p5pRT
commented
12 years ago From carson@taltos.org
Created by carson@taltos.org
The async connect() logic in IO::Socket is broken for Solaris (and almost certainly other OS variants). It assumes you're allowed to call connect() a second time\, which is not at all guaranteed. Solaris correctly returns EINVAL when IO::Socket does so (as does Windows\, but they spell it WSAEINVAL\, and there is code that handles that already).
There was a recent commit to change the select() logic\, but it's still wrong.
Below is some very lightly tested code that tries to do the right thing on all platforms.
sub connect { @_ == 2 or croak 'usage: $sock->connect(NAME)'; my $sock = shift; my $addr = shift; my $timeout = ${*$sock}{'io_socket_timeout'}; my $err; my $blocking;
$blocking = $sock->blocking(0) if $timeout; if (!connect($sock\, $addr)) { if (defined $timeout && ($!{EINPROGRESS} || $!{EWOULDBLOCK})) { require IO::Select;
my $sel = new IO::Select $sock;
undef $!; my($r\,$w\,$e) = IO::Select::select($sel\,$sel\,$sel\,$timeout); if (!defined($r) && !defined($w) && !defined($e)) { # select returns an empty list on timeout or other error $err = $!; if ($err == 0) { # timeout $err = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1); $@ = "connect: timeout"; } } elsif(@$w[0] || @$r[0]) { # select() returns writable when connect() completes # select() returns readable if there's an error # if both\, we either received data very quickly\, or it's # an odd OS specific error behaviour. if (@$r[0]) { if (exists(&Socket::SO_ERROR)) { # The best way to get the error state\, if supported $err = $sock->getsockopt(SOL_SOCKET\,SO_ERROR); if ($err == 0) { undef $err; } } else { # If SO_ERROR isn't supported\, the options to get # the error code are all bad. sysread($fd\, $junk\, 0) # works on some systems. Calling connect() again # works on others. But neither is reliable in # portable code. The only portable option is # getpeername()\, which returns a generic error. if (! getpeername($sock)) { $err = $!; } } } } elsif(@$e[0]) { # We really shouldn't ever get here. Exception means # OOB data is waiting on most UNIX platforms\, and # should never be set without read or write. # Windows return from select after the timeout in case of # WSAECONNREFUSED(10061) if exception set is not used. # This behavior is different from Linux. # Using the exception # set we now emulate the behavior in Linux # - Karthik Rajagopalan $err = $sock->getsockopt(SOL_SOCKET\,SO_ERROR); $@ = "connect: $err"; } } elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK})) { $err = $!; $@ = "connect: $!"; } }
$sock->blocking(1) if $blocking;
$! = $err if $err;
$err ? undef : $sock; }
Migrated from rt.perl.org#107962 (status was 'open')
Searchable as RT107962$