summaryrefslogtreecommitdiffstats
path: root/contrib/perl5/lib/Net
diff options
context:
space:
mode:
authormarkm <markm@FreeBSD.org>2002-03-16 20:14:30 +0000
committermarkm <markm@FreeBSD.org>2002-03-16 20:14:30 +0000
commit3eac21f49bc763a6c0044b4afbc0c7ece760144f (patch)
tree4cf1274fa3ca68f7ecf6a3051e0c2243e378afc5 /contrib/perl5/lib/Net
parent259bd53c06712c4ffb0ab7e06898c19ebf221b21 (diff)
downloadFreeBSD-src-3eac21f49bc763a6c0044b4afbc0c7ece760144f.zip
FreeBSD-src-3eac21f49bc763a6c0044b4afbc0c7ece760144f.tar.gz
Vendor import Perl 5.6.1
Diffstat (limited to 'contrib/perl5/lib/Net')
-rw-r--r--contrib/perl5/lib/Net/Ping.pm36
-rw-r--r--contrib/perl5/lib/Net/protoent.pm3
2 files changed, 25 insertions, 14 deletions
diff --git a/contrib/perl5/lib/Net/Ping.pm b/contrib/perl5/lib/Net/Ping.pm
index 2713383..a2846fe 100644
--- a/contrib/perl5/lib/Net/Ping.pm
+++ b/contrib/perl5/lib/Net/Ping.pm
@@ -269,13 +269,13 @@ sub checksum
);
$len_msg = length($msg);
- $num_short = $len_msg / 2;
+ $num_short = int($len_msg / 2);
$chk = 0;
foreach $short (unpack("S$num_short", $msg))
{
$chk += $short;
} # Add the odd byte in
- $chk += unpack("C", substr($msg, $len_msg - 1, 1)) if $len_msg % 2;
+ $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
$chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low
return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement
}
@@ -369,16 +369,17 @@ sub ping_udp
elsif ($nfound) # A packet is waiting
{
$from_msg = "";
- $from_saddr = recv($self->{"fh"}, $from_msg, 1500, $flags);
- ($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))
- {
- $ret = 1; # It's a winner
- $done = 1;
- }
- }
+ $from_saddr = recv($self->{"fh"}, $from_msg, 1500, $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))
+ {
+ $ret = 1; # It's a winner
+ $done = 1;
+ }
+ }
else # Oops, timed out
{
$done = 1;
@@ -442,7 +443,11 @@ 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 three different protocols to use for the ping.
+You may choose one of three different protocols to use for the
+ping. The "udp" 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.
+
With the "tcp" protocol the ping() method attempts to establish a
connection to the remote host's echo port. If the connection is
successfully established, the remote host is considered reachable. No
@@ -455,6 +460,11 @@ received from the remote host and the received packet contains the
same data as the packet that was sent, the remote host is considered
reachable. This protocol does not require any special privileges.
+It should be borne in mind that, for both tcp and udp ping, a host
+will be reported as unreachable if it is not running the
+appropriate echo service. For Unix-like systems see L<inetd(8)> for
+more information.
+
If the "icmp" protocol is specified, the ping() method sends an icmp
echo message to the remote host, which is what the UNIX ping program
does. If the echoed message is received from the remote host and
diff --git a/contrib/perl5/lib/Net/protoent.pm b/contrib/perl5/lib/Net/protoent.pm
index 334af78..00a76af 100644
--- a/contrib/perl5/lib/Net/protoent.pm
+++ b/contrib/perl5/lib/Net/protoent.pm
@@ -6,7 +6,7 @@ our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
BEGIN {
use Exporter ();
@EXPORT = qw(getprotobyname getprotobynumber getprotoent);
- @EXPORT_OK = qw( $p_name @p_aliases $p_proto );
+ @EXPORT_OK = qw( $p_name @p_aliases $p_proto getproto );
%EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
}
use vars @EXPORT_OK;
@@ -78,6 +78,7 @@ regular array variables, so for example C<@{ $proto_obj-E<gt>aliases()
The getproto() function is a simple front-end that forwards a numeric
argument to getprotobyport(), and the rest to getprotobyname().
+This function is not exported by default.
To access this functionality without the core overrides,
pass the C<use> an empty import list, and then access
OpenPOWER on IntegriCloud