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