From: Ian Jackson Date: Wed, 15 Jan 2014 21:40:27 +0000 (+0000) Subject: dgit-repos-server: wip, receive-pack mostly done? X-Git-Tag: debian/0.22~106 X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=commitdiff_plain;h=b1f5b0b214e6f21145627e78e662c370754c1aff dgit-repos-server: wip, receive-pack mostly done? --- diff --git a/dgit-repos-server b/dgit-repos-server index 51160be4..5055de63 100644 --- a/dgit-repos-server +++ b/dgit-repos-server @@ -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 () { + 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 () { + 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();