Commit | Line | Data |
---|---|---|
e150c453 RS |
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, | |
f1e79f74 | 23 | Timeout => 3, |
e150c453 RS |
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, | |
f1e79f74 | 61 | Timeout => 3, |
e150c453 RS |
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; |