sourcecode
idnopheq
<code>
#!/usr/local/bin/perl -w
#-*-perl-*-
#
=pod
=head1 NAME
B<ping> -- send ICMP ECHO_REQUEST packets to network hosts
=cut
use strict;
use Net::Ping;
use Getopt::Std;
use Sys::Hostname;
use vars qw ( %Option %Statistics );
use Time::HiRes qw ( gettimeofday tv_interval );
my ($VERSION) = '$Revision: 1.0 $' =~ /([.\d]+)/;
my $warnings = 0;
# print statistics on ^C if supported
#$SIG{INT} = \&PingStatistics;
$SIG {__WARN__} = sub { # Print a usuage message on an unknown
if ( substr ( # option. Borrowed from abigail.
$_ [0],
0,
14
) eq "Unknown option" ) { die "Usage" };
require File::Basename;
$0 = File::Basename::basename ( $0 );
$warnings = 1;
warn "$0: @_";
};
$SIG {__DIE__} = sub {
require File::Basename;
$0 = File::Basename::basename ( $0 );
if ( substr (
$_ [0],
0,
5
) eq "Usage" ) {
die <<EOF;
$0 (Perl bin utils) $VERSION
$0 [ -aAnq ] [ -c count ] [-i wait ] [ -p protocol ] [ -s packetsize ]
[ -w maxwait ] host
EOF
}
elsif ( substr (
$_ [0],
0,
6
) eq "Exited" ) {
die <<EOF;
$0: Exited on ^C
EOF
}
die "$0: @_";
};
=pod
=head1 SYNOPSIS
B<ping> [ -QaAnq ] [ -c count ] [ -i wait ] [ -p protocol ] [ -s packetsize ]
[ -w maxwait ] I<host>
=head1 DESCRIPTION
B<ping> tests whether a remote host can be reached from your computer.
This simple function is extremely useful as the first step in testing
network connections, B<ping> sends a packet to the destination host
with a timestamp. The destination host sends the packet back.
B<ping> calculates the time difference and displays the data.
This test is independent of any application in which the original
problem may have been detected. B<ping> allows you to determine whether further
testing should be directed toward the network connection or the
application. If B<ping> shows that packets can travel to the remote
system and back, the isse may be application related. If packets can't
make the round trip, the network may be at fault. Test further.
The options are as follows:
=head2 OPTIONS
=head3 note
This B<ping> implementation does support ~strange~ behavior some other
B<ping>'s exhibit due to answering the question "Where on the command
line should the destination host be listed?" Some, like Solaris and
Win32, answer this quandry by not caring if the host is the zeroth
(first, if you like) option or the last option. We don't care either,
and accomplish this zest for life by performing a quick
'begin-with-hyphen?' test on the primary argument. If no hyphen,
assume it is the destination host and the remainder are options. IF
we do see a hyphen, assume the last argument is the destination host
and gather all the prior stuff as options.
Please don't think you can stick the destination host anywhere. If it
is not at the start or end, it will be ignored and the syntax error
will appear.
=cut
my ( # set up excessive flexibility
$IpAddress, # a couple of testers commented that
$HostName, # allowing the destination host as the
$LocalHost # zeroth or else last argument is a
); # 'good thing'
die "Usage"
unless $ARGV[0];
# some 'ping' implementations allow
# destination host at the beginning
unless ( $ARGV[0] =~ /^-/ ) { # or end of the options at the shell
$IpAddress = shift @ARGV; # so, if the first option does not
} # start w/ '-', assume its a hostname
getopts ( # get our options
'aAc:i:np:qQs:w:', # see the pod doc below for details
\%Option # store them in our hash
);
$SIG{'INT'} = \&PingStatistics;
$IpAddress ||= $ARGV[0]; # get $ARGV[0] after 'getopts' if we
$HostName = $IpAddress; # didn't get it before
$LocalHost = hostname; # we see the '-n' option for beauty
=pod
=over
=item -a
Audible. Include a bell (ASCII 0x07) character in the output when
any packet is received.
=item -A
Audible. Include a bell (ASCII 0x07) character in the output when
any packet is not received.
=item -c count
Stop after sending (and receiving) count ECHO_RESPONSE packets. By
default, B<ping> will go continuously until interrupted. On most
systems, the statistics will display on a SIGINT (CTRL-C or ^C). But
on systems where SIGINT cannot be trapped (Win32, for example) will
simply end.
=item -i wait
Wait I<wait> miliseconds between sending each packet. The default is
to wait for 1000 ms (one second) between each packet. The wait time
may be fractional.
=item -n
Numeric output only. No attempt will be made to lookup symbolic names
for host addresses. This option cannot be performed unless the IP
address is offered on the command line and will fail otherwise.
=item -p protocol
B<ping> with I<protocol>. Valid protocols are C<icmp>, C<tcp>, or
C<udp> for pings. C<tcp> is unavailable on systems without I<alarm>
functionality. C<icmp> is the default.
=item -Q
Somewhat quiet output. Don't display ICMP error messages that
are in response to our query messages.
=item -q
Quick and very quiet like the default Solaris B<ping> response stating
up or down only.
print ReadKey(0) , "\n";
=item -s packetsize
Specifies the number of data bytes to be sent. The default is 64.
=item -w maxwait
Specifies the number of miliseconds to wait for a response to a packet
before transmitting the next one. The default is 10000 ms (ten seconds).
=back
=head2 ERRORS
I<unknown host>
The destination host's name cannot be resolved by name service into an
IP address.
I<destination host unreachable>
The local system does not have a route to the remote system or the
remote system did not respond. The remote host may be down. The
remote host may be incorrectly configured. A gateway or curcuit
between the local host and the remote host may be down. Test further.
=cut
die "Usage" unless $IpAddress; # syntax on no hostname
die "Usage" if ( # makes no sense to ping by name
$Option{'n'} # yet not allow an IP lookup
and $IpAddress =~ /[A-Za-z]/o
);
=pod
=head1 EXAMPLES
In the following example, B<ping> checks the network status of a
host. To check that www.yahoo.com can be reached from almond, we send
five 64-byte packets with the following command:
C:\> ping -c 5 www.perl.com
PING www.perl.com (208.201.239.50) from 192.168.2.101: 64 bytes of data.
64 bytes from 208.201.239.50: icmp_seq=0, time=100.00 ms
64 bytes from 208.201.239.50: icmp_seq=1, time=110.00 ms
64 bytes from 208.201.239.50: icmp_seq=2, time=100.00 ms
64 bytes from 208.201.239.50: icmp_seq=3, time=110.00 ms
64 bytes from 208.201.239.50: icmp_seq=4, time=101.00 ms
--- www.perl.com ping Statistics ---
5 packets transmitted, 5 packets received, 0% packet loss
round-trip (ms): min/avg/max = 100.00/104.20/110.00
The sequence in which the packets are arriving, as shown by the ICMP
sequence number (C<icmp_seq>) displayed for each packet will show
dropped packets if the numbering is out of sequence..
How long it takes a packet to make the round trip is displayed in
milliseconds after the string C<time=>. The lower the number the
better. Note that slow connections, like dialup or VPN, cause high
response numbers.
The percentage of packets lost is displayed in a summary line at the end
of the B<ping> output with the minimum, average, and maximum round-trip
times.
The following is an example of the quick ping:
C:\> ping www.perl.com -p
www.perl.com is alive.
This method simply checks if a host is up or not without the default
output's verbosity. This is similar to the default action of Solaris'
B<ping>.
=head1 ENVIRONMENT
The working of B<ping> is not influenced by any environment variables.
However, tcp pings cannot function on systems (like Win32) with no I<alarm>
function.
=cut
if ( # alarm() fails on some systems, so
$Option{'p'} # 0. See if -p was keyed at the shell
and $Option{'p'} eq "tcp" # 1. Did it have 'tcp' as an arg?
and ! eval { alarm 1 } # 2. eval 'alarm' for kosher-ness
) {
print $0 , " protocol " , $Option{'p'} , " is invalid on " , $^O;
print " due to a possibly unimplemented alarm() function\n";
die "Usage"; # die if we don't support 'alarm'
}
# --- Defaults ---
$Option{'c'} ||= "-1"; # ping continuously
$Option{'i'} ||= "1000"; # wait 1 second between pings
$Option{'s'} ||= "64"; # send 64 bytes per packet
$Option{'w'} ||= "10000"; # wait 10 seconds for a response
$Option{'p'} ||= "icmp"; # icmp for ping
$Statistics{'i'} = "0"; # stats in a global hash in case of
$Statistics{'loss'} = "0"; # a trapped SIGINT so PingStatistics()
$Statistics{'max'} = "0"; # can get at it without passing args
(
$HostName, # pass
$IpAddress, # and return real values
$LocalHost # for source and destination
) = ResolveName (
$IpAddress,
$LocalHost
)
unless $Option{'n'}; # unless we see '-n'
# setup the 'ping' with protocol,
# waittime (remember I work in ms
# tho Net::Ping takes seconds) divided
# by 1000, and packet size
my $Ping = Net::Ping->new (
$Option{'p'},
$Option{'w'} / 1000,
$Option{'s'}
)
# sometimes you must be root-like
or die "Cannot ping. Are you priviledged?\n";
$Statistics{'i'} = 0;
QuickPing()
if $Option{'q'}; # run this subroutine and die if '-q'
FullPing(); # otherwise do a full ping display
PingStatistics(); # and give us stats if we provide '-c';
sub FullPing {
my $sum = "0"; # tally times for stats
# print the header
print uc $0 , " " , $HostName , " (" , $IpAddress , ") from " , $LocalHost;
print ": ", $Option{'s'} , " bytes of data.\n";
# ping until we hit 'count'
until ( $Statistics{'i'} == $Option{'c'} ) {
# timestamp
my $time0 = [gettimeofday];
if ( $Ping->ping ( $IpAddress ) ) {
# math for round-trip
my $elapsed = tv_interval ( $time0 ) * 1000;
# print the packet's info
print "\a"
if $Option{'a'};
print $Option{'s'} , " bytes from $IpAddress: ";
print $Option{'p'} , "_seq=" , $Statistics{'i'} , ", time=";
printf "%.2f ms\n", $elapsed;
# if we returned slowest, save
$Statistics{'max'} = $elapsed
unless $elapsed < $Statistics{'max'};
# if we returned fastest, save
$Statistics{'min'} = $elapsed
if (
! $Statistics{'min'} # especially if this is the first
or $elapsed < $Statistics{'min'}
);
# tally times
$Statistics{'sum'} += $elapsed;
}
else {
$Statistics{'loss'}++; # if we don't return, tally that
# and print a message for comfort
print "\a"
if $Option{'A'};
print "From " , $LocalHost , ": destination host unreachable\n"
unless $Option{'Q'};
}
$Statistics{'i'}++;
sleep $Option{'i'} / 1000; # sleep before going again
}
$Ping->close(); # if we're done, close the ping
}
sub QuickPing { # is remote up or down only
print $HostName , " is alive.\n"
if $Ping->ping( $IpAddress )
or die $HostName , " is unreachable\n";
$Ping->close(); # if we're done, close the ping
exit 1;
}
sub PingStatistics {
# Solaris needed this to trap SIGINT
$SIG{INT} = \&PingStatistics
unless $^O =~ /MSWin/;
# math on %Statistics for display stats
my $received = $Statistics{'i'} - $Statistics{'loss'};
my $stat_loss = ( $Statistics{'loss'} / $Statistics{'i'} * 100 );
# print the top stat line
print "\n--- " , $HostName , " " , uc $0 , " Statistics ---\n";
print $Statistics{'i'} , " packets transmitted, " , $received;
print " packets received, " , $stat_loss , "\% packet loss\n";
exit
if $stat_loss == "100"; # if no packets made it forget the rest
$Statistics{'avg'} = $Statistics{'sum'} / $Statistics{'i'};
# print the bottom stat line
print "round-trip (ms): min/avg/max = ";
printf "%.2f/%.2f/%.2f\n",
$Statistics{'min'},
$Statistics{'avg'},
$Statistics{'max'};
die "Exited" # Solaris needs this too or will
unless $^O =~ /MSWin/;
exit;
} # ping without stopping
sub ResolveName {
require Socket; # require versus use in case '-n'
my (
$remote,
$local
) = @_; # gather
my (
$name,
$address,
$packed
);
# get our local IP
$local = Socket::inet_ntoa ( Socket::inet_aton ( $local ) );
# passed a hostname?
if ( $remote =~ /[A-Za-z]/o ) {
$name = $remote;
# get the remote IP, packed
$packed = Socket::inet_aton ( $name )
# can't with w/o IP, so die
or die "unknown host $name\n";
# unpack the IP into dotted quads
$address = Socket::inet_ntoa ( $packed )
# ditto
or die "unknown host $name\n";
}
# Dotted quads (most IP addresses)
# fails on IPs like 127.1 and 2130706433
elsif ( $remote =~ # sanity check the $remote IP address
m{ # this is so cool, I'm still disecting
^ ( \d | [01]?\d\d | 2[0-4]\d | 25[0-5] )
\. ( \d | [01]?\d\d | 2[0-4]\d | 25[0-5] )
\. ( \d | [01]?\d\d | 2[0-4]\d | 25[0-5] )
\. ( \d | [01]?\d\d | 2[0-4]\d | 25[0-5] )
$ # from the Perl Cookbook, Recipe 6.23,
}xo # pages 218-9, as fixed in the 01/00
) { # reprint
$address = $remote;
# get the remote IP, packed
$packed = Socket::inet_aton ( $address );
# unpack the hostname
$name = gethostbyaddr (
$packed,
Socket::AF_INET()
)
or $name = $address; # or else work with the IP address only
} # no sense in dying here
else { # die if $remote isn't a valid IP
die "$remote: invalid hostname or address\n";
}
return $name, $address, $local; # return
}
exit 1;
__END__
=pod
=head1 BUGS
B<ping> suffers from no known bugs at this time. But see the ENVIRONMENT
section for more detail.
Some environments (like Win32) cannot trap SIGINT (CTRL-C) to display
the summary lines on a break.
Believed to work on Windows NT, Windows 2K, Solaris, Linux, and NetBSD.
=head1 STANDARDS
I might be RFC compliant. I'm still reading the related RFCs for
icmp. ~yawn~
=head1 REVISION HISTORY
ping
Revision 1.0 2000/06/29 10:34:03 idnopheq
Initial revision
=head1 AUTHOR
The Perl implementation of B<ping> was written by Dexter Coffin,
I<idnopheq@home.com>.
=head1 COPYRIGHT and LICENSE
This program is copyright by Dexter Coffin 2000.
This program is free and open software. You may use, copy, modify, distribute,
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same.
=head1 SEE ALSO
=head1 NEXT TOPIC
=for html
<a href="os.html">ps</a><p>
=cut
</code>
<b>ping</b> -- send ICMP ECHO_REQUEST packets to network hosts
<p>
<b>ping</b> tests whether a remote host can be reached from your computer.
This simple function is extremely useful as the first step in testing
network connections, <b>ping</b> sends a packet to the destination host
with a timestamp. The destination host sends the packet back.
<B>ping</b> calculates the time difference and displays the data.
<p>
This test is independent of any application in which the original
problem may have been detected. <B>ping</b> allows you to determine whether further
testing should be directed toward the network connection or the
application. If <B>ping</b> shows that packets can travel to the remote
system and back, the isse may be application related. If packets can't
make the round trip, the network may be at fault. Test further.
<p>
Added actual ~pinging~ sound via the system bell, per the cononical naval usage of the term and the jargon file's entry (see the -a -A options).
<p>
<i>
The funniest use of `ping' to date was described in January 1991 by Steve Hayman on the Usenet group comp.sys.next. He was trying to isolate a faulty cable segment on a TCP/IP Ethernet hooked up to a NeXT machine, and got tired of having to run back to his console after each cabling tweak to see if the ping packets were getting through. So he used the sound-recording feature on the NeXT, then wrote a script that repeatedly invoked `ping(8)', listened for an echo, and played back the recording on each returned packet. Result? A program that caused the machine to repeat, over and over, "Ping ... ping ... ping ..." as long as the network was up. He turned the volume to maximum, ferreted through the building with one ear cocked, and found a faulty tee connector in no time.
</i>
<p>
Requires up-to-date Net::Ping and Time::HiRes. Many thanks to [id://19977]'s neat warn and die subs from the [http://language.perl.com/ppt] site!
<p>
Two items anyone can help with:
<br><ul>
<li>Sig{INT} control for Win32 - Term::ReadKey (which I could not get to work right for this one script)?<br>
<li>TTL on various systems, like Win32. I know the default from the RFC, but the reallity and how to automagically query?
</ul>
<p>
<b>UPDATE:</b> ACK! I posted an old version w/o the ping sound! Here it is.
<p>
<b>UPDATE 1</b>: submitted to PPT for inclusion
Utility Scripts
[id://63535]