1use strict;
2
3BEGIN {
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# Hopefully this is never a routeable host
36my $fail_ip = $ENV{NET_PING_FAIL_IP} || "172.29.249.249";
37
38# Try a few remote servers
39my %webs = (
40  $fail_ip => 0,
41
42  # Hopefully all these web ports are open
43  "yahoo.com." => 1,
44  "www.yahoo.com." => 1,
45  "www.about.com." => 1,
46  "www.microsoft.com." => 1,
47);
48
49use Test::More;
50plan tests => 4 + 2 * keys %webs;
51
52use_ok('Net::Ping');
53
54my $can_alarm = eval {alarm 0; 1;};
55
56sub Alarm {
57  alarm(shift) if $can_alarm;
58}
59
60Alarm(50);
61$SIG{ALRM} = sub {
62  fail('Alarm timed out');
63  die "TIMED OUT!";
64};
65
66my $p = new Net::Ping "syn", 10;
67
68isa_ok($p, 'Net::Ping', 'new() worked');
69
70# Change to use the more common web port.
71# (Make sure getservbyname works in scalar context.)
72cmp_ok(($p->{port_num} = getservbyname("http", "tcp")), '>', 0, 'valid port');
73
74# message_type can't be used
75eval {
76  $p->message_type();
77};
78like($@, qr/message type only supported on 'icmp' protocol/, "message_type() API only concern 'icmp' protocol");
79
80# check if network is up
81eval { $p->ping('www.google.com.'); };
82if ($@ =~ /getaddrinfo.*failed/) {
83  ok(1, "skip $@");
84  ok(1, "skip") for 0..12;
85  exit;
86}
87foreach my $host (keys %webs) {
88  # ping() does dns resolution and
89  # only sends the SYN at this point
90  Alarm(50); # (Plenty for a DNS lookup)
91  is($p->ping($host), 1, "Can reach $host [" . ($p->{bad}->{$host} || "") . "]");
92}
93
94my $failed;
95Alarm(20);
96while (my $host = $p->ack()) {
97  next if $host eq 'www.google.com.';
98  $failed += !is($webs{$host}, 1, "supposed to be up: http://$host/");
99  delete $webs{$host};
100}
101
102Alarm(0);
103foreach my $host (keys %webs) {
104  $failed += !is($webs{$host}, 0,
105                "supposed to be down: http://$host/ [" . ($p->{bad}->{$host} || "") . "]");
106}
107
108if ($failed) {
109  diag ("NOTE: ",
110        "Network connectivity will be required for all tests to pass.\n",
111        "Firewalls may also cause some tests to fail, so test it ",
112        "on a clear network.");
113}
114