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

diff --git a/dgit b/dgit
index a47db911e6a31e2d72a29baf7ea07356084db285..c24a95034332ff32ec285f82418ace95aa8d4b93 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -121,30 +121,53 @@ 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;
-    die "responder send file $keyword $ourfn\n";
+    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;
-    die 'nyi';
+    
 }
 
-sub responder_send_command ($) {
-    my ($command) = @_;
-    return unless $we_are_responder;
-    # called even without $we_are_responder
-    print DEBUG "responder command $command\n";
-    die;
-}    
-
 sub url_get {
     if (!$ua) {
        $ua = LWP::UserAgent->new();
@@ -1220,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;