diff options
author | Guilhem Moulin <guilhem@fripost.org> | 2016-03-08 17:30:48 +0100 |
---|---|---|
committer | Guilhem Moulin <guilhem@fripost.org> | 2016-03-08 17:30:48 +0100 |
commit | c61cd2c80674757c9a910b4d379e5b92f65cbec7 (patch) | |
tree | e5ee5953e833effe3b3431a99d68980757fb3ff9 | |
parent | d0d439750b572250ae00b595d9a742ccbb7b8a4e (diff) |
Net::IMAP::InterIMAP: try again if connect(2) was interrupted.
-rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index be62a9d..785de38 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -1366,15 +1366,18 @@ sub _tcp_connect($$$) { my ($err, @res) = getaddrinfo($host, $port, \%hints); $self->fail("Can't getaddrinfo: $err") if $err ne ''; + SOCKETS: foreach my $ai (@res) { - socket my $s, $ai->{family}, $ai->{socktype}, $ai->{protocol}; + 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 - if (defined $s and connect($s, $ai->{addr})) { - my $flags = fcntl($s, F_GETFL, 0) or $self->panic("fcntl F_GETFL: $!"); - fcntl($s, F_SETFL, $flags | FD_CLOEXEC) or $self->panic("fcntl F_SETFL: $!"); - return $s; + 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_GETFL, 0) or $self->panic("fcntl F_GETFL: $!"); + fcntl($s, F_SETFL, $flags | FD_CLOEXEC) or $self->panic("fcntl F_SETFL: $!"); + return $s; } $self->fail("Can't connect to $host:$port"); } |