Commit | Line | Data |
69c74a9c |
1 | # Same as 400_ping_syn.t but testing ack( $host ) instead of ack( ). |
2 | |
3 | BEGIN { |
4 | if ($ENV{PERL_CORE}) { |
5 | unless ($ENV{PERL_TEST_Net_Ping}) { |
6 | print "1..0 # Skip: network dependent test\n"; |
7 | exit; |
8 | } |
9 | chdir 't' if -d 't'; |
10 | @INC = qw(../lib); |
11 | } |
12 | unless (eval "require Socket") { |
13 | print "1..0 \# Skip: no Socket\n"; |
14 | exit; |
15 | } |
16 | unless (getservbyname('echo', 'tcp')) { |
17 | print "1..0 \# Skip: no echo port\n"; |
18 | exit; |
19 | } |
20 | unless (getservbyname('http', 'tcp')) { |
21 | print "1..0 \# Skip: no http port\n"; |
22 | exit; |
23 | } |
24 | } |
25 | |
26 | # Remote network test using syn protocol. |
27 | # |
28 | # NOTE: |
29 | # Network connectivity will be required for all tests to pass. |
30 | # Firewalls may also cause some tests to fail, so test it |
31 | # on a clear network. If you know you do not have a direct |
32 | # connection to remote networks, but you still want the tests |
33 | # to pass, use the following: |
34 | # |
35 | # $ PERL_CORE=1 make test |
36 | |
37 | # Try a few remote servers |
38 | my $webs = { |
39 | # Hopefully this is never a routeable host |
40 | "172.29.249.249" => 0, |
41 | |
42 | # Hopefully all these web ports are open |
43 | "www.geocities.com." => 1, |
44 | "www.freeservers.com." => 1, |
45 | "yahoo.com." => 1, |
46 | "www.yahoo.com." => 1, |
47 | "www.about.com." => 1, |
48 | "www.microsoft.com." => 1, |
49 | "127.0.0.1" => 1, |
50 | }; |
51 | |
52 | use strict; |
53 | use Test; |
54 | use Net::Ping; |
55 | plan tests => ((keys %{ $webs }) * 2 + 3); |
56 | |
57 | # Everything loaded fine |
58 | ok 1; |
59 | |
9c36735d |
60 | my $can_alarm = eval {alarm 0; 1;}; |
61 | |
62 | sub Alarm { |
63 | alarm(shift) if $can_alarm; |
64 | } |
65 | |
66 | Alarm(50); |
69c74a9c |
67 | $SIG{ALRM} = sub { |
68 | ok 0; |
69 | die "TIMED OUT!"; |
70 | }; |
71 | |
72 | my $p = new Net::Ping "syn", 10; |
73 | |
74 | # new() worked? |
75 | ok !!$p; |
76 | |
77 | # Change to use the more common web port. |
78 | # (Make sure getservbyname works in scalar context.) |
79 | ok ($p -> {port_num} = getservbyname("http", "tcp")); |
80 | |
81 | foreach my $host (keys %{ $webs }) { |
82 | # ping() does dns resolution and |
83 | # only sends the SYN at this point |
9c36735d |
84 | Alarm(50); # (Plenty for a DNS lookup) |
69c74a9c |
85 | if (!ok($p -> ping($host))) { |
86 | print STDERR "CANNOT RESOLVE $host $p->{bad}->{$host}\n"; |
87 | } |
88 | } |
89 | |
9c36735d |
90 | Alarm(20); |
69c74a9c |
91 | foreach my $host (sort keys %{ $webs }) { |
92 | my $on = $p->ack($host); |
93 | if (!ok (($on && $webs->{$host}) || |
94 | (!$on && !$webs->{$host}))) { |
95 | if ($on) { |
96 | print STDERR "SUPPOSED TO BE DOWN: http://$host/\n"; |
97 | } else { |
9c36735d |
98 | print STDERR "DOWN: http://$host/ [",($p->{bad}->{$host} || ""),"]\n"; |
69c74a9c |
99 | } |
100 | } |
101 | delete $webs->{$host}; |
9c36735d |
102 | Alarm(20); |
69c74a9c |
103 | } |
104 | |
9c36735d |
105 | Alarm(0); |