wip changes for remote push - implementation of remote push responder, not tested

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 357ccc3ac96e0faaa1be3502f364cf03b7d81bd5..c24a95034332ff32ec285f82418ace95aa8d4b93 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -42,6 +42,7 @@ our $ignoredirty = 0;
 our $noquilt = 0;
 our $existing_package = 'dpkg';
 our $cleanmode = 'dpkg-source';
+our $we_are_responder;
 
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
@@ -120,8 +121,51 @@ sub fetchspec () {
 
 our $ua;
 
+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 {
-    print @_, "\n";
+    if ($we_are_responder) {
+       my $m = join '', @_;
+       responder_send_command "progress ".length($m) or die $!;
+       print $m or die $!;
+    } else {
+       print @_, "\n";
+    }
+}
+
+sub protocol_send_file ($) {
+    my ($fh, $cmdprefix, $ourfn) = @_;
+    open PF, "<", $ourfn or die "$ourfn: $!";
+    print $fh "$cmdprefix begin\n" or die $!;
+    for (;;) {
+       my $d;
+       my $got = read PF, $d, 65536;
+       die "$ourfn: $!" unless defined $got;
+       last if $got;
+       print $fh "$keyword block ".length($d)."\n" or die $!;
+       print $d or die $!;
+    }
+    print $fh "$keyword end\n" or die $!;
+    close PF;
+}
+
+sub responder_send_file ($$) {
+    my ($keyword, $ourfn) = @_;
+    return unless $we_are_responder;
+    print DEBUG "responder sending $keyword $ourfn\n";
+    protocol_send_file(\*STDOUT, "upload $keyword");
+}
+
+sub responder_receive_files ($@) {
+    my ($keyword, @ourfns) = @_;
+    die unless $we_are_responder;
+    
 }
 
 sub url_get {
@@ -204,7 +248,7 @@ sub cmdoutput {
 }
 
 sub dryrun_report {
-    printcmd(\*STDOUT,"#",@_);
+    printcmd(\*STDERR,"#",@_);
 }
 
 sub runcmd_ordryrun {
@@ -910,8 +954,6 @@ sub push_parse_changelog ($) {
     my $clogp = Dpkg::Control::Hash->new();
     $clogp->load($clogpfn);
 
-    responder_send_file('parsed-changelog', $clogpfn);
-
     $package = getfield $clogp, 'Source';
     my $cversion = getfield $clogp, 'Version';
     my $tag = debiantag($cversion);
@@ -986,16 +1028,20 @@ sub dopush () {
     print DEBUG "actually entering push\n";
     prep_ud();
 
-    runcmd shell_cmd "exec >.git/dgit/changelog.822.tmp",
-        qw(dpkg-parsechangelog);
+    my $clogpfn = ".git/dgit/changelog.822.tmp";
+    runcmd shell_cmd "exec >$clogpfn", qw(dpkg-parsechangelog);
+
+    responder_send_file('parsed-changelog', $clogpfn);
 
     my ($clogp, $cversion, $tag, $dscfn) =
-       push_parse_changelog(".git/dgit/changelog.822.tmp");
+       push_parse_changelog("$clogpfn");
 
     stat "../$dscfn" or
        fail "looked for .dsc $dscfn, but $!;".
            " maybe you forgot to build";
 
+    responder_send_file('dsc', "../$dscfn");
+
     push_parse_dsc("../$dscfn", $dscfn, $cversion);
 
     my $format = getfield $dsc, 'Format';
@@ -1043,11 +1089,16 @@ sub dopush () {
        }
     }
 
+    responder_send_file('changes',$changesfn);
+
+    my $tfn = sub { ".git/dgit/tag$_[0]"; };
     my ($tagobjfn) =
-       push_mktag($head,$clogp,$tag,
-                  $dsc,"../$dscfn",
-                  $changesfile,$changesfile,
-                  sub { ".git/dgit/tag$_[0]"; });
+       $we_are_responder
+       ? responder_receive_files('signed-tag', $tfn->('.signed.tmp'))
+       : push_mktag($head,$clogp,$tag,
+                    $dsc,"../$dscfn",
+                    $changesfile,$changesfile,
+                                $tfn);
 
     my $tag_obj_hash = cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn;
     runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash;
@@ -1059,23 +1110,35 @@ sub dopush () {
     }
     runcmd_ordryrun @git, qw(push),access_giturl(),"HEAD:".rrref();
     runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD';
-    if (!$dryrun) {
-       rename "../$dscfn.tmp","../$dscfn" or die "$dscfn $!";
-    } else {
-       progress "[new .dsc left in $dscfn.tmp]";
+
+    if (!$we_are_responder) {
+       if (!$dryrun) {
+           rename "../$dscfn.tmp","../$dscfn" or die "$dscfn $!";
+       } else {
+           progress "[new .dsc left in $dscfn.tmp]";
+       }
     }
 
     if ($sign) {
-       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-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;
+       }
     }
     runcmd_ordryrun @git, qw(push),access_giturl(),"refs/tags/$tag";
     my $host = access_cfg('upload-host','RETURN-UNDEF');
     my @hostarg = defined($host) ? ($host,) : ();
     runcmd_ordryrun @dput, @hostarg, $changesfile;
     printdone "pushed and uploaded $cversion";
+
+    responder_send_command("complete");
 }
 
 sub cmd_clone {
@@ -1180,6 +1243,18 @@ sub cmd_push {
     dopush();
 }
 
+sub cmd_remote_push_responder {
+    my ($nrargs) = shift @ARGV;
+    my (@rargs) = @ARGV[0..$nrargs-1];
+    @ARGV = @ARGV[$nrargs..$#ARGV];
+    die unless @rargs;
+    my ($dir) = @rargs;
+    chdir $dir or die "$dir: $!";
+    $we_are_remote = 1;
+    responder_send_command("dgit-remote-push-ready");
+    &cmd_push;
+}
+
 our $version;
 our $sourcechanges;
 our $dscfn;