X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit-repos-server;h=eb59edc4e2b02014b225808a34d75388a1ccbe50;hp=aab35d32051094785fd4e7765a5aa656fbe53280;hb=397c47973c3f1fb2dbbbfc4fff1d2d88c8df711d;hpb=fb6ff2e818203ba2b02f4d4d3b2eb57c77ba74c0 diff --git a/dgit-repos-server b/dgit-repos-server index aab35d32..eb59edc4 100755 --- a/dgit-repos-server +++ b/dgit-repos-server @@ -86,6 +86,8 @@ use POSIX; use Fcntl qw(:flock); use File::Path qw(rmtree); +open DEBUG, ">/dev/null" or die $!; + our $package_re = '[0-9a-z][-+.0-9a-z]+'; our $func; @@ -97,19 +99,26 @@ our $destrepo; our $workrepo; our $keyrings; our @lockfhs; +our $debug=''; #----- utilities ----- +sub debug { + print DEBUG "$debug @_\n"; +} + sub acquirelock ($$) { my ($lock, $must) = @_; my $fh; + printf DEBUG "$debug locking %s %d\n", $lock, $must; for (;;) { 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 undef unless $must; - die "flock $lock: $!"; + die "flock $lock: $!" if $must; + debug " locking $lock failed"; + return undef; } if (!stat $lock) { next if $! == ENOENT; @@ -133,11 +142,26 @@ 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"; + my ($why) = @_; + debug " rejecting $why"; + die "dgit-repos-server: reject: $why\n"; } sub runcmd { + if ($debug) { + use Data::Dumper; + local $Data::Dumper::Indent = 0; + local $Data::Dumper::Terse = 1; + debug "|".Dumper(\@_); + } $!=0; $?=0; my $r = system @_; die "@_ $? $!" if $r; @@ -146,6 +170,7 @@ sub runcmd { #----- git-receive-pack ----- sub fixmissing__git_receive_pack () { + mkrepotmp(); $destrepo = "$dgitrepos/_tmp/${package}_prospective"; acquiretree($destrepo, 1); my $r = system qw(cp -a --), "$dgitrepos/_template", "$destrepo"; @@ -153,6 +178,7 @@ sub fixmissing__git_receive_pack () { } sub makeworkingclone () { + mkrepotmp(); $workrepo = "$dgitrepos/_tmp/${package}_incoming$$"; acquiretree($workrepo, 1); runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo; @@ -168,13 +194,16 @@ set -e exec $0 --pre-receive-hook $package END close $fh or die "$prerecv: $!"; - $ENV{'DGIT_RPR_WORK'}= $workrepo; - $ENV{'DGIT_RPR_DEST'}= $destrepo; + $ENV{'DGIT_DRS_WORK'}= $workrepo; + $ENV{'DGIT_DRS_DEST'}= $destrepo; + debug " stunt hook set up $prerecv"; } sub maybeinstallprospective () { return if $destrepo eq $realdestrepo; + debug " show-ref ..."; + my $child = open SR, "-|"; defined $child or die $!; if (!$child) { @@ -185,6 +214,7 @@ sub maybeinstallprospective () { my %got = qw(tag 0 head 0); while () { chomp or die; + debug " show-refs| $_"; s/^\S*[1-9a-f]\S* (\S+)$/$1/ or die; my $wh = m{^refs/tags/} ? 'tag' : @@ -202,7 +232,7 @@ sub maybeinstallprospective () { sub main__git_receive_pack () { makeworkingclone(); setupstunthook(); - runcmd qw(git receive-pack), $destrepo; + runcmd qw(git receive-pack), $workrepo; maybeinstallprospective(); } @@ -212,7 +242,10 @@ our ($tagname, $tagval, $suite, $oldcommit, $commit); our ($version, %tagh); sub readupdates () { + debug " updates ..."; while () { + chomp or die; + debug " upd.| $_"; m/^(\S+) (\S+) (\S+)$/ or die "$_ ?"; my ($old, $sha1, $refname) = ($1, $2, $3); if ($refname =~ m{^refs/tags/(?=debian/)}) { @@ -235,9 +268,11 @@ sub readupdates () { die unless defined $tagname; die unless defined $suite; + debug " updates ok."; } sub parsetag () { + debug " parsetag..."; open PT, ">dgit-tmp/plaintext" or die $!; open DS, ">dgit-tmp/plaintext.asc" or die $!; open T, "-|", qw(git cat-file tag), $tagval or die $!; @@ -257,7 +292,7 @@ sub parsetag () { die unless $1 eq $package; $version = $2; - die unless $3 eq $suite; + die "$3 != $suite " unless $3 eq $suite; for (;;) { print PT or die $!; @@ -272,6 +307,7 @@ sub parsetag () { T->error and die $!; close PT or die $!; close DS or die $!; + debug " parsetag ok."; } sub checksig_keyring ($) { @@ -282,6 +318,8 @@ sub checksig_keyring ($) { my $ok = undef; + debug " checksig keyring $keyringfile..."; + open P, "-|", (qw(gpgv --status-fd=1 --keyring), $keyringfile, qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext)) @@ -290,6 +328,7 @@ sub checksig_keyring ($) { while (

) { next unless s/^\[GNUPG:\]: //; chomp or die; + debug " checksig| $_"; my @l = split / /, $_; if ($l[0] eq 'NO_PUBKEY') { last; @@ -303,11 +342,14 @@ sub checksig_keyring ($) { } close P; + debug sprintf " checksig ok=%d", !!$ok; + return $ok; } sub dm_txt_check ($$) { my ($keyid, $dmtxtfn) = @_; + debug " dm_txt_check $keyid $dmtxtfn"; open DT, '<', $dmtxtfn or die "$dmtxtfn $!"; while (

) { m/^fingerprint:\s+$keyid$/oi @@ -322,8 +364,14 @@ sub dm_txt_check ($$) { # in allow field... s/\([^()]+\)//; s/\,//; + chomp or die; + debug " dm_txt_check allow| $_"; foreach my $p (split /\s+/) { - return if $p eq $package; # yay! + if ($p eq $package) { + # yay! + debug " dm_txt_check ok"; + return; + } } } DT->error and die $!; @@ -333,13 +381,16 @@ sub dm_txt_check ($$) { sub verifytag () { foreach my $kas (split /:/, $keyrings) { + debug "verifytag $kas..."; $kas =~ s/^([^,]+),// or die; my $keyid = checksig_keyring $1; if (defined $keyid) { if ($kas =~ m/^a$/) { + debug "verifytag a ok"; return; # yay } elsif ($kas =~ m/^m([^,]+)$/) { dm_txt_check($keyid, $1); + debug "verifytag m ok"; return; } else { die; @@ -350,6 +401,7 @@ sub verifytag () { } sub checksuite () { + debug "checksuite"; open SUITES, "<", $suitesfile or die $!; while () { chomp; @@ -363,6 +415,7 @@ sub checksuite () { } sub checks () { + debug "checks"; checksuite(); tagh1('type') eq 'commit' or die; tagh1('object') eq $commit or die; @@ -370,9 +423,12 @@ sub checks () { my $v = $version; $v =~ y/~:/_%/; + + debug "translated version $v"; $tagname eq "debian/$v" or die; # check that our ref is being fast-forwarded + debug "oldcommit $oldcommit"; if ($oldcommit =~ m/[^0]/) { $?=0; $!=0; my $mb = `git merge-base $commit $oldcommit`; chomp $mb; @@ -390,6 +446,7 @@ sub onwardpush () { } sub stunthook () { + debug "stunthook"; chdir $workrepo or die "chdir $workrepo: $!"; mkdir "dgit-tmp" or $!==EEXIST or die $!; readupdates(); @@ -430,21 +487,27 @@ sub argval () { sub parseargsdispatch () { die unless @ARGV; + if ($ENV{'DGIT_DRS_DEBUG'}) { + $debug='='; + open DEBUG, ">&STDERR" or die $!; + } + if ($ARGV[0] eq '--pre-receive-hook') { + if ($debug) { $debug.="="; } shift @ARGV; @ARGV == 1 or die; $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; - defined($keyrings = $ENV{'DGIT_RPR_KEYRINGS'}) or die $!; + defined($suitesfile = $ENV{'DGIT_DRS_SUITES'}) or die; + defined($workrepo = $ENV{'DGIT_DRS_WORK'}) or die; + defined($destrepo = $ENV{'DGIT_DRS_DEST'}) or die; + defined($keyrings = $ENV{'DGIT_DRS_KEYRINGS'}) or die $!; open STDOUT, ">&STDERR" or die $!; stunthook(); exit 0; } - $ENV{'DGIT_RPR_SUITES'} = argval(); - $ENV{'DGIT_RPR_KEYRINGS'} = argval(); + $ENV{'DGIT_DRS_SUITES'} = argval(); + $ENV{'DGIT_DRS_KEYRINGS'} = argval(); $dgitrepos = argval(); die unless @ARGV==1 && $ARGV[0] eq '--ssh'; @@ -474,10 +537,12 @@ sub parseargsdispatch () { $destrepo = $realdestrepo; } else { $! == ENOENT or die "stat dest repo $destrepo: $!"; + debug " fixmissing $funcn"; my $fixfunc = $main::{"fixmissing__$funcn"}; &$fixfunc; } + debug " running main $funcn"; &$mainfunc; }