From: Guilhem Moulin <guilhem@fripost.org>
Date: Fri, 4 Mar 2016 10:50:00 +0000 (+0100)
Subject: Inspect the select(2) syscall's return value.
X-Git-Url: https://git.g-eek.se/?a=commitdiff_plain;h=7e4d373d1fd60eeddf641458cc4bec115d3b5ecf;p=interimap.git

Inspect the select(2) syscall's return value.
---

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 745e64f..3957020 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -22,6 +22,7 @@ use strict;
 
 use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
 use Config::Tiny ();
+use Errno 'EINTR';
 use Net::SSLeay ();
 use List::Util qw/all first/;
 use POSIX ':signal_h';
@@ -948,13 +949,16 @@ sub slurp($;$$) {
 
     vec(my $rin, fileno($self->{STDOUT}), 1) = 1;
     while (1) {
-        return $read unless
-            (defined $self->{_OUTBUF} and $self->{_OUTBUF} ne '') or
-            # Unprocessed data within the current TLS record would cause
-            # select(2) to block/timeout due to the raw socket not being
-            # ready.
-            (defined $ssl and Net::SSLeay::pending($ssl) > 0) or
-            select($rin, undef, undef, 0) > 0;
+        unless ((defined $self->{_OUTBUF} and $self->{_OUTBUF} ne '') or
+                # Unprocessed data within the current TLS record would
+                # cause select(2) to block/timeout due to the raw socket
+                # not being ready.
+                (defined $ssl and Net::SSLeay::pending($ssl) > 0)) {
+            my $r = CORE::select($rin, undef, undef, 0);
+            next if $r == -1 and $! == EINTR; # select(2) was interrupted
+            $self->panic("Can't select: $!") if $r == -1;
+            return $read if $r == 0; # nothing more to read
+        }
         my $x = $self->_getline();
         $self->_resp($x, $cmd, undef, $callback);
         $read++;