diff options
author | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2014-09-13 19:44:08 +0100 |
---|---|---|
committer | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2014-09-13 19:44:08 +0100 |
commit | cdfcfc0b6c787e44466e6a226452244d720a1f4f (patch) | |
tree | 37d1552446c7a67192c77435f60dc37a6aad6d6a | |
parent | 019bf6638b0c7be4646504d16e256447855632d3 (diff) | |
download | perl-cdfcfc0b6c787e44466e6a226452244d720a1f4f.tar.gz |
Update IO-Socket-IP to CPAN version 0.32
[DELTA]
0.32 2014/09/12 10:11:27
[CHANGES]
* Implementation of Timeout for ->connect (RT92075)
-rw-r--r-- | MANIFEST | 1 | ||||
-rwxr-xr-x | Porting/Maintainers.pl | 2 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/lib/IO/Socket/IP.pm | 105 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/02local-server-v4.t | 1 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/03local-cross-v4.t | 1 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/05local-server-v6.t | 1 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/06local-cross-v6.t | 1 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/15io-socket.t | 2 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/16v6only.t | 4 | ||||
-rw-r--r-- | cpan/IO-Socket-IP/t/22timeout.t | 29 |
10 files changed, 137 insertions, 10 deletions
@@ -1338,6 +1338,7 @@ cpan/IO-Socket-IP/t/18fdopen.t IO::Socket::IP tests cpan/IO-Socket-IP/t/19no-addrs.t IO::Socket::IP tests cpan/IO-Socket-IP/t/20subclass.t IO::Socket::IP tests cpan/IO-Socket-IP/t/21as-inet.t IO::Socket::IP tests +cpan/IO-Socket-IP/t/22timeout.t cpan/IO-Socket-IP/t/30nonblocking-connect.t IO::Socket::IP tests cpan/IO-Socket-IP/t/31nonblocking-connect-internet.t IO::Socket::IP tests cpan/IO-Socket-IP/t/99pod.t IO::Socket::IP tests diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 7e641f27c9..8bd4918cb9 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -630,7 +630,7 @@ use File::Glob qw(:case); }, 'IO::Socket::IP' => { - 'DISTRIBUTION' => 'PEVANS/IO-Socket-IP-0.31.tar.gz', + 'DISTRIBUTION' => 'PEVANS/IO-Socket-IP-0.32.tar.gz', 'FILES' => q[cpan/IO-Socket-IP], 'EXCLUDED' => [ qr{^examples/}, diff --git a/cpan/IO-Socket-IP/lib/IO/Socket/IP.pm b/cpan/IO-Socket-IP/lib/IO/Socket/IP.pm index af783f23b8..8ebc44a433 100644 --- a/cpan/IO-Socket-IP/lib/IO/Socket/IP.pm +++ b/cpan/IO-Socket-IP/lib/IO/Socket/IP.pm @@ -7,7 +7,7 @@ package IO::Socket::IP; # $VERSION needs to be set before use base 'IO::Socket' # - https://rt.cpan.org/Ticket/Display.html?id=92107 BEGIN { - $VERSION = '0.31'; + $VERSION = '0.32'; } use strict; @@ -31,7 +31,7 @@ use Socket 1.97 qw( my $AF_INET6 = eval { Socket::AF_INET6() }; # may not be defined my $AI_ADDRCONFIG = eval { Socket::AI_ADDRCONFIG() } || 0; use POSIX qw( dup2 ); -use Errno qw( EINVAL EINPROGRESS EISCONN ); +use Errno qw( EINVAL EINPROGRESS EISCONN ETIMEDOUT EWOULDBLOCK ); use constant HAVE_MSWIN32 => ( $^O eq "MSWin32" ); @@ -304,6 +304,22 @@ If defined but false, the socket will be set to non-blocking mode. Otherwise it will default to blocking mode. See the NON-BLOCKING section below for more detail. +=item Timeout => NUM + +If defined, gives a maximum time in seconds to block per C<connect()> call +when in blocking mode. If missing, no timeout is applied other than that +provided by the underlying operating system. When in non-blocking mode this +parameter is ignored. + +Note that if the hostname resolves to multiple address candidates, the same +timeout will apply to each connection attempt individually, rather than to the +operation as a whole. Further note that the timeout does not apply to the +initial hostname resolve operation, if connecting by hostname. + +This behviour is copied inspired by C<IO::Socket::INET>; for more fine grained +control over connection timeouts, consider performing a nonblocking connect +directly. + =back If neither C<Type> nor C<Proto> hints are provided, a default of @@ -611,12 +627,12 @@ sub setup return 0; } - # If connect failed but we have no system error there must be an error - # at the application layer, like a bad certificate with - # IO::Socket::SSL. - # In this case don't continue IP based multi-homing because the problem - # cannot be solved at the IP layer. - return 0 if ! $!; + # If connect failed but we have no system error there must be an error + # at the application layer, like a bad certificate with + # IO::Socket::SSL. + # In this case don't continue IP based multi-homing because the problem + # cannot be solved at the IP layer. + return 0 if ! $!; ${*$self}{io_socket_ip_errors}[0] = $!; next; @@ -641,7 +657,47 @@ sub connect # useful APIs I'm just going to end-run around it and call CORE::connect() # directly - return CORE::connect( $self, $_[0] ) if @_; + if( @_ ) { + my ( $addr ) = @_; + + # Annoyingly IO::Socket's connect() is where the timeout logic is + # implemented, so we'll have to reinvent it here + my $timeout = ${*$self}{'io_socket_timeout'}; + + return CORE::connect( $self, $addr ) unless defined $timeout; + + my $was_blocking = $self->blocking( 0 ); + + my $err = defined CORE::connect( $self, $addr ) ? 0 : $!+0; + + if( !$err ) { + # All happy + return 1; + } + elsif( not( $err == EINPROGRESS or $err == EWOULDBLOCK ) ) { + # Failed for some other reason + return undef; + } + elsif( !$was_blocking ) { + # We shouldn't block anyway + return undef; + } + + my $vec = ''; vec( $vec, $self->fileno, 1 ) = 1; + if( !select( $vec, $vec, $vec, $timeout ) ) { + $! = ETIMEDOUT; + return undef; + } + + # 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; + } return 1 if !${*$self}{io_socket_ip_connect_in_progress}; @@ -1090,6 +1146,37 @@ constructor will ignore the value of this argument, except if it is defined but false. An exception is thrown in this case, because that would request it disable the C<getaddrinfo(3)> search behaviour in the first place. +=item * + +C<IO::Socket::IP> implements both the C<Blocking> and C<Timeout> parameters, +but it implements the interaction of both in a different way. + +In C<::INET>, supplying a timeout overrides the non-blocking behaviour, +meaning that the C<connect()> operation will still block despite that the +caller asked for a non-blocking socket. This is not explicitly specified in +its documentation, nor does this author believe that is a useful behaviour - +it appears to come from a quirk of implementation. + +In C<::IP> therefore, the C<Blocking> parameter takes precedence - if a +non-blocking socket is requested, no operation will block. The C<Timeout> +parameter here simply defines the maximum time that a blocking C<connect()> +call will wait, if it blocks at all. + +In order to specifically obtain the "blocking connect then non-blocking send +and receive" behaviour of specifying this combination of options to C<::INET> +when using C<::IP>, perform first a blocking connect, then afterwards turn the +socket into nonblocking mode. + + my $sock = IO::Socket::IP->new( + PeerHost => $peer, + Timeout => 20, + ) or die "Cannot connect - $@"; + + $sock->blocking( 0 ); + +This code will behave identically under both C<IO::Socket::INET> and +C<IO::Socket::IP>. + =back =cut diff --git a/cpan/IO-Socket-IP/t/02local-server-v4.t b/cpan/IO-Socket-IP/t/02local-server-v4.t index d1f2b40f45..bca5b83127 100644 --- a/cpan/IO-Socket-IP/t/02local-server-v4.t +++ b/cpan/IO-Socket-IP/t/02local-server-v4.t @@ -27,6 +27,7 @@ foreach my $socktype (qw( SOCK_STREAM SOCK_DGRAM )) { my $testserver = IO::Socket::IP->new( ( $socktype eq "SOCK_STREAM" ? ( Listen => 1 ) : () ), LocalHost => "127.0.0.1", + Port => 0, Type => Socket->$socktype, ); diff --git a/cpan/IO-Socket-IP/t/03local-cross-v4.t b/cpan/IO-Socket-IP/t/03local-cross-v4.t index 532b78cc6c..4d75d959d0 100644 --- a/cpan/IO-Socket-IP/t/03local-cross-v4.t +++ b/cpan/IO-Socket-IP/t/03local-cross-v4.t @@ -11,6 +11,7 @@ foreach my $socktype (qw( SOCK_STREAM SOCK_DGRAM )) { my $testserver = IO::Socket::IP->new( ( $socktype eq "SOCK_STREAM" ? ( Listen => 1 ) : () ), LocalHost => "127.0.0.1", + Port => 0, Type => Socket->$socktype, ) or die "Cannot listen on PF_INET - $@"; diff --git a/cpan/IO-Socket-IP/t/05local-server-v6.t b/cpan/IO-Socket-IP/t/05local-server-v6.t index 22ee59e3ce..27664b6991 100644 --- a/cpan/IO-Socket-IP/t/05local-server-v6.t +++ b/cpan/IO-Socket-IP/t/05local-server-v6.t @@ -33,6 +33,7 @@ foreach my $socktype (qw( SOCK_STREAM SOCK_DGRAM )) { my $testserver = IO::Socket::IP->new( ( $socktype eq "SOCK_STREAM" ? ( Listen => 1 ) : () ), LocalHost => "::1", + Port => 0, Type => Socket->$socktype, GetAddrInfoFlags => 0, # disable AI_ADDRCONFIG ); diff --git a/cpan/IO-Socket-IP/t/06local-cross-v6.t b/cpan/IO-Socket-IP/t/06local-cross-v6.t index c4842b7959..8d40f4a495 100644 --- a/cpan/IO-Socket-IP/t/06local-cross-v6.t +++ b/cpan/IO-Socket-IP/t/06local-cross-v6.t @@ -14,6 +14,7 @@ foreach my $socktype (qw( SOCK_STREAM SOCK_DGRAM )) { my $testserver = IO::Socket::IP->new( ( $socktype eq "SOCK_STREAM" ? ( Listen => 1 ) : () ), LocalHost => "::1", + Port => 0, Type => Socket->$socktype, ) or die "Cannot listen on PF_INET6 - $@"; diff --git a/cpan/IO-Socket-IP/t/15io-socket.t b/cpan/IO-Socket-IP/t/15io-socket.t index 8acc9a75e9..07472941a6 100644 --- a/cpan/IO-Socket-IP/t/15io-socket.t +++ b/cpan/IO-Socket-IP/t/15io-socket.t @@ -15,6 +15,7 @@ use IO::Socket::IP -register; Type => SOCK_STREAM, LocalHost => "127.0.0.1", LocalPort => 0, + GetAddrInfoFlags => 0, # disable AI_ADDRCONFIG ); isa_ok( $sock, "IO::Socket::IP", 'IO::Socket->new( Domain => AF_INET )' ) or @@ -41,6 +42,7 @@ SKIP: { Type => SOCK_STREAM, LocalHost => "::1", LocalPort => 0, + GetAddrInfoFlags => 0, # disable AI_ADDRCONFIG ); isa_ok( $sock, "IO::Socket::IP", 'IO::Socket->new( Domain => AF_INET6 )' ) or diff --git a/cpan/IO-Socket-IP/t/16v6only.t b/cpan/IO-Socket-IP/t/16v6only.t index 4aeb4e0cb7..8e3ee31751 100644 --- a/cpan/IO-Socket-IP/t/16v6only.t +++ b/cpan/IO-Socket-IP/t/16v6only.t @@ -25,6 +25,7 @@ my $ECONNREFUSED_STR = "$!"; LocalPort => 0, Type => SOCK_STREAM, V6Only => 1, + GetAddrInfoFlags => 0, # disable AI_ADDRCONFIG ) or die "Cannot listen on PF_INET6 - $@"; is( $listensock->getsockopt( IPPROTO_IPV6, IPV6_V6ONLY ), 1, 'IPV6_V6ONLY is 1 on $listensock' ); @@ -34,6 +35,7 @@ my $ECONNREFUSED_STR = "$!"; PeerHost => "127.0.0.1", PeerPort => $listensock->sockport, Type => SOCK_STREAM, + GetAddrInfoFlags => 0, # disable AI_ADDRCONFIG ); my $err = "$@"; @@ -52,6 +54,7 @@ SKIP: { LocalPort => 0, Type => SOCK_STREAM, V6Only => 0, + GetAddrInfoFlags => 0, # disable AI_ADDRCONFIG ) or die "Cannot listen on PF_INET6 - $@"; is( $listensock->getsockopt( IPPROTO_IPV6, IPV6_V6ONLY ), 0, 'IPV6_V6ONLY is 0 on $listensock' ); @@ -61,6 +64,7 @@ SKIP: { PeerHost => "127.0.0.1", PeerPort => $listensock->sockport, Type => SOCK_STREAM, + GetAddrInfoFlags => 0, # disable AI_ADDRCONFIG ); my $err = "$@"; diff --git a/cpan/IO-Socket-IP/t/22timeout.t b/cpan/IO-Socket-IP/t/22timeout.t new file mode 100644 index 0000000000..48bc697f5c --- /dev/null +++ b/cpan/IO-Socket-IP/t/22timeout.t @@ -0,0 +1,29 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +use IO::Socket::IP; + +my $server = IO::Socket::IP->new( + Listen => 1, + LocalHost => "127.0.0.1", + LocalPort => 0, +) or die "Cannot listen on PF_INET - $!"; + +my $client = IO::Socket::IP->new( + PeerHost => $server->sockhost, + PeerPort => $server->sockport, + Timeout => 0.1, +) or die "Cannot connect on PF_INET - $!"; + +ok( defined $client, 'client constructed with Timeout' ); + +my $accepted = $server->accept + or die "Cannot accept - $!"; + +ok( defined $accepted, 'accepted a client' ); + +done_testing; |