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)

8 files changed, 135 insertions, 9 deletions

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;