1# Same as 400_ping_syn.t but testing ack( $host ) instead of ack( ).
2use strict;
3
4BEGIN {
5  if ($ENV{NO_NETWORK_TESTING} ||
6      ($ENV{PERL_CORE} && !$ENV{PERL_TEST_Net_Ping})) {
7    print "1..0 # Skip: network dependent test\n";
8    exit;
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# $ NO_NETWORK_TESTING=1 make test
34
35# Try a few remote servers
36my %webs;
37BEGIN {
38  # Hopefully this is never a routeable host
39  my $fail_ip = $ENV{NET_PING_FAIL_IP} || "192.0.2.0";
40
41  %webs = (
42  $fail_ip => 0,
43
44  # Hopefully all these web ports are open
45  "www.google.com." => 1,
46  "www.freeservers.com." => 1,
47  "yahoo.com." => 1,
48  "www.yahoo.com." => 1,
49  "www.about.com." => 1,
50  "www.microsoft.com." => 1,
51  "127.0.0.1" => 1,
52);
53}
54
55use Test::More tests => 3 + 2 * keys %webs;
56
57BEGIN {use_ok('Net::Ping')};
58
59my $can_alarm = eval {alarm 0; 1;};
60
61sub Alarm {
62  alarm(shift) if $can_alarm;
63}
64
65Alarm(50);
66$SIG{ALRM} = sub {
67  fail('Alarm timed out');
68  die "TIMED OUT!";
69};
70
71my $p = new Net::Ping "syn", 10;
72
73isa_ok($p, 'Net::Ping', 'new(syn, 10) worked');
74
75# Change to use the more common web port.
76# (Make sure getservbyname works in scalar context.)
77cmp_ok(($p->{port_num} = getservbyname("http", "tcp")), '>', 0, 'valid port');
78
79foreach 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  is($p->ping($host), 1, "Can reach $host [" . ($p->{bad}->{$host} || "") . "]");
84}
85
86Alarm(20);
87foreach my $host (sort keys %webs) {
88  my $on = $p->ack($host);
89  if ($on) {
90    if ($webs{$host}) {
91      is($webs{$host}, 1, "ack: supposed to be up http://$host/ [" . ($p->{bad}->{$host} || "") . "]");
92    } else {
93      ok("TODO ack: supposed to be up: http://$host/ [" . ($p->{bad}->{$host} || "") . "]");
94    }
95  } else {
96    if (!$webs{$host}) {
97      is($webs{$host}, 0, "supposed to be down: http://$host/ [" . ($p->{bad}->{$host} || "") . "]");
98    } else {
99      ok("TODO ack: supposed to be down: http://$host/ [" . ($p->{bad}->{$host} || "") . "]");
100    }
101  }
102  delete $webs{$host};
103  Alarm(20);
104}
105
106Alarm(0);
107