cpan/IO-Socket-IP/t/31nonblocking-connect-internet.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 use IO::Socket::IP;
   9
  10 use IO::Socket::INET;
  11 use Errno qw( EINPROGRESS EWOULDBLOCK ECONNREFUSED );
  12
  13 # Chris Williams (BINGOS) has offered cpanidx.org as a TCP testing server here
  14 my $test_host = "cpanidx.org";
  15 my $test_good_port = 80;
  16 my $test_bad_port = 6666;
  17
  18 SKIP: {
  19    IO::Socket::INET->new(
  20       PeerHost => $test_host,
  21       PeerPort => $test_good_port,
  22       Type     => SOCK_STREAM,
  23       Timeout  => 3,
  24    ) or skip "Can't connect to $test_host:$test_good_port", 5;
  25
  26    my $socket = IO::Socket::IP->new(
  27       PeerHost    => $test_host,
  28       PeerService => $test_good_port,
  29       Type        => SOCK_STREAM,
  30       Blocking    => 0,
  31    );
  32
  33    ok( defined $socket, "defined \$socket for $test_host:$test_good_port" ) or
  34       diag( "  error was $@" );
  35
  36    ok( defined $socket->fileno, '$socket has fileno' );
  37
  38    ok( !$socket->connected, '$socket not yet connected' );
  39
  40    while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) {
  41       my $wvec = '';
  42       vec( $wvec, fileno $socket, 1 ) = 1;
  43       my $evec = '';
  44       vec( $evec, fileno $socket, 1 ) = 1;
  45
  46       my $ret = select( undef, $wvec, $evec, 60 );
  47       defined $ret or die "Cannot select() - $!";
  48       $ret or die "select() timed out";
  49    }
  50
  51    ok( !$!, '->connect eventually succeeds' );
  52
  53    ok( $socket->connected, '$socket now connected' );
  54 }
  55
  56 SKIP: {
  57    IO::Socket::INET->new(
  58       PeerHost => $test_host,
  59       PeerPort => $test_bad_port,
  60       Type     => SOCK_STREAM,
  61       Timeout  => 3,
  62    ) and skip "Connecting to $test_host:$test_bad_port succeeds", 4;
  63    $! == ECONNREFUSED or skip "Connecting to $test_host:$test_bad_port doesn't give ECONNREFUSED", 4;
  64
  65    my $socket = IO::Socket::IP->new(
  66       PeerHost    => $test_host,
  67       PeerService => $test_bad_port,
  68       Type        => SOCK_STREAM,
  69       Blocking    => 0,
  70    );
  71
  72    ok( defined $socket, "defined \$socket for $test_host:$test_bad_port" ) or
  73       diag( "  error was $@" );
  74
  75    ok( defined $socket->fileno, '$socket has fileno' );
  76
  77    ok( !$socket->connected, '$socket not yet connected' );
  78
  79    while( !$socket->connect and ( $! == EINPROGRESS || $! == EWOULDBLOCK ) ) {
  80       my $wvec = '';
  81       vec( $wvec, fileno $socket, 1 ) = 1;
  82       my $evec = '';
  83       vec( $evec, fileno $socket, 1 ) = 1;
  84
  85       my $ret = select( undef, $wvec, $evec, 60 );
  86       defined $ret or die "Cannot select() - $!";
  87       $ret or die "select() timed out";
  88    }
  89
  90    my $dollarbang = $!;
  91
  92    ok( $dollarbang == ECONNREFUSED, '->connect eventually fails with ECONNREFUSED' ) or
  93       diag( "  dollarbang = $dollarbang" );
  94 }
  95
  96 done_testing;