aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2016-03-12 01:10:30 +0100
committerGuilhem Moulin <guilhem@fripost.org>2016-03-12 02:18:06 +0100
commit93d2e96fde87cbeb1c32ea556c0b4d3591ec41ba (patch)
tree8b3bbc3d684bcd75e49c18dffb0d0aed0c0f7acd /lib/Net
parent32ba1586d1c11a25ad1f947329a0edabbcbc340f (diff)
Net::IMAP::InterIMAP: quit idling when a time jump of at least 30s is detected
This forces a write, so we can better detect detect dead peers after hibernation for instance.
Diffstat (limited to 'lib/Net')
-rw-r--r--lib/Net/IMAP/InterIMAP.pm24
1 files changed, 15 insertions, 9 deletions
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index e7a86aa..d2bb130 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -931,14 +931,14 @@ sub notify($@) {
}
-# $self->slurp([$callback, $cmd])
+# $self->slurp([$callback, $cmd, $timeout])
# 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 2177 (IDLE) or RFC 5465 (NOTIFY).
-sub slurp($;&$) {
- my ($self, $callback, $cmd) = @_;
+sub slurp($;&$$) {
+ my ($self, $callback, $cmd, $timeout) = @_;
my $ssl = $self->{_SSL};
my $read = 0;
@@ -949,10 +949,11 @@ sub slurp($;&$) {
# 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);
+ my $r = CORE::select($rin, undef, undef, $timeout // 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
+ $timeout = 0; # don't wait during the next select(2) calls
}
my $x = $self->_getline();
$self->_resp($x, $callback, $cmd);
@@ -969,7 +970,7 @@ sub slurp($;&$) {
sub idle($;$&) {
my ($self, $timeout, $stopwhen) = @_;
$timeout //= 1740; # 29 mins
- my $callback = sub() {$timeout = -1 if $stopwhen->()};
+ my $callback = sub() {undef $timeout if $stopwhen->()};
$self->fail("Server did not advertise IDLE (RFC 2177) capability.")
unless $self->_capable('IDLE');
@@ -977,9 +978,14 @@ sub idle($;$&) {
my $tag = $self->_cmd_init('IDLE');
$self->_cmd_flush();
- for (; $timeout > 0; $timeout--) {
- $self->slurp($callback, 'IDLE');
- sleep 1 if $timeout > 0;
+ for (my $now = time;;) {
+ $self->slurp($callback, 'IDLE', 1);
+ last unless defined $timeout;
+ my $delta = time - $now;
+ $timeout -= $delta;
+ # quit idling when a time jump of at least 30s is detected
+ last if $timeout <= 0 or $delta >= 30;
+ $now += $delta;
}
# done idling
@@ -989,7 +995,7 @@ sub idle($;$&) {
# untagged responses between the DONE and the tagged response
$self->_recv($tag, $callback, 'IDLE');
- return $timeout < 0 ? 1 : 0;
+ return (defined $timeout) ? 0 : 1;
}