From: Jarkko Hietaniemi Date: Wed, 19 Dec 2001 14:55:26 +0000 (+0000) Subject: Upgrade to Net::Ping 2.09. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=505f3f16d6d7a74e8cf7e8f3a785787b06f153f9;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Net::Ping 2.09. p4raw-id: //depot/perl@13804 --- diff --git a/MANIFEST b/MANIFEST index b320b65..0fa46a2 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1139,6 +1139,15 @@ lib/Net/netent.t See if Net::netent works lib/Net/Netrc.pm libnet lib/Net/NNTP.pm libnet lib/Net/Ping.pm Hello, anybody home? +lib/Net/Ping/CHANGES Net::Ping +lib/Net/Ping/README Net::Ping +lib/Net/Ping/t/100_load.t Ping Net::Ping +lib/Net/Ping/t/110_icmp_inst.t Ping Net::Ping +lib/Net/Ping/t/120_udp_inst.t Ping Net::Ping +lib/Net/Ping/t/130_tcp_inst.t Ping Net::Ping +lib/Net/Ping/t/140_stream_inst.t Ping Net::Ping +lib/Net/Ping/t/200_ping_tcp.t Ping Net::Ping +lib/Net/Ping/t/300_ping_stream.t Ping Net::Ping lib/Net/POP3.pm libnet lib/Net/protoent.pm By-name interface to Perl's builtin getproto* lib/Net/protoent.t See if Net::protoent works diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm index d78a14f..c3673b1 100644 --- a/lib/Net/Ping.pm +++ b/lib/Net/Ping.pm @@ -1,6 +1,6 @@ package Net::Ping; -# $Id: Ping.pm,v 1.11 2001/12/04 02:41:51 rob Exp $ +# $Id: Ping.pm,v 1.13 2001/12/07 02:18:44 rob Exp $ require 5.002; require Exporter; @@ -15,7 +15,7 @@ use Carp; @ISA = qw(Exporter); @EXPORT = qw(pingecho); -$VERSION = 2.07; +$VERSION = 2.09; # Constants @@ -371,7 +371,7 @@ sub tcp_connect $child = waitpid($pid, &POSIX::WNOHANG); $! = $? >> 8; $@ = $!; - sleep 1; + select(undef, undef, undef, 0.1); } while time < $patience && $child != $pid; if ($child == $pid) { @@ -595,7 +595,7 @@ __END__ Net::Ping - check a remote host for reachability -$Id: Ping.pm,v 1.11 2001/12/04 02:41:51 rob Exp $ +$Id: Ping.pm,v 1.13 2001/12/07 02:18:44 rob Exp $ =head1 SYNOPSIS diff --git a/lib/Net/Ping/CHANGES b/lib/Net/Ping/CHANGES new file mode 100644 index 0000000..fb327f1 --- /dev/null +++ b/lib/Net/Ping/CHANGES @@ -0,0 +1,40 @@ +CHANGES +------- + +2.09 Dec 06 19:00 2001 + - Documental and test changes only. + - No functional changes. + +2.08 Dec 04 13:00 2001 + - Faster response for Win32 tcp_connect. + - Better explanations in test comments. + +2.07 Nov 28 13:00 2001 + - Compatibility changes + - Works with UNIX and Win32 OS + - Works with Perl 5.005 5.6.x 5.7.x 5.8.x + - Applied several patches from distro + - External protocol added thanks to + colinm@cpan.org (Colin McMillen) + - Stream protocol added thanks to + bronson@trestle.com (Scott Bronson) + +2.06 Nov 19 12:00 2001 + - Added Net-Ping.spec for RPM to easily + utilize using "rpm -ta Net-Ping*tar.gz" + - Moved Copyright section to perldoc + +2.05 Nov 18 20:00 2001 + - Added test suite + +2.04 Nov 16 16:00 2001 + - Added CHANGES and README to tarball. + - No functional changes. + +2.03 Nov 15 12:00 2001 + - Portability adjustments to ping_tcp() + made by Rob Brown to work with most + default systems. + +2.02 Sep 27 12:00 1996 + - Magic version by Russell Mosemann from CPAN diff --git a/lib/Net/Ping/README b/lib/Net/Ping/README new file mode 100644 index 0000000..53b4dab --- /dev/null +++ b/lib/Net/Ping/README @@ -0,0 +1,195 @@ +NAME + Net::Ping - check a remote host for reachability + + $Id: Ping.pm,v 1.13 2001/12/07 02:18:44 rob Exp $ + +SYNOPSIS + use Net::Ping; + + $p = Net::Ping->new(); + print "$host is alive.\n" if $p->ping($host); + $p->close(); + + $p = Net::Ping->new("icmp"); + foreach $host (@host_array) + { + print "$host is "; + print "NOT " unless $p->ping($host, 2); + print "reachable.\n"; + sleep(1); + } + $p->close(); + + $p = Net::Ping->new("tcp", 2); + # Try connecting to the www port instead of the echo port + $p->{port_num} = getservbyname("http", "tcp"); + while ($stop_time > time()) + { + print "$host not reachable ", scalar(localtime()), "\n" + unless $p->ping($host); + sleep(300); + } + undef($p); + + # For backward compatibility + print "$host is alive.\n" if pingecho($host); + +DESCRIPTION + This module contains methods to test the reachability of remote 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 four 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 + data is actually echoed. This protocol does not require any special + privileges but has higher overhead than the other two protocols. + + Specifying the "udp" protocol causes the ping() method to send a udp + packet to the remote host's echo port. If the echoed packet is 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 a udp ping, a host will be reported as unreachable if it + is not running the appropriate echo service. For Unix-like systems see + the inetd(8) manpage 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 the + echoed information is correct, the remote host is considered reachable. + Specifying the "icmp" protocol requires that the program be run as root + or that the program be setuid to root. + + If the "external" protocol is specified, the ping() method attempts to + use the `Net::Ping::External' module to ping the remote host. + `Net::Ping::External' interfaces with your system's default `ping' + utility to perform the ping, and generally produces relatively accurate + results. If `Net::Ping::External' if not installed on your system, + specifying the "external" protocol will result in an error. + + Functions + + Net::Ping->new([$proto [, $def_timeout [, $bytes]]]); + Create a new ping object. All of the parameters are optional. $proto + specifies the protocol to use when doing a ping. The current choices + are "tcp", "udp" or "icmp". The default is "udp". + + If a default timeout ($def_timeout) in seconds is provided, it is + used when a timeout is not given to the ping() method (below). The + timeout must be greater than 0 and the default, if not specified, is + 5 seconds. + + If the number of data bytes ($bytes) is given, that many data bytes + are included in the ping packet sent to the remote host. The number + of data bytes is ignored if the protocol is "tcp". The minimum (and + default) number of data bytes is 1 if the protocol is "udp" and 0 + otherwise. The maximum number of data bytes that can be specified is + 1024. + + $p->ping($host [, $timeout]); + Ping the remote host and wait for a response. $host can be either + the hostname or the IP number of the remote host. The optional + timeout must be greater than 0 seconds and defaults to whatever was + specified when the ping object was created. If the hostname cannot + be found or there is a problem with the IP number, undef is + returned. Otherwise, 1 is returned if the host is reachable and 0 if + it is not. For all practical purposes, undef and 0 and can be + treated as the same case. + + $p->open($host); + When you are using the stream protocol, this call pre-opens the tcp + socket. It's only necessary to do this if you want to provide a + different timeout when creating the connection, or remove the + overhead of establishing the connection from the first ping. If you + don't call `open()', the connection is automatically opened the + first time `ping()' is called. This call simply does nothing if you + are using any protocol other than stream. + + $p->open($host); + When you are using the stream protocol, this call pre-opens the tcp + socket. It's only necessary to do this if you want to provide a + different timeout when creating the connection, or remove the + overhead of establishing the connection from the first ping. If you + don't call `open()', the connection is automatically opened the + first time `ping()' is called. This call simply does nothing if you + are using any protocol other than stream. + + $p->close(); + Close the network connection for this ping object. The network + connection is also closed by "undef $p". The network connection is + automatically closed if the ping object goes out of scope (e.g. $p + is local to a subroutine and you leave the subroutine). + + pingecho($host [, $timeout]); + To provide backward compatibility with the previous version of + Net::Ping, a pingecho() subroutine is available with the same + functionality as before. pingecho() uses the tcp protocol. The + return values and parameters are the same as described for the + ping() method. This subroutine is obsolete and may be removed in a + future version of Net::Ping. + +WARNING + pingecho() or a ping object with the tcp protocol use alarm() to + implement the timeout. So, don't use alarm() in your program while you + are using pingecho() or a ping object with the tcp protocol. The udp and + icmp protocols do not use alarm() to implement the timeout. + +NOTES + There will be less network overhead (and some efficiency in your + program) if you specify either the udp or the icmp protocol. The tcp + protocol will generate 2.5 times or more traffic for each ping than + either udp or icmp. If many hosts are pinged frequently, you may wish to + implement a small wait (e.g. 25ms or more) between each ping to avoid + flooding your network with packets. + + The icmp protocol requires that the program be run as root or that it be + setuid to root. The other protocols do not require special privileges, + but not all network devices implement tcp or udp echo. + + Local hosts should normally respond to pings within milliseconds. + However, on a very congested network it may take up to 3 seconds or + longer to receive an echo packet from the remote host. If the timeout is + set too low under these conditions, it will appear that the remote host + is not reachable (which is almost the truth). + + Reachability doesn't necessarily mean that the remote host is actually + functioning beyond its ability to echo packets. tcp is slightly better + at indicating the health of a system than icmp because it uses more of + the networking stack to respond. + + Because of a lack of anything better, this module uses its own routines + to pack and unpack ICMP packets. It would be better for a separate + module to be written which understands all of the different kinds of + ICMP packets. + +AUTHOR(S) + Current maintainer Net::Ping base code: + colinm@cpan.org (Colin McMillen) + + Stream protocol: + bronson@trestle.com (Scott Bronson) + + Original pingecho(): + karrer@bernina.ethz.ch (Andreas Karrer) + pmarquess@bfsec.bt.co.uk (Paul Marquess) + + Original Net::Ping author: + mose@ns.ccsn.edu (Russell Mosemann) + + Compatibility porting: + bbb@cpan.org (Rob Brown) + +COPYRIGHT + Copyright (c) 2001, Colin McMillen. All rights reserved. Copyright (c) + 2001, Rob Brown. All rights reserved. + + This program is free software; you may redistribute it and/or modify it + under the same terms as Perl itself. + diff --git a/lib/Net/Ping/t/100_load.t b/lib/Net/Ping/t/100_load.t new file mode 100644 index 0000000..d6a71e0 --- /dev/null +++ b/lib/Net/Ping/t/100_load.t @@ -0,0 +1,19 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl test.t' + +######################### We start with some black magic to print on failure. + +use Test; +BEGIN { plan tests => 1; $loaded = 0} +END { ok $loaded;} + +# Just make sure everything compiles +use Net::Ping; + +$loaded = 1; + +######################### End of black magic. + +# Insert your test code below (better if it prints "ok 13" +# (correspondingly "not ok 13") depending on the success of chunk 13 +# of the test code): diff --git a/lib/Net/Ping/t/110_icmp_inst.t b/lib/Net/Ping/t/110_icmp_inst.t new file mode 100644 index 0000000..2e67a59 --- /dev/null +++ b/lib/Net/Ping/t/110_icmp_inst.t @@ -0,0 +1,12 @@ +# Test to make sure object can be instantiated for icmp protocol. +# Root access is required to actually perform icmp testing. + +use Test; +use Net::Ping; +plan tests => 2; + +# Everything loaded fine +ok 1; + +my $p = new Net::Ping "tcp"; +ok !!$p; diff --git a/lib/Net/Ping/t/120_udp_inst.t b/lib/Net/Ping/t/120_udp_inst.t new file mode 100644 index 0000000..ee53bd4 --- /dev/null +++ b/lib/Net/Ping/t/120_udp_inst.t @@ -0,0 +1,12 @@ +# Test to make sure object can be instantiated for udp protocol. +# I do not know of any servers that support udp echo anymore. + +use Test; +use Net::Ping; +plan tests => 2; + +# Everything loaded fine +ok 1; + +my $p = new Net::Ping "udp"; +ok !!$p; diff --git a/lib/Net/Ping/t/130_tcp_inst.t b/lib/Net/Ping/t/130_tcp_inst.t new file mode 100644 index 0000000..6a547e1 --- /dev/null +++ b/lib/Net/Ping/t/130_tcp_inst.t @@ -0,0 +1,11 @@ +# Test to make sure object can be instantiated for tcp protocol. + +use Test; +use Net::Ping; +plan tests => 2; + +# Everything loaded fine +ok 1; + +my $p = new Net::Ping "tcp"; +ok !!$p; diff --git a/lib/Net/Ping/t/140_stream_inst.t b/lib/Net/Ping/t/140_stream_inst.t new file mode 100644 index 0000000..142f6db --- /dev/null +++ b/lib/Net/Ping/t/140_stream_inst.t @@ -0,0 +1,11 @@ +# Test to make sure object can be instantiated for stream protocol. + +use Test; +use Net::Ping; +plan tests => 2; + +# Everything loaded fine +ok 1; + +my $p = new Net::Ping "stream"; +ok !!$p; diff --git a/lib/Net/Ping/t/200_ping_tcp.t b/lib/Net/Ping/t/200_ping_tcp.t new file mode 100644 index 0000000..7bdc8e7 --- /dev/null +++ b/lib/Net/Ping/t/200_ping_tcp.t @@ -0,0 +1,60 @@ +BEGIN { + if ($ENV{PERL_CORE}) { + unless ($ENV{PERL_TEST_Net_Ping}) { + print "1..0 # Skip: network dependent test\n"; + exit; + } + chdir 't' if -d 't'; + @INC = qw(../lib); + } +} + +# Remote network test using tcp protocol. +# +# NOTE: +# Network connectivity will be required for all tests to pass. +# Firewalls may also cause some tests to fail, so test it +# on a clear network. If you know you do not have a direct +# connection to remote networks, but you still want the tests +# to pass, use the following: +# +# $ PERL_CORE=1 make test + +use Test; +use Net::Ping; +plan tests => 13; + +# Everything loaded fine +ok 1; + +my $p = new Net::Ping "tcp"; + +# new() worked? +ok !!$p; + +# Test on the default port +ok $p -> ping("localhost"); + +# Change to use the more common web port. +# This will pull from /etc/services on UNIX. +# (Make sure getservbyname works in scalar context.) +ok ($p -> {port_num} = (getservbyname("http", "tcp") || 80)); + +# Test localhost on the web port +ok $p -> ping("localhost"); + +# Hopefully this is not a routeable host +ok !$p -> ping("10.12.14.16"); + +# Test a few remote servers +# Hopefully they are up when the tests are run. + +ok $p -> ping("www.geocities.com"); +ok $p -> ping("ftp.geocities.com"); + +ok $p -> ping("www.freeservers.com"); +ok $p -> ping("ftp.freeservers.com"); + +ok $p -> ping("yahoo.com"); +ok $p -> ping("www.yahoo.com"); +ok $p -> ping("www.about.com"); diff --git a/lib/Net/Ping/t/300_ping_stream.t b/lib/Net/Ping/t/300_ping_stream.t new file mode 100644 index 0000000..4c32a64 --- /dev/null +++ b/lib/Net/Ping/t/300_ping_stream.t @@ -0,0 +1,55 @@ +BEGIN { + if ($ENV{PERL_CORE}) { + unless ($ENV{PERL_TEST_Net_Ping}) { + print "1..0 # Skip: network dependent test\n"; + exit; + } + chdir 't' if -d 't'; + @INC = qw(../lib); + } +} + +# Test of stream protocol using loopback interface. +# +# NOTE: +# The echo service must be enabled on localhost +# to really test the stream protocol ping. + +use Test; +use Net::Ping; +plan tests => 12; + +my $p = new Net::Ping "stream"; + +# new() worked? +ok !!$p; + +# Attempt to connect to the echo port +if ($p -> ping("localhost")) { + ok 1; + # Try several pings while it is connected + for (1..10) { + ok $p -> ping("localhost"); + } +} else { + # Echo port is off, skip the tests + for (2..12) { skip "Local echo port is off", 1; } + exit; +} + +__END__ + +A simple xinetd configuration to enable the echo service can easily be made. +Just create the following file before restarting xinetd: + +/etc/xinetd.d/echo: + +# description: echo service +service echo +{ + socket_type = stream + wait = no + user = root + server = /bin/cat + disable = no +}