diff options
author | Guilhem Moulin <guilhem@fripost.org> | 2015-07-26 01:36:48 +0200 |
---|---|---|
committer | Guilhem Moulin <guilhem@fripost.org> | 2015-07-26 01:46:00 +0200 |
commit | 1c78a883849c5ffc4e2fbd84dc912dec18486759 (patch) | |
tree | f027562a610330711372c2c2f4b61dcd96ba5489 /lib/Net/IMAP/Sync.pm | |
parent | 71cddb9e85ae0ea2468c64687319677e6bc9746a (diff) |
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.
Diffstat (limited to 'lib/Net/IMAP/Sync.pm')
-rw-r--r-- | lib/Net/IMAP/Sync.pm | 29 |
1 files changed, 21 insertions, 8 deletions
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 // ''; |