Update to Net::Ping v2.23

p4raw-id: //depot/perl@18038

5 files changed, 332 insertions, 3 deletions

diff --git a/lib/Net/Ping/t/110_icmp_inst.t b/lib/Net/Ping/t/110_icmp_inst.t
index b0ee1b74f3..cdb7219af9 100644
--- a/lib/Net/Ping/t/110_icmp_inst.t
+++ b/lib/Net/Ping/t/110_icmp_inst.t
@@ -15,7 +15,7 @@ plan tests => 2;
 # Everything loaded fine
 ok 1;
 
-if (($> and $^O ne 'VMS')
+if (($> and $^O ne 'VMS' and $^O ne 'cygwin')
     or ($^O eq 'MSWin32'
         and Win32::IsWinNT())
     or ($^O eq 'VMS'
diff --git a/lib/Net/Ping/t/150_syn_inst.t b/lib/Net/Ping/t/150_syn_inst.t
new file mode 100644
index 0000000000..df85d460fe
--- /dev/null
+++ b/lib/Net/Ping/t/150_syn_inst.t
@@ -0,0 +1,22 @@
+# Test to make sure object can be instantiated for syn protocol.
+
+BEGIN {
+  unless (eval "require Socket") {
+    print "1..0 \# Skip: no Socket\n";
+    exit;
+  }
+  unless (getservbyname('echo', 'tcp')) {
+    print "1..0 \# Skip: no echo port\n";
+    exit;
+  }
+}
+
+use Test;
+use Net::Ping;
+plan tests => 2;
+
+# Everything loaded fine
+ok 1;
+
+my $p = new Net::Ping "syn";
+ok !!$p;
diff --git a/lib/Net/Ping/t/200_ping_tcp.t b/lib/Net/Ping/t/200_ping_tcp.t
index 591c25166f..2ac2236acf 100644
--- a/lib/Net/Ping/t/200_ping_tcp.t
+++ b/lib/Net/Ping/t/200_ping_tcp.t
@@ -11,7 +11,7 @@ BEGIN {
     print "1..0 \# Skip: no Socket\n";
     exit;
   }
-  unless (getservbyname('echo', 'udp')) {
+  unless (getservbyname('echo', 'tcp')) {
     print "1..0 \# Skip: no echo port\n";
     exit;
   }
@@ -35,7 +35,7 @@ plan tests => 13;
 # Everything loaded fine
 ok 1;
 
-my $p = new Net::Ping "tcp";
+my $p = new Net::Ping "tcp",9;
 
 # new() worked?
 ok !!$p;
diff --git a/lib/Net/Ping/t/400_ping_syn.t b/lib/Net/Ping/t/400_ping_syn.t
new file mode 100644
index 0000000000..3b84af78b1
--- /dev/null
+++ b/lib/Net/Ping/t/400_ping_syn.t
@@ -0,0 +1,94 @@
+BEGIN {
+  if ($ENV{PERL_CORE}) {
+    unless ($ENV{PERL_TEST_Net_Ping}) {
+      print "1..0 # Skip: network dependent test\n";
+        exit;
+    }
+    chdir 't' if -d 't';
+    @INC = qw(../lib);
+  }
+  unless (eval "require Socket") {
+    print "1..0 \# Skip: no Socket\n";
+    exit;
+  }
+  unless (getservbyname('echo', 'tcp')) {
+    print "1..0 \# Skip: no echo port\n";
+    exit;
+  }
+  unless (getservbyname('http', 'tcp')) {
+    print "1..0 \# Skip: no http port\n";
+    exit;
+  }
+}
+
+# Remote network test using syn protocol.
+#
+# NOTE:
+#   Network connectivity will be required for all tests to pass.
+#   Firewalls may also cause some tests to fail, so test it
+#   on a clear network.  If you know you do not have a direct
+#   connection to remote networks, but you still want the tests
+#   to pass, use the following:
+#
+# $ PERL_CORE=1 make test
+
+# Try a few remote servers
+my $webs = {
+  # Hopefully this is never a routeable host
+  "172.29.249.249" => 0,
+
+  # Hopefully all these web servers are on
+  "www.geocities.com." => 1,
+  "www.freeservers.com." => 1,
+  "yahoo.com." => 1,
+  "www.yahoo.com." => 1,
+  "www.about.com." => 1,
+  "www.microsoft.com." => 1,
+};
+
+use strict;
+use Test;
+use Net::Ping;
+plan tests => ((keys %{ $webs }) * 2 + 3);
+
+# Everything loaded fine
+ok 1;
+
+my $p = new Net::Ping "syn", 10;
+
+# new() worked?
+ok !!$p;
+
+# Change to use the more common web port.
+# (Make sure getservbyname works in scalar context.)
+ok ($p -> {port_num} = getservbyname("http", "tcp"));
+
+foreach my $host (keys %{ $webs }) {
+  # ping() does dns resolution and
+  # only sends the SYN at this point
+  if ($p -> ping($host)) {
+    ok 1;
+  } else {
+    print STDERR "CANNOT RESOLVE $host\n";
+    ok 0;
+  }
+}
+
+while (my $host = $p->ack()) {
+  if ($webs->{$host}) {
+    ok 1;
+  } else {
+    print STDERR "SUPPOSED TO BE DOWN: http://$host/\n";
+    ok 0;
+  }
+  delete $webs->{$host};
+}
+
+foreach my $host (keys %{ $webs }) {
+  if ($webs->{$host}) {
+    print STDERR "DOWN: http://$host/\n";
+    ok 0;
+  } else {
+    ok 1;
+  }
+}
diff --git a/lib/Net/Ping/t/450_service.t b/lib/Net/Ping/t/450_service.t
new file mode 100644
index 0000000000..7d19c76bb5
--- /dev/null
+++ b/lib/Net/Ping/t/450_service.t
@@ -0,0 +1,213 @@
+# Testing tcp_service_check method using tcp and syn protocols.
+
+BEGIN {
+  unless (eval "require IO::Socket") {
+    print "1..0 \# Skip: no IO::Socket\n";
+    exit;
+  }
+  unless (getservbyname('echo', 'tcp')) {
+    print "1..0 \# Skip: no echo port\n";
+    exit;
+  }
+}
+
+use strict;
+use Test;
+use Net::Ping;
+use IO::Socket;
+
+# I'm lazy so I'll just use IO::Socket
+# for the TCP Server stuff instead of doing
+# all that direct socket() junk manually.
+
+plan tests => 37;
+
+# Everything loaded fine
+ok 1;
+
+"0" =~ /(0)/; # IO::Socket::INET ephemeral buttwag hack
+
+# Start a tcp listen server on ephemeral port
+my $sock1 = new IO::Socket::INET
+  LocalAddr => "127.1.1.1",
+  Proto => "tcp",
+  Listen => 8,
+  Reuse => 1,
+  Type => SOCK_STREAM,
+  ;
+
+# Make sure it worked.
+ok !!$sock1;
+
+"0" =~ /(0)/; # IO::Socket::INET ephemeral buttwag hack
+
+# Start listening on another ephemeral port
+my $sock2 = new IO::Socket::INET
+  LocalAddr => "127.2.2.2",
+  Proto => "tcp",
+  Listen => 8,
+  Reuse => 1,
+  Type => SOCK_STREAM,
+  ;
+
+# Make sure it worked too.
+ok !!$sock2;
+
+my $port1 = $sock1->sockport;
+ok $port1;
+
+my $port2 = $sock2->sockport;
+ok $port2;
+
+# Make sure the sockets are listening on different ports.
+ok ($port1 != $port2);
+
+# This is how it should be:
+# 127.1.1.1:$port1 - service ON
+# 127.2.2.2:$port2 - service ON
+# 127.1.1.1:$port2 - service OFF
+# 127.2.2.2:$port1 - service OFF
+
+#####
+# First, we test using the "tcp" protocol.
+# (2 seconds should be long enough to connect to loopback.)
+my $p = new Net::Ping "tcp", 2;
+
+# new() worked?
+ok !!$p;
+
+# Disable service checking
+$p->tcp_service_check(0);
+
+# Try on the first port
+$p->{port_num} = $port1;
+
+# Make sure IP1 is reachable
+ok $p -> ping("127.1.1.1");
+
+# Make sure IP2 is reachable
+ok $p -> ping("127.2.2.2");
+
+# Try on the other port
+$p->{port_num} = $port2;
+
+# Make sure IP1 is reachable
+ok $p -> ping("127.1.1.1");
+
+# Make sure IP2 is reachable
+ok $p -> ping("127.2.2.2");
+
+
+# Enable service checking
+$p->tcp_service_check(1);
+
+# Try on the first port
+$p->{port_num} = $port1;
+
+# Make sure service on IP1 
+ok $p -> ping("127.1.1.1");
+
+# Make sure not service on IP2
+ok !$p -> ping("127.2.2.2");
+
+# Try on the other port
+$p->{port_num} = $port2;
+
+# Make sure not service on IP1
+ok !$p -> ping("127.1.1.1");
+
+# Make sure service on IP2
+ok $p -> ping("127.2.2.2");
+
+
+#####
+# Lastly, we test using the "syn" protocol.
+$p = new Net::Ping "syn", 2;
+
+# new() worked?
+ok !!$p;
+
+# Disable service checking
+$p->tcp_service_check(0);
+
+# Try on the first port
+$p->{port_num} = $port1;
+
+# Send SYN to both IPs
+ok $p -> ping("127.1.1.1");
+ok $p -> ping("127.2.2.2");
+
+# Both IPs should be reachable
+ok $p -> ack();
+ok $p -> ack();
+# No more sockets?
+ok !$p -> ack();
+
+###
+# Get a fresh object
+$p = new Net::Ping "syn", 2;
+
+# new() worked?
+ok !!$p;
+
+# Disable service checking
+$p->tcp_service_check(0);
+
+# Try on the other port
+$p->{port_num} = $port2;
+
+# Send SYN to both IPs
+ok $p -> ping("127.1.1.1");
+ok $p -> ping("127.2.2.2");
+
+# Both IPs should be reachable
+ok $p -> ack();
+ok $p -> ack();
+# No more sockets?
+ok !$p -> ack();
+
+
+###
+# Get a fresh object
+$p = new Net::Ping "syn", 2;
+
+# new() worked?
+ok !!$p;
+
+# Enable service checking
+$p->tcp_service_check(1);
+
+# Try on the first port
+$p->{port_num} = $port1;
+
+# Send SYN to both IPs
+ok $p -> ping("127.1.1.1");
+ok $p -> ping("127.2.2.2");
+
+# Only IP1 should have service
+ok "127.1.1.1",$p -> ack();
+# No more good sockets?
+ok !$p -> ack();
+
+
+###
+# Get a fresh object
+$p = new Net::Ping "syn", 2;
+
+# new() worked?
+ok !!$p;
+
+# Enable service checking
+$p->tcp_service_check(1);
+
+# Try on the other port
+$p->{port_num} = $port2;
+
+# Send SYN to both IPs
+ok $p -> ping("127.1.1.1");
+ok $p -> ping("127.2.2.2");
+
+# Only IP2 should have service
+ok "127.2.2.2",$p -> ack();
+# No more good sockets?
+ok !$p -> ack();