Net::Cmd: fix ->getline if SSL_read overreads read-early

sysread may call SSL_read, and SSL_read may buffer extra
data in userspace which can be returned via sysread without
making another read(2) syscall.  This makes it it possible for
select() to block indefinitely since select() only knows about
buffers in the kernel, not userspace.

This problem was exposed by a forthcoming patch to support NNTP
compression, but it is theoretically possible to trigger with
use of TLS alone, especially if compression is done by the TLS
layer.

Fortunately for existing users, TLS compression isn't widely
used anymore because of CRIME and other vulnerabilities.

So, flip the socket to non-blocking, perform the sysread, using
select() to wait only if the kernel requires it, and reset the
original blocking state of the socket when done to maintain
compatibility with existing users.

Thread-safety with flipping the O_NONBLOCK flag like this should
not be a concern, because any application sharing connected TCP
sockets across threads is buggy, anyways.

1 files changed, 45 insertions, 23 deletions

diff --git a/lib/Net/Cmd.pm b/lib/Net/Cmd.pm
index 0b1bbe1..bdb2028 100644
--- a/lib/Net/Cmd.pm
+++ b/lib/Net/Cmd.pm
@@ -16,7 +16,7 @@ use warnings;
 use Carp;
 use Exporter;
 use Symbol 'gensym';
-use Errno 'EINTR';
+use Errno qw(EINTR EAGAIN EWOULDBLOCK);
 
 BEGIN {
   if ($^O eq 'os390') {
@@ -317,6 +317,19 @@ sub unsupported {
   0;
 }
 
+# only call this after EAGAIN or EWOULDBLOCK
+# returns 1 if ready, 0 on timeout, -1 on error (sets $!)
+sub _wait_read {
+  my ($cmd, $timeout) = @_;
+
+  vec(my $rin, fileno($cmd), 1) = 1;
+
+  if (eval { $cmd->is_SSL && $cmd->want_write }) {
+    select(undef, $rin, undef, $timeout);
+  } else {
+    select($rin, undef, undef, $timeout);
+  }
+}
 
 sub getline {
   my $cmd = shift;
@@ -331,34 +344,43 @@ sub getline {
   return
     if $cmd->_is_closed;
 
-  my $fd = fileno($cmd);
-  my $rin = "";
-  vec($rin, $fd, 1) = 1;
-
-  until (scalar(@{${*$cmd}{'net_cmd_lines'}})) {
-    my $timeout = $cmd->timeout || undef;
-    my $rout;
-
-    my $select_ret = select($rout = $rin, undef, undef, $timeout);
-    if ($select_ret > 0) {
-      unless (sysread($cmd, $partial, 1024, length($partial))) {
-        my $err = $!;
-        $cmd->close;
-        $cmd->_set_status_closed($err);
-        return;
+  my $was_blocking = $cmd->blocking;
+  $cmd->blocking(0);
+  my $timeout = $cmd->timeout || undef;
+  my $err;
+
+  until ($err || scalar(@{${*$cmd}{'net_cmd_lines'}})) {
+    my $r = sysread($cmd, $partial, 1024, length($partial));
+    if (defined($r)) {
+      if ($r > 0) {
+        my @buf = split(/\015?\012/, $partial, -1);    ## break into lines
+        $partial = pop @buf;
+        push(@{${*$cmd}{'net_cmd_lines'}}, map {"$_\n"} @buf);
+      } else {
+        $err = 'EOF from peer';
       }
+    }
+    elsif ($! == EAGAIN || $! == EWOULDBLOCK) {
+      my $select_ret = $cmd->_wait_read($timeout);
+      redo if $select_ret > 0;
+      $err = 'timeout'; # ignore '$!' for backwards compatibility
+    }
+    else {
+      $err = $!;
+    }
+  }
 
-      my @buf = split(/\015?\012/, $partial, -1);    ## break into lines
-
-      $partial = pop @buf;
-
-      push(@{${*$cmd}{'net_cmd_lines'}}, map {"$_\n"} @buf);
+  $cmd->blocking($was_blocking);
 
+  if ($err) {
+    if ($err eq 'timeout') {
+      $cmd->_set_status_timeout;
     }
     else {
-      $cmd->_set_status_timeout;
-      return;
+      $cmd->close;
+      $cmd->_set_status_closed($err);
     }
+    return;
   }
 
   ${*$cmd}{'net_cmd_partial'} = $partial;