X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=8db03b3f5ee8737b55a50b1c8c585c66c0ea1ec0;hp=1f1c425d1f95eaded35208faa49946c9b080b0de;hb=76983699d71d7eaa73cd28ad5315fcd53620fb42;hpb=85967df816321c56d70cbfda75994285975347d1 diff --git a/dgit b/dgit index 1f1c425d..8db03b3f 100755 --- a/dgit +++ b/dgit @@ -99,9 +99,6 @@ our %opts_opt_cmdonly = ('gpg' => 1); our $keyid; -our $debug = 0; -open DEBUG, ">/dev/null" or die $!; - autoflush STDOUT 1; our $remotename = 'dgit'; @@ -132,7 +129,7 @@ sub dscfn ($) { } our $us = 'dgit'; -our $debugprefix = ''; +initdebug(''); our @end; END { @@ -160,8 +157,6 @@ sub waitstatusmsg () { } } -sub printdebug { print DEBUG $debugprefix, @_ or die $!; } - sub fail { my $s = "@_\n"; my $prefix = $us.($we_are_responder ? " (build host)" : "").": "; @@ -379,29 +374,6 @@ sub url_get { our ($dscdata,$dscurl,$dsc,$dsc_checked,$skew_warning_vsn); -sub shellquote { - my @out; - local $_; - foreach my $a (@_) { - $_ = $a; - if (m{[^-=_./0-9a-z]}i) { - s{['\\]}{'\\$&'}g; - push @out, "'$_'"; - } else { - push @out, $_; - } - } - return join ' ', @out; -} - -sub printcmd { - my $fh = shift @_; - my $intro = shift @_; - print $fh $intro," " or die $!; - print $fh shellquote @_ or die $!; - print $fh "\n" or die $!; -} - sub failedcmd { { local ($!); printcmd \*STDERR, "$us: failed command:", @_ or die $!; }; if ($!) { @@ -414,7 +386,7 @@ sub failedcmd { } sub runcmd { - printcmd(\*DEBUG,$debugprefix."+",@_) if $debug>0; + debugcmd "+",@_; $!=0; $?=0; failedcmd @_ if system @_; } @@ -432,16 +404,16 @@ sub printdone { sub cmdoutput_errok { die Dumper(\@_)." ?" if grep { !defined } @_; - printcmd(\*DEBUG,$debugprefix."|",@_) if $debug>0; + debugcmd "|",@_; open P, "-|", @_ or die $!; my $d; $!=0; $?=0; { local $/ = undef; $d =

; } die $! if P->error; - if (!close P) { printdebug "=>!$?\n" if $debug>0; return undef; } + if (!close P) { printdebug "=>!$?\n"; return undef; } chomp $d; $d =~ m/^.*/; - printdebug "=> \`$&'",(length $' ? '...' : ''),"\n" if $debug>0; #'; + printdebug "=> \`$&'",(length $' ? '...' : ''),"\n" if $debuglevel>0; #'; return $d; } @@ -559,7 +531,7 @@ sub cfg { my @cmd = (@git, qw(config --), $c); my $v; { - local ($debug) = $debug-1; + local ($debuglevel) = $debuglevel-2; $v = cmdoutput_errok @cmd; }; if ($?==0) { @@ -938,7 +910,7 @@ sub sshpsql ($$$) { access_runeinfo("ssh-psql $runeinfo"). " export LC_MESSAGES=C; export LC_CTYPE=C;". " ".shellquote qw(psql -A), $dbname, qw(-c), $sql); - printcmd(\*DEBUG,$debugprefix."|",@cmd) if $debug>0; + debugcmd "|",@cmd; open P, "-|", @cmd or die $!; while (

) { chomp or die; @@ -1070,9 +1042,9 @@ sub get_archive_dsc () { " archive told us to expect $digest"; } my $dscfh = new IO::File \$dscdata, '<' or die $!; - printdebug Dumper($dscdata) if $debug>1; + printdebug Dumper($dscdata) if $debuglevel>1; $dsc = parsecontrolfh($dscfh,$dscurl,1); - printdebug Dumper($dsc) if $debug>1; + printdebug Dumper($dsc) if $debuglevel>1; my $fmt = getfield $dsc, 'Format'; fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt}; $dsc_checked = !!$digester; @@ -1530,7 +1502,7 @@ sub pull () { sub check_not_dirty () { return if $ignoredirty; my @cmd = (@git, qw(diff --quiet HEAD)); - printcmd(\*DEBUG,$debugprefix."+",@cmd) if $debug>0; + debugcmd "+",@cmd; $!=0; $?=0; system @cmd; return if !$! && !$?; if (!$! && $?==256) { @@ -1720,9 +1692,9 @@ sub dopush () { $dscpath =~ m#^/# ? $dscpath : "../../../$dscpath"; my ($tree,$dir) = mktree_in_ud_from_only_subdir(); changedir '../../../..'; - my $diffopt = $debug>0 ? '--exit-code' : '--quiet'; + my $diffopt = $debuglevel>0 ? '--exit-code' : '--quiet'; my @diffcmd = (@git, qw(diff), $diffopt, $tree); - printcmd \*DEBUG,$debugprefix."+",@diffcmd; + debugcmd "+",@diffcmd; $!=0; $?=0; my $r = system @diffcmd; if ($r) { @@ -2020,7 +1992,7 @@ sub cmd_rpush { push @rdgit, qw(remote-push-build-host), (scalar @rargs), @rargs; push @rdgit, @ARGV; my @cmd = (@ssh, $host, shellquote @rdgit); - printcmd \*DEBUG,$debugprefix."+",@cmd; + debugcmd "+",@cmd; if (defined $initiator_tempdir) { rmtree $initiator_tempdir; @@ -2725,6 +2697,7 @@ sub cmd_archive_api_query { badusage "need only 1 subpath argument" unless @ARGV==1; my ($subpath) = @ARGV; my @cmd = archive_api_query_cmd($subpath); + debugcmd ">",@cmd; exec @cmd or fail "exec curl: $!\n"; } @@ -2829,9 +2802,8 @@ sub parseopts () { cmd_help(); } elsif (s/^-D/-/) { push @ropts, $&; - open DEBUG, ">&STDERR" or die $!; - autoflush DEBUG 1; - $debug++; + $debuglevel++; + enabledebug(); } elsif (s/^-N/-/) { push @ropts, $&; $new_package=1;