_sysptycap_tty: avoid getting stuck on sysread

1 files changed, 19 insertions, 4 deletions

diff --git a/perl5/Local/Interactive.pm b/perl5/Local/Interactive.pm
index 50f3e06a..0cd6e912 100644
--- a/perl5/Local/Interactive.pm
+++ b/perl5/Local/Interactive.pm
@@ -25,7 +25,7 @@ use Exporter 'import';
 use Term::ANSIColor;
 use Local::ScriptStatus;
 use Sys::Hostname;
-use POSIX ();
+use POSIX ":sys_wait_h";
 
 # Quoting perldoc perlmodlib: "As a general rule, if the module is
 # trying to be object oriented then export nothing. If it's just a
@@ -216,15 +216,30 @@ sub _sysptycap_tty {
     }
     $pty->close;
     my $output;
-    while (1) {
+    # don't continue trying to read if child has died.  This is needed
+    # as the child might die without the pty getting EOF, e.g. if an
+    # SSH control socket is still alive (seems to happen when using
+    # Debian's SSH jump host to SSH to salsa)
+    while (kill 0, $pid) {
         my ($chars, $nchars);
-        $nchars = sysread $slave, $chars, 8192;
+        local $@;
+        eval {
+            local $SIG{ALRM} = sub { die "sysread timeout\n" };
+            alarm 1;
+            $nchars = sysread $slave, $chars, 8192;
+            alarm 0;
+        };
+        if (my $exception = $@) {
+            die $exception unless $exception eq "sysread timeout\n";
+            # since it's stopped emitting output, see if child needs
+            # reaping
+            waitpid -1, &WNOHANG;
+        }
         last if defined $nchars and $nchars == 0;
         print $chars;
         $output .= $chars;
     }
     $slave->close;
-    wait;
     exit 2 if $interrupted;
     return { exit => $? >> 8, output => $output };
 }