Blame t/31nonblocking-connect-internet.t

Packit Service 64bc36
#!/usr/bin/perl
Packit Service 64bc36
Packit Service 64bc36
use strict;
Packit Service 64bc36
use warnings;
Packit Service 64bc36
Packit Service 64bc36
use Test::More;
Packit Service 64bc36
Packit Service 64bc36
use IO::Socket::IP;
Packit Service 64bc36
Packit Service 64bc36
use IO::Socket::INET;
Packit Service 64bc36
use Errno qw( EINPROGRESS EWOULDBLOCK ECONNREFUSED );
Packit Service 64bc36
Packit Service 64bc36
# Chris Williams (BINGOS) has offered cpanidx.org as a TCP testing server here
Packit Service 64bc36
my $test_host = "cpanidx.org";
Packit Service 64bc36
my $test_good_port = 80;
Packit Service 64bc36
my $test_bad_port = 6666;
Packit Service 64bc36
Packit Service 64bc36
SKIP: {
Packit Service 64bc36
   IO::Socket::INET->new(
Packit Service 64bc36
      PeerHost => $test_host,
Packit Service 64bc36
      PeerPort => $test_good_port,
Packit Service 64bc36
      Type     => SOCK_STREAM,
Packit Service 64bc36
      Timeout  => 3,
Packit Service 64bc36
   ) or skip "Can't connect to $test_host:$test_good_port", 5;
Packit Service 64bc36
Packit Service 64bc36
   my $socket = IO::Socket::IP->new(
Packit Service 64bc36
      PeerHost    => $test_host,
Packit Service 64bc36
      PeerService => $test_good_port,
Packit Service 64bc36
      Type        => SOCK_STREAM,
Packit Service 64bc36
      Blocking    => 0,
Packit Service 64bc36
   );
Packit Service 64bc36
Packit Service 64bc36
   ok( defined $socket, "defined \$socket for $test_host:$test_good_port" ) or
Packit Service 64bc36
      diag( "  error was $@" );
Packit Service 64bc36
Packit Service 64bc36
   ok( defined $socket->fileno, '$socket has fileno' );
Packit Service 64bc36
Packit Service 64bc36
   ok( !$socket->connected, '$socket not yet connected' );
Packit Service 64bc36
Packit Service 64bc36
   while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) {
Packit Service 64bc36
      my $wvec = '';
Packit Service 64bc36
      vec( $wvec, fileno $socket, 1 ) = 1;
Packit Service 64bc36
      my $evec = '';
Packit Service 64bc36
      vec( $evec, fileno $socket, 1 ) = 1;
Packit Service 64bc36
Packit Service 64bc36
      my $ret = select( undef, $wvec, $evec, 60 );
Packit Service 64bc36
      defined $ret or die "Cannot select() - $!";
Packit Service 64bc36
      $ret or die "select() timed out";
Packit Service 64bc36
   }
Packit Service 64bc36
Packit Service 64bc36
   ok( !$!, '->connect eventually succeeds' );
Packit Service 64bc36
Packit Service 64bc36
   ok( $socket->connected, '$socket now connected' );
Packit Service 64bc36
}
Packit Service 64bc36
Packit Service 64bc36
SKIP: {
Packit Service 64bc36
   IO::Socket::INET->new(
Packit Service 64bc36
      PeerHost => $test_host,
Packit Service 64bc36
      PeerPort => $test_bad_port,
Packit Service 64bc36
      Type     => SOCK_STREAM,
Packit Service 64bc36
      Timeout  => 3,
Packit Service 64bc36
   ) and skip "Connecting to $test_host:$test_bad_port succeeds", 4;
Packit Service 64bc36
   $! == ECONNREFUSED or skip "Connecting to $test_host:$test_bad_port doesn't give ECONNREFUSED", 4;
Packit Service 64bc36
Packit Service 64bc36
   my $socket = IO::Socket::IP->new(
Packit Service 64bc36
      PeerHost    => $test_host,
Packit Service 64bc36
      PeerService => $test_bad_port,
Packit Service 64bc36
      Type        => SOCK_STREAM,
Packit Service 64bc36
      Blocking    => 0,
Packit Service 64bc36
   );
Packit Service 64bc36
Packit Service 64bc36
   ok( defined $socket, "defined \$socket for $test_host:$test_bad_port" ) or
Packit Service 64bc36
      diag( "  error was $@" );
Packit Service 64bc36
Packit Service 64bc36
   ok( defined $socket->fileno, '$socket has fileno' );
Packit Service 64bc36
Packit Service 64bc36
   ok( !$socket->connected, '$socket not yet connected' );
Packit Service 64bc36
Packit Service 64bc36
   while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) {
Packit Service 64bc36
      my $wvec = '';
Packit Service 64bc36
      vec( $wvec, fileno $socket, 1 ) = 1;
Packit Service 64bc36
      my $evec = '';
Packit Service 64bc36
      vec( $evec, fileno $socket, 1 ) = 1;
Packit Service 64bc36
Packit Service 64bc36
      my $ret = select( undef, $wvec, $evec, 60 );
Packit Service 64bc36
      defined $ret or die "Cannot select() - $!";
Packit Service 64bc36
      $ret or die "select() timed out";
Packit Service 64bc36
   }
Packit Service 64bc36
Packit Service 64bc36
   my $dollarbang = $!;
Packit Service 64bc36
Packit Service 64bc36
   ok( $dollarbang == ECONNREFUSED, '->connect eventually fails with ECONNREFUSED' ) or
Packit Service 64bc36
      diag( "  dollarbang = $dollarbang" );
Packit Service 64bc36
}
Packit Service 64bc36
Packit Service 64bc36
done_testing;