From: Guilhem Moulin <guilhem@fripost.org>
Date: Sat, 25 Jul 2015 23:36:48 +0000 (+0200)
Subject: Don't use readline with non-blocking IO.
X-Git-Url: https://git.g-eek.se/?a=commitdiff_plain;h=1c78a883849c5ffc4e2fbd84dc912dec18486759;p=interimap.git

Don't use readline with non-blocking IO.

Instead use the select(2) syscall to see if there data available while
we're waiting for notifications.
Except for SSL/TLS connections, where we have to check if there is
unprocessed cached data in the current SSL frame.
---

diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm
index 6c4b8a3..7c76996 100644
--- a/lib/Net/IMAP/Sync.pm
+++ b/lib/Net/IMAP/Sync.pm
@@ -21,6 +21,7 @@ use warnings;
 use strict;
 
 use Config::Tiny ();
+use IO::Select ();
 use List::Util 'first';
 use Socket 'SO_KEEPALIVE';
 
@@ -709,24 +710,35 @@ sub notify($@) {
     my $command = 'NOTIFY ';
     $command .= @_ ? ('SET '. join(' ', map {"($_ ($events))"} @_)) : 'NONE';
     $self->_send($command);
+    $self->{_SEL_OUT} = IO::Select::->new($self->{STDOUT});
 }
 
 
 # $self->slurp()
-#   Turn on non-blocking IO, try to as many lines as possible, then turn
-#   non-blocking IO back off and return the number of lines read.
+#   See if the server has sent some unprocessed data; try to as many
+#   lines as possible, process them, and return the number of lines
+#   read.
 #   This is mostly useful when waiting for notifications while no
 #   command is progress, cf. RFC 5465 (NOTIFY).
 sub slurp($) {
     my $self = shift;
+
+    my $stdout = $self->{STDOUT};
     my $read = 0;
-    $self->{STDOUT}->blocking(0) // $self->panic("Can't turn on non-blocking IO: $!");
-    while (defined (my $x = $self->_getline())) {
-        $self->_resp($x);
-        $read++
+
+    while (1) {
+        # Unprocessed data within the current SSL frame would cause
+        # select(2) to block/timeout due to the raw socket not being
+        # ready.
+        unless (ref $stdout eq 'IO::Socket::SSL' and $stdout->pending() > 0) {
+            my $sel = IO::Select::->new($stdout);
+            my ($ok) = $self->{_SEL_OUT}->can_read(0);
+            return $read unless defined $ok;
+        }
+
+        $self->_resp( $self->_getline() );
+        $read++;
     }
-    $self->{STDOUT}->blocking(1) // $self->panic("Can't turn off non-blocking IO: $!");
-    return $read;
 }
 
 
@@ -1039,6 +1051,7 @@ sub _fingerprint_match($$$) {
 
 # $self->_getline([$msg])
 #   Read a line from the handle and strip the trailing CRLF.
+#   /!\ Don't use this method with non-blocking IO!
 sub _getline($;$) {
     my $self = shift;
     my $msg = shift // '';