chiark / gitweb /
dgit-repos-server: wip, receive-pack mostly done?
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Wed, 15 Jan 2014 21:40:27 +0000 (21:40 +0000)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Wed, 5 Mar 2014 18:29:02 +0000 (18:29 +0000)
dgit-repos-server

index 51160be..5055de6 100644 (file)
@@ -3,7 +3,6 @@
 #
 # usages:
 #  .../dgit-repos-push-receiver SUITES KEYRING-AUTH-SPEC DGIT-REPOS-DIR --ssh
-#  .../dgit-repos-push-receiver SUITES KEYRING-AUTH-SPEC DGIT-REPOS-DIR PACKAGE
 # internal usage:
 #  .../dgit-repos-push-receiver --pre-receive-hook PACKAGE
 #
@@ -27,14 +26,14 @@ use strict;
 #  - make a hardlink clone of the destination repo
 #  - provide the destination with a stunt pre-receive hook
 #  - run actual git-receive-pack with that new destination
-#   as a result of this the stunt pre-receive hook runs; it does this
+#   as a result of this the stunt pre-receive hook runs; it does this:
 #    + understand what refs we are allegedly updating and
 #      check some correspondences:
 #        * we are updating only refs/tags/debian/* and refs/dgit/*
 #        * and only one of each
 #        * and the tag does not already exist
 #      and
-#        * recovering the suite name from the destination refs/dgit/ ref
+#        * recover the suite name from the destination refs/dgit/ ref
 #    + disassemble the signed tag into its various fields and signature
 #      including:
 #        * parsing the first line of the tag message to recover
@@ -64,10 +63,10 @@ use strict;
 #  - we use the prospective new destination repo instead of the
 #    actual new destination repo (since the latter doesn't exist)
 #  - we set up a post-receive hook as well, which
-#    + checks that exactly two refs were updated
 #    + touches a stamp file
-#  - after git-receive-pack exits, we rename the prospective
-#    destination repo into place
+#  - after git-receive-pack exits, we
+#    + check that the prospective repo contains a tag and head
+#    + rename the prospective destination repo into place
 #
 # Cleanup strategy:
 #  - We are crash-only
@@ -85,22 +84,31 @@ use strict;
 
 use POSIX;
 use Fcntl qw(:flock);
+use File::Path qw(rmtree);
 
 our $package_re = '[0-9a-z][-+.0-9a-z]+';
 
+our $func;
 our $dgitrepos;
 our $pkg;
+our $suitesfile;
+our $realdestrepo;
 our $destrepo;
 our $workrepo;
 our @keyrings;
+our @lockfhs;
+
+#----- utilities -----
 
 sub acquirelock ($$) {
     my ($lock, $must) = @_;
+    my $fh;
     for (;;) {
-       my $fh = new IO::File, ">", $lock or die "open $lock: $!";
+       close $fh if $fh;
+       $fh = new IO::File, ">", $lock or die "open $lock: $!";
        my $ok = flock $fh, $must ? LOCK_EX : (LOCK_EX|LOCK_NB);
        if (!$ok) {
-           return unless $must;
+           return undef unless $must;
            die "flock $lock: $!";
        }
        if (!stat $lock) {
@@ -110,21 +118,38 @@ sub acquirelock ($$) {
        my $want = (stat _)[1];
        stat $fh or die $!;
        my $got = (stat _)[1];
-       return $fh if $got == $want;
+       last if $got == $want;
+    }
+    return $fh;
+}
+
+sub acquiretree ($$) {
+    my ($tree, $must) = @_;
+    my $fh = acquirelock("$tree.lock", $must);
+    if ($fh) {
+       push @lockfhs, $fh;
+       rmtree $tree;
     }
+    return $fh;
+}
+
+sub reject ($) {
+    die "dgit-repos-server: reject: $_[0]\n";
+}
+
+#----- git-receive-pack -----
+
+sub fixmissing__git_receive_pack () {
+    $destrepo = "$dgitrepos/_tmp/${pkg}_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$$";
-    my $lock = "$workrepo.lock";
-    my $lockfh = acquirelock($lock, 1);
-    if (!stat $destrepo) {
-       $! == ENOENT or die "stat dest repo $destrepo: $!";
-       mkdir $workrepo or die "create work repo $workrepo: $!";
-       runcmd qw(git init --bare), $workrepo;
-    } else {
-       runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo;
-    }
+    acquiretree($workrepo, 1);
+    runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo;
 }
 
 sub setupstunthook () {
@@ -141,6 +166,40 @@ END
     $ENV{'DGIT_RPR_DEST'}= $destrepo;
 }
 
+sub maybeinstallprospective () {
+    return if $destrepo eq $realdestrepo;
+
+    my $child = open SR, "-|";
+    defined $child or die $!;
+    if (!$child) {
+       chdir $destrepo or die $!;
+       exec qw(git show-ref);
+       die $!;
+    }
+    my %got = qw(tag 0 head 0);
+    while (<SR>) {
+       chomp or die;
+       s/^\S*[1-9a-f]\S* (\S+)$/$1/ or die;
+       my $wh =
+           m{^refs/tags/} ? 'tag' :
+           m{^refs/dgit/} ? 'head' :
+           die;
+       die if $got{$wh}++;
+    }
+    die if grep { !$_ } values %got;
+    $!=0; $?=0; close SR or die "$? $!";
+
+    rename $destrepo, $realdestrepo or die $!;
+    remove "$destrepo.lock" or die $!;
+}
+
+sub main__git_receive_pack () {
+    makeworkingclone();
+    setupstunthook();
+    runcmd qw(git receive-pack), $destdir;
+    maybeinstallprospective();
+}
+
 #----- stunt post-receive hook -----
 
 our ($tagname, $tagval, $suite, $oldcommit, $commit);
@@ -284,8 +343,21 @@ sub verifytag () {
     reject "key not found in keyrings";
 }
 
+sub checksuite () {
+    open SUITES, "<", $suitesfile or die $!;
+    while (<SUITES>) {
+       chomp;
+       next unless m/\S/;
+       next if m/^\#/;
+       s/\s+$//;
+       return if $_ eq $suite;
+    }
+    die $! if SUITES->error;
+    reject "unknown suite";
+}
+
 sub checks () {
-fixme check the suite against the approved list
+    checksuite();
     tagh1('type') eq 'commit' or die;
     tagh1('object') eq $commit or die;
     tagh1('tag') eq $tagname or die;
@@ -323,13 +395,21 @@ sub stunthook () {
 
 #----- arg parsing and main program -----
 
-sub parseargs () {
+sub argval () {
+    die unless @ARGV;
+    my $v = shift @ARGV;
+    die if $v =~ m/^-/;
+    return $v;
+}
+
+sub parseargsdispatch () {
     die unless @ARGV;
 
     if ($ARGV[0] eq '--pre-receive-hook') {
        shift @ARGV;
        @ARGV == 1 or die;
        $pkg = 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;
        defined($keyrings = $ENV{'DGIT_RPR_KEYRINGS'}) or die $!;
@@ -338,52 +418,59 @@ sub parseargs () {
        exit 0;
     }
 
-    die unless @ARGV>=3;
-
-    die if $ARGV[0] =~ m/^-/;
-    $suitesfile = shift @ARGV;
-
-    die if $ARGV[0] =~ m/^-/;
-    $ENV{'DGIT_RPR_KEYRINGS'} = shift @ARGV;
-
-    die if $ARGV[0] =~ m/^-/;
-    $dgitrepos = shift @ARGV;
-
-    die unless @ARGV;
-    if ($ARGV[0] != m/^-/) {
-       @ARGV == 1 or die;
-       $pkg = shift @ARGV;
-    } elsif ($ARGV[0] eq '--ssh') {
-       shift @ARGV;
-       !@ARGV or die;
-       my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'};
-       $cmd =~ m{
-            ^
-            (?:\S*/)?
-           (git-receive-pack|git-upload-pack)
-           \s+
-            (?:\S*/)?
-           ($package_re)\.git
-            $
-        }ox 
-           or die "requested command $cmd not understood";
-       $method = $1;
-       $pkg = $2;
-       my $func = $method;
-       $func =~ y/-/_/;
-       $func = $main::{"main__$func"};
-       &$func;
+    $ENV{'DGIT_RPR_SUITES'} = argval();
+    $ENV{'DGIT_RPR_KEYRINGS'} = argval();
+    $dgitrepos = argval();
+
+    die unless @ARGV==1 && $ARGV[0] eq '--ssh';
+
+    my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'};
+    $cmd =~ m{
+       ^
+       (?:\S*/)?
+       ([-0-9a-z]+)
+       \s+
+       (?:\S*/)?
+       ($package_re)\.git
+       $
+    }ox 
+    or reject "command string not understood";
+    $method = $1;
+    $pkg = $2;
+    $realdestrepo = "$dgitrepos/$pkg.git";
+
+    my $funcn = $method;
+    $funcn =~ y/-/_/;
+    my $mainfunc = $main::{"main__$funcn"};
+
+    reject "unknown method" unless $mainfunc;
+
+    if (stat $realdestrepo) {
+       $destrepo = $realdestrepo;
     } else {
-       die;
+       $! == ENOENT or die "stat dest repo $destrepo: $!";
+       my $fixfunc = $main::{"fixmissing__$funcn"};
+       &$fixfunc;
     }
 
-    $destrepo = "$dgitrepos/$pkg.git";
+    &$mainfunc;
 }
 
-sub main__git_receive_pack () {
-    parseargs();
-fixme check method;
-    makeworkingclone();
-    setupstunthook();
-    runcmd qw(git receive-pack), $destdir;
+sub unlockall () {
+    while (my $fh = pop $lockfhs) { close $fh; }
+}
+
+sub cleanup () {
+    unlockall();
+    chdir "$dgitrepos/_tmp" or die $!;
+    foreach my $lock (<*.lock>) {
+       my $tree = $lf;
+       $tree =~ s/\.lock$//;
+       next unless acquiretree($tree, 0);
+       remove $lock or warn $!;
+       unlockall();
+    }
 }
+
+parseargsdispatch();
+cleanup();