diff options
Diffstat (limited to 'lib/Net/IMAP')
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 24 |
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; |