X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=83bed5400b58d0d3c01cf2f4ffa48743b4571f9a;hb=52ffda03db49cec58b181a7ca3b754980e61869c;hp=6bd95e99e2f5ce238623c2774777a7b683ba95ff;hpb=76708972d08328b32cef22ec1cf86d0aec1541fa;p=dgit.git

diff --git a/dgit b/dgit
index 6bd95e99..83bed540 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###
 
@@ -224,7 +225,7 @@ sub responder_send_command ($) {
 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;
 }
 
@@ -1360,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;
@@ -1378,13 +1394,57 @@ 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 $@;
+}
+
+sub i_resp_progress ($) {
+    my ($rhs) = @_;
+    my $msg = protocol_read_bytes \*RO, $rhs;
+    progress $msg;
+}
+
+sub i_resp_complete {
+    i_cleanup();
+    exit 0;
+}
+
+sub i_resp_file ($) {
+    my ($keyword) = @_;
+    my $localname = i_method "i_localname_", $keyword;
+    my $localpath = "$i_tmp/$localname";
+    stat $localpath and badproto \*RO, "file $keyword ($localpath) twice";
+    protocol_receive_file \*RO, $localpath;
+}
+
+sub i_resp_want ($) {
+    my ($keyword) = @_;
+    my @localpaths = i_method "i_want_", $keyword;
+    foreach my $localpath (@localpaths) {
+	protocol_send_file \*RI, $localpath;
     }
+    print RI "end-files\n" or die $!;
+}
+
+our ($i_clogp, $i_version, $i_tag, $i_dscfn);
+
+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';
+    die if $i_dscfn =~ m#/|^\W#;
+    return $dscfn;
 }
 
 #---------- building etc. ----------