1# Same as 400_ping_sync.t, but port should be included in return 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# Hopefully this is never a routeable host 36my $fail_ip = $ENV{NET_PING_FAIL_IP} || "192.0.2.0"; 37 38# Try a few remote servers 39my %webs; 40my @hosts = ( 41 $fail_ip, 42 43 # Hopefully all these http and https ports are open 44 "www.google.com", 45 "www.duckduckgo.com", 46 "www.microsoft.com", 47); 48 49use Test::More tests => 19; 50 51BEGIN {use_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 = Net::Ping->new("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 for http/tcp'); 72 73my %contacted; 74foreach my $host (@hosts) { 75 # ping() does dns resolution and 76 # only sends the SYN at this point 77 Alarm(50); # (Plenty for a DNS lookup) 78 foreach my $port (80, 443) { 79 $p->port_number($port); 80 is($p->ping($host), 1, "Sent SYN to $host at port $port [" . ($p->{bad}->{$host} || "") . "]"); 81 $contacted{"$host:$port"} = 1; 82 } 83} 84 85Alarm(20); 86while (my @r = $p->ack()) { 87 my %res; 88 @res{qw(host ack_time ip port)} = @r; 89 my $answered = "$res{host}:$res{port}"; 90 like($answered, qr/^[\w\.]+:\d+$/, "Supposed to be up: $res{host}:$res{port}"); 91 delete $contacted{$answered}; 92} 93 94Alarm(0); 95# $fail_ip should not be reachable 96is keys %contacted, 2, 97 '2 servers did not acknowledge our ping' 98 or diag sort keys %contacted; 99delete $contacted{$_} 100 foreach ("$fail_ip:80","$fail_ip:443", 'www.about.com:443'); 101is keys %contacted, 0, 102 'The servers that did not acknowledge our ping were correct'; 103