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