X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=e80faf3ec8f7f56a90582950ad43565945b621b6;hp=be9045048bc6ff282755ea68fe105e14e9232d94;hb=7684f83e49bdc4d883e682abd922a7722cf996c4;hpb=75227f50be6aae4386166de507af1d7fcfcd4823 diff --git a/dgit b/dgit index be904504..e80faf3e 100755 --- a/dgit +++ b/dgit @@ -18,6 +18,7 @@ # along with this program. If not, see . use strict; +$SIG{__WARN__} = sub { die $_[0]; }; use IO::Handle; use Data::Dumper; @@ -98,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'; @@ -131,7 +129,7 @@ sub dscfn ($) { } our $us = 'dgit'; -our $debugprefix = ''; +initdebug(''); our @end; END { @@ -159,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)" : "").": "; @@ -378,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 ($!) { @@ -413,7 +386,7 @@ sub failedcmd { } sub runcmd { - printcmd(\*DEBUG,$debugprefix."+",@_) if $debug>0; + debugcmd "+",@_; $!=0; $?=0; failedcmd @_ if system @_; } @@ -431,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; } @@ -546,7 +519,8 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit-distro.test-dummy.git-url' => "$td/git", 'dgit-distro.test-dummy.git-host' => "git", 'dgit-distro.test-dummy.git-path' => "$td/git", - 'dgit-distro.test-dummy.archive-query' => "dummycat:$td/aq", + 'dgit-distro.test-dummy.archive-query' => "ftpmasterapi:", + 'dgit-distro.test-dummy.archive-query-url' => "file://$td/aq/", 'dgit-distro.test-dummy.mirror' => "file://$td/mirror/", 'dgit-distro.test-dummy.upload-host' => 'test-dummy', ); @@ -557,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) { @@ -934,9 +908,9 @@ sub sshpsql ($$$) { my @rows; my @cmd = (access_cfg_ssh, $userhost, access_runeinfo("ssh-psql $runeinfo"). - " export LANG=C;". + " 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; @@ -1068,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; @@ -1502,8 +1476,8 @@ sub clone ($) { } fetch_from_archive() or no_such_package; my $vcsgiturl = $dsc->{'Vcs-Git'}; - $vcsgiturl =~ s/\s+-b\s+\S+//g; if (length $vcsgiturl) { + $vcsgiturl =~ s/\s+-b\s+\S+//g; runcmd @git, qw(remote add vcs-git), $vcsgiturl; } runcmd @git, qw(reset --hard), lrref(); @@ -1528,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) { @@ -1718,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) { @@ -2018,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; @@ -2723,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"; } @@ -2809,7 +2784,7 @@ sub parseopts () { } elsif (m/^--no-rm-on-error$/s) { push @ropts, $_; $rmonerror = 0; - } elsif (m/^--deliberately-($suite_re)$/s) { + } elsif (m/^--deliberately-($deliberately_re)$/s) { push @ropts, $_; push @deliberatelies, $&; } else { @@ -2827,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;