X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=2e7df8e2862fd113e502e1193ca31d6a20ad22fd;hp=381b7311946f2e7cf6dac556f3bbed1e026c6684;hb=b944f517c8b2886ef3adda8bc1b72adacb243d29;hpb=e8b6fa044b8df746e84aa034a44d7c96156cc546

diff --git a/dgit b/dgit
index 381b7311..2e7df8e2 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###
 
@@ -143,6 +144,8 @@ sub fetchspec () {
 #  > file begin changes
 #  [etc]
 #
+#  > param head HEAD
+#
 #  > want signed-tag
 #  [indicates that signed tag is wanted]
 #  < data-block NBYTES
@@ -191,15 +194,22 @@ 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 $!;
     }
 }
@@ -217,7 +227,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;
 }
 
@@ -1119,6 +1129,16 @@ END
     return ($tagobjfn);
 }
 
+sub sign_changes ($) {
+    my ($changesfile) = @_;
+    if ($sign) {
+	my @debsign_cmd = @debsign;
+	push @debsign_cmd, "-k$keyid" if defined $keyid;
+	push @debsign_cmd, $changesfile;
+	runcmd_ordryrun @debsign_cmd;
+    }
+}
+
 sub dopush () {
     print DEBUG "actually entering push\n";
     prep_ud();
@@ -1214,19 +1234,15 @@ sub dopush () {
 	}
     }
 
-    if ($sign) {
-	if ($we_are_responder) {
-	    my $dryrunsuffix = $dryrun ? ".tmp" : "";
-	    responder_receive_files('signed-changes-dsc',
-				    "$changesfile$dryrunsuffix",
-				    "../$dscfn$dryrunsuffix");
-	} else {
-	    my @debsign_cmd = @debsign;
-	    push @debsign_cmd, "-k$keyid" if defined $keyid;
-	    push @debsign_cmd, $changesfile;
-	    runcmd_ordryrun @debsign_cmd;
-	}
+    if ($we_are_responder) {
+	my $dryrunsuffix = $dryrun ? ".tmp" : "";
+	responder_receive_files('signed-dsc-changes',
+				"../$dscfn$dryrunsuffix",
+				"$changesfile$dryrupnsuffix");
+    } else {
+	sign_changes $changesfile;
     }
+
     runcmd_ordryrun @git, qw(push),access_giturl(),"refs/tags/$tag";
     my $host = access_cfg('upload-host','RETURN-UNDEF');
     my @hostarg = defined($host) ? ($host,) : ();
@@ -1353,6 +1369,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;
@@ -1371,13 +1402,66 @@ 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;
+}
+
+our %i_param;
+
+sub i_param ($) {
+    $_[0] =~ m/^(\S+) (.*)$/;
+    $i_param{$1} = $2;
+}
+
+our %i_wanted;
+
+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. ----------