From cb5dfd5817329930d923aa005d6cf3b9c424656d Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sat, 2 May 2015 20:06:48 +0100 Subject: [PATCH 1/1] Debugging: Use Dgit.pm's facilities in dgit-repos-server --- infra/dgit-repos-server | 112 ++++++++++++++++++---------------------- 1 file changed, 49 insertions(+), 63 deletions(-) diff --git a/infra/dgit-repos-server b/infra/dgit-repos-server index 8e939d02..63f9aac0 100755 --- a/infra/dgit-repos-server +++ b/infra/dgit-repos-server @@ -170,7 +170,7 @@ use File::Temp qw(tempfile); use Debian::Dgit qw(:DEFAULT :policyflags); -open DEBUG, ">/dev/null" or die $!; +initdebug(''); our $func; our $dgitrepos; @@ -183,30 +183,26 @@ our $destrepo; our $workrepo; our $keyrings; our @lockfhs; -our $debug=''; + our @deliberatelies; our %supersedes; our $policy; #----- utilities ----- -sub debug { - print DEBUG "$debug @_\n"; -} - sub realdestrepo () { "$dgitrepos/$package.git"; } sub acquirelock ($$) { my ($lock, $must) = @_; my $fh; - printf DEBUG "$debug locking %s %d\n", $lock, $must; + printdebug sprintf "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) { die "flock $lock: $!" if $must; - debug " locking $lock failed"; + printdebug " locking $lock failed\n"; return undef; } next unless stat_exists $lock; @@ -263,17 +259,8 @@ sub reject ($) { die "dgit-repos-server: reject: $why\n"; } -sub debugcmd { - if ($debug) { - use Data::Dumper; - local $Data::Dumper::Indent = 0; - local $Data::Dumper::Terse = 1; - debug "|".Dumper(\@_); - } -} - sub runcmd { - debugcmd @_; + debugcmd '+',@_; $!=0; $?=0; my $r = system @_; die "@_ $? $!" if $r; @@ -284,11 +271,11 @@ sub policyhook { # => ($exitstatuspolicybitmap); die if $policyallowbits & ~0x3e; my @cmd = ($policyhook,$distro,$dgitrepos,$dgitlive,@polargs); - debugcmd @cmd; + debugcmd '+',@cmd; my $r = system @cmd; die "system: $!" if $r < 0; die "hook (@cmd) failed ($?)" if $r & ~($policyallowbits << 8); - debug sprintf "hook (%s) => %#x", "@polargs", $r; + printdebug sprintf "hook (%s) => %#x\n", "@polargs", $r; return $r >> 8; } @@ -301,7 +288,7 @@ sub mkrepo_fromtemplate ($) { my ($dir) = @_; my $template = "$dgitrepos/_template"; locksometree($template); - debug "copy template $template -> $dir"; + printdebug "copy template $template -> $dir\n"; my $r = system qw(cp -a --), $template, $dir; !$r or die "create new repo $dir failed: $r $!"; } @@ -368,7 +355,7 @@ END close $fh or die "$prerecv: $!"; $ENV{'DGIT_DRS_WORK'}= $workrepo; $ENV{'DGIT_DRS_DEST'}= $destrepo; - debug " stunt hook set up $prerecv"; + printdebug " stunt hook set up $prerecv\n"; } sub dealwithfreshrepo () { @@ -390,7 +377,7 @@ sub maybeinstallprospective () { $!==&ENOENT or die $!; } - debug " show-ref ($destrepo) ..."; + printdebug " show-ref ($destrepo) ...\n"; my $child = open SR, "-|"; defined $child or die $!; @@ -402,7 +389,7 @@ sub maybeinstallprospective () { my %got = qw(tag 0 head 0); while () { chomp or die; - debug " show-refs| $_"; + printdebug " show-refs| $_\n"; s/^\S*[1-9a-f]\S* (\S+)$/$1/ or die; my $wh = m{^refs/tags/} ? 'tag' : @@ -412,7 +399,7 @@ sub maybeinstallprospective () { } $!=0; $?=0; close SR or $?==256 or die "$? $!"; - debug "installprospective ?"; + printdebug "installprospective ?\n"; die Dumper(\%got)." -- missing refs in new repo" if grep { !$_ } values %got; @@ -422,7 +409,7 @@ sub maybeinstallprospective () { movetogarbage; } - debug "install $destrepo => ".realdestrepo; + printdebug "install $destrepo => ".realdestrepo."\n"; rename $destrepo, realdestrepo or die $!; remove "$destrepo.lock" or die $!; } @@ -441,10 +428,10 @@ our ($tagname, $tagval, $suite, $oldcommit, $commit); our ($version, %tagh); sub readupdates () { - debug " updates ..."; + printdebug " updates ...\n"; while () { chomp or die; - debug " upd.| $_"; + printdebug " upd.| $_\n"; m/^(\S+) (\S+) (\S+)$/ or die "$_ ?"; my ($old, $sha1, $refname) = ($1, $2, $3); if ($refname =~ m{^refs/tags/(?=debian/)}) { @@ -467,11 +454,11 @@ sub readupdates () { reject "push is missing tag ref update" unless defined $tagname; reject "push is missing head ref update" unless defined $suite; - debug " updates ok."; + printdebug " updates ok.\n"; } sub parsetag () { - debug " parsetag..."; + printdebug " parsetag...\n"; 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 $!; @@ -527,7 +514,7 @@ sub parsetag () { T->error and die $!; close PT or die $!; close DS or die $!; - debug " parsetag ok."; + printdebug " parsetag ok.\n"; } sub checksig_keyring ($) { @@ -538,12 +525,12 @@ sub checksig_keyring ($) { my $ok = undef; - debug " checksig keyring $keyringfile..."; + printdebug " checksig keyring $keyringfile...\n"; our @cmd = (qw(gpgv --status-fd=1 --keyring), $keyringfile, qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext)); - debugcmd @cmd; + debugcmd '|',@cmd; open P, "-|", @cmd or die $!; @@ -551,7 +538,7 @@ sub checksig_keyring ($) { while (

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

) { m/^fingerprint:\s+$keyid$/oi @@ -590,11 +577,11 @@ sub dm_txt_check ($$) { s/\([^()]+\)//; s/\,//; chomp or die; - debug " dm_txt_check allow| $_"; + printdebug " dm_txt_check allow| $_\n"; foreach my $p (split /\s+/) { if ($p eq $package) { # yay! - debug " dm_txt_check ok"; + printdebug " dm_txt_check ok\n"; return; } } @@ -606,16 +593,16 @@ sub dm_txt_check ($$) { sub verifytag () { foreach my $kas (split /:/, $keyrings) { - debug "verifytag $kas..."; + printdebug "verifytag $kas...\n"; $kas =~ s/^([^,]+),// or die; my $keyid = checksig_keyring $1; if (defined $keyid) { if ($kas =~ m/^a$/) { - debug "verifytag a ok"; + printdebug "verifytag a ok\n"; return; # yay } elsif ($kas =~ m/^m([^,]+)$/) { dm_txt_check($keyid, $1); - debug "verifytag m ok"; + printdebug "verifytag m ok\n"; return; } else { die; @@ -626,7 +613,7 @@ sub verifytag () { } sub checksuite () { - debug "checksuite ($suitesfile)"; + printdebug "checksuite ($suitesfile)\n"; open SUITES, "<", $suitesfile or die $!; while () { chomp; @@ -660,7 +647,7 @@ sub checktagnoreplay () { if (!defined $ENV{GIT_DIR}) { # Nothing to overwrite so the FRESHREPO and NOFFCHECK were # pointless. Oh well. - debug "checktagnoreplay - no garbage, ok"; + printdebug "checktagnoreplay - no garbage, ok\n"; return; } @@ -673,20 +660,20 @@ sub checktagnoreplay () { $? and die "$branch $?"; if (!length) { # No such branch - NOFFCHECK was unnecessary. Oh well. - debug "checktagnoreplay - not FRESHREPO, new branch, ok"; + printdebug "checktagnoreplay - not FRESHREPO, new branch, ok\n"; return; } m/^(\w+)\n$/ or die "$branch $_ ?"; $onlyreferring = $1; - debug "checktagnoreplay - not FRESHREPO,". - " checking for overwriting refs/$branch=$onlyreferring"; + printdebug "checktagnoreplay - not FRESHREPO,". + " checking for overwriting refs/$branch=$onlyreferring\n"; } my @problems; git_for_each_tag_referring($onlyreferring, sub { my ($objid,$fullrefname,$tagname) = @_; - debug "checktagnoreplay - overwriting $fullrefname=$objid"; + printdebug "checktagnoreplay - overwriting $fullrefname=$objid\n"; my $supers = $supersedes{$fullrefname}; if (!defined $supers) { push @problems, "does not supersede $fullrefname"; @@ -704,7 +691,7 @@ sub checktagnoreplay () { join("; ", @problems). "\n"; } - debug "checktagnoreply - all ok" + printdebug "checktagnoreply - all ok\n" } sub tagh1 ($) { @@ -716,7 +703,7 @@ sub tagh1 ($) { } sub checks () { - debug "checks"; + printdebug "checks\n"; tagh1('type') eq 'commit' or reject "tag refers to wrong kind of object"; tagh1('object') eq $commit or reject "tag refers to wrong commit"; @@ -725,7 +712,7 @@ sub checks () { my $v = $version; $v =~ y/~:/_%/; - debug "translated version $v"; + printdebug "translated version $v\n"; $tagname eq "debian/$v" or die; lockrealtree(); @@ -738,7 +725,7 @@ sub checks () { checksuite(); # check that our ref is being fast-forwarded - debug "oldcommit $oldcommit"; + printdebug "oldcommit $oldcommit\n"; if (!($policy & NOFFCHECK) && $oldcommit =~ m/[^0]/) { $?=0; $!=0; my $mb = `git merge-base $commit $oldcommit`; chomp $mb; @@ -771,14 +758,14 @@ sub onwardpush () { push @cmd, qw(--force) if $policy & NOFFCHECK; push @cmd, "$commit:refs/dgit/$suite", "$tagval:refs/tags/$tagname"; - debugcmd @cmd; + debugcmd '+',@cmd; $!=0; my $r = system @cmd; !$r or die "onward push to $destrepo failed: $r $!"; } sub stunthook () { - debug "stunthook in $workrepo"; + printdebug "stunthook in $workrepo\n"; chdir $workrepo or die "chdir $workrepo: $!"; mkdir "dgit-tmp" or $!==EEXIST or die $!; readupdates(); @@ -786,7 +773,7 @@ sub stunthook () { verifytag(); checks(); onwardpush(); - debug "stunthook done."; + printdebug "stunthook done.\n"; } #----- git-upload-pack ----- @@ -804,7 +791,7 @@ sub fixmissing__git_upload_pack () { sub main__git_upload_pack () { my $lfh = locksometree($destrepo); - debug "git-upload-pack in $destrepo"; + printdebug "git-upload-pack in $destrepo\n"; chdir $destrepo or die "$destrepo: $!"; close $lfh; runcmd qw(git upload-pack), "."; @@ -859,12 +846,12 @@ sub mode_ssh () { if (stat_exists realdestrepo) { $destrepo = realdestrepo; } else { - debug " fixmissing $funcn"; + printdebug " fixmissing $funcn\n"; my $fixfunc = $main::{"fixmissing__$funcn"}; &$fixfunc; } - debug " running main $funcn"; + printdebug " running main $funcn\n"; &$mainfunc; } @@ -896,16 +883,15 @@ sub parseargsdispatch () { delete $ENV{'GIT_PREFIX'}; # sets these and they mess things up if ($ENV{'DGIT_DRS_DEBUG'}) { - $debug='='; - open DEBUG, ">&STDERR" or die $!; + enabledebug(); } if ($ARGV[0] eq '--pre-receive-hook') { - if ($debug) { - $debug.="="; - debug "in stunthook @ARGV"; + if ($debuglevel) { + $debugprefix.="="; + printdebug "in stunthook @ARGV\n"; foreach my $k (sort keys %ENV) { - debug "$k=$ENV{$k}" if $k =~ m/^DGIT/; + printdebug "$k=$ENV{$k}\n" if $k =~ m/^DGIT/; } } shift @ARGV; -- 2.30.2