chiark / gitweb /
Remove leftover debugging print
[dgit.git] / dgit
diff --git a/dgit b/dgit
index ebeb8807b4419ded8d33237d9b09061e9a907d9a..930a59440e776d5145d2c277e8b442eb95ccad95 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -30,9 +30,12 @@ use Dpkg::Version;
 use POSIX;
 use IPC::Open2;
 use Digest::SHA;
+use Config;
 
 our $our_version = 'UNRELEASED'; ###substituted###
 
+our $rpushprotovsn = 2;
+
 our $isuite = 'unstable';
 our $idistro;
 our $package;
@@ -133,6 +136,23 @@ END {
     }
 };
 
+our @signames = split / /, $Config{sig_name};
+
+sub waitstatusmsg () {
+    if (!$?) {
+       return "terminated, reporting successful completion";
+    } elsif (!($? & 255)) {
+       return "failed with error exit status ".WEXITSTATUS($?);
+    } elsif (WIFSIGNALED($?)) {
+       my $signum=WTERMSIG($?);
+       return "died due to fatal signal ".
+           ($signames[$signum] // "number $signum").
+           ($? & 128 ? " (core dumped)" : ""); # POSIX(3pm) has no WCOREDUMP
+    } else {
+       return "failed with unknown wait status ".$?;
+    }
+}
+
 sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
 
 sub fail { 
@@ -194,17 +214,39 @@ sub changedir ($) {
 #
 #  > complete
 
+our $i_child_pid;
+
+sub i_child_report () {
+    # Sees if our child has died, and reap it if so.  Returns a string
+    # describing how it died if it failed, or undef otherwise.
+    return undef unless $i_child_pid;
+    my $got = waitpid $i_child_pid, WNOHANG;
+    return undef if $got <= 0;
+    die unless $got == $i_child_pid;
+    $i_child_pid = undef;
+    return undef unless $?;
+    return "build host child ".waitstatusmsg();
+}
+
 sub badproto ($$) {
     my ($fh, $m) = @_;
     fail "connection lost: $!" if $fh->error;
     fail "protocol violation; $m not expected";
 }
 
+sub badproto_badread ($$) {
+    my ($fh, $wh) = @_;
+    fail "connection lost: $!" if $!;
+    my $report = i_child_report();
+    fail $report if defined $report;
+    badproto $fh, "eof (reading $wh)";
+}
+
 sub protocol_expect (&$) {
     my ($match, $fh) = @_;
     local $_;
     $_ = <$fh>;
-    defined && chomp or badproto $fh, "eof";
+    defined && chomp or badproto_badread $fh, "protocol message";
     if (wantarray) {
        my @r = &$match;
        return @r if @r;
@@ -236,7 +278,7 @@ sub protocol_read_bytes ($$) {
     $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";
+    $got==$nbytes or badproto_badread $fh, "data block";
     return $d;
 }
 
@@ -350,10 +392,8 @@ sub failedcmd {
     { local ($!); printcmd \*STDERR, "$us: failed command:", @_ or die $!; };
     if ($!) {
        fail "failed to fork/exec: $!";
-    } elsif (!($? & 0xff)) {
-       fail "subprocess failed with error exit status ".($?>>8);
     } elsif ($?) {
-       fail "subprocess crashed (wait status $?)";
+       fail "subprocess ".waitstatusmsg();
     } else {
        fail "subprocess produced invalid output";
     }
@@ -601,9 +641,8 @@ sub parsecontrolfh ($$;$) {
     for (;;) {
        my %opts = ('name' => $desc);
        $opts{allow_pgp}= $allowsigned || !$dpkgcontrolhash_noissigned;
-print STDERR Dumper(\%opts);
        $c = Dpkg::Control::Hash->new(%opts);
-       $c->parse($fh) or die "parsing of $desc failed";
+       $c->parse($fh,$desc) or die "parsing of $desc failed";
        last if $allowsigned;
        last if $dpkgcontrolhash_noissigned;
        my $issigned= $c->get_option('is_pgp_signed');
@@ -1689,12 +1728,15 @@ sub cmd_push {
 
 #---------- remote commands' implementation ----------
 
-sub cmd_remote_push_responder {
+sub cmd_remote_push_build_host {
     my ($nrargs) = shift @ARGV;
     my (@rargs) = @ARGV[0..$nrargs-1];
     @ARGV = @ARGV[$nrargs..$#ARGV];
     die unless @rargs;
-    my ($dir) = @rargs;
+    my ($dir,$vsnwant) = @rargs;
+    # vsnwant is a comma-separated list; we report which we have
+    # chosen in our ready response (so other end can tell if they
+    # offered several)
     $debugprefix = ' ';
     $we_are_responder = 1;
 
@@ -1705,19 +1747,30 @@ sub cmd_remote_push_responder {
     open STDOUT, ">&STDERR" or die $!;
     autoflush STDOUT 1;
 
-    responder_send_command("dgit-remote-push-ready");
+    $vsnwant //= 1;
+    fail "build host has dgit rpush protocol version".
+       " $rpushprotovsn but invocation host has $vsnwant"
+       unless grep { $rpushprotovsn eq $_ } split /,/, $vsnwant;
+
+    responder_send_command("dgit-remote-push-ready $rpushprotovsn");
 
     changedir $dir;
     &cmd_push;
 }
 
+sub cmd_remote_push_responder { cmd_remote_push_build_host(); }
+# ... for compatibility with proto vsn.1 dgit (just so that user gets
+#     a good error message)
+
 our $i_tmp;
-our $i_child_pid;
 
 sub i_cleanup {
-    local ($@);
-    if ($i_child_pid) {
-       printdebug "(killing remote child $i_child_pid)\n";
+    local ($@, $?);
+    my $report = i_child_report();
+    if (defined $report) {
+       printdebug "($report)\n";
+    } elsif ($i_child_pid) {
+       printdebug "(killing build host child $i_child_pid)\n";
        kill 15, $i_child_pid;
     }
     if (defined $i_tmp && !defined $initiator_tempdir) {
@@ -1744,11 +1797,11 @@ sub cmd_rpush {
        $dir = nextarg;
     }
     $dir =~ s{^-}{./-};
-    my @rargs = ($dir);
+    my @rargs = ($dir,$rpushprotovsn);
     my @rdgit;
     push @rdgit, @dgit;
     push @rdgit, @ropts;
-    push @rdgit, qw(remote-push-responder), (scalar @rargs), @rargs;
+    push @rdgit, qw(remote-push-build-host), (scalar @rargs), @rargs;
     push @rdgit, @ARGV;
     my @cmd = (@ssh, $host, shellquote @rdgit);
     printcmd \*DEBUG,$debugprefix."+",@cmd;
@@ -1781,10 +1834,10 @@ sub i_resp_progress ($) {
 sub i_resp_complete {
     my $pid = $i_child_pid;
     $i_child_pid = undef; # prevents killing some other process with same pid
-    printdebug "waiting for remote child $pid...\n";
+    printdebug "waiting for build host child $pid...\n";
     my $got = waitpid $pid, 0;
     die $! unless $got == $pid;
-    die "remote child failed $?" if $?;
+    die "build host child failed $?" if $?;
 
     i_cleanup();
     printdebug "all done\n";