aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2016-03-12 00:52:42 +0100
committerGuilhem Moulin <guilhem@fripost.org>2016-03-12 00:53:34 +0100
commit32ba1586d1c11a25ad1f947329a0edabbcbc340f (patch)
tree26818f5b748640f6f554d53e96893c77911eb8f9 /lib/Net
parentd4f52ae67f007ceacfc1a3ea2d0678600b0df73d (diff)
Net::IMAP::InterIMAP: set SO_{RCV,SND}TIMEO on the socket so we can detect dead peers
Diffstat (limited to 'lib/Net')
-rw-r--r--lib/Net/IMAP/InterIMAP.pm24
1 files changed, 11 insertions, 13 deletions
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;