our $existing_package = 'dpkg';
our $cleanmode = 'dpkg-source';
our $we_are_responder;
+our $initiator_tempdir;
our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
sub changesopts () { return @changesopts[1..$#changesopts]; }
our $us = 'dgit';
-our $debugprefix = ' ';
+our $debugprefix = '';
sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
-sub fail { die "$us: @_\n"; }
+sub fail {
+ die $us.($we_are_responder ? " (build host)" : "").": @_\n";
+}
sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
sub badproto ($$) {
my ($fh, $m) = @_;
fail "connection lost: $!" if $fh->error;
- fail "connection terminated" if $fh->eof;
fail "protocol violation; $m not expected";
}
my $d;
my $got = read PF, $d, 65536;
die "$ourfn: $!" unless defined $got;
- last if $got;
+ last if !$got;
print $fh "data-block ".length($d)."\n" or die $!;
- print $d or die $!;
+ print $fh $d or die $!;
}
+ PF->error and die "$ourfn $!";
print $fh "data-end\n" or die $!;
close PF;
}
sub protocol_read_bytes ($$) {
my ($fh, $nbytes) = @_;
- $nbytes =~ m/^\d{1,6}$/ or badproto \*RO, "bad byte count";
+ $nbytes =~ m/^[1-9]\d{0,5}$/ or badproto \*RO, "bad byte count";
my $d;
my $got = read $fh, $d, $nbytes;
$got==$nbytes or badproto $fh, "eof during data block";
sub protocol_receive_file ($$) {
my ($fh, $ourfn) = @_;
+ printdebug "() $ourfn\n";
open PF, ">", $ourfn or die "$ourfn: $!";
for (;;) {
my ($y,$l) = protocol_expect {
- m/^data-block (.*})$|data-end$/;
- length $1 ? (1,$1) : (0);
+ m/^data-block (.*)$/ ? (1,$1) :
+ m/^data-end$/ ? (0,) :
+ ();
} $fh;
last unless $y;
- my $d = protocol_read_bytes $fh, $1;
+ my $d = protocol_read_bytes $fh, $l;
print PF $d or die $!;
}
- printdebug "received into $ourfn\n";
+ close PF or die $!;
}
#---------- remote protocol support, responder ----------
return unless $we_are_responder;
# called even without $we_are_responder
printdebug "<< $command\n";
- print $command, "\n" or die $!;
+ print PO $command, "\n" or die $!;
}
sub responder_send_file ($$) {
return unless $we_are_responder;
printdebug "[[ $keyword $ourfn\n";
responder_send_command "file $keyword";
- protocol_send_file \*STDOUT, $ourfn;
+ protocol_send_file \*PO, $ourfn;
}
sub responder_receive_files ($@) {
printdebug "]] $keyword @ourfns\n";
responder_send_command "want $keyword";
foreach my $fn (@ourfns) {
- protocol_receive_file \*STDIN, $fn;
+ protocol_receive_file \*PI, $fn;
}
- protocol_expect { m/^files-end$/ } \*STDIN;
+ protocol_expect { m/^files-end$/ } \*PI;
}
#---------- remote protocol support, initiator ----------
if ($we_are_responder) {
my $m = join '', @_;
responder_send_command "progress ".length($m) or die $!;
- print $m or die $!;
+ print PO $m or die $!;
} else {
print @_, "\n";
}
my ($clogpfn) = @_;
my $clogp = Dpkg::Control::Hash->new();
- $clogp->load($clogpfn);
+ $clogp->load($clogpfn) or die;
$package = getfield $clogp, 'Source';
my $cversion = getfield $clogp, 'Version';
my $dversion = getfield $dsc, 'Version';
my $dscpackage = getfield $dsc, 'Source';
($dscpackage eq $package && $dversion eq $cversion) or
- fail "$dsc is for $dscpackage $dversion".
+ fail "$dscfn is for $dscpackage $dversion".
" but debian/changelog is for $package $cversion";
}
-sub push_mktag ($$$$$$$$) {
+sub push_mktag ($$$$$$$) {
my ($head,$clogp,$tag,
- $dsc,$dscfn,
+ $dscfn,
$changesfile,$changesfilewhat,
$tfn) = @_;
}
responder_send_file('changes',$changesfile);
+ responder_send_command("param head $head");
my $tfn = sub { ".git/dgit/tag$_[0]"; };
my ($tagobjfn) =
$we_are_responder
? responder_receive_files('signed-tag', $tfn->('.signed.tmp'))
: push_mktag($head,$clogp,$tag,
- $dsc,"../$dscfn",
+ "../$dscfn",
$changesfile,$changesfile,
$tfn);
@ARGV = @ARGV[$nrargs..$#ARGV];
die unless @rargs;
my ($dir) = @rargs;
- changedir $dir;
- $we_are_responder = 1;
$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 ($@);
- return unless defined $i_tmp;
- changedir "/";
- eval { rmtree $i_tmp; };
+ 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;
push @rdgit, @ARGV;
my @cmd = (@ssh, $host, shellquote @rdgit);
printcmd \*DEBUG,$debugprefix."+",@cmd;
- eval {
+
+ if (defined $initiator_tempdir) {
+ rmtree $initiator_tempdir;
+ mkdir $initiator_tempdir, 0700 or die "$initiator_tempdir: $!";
+ $i_tmp = $initiator_tempdir;
+ } else {
$i_tmp = tempdir();
- my $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;
- }
- };
+ }
+ $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();
- die $@;
+ exit 0;
}
sub i_resp_progress ($) {
our %i_param;
-sub i_param ($) {
- $_[0] =~ m/^(\S+) (.*)$/;
+sub i_resp_param ($) {
+ $_[0] =~ m/^(\S+) (.*)$/ or badproto \*RO, "bad param spec";
$i_param{$1} = $2;
}
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';
+ push_parse_changelog "$i_tmp/remote-changelog.822";
die if $i_dscfn =~ m#/|^\W#;
return $i_dscfn;
}
sub i_want_signed_tag {
+ printdebug Dumper(\%i_param, $i_dscfn);
defined $i_param{'head'} && defined $i_dscfn
or badproto \*RO, "sequencing error";
my $head = $i_param{'head'};
push_parse_dsc $i_dscfn, 'remote dsc',
push_mktag $head, $i_clogp, $i_tag,
- $dsc, $i_dscfn,
+ $i_dscfn,
'remote.changes', 'remote changes',
'tag.tag';
} elsif (m/^--existing-package=(.*)/s) {
push @ropts, $_;
$existing_package = $1;
+ } elsif (m/^--initiator-tempdir=(.*)/s) {
+ $initiator_tempdir = $1;
+ $initiator_tempdir =~ m#^/# or
+ badusage "--initiator-tempdir must be used specify an".
+ " absolute, not relative, directory."
} elsif (m/^--distro=(.*)/s) {
push @ropts, $_;
$idistro = $1;
~ianmdlvl / dgit.git / blobdiff