dist/Net-Ping/t/400_ping_syn.t

   1 use strict;
   2
   3 BEGIN {
   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 # Try a few remote servers
  36 my %webs;
  37 BEGIN {
  38   %webs = (
  39   # Hopefully this is never a routeable host
  40   "172.29.249.249" => 0,
  41
  42   # Hopefully all these web ports are open
  43   "www.geocities.com." => 1,
  44   "www.freeservers.com." => 1,
  45   "yahoo.com." => 1,
  46   "www.yahoo.com." => 1,
  47   "www.about.com." => 1,
  48   "www.microsoft.com." => 1,
  49   "127.0.0.1" => 1,
  50 );
  51 }
  52
  53 use Test::More tests => 3 + 2 * keys %webs;
  54
  55 BEGIN {use_ok('Net::Ping')};
  56
  57 my $can_alarm = eval {alarm 0; 1;};
  58
  59 sub Alarm {
  60   alarm(shift) if $can_alarm;
  61 }
  62
  63 Alarm(50);
  64 $SIG{ALRM} = sub {
  65   fail('Alarm timed out');
  66   die "TIMED OUT!";
  67 };
  68
  69 my $p = new Net::Ping "syn", 10;
  70
  71 isa_ok($p, 'Net::Ping', 'new() worked');
  72
  73 # Change to use the more common web port.
  74 # (Make sure getservbyname works in scalar context.)
  75 cmp_ok(($p->{port_num} = getservbyname("http", "tcp")), '>', 0, 'valid port');
  76
  77 foreach my $host (keys %webs) {
  78   # ping() does dns resolution and
  79   # only sends the SYN at this point
  80   Alarm(50); # (Plenty for a DNS lookup)
  81   is($p->ping($host), 1, "Can reach $host $p->{bad}->{$host}");
  82 }
  83
  84 Alarm(20);
  85 while (my $host = $p->ack()) {
  86   is($webs{$host}, 1, "supposed to be up: http://$host/");
  87   delete $webs{$host};
  88 }
  89
  90 Alarm(0);
  91 foreach my $host (keys %webs) {
  92   is($webs{$host}, 0, "supposed to be down: http://$host/ [" . ($p->{bad}->{$host} || "") . "]");
  93 }