Move Net::Ping from ext/ to dist/
[perl.git] / dist / Net-Ping / t / 400_ping_syn.t
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     }
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
38   # Hopefully all these web ports are open
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,
45   "127.0.0.1" => 1,
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
56 my $can_alarm = eval {alarm 0; 1;};
57
58 sub Alarm {
59   alarm(shift) if $can_alarm;
60 }
61
62 Alarm(50);
63 $SIG{ALRM} = sub {
64   ok 0;
65   die "TIMED OUT!";
66 };
67
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
80   Alarm(50); # (Plenty for a DNS lookup)
81   if (!ok $p -> ping($host)) {
82     print STDERR "CANNOT RESOLVE $host $p->{bad}->{$host}\n";
83   }
84 }
85
86 Alarm(20);
87 while (my $host = $p->ack()) {
88   if (!ok $webs->{$host}) {
89     print STDERR "SUPPOSED TO BE DOWN: http://$host/\n";
90   }
91   delete $webs->{$host};
92 }
93
94 Alarm(0);
95 foreach my $host (keys %{ $webs }) {
96   if (!ok !$webs->{$host}) {
97     print STDERR "DOWN: http://$host/ [",($p->{bad}->{$host} || ""),"]\n";
98   }
99 }