From 32ba1586d1c11a25ad1f947329a0edabbcbc340f Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Sat, 12 Mar 2016 00:52:42 +0100
Subject: Net::IMAP::InterIMAP: set SO_{RCV,SND}TIMEO on the socket so we can
 detect dead peers

---
 lib/Net/IMAP/InterIMAP.pm | 24 +++++++++++-------------
 1 file changed, 11 insertions(+), 13 deletions(-)

(limited to 'lib')

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index f3e9c9e..e7a86aa 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -323,23 +323,12 @@ 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: $!");
 
         binmode($socket) // $self->panic("binmode: $!");
         $self->_start_ssl($socket) if $self->{type} eq 'imaps';
@@ -1380,12 +1369,21 @@ sub _tcp_connect($$$) {
     SOCKETS:
     foreach my $ai (@res) {
         socket (my $s, $ai->{family}, $ai->{socktype}, $ai->{protocol}) or $self->panic("connect: $!");
-        # TODO: add a connection timeout
-        # http://devpit.org/wiki/Connect%28%29_with_timeout_%28in_Perl%29
+
+        # timeout connect/read/write/... after 30s
+        # XXX we need to pack the struct timeval manually: not portable!
+        # https://stackoverflow.com/questions/8284243/how-do-i-set-so-rcvtimeo-on-a-socket-in-perl
+        my $timeout = pack('l!l!', 30, 0);
+        setsockopt($s, Socket::SOL_SOCKET, Socket::SO_RCVTIMEO, $timeout)
+                or $self->fail("Can't setsockopt SO_RCVTIMEO: $!");
+        setsockopt($s, Socket::SOL_SOCKET, Socket::SO_SNDTIMEO, $timeout)
+                or $self->fail("Can't setsockopt SO_RCVTIMEO: $!");
+
         until (connect($s, $ai->{addr})) {
             next if $! == EINTR; # try again if connect(2) was interrupted by a signal
             next SOCKETS;
         }
+
         my $flags = fcntl($s, F_GETFD, 0)       or $self->panic("fcntl F_GETFD: $!");
         fcntl($s, F_SETFD, $flags | FD_CLOEXEC) or $self->panic("fcntl F_SETFD: $!");
         return $s;
-- 
cgit v1.2.3