From f0e2a4873a21f9b0399686aad295938891dc5417 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 10 Aug 2014 20:42:03 +0100
Subject: [PATCH] In rpush, on protocol error talking to build host, check if
 the subprocess died and report differently if so.  Closes:#736528.

---
 debian/changelog |  2 ++
 dgit             | 30 ++++++++++++++++++++++++++----
 2 files changed, 28 insertions(+), 4 deletions(-)

diff --git a/debian/changelog b/debian/changelog
index f70f2ff6..fc4bd89b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -38,6 +38,8 @@ dgit (0.22~experimental1) experimental; urgency=low
     using libdpkg-perl 1.17.x).  Closes:#731635.
   * Improve error message for .dsc parsing failures more generally.
   * Better reporting of child exit statuses (esp. deaths due to signals).
+  * In rpush, on protocol error talking to build host, check if the
+    subprocess died and report differently if so.  Closes:#736528.
 
   Major new feature, currently stalled awaiting server infrastructure:
   * dgit-repos-server: New program for receiving signed-tag-based
diff --git a/dgit b/dgit
index e3fc0eef..59fabafb 100755
--- a/dgit
+++ b/dgit
@@ -212,17 +212,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;
@@ -254,7 +276,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;
 }
 
@@ -1797,10 +1819,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";
-- 
2.30.2