X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit-repos-server;h=aaa754207ab91701fda9ba899bface80a25e1eb8;hp=e6b2dfbb2b64893f64ce68337e24e7176094424e;hb=2b475587b57da40b8992aa5f54fa1ca49cd66874;hpb=5fb470433413f6594afd9e4d5e2415a1454def14

diff --git a/dgit-repos-server b/dgit-repos-server
old mode 100644
new mode 100755
index e6b2dfbb..aaa75420
--- 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();
     }
 }