This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update to Net::Ping v2.23
[perl5.git] / lib / Net / Ping.pm
index 04cddc1..1192663 100644 (file)
@@ -1,22 +1,23 @@
 package Net::Ping;
 
-# $Id: Ping.pm,v 1.34 2002/05/06 17:37:54 rob Exp $
+# $Id: Ping.pm,v 1.33 2002/10/19 05:02:43 rob Exp $
 
 require 5.002;
 require Exporter;
 
 use strict;
 use vars qw(@ISA @EXPORT $VERSION
-            $def_timeout $def_proto $max_datasize $pingstring $hires);
-use FileHandle;
-use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
+            $def_timeout $def_proto $max_datasize $pingstring $hires $source_verify $syn_forking);
+use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK );
+use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET SOL_SOCKET
                inet_aton inet_ntoa sockaddr_in );
+use POSIX qw( ECONNREFUSED EINPROGRESS WNOHANG );
+use FileHandle;
 use Carp;
-use POSIX qw(ECONNREFUSED);
 
 @ISA = qw(Exporter);
 @EXPORT = qw(pingecho);
-$VERSION = "2.18";
+$VERSION = "2.23";
 
 # Constants
 
@@ -25,13 +26,20 @@ $def_proto = "tcp";         # Default protocol to use for pinging
 $max_datasize = 1024;       # Maximum data bytes in a packet
 # The data we exchange with the server for the stream protocol
 $pingstring = "pingschwingping!\n";
+$source_verify = 1;         # Default is to verify source endpoint
+$syn_forking = 0;
 
 if ($^O =~ /Win32/i) {
   # Hack to avoid this Win32 spewage:
   # Your vendor has not defined POSIX macro ECONNREFUSED
   *ECONNREFUSED = sub {10061;}; # "Unknown Error" Special Win32 Response?
+  $syn_forking = 1;
 };
 
+# h2ph "asm/socket.h"
+# require "asm/socket.ph";
+sub SO_BINDTODEVICE {25;}
+
 # Description:  The pingecho() subroutine is provided for backward
 # compatibility with the original Net::Ping.  It accepts a host
 # name/IP and an optional timeout in seconds.  Create a tcp ping
@@ -60,7 +68,8 @@ sub new
   my ($this,
       $proto,             # Optional protocol to use for pinging
       $timeout,           # Optional timeout in seconds
-      $data_size          # Optional additional bytes of data
+      $data_size,         # Optional additional bytes of data
+      $device,            # Optional device to use
       ) = @_;
   my  $class = ref($this) || $this;
   my  $self = {};
@@ -71,8 +80,8 @@ sub new
   bless($self, $class);
 
   $proto = $def_proto unless $proto;          # Determine the protocol
-  croak('Protocol for ping must be "icmp", "udp", "tcp", "stream", or "external"')
-    unless $proto =~ m/^(icmp|udp|tcp|stream|external)$/;
+  croak('Protocol for ping must be "icmp", "udp", "tcp", "syn", "stream", or "external"')
+    unless $proto =~ m/^(icmp|udp|tcp|syn|stream|external)$/;
   $self->{"proto"} = $proto;
 
   $timeout = $def_timeout unless $timeout;    # Determine the timeout
@@ -80,6 +89,8 @@ sub new
     if $timeout <= 0;
   $self->{"timeout"} = $timeout;
 
+  $self->{"device"} = $device;
+
   $min_datasize = ($proto eq "udp") ? 1 : 0;  # Determine data size
   $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
   croak("Data for ping must be from $min_datasize to $max_datasize bytes")
@@ -95,6 +106,8 @@ sub new
 
   $self->{"local_addr"} = undef;              # Don't bind by default
 
+  $self->{"tcp_econnrefused"} = undef;        # Default Connection refused behavior
+
   $self->{"seq"} = 0;                         # For counting packets
   if ($self->{"proto"} eq "udp")              # Open a socket
   {
@@ -106,16 +119,24 @@ sub new
     socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
            $self->{"proto_num"}) ||
              croak("udp socket error - $!");
+    if ($self->{'device'}) {
+      setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
+        or croak "error binding to device $self->{'device'} $!";
+    }
   }
   elsif ($self->{"proto"} eq "icmp")
   {
-    croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
+    croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS' and $^O ne 'cygwin');
     $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
       croak("Can't get icmp protocol by name");
     $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
     $self->{"fh"} = FileHandle->new();
     socket($self->{"fh"}, PF_INET, SOCK_RAW, $self->{"proto_num"}) ||
       croak("icmp socket error - $!");
+    if ($self->{'device'}) {
+      setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
+        or croak "error binding to device $self->{'device'} $!";
+    }
   }
   elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
   {
@@ -125,6 +146,28 @@ sub new
       croak("Can't get tcp echo port by name");
     $self->{"fh"} = FileHandle->new();
   }
+  elsif ($self->{"proto"} eq "syn")
+  {
+    $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
+      croak("Can't get tcp protocol by name");
+    $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
+      croak("Can't get tcp echo port by name");
+    if ($syn_forking) {
+      $self->{"fork_rd"} = FileHandle->new();
+      $self->{"fork_wr"} = FileHandle->new();
+      pipe($self->{"fork_rd"}, $self->{"fork_wr"});
+      $self->{"fh"} = FileHandle->new();
+    } else {
+      $self->{"wbits"} = "";
+      $self->{"bad"} = {};
+    }
+    $self->{"syn"} = {};
+    $self->{"stop_time"} = 0;
+  }
+  elsif ($self->{"proto"} eq "external")
+  {
+    # No preliminary work needs to be done.
+  }
 
   return($self);
 }
@@ -163,6 +206,28 @@ sub bind
 }
 
 
+# Description: Allow UDP source endpoint comparision to be
+#              skipped for those remote interfaces that do
+#              not response from the same endpoint.
+
+sub source_verify
+{
+  my $self = shift;
+  $source_verify = 1 unless defined
+    ($source_verify = ((defined $self) && (ref $self)) ? shift() : $self);
+}
+
+# Description: Set whether or not the tcp connect
+# behavior should enforce remote service availability
+# as well as reachability.
+
+sub tcp_service_check
+{
+  my $self = shift;
+  $self->{"tcp_econnrefused"} = 1 unless defined
+    ($self->{"tcp_econnrefused"} = shift());
+}
+
 # Description: allows the module to use milliseconds as returned by
 # the Time::HiRes module
 
@@ -219,6 +284,9 @@ sub ping
   }
   elsif ($self->{"proto"} eq "stream") {
     $ret = $self->ping_stream($ip, $timeout);
+  }
+  elsif ($self->{"proto"} eq "syn") {
+    $ret = $self->ping_syn($host, $ip, $ping_time, $ping_time+$timeout);
   } else {
     croak("Unknown protocol \"$self->{proto}\" in ping()");
   }
@@ -309,7 +377,7 @@ sub ping_icmp
                 substr($recv_msg, length($recv_msg) - $len_msg,
                        $len_msg));
       if (($from_type == ICMP_ECHOREPLY) &&
-          ($from_ip eq $ip) &&
+          (!$source_verify || $from_ip eq $ip) &&
           ($from_pid == $self->{"pid"}) && # Does the packet check out?
           ($from_seq == $self->{"seq"}))
       {
@@ -373,7 +441,10 @@ sub ping_tcp
 
   $@ = ""; $! = 0;
   $ret = $self -> tcp_connect( $ip, $timeout);
-  $ret = 1 if $! == ECONNREFUSED;  # Connection refused
+  if (!$self->{"tcp_econnrefused"} &&
+      $! == ECONNREFUSED) {
+    $ret = 1;  # "Connection refused" means reachable
+  }
   $self->{"fh"}->close();
   return $ret;
 }
@@ -397,6 +468,10 @@ sub tcp_connect
         !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
       croak("tcp bind error - $!");
     }
+    if ($self->{'device'}) {
+      setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
+        or croak("error binding to device $self->{'device'} $!");
+    }
   };
   my $do_connect = sub {
     eval {
@@ -439,13 +514,12 @@ sub tcp_connect
 
     my $patience = &time() + $timeout;
 
-    require POSIX;
     my ($child);
     $? = 0;
     # Wait up to the timeout
     # And clean off the zombie
     do {
-      $child = waitpid($pid, &POSIX::WNOHANG);
+      $child = waitpid($pid, &WNOHANG());
       $! = $? >> 8;
       $@ = $!;
       select(undef, undef, undef, 0.1);
@@ -469,11 +543,11 @@ sub tcp_connect
 
     &{ $do_socket }();
 
-    $SIG{'ALRM'} = sub { die "Timed out!"; };
-    alarm($timeout);        # Interrupt connect() if we have to
+    local $SIG{'ALRM'} = sub { die "Timed out!"; };
+    my $old = alarm($timeout);   # Interrupt connect() if we have to
 
     &{ $do_connect }();
-    alarm(0);
+    alarm($old);
   }
 
   return $ret;
@@ -638,9 +712,10 @@ sub ping_udp
       $from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS)
         or last; # For example an unreachable host will make recv() fail.
       ($from_port, $from_ip) = sockaddr_in($from_saddr);
-      if (($from_ip eq $ip) &&        # Does the packet check out?
-          ($from_port == $self->{"port_num"}) &&
-          ($from_msg eq $msg))
+      if (!$source_verify ||
+          (($from_ip eq $ip) &&        # Does the packet check out?
+           ($from_port == $self->{"port_num"}) &&
+           ($from_msg eq $msg)))
       {
         $ret = 1;       # It's a winner
         $done = 1;
@@ -654,14 +729,318 @@ sub ping_udp
   return $ret;
 }
 
-# Description:  Close the connection unless we are using the tcp
-# protocol, since it will already be closed.
+# Description: Send a TCP SYN packet to host specified.
+sub ping_syn
+{
+  my $self = shift;
+  my $host = shift;
+  my $ip = shift;
+  my $start_time = shift;
+  my $stop_time = shift;
+
+  if ($syn_forking) {
+    return $self->ping_syn_fork($host, $ip, $start_time, $stop_time);
+  }
+
+  my $fh = FileHandle->new();
+  my $saddr = sockaddr_in($self->{"port_num"}, $ip);
+
+  # Create TCP socket
+  if (!socket ($fh, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
+    croak("tcp socket error - $!");
+  }
+
+  if (defined $self->{"local_addr"} &&
+      !CORE::bind($fh, sockaddr_in(0, $self->{"local_addr"}))) {
+    croak("tcp bind error - $!");
+  }
+
+  if ($self->{'device'}) {
+    setsockopt($fh, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
+      or croak("error binding to device $self->{'device'} $!");
+  }
+
+  # Set O_NONBLOCK property on filehandle
+  if (my $flags = fcntl($fh, F_GETFL, 0)) {
+    fcntl($fh, F_SETFL, $flags | O_NONBLOCK);
+  } else {
+    croak("fcntl F_GETFL: $!");
+  }
+
+  # Attempt the non-blocking connect
+  # by just sending the TCP SYN packet
+  if (connect($fh, $saddr)) {
+    # Non-blocking, yet still connected?
+    # Must have connected very quickly.
+    # Can this ever really happen?
+  }
+  else {
+    # Error occurred connecting.
+    # Hopefully the connection is just still in progress.
+    if ($! != EINPROGRESS) {
+      # If not, then it really is something bad.
+      $self->{"bad"}->{$host} = $!;
+      return undef;
+    }
+  }
+
+  my $entry = [ $host, $ip, $fh, $start_time, $stop_time ];
+  $self->{"syn"}->{$fh->fileno} = $entry;
+  if ($self->{"stop_time"} < $stop_time) {
+    $self->{"stop_time"} = $stop_time;
+  }
+  vec($self->{"wbits"}, $fh->fileno, 1) = 1;
+
+  return 1;
+}
+
+sub ping_syn_fork {
+  my ($self, $host, $ip, $start_time, $stop_time) = @_;
+
+  # Buggy Winsock API doesn't allow nonblocking connect.
+  # Hence, if our OS is Windows, we need to create a separate
+  # process to do the blocking connect attempt.
+  my $pid = fork();
+  if (defined $pid) {
+    if ($pid) {
+      # Parent process
+      my $entry = [ $host, $ip, $pid, $start_time, $stop_time ];
+      $self->{"syn"}->{$pid} = $entry;
+      if ($self->{"stop_time"} < $stop_time) {
+        $self->{"stop_time"} = $stop_time;
+      }
+    } else {
+      # Child process
+      my $saddr = sockaddr_in($self->{"port_num"}, $ip);
+
+      # Create TCP socket
+      if (!socket ($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
+        croak("tcp socket error - $!");
+      }
+
+      if (defined $self->{"local_addr"} &&
+          !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
+        croak("tcp bind error - $!");
+      }
+
+      if ($self->{'device'}) {
+        setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
+          or croak("error binding to device $self->{'device'} $!");
+      }
+
+      $!=0;
+      # Try to connect (could take a long time)
+      connect($self->{"fh"}, $saddr);
+      # Notify parent of connect error status
+      my $err = $!+0;
+      my $wrstr = "$$ $err";
+      # Force to 10 chars including \n
+      $wrstr .= " "x(9 - length $wrstr). "\n";
+      syswrite($self->{"fork_wr"}, $wrstr);
+      exit;
+    }
+  } else {
+    # fork() failed?
+    die "fork: $!";
+  }
+  return 1;
+}
+
+# Description: Wait for TCP ACK from host specified
+# from ping_syn above.  If no host is specified, wait
+# for TCP ACK from any of the hosts in the SYN queue.
+sub ack
+{
+  my $self = shift;
+
+  if ($self->{"proto"} eq "syn") {
+    if ($syn_forking) {
+      my @answer = $self->ack_unfork(shift);
+      return wantarray ? @answer : $answer[0];
+    }
+    my $wbits = "";
+    my $stop_time = 0;
+    if (my $host = shift) {
+      # Host passed as arg
+      if (exists $self->{"bad"}->{$host}) {
+        return ();
+      }
+      my $host_fd = undef;
+      foreach my $fd (keys %{ $self->{"syn"} }) {
+        my $entry = $self->{"syn"}->{$fd};
+        if ($entry->[0] eq $host) {
+          $host_fd = $fd;
+          $stop_time = $entry->[4]
+            || croak("Corrupted SYN entry for [$host]");
+          last;
+        }
+      }
+      croak("ack called on [$host] without calling ping first!")
+        unless defined $host_fd;
+      vec($wbits, $host_fd, 1) = 1;
+    } else {
+      # No $host passed so scan all hosts
+      # Use the latest stop_time
+      $stop_time = $self->{"stop_time"};
+      # Use all the bits
+      $wbits = $self->{"wbits"};
+    }
+
+    while ($wbits !~ /^\0*$/) {
+      my $timeout = $stop_time - &time();
+      # Force a minimum of 10 ms timeout.
+      $timeout = 0.01 if $timeout <= .01;
+      if (my $nfound = select(undef, (my $wout=$wbits), undef, $timeout)) {
+        # Done waiting for one of the ACKs
+        my $fd = 0;
+        # Determine which one
+        while (length $wout &&
+               !vec($wout, $fd, 1)) {
+          $fd++;
+        }
+        if (my $entry = $self->{"syn"}->{$fd}) {
+          if (getpeername($entry->[2])) {
+            # Connection established to remote host
+            delete $self->{"syn"}->{$fd};
+            vec($self->{"wbits"}, $fd, 1) = 0;
+            return wantarray ?
+              ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
+              : $entry->[0];
+          } else {
+            # TCP ACK will never come from this host
+            # because there was an error connecting.
+
+            # Wipe it from future scanning.
+            delete $self->{"syn"}->{$fd};
+            vec($self->{"wbits"}, $fd, 1) = 0;
+            vec($wbits, $fd, 1) = 0;
+
+            # This should set $! to the correct error.
+            my $char;
+            read($entry->[2],$char,1);
+            # Store the excuse why the connection failed.
+            $self->{"bad"}->{$entry->[0]} = $!;
+            if (!$self->{"tcp_econnrefused"} &&
+                $! == ECONNREFUSED) {
+              # "Connection refused" means reachable
+              return wantarray ?
+                ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
+                : $entry->[0];
+            }
+            # Try another socket...
+          }
+        } else {
+          warn "Corrupted SYN entry: unknown fd [$fd] ready!";
+          vec($wbits, $fd, 1) = 0;
+          vec($self->{"wbits"}, $fd, 1) = 0;
+        }
+      } elsif (defined $nfound) {
+        # Timed out waiting for ACK
+        foreach my $fd (keys %{ $self->{"syn"} }) {
+          if (vec($wbits, $fd, 1)) {
+            my $entry = $self->{"syn"}->{$fd};
+            $self->{"bad"}->{$entry->[0]} = "Timed out";
+            vec($wbits, $fd, 1) = 0;
+            vec($self->{"wbits"}, $fd, 1) = 0;
+            delete $self->{"syn"}->{$fd};
+          }
+        }
+      } else {
+        # Weird error occurred with select()
+        warn("select: $!");
+        $self->{"syn"} = {};
+        $wbits = "";
+      }
+    }
+  }
+  return ();
+}
+
+sub ack_unfork {
+  my $self = shift;
+  my $stop_time = $self->{"stop_time"};
+  if (my $host = shift) {
+    # Host passed as arg
+    warn "Cannot specify host for ack on win32\n";
+  }
+
+  my $rbits = "";
+  my $timeout;
+  if (keys %{ $self->{"syn"} }) {
+    # Scan all hosts that are left
+    vec($rbits, fileno($self->{"fork_rd"}), 1) = 1;
+    $timeout = $stop_time - &time();
+  } else {
+    # No hosts left to wait for
+    $timeout = 0;
+  }
+
+  if ($timeout > 0) {
+    if (my $nfound = select((my $rout=$rbits), undef, undef, $timeout)) {
+      # Done waiting for one of the ACKs
+      if (!sysread($self->{"fork_rd"}, $_, 10)) {
+        # Socket closed, which means all children are done.
+        return ();
+      }
+      my ($pid, $how) = split;
+      if ($pid) {
+        # Flush the zombie
+        waitpid($pid, 0);
+        if (my $entry = $self->{"syn"}->{$pid}) {
+          # Connection attempt to remote host is done
+          delete $self->{"syn"}->{$pid};
+          if (!$how || # If there was no error connecting
+              (!$self->{"tcp_econnrefused"} &&
+               $how == ECONNREFUSED)) {  # "Connection refused" means reachable
+            return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
+          }
+        } else {
+          # Should never happen
+          die "Unknown ping from pid [$pid]";
+        }
+      } else {
+        die "Empty response from status socket?";
+      }
+    } elsif (defined $nfound) {
+      # Timed out waiting for ACK status
+    } else {
+      # Weird error occurred with select()
+      warn("select: $!");
+    }
+  }
+  if (my @synners = keys %{ $self->{"syn"} }) {
+    # Kill all the synners
+    kill 9, @synners;
+    foreach my $pid (@synners) {
+      # Wait for the deaths to finish
+      # Then flush off the zombie
+      waitpid($pid, 0);
+    }
+  }
+  $self->{"syn"} = {};
+  return ();
+}
+
+# Description:  Tell why the ack() failed
+sub nack {
+  my $self = shift;
+  my $host = shift || croak('Usage> nack($failed_ack_host)');
+  return $self->{"bad"}->{$host} || undef;
+}
+
+# Description:  Close the connection.
 
 sub close
 {
   my ($self) = @_;
 
-  $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
+  if ($self->{"proto"} eq "syn") {
+    delete $self->{"syn"};
+  } elsif ($self->{"proto"} eq "tcp") {
+    # The connection will already be closed
+  } else {
+    $self->{"fh"}->close();
+  }
 }
 
 
@@ -672,7 +1051,7 @@ __END__
 
 Net::Ping - check a remote host for reachability
 
-$Id: Ping.pm,v 1.34 2002/05/06 17:37:54 rob Exp $
+$Id: Ping.pm,v 1.33 2002/10/19 05:02:43 rob Exp $
 
 =head1 SYNOPSIS
 
@@ -704,6 +1083,16 @@ $Id: Ping.pm,v 1.34 2002/05/06 17:37:54 rob Exp $
     }
     undef($p);
 
+    # Like tcp protocol, but with many hosts
+    $p = Net::Ping->new("syn");
+    $p->{port_num} = getservbyname("http", "tcp");
+    foreach $host (@host_array) {
+      $p->ping($host);
+    }
+    while (($host,$rtt,$ip) = $p->ack) {
+      print "HOST: $host [$ip] ACKed in $rtt seconds.\n";
+    }
+
     # High precision syntax (requires Time::HiRes)
     $p = Net::Ping->new();
     $p->hires();
@@ -722,10 +1111,10 @@ hosts on a network.  A ping object is first created with optional
 parameters, a variable number of hosts may be pinged multiple
 times and then the connection is closed.
 
-You may choose one of four different protocols to use for the
-ping. The "udp" protocol is the default. Note that a live remote host
+You may choose one of six different protocols to use for the
+ping. The "tcp" protocol is the default. Note that a live remote host
 may still fail to be pingable by one or more of these protocols. For
-example, www.microsoft.com is generally alive but not pingable.
+example, www.microsoft.com is generally alive but not "icmp" pingable.
 
 With the "tcp" protocol the ping() method attempts to establish a
 connection to the remote host's echo port.  If the connection is
@@ -757,15 +1146,32 @@ utility to perform the ping, and generally produces relatively
 accurate results. If C<Net::Ping::External> if not installed on your
 system, specifying the "external" protocol will result in an error.
 
+If the "syn" protocol is specified, the ping() method will only
+send a TCP SYN packet to the remote host then immediately return.
+If the syn packet was sent successfully, it will return a true value,
+otherwise it will return false.  NOTE: Unlike the other protocols,
+the return value does NOT determine if the remote host is alive or
+not since the full TCP three-way handshake may not have completed
+yet.  The remote host is only considered reachable if it receives
+a TCP ACK within the timeout specifed.  To begin waiting for the
+ACK packets, use the ack() method as explained below.  Use the
+"syn" protocol instead the "tcp" protocol to determine reachability
+of multiple destinations simultaneously by sending parallel TCP
+SYN packets.  It will not block while testing each remote host.
+demo/fping is provided in this distribution to demonstrate the
+"syn" protocol as an example.
+This protocol does not require any special privileges.
+
 =head2 Functions
 
 =over 4
 
-=item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
+=item Net::Ping->new([$proto [, $def_timeout [, $bytes [, $device ]]]]);
 
 Create a new ping object.  All of the parameters are optional.  $proto
 specifies the protocol to use when doing a ping.  The current choices
-are "tcp", "udp" or "icmp".  The default is "udp".
+are "tcp", "udp", "icmp", "stream", "syn", or "external".
+The default is "tcp".
 
 If a default timeout ($def_timeout) in seconds is provided, it is used
 when a timeout is not given to the ping() method (below).  The timeout
@@ -778,11 +1184,63 @@ default) number of data bytes is 1 if the protocol is "udp" and 0
 otherwise.  The maximum number of data bytes that can be specified is
 1024.
 
+If $device is given, this device is used to bind the source endpoint
+before sending the ping packet.  I beleive this only works with
+superuser privileges and with udp and icmp protocols at this time.
+
+=item $p->ping($host [, $timeout]);
+
+Ping the remote host and wait for a response.  $host can be either the
+hostname or the IP number of the remote host.  The optional timeout
+must be greater than 0 seconds and defaults to whatever was specified
+when the ping object was created.  Returns a success flag.  If the
+hostname cannot be found or there is a problem with the IP number, the
+success flag returned will be undef.  Otherwise, the success flag will
+be 1 if the host is reachable and 0 if it is not.  For most practical
+purposes, undef and 0 and can be treated as the same case.  In array
+context, the elapsed time as well as the string form of the ip the
+host resolved to are also returned.  The elapsed time value will
+be a float, as retuned by the Time::HiRes::time() function, if hires()
+has been previously called, otherwise it is returned as an integer.
+
+=item $p->source_verify( { 0 | 1 } );
+
+Allows source endpoint verification to be enabled or disabled.
+This is useful for those remote destinations with multiples
+interfaces where the response may not originate from the same
+endpoint that the original destination endpoint was sent to.
+This only affects udp and icmp protocol pings.
+
+This is enabled by default.
+
+=item $p->tcp_service_check( { 0 | 1 } );
+
+Set whether or not the tcp connect behavior should enforce
+remote service availability as well as reachability.  Normally,
+if the remote server reported ECONNREFUSED, it must have been
+reachable because of the status packet that it reported.
+With this option enabled, the full three-way tcp handshake
+must have been established successfully before it will
+claim it is reachable.  NOTE:  It still does nothing more
+than connect and disconnect.  It does not speak any protocol
+(i.e., HTTP or FTP) to ensure the remote server is sane in
+any way.  The remote server CPU could be grinding to a halt
+and unresponsive to any clients connecting, but if the kernel
+throws the ACK packet, it is considered alive anyway.  To
+really determine if the server is responding well would be
+application specific and is beyond the scope of Net::Ping.
+
+This only affects "tcp" and "syn" protocols.
+
+This is disabled by default.
+
 =item $p->hires( { 0 | 1 } );
 
 Causes this module to use Time::HiRes module, allowing milliseconds
 to be returned by subsequent calls to ping().
 
+This is disabled by default.
+
 =item $p->bind($local_addr);
 
 Sets the source address from which pings will be sent.  This must be
@@ -797,23 +1255,9 @@ then bind() must be called at most once per object, and (if it is
 called at all) must be called before the first call to ping() for that
 object.
 
-=item $p->ping($host [, $timeout]);
-
-Ping the remote host and wait for a response.  $host can be either the
-hostname or the IP number of the remote host.  The optional timeout
-must be greater than 0 seconds and defaults to whatever was specified
-when the ping object was created.  Returns a success flag.  If the
-hostname cannot be found or there is a problem with the IP number, the
-success flag returned will be undef.  Otherwise, the success flag will
-be 1 if the host is reachable and 0 if it is not.  For most practical
-purposes, undef and 0 and can be treated as the same case.  In array
-context, the elapsed time is also returned.  The elapsed time value will
-be a float, as retuned by the Time::HiRes::time() function, if hires()
-has been previously called, otherwise it is returned as an integer.
-
 =item $p->open($host);
 
-When you are using the stream protocol, this call pre-opens the
+When you are using the "stream" protocol, this call pre-opens the
 tcp socket.  It's only necessary to do this if you want to
 provide a different timeout when creating the connection, or
 remove the overhead of establishing the connection from the
@@ -822,6 +1266,31 @@ automatically opened the first time C<ping()> is called.
 This call simply does nothing if you are using any protocol other
 than stream.
 
+=item $p->ack( [ $host ] );
+
+When using the "syn" protocol, use this method to determine
+the reachability of the remote host.  This method is meant
+to be called up to as many times as ping() was called.  Each
+call returns the host (as passed to ping()) that came back
+with the TCP ACK.  The order in which the hosts are returned
+may not necessarily be the same order in which they were
+SYN queued using the ping() method.  If the timeout is
+reached before the TCP ACK is received, or if the remote
+host is not listening on the port attempted, then the TCP
+connection will not be established and ack() will return
+undef.  In list context, the host, the ack time, and the
+dotted ip string will be returned instead of just the host.
+If the optional $host argument is specified, the return
+value will be partaining to that host only.
+This call simply does nothing if you are using any protocol
+other than syn.
+
+=item $p->nack( $failed_ack_host );
+
+The reason that host $failed_ack_host did not receive a
+valid ACK.  Useful to find out why when ack( $fail_ack_host )
+returns a false value.
+
 =item $p->close();
 
 Close the network connection for this ping object.  The network
@@ -876,6 +1345,43 @@ routines to pack and unpack ICMP packets.  It would be better for a
 separate module to be written which understands all of the different
 kinds of ICMP packets.
 
+=head1 INSTALL
+
+The latest source tree is available via cvs:
+
+  cvs -z3 -q -d :pserver:anonymous@cvs.roobik.com.:/usr/local/cvsroot/freeware checkout Net-Ping
+  cd Net-Ping
+
+The tarball can be created as follows:
+
+  perl Makefile.PL ; make ; make dist
+
+The latest Net::Ping release can be found at CPAN:
+
+  $CPAN/modules/by-module/Net/
+
+1) Extract the tarball
+
+  gtar -zxvf Net-Ping-xxxx.tar.gz
+  cd Net-Ping-xxxx
+
+2) Build:
+
+  make realclean
+  perl Makefile.PL
+  make
+  make test
+
+3) Install
+
+  make install
+
+Or install it RPM Style:
+
+  rpm -ta SOURCES/Net-Ping-xxxx.tar.gz
+
+  rpm -ih RPMS/noarch/perl-Net-Ping-xxxx.rpm
+
 =head1 AUTHORS
 
   Current maintainer: