diff options
Diffstat (limited to 'dgit-repos-server')
| -rwxr-xr-x | dgit-repos-server | 64 |
1 files changed, 60 insertions, 4 deletions
diff --git a/dgit-repos-server b/dgit-repos-server index c17ae80..3a471a1 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; @@ -141,10 +150,18 @@ sub mkrepotmp () { } 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; @@ -179,11 +196,14 @@ END close $fh or die "$prerecv: $!"; $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) { @@ -194,6 +214,7 @@ sub maybeinstallprospective () { my %got = qw(tag 0 head 0); while (<SR>) { chomp or die; + debug " show-refs| $_"; s/^\S*[1-9a-f]\S* (\S+)$/$1/ or die; my $wh = m{^refs/tags/} ? 'tag' : @@ -221,7 +242,10 @@ our ($tagname, $tagval, $suite, $oldcommit, $commit); our ($version, %tagh); sub readupdates () { + debug " updates ..."; while (<STDIN>) { + chomp or die; + debug " updates| $_"; m/^(\S+) (\S+) (\S+)$/ or die "$_ ?"; my ($old, $sha1, $refname) = ($1, $2, $3); if ($refname =~ m{^refs/tags/(?=debian/)}) { @@ -244,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 $!; @@ -281,6 +307,7 @@ sub parsetag () { T->error and die $!; close PT or die $!; close DS or die $!; + debug " parsetag ok."; } sub checksig_keyring ($) { @@ -291,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)) @@ -299,6 +328,7 @@ sub checksig_keyring ($) { while (<P>) { next unless s/^\[GNUPG:\]: //; chomp or die; + debug " checksig| $_"; my @l = split / /, $_; if ($l[0] eq 'NO_PUBKEY') { last; @@ -312,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 (<DT>) { m/^fingerprint:\s+$keyid$/oi @@ -331,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 $!; @@ -342,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; @@ -359,6 +401,7 @@ sub verifytag () { } sub checksuite () { + debug "checksuite"; open SUITES, "<", $suitesfile or die $!; while (<SUITES>) { chomp; @@ -372,6 +415,7 @@ sub checksuite () { } sub checks () { + debug "checks"; checksuite(); tagh1('type') eq 'commit' or die; tagh1('object') eq $commit or die; @@ -379,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; @@ -399,6 +446,7 @@ sub onwardpush () { } sub stunthook () { + debug "stunthook"; chdir $workrepo or die "chdir $workrepo: $!"; mkdir "dgit-tmp" or $!==EEXIST or die $!; readupdates(); @@ -439,7 +487,13 @@ 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; @@ -483,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; } |