From: Jarkko Hietaniemi Date: Fri, 4 Jul 2003 13:17:22 +0000 (+0000) Subject: Upgrade to Net::Ping 2.31. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=03550e9d59a5decbb987360bea1dceb32becfebb;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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;