Use TCP keepalive to detect dead peers.

diff --git a/Changelog b/Changelog
index 79a7ea42c839d218a49e5bbdd794ffe54a7efffa..8cd8be23aeb29d68cc358a6c17305312160fe571 100644 (file)
--- a/Changelog
+++ b/Changelog
@@ -22,9 +22,6 @@ interimap (0.2) upstream;
     IPv6.  (Both are core Perl module.)
   * Add a configuration option 'proxy' to proxy TCP connections to the
     IMAP server.
-  * Don't set SO_KEEPALIVE on the socket.  This is most likely useless
-    in our case since the TCP keepalive time is usually much higher than
-    the IMAP timeout.
   * Set X.509 certificate purpose to 'SSL Server' for SSL_verify=YES.
   * Display the certificate chain, SSL protocol and cipher in debug
     mode.

diff --git a/interimap b/interimap
index 45a6643ac0aeab49ed86d6dacd1754967b75ed00..54ae0aaa75886e8e3fee613eb369e3c71b40b647 100755 (executable)
--- a/interimap
+++ b/interimap
@@ -248,6 +248,7 @@ foreach my $name (qw/local remote/) {
     $config{name} = $name;
     $config{'logger-fd'} = $LOGGER_FD if defined $LOGGER_FD;
     $config{'compress'} //= ($name eq 'local' ? 0 : 1);
+    $config{keepalive} = 1 if $CONFIG{watch} and $config{type} ne 'tunnel';
 
     $IMAP->{$name} = { client => Net::IMAP::InterIMAP::->new(%config) };
     my $client = $IMAP->{$name}->{client};

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index bf3329477c8284bfb7f66b9f389b6c1305c5de4b..d6c46a8602481cae424896db393627c91edd5181 100644 (file)
--- 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/;