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

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