X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=b551eacd1e9c7a6fa73d49a612b72e1e088efc13;hp=66f08c1d87eb6ed1b71c7c1941742cf146ad29da;hb=20d213b07642bab55c3727532696623cb74ecee6;hpb=01da2f9b6a9eec44d0072b281bf011e74ab22605

diff --git a/dgit b/dgit
index 66f08c1d..b551eacd 100755
--- a/dgit
+++ b/dgit
@@ -28,6 +28,7 @@ use File::Basename;
 use Dpkg::Version;
 use POSIX;
 use IPC::Open2;
+use File::Temp;
 
 our $our_version = 'UNRELEASED'; ###substituted###
 
@@ -125,7 +126,7 @@ sub fetchspec () {
     return  "+".rrref().":".lrref();
 }
 
-our $ua;
+#---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:
 #  < dgit-remote-push-ready [optional extra info ignored by old initiators]
@@ -160,24 +161,6 @@ our $ua;
 #
 #  > complete
 
-sub responder_send_command ($) {
-    my ($command) = @_;
-    return unless $we_are_responder;
-    # called even without $we_are_responder
-    print DEBUG "<< $command\n";
-    print $command, "\n" or die $!;
-}    
-
-sub progress {
-    if ($we_are_responder) {
-	my $m = join '', @_;
-	responder_send_command "progress ".length($m) or die $!;
-	print $m or die $!;
-    } else {
-	print @_, "\n";
-    }
-}
-
 sub badproto ($$) {
     my ($fh, $m) = @_;
     fail "connection lost: $!" if $fh->error;
@@ -209,23 +192,40 @@ sub protocol_send_file ($$) {
     close PF;
 }
 
+sub protocol_read_bytes ($$) {
+    my ($fh, $nbytes) = @_;
+    $nbytes =~ m/^\d{1,6}$/ or badproto \*RO, "bad byte count";
+    my $d;
+    my $got = read $fh, $d, $nbytes;
+    $got==$nbytes or badproto $fh, "eof during data block";
+    return $d;
+}
+
 sub protocol_receive_file ($$) {
     my ($fh, $ourfn) = @_;
     open PF, ">", $ourfn or die "$ourfn: $!";
     for (;;) {
-	protocol_expect \*STDIN, { m/^data-block (\d{1,6})$|data-end$/ };
+	protocol_expect \*STDIN, { m/^data-block (.*})$|data-end$/ };
 	length $1 or last;
-	my $d;
-	my $got = read $fh, $d, $1;
-	$got==$1 or badproto $fh, "eof during data block";
+	my $d = protocol_read_bytes \*STDIN, $1;
 	print PF $d or die $!;
     }
 }
 
+#---------- remote protocol support, responder ----------
+
+sub responder_send_command ($) {
+    my ($command) = @_;
+    return unless $we_are_responder;
+    # called even without $we_are_responder
+    print DEBUG "<< $command\n";
+    print $command, "\n" or die $!;
+}    
+
 sub responder_send_file ($$) {
     my ($keyword, $ourfn) = @_;
     return unless $we_are_responder;
-    responder_send_command "file begin $cmdprefix";
+    responder_send_command "file-begin $keyword";
     protocol_send_file \*STDOUT, $ourfn;
 }
 
@@ -239,6 +239,27 @@ sub responder_receive_files ($@) {
     protocol_expect \*STDIN, { m/^files-end$/ };
 }
 
+#---------- remote protocol support, initiator ----------
+
+sub initiator_expect (&) {
+    my ($match) = @_;
+    protocol_expect \*RO, &$match;
+}
+
+#---------- end remote code ----------
+
+sub progress {
+    if ($we_are_responder) {
+	my $m = join '', @_;
+	responder_send_command "progress ".length($m) or die $!;
+	print $m or die $!;
+    } else {
+	print @_, "\n";
+    }
+}
+
+our $ua;
+
 sub url_get {
     if (!$ua) {
 	$ua = LWP::UserAgent->new();
@@ -1325,6 +1346,8 @@ sub cmd_push {
     dopush();
 }
 
+#---------- remote commands' implementation ----------
+
 sub cmd_remote_push_responder {
     my ($nrargs) = shift @ARGV;
     my (@rargs) = @ARGV[0..$nrargs-1];
@@ -1338,6 +1361,21 @@ sub cmd_remote_push_responder {
     &cmd_push;
 }
 
+our $i_tmp;
+
+sub i_cleanup {
+    local ($@);
+    return unless defined $i_tmp;
+    chdir "/" or die $!;
+    eval { rmtree $i_tmp; };
+}
+
+sub i_method {
+    my ($base,$selector,@args) = @_;
+    $selector =~ s/\-/_/g;
+    { no strict qw(refs); &{"${base}_${selector}"}(@args); }
+}
+
 sub cmd_rpush {
     my $host = nextarg;
     my $dir;
@@ -1356,15 +1394,23 @@ sub cmd_rpush {
     push @rdgit, @ARGV;
     my @cmd = (@ssh, $host, shellquote @rdgit);
     my $pid = open2(\*RO, \*RI, @cmd);
-    initiator_expect { m/^dgit-remote-push-ready/ };
-    for (;;) {
-	initiator_expect { m/^(\S+)\s+(.*)$/ };
-	my ($icmd,$iargs) = ($1, $2);
-	$icmd =~ s/\-/_/g;
-	{ no strict qw(refs); &{"i_resp_$icmd"}($iargs); }
+    eval {
+	$i_tmp = tempdir();
+	chdir $i_tmp or die "$i_tmp $!";
+	initiator_expect { m/^dgit-remote-push-ready/ };
+	for (;;) {
+	    initiator_expect { m/^(\S+)(?: (.*))?$/ };
+	    my ($icmd,$iargs) = ($1, $2);
+	    i_method "i_resp_", $icmd, $iargs;
+	}
+    };
+    i_cleanup();
+    die $@;
     }
 }
 
+#---------- building etc. ----------
+
 our $version;
 our $sourcechanges;
 our $dscfn;
@@ -1533,6 +1579,8 @@ sub cmd_quilt_fixup {
     build_maybe_quilt_fixup();
 }
 
+#---------- argument parsing and main program ----------
+
 sub cmd_version {
     print "dgit version $our_version\n" or die $!;
     exit 0;