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