From 93d2e96fde87cbeb1c32ea556c0b4d3591ec41ba Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Sat, 12 Mar 2016 01:10:30 +0100
Subject: 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.
---
 lib/Net/IMAP/InterIMAP.pm | 24 +++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

(limited to 'lib')

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;
 }
 
 
-- 
cgit v1.2.3