summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xinfra/dgit-repos-server112
1 files changed, 49 insertions, 63 deletions
diff --git a/infra/dgit-repos-server b/infra/dgit-repos-server
index 8e939d0..63f9aac 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 (<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;