chiark / gitweb /
Debugging: Use Dgit.pm's facilities in dgit-repos-server
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Sat, 2 May 2015 19:06:48 +0000 (20:06 +0100)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Sun, 31 May 2015 10:54:09 +0000 (11:54 +0100)
infra/dgit-repos-server

index 8e939d0..63f9aac 100755 (executable)
@@ -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 (<SR>) {
        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 (<STDIN>) {
        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 (<P>) {
        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 (<DT>) {
        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 (<SUITES>) {
        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;