ext/Net-Ping/t/410_syn_host.t

   1 # Same as 400_ping_syn.t but testing ack( $host ) instead of ack( ).
   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   # Hopefully this is never a routeable host
  38   "172.29.249.249" => 0,
  39
  40   # Hopefully all these web ports are open
  41   "www.geocities.com." => 1,
  42   "www.freeservers.com." => 1,
  43   "yahoo.com." => 1,
  44   "www.yahoo.com." => 1,
  45   "www.about.com." => 1,
  46   "www.microsoft.com." => 1,
  47   "127.0.0.1" => 1,
  48 };
  49
  50 use strict;
  51 use Test;
  52 use Net::Ping;
  53 plan tests => ((keys %{ $webs }) * 2 + 3);
  54
  55 # Everything loaded fine
  56 ok 1;
  57
  58 my $can_alarm = eval {alarm 0; 1;};
  59
  60 sub Alarm {
  61   alarm(shift) if $can_alarm;
  62 }
  63
  64 Alarm(50);
  65 $SIG{ALRM} = sub {
  66   ok 0;
  67   die "TIMED OUT!";
  68 };
  69
  70 my $p = new Net::Ping "syn", 10;
  71
  72 # new() worked?
  73 ok !!$p;
  74
  75 # Change to use the more common web port.
  76 # (Make sure getservbyname works in scalar context.)
  77 ok ($p -> {port_num} = getservbyname("http", "tcp"));
  78
  79 foreach my $host (keys %{ $webs }) {
  80   # ping() does dns resolution and
  81   # only sends the SYN at this point
  82   Alarm(50); # (Plenty for a DNS lookup)
  83   if (!ok($p -> ping($host))) {
  84     print STDERR "CANNOT RESOLVE $host $p->{bad}->{$host}\n";
  85   }
  86 }
  87
  88 Alarm(20);
  89 foreach my $host (sort keys %{ $webs }) {
  90   my $on = $p->ack($host);
  91   if (!ok (($on && $webs->{$host}) ||
  92            (!$on && !$webs->{$host}))) {
  93     if ($on) {
  94       print STDERR "SUPPOSED TO BE DOWN: http://$host/\n";
  95     } else {
  96       print STDERR "DOWN: http://$host/ [",($p->{bad}->{$host} || ""),"]\n";
  97     }
  98   }
  99   delete $webs->{$host};
 100   Alarm(20);
 101 }
 102
 103 Alarm(0);