+#---------- remote commands' implementation ----------
+
+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;
+ $debugprefix = ' ';
+ $we_are_responder = 1;
+
+ open PI, "<&STDIN" or die $!;
+ open STDIN, "/dev/null" or die $!;
+ open PO, ">&STDOUT" or die $!;
+ autoflush PO 1;
+ open STDOUT, ">&STDERR" or die $!;
+ autoflush STDOUT 1;
+
+ responder_send_command("dgit-remote-push-ready");
+
+ changedir $dir;
+ &cmd_push;
+}
+
+our $i_tmp;
+our $i_child_pid;
+
+sub i_cleanup {
+ local ($@);
+ if ($i_child_pid) {
+ printdebug "(killing remote child $i_child_pid)\n";
+ kill 15, $i_child_pid;
+ }
+ if (defined $i_tmp && !defined $initiator_tempdir) {
+ changedir "/";
+ eval { rmtree $i_tmp; };
+ }
+}
+
+END { i_cleanup(); }
+
+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;
+ if ($host =~ m/^((?:[^][]|\[[^][]*\])*)\:/) {
+ $host = $1;
+ $dir = $'; #';
+ } else {
+ $dir = nextarg;
+ }
+ $dir =~ s{^-}{./-};
+ my @rargs = ($dir);
+ my @rdgit;
+ push @rdgit, @dgit;
+ push @rdgit, @ropts;
+ push @rdgit, qw(remote-push-responder), (scalar @rargs), @rargs;
+ push @rdgit, @ARGV;
+ my @cmd = (@ssh, $host, shellquote @rdgit);
+ printcmd \*DEBUG,$debugprefix."+",@cmd;
+
+ if (defined $initiator_tempdir) {
+ rmtree $initiator_tempdir;
+ mkdir $initiator_tempdir, 0700 or die "$initiator_tempdir: $!";
+ $i_tmp = $initiator_tempdir;
+ } else {
+ $i_tmp = tempdir();
+ }
+ $i_child_pid = open2(\*RO, \*RI, @cmd);
+ changedir $i_tmp;
+ initiator_expect { m/^dgit-remote-push-ready/ };
+ for (;;) {
+ my ($icmd,$iargs) = initiator_expect {
+ m/^(\S+)(?: (.*))?$/;
+ ($1,$2);
+ };
+ i_method "i_resp", $icmd, $iargs;
+ }
+
+ my $pid = $i_child_pid;
+ $i_child_pid = undef; # prevents killing some other process with same pid
+ printdebug "waiting for remote child $pid...";
+ my $got = waitpid $pid, 0;
+ die $! unless $got == $pid;
+ die "remote child failed $?" if $?;
+
+ i_cleanup();
+ exit 0;
+}
+
+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;
+ i_method "i_file", $keyword;
+}
+
+our %i_param;
+
+sub i_resp_param ($) {
+ $_[0] =~ m/^(\S+) (.*)$/ or badproto \*RO, "bad param spec";
+ $i_param{$1} = $2;
+}
+
+our %i_wanted;
+
+sub i_resp_want ($) {
+ my ($keyword) = @_;
+ die "$keyword ?" if $i_wanted{$keyword}++;
+ my @localpaths = i_method "i_want", $keyword;
+ printdebug "[[ $keyword @localpaths\n";
+ foreach my $localpath (@localpaths) {
+ protocol_send_file \*RI, $localpath;
+ }
+ print RI "files-end\n" or die $!;
+}
+
+our ($i_clogp, $i_version, $i_tag, $i_dscfn, $i_changesfn);
+
+sub i_localname_parsed_changelog {
+ return "remote-changelog.822";
+}
+sub i_file_parsed_changelog {
+ ($i_clogp, $i_version, $i_tag, $i_dscfn) =
+ push_parse_changelog "$i_tmp/remote-changelog.822";
+ die if $i_dscfn =~ m#/|^\W#;
+}
+
+sub i_localname_dsc {
+ defined $i_dscfn or badproto \*RO, "dsc (before parsed-changelog)";
+ return $i_dscfn;
+}
+sub i_file_dsc { }
+
+sub i_localname_changes {
+ defined $i_dscfn or badproto \*RO, "dsc (before parsed-changelog)";
+ $i_changesfn = $i_dscfn;
+ $i_changesfn =~ s/\.dsc$/_dgit.changes/ or die;
+ return $i_changesfn;
+}
+sub i_file_changes { }
+
+sub i_want_signed_tag {
+ printdebug Dumper(\%i_param, $i_dscfn);
+ defined $i_param{'head'} && defined $i_dscfn && defined $i_clogp
+ or badproto \*RO, "premature desire for signed-tag";
+ my $head = $i_param{'head'};
+ die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
+
+ push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
+
+ my $tagobjfn =
+ push_mktag $head, $i_clogp, $i_tag,
+ $i_dscfn,
+ $i_changesfn, 'remote changes',
+ sub { "tag$_[0]"; };
+
+ return $tagobjfn;
+}
+
+sub i_want_signed_dsc_changes {
+ rename "$i_dscfn.tmp","$i_dscfn" or die "$i_dscfn $!";
+ sign_changes $i_changesfn;
+ return ($i_dscfn, $i_changesfn);
+}
+
+#---------- building etc. ----------
+