X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=b6d815870165667d72513da46194b0dea42c2dfc;hb=863475c001c7846fe4de4310f517207bd8178871;hp=448412e242f218c12a3c32f0ce5efb724d86d7c1;hpb=b250e873041896930e9e1d2f92df580f5eb91529;p=dgit.git diff --git a/dgit b/dgit index 448412e2..b6d81587 100755 --- a/dgit +++ b/dgit @@ -24,6 +24,7 @@ use Data::Dumper; use LWP::UserAgent; use Dpkg::Control::Hash; use File::Path; +use File::Temp qw(tempdir); use File::Basename; use Dpkg::Version; use POSIX; @@ -112,6 +113,9 @@ sub dscfn ($) { sub changesopts () { return @changesopts[1..$#changesopts]; } our $us = 'dgit'; +our $debugprefix = ' '; + +sub printdebug { print DEBUG $debugprefix, @_ or die $!; } sub fail { die "$us: @_\n"; } @@ -132,17 +136,17 @@ sub fetchspec () { # remote push initiator/responder protocol: # < dgit-remote-push-ready [optional extra info ignored by old initiators] # -# > file begin parsed-changelog +# > file parsed-changelog # [indicates that output of dpkg-parsechangelog follows] # > data-block NBYTES # > [NBYTES bytes of data (no newline)] # [maybe some more blocks] # > data-end # -# > file begin dsc +# > file dsc # [etc] # -# > file begin changes +# > file changes # [etc] # # > param head HEAD @@ -176,7 +180,13 @@ sub protocol_expect (&$) { local $_; $_ = <$fh>; defined && chomp or badproto $fh, "eof"; - return if &$match; + if (wantarray) { + my @r = &$match; + return @r if @r; + } else { + my $r = &$match; + return $r if $r; + } badproto $fh, "\`$_'"; } @@ -208,11 +218,15 @@ sub protocol_receive_file ($$) { my ($fh, $ourfn) = @_; open PF, ">", $ourfn or die "$ourfn: $!"; for (;;) { - protocol_expect { m/^data-block (.*})$|data-end$/ } \*STDIN; - length $1 or last; + my ($y,$l) = protocol_expect { + m/^data-block (.*})$|data-end$/; + length $1 ? (1,$1) : (0); + } \*STDIN; + last unless $y; my $d = protocol_read_bytes \*STDIN, $1; print PF $d or die $!; } + printdebug "received into $ourfn\n"; } #---------- remote protocol support, responder ---------- @@ -221,20 +235,22 @@ sub responder_send_command ($) { my ($command) = @_; return unless $we_are_responder; # called even without $we_are_responder - print DEBUG "<< $command\n"; + printdebug "<< $command\n"; print $command, "\n" or die $!; } sub responder_send_file ($$) { my ($keyword, $ourfn) = @_; return unless $we_are_responder; - responder_send_command "file-begin $keyword"; + printdebug "[[ $keyword $ourfn\n"; + responder_send_command "file $keyword"; protocol_send_file \*STDOUT, $ourfn; } sub responder_receive_files ($@) { my ($keyword, @ourfns) = @_; die unless $we_are_responder; + printdebug "]] $keyword @ourfns\n"; responder_send_command "want $keyword"; foreach my $fn (@ourfns) { protocol_receive_file \*STDIN, $fn; @@ -314,7 +330,7 @@ sub failedcmd { } sub runcmd { - printcmd(\*DEBUG,"+",@_) if $debug>0; + printcmd(\*DEBUG,$debugprefix."+",@_) if $debug>0; $!=0; $?=0; failedcmd @_ if system @_; } @@ -329,16 +345,16 @@ sub printdone { sub cmdoutput_errok { die Dumper(\@_)." ?" if grep { !defined } @_; - printcmd(\*DEBUG,"|",@_) if $debug>0; + printcmd(\*DEBUG,$debugprefix."|",@_) if $debug>0; open P, "-|", @_ or die $!; my $d; $!=0; $?=0; { local $/ = undef; $d =
; }
die $! if P->error;
- if (!close P) { print DEBUG "=>!$?\n" if $debug>0; return undef; }
+ if (!close P) { printdebug "=>!$?\n" if $debug>0; return undef; }
chomp $d;
$d =~ m/^.*/;
- print DEBUG "=> \`$&'",(length $' ? '...' : ''),"\n" if $debug>0; #';
+ printdebug "=> \`$&'",(length $' ? '...' : ''),"\n" if $debug>0; #';
return $d;
}
@@ -349,7 +365,7 @@ sub cmdoutput {
}
sub dryrun_report {
- printcmd(\*STDERR,"#",@_);
+ printcmd(\*STDERR,$debugprefix."#",@_);
}
sub runcmd_ordryrun {
@@ -630,9 +646,9 @@ sub get_archive_dsc () {
next;
}
my $dscfh = new IO::File \$dscdata, '<' or die $!;
- print DEBUG Dumper($dscdata) if $debug>1;
+ printdebug Dumper($dscdata) if $debug>1;
$dsc = parsecontrolfh($dscfh,$dscurl, allow_pgp=>1);
- print DEBUG Dumper($dsc) if $debug>1;
+ printdebug Dumper($dsc) if $debug>1;
my $fmt = getfield $dsc, 'Format';
fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt};
return;
@@ -904,7 +920,7 @@ sub fetch_from_archive () {
} else {
die "$lrref_fn $!";
}
- print DEBUG "previous reference hash=$lastpush_hash\n";
+ printdebug "previous reference hash=$lastpush_hash\n";
my $hash;
if (defined $dsc_hash) {
fail "missing git history even though dsc has hash -".
@@ -938,7 +954,7 @@ Package not found in the archive, but has allegedly been pushed using dgit.
$later_warning_msg
END
} else {
- print DEBUG "nothing found!\n";
+ printdebug "nothing found!\n";
if (defined $skew_warning_vsn) {
print STDERR <