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)");
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 {
our ($dscdata,$dscurl,$dsc,$skew_warning_vsn);
-sub printcmd {
- my $fh = shift @_;
- my $intro = shift @_;
- print $fh $intro or die $!;
+sub shellquote {
+ my @out;
local $_;
foreach my $a (@_) {
$_ = $a;
if (s{['\\]}{\\$&}g || m{\s} || m{[^-_./0-9a-z]}i) {
- print $fh " '$_'" or die $!;
+ push @out, "'$_'";
} else {
- print $fh " $_" or die $!;
+ push @out, $_;
}
}
+ return join '', @out;
+}
+
+sub printcmd {
+ my $fh = shift @_;
+ my $intro = shift @_;
+ print $fh $intro or die $!;
+ print $fh shellquote @_ or die $!;
print $fh "\n" or die $!;
}
}
sub dryrun_report {
- printcmd(\*STDOUT,"#",@_);
+ printcmd(\*STDERR,"#",@_);
}
sub runcmd_ordryrun {
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);
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';
}
}
+ 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;
}
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 {
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;