1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use Test::More; 7 8use IO::Socket::IP; 9 10use IO::Socket::INET; 11use Errno qw( EINPROGRESS EWOULDBLOCK ECONNREFUSED ); 12 13# Chris Williams (BINGOS) has offered cpanidx.org as a TCP testing server here 14my $test_host = "cpanidx.org"; 15my $test_good_port = 80; 16my $test_bad_port = 6666; 17 18SKIP: { 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 56SKIP: { 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 96done_testing; 97