aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2015-09-17 22:05:09 +0200
committerGuilhem Moulin <guilhem@fripost.org>2015-09-21 01:01:25 +0200
commit612b9e2102e1907709dde325f91d5fdf70ed2534 (patch)
tree007d69ddd0998924ce81493b2a49a9076d8f020b /lib
parent683a3973a32ee3618824d08ed7ee6cfc7ee9ab02 (diff)
Use TCP keepalive to detect dead peers.
Diffstat (limited to 'lib')
-rw-r--r--lib/Net/IMAP/InterIMAP.pm20
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/;