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