Upgrade to Net::Ping 2.31.

p4raw-id: //depot/perl@19988

diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm
index 05a3fd5..001ff2e 100644 (file)
--- a/lib/Net/Ping.pm
+++ b/lib/Net/Ping.pm
@@ -16,7 +16,10 @@ use Carp;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(pingecho);
-$VERSION = "2.30";
+$VERSION = "2.31";
+
+sub SOL_IP { 0; };
+sub IP_TOS { 1; };
 
 # Constants
 
@@ -74,6 +77,7 @@ sub new
       $timeout,           # Optional timeout in seconds
       $data_size,         # Optional additional bytes of data
       $device,            # Optional device to use
+      $tos,               # Optional ToS to set
       ) = @_;
   my  $class = ref($this) || $this;
   my  $self = {};
@@ -95,6 +99,8 @@ sub new
 
   $self->{"device"} = $device;
 
+  $self->{"tos"} = $tos;
+
   $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")
@@ -127,6 +133,10 @@ sub new
       setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
         or croak "error binding to device $self->{'device'} $!";
     }
+    if ($self->{'tos'}) {
+      setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+        or croak "error configuring tos to $self->{'tos'} $!";
+    }
   }
   elsif ($self->{"proto"} eq "icmp")
   {
@@ -141,6 +151,10 @@ sub new
       setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
         or croak "error binding to device $self->{'device'} $!";
     }
+    if ($self->{'tos'}) {
+      setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+        or croak "error configuring tos to $self->{'tos'} $!";
+    }
   }
   elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
   {
@@ -203,7 +217,7 @@ sub bind
   CORE::bind($self->{"fh"}, sockaddr_in(0, $ip)) ||
     croak("$self->{'proto'} bind error - $!");
   }
-  elsif ($self->{"proto"} ne "tcp")
+  elsif (($self->{"proto"} ne "tcp") && ($self->{"proto"} ne "syn"))
   {
     croak("Unknown protocol \"$self->{proto}\" in bind()");
   }
@@ -562,6 +576,10 @@ sub tcp_connect
       setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
         or croak("error binding to device $self->{'device'} $!");
     }
+    if ($self->{'tos'}) {
+      setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+        or croak "error configuring tos to $self->{'tos'} $!";
+    }
   };
   my $do_connect = sub {
     $self->{"ip"} = $ip;
@@ -1002,7 +1020,10 @@ sub ping_syn
     setsockopt($fh, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
       or croak("error binding to device $self->{'device'} $!");
   }
-
+  if ($self->{'tos'}) {
+    setsockopt($fh, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+      or croak "error configuring tos to $self->{'tos'} $!";
+  }
   # Set O_NONBLOCK property on filehandle
   $self->socket_blocking_mode($fh, 0);
 
@@ -1068,6 +1089,10 @@ sub ping_syn_fork {
         setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
           or croak("error binding to device $self->{'device'} $!");
       }
+      if ($self->{'tos'}) {
+        setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
+          or croak "error configuring tos to $self->{'tos'} $!";
+      }
 
       $!=0;
       # Try to connect (could take a long time)
@@ -1459,7 +1484,7 @@ This protocol does not require any special privileges.
 
 =over 4
 
-=item Net::Ping->new([$proto [, $def_timeout [, $bytes [, $device ]]]]);
+=item Net::Ping->new([$proto [, $def_timeout [, $bytes [, $device [, $tos ]]]]]);
 
 Create a new ping object.  All of the parameters are optional.  $proto
 specifies the protocol to use when doing a ping.  The current choices
@@ -1481,6 +1506,8 @@ 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.
 
+If $tos is given, this ToS is configured into the soscket.
+
 =item $p->ping($host [, $timeout]);
 
 Ping the remote host and wait for a response.  $host can be either the
@@ -1712,6 +1739,6 @@ Copyright (c) 2001, Colin McMillen.  All rights reserved.
 This program is free software; you may redistribute it and/or
 modify it under the same terms as Perl itself.
 
-$Id: Ping.pm,v 1.81 2003/04/18 04:16:03 rob Exp $
+$Id: Ping.pm,v 1.86 2003/06/27 21:31:07 rob Exp $
 
 =cut

diff --git a/lib/Net/Ping/Changes b/lib/Net/Ping/Changes
index bcfad43..c4885be 100644 (file)
--- a/lib/Net/Ping/Changes
+++ b/lib/Net/Ping/Changes
@@ -1,7 +1,14 @@
 CHANGES
 -------
 
-3.30  Apr 18 14:00 2003
+2.31  Jun 28 14:00 2003
+       - Win32 Compatibility fixes.
+         Patch by mhx-perl@gmx.net (Marcus Holland-Moritz)
+       - Apply bleadperl patch #22204
+       - Add ToS support.
+         Patch by martin@lorensen.dk (Martin Lorensen)
+
+2.30  Apr 18 14:00 2003
        - Fix select() bug for UDP and ICMP protocols
          in case packet comes from wrong source or seq.
        - Allow UDP ping to different IP addresses

diff --git a/lib/Net/Ping/t/250_ping_hires.t b/lib/Net/Ping/t/250_ping_hires.t
index 91e905f..52dae1b 100644 (file)
--- a/lib/Net/Ping/t/250_ping_hires.t
+++ b/lib/Net/Ping/t/250_ping_hires.t
@@ -57,7 +57,5 @@ my ($ret, $duration) = $p -> ping("localhost");
 ok $ret;
 
 # It is extremely likely that the duration contains a decimal
-# point if Time::HiRes is functioning properly, except when it
-# it is fast enough to be "zero".
-print "# duration=[$duration]\n";
-ok $duration =~ /\.|^0$/;
+# point if Time::HiRes is functioning properly.
+ok $duration =~ /\./;

diff --git a/lib/Net/Ping/t/300_ping_stream.t b/lib/Net/Ping/t/300_ping_stream.t
index ddc36a2..3a2f444 100644 (file)
--- a/lib/Net/Ping/t/300_ping_stream.t
+++ b/lib/Net/Ping/t/300_ping_stream.t
@@ -14,7 +14,7 @@ BEGIN {
   if (my $port = getservbyname('echo', 'tcp')) {
     socket(*ECHO, &Socket::PF_INET(), &Socket::SOCK_STREAM(), (getprotobyname 'tcp')[2]);
     unless (connect(*ECHO, scalar &Socket::sockaddr_in($port, &Socket::inet_aton("localhost")))) {
-      print "1..0 \# Skip: loopback echo service is off ($!)\n";
+      print "1..0 \# Skip: loopback tcp echo service is off ($!)\n";
       exit;
     }
     close (*ECHO);

diff --git a/lib/Net/Ping/t/450_service.t b/lib/Net/Ping/t/450_service.t
index 006bf64..c41b84b 100644 (file)
--- a/lib/Net/Ping/t/450_service.t
+++ b/lib/Net/Ping/t/450_service.t
@@ -19,7 +19,7 @@ use Net::Ping;
 # for the TCP Server stuff instead of doing
 # all that direct socket() junk manually.
 
-plan tests => 26, ($^O eq 'MSWin32' ? (todo => [18]) : ());
+plan tests => 26;
 
 # Everything loaded fine
 ok 1;