X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=5ea9c26613432c1bbb95fcc4f86f2fa1351c410a;hb=1d7cbdc7bef6b4752ba0d46b22dd77136c5b3efb;hp=d31b9b1db9d306338896fa6dfae01a4b719fd672;hpb=589cbeb80f59adb3c6c1b0bd1c74b9e4b0246950;p=dgit.git

diff --git a/dgit b/dgit
index d31b9b1d..5ea9c266 100755
--- a/dgit
+++ b/dgit
@@ -46,6 +46,7 @@ our $noquilt = 0;
 our $existing_package = 'dpkg';
 our $cleanmode = 'dpkg-source';
 our $we_are_responder;
+our $initiator_tempdir;
 
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
@@ -115,11 +116,13 @@ sub dscfn ($) {
 sub changesopts () { return @changesopts[1..$#changesopts]; }
 
 our $us = 'dgit';
-our $debugprefix = ' ';
+our $debugprefix = '';
 
 sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
 
-sub fail { die "$us: @_\n"; }
+sub fail { 
+    die $us.($we_are_responder ? " (build host)" : "").": @_\n";
+}
 
 sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
 
@@ -179,7 +182,6 @@ sub changedir ($) {
 sub badproto ($$) {
     my ($fh, $m) = @_;
     fail "connection lost: $!" if $fh->error;
-    fail "connection terminated" if $fh->eof;
     fail "protocol violation; $m not expected";
 }
 
@@ -205,17 +207,18 @@ sub protocol_send_file ($$) {
 	my $d;
 	my $got = read PF, $d, 65536;
 	die "$ourfn: $!" unless defined $got;
-	last if $got;
+	last if !$got;
 	print $fh "data-block ".length($d)."\n" or die $!;
-	print $d or die $!;
+	print $fh $d or die $!;
     }
+    PF->error and die "$ourfn $!";
     print $fh "data-end\n" or die $!;
     close PF;
 }
 
 sub protocol_read_bytes ($$) {
     my ($fh, $nbytes) = @_;
-    $nbytes =~ m/^\d{1,6}$/ or badproto \*RO, "bad byte count";
+    $nbytes =~ m/^[1-9]\d{0,5}$/ or badproto \*RO, "bad byte count";
     my $d;
     my $got = read $fh, $d, $nbytes;
     $got==$nbytes or badproto $fh, "eof during data block";
@@ -224,17 +227,19 @@ sub protocol_read_bytes ($$) {
 
 sub protocol_receive_file ($$) {
     my ($fh, $ourfn) = @_;
+    printdebug "() $ourfn\n";
     open PF, ">", $ourfn or die "$ourfn: $!";
     for (;;) {
 	my ($y,$l) = protocol_expect {
-	    m/^data-block (.*})$|data-end$/;
-	    length $1 ? (1,$1) : (0);
+	    m/^data-block (.*)$/ ? (1,$1) :
+	    m/^data-end$/ ? (0,) :
+	    ();
 	} $fh;
 	last unless $y;
-	my $d = protocol_read_bytes $fh, $1;
+	my $d = protocol_read_bytes $fh, $l;
 	print PF $d or die $!;
     }
-    printdebug "received into $ourfn\n";
+    close PF or die $!;
 }
 
 #---------- remote protocol support, responder ----------
@@ -244,7 +249,7 @@ sub responder_send_command ($) {
     return unless $we_are_responder;
     # called even without $we_are_responder
     printdebug "<< $command\n";
-    print $command, "\n" or die $!;
+    print PO $command, "\n" or die $!;
 }    
 
 sub responder_send_file ($$) {
@@ -252,7 +257,7 @@ sub responder_send_file ($$) {
     return unless $we_are_responder;
     printdebug "[[ $keyword $ourfn\n";
     responder_send_command "file $keyword";
-    protocol_send_file \*STDOUT, $ourfn;
+    protocol_send_file \*PO, $ourfn;
 }
 
 sub responder_receive_files ($@) {
@@ -261,9 +266,9 @@ sub responder_receive_files ($@) {
     printdebug "]] $keyword @ourfns\n";
     responder_send_command "want $keyword";
     foreach my $fn (@ourfns) {
-	protocol_receive_file \*STDIN, $fn;
+	protocol_receive_file \*PI, $fn;
     }
-    protocol_expect { m/^files-end$/ } \*STDIN;
+    protocol_expect { m/^files-end$/ } \*PI;
 }
 
 #---------- remote protocol support, initiator ----------
@@ -279,7 +284,7 @@ sub progress {
     if ($we_are_responder) {
 	my $m = join '', @_;
 	responder_send_command "progress ".length($m) or die $!;
-	print $m or die $!;
+	print PO $m or die $!;
     } else {
 	print @_, "\n";
     }
@@ -1108,7 +1113,7 @@ sub push_parse_changelog ($) {
     my ($clogpfn) = @_;
 
     my $clogp = Dpkg::Control::Hash->new();
-    $clogp->load($clogpfn);
+    $clogp->load($clogpfn) or die;
 
     $package = getfield $clogp, 'Source';
     my $cversion = getfield $clogp, 'Version';
@@ -1126,13 +1131,13 @@ sub push_parse_dsc ($$$) {
     my $dversion = getfield $dsc, 'Version';
     my $dscpackage = getfield $dsc, 'Source';
     ($dscpackage eq $package && $dversion eq $cversion) or
-	fail "$dsc is for $dscpackage $dversion".
+	fail "$dscfn is for $dscpackage $dversion".
 	    " but debian/changelog is for $package $cversion";
 }
 
-sub push_mktag ($$$$$$$$) {
+sub push_mktag ($$$$$$$) {
     my ($head,$clogp,$tag,
-	$dsc,$dscfn,
+	$dscfn,
 	$changesfile,$changesfilewhat,
 	$tfn) = @_;
 
@@ -1147,6 +1152,7 @@ sub push_mktag ($$$$$$$$) {
     }
 
     my $cversion = getfield $clogp, 'Version';
+    my $clogsuite = getfield $clogp, 'Distribution';
 
     # We make the git tag by hand because (a) that makes it easier
     # to control the "tagger" (b) we can do remote signing
@@ -1158,7 +1164,7 @@ type commit
 tag $tag
 tagger $authline
 
-$package release $cversion for $csuite [dgit]
+$package release $cversion for $clogsuite [dgit]
 END
     close TO or die $!;
 
@@ -1259,13 +1265,14 @@ sub dopush () {
     }
 
     responder_send_file('changes',$changesfile);
+    responder_send_command("param head $head");
 
     my $tfn = sub { ".git/dgit/tag$_[0]"; };
     my ($tagobjfn) =
 	$we_are_responder
 	? responder_receive_files('signed-tag', $tfn->('.signed.tmp'))
 	: push_mktag($head,$clogp,$tag,
-		     $dsc,"../$dscfn",
+		     "../$dscfn",
 		     $changesfile,$changesfile,
 				 $tfn);
 
@@ -1416,23 +1423,39 @@ sub cmd_remote_push_responder {
     @ARGV = @ARGV[$nrargs..$#ARGV];
     die unless @rargs;
     my ($dir) = @rargs;
-    changedir $dir;
-    $we_are_responder = 1;
     $debugprefix = ' ';
+    $we_are_responder = 1;
+
+    open PI, "<&STDIN" or die $!;
+    open STDIN, "/dev/null" or die $!;
+    open PO, ">&STDOUT" or die $!;
+    autoflush PO 1;
+    open STDOUT, ">&STDERR" or die $!;
     autoflush STDOUT 1;
+
     responder_send_command("dgit-remote-push-ready");
+
+    changedir $dir;
     &cmd_push;
 }
 
 our $i_tmp;
+our $i_child_pid;
 
 sub i_cleanup {
     local ($@);
-    return unless defined $i_tmp;
-    changedir "/";
-    eval { rmtree $i_tmp; };
+    if ($i_child_pid) {
+	printdebug "(killing remote child $i_child_pid)\n";
+	kill 15, $i_child_pid;
+    }
+    if (defined $i_tmp && !defined $initiator_tempdir) {
+	changedir "/";
+	eval { rmtree $i_tmp; };
+    }
 }
 
+END { i_cleanup(); }
+
 sub i_method {
     my ($base,$selector,@args) = @_;
     $selector =~ s/\-/_/g;
@@ -1457,21 +1480,34 @@ sub cmd_rpush {
     push @rdgit, @ARGV;
     my @cmd = (@ssh, $host, shellquote @rdgit);
     printcmd \*DEBUG,$debugprefix."+",@cmd;
-    eval {
+
+    if (defined $initiator_tempdir) {
+	rmtree $initiator_tempdir;
+	mkdir $initiator_tempdir, 0700 or die "$initiator_tempdir: $!";
+	$i_tmp = $initiator_tempdir;
+    } else {
 	$i_tmp = tempdir();
-	my $pid = open2(\*RO, \*RI, @cmd);
-	changedir $i_tmp;
-	initiator_expect { m/^dgit-remote-push-ready/ };
-	for (;;) {
-	    my ($icmd,$iargs) = initiator_expect {
-		m/^(\S+)(?: (.*))?$/;
-		($1,$2);
-	    };
-	    i_method "i_resp", $icmd, $iargs;
-	}
-    };
+    }
+    $i_child_pid = open2(\*RO, \*RI, @cmd);
+    changedir $i_tmp;
+    initiator_expect { m/^dgit-remote-push-ready/ };
+    for (;;) {
+	my ($icmd,$iargs) = initiator_expect {
+	    m/^(\S+)(?: (.*))?$/;
+	    ($1,$2);
+	};
+	i_method "i_resp", $icmd, $iargs;
+    }
+
+    my $pid = $i_child_pid;
+    $i_child_pid = undef; # prevents killing some other process with same pid
+    printdebug "waiting for remote child $pid...";
+    my $got = waitpid $pid, 0;
+    die $! unless $got == $pid;
+    die "remote child failed $?" if $?;
+
     i_cleanup();
-    die $@;
+    exit 0;
 }
 
 sub i_resp_progress ($) {
@@ -1495,8 +1531,8 @@ sub i_resp_file ($) {
 
 our %i_param;
 
-sub i_param ($) {
-    $_[0] =~ m/^(\S+) (.*)$/;
+sub i_resp_param ($) {
+    $_[0] =~ m/^(\S+) (.*)$/ or badproto \*RO, "bad param spec";
     $i_param{$1} = $2;
 }
 
@@ -1519,12 +1555,13 @@ sub i_localname_parsed_changelog { return "remote-changelog.822"; }
 sub i_localname_changes { return "remote.changes"; }
 sub i_localname_dsc {
     ($i_clogp, $i_version, $i_tag, $i_dscfn) =
-	push_parse_changelog 'remote-changelog.822';
+	push_parse_changelog "$i_tmp/remote-changelog.822";
     die if $i_dscfn =~ m#/|^\W#;
     return $i_dscfn;
 }
 
 sub i_want_signed_tag {
+    printdebug Dumper(\%i_param, $i_dscfn);
     defined $i_param{'head'} && defined $i_dscfn
 	or badproto \*RO, "sequencing error";
     my $head = $i_param{'head'};
@@ -1533,7 +1570,7 @@ sub i_want_signed_tag {
     push_parse_dsc $i_dscfn, 'remote dsc', 
 
     push_mktag $head, $i_clogp, $i_tag,
-        $dsc, $i_dscfn,
+        $i_dscfn,
         'remote.changes', 'remote changes',
         'tag.tag';
 
@@ -1767,6 +1804,11 @@ sub parseopts () {
 	    } elsif (m/^--existing-package=(.*)/s) {
 		push @ropts, $_;
 		$existing_package = $1;
+	    } elsif (m/^--initiator-tempdir=(.*)/s) {
+		$initiator_tempdir = $1;
+		$initiator_tempdir =~ m#^/# or
+		    badusage "--initiator-tempdir must be used specify an".
+		        " absolute, not relative, directory."
 	    } elsif (m/^--distro=(.*)/s) {
 		push @ropts, $_;
 		$idistro = $1;