Use TCP keepalive to detect dead peers.

1 files changed, 20 insertions, 0 deletions

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index bf33294..d6c46a8 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -228,6 +228,9 @@ our $IMAP_text;
 #
 #   - 'logger-fd': An optional filehandle to use for debug output.
 #
+#   - 'keepalive': Whether to enable sending of keep-alive messages.
+#     (type=imap or type=imaps).
+#
 sub new($%) {
     my $class = shift;
     my $self = { @_ };
@@ -289,6 +292,23 @@ sub new($%) {
         }
         my $socket = defined $self->{proxy} ? $self->_proxify(@$self{qw/proxy host port/})
                                             : $self->_tcp_connect(@$self{qw/host port/});
+        my ($cnt, $intvl) = (3, 5);
+        if (defined $self->{keepalive}) {
+            # detect dead peers and drop the connection after 60 secs + $cnt*$intvl
+            setsockopt($socket, Socket::SOL_SOCKET, Socket::SO_KEEPALIVE, 1)
+                or $self->fail("Can't setsockopt SO_KEEPALIVE: $!");
+            setsockopt($socket, Socket::IPPROTO_TCP, Socket::TCP_KEEPIDLE, 60)
+                or $self->fail("Can't setsockopt TCP_KEEPIDLE: $!");
+            setsockopt($socket, Socket::IPPROTO_TCP, Socket::TCP_KEEPCNT, $cnt)
+                or $self->fail("Can't setsockopt TCP_KEEPCNT: $!");
+            setsockopt($socket, Socket::IPPROTO_TCP, Socket::TCP_KEEPINTVL, $intvl)
+                or $self->fail("Can't setsockopt TCP_KEEPINTVL: $!");
+        }
+        # Abort after 15secs if write(2) isn't acknowledged
+        # XXX Socket::TCP_USER_TIMEOUT isn't defined.
+        # `grep TCP_USER_TIMEOUT /usr/include/linux/tcp.h` gives 18
+        setsockopt($socket, Socket::IPPROTO_TCP, 18, 1000 * $cnt * $intvl)
+            or $self->fail("Can't setsockopt TCP_USER_TIMEOUT: $!");
 
         $self->_start_ssl($socket) if $self->{type} eq 'imaps';
         $self->{$_} = $socket for qw/STDOUT STDIN/;