| Subject: | [PATCH] Accumulate fixes from bleadperl |
Over the past four years, several fixes have been applied to bleadperl
to fix various problems with Net::Ping. The patch below is the
accumulated differences between Net-Ping-2.31 and bleadperl.
--- lib/Net/Ping.pm 2003-06-27 16:31:07.000000000 -0500
+++ /home/steve/p4-bleadperl/perl/lib/Net/Ping.pm 2007-07-10
14:02:22.000000000 -0500
@@ -16,7 +16,7 @@
@ISA = qw(Exporter);
@EXPORT = qw(pingecho);
-$VERSION = "2.31";
+$VERSION = "2.31_04";
sub SOL_IP { 0; };
sub IP_TOS { 1; };
@@ -35,11 +35,11 @@
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?
- *ENOTCONN = sub {10057;};
- *ECONNRESET = sub {10054;};
- *EINPROGRESS = sub {10036;};
- *EWOULDBLOCK = sub {10035;};
+ *ECONNREFUSED = sub() {10061;}; # "Unknown Error" Special Win32 Response?
+ *ENOTCONN = sub() {10057;};
+ *ECONNRESET = sub() {10054;};
+ *EINPROGRESS = sub() {10036;};
+ *EWOULDBLOCK = sub() {10035;};
# $syn_forking = 1; # XXX possibly useful in < Win2K ?
};
@@ -240,6 +240,7 @@
while (1) {
$gran = $t if $gran > $t;
my $nfound = select($_[0], $_[1], $_[2], $gran);
+ undef $nfound if $nfound == -1;
$t -= $gran;
return $nfound if $nfound or !defined($nfound) or $t <= 0;
@@ -248,11 +249,13 @@
}
}
else {
- return select($_[0], $_[1], $_[2], $_[3]);
+ my $nfound = select($_[0], $_[1], $_[2], $_[3]);
+ undef $nfound if $nfound == -1;
+ return $nfound;
}
}
-# Description: Allow UDP source endpoint comparision to be
+# Description: Allow UDP source endpoint comparison to be
# skipped for those remote interfaces that do
# not response from the same endpoint.
@@ -316,9 +319,9 @@
# set the non-blocking mode (set O_NONBLOCK)
my $flags;
- if ($^O eq 'MSWin32') {
- # FIONBIO enables non-blocking sockets on windows.
- # FIONBIO is (0x80000000|(4<<16)|(ord('f')<<8)|126), as per
winsock.h.
+ if ($^O eq 'MSWin32' || $^O eq 'VMS') {
+ # FIONBIO enables non-blocking sockets on windows and vms.
+ # FIONBIO is (0x80000000|(4<<16)|(ord('f')<<8)|126), as per
winsock.h, ioctl.h
my $f = 0x8004667e;
my $v = pack("L", $block ? 0 : 1);
ioctl($fh, $f, $v) or croak("ioctl failed: $!");
@@ -395,12 +398,13 @@
return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
}
-use constant ICMP_ECHOREPLY => 0; # ICMP packet types
-use constant ICMP_ECHO => 8;
-use constant ICMP_STRUCT => "C2 n3 A"; # Structure of a minimal
ICMP packet
-use constant SUBCODE => 0; # No ICMP subcode for ECHO and ECHOREPLY
-use constant ICMP_FLAGS => 0; # No special flags for send or recv
-use constant ICMP_PORT => 0; # No port with ICMP
+use constant ICMP_ECHOREPLY => 0; # ICMP packet types
+use constant ICMP_UNREACHABLE => 3; # ICMP packet types
+use constant ICMP_ECHO => 8;
+use constant ICMP_STRUCT => "C2 n3 A"; # Structure of a minimal
ICMP packet
+use constant SUBCODE => 0; # No ICMP subcode for ECHO and
ECHOREPLY
+use constant ICMP_FLAGS => 0; # No special flags for send or recv
+use constant ICMP_PORT => 0; # No port with ICMP
sub ping_icmp
{
@@ -478,10 +482,12 @@
$self->{"from_subcode"} = $from_subcode;
if (($from_pid == $self->{"pid"}) && # Does the packet check out?
($from_seq == $self->{"seq"})) {
- if ($from_type == ICMP_ECHOREPLY){
+ if ($from_type == ICMP_ECHOREPLY) {
$ret = 1;
+ $done = 1;
+ } elsif ($from_type == ICMP_UNREACHABLE) {
+ $done = 1;
}
- $done = 1;
}
} else { # Oops, timed out
$done = 1;
@@ -1471,7 +1477,7 @@
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
+a TCP ACK within the timeout specified. 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
@@ -1503,10 +1509,10 @@
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
+before sending the ping packet. I believe 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.
+If $tos is given, this ToS is configured into the socket.
=item $p->ping($host [, $timeout]);
@@ -1559,7 +1565,7 @@
=item $p->tcp_service_check( { 0 | 1 } );
-Depricated method, but does the same as service_check() method.
+Deprecated method, but does the same as service_check() method.
=item $p->hires( { 0 | 1 } );
@@ -1608,7 +1614,7 @@
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.
+value will be pertaining to that host only.
This call simply does nothing if you are using any protocol
other than syn.
diff -ur t/110_icmp_inst.t
/home/steve/p4-bleadperl/perl/lib/Net/Ping/t/110_icmp_inst.t
--- t/110_icmp_inst.t 2002-10-14 12:10:03.000000000 -0500
+++ /home/steve/p4-bleadperl/perl/lib/Net/Ping/t/110_icmp_inst.t
2006-12-29 20:29:20.000000000 -0600
@@ -17,7 +17,7 @@
if (($> and $^O ne 'VMS' and $^O ne 'cygwin')
or ($^O eq 'MSWin32'
- and Win32::IsWinNT())
+ and !IsAdminUser())
or ($^O eq 'VMS'
and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/))) {
skip "icmp ping requires root privileges.", 1;
@@ -27,3 +27,10 @@
my $p = new Net::Ping "icmp";
ok !!$p;
}
+
+sub IsAdminUser {
+ return unless $^O eq 'MSWin32';
+ return unless eval { require Win32 };
+ return unless defined &Win32::IsAdminUser;
+ return Win32::IsAdminUser();
+}
diff -ur t/250_ping_hires.t
/home/steve/p4-bleadperl/perl/lib/Net/Ping/t/250_ping_hires.t
--- t/250_ping_hires.t 2002-04-01 16:12:37.000000000 -0600
+++ /home/steve/p4-bleadperl/perl/lib/Net/Ping/t/250_ping_hires.t
2007-07-02 11:28:38.000000000 -0500
@@ -23,7 +23,7 @@
}
}
-use Test;
+use Test qw(plan ok $TESTERR);
use Net::Ping;
plan tests => 8;
@@ -57,5 +57,8 @@
ok $ret;
# It is extremely likely that the duration contains a decimal
-# point if Time::HiRes is functioning properly.
-ok $duration =~ /\./;
+# point if Time::HiRes is functioning properly, except when it
+# is fast enough to be "0", or slow enough to be exactly "1".
+if (! ok($duration =~ /\.|^[01]$/)) {
+ print($TESTERR "# duration=[$duration]\n");
+}
diff -ur t/450_service.t
/home/steve/p4-bleadperl/perl/lib/Net/Ping/t/450_service.t
--- t/450_service.t 2003-04-16 12:07:24.000000000 -0500
+++ /home/steve/p4-bleadperl/perl/lib/Net/Ping/t/450_service.t
2006-12-29 20:29:21.000000000 -0600
@@ -19,7 +19,8 @@
# for the TCP Server stuff instead of doing
# all that direct socket() junk manually.
-plan tests => 26;
+plan tests => 26, ($^O eq 'MSWin32' ? (todo => [18]) :
+ $^O eq "hpux" ? (todo => [9, 18]) : ());
# Everything loaded fine
ok 1;
diff -ur t/500_ping_icmp.t
/home/steve/p4-bleadperl/perl/lib/Net/Ping/t/500_ping_icmp.t
--- t/500_ping_icmp.t 2002-12-30 14:12:12.000000000 -0600
+++ /home/steve/p4-bleadperl/perl/lib/Net/Ping/t/500_ping_icmp.t
2007-07-09 13:18:45.000000000 -0500
@@ -15,9 +15,9 @@
# Everything loaded fine
ok 1;
-if (($> and $^O ne 'VMS' and $^O ne 'cygwin')
- or ($^O eq 'MSWin32'
- and Win32::IsWinNT())
+if (($> and $^O ne 'VMS')
+ or (($^O eq 'MSWin32' or $^O eq 'cygwin')
+ and !IsAdminUser())
or ($^O eq 'VMS'
and (`write sys\$output f\$privilege("SYSPRV")` =~ m/FALSE/))) {
skip "icmp ping requires root privileges.", 1;
@@ -27,3 +27,10 @@
my $p = new Net::Ping "icmp";
ok $p->ping("127.0.0.1");
}
+
+sub IsAdminUser {
+ return unless $^O eq 'MSWin32' or $^O eq "cygwin";
+ return unless eval { require Win32 };
+ return unless defined &Win32::IsAdminUser;
+ return Win32::IsAdminUser();
+}