#!/usr/bin/perl -w
#
# Copyright (c) 2010, Novell Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

BEGIN {
  my ($wd) = $0 =~ m-(.*)/- ;
  $wd ||= '.';
  chdir($wd);
  unshift @INC,  "$wd/build";
  unshift @INC,  "$wd";
}

use XML::Structured ':bytes';

use BSConfig;
use BSUtil;
use BSVerify;
use BSAccess;

my $projectsdir = "$BSConfig::bsdir/projects";

sub qsystem {
  my @args = @_;
  my $pid;
  local (*RH, *WH);
  if ($args[0] eq 'echo') {
    pipe(RH, WH) || die("pipe: $!\n");
  }
  if (!($pid = xfork())) {
    open(STDOUT, ">/dev/null");
    eval {
      exec(@args);
      die("$args[0]: $!\n");
    };
    warn($@) if $@;
    exit 1;
  }
  waitpid($pid, 0) == $pid || die("waitpid $pid: $!\n");
  return $?;
}

BSAccess::set_projectsdir($projectsdir);

my $userid = $ARGV[0];
die("user not given\n") unless defined $userid;

die("SSH_ORIGINAL_COMMAND not set\n") unless $::ENV{'SSH_ORIGINAL_COMMAND'};
my @cmd = split(' ', $::ENV{'SSH_ORIGINAL_COMMAND'});
if ($cmd[0] eq 'git' && @cmd > 1) {
  pop @cmd;
  $cmd[0] = "git-$cmd[0]";
}
die("bad command @cmd\n") unless @cmd == 2;
die("illegal command @cmd\n") unless $cmd[0] eq 'git-upload-pack' || $cmd[0] eq 'git-receive-pack';

#unquote argument
if ($cmd[1] =~ s/^'(.*)'/$1/s) {
  $cmd[1] =~ s/'\\(.)'/$1/sg;
}
die("repository must end with .git\n") unless $cmd[1] =~ s/\.git$//s;
my ($projid, $packid) = split('/', $cmd[1], 2);
BSVerify::verify_projid($projid);
BSVerify::verify_packid($packid);
die("project '$projid' does not exist\n") unless -e "$projectsdir/$projid.xml";
die("package '$packid' does not exist\n") unless -e "$projectsdir/$projid.pkg/$packid.xml";
my $gitdir = "$projectsdir/$projid.pkg/$packid.git";
die("package '$packid' is not under git control\n") unless -d $gitdir;

if ($cmd[0] eq 'git-upload-pack') {
  BSAccess::may_read($userid, $projid, $packid);
  if (-e "$gitdir/refs/heads/link") {
    # need to make sure the link us up-to-date
    qsystem('git', "--git-dir=$gitdir", 'fetch', '-q', '-n', 'link', 'master:link');
  }
  exec $cmd[0], $gitdir;
  die("$cmd[0]: $!\n");
}
if ($cmd[0] eq 'git-receive-pack') {
  BSAccess::may_write($userid, $projid, $packid);
  exec $cmd[0], $gitdir;
  die("$cmd[0]: $!\n");
}
die("unsupported command $cmd[0]\n");
