Net::IMAP::InterIMAP: set SO_{RCV,SND}TIMEO on the socket so we can detect dead peers

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