dgit-repos-server: add debugging output

diff --git a/dgit-repos-server b/dgit-repos-server
index c17ae80d2bfe94d754907a2e476f219c398c6af3..3a471a1d741718f9cff003d38f5bc2b560af97cb 100755 (executable)
--- a/dgit-repos-server
+++ b/dgit-repos-server
@@ -86,6 +86,8 @@ use POSIX;
 use Fcntl qw(:flock);
 use File::Path qw(rmtree);
 
 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;
 our $package_re = '[0-9a-z][-+.0-9a-z]+';
 
 our $func;


@@ -97,19 +99,26 @@ our $destrepo;
 our $workrepo;
 our $keyrings;
 our @lockfhs;
 our $workrepo;
 our $keyrings;
 our @lockfhs;

+our $debug='';

 
 #----- utilities -----
 
 
 #----- utilities -----
 

+sub debug {
+    print DEBUG "$debug @_\n";
+}
+

 sub acquirelock ($$) {
     my ($lock, $must) = @_;
     my $fh;
 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) {
     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;
        }
        if (!stat $lock) {
            next if $! == ENOENT;


@@ -141,10 +150,18 @@ sub mkrepotmp () {
 }
 
 sub reject ($) {
 }
 
 sub reject ($) {

-    die "dgit-repos-server: reject: $_[0]\n";
+    my ($why) = @_;
+    debug " rejecting $why";
+    die "dgit-repos-server: reject: $why\n";

 }
 
 sub runcmd {
 }
 
 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;
     $!=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;
     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;
 
 }
 
 sub maybeinstallprospective () {
     return if $destrepo eq $realdestrepo;
 

+    debug " show-ref ...";
+

     my $child = open SR, "-|";
     defined $child or die $!;
     if (!$child) {
     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;
     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' :
        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 () {
 our ($version, %tagh);
 
 sub readupdates () {

+    debug " updates ...";

     while (<STDIN>) {
     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/)}) {
        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;
 
     die unless defined $tagname;
     die unless defined $suite;

+    debug " updates ok.";

 }
 
 sub parsetag () {
 }
 
 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 $!;
     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 $!;
     T->error and die $!;
     close PT or die $!;
     close DS or die $!;

+    debug " parsetag ok.";

 }
 
 sub checksig_keyring ($) {
 }
 
 sub checksig_keyring ($) {


@@ -291,6 +318,8 @@ sub checksig_keyring ($) {
 
     my $ok = undef;
 
 
     my $ok = undef;
 

+    debug " checksig keyring $keyringfile...";
+

     open P, "-|", (qw(gpgv --status-fd=1 --keyring),
                   $keyringfile,
                   qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext))
     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;
     while (<P>) {
        next unless s/^\[GNUPG:\]: //;
        chomp or die;

+       debug " checksig| $_";

        my @l = split / /, $_;
        if ($l[0] eq 'NO_PUBKEY') {
            last;
        my @l = split / /, $_;
        if ($l[0] eq 'NO_PUBKEY') {
            last;


@@ -312,11 +342,14 @@ sub checksig_keyring ($) {
     }
     close P;
 
     }
     close P;
 

+    debug sprintf " checksig ok=%d", !!$ok;
+

     return $ok;
 }
 
 sub dm_txt_check ($$) {
     my ($keyid, $dmtxtfn) = @_;
     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
     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/\,//;
        # in allow field...
        s/\([^()]+\)//;
        s/\,//;

+       chomp or die;
+       debug " dm_txt_check allow| $_";

        foreach my $p (split /\s+/) {
        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 $!;
        }
     }
     DT->error and die $!;


@@ -342,13 +381,16 @@ sub dm_txt_check ($$) {
 
 sub verifytag () {
     foreach my $kas (split /:/, $keyrings) {
 
 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$/) {
        $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);
                return; # yay
            } elsif ($kas =~ m/^m([^,]+)$/) {
                dm_txt_check($keyid, $1);

+               debug "verifytag m ok";

                return;
            } else {
                die;
                return;
            } else {
                die;


@@ -359,6 +401,7 @@ sub verifytag () {
 }
 
 sub checksuite () {
 }
 
 sub checksuite () {

+    debug "checksuite";

     open SUITES, "<", $suitesfile or die $!;
     while (<SUITES>) {
        chomp;
     open SUITES, "<", $suitesfile or die $!;
     while (<SUITES>) {
        chomp;


@@ -372,6 +415,7 @@ sub checksuite () {
 }
 
 sub checks () {
 }
 
 sub checks () {

+    debug "checks";

     checksuite();
     tagh1('type') eq 'commit' or die;
     tagh1('object') eq $commit or die;
     checksuite();
     tagh1('type') eq 'commit' or die;
     tagh1('object') eq $commit or die;


@@ -379,9 +423,12 @@ sub checks () {
 
     my $v = $version;
     $v =~ y/~:/_%/;
 
     my $v = $version;
     $v =~ y/~:/_%/;

+
+    debug "translated version $v";

     $tagname eq "debian/$v" or die;
 
     # check that our ref is being fast-forwarded
     $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;
     if ($oldcommit =~ m/[^0]/) {
        $?=0; $!=0; my $mb = `git merge-base $commit $oldcommit`;
        chomp $mb;


@@ -399,6 +446,7 @@ sub onwardpush () {
 }      
 
 sub stunthook () {
 }      
 
 sub stunthook () {

+    debug "stunthook";

     chdir $workrepo or die "chdir $workrepo: $!";
     mkdir "dgit-tmp" or $!==EEXIST or die $!;
     readupdates();
     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;
 
 sub parseargsdispatch () {
     die unless @ARGV;
 

+    if ($ENV{'DGIT_DRS_DEBUG'}) {
+       $debug='=';
+       open DEBUG, ">&STDERR" or die $!;
+    }
+

     if ($ARGV[0] eq '--pre-receive-hook') {
     if ($ARGV[0] eq '--pre-receive-hook') {

+       if ($debug) { $debug.="="; }

        shift @ARGV;
        @ARGV == 1 or die;
        $package = shift @ARGV;
        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: $!";
        $destrepo = $realdestrepo;
     } else {
        $! == ENOENT or die "stat dest repo $destrepo: $!";

+       debug " fixmissing $funcn";

        my $fixfunc = $main::{"fixmissing__$funcn"};
        &$fixfunc;
     }
 
        my $fixfunc = $main::{"fixmissing__$funcn"};
        &$fixfunc;
     }
 

+    debug " running main $funcn";

     &$mainfunc;
 }
 
     &$mainfunc;
 }