Change 19988 by [EMAIL PROTECTED] on 2003/07/04 13:17:22
Upgrade to Net::Ping 2.31.
Affected files ...
... //depot/perl/lib/Net/Ping.pm#42 edit
... //depot/perl/lib/Net/Ping/Changes#6 edit
... //depot/perl/lib/Net/Ping/t/250_ping_hires.t#3 edit
... //depot/perl/lib/Net/Ping/t/300_ping_stream.t#6 edit
... //depot/perl/lib/Net/Ping/t/450_service.t#7 edit
Differences ...
==== //depot/perl/lib/Net/Ping.pm#42 (text) ====
Index: perl/lib/Net/Ping.pm
--- perl/lib/Net/Ping.pm#41~19536~ Fri May 16 23:07:07 2003
+++ perl/lib/Net/Ping.pm Fri Jul 4 06:17:22 2003
@@ -16,7 +16,10 @@
@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 @@
$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 @@
$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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
=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 @@
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 @@
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
==== //depot/perl/lib/Net/Ping/Changes#6 (text) ====
Index: perl/lib/Net/Ping/Changes
--- perl/lib/Net/Ping/Changes#5~19270~ Sat Apr 19 05:09:21 2003
+++ perl/lib/Net/Ping/Changes Fri Jul 4 06:17:22 2003
@@ -1,7 +1,14 @@
CHANGES
-------
-3.30 Apr 18 14:00 2003
+2.31 Jun 28 14:00 2003
+ - Win32 Compatibility fixes.
+ Patch by [EMAIL PROTECTED] (Marcus Holland-Moritz)
+ - Apply bleadperl patch #22204
+ - Add ToS support.
+ Patch by [EMAIL PROTECTED] (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
==== //depot/perl/lib/Net/Ping/t/250_ping_hires.t#3 (text) ====
Index: perl/lib/Net/Ping/t/250_ping_hires.t
--- perl/lib/Net/Ping/t/250_ping_hires.t#2~19723~ Mon Jun 9 11:00:57 2003
+++ perl/lib/Net/Ping/t/250_ping_hires.t Fri Jul 4 06:17:22 2003
@@ -57,7 +57,5 @@
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 =~ /\./;
==== //depot/perl/lib/Net/Ping/t/300_ping_stream.t#6 (text) ====
Index: perl/lib/Net/Ping/t/300_ping_stream.t
--- perl/lib/Net/Ping/t/300_ping_stream.t#5~18671~ Sat Feb 8 00:35:06 2003
+++ perl/lib/Net/Ping/t/300_ping_stream.t Fri Jul 4 06:17:22 2003
@@ -14,7 +14,7 @@
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);
==== //depot/perl/lib/Net/Ping/t/450_service.t#7 (text) ====
Index: perl/lib/Net/Ping/t/450_service.t
--- perl/lib/Net/Ping/t/450_service.t#6~19724~ Mon Jun 9 11:17:42 2003
+++ perl/lib/Net/Ping/t/450_service.t Fri Jul 4 06:17:22 2003
@@ -19,7 +19,7 @@
# 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;
End of Patch.
