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