dgit-repos-server: tests: no need for troot

[dgit.git] / dgit-repos-server

diff --git a/dgit-repos-server b/dgit-repos-server
old mode 100644 (file)
new mode 100755 (executable)
index e6b2dfb..aaa7542
--- a/dgit-repos-server
+++ b/dgit-repos-server
@@ -1,10 +1,10 @@
 #!/usr/bin/perl -w
-# dgit-repos-push-receiver
+# dgit-repos-server
 #
 # usages:
-#  .../dgit-repos-push-receiver SUITES KEYRING-AUTH-SPEC DGIT-REPOS-DIR --ssh
+#  .../dgit-repos-server SUITES KEYRING-AUTH-SPEC DGIT-REPOS-DIR --ssh
 # internal usage:
-#  .../dgit-repos-push-receiver --pre-receive-hook PACKAGE
+#  .../dgit-repos-server --pre-receive-hook PACKAGE
 #
 # Invoked as the ssh restricted command
 #
@@ -90,12 +90,12 @@ our $package_re = '[0-9a-z][-+.0-9a-z]+';
 
 our $func;
 our $dgitrepos;
-our $pkg;
+our $package;
 our $suitesfile;
 our $realdestrepo;
 our $destrepo;
 our $workrepo;
-our @keyrings;
+our $keyrings;
 our @lockfhs;
 
 #----- utilities -----
@@ -105,7 +105,7 @@ sub acquirelock ($$) {
     my $fh;
     for (;;) {
        close $fh if $fh;
-       $fh = new IO::File, ">", $lock or die "open $lock: $!";
+       $fh = new IO::File $lock, ">" or die "open $lock: $!";
        my $ok = flock $fh, $must ? LOCK_EX : (LOCK_EX|LOCK_NB);
        if (!$ok) {
            return undef unless $must;
@@ -133,33 +133,48 @@ sub acquiretree ($$) {
     return $fh;
 }
 
+sub mkrepotmp () {
+    my $tmpdir = "$dgitrepos/_tmp";
+    return if mkdir $tmpdir;
+    return if $! == EEXIST;
+    die $!;
+}
+
 sub reject ($) {
     die "dgit-repos-server: reject: $_[0]\n";
 }
 
+sub runcmd {
+    $!=0; $?=0;
+    my $r = system @_;
+    die "@_ $? $!" if $r;
+}
+
 #----- git-receive-pack -----
 
 sub fixmissing__git_receive_pack () {
-    $destrepo = "$dgitrepos/_tmp/${pkg}_prospective";
+    mkrepotmp();
+    $destrepo = "$dgitrepos/_tmp/${package}_prospective";
     acquiretree($destrepo, 1);
     my $r = system qw(cp -a --), "$dgitrepos/_template", "$destrepo";
     !$r or die "create new repo failed failed: $r $!";
 }
 
 sub makeworkingclone () {
-    $workrepo = "$dgitrepos/_tmp/${pkg}_incoming$$";
+    mkrepotmp();
+    $workrepo = "$dgitrepos/_tmp/${package}_incoming$$";
     acquiretree($workrepo, 1);
     runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo;
 }
 
 sub setupstunthook () {
     my $prerecv = "$workrepo/hooks/pre-receive";
-    my $fh = new IO::File, $prerecv, O_WRONLY|O_CREAT|O_TRUNC, 0777
+    my $fh = new IO::File $prerecv, O_WRONLY|O_CREAT|O_TRUNC, 0777
        or die "$prerecv: $!";
     print $fh <<END or die "$prerecv: $!";
 #!/bin/sh
 set -e
-exec $0 --pre-receive-hook $pkg
+exec $0 --pre-receive-hook $package
 END
     close $fh or die "$prerecv: $!";
     $ENV{'DGIT_RPR_WORK'}= $workrepo;
@@ -196,7 +211,7 @@ sub maybeinstallprospective () {
 sub main__git_receive_pack () {
     makeworkingclone();
     setupstunthook();
-    runcmd qw(git receive-pack), $destdir;
+    runcmd qw(git receive-pack), $destrepo;
     maybeinstallprospective();
 }
 
@@ -227,8 +242,8 @@ sub readupdates () {
     }
     STDIN->error and die $!;
 
-    die unless defined $refname;
-    die unless defined $branchname;
+    die unless defined $tagname;
+    die unless defined $suite;
 }
 
 sub parsetag () {
@@ -249,7 +264,7 @@ sub parsetag () {
     $!=0; $_=<T>; defined or die $!;
     m/^($package_re) release (\S+) for (\S+) \[dgit\]$/ or die;
 
-    die unless $1 eq $pkg;
+    die unless $1 eq $package;
     $version = $2;
     die unless $3 eq $suite;
 
@@ -276,8 +291,8 @@ sub checksig_keyring ($) {
 
     my $ok = undef;
 
-    open P, "-|", (qw(gpgv --status-fd=1),
-                  map { '--keyring', $_ }, @keyrings,
+    open P, "-|", (qw(gpgv --status-fd=1 --keyring),
+                  $keyringfile,
                   qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext))
        or die $!;
 
@@ -397,10 +412,19 @@ sub stunthook () {
 
 sub fixmissing__git_upload_pack () {
     $destrepo = "$dgitrepos/_empty";
+    my $lfh = acquiretree($destrepo,1);
+    return if stat $destrepo;
+    die $! unless $!==ENOENT;
+    rmtree "$destrepo.new";
+    umask 022;
+    runcmd qw(git init --bare --quiet), "$destrepo.new";
+    rename "$destrepo.new", $destrepo or die $!;
+    unlink "$destrepo.lock" or die $!;
+    close $lfh;
 }
 
 sub main__git_upload_pack () {
-    runcmd qw(git upload-pack), $destdir;
+    runcmd qw(git upload-pack), $destrepo;
 }
 
 #----- arg parsing and main program -----
@@ -418,7 +442,7 @@ sub parseargsdispatch () {
     if ($ARGV[0] eq '--pre-receive-hook') {
        shift @ARGV;
        @ARGV == 1 or die;
-       $pkg = shift @ARGV;
+       $package = shift @ARGV;
        defined($suitesfile = $ENV{'DGIT_RPR_SUITES'}) or die;
        defined($workrepo = $ENV{'DGIT_RPR_WORK'}) or die;
        defined($destrepo = $ENV{'DGIT_RPR_DEST'}) or die;
@@ -445,9 +469,9 @@ sub parseargsdispatch () {
        $
     }ox 
     or reject "command string not understood";
-    $method = $1;
-    $pkg = $2;
-    $realdestrepo = "$dgitrepos/$pkg.git";
+    my $method = $1;
+    $package = $2;
+    $realdestrepo = "$dgitrepos/$package.git";
 
     my $funcn = $method;
     $funcn =~ y/-/_/;
@@ -467,17 +491,20 @@ sub parseargsdispatch () {
 }
 
 sub unlockall () {
-    while (my $fh = pop $lockfhs) { close $fh; }
+    while (my $fh = pop @lockfhs) { close $fh; }
 }
 
 sub cleanup () {
     unlockall();
-    chdir "$dgitrepos/_tmp" or die $!;
-    foreach my $lock (<*.lock>) {
+    if (!chdir "$dgitrepos/_tmp") {
+       $!==ENOENT or die $!;
+       return;
+    }
+    foreach my $lf (<*.lock>) {
        my $tree = $lf;
        $tree =~ s/\.lock$//;
        next unless acquiretree($tree, 0);
-       remove $lock or warn $!;
+       remove $lf or warn $!;
        unlockall();
     }
 }