After some more debugging, I found there are 3 ways to fix this on my system. My 2 core 1 CPU Win XP box will never die with $! 22 unless I have very high CPU usage. My Server 2003 box with 2 core x 4 CPUs fails with $! 22 about 95% of the time, making CPAN shell unusable since HTTP::Tiny is unusable.
-------------------------------------------------------
sub connect
-------------------------------------------------------
my $vec = ''; vec( $vec, $self->fileno, 1 ) = 1;
my ($r, $w, $e) = ($vec, $vec, $vec);
if( !select( $r, $w, $e, $timeout ) ) {
$! = ETIMEDOUT;
return undef;
}
#remove 2nd connect call, why is it here? select provides info whether a connection was made or not
$err = '';
$! = $err, return undef if $err;
return 1;
}
-------------------------------------------------------
my $vec = ''; vec( $vec, $self->fileno, 1 ) = 1;
my ($r, $w, $e) = ($vec, $vec, $vec);
if( !select( $r, $w, $e, $timeout ) ) {
$! = ETIMEDOUT;
return undef;
}
# Hoist the error by connect()ing a second time
$err = defined CORE::connect( $self, $addr ) ? 0 : $!+0;
#windows reports EINVAL on Win2k and newer, since calling connect twice without a closesocket() in between is an "error" according to MS thinking, and is not an authorized way of finding out if the non blocking connection finished
#see
http://msdn.microsoft.com/en-us/library/windows/desktop/ms737625%28v=vs.85%29.aspx
$err = 0 if $err == EISCONN || $err == EINVAL; # Some OSes give EISCONN
$self->blocking( $was_blocking );
$! = $err, return undef if $err;
return 1;
}
-------------------------------------------------------
my $vec = ''; vec( $vec, $self->fileno, 1 ) = 1;
my ($r, $w, $e) = ($vec, $vec, $vec);
if( !select( $r, $w, $e, $timeout ) ) {
$! = ETIMEDOUT;
return undef;
}
#very bad fix but it works for me
sleep 1;
# Hoist the error by connect()ing a second time
$err = defined CORE::connect( $self, $addr ) ? 0 : $!+0;
$err = 0 if $err == EISCONN; # Some OSes give EISCONN
$self->blocking( $was_blocking );
$! = $err, return undef if $err;
return 1;
}
-------------------------------------------------------
How come readability is being checked in the select call in your original code? writeability determines when the connection occurs according to MS and from a POSIX person, on POSIX too.
Here is a block of code from IO::Socket, notice the "$^O eq 'MSWin32'"
-------------------------------------------------------
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(undef,$sel,$sel,$timeout);
if(@$e[0]) {
# 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(!@$w[0]) {
$err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
$@ = "connect: timeout";
}
elsif (!connect($sock,$addr) &&
not ($!{EISCONN} || ($^O eq 'MSWin32' &&
($! == (($] < 5.019004) ? 10022 : Errno::EINVAL))))
) {
# Some systems refuse to re-connect() to
# an already open socket and set errno to EISCONN.
# Windows sets errno to WSAEINVAL (10022) (pre-5.19.4) or
# EINVAL (22) (5.19.4 onwards).
$err = $!;
$@ = "connect: $!";
}
}
-------------------------------------------------------
