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