3 # $Id: Ping.pm,v 1.13 2001/12/07 02:18:44 rob Exp $
9 use vars qw(@ISA @EXPORT $VERSION
10 $def_timeout $def_proto $max_datasize $pingstring);
12 use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
13 inet_aton sockaddr_in );
17 @EXPORT = qw(pingecho);
22 $def_timeout = 5; # Default timeout to wait for a reply
23 $def_proto = "udp"; # Default protocol to use for pinging
24 $max_datasize = 1024; # Maximum data bytes in a packet
25 # The data we exchange with the server for the stream protocol
26 $pingstring = "pingschwingping!\n";
28 # Description: The pingecho() subroutine is provided for backward
29 # compatibility with the original Net::Ping. It accepts a host
30 # name/IP and an optional timeout in seconds. Create a tcp ping
31 # object and try pinging the host. The result of the ping is returned.
35 my ($host, # Name or IP number of host to ping
36 $timeout # Optional timeout in seconds
38 my ($p); # A ping object
40 $p = Net::Ping->new("tcp", $timeout);
41 $p->ping($host); # Going out of scope closes the connection
44 # Description: The new() method creates a new ping object. Optional
45 # parameters may be specified for the protocol to use, the timeout in
46 # seconds and the size in bytes of additional data which should be
47 # included in the packet.
48 # After the optional parameters are checked, the data is constructed
49 # and a socket is opened if appropriate. The object is returned.
54 $proto, # Optional protocol to use for pinging
55 $timeout, # Optional timeout in seconds
56 $data_size # Optional additional bytes of data
58 my $class = ref($this) || $this;
60 my ($cnt, # Count through data bytes
61 $min_datasize # Minimum data bytes required
66 $proto = $def_proto unless $proto; # Determine the protocol
67 croak('Protocol for ping must be "icmp", "udp", "tcp", "stream", or "external"')
68 unless $proto =~ m/^(icmp|udp|tcp|stream|external)$/;
69 $self->{"proto"} = $proto;
71 $timeout = $def_timeout unless $timeout; # Determine the timeout
72 croak("Default timeout for ping must be greater than 0 seconds")
74 $self->{"timeout"} = $timeout;
76 $min_datasize = ($proto eq "udp") ? 1 : 0; # Determine data size
77 $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
78 croak("Data for ping must be from $min_datasize to $max_datasize bytes")
79 if ($data_size < $min_datasize) || ($data_size > $max_datasize);
80 $data_size-- if $self->{"proto"} eq "udp"; # We provide the first byte
81 $self->{"data_size"} = $data_size;
83 $self->{"data"} = ""; # Construct data bytes
84 for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
86 $self->{"data"} .= chr($cnt % 256);
89 $self->{"seq"} = 0; # For counting packets
90 if ($self->{"proto"} eq "udp") # Open a socket
92 $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
93 croak("Can't udp protocol by name");
94 $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
95 croak("Can't get udp echo port by name");
96 $self->{"fh"} = FileHandle->new();
97 socket($self->{"fh"}, &PF_INET(), &SOCK_DGRAM(),
98 $self->{"proto_num"}) ||
99 croak("udp socket error - $!");
101 elsif ($self->{"proto"} eq "icmp")
103 croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
104 $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
105 croak("Can't get icmp protocol by name");
106 $self->{"pid"} = $$ & 0xffff; # Save lower 16 bits of pid
107 $self->{"fh"} = FileHandle->new();
108 socket($self->{"fh"}, &PF_INET(), &SOCK_RAW(), $self->{"proto_num"}) ||
109 croak("icmp socket error - $!");
111 elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
113 $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
114 croak("Can't get tcp protocol by name");
115 $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
116 croak("Can't get tcp echo port by name");
117 $self->{"fh"} = FileHandle->new();
124 # Description: Ping a host name or IP number with an optional timeout.
125 # First lookup the host, and return undef if it is not found. Otherwise
126 # perform the specific ping method based on the protocol. Return the
127 # result of the ping.
132 $host, # Name or IP number of host to ping
133 $timeout # Seconds after which ping times out
135 my ($ip, # Packed IP number of $host
136 $ret # The return value
139 croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
140 $timeout = $self->{"timeout"} unless $timeout;
141 croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
143 $ip = inet_aton($host);
144 return(undef) unless defined($ip); # Does host exist?
146 # Dispatch to the appropriate routine.
147 return $self->ping_external($ip, $timeout) if $self->{"proto"} eq "external";
148 return $self->ping_udp($ip, $timeout) if $self->{"proto"} eq "udp";
149 return $self->ping_icmp($ip, $timeout) if $self->{"proto"} eq "icmp";
150 return $self->ping_tcp($ip, $timeout) if $self->{"proto"} eq "tcp";
151 return $self->ping_stream($ip, $timeout) if $self->{"proto"} eq "stream";
153 croak("Unknown protocol \"$self->{proto}\" in ping()");
156 # Uses Net::Ping::External to do an external ping.
159 $ip, # Packed IP number of the host
160 $timeout # Seconds after which ping times out
163 eval { require Net::Ping::External; }
164 or croak('Protocol "external" not supported on your system: Net::Ping::External not found');
165 return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
171 $ip, # Packed IP number of the host
172 $timeout # Seconds after which ping times out
175 my $ICMP_ECHOREPLY = 0; # ICMP packet types
177 my $icmp_struct = "C2 S3 A"; # Structure of a minimal ICMP packet
178 my $subcode = 0; # No ICMP subcode for ECHO and ECHOREPLY
179 my $flags = 0; # No special flags when opening a socket
180 my $port = 0; # No port with ICMP
182 my ($saddr, # sockaddr_in with port and ip
183 $checksum, # Checksum of ICMP packet
184 $msg, # ICMP packet to send
185 $len_msg, # Length of $msg
186 $rbits, # Read bits, filehandles for reading
187 $nfound, # Number of ready filehandles found
188 $finish_time, # Time ping should be finished
189 $done, # set to 1 when we are done
191 $recv_msg, # Received message including IP header
192 $from_saddr, # sockaddr_in of sender
193 $from_port, # Port packet was sent from
194 $from_ip, # Packed IP of sender
195 $from_type, # ICMP type
196 $from_subcode, # ICMP subcode
197 $from_chk, # ICMP packet checksum
198 $from_pid, # ICMP packet id
199 $from_seq, # ICMP packet sequence
200 $from_msg # ICMP message
203 $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
204 $checksum = 0; # No checksum for starters
205 $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
206 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
207 $checksum = Net::Ping->checksum($msg);
208 $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
209 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
210 $len_msg = length($msg);
211 $saddr = sockaddr_in($port, $ip);
212 send($self->{"fh"}, $msg, $flags, $saddr); # Send the message
215 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
218 $finish_time = time() + $timeout; # Must be done by this time
219 while (!$done && $timeout > 0) # Keep trying if we have time
221 $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
222 $timeout = $finish_time - time(); # Get remaining time
223 if (!defined($nfound)) # Hmm, a strange error
228 elsif ($nfound) # Got a packet from somewhere
231 $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, $flags);
232 ($from_port, $from_ip) = sockaddr_in($from_saddr);
233 ($from_type, $from_subcode, $from_chk,
234 $from_pid, $from_seq, $from_msg) =
235 unpack($icmp_struct . $self->{"data_size"},
236 substr($recv_msg, length($recv_msg) - $len_msg,
238 if (($from_type == $ICMP_ECHOREPLY) &&
240 ($from_pid == $self->{"pid"}) && # Does the packet check out?
241 ($from_seq == $self->{"seq"}))
243 $ret = 1; # It's a winner
247 else # Oops, timed out
255 # Description: Do a checksum on the message. Basically sum all of
256 # the short words and fold the high order bits into the low order bits.
261 $msg # The message to checksum
263 my ($len_msg, # Length of the message
264 $num_short, # The number of short words in the message
265 $short, # One short word
269 $len_msg = length($msg);
270 $num_short = int($len_msg / 2);
272 foreach $short (unpack("S$num_short", $msg))
275 } # Add the odd byte in
276 $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
277 $chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low
278 return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement
282 # Description: Perform a tcp echo ping. Since a tcp connection is
283 # host specific, we have to open and close each connection here. We
284 # can't just leave a socket open. Because of the robust nature of
285 # tcp, it will take a while before it gives up trying to establish a
286 # connection. Therefore, we use select() on a non-blocking socket to
287 # check against our timeout. No data bytes are actually
288 # sent since the successful establishment of a connection is proof
289 # enough of the reachability of the remote host. Also, tcp is
290 # expensive and doesn't need our help to add to the overhead.
295 $ip, # Packed IP number of the host
296 $timeout # Seconds after which ping times out
298 my ($ret # The return value
302 $ret = $self -> tcp_connect( $ip, $timeout);
303 $ret = 1 if $@ =~ /(Connection Refused|Unknown Error)/i;
304 $self->{"fh"}->close();
311 $ip, # Packed IP number of the host
312 $timeout # Seconds after which connect times out
314 my ($saddr); # Packed IP and Port
316 $saddr = sockaddr_in($self->{"port_num"}, $ip);
318 my $ret = 0; # Default to unreachable
320 my $do_socket = sub {
321 socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
322 croak("tcp socket error - $!");
324 my $do_connect = sub {
326 die $! unless connect($self->{"fh"}, $saddr);
333 if ($^O =~ /Win32/i) {
335 # Buggy Winsock API doesn't allow us to use alarm() calls.
336 # Hence, if our OS is Windows, we need to create a separate
337 # process to do the blocking connect attempt.
339 $| = 1; # Clear buffer prior to fork to prevent duplicate flushing.
344 warn "Win32 Fork error: $!";
349 # Try a slow blocking connect() call
350 # and report the status to the pipe.
351 if ( &{ $do_connect }() ) {
352 $self->{"fh"}->close();
356 # Pass the error status to the parent
363 my $patience = time + $timeout;
368 # Wait up to the timeout
369 # And clean off the zombie
371 $child = waitpid($pid, &POSIX::WNOHANG);
374 select(undef, undef, undef, 0.1);
375 } while time < $patience && $child != $pid;
377 if ($child == $pid) {
378 # Since she finished within the timeout,
379 # it is probably safe for me to try it too
382 # Time must have run out.
384 # Put that choking client out of its misery
386 # Clean off the zombie
391 # Otherwise don't waste the resources to fork
395 $SIG{'ALRM'} = sub { die "Timed out!"; };
396 alarm($timeout); # Interrupt connect() if we have to
405 # This writes the given string to the socket and then reads it
406 # back. It returns 1 on success, 0 on failure.
411 my $pingstring = shift;
415 my $wrstr = $pingstring;
421 vec($rin, $self->{"fh"}->fileno(), 1) = 1;
426 vec($rout, $self->{"fh"}->fileno(), 1) = 1;
429 if(select($rin, $rout, undef, ($time + $timeout) - time())) {
431 if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
432 my $num = syswrite($self->{"fh"}, $wrstr);
434 # If it was a partial write, update and try again.
435 $wrstr = substr($wrstr,$num);
437 # There was an error.
442 if(vec($rin,$self->{"fh"}->fileno(),1)) {
444 if(sysread($self->{"fh"},$reply,length($pingstring)-length($rdstr))) {
446 $ret = 1 if $rdstr eq $pingstring;
448 # There was an error.
454 } until time() > ($time + $timeout) || defined($ret);
463 # Description: Perform a stream ping. If the tcp connection isn't
464 # already open, it opens it. It then sends some data and waits for
465 # a reply. It leaves the stream open on exit.
470 $ip, # Packed IP number of the host
471 $timeout # Seconds after which ping times out
474 # Open the stream if it's not already open
475 if(!defined $self->{"fh"}->fileno()) {
476 $self->tcp_connect($ip, $timeout) or return 0;
479 croak "tried to switch servers while stream pinging"
480 if $self->{"ip"} ne $ip;
482 return $self->tcp_echo($timeout, $pingstring);
485 # Description: opens the stream. You would do this if you want to
486 # separate the overhead of opening the stream from the first ping.
491 $host, # Host or IP address
492 $timeout # Seconds after which open times out
495 my ($ip); # Packed IP number of the host
496 $ip = inet_aton($host);
497 $timeout = $self->{"timeout"} unless $timeout;
499 if($self->{"proto"} eq "stream") {
500 if(defined($self->{"fh"}->fileno())) {
501 croak("socket is already open");
503 $self->tcp_connect($ip, $timeout);
509 # Description: Perform a udp echo ping. Construct a message of
510 # at least the one-byte sequence number and any additional data bytes.
511 # Send the message out and wait for a message to come back. If we
512 # get a message, make sure all of its parts match. If they do, we are
513 # done. Otherwise go back and wait for the message until we run out
514 # of time. Return the result of our efforts.
519 $ip, # Packed IP number of the host
520 $timeout # Seconds after which ping times out
523 my $flags = 0; # Nothing special on open
525 my ($saddr, # sockaddr_in with port and ip
526 $ret, # The return value
527 $msg, # Message to be echoed
528 $finish_time, # Time ping should be finished
529 $done, # Set to 1 when we are done pinging
530 $rbits, # Read bits, filehandles for reading
531 $nfound, # Number of ready filehandles found
532 $from_saddr, # sockaddr_in of sender
533 $from_msg, # Characters echoed by $host
534 $from_port, # Port message was echoed from
535 $from_ip # Packed IP number of sender
538 $saddr = sockaddr_in($self->{"port_num"}, $ip);
539 $self->{"seq"} = ($self->{"seq"} + 1) % 256; # Increment sequence
540 $msg = chr($self->{"seq"}) . $self->{"data"}; # Add data if any
541 send($self->{"fh"}, $msg, $flags, $saddr); # Send it
544 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
545 $ret = 0; # Default to unreachable
547 $finish_time = time() + $timeout; # Ping needs to be done by then
548 while (!$done && $timeout > 0)
550 $nfound = select($rbits, undef, undef, $timeout); # Wait for response
551 $timeout = $finish_time - time(); # Get remaining time
553 if (!defined($nfound)) # Hmm, a strange error
558 elsif ($nfound) # A packet is waiting
561 $from_saddr = recv($self->{"fh"}, $from_msg, 1500, $flags)
562 or last; # For example an unreachable host will make recv() fail.
563 ($from_port, $from_ip) = sockaddr_in($from_saddr);
564 if (($from_ip eq $ip) && # Does the packet check out?
565 ($from_port == $self->{"port_num"}) &&
568 $ret = 1; # It's a winner
572 else # Oops, timed out
580 # Description: Close the connection unless we are using the tcp
581 # protocol, since it will already be closed.
587 $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
596 Net::Ping - check a remote host for reachability
598 $Id: Ping.pm,v 1.13 2001/12/07 02:18:44 rob Exp $
604 $p = Net::Ping->new();
605 print "$host is alive.\n" if $p->ping($host);
608 $p = Net::Ping->new("icmp");
609 foreach $host (@host_array)
612 print "NOT " unless $p->ping($host, 2);
613 print "reachable.\n";
618 $p = Net::Ping->new("tcp", 2);
619 # Try connecting to the www port instead of the echo port
620 $p->{port_num} = getservbyname("http", "tcp");
621 while ($stop_time > time())
623 print "$host not reachable ", scalar(localtime()), "\n"
624 unless $p->ping($host);
629 # For backward compatibility
630 print "$host is alive.\n" if pingecho($host);
634 This module contains methods to test the reachability of remote
635 hosts on a network. A ping object is first created with optional
636 parameters, a variable number of hosts may be pinged multiple
637 times and then the connection is closed.
639 You may choose one of four different protocols to use for the
640 ping. The "udp" protocol is the default. Note that a live remote host
641 may still fail to be pingable by one or more of these protocols. For
642 example, www.microsoft.com is generally alive but not pingable.
644 With the "tcp" protocol the ping() method attempts to establish a
645 connection to the remote host's echo port. If the connection is
646 successfully established, the remote host is considered reachable. No
647 data is actually echoed. This protocol does not require any special
648 privileges but has higher overhead than the other two protocols.
650 Specifying the "udp" protocol causes the ping() method to send a udp
651 packet to the remote host's echo port. If the echoed packet is
652 received from the remote host and the received packet contains the
653 same data as the packet that was sent, the remote host is considered
654 reachable. This protocol does not require any special privileges.
655 It should be borne in mind that, for a udp ping, a host
656 will be reported as unreachable if it is not running the
657 appropriate echo service. For Unix-like systems see L<inetd(8)>
658 for more information.
660 If the "icmp" protocol is specified, the ping() method sends an icmp
661 echo message to the remote host, which is what the UNIX ping program
662 does. If the echoed message is received from the remote host and
663 the echoed information is correct, the remote host is considered
664 reachable. Specifying the "icmp" protocol requires that the program
665 be run as root or that the program be setuid to root.
667 If the "external" protocol is specified, the ping() method attempts to
668 use the C<Net::Ping::External> module to ping the remote host.
669 C<Net::Ping::External> interfaces with your system's default C<ping>
670 utility to perform the ping, and generally produces relatively
671 accurate results. If C<Net::Ping::External> if not installed on your
672 system, specifying the "external" protocol will result in an error.
678 =item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
680 Create a new ping object. All of the parameters are optional. $proto
681 specifies the protocol to use when doing a ping. The current choices
682 are "tcp", "udp" or "icmp". The default is "udp".
684 If a default timeout ($def_timeout) in seconds is provided, it is used
685 when a timeout is not given to the ping() method (below). The timeout
686 must be greater than 0 and the default, if not specified, is 5 seconds.
688 If the number of data bytes ($bytes) is given, that many data bytes
689 are included in the ping packet sent to the remote host. The number of
690 data bytes is ignored if the protocol is "tcp". The minimum (and
691 default) number of data bytes is 1 if the protocol is "udp" and 0
692 otherwise. The maximum number of data bytes that can be specified is
695 =item $p->ping($host [, $timeout]);
697 Ping the remote host and wait for a response. $host can be either the
698 hostname or the IP number of the remote host. The optional timeout
699 must be greater than 0 seconds and defaults to whatever was specified
700 when the ping object was created. If the hostname cannot be found or
701 there is a problem with the IP number, undef is returned. Otherwise,
702 1 is returned if the host is reachable and 0 if it is not. For all
703 practical purposes, undef and 0 and can be treated as the same case.
705 =item $p->open($host);
707 When you are using the stream protocol, this call pre-opens the
708 tcp socket. It's only necessary to do this if you want to
709 provide a different timeout when creating the connection, or
710 remove the overhead of establishing the connection from the
711 first ping. If you don't call C<open()>, the connection is
712 automatically opened the first time C<ping()> is called.
713 This call simply does nothing if you are using any protocol other
716 =item $p->open($host);
718 When you are using the stream protocol, this call pre-opens the
719 tcp socket. It's only necessary to do this if you want to
720 provide a different timeout when creating the connection, or
721 remove the overhead of establishing the connection from the
722 first ping. If you don't call C<open()>, the connection is
723 automatically opened the first time C<ping()> is called.
724 This call simply does nothing if you are using any protocol other
729 Close the network connection for this ping object. The network
730 connection is also closed by "undef $p". The network connection is
731 automatically closed if the ping object goes out of scope (e.g. $p is
732 local to a subroutine and you leave the subroutine).
734 =item pingecho($host [, $timeout]);
736 To provide backward compatibility with the previous version of
737 Net::Ping, a pingecho() subroutine is available with the same
738 functionality as before. pingecho() uses the tcp protocol. The
739 return values and parameters are the same as described for the ping()
740 method. This subroutine is obsolete and may be removed in a future
741 version of Net::Ping.
747 pingecho() or a ping object with the tcp protocol use alarm() to
748 implement the timeout. So, don't use alarm() in your program while
749 you are using pingecho() or a ping object with the tcp protocol. The
750 udp and icmp protocols do not use alarm() to implement the timeout.
754 There will be less network overhead (and some efficiency in your
755 program) if you specify either the udp or the icmp protocol. The tcp
756 protocol will generate 2.5 times or more traffic for each ping than
757 either udp or icmp. If many hosts are pinged frequently, you may wish
758 to implement a small wait (e.g. 25ms or more) between each ping to
759 avoid flooding your network with packets.
761 The icmp protocol requires that the program be run as root or that it
762 be setuid to root. The other protocols do not require special
763 privileges, but not all network devices implement tcp or udp echo.
765 Local hosts should normally respond to pings within milliseconds.
766 However, on a very congested network it may take up to 3 seconds or
767 longer to receive an echo packet from the remote host. If the timeout
768 is set too low under these conditions, it will appear that the remote
769 host is not reachable (which is almost the truth).
771 Reachability doesn't necessarily mean that the remote host is actually
772 functioning beyond its ability to echo packets. tcp is slightly better
773 at indicating the health of a system than icmp because it uses more
774 of the networking stack to respond.
776 Because of a lack of anything better, this module uses its own
777 routines to pack and unpack ICMP packets. It would be better for a
778 separate module to be written which understands all of the different
779 kinds of ICMP packets.
783 Current maintainer Net::Ping base code:
784 colinm@cpan.org (Colin McMillen)
787 bronson@trestle.com (Scott Bronson)
790 karrer@bernina.ethz.ch (Andreas Karrer)
791 pmarquess@bfsec.bt.co.uk (Paul Marquess)
793 Original Net::Ping author:
794 mose@ns.ccsn.edu (Russell Mosemann)
796 Compatibility porting:
797 bbb@cpan.org (Rob Brown)
801 Copyright (c) 2001, Colin McMillen. All rights reserved.
802 Copyright (c) 2001, Rob Brown. All rights reserved.
804 This program is free software; you may redistribute it and/or
805 modify it under the same terms as Perl itself.