3 # Current maintainer: colinm@cpan.org (Colin McMillen)
4 # stream protocol: bronson@trestle.com (Scott Bronson)
6 # Original author: mose@ccsn.edu (Russell Mosemann)
8 # Authors of the original pingecho():
9 # karrer@bernina.ethz.ch (Andreas Karrer)
10 # Paul.Marquess@btinternet.com (Paul Marquess)
12 # Copyright (c) 2001, Colin McMillen. All rights reserved. This
13 # program is free software; you may redistribute it and/or modify it
14 # under the same terms as Perl itself.
19 our(@ISA, @EXPORT, $VERSION, $def_timeout, $def_proto, $max_datasize);
21 use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
22 inet_aton inet_ntoa sockaddr_in );
26 @EXPORT = qw(pingecho);
31 $def_timeout = 5; # Default timeout to wait for a reply
32 $def_proto = "udp"; # Default protocol to use for pinging
33 $max_datasize = 1024; # Maximum data bytes in a packet
35 # Description: The pingecho() subroutine is provided for backward
36 # compatibility with the original Net::Ping. It accepts a host
37 # name/IP and an optional timeout in seconds. Create a tcp ping
38 # object and try pinging the host. The result of the ping is returned.
42 my ($host, # Name or IP number of host to ping
43 $timeout # Optional timeout in seconds
45 my ($p); # A ping object
47 $p = Net::Ping->new("tcp", $timeout);
48 $p->ping($host); # Going out of scope closes the connection
51 # Description: The new() method creates a new ping object. Optional
52 # parameters may be specified for the protocol to use, the timeout in
53 # seconds and the size in bytes of additional data which should be
54 # included in the packet.
55 # After the optional parameters are checked, the data is constructed
56 # and a socket is opened if appropriate. The object is returned.
61 $proto, # Optional protocol to use for pinging
62 $timeout, # Optional timeout in seconds
63 $data_size # Optional additional bytes of data
65 my $class = ref($this) || $this;
67 my ($cnt, # Count through data bytes
68 $min_datasize # Minimum data bytes required
73 $proto = $def_proto unless $proto; # Determine the protocol
74 croak('Protocol for ping must be "icmp", "udp", "tcp", "stream", or "external"')
75 unless $proto =~ m/^(icmp|udp|tcp|stream|external)$/;
76 $self->{"proto"} = $proto;
78 $timeout = $def_timeout unless $timeout; # Determine the timeout
79 croak("Default timeout for ping must be greater than 0 seconds")
81 $self->{"timeout"} = $timeout;
83 $min_datasize = ($proto eq "udp") ? 1 : 0; # Determine data size
84 $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
85 croak("Data for ping must be from $min_datasize to $max_datasize bytes")
86 if ($data_size < $min_datasize) || ($data_size > $max_datasize);
87 $data_size-- if $self->{"proto"} eq "udp"; # We provide the first byte
88 $self->{"data_size"} = $data_size;
90 $self->{"data"} = ""; # Construct data bytes
91 for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
93 $self->{"data"} .= chr($cnt % 256);
96 $self->{"seq"} = 0; # For counting packets
97 if ($self->{"proto"} eq "udp") # Open a socket
99 $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
100 croak("Can't udp protocol by name");
101 $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
102 croak("Can't get udp echo port by name");
103 $self->{"fh"} = FileHandle->new();
104 socket($self->{"fh"}, &PF_INET(), &SOCK_DGRAM(),
105 $self->{"proto_num"}) ||
106 croak("udp socket error - $!");
108 elsif ($self->{"proto"} eq "icmp")
110 croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
111 $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
112 croak("Can't get icmp protocol by name");
113 $self->{"pid"} = $$ & 0xffff; # Save lower 16 bits of pid
114 $self->{"fh"} = FileHandle->new();
115 socket($self->{"fh"}, &PF_INET(), &SOCK_RAW(), $self->{"proto_num"}) ||
116 croak("icmp socket error - $!");
118 elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
120 $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
121 croak("Can't get tcp protocol by name");
122 $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
123 croak("Can't get tcp echo port by name");
124 $self->{"fh"} = FileHandle->new();
131 # Description: Ping a host name or IP number with an optional timeout.
132 # First lookup the host, and return undef if it is not found. Otherwise
133 # perform the specific ping method based on the protocol. Return the
134 # result of the ping.
139 $host, # Name or IP number of host to ping
140 $timeout # Seconds after which ping times out
142 my ($ip, # Packed IP number of $host
143 $ret # The return value
146 croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
147 $timeout = $self->{"timeout"} unless $timeout;
148 croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
150 $ip = inet_aton($host);
151 return(undef) unless defined($ip); # Does host exist?
153 # Dispatch to the appropriate routine.
154 return $self->ping_external($ip, $timeout) if $self->{"proto"} eq "external";
155 return $self->ping_udp($ip, $timeout) if $self->{"proto"} eq "udp";
156 return $self->ping_icmp($ip, $timeout) if $self->{"proto"} eq "icmp";
157 return $self->ping_tcp($ip, $timeout) if $self->{"proto"} eq "tcp";
158 return $self->ping_stream($ip, $timeout) if $self->{"proto"} eq "stream";
160 croak("Unknown protocol \"$self->{proto}\" in ping()");
163 # Uses Net::Ping::External to do an external ping.
166 $ip, # Packed IP number of the host
167 $timeout # Seconds after which ping times out
170 eval { require Net::Ping::External; };
171 croak('Protocol "external" not supported on your system: Net::Ping::External not found') if $@;
172 return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
178 $ip, # Packed IP number of the host
179 $timeout # Seconds after which ping times out
182 my $ICMP_ECHOREPLY = 0; # ICMP packet types
184 my $icmp_struct = "C2 S3 A"; # Structure of a minimal ICMP packet
185 my $subcode = 0; # No ICMP subcode for ECHO and ECHOREPLY
186 my $flags = 0; # No special flags when opening a socket
187 my $port = 0; # No port with ICMP
189 my ($saddr, # sockaddr_in with port and ip
190 $checksum, # Checksum of ICMP packet
191 $msg, # ICMP packet to send
192 $len_msg, # Length of $msg
193 $rbits, # Read bits, filehandles for reading
194 $nfound, # Number of ready filehandles found
195 $finish_time, # Time ping should be finished
196 $done, # set to 1 when we are done
198 $recv_msg, # Received message including IP header
199 $from_saddr, # sockaddr_in of sender
200 $from_port, # Port packet was sent from
201 $from_ip, # Packed IP of sender
202 $from_type, # ICMP type
203 $from_subcode, # ICMP subcode
204 $from_chk, # ICMP packet checksum
205 $from_pid, # ICMP packet id
206 $from_seq, # ICMP packet sequence
207 $from_msg # ICMP message
210 $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
211 $checksum = 0; # No checksum for starters
212 $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
213 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
214 $checksum = Net::Ping->checksum($msg);
215 $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
216 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
217 $len_msg = length($msg);
218 $saddr = sockaddr_in($port, $ip);
219 send($self->{"fh"}, $msg, $flags, $saddr); # Send the message
222 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
225 $finish_time = time() + $timeout; # Must be done by this time
226 while (!$done && $timeout > 0) # Keep trying if we have time
228 $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
229 $timeout = $finish_time - time(); # Get remaining time
230 if (!defined($nfound)) # Hmm, a strange error
235 elsif ($nfound) # Got a packet from somewhere
238 $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, $flags);
239 ($from_port, $from_ip) = sockaddr_in($from_saddr);
240 ($from_type, $from_subcode, $from_chk,
241 $from_pid, $from_seq, $from_msg) =
242 unpack($icmp_struct . $self->{"data_size"},
243 substr($recv_msg, length($recv_msg) - $len_msg,
245 if (($from_type == $ICMP_ECHOREPLY) &&
247 ($from_pid == $self->{"pid"}) && # Does the packet check out?
248 ($from_seq == $self->{"seq"}))
250 $ret = 1; # It's a winner
254 else # Oops, timed out
262 # Description: Do a checksum on the message. Basically sum all of
263 # the short words and fold the high order bits into the low order bits.
268 $msg # The message to checksum
270 my ($len_msg, # Length of the message
271 $num_short, # The number of short words in the message
272 $short, # One short word
276 $len_msg = length($msg);
277 $num_short = int($len_msg / 2);
279 foreach $short (unpack("S$num_short", $msg))
282 } # Add the odd byte in
283 $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
284 $chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low
285 return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement
288 # Warning: this method may generate false positives.
289 # It is meant to be a private method and should only
290 # be invoked by ping_tcp() if $^O =~ /win32/i.
295 $ip, # Packed IP number of the host
297 my ($saddr, # sockaddr_in with port and ip
298 $ret # The return value
301 socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
302 croak("tcp socket error - $!");
304 $saddr = sockaddr_in($self->{"port_num"}, $ip);
306 $ret = 0; # Default to unreachable
308 eval { $ret = connect($self->{"fh"}, $saddr) };
310 # If the remote host exists but returns "Connection refused",
311 # the call to connect() sets $! to "Unknown error". So, we
312 # assume that an "Unknown error" actually means the host is
313 # alive. This assumption may occassionally give false positives.
314 $ret = 1 if $! =~ /Unknown error/i;
316 $self->{"fh"}->close();
320 # Buggy Winsock API doesn't allow us to use non-blocking connect()
321 # calls. Hence, if our OS is Windows, we need to create a new process
322 # to run a blocking connect attempt, and kill it after the timeout has
323 # passed. Unfortunately, this won't work with the stream protocol.
328 $ip, # Packed IP number of the host
329 $timeout # Seconds after which open times out
332 socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
333 croak("tcp socket error - $!");
335 my $saddr = sockaddr_in($self->{"port_num"}, $ip);
337 my ($child, $ret, $pid, $time);
338 my $host = inet_ntoa($ip);
340 # The code we will be executing in our new process.
341 my $code = '"use Net::Ping; $p = Net::Ping->new(\'tcp\'); ';
342 $code .= 'exit($p->_ping_tcp_win(' . $host . '))"';
345 $pid = system(1, "perl", "-e", $code);
347 # Import the POSIX version of <sys/wait.h>
349 import POSIX qw(:sys_wait_h);
351 # Get the current time; will be used to tell if we've timed out.
354 # Wait for the child to return or for the timeout to expire.
356 $child = waitpid($pid, &WNOHANG);
358 } until time > ($time + $timeout) or $child;
360 # Return an appropriate value; 0 if the child didn't return,
361 # the return value of the child otherwise.
362 return $ret >> 8 if $child;
368 # This writes the given string to the socket and then reads it
369 # back. It returns 1 on success, 0 on failure.
374 my $pingstring = shift;
378 my $wrstr = $pingstring;
384 vec($rin, $self->{"fh"}->fileno(), 1) = 1;
389 vec($rout, $self->{"fh"}->fileno(), 1) = 1;
392 if(select($rin, $rout, undef, ($time + $timeout) - time())) {
394 if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
395 my $num = syswrite($self->{"fh"}, $wrstr);
397 # If it was a partial write, update and try again.
398 $wrstr = substr($wrstr,$num);
400 # There was an error.
405 if(vec($rin,$self->{"fh"}->fileno(),1)) {
407 if(sysread($self->{"fh"},$reply,length($pingstring)-length($rdstr))) {
409 $ret = 1 if $rdstr eq $pingstring;
411 # There was an error.
417 } until time() > ($time + $timeout) || defined($ret);
426 $ip, # Packed IP number of the host
427 $timeout # Seconds after which open times out
430 # Should we go back to using blocking IO and alarms to implement
431 # the stream protocol on win32?
432 croak "no nonblocking io -- can't stream ping on win32"
433 if ($^O =~ /win32/i);
437 socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
438 croak("tcp socket error - $!");
440 my $saddr = sockaddr_in($self->{"port_num"}, $ip);
443 # Try a non-blocking TCP connect to the remote echo port.
444 # Our call to select() below will stop after the timeout has
445 # passed or set the return value to true if the connection
447 $self->{"fh"}->blocking(0);
448 connect($self->{"fh"}, $saddr);
450 # This replaces the breakage where we were listening on a
451 # socket that would never produce any data. This works, but
452 # it's now quite a bit heavier than the old Net::Ping. I'd
453 # like to see it reverted.
454 return $self->tcp_echo($timeout, "ping!\n");
457 # Description: Perform a tcp echo ping. Since a tcp connection is
458 # host specific, we have to open and close each connection here. We
459 # can't just leave a socket open. Because of the robust nature of
460 # tcp, it will take a while before it gives up trying to establish a
461 # connection. Therefore, we use select() on a non-blocking socket to
462 # check against our timeout. No data bytes are actually
463 # sent since the successful establishment of a connection is proof
464 # enough of the reachability of the remote host. Also, tcp is
465 # expensive and doesn't need our help to add to the overhead.
470 $ip, # Packed IP number of the host
471 $timeout # Seconds after which ping times out
476 # tcp_connect won't work on win32, so special-case it if need be.
477 if ($^O =~ /win32/i) {
478 $ret = $self->ping_tcp_win32($ip, $timeout);
480 $ret = $self->tcp_connect($ip, $timeout);
481 $self->{"fh"}->close();
487 # Description: Perform a stream ping. If the tcp connection isn't
488 # already open, it opens it. It then sends some data and waits for
489 # a reply. It leaves the stream open on exit.
494 $ip, # Packed IP number of the host
495 $timeout # Seconds after which ping times out
498 my $pingstring = "ping!\n"; # The data we exchange with the server
500 # Open the stream if it's not already open
501 if(!defined $self->{"fh"}->fileno()) {
502 $self->tcp_connect($ip, $timeout) or return 0;
505 croak "tried to switch servers while stream pinging"
506 if $self->{"ip"} ne $ip;
508 return $self->tcp_echo($timeout, "pingschwingping!\n");
511 # Description: opens the stream. You would do this if you want to
512 # separate the overhead of opening the stream from the first ping.
517 $ip, # Packed IP number of the host
518 $timeout # Seconds after which open times out
521 $timeout = $self->{"timeout"} unless $timeout;
523 if($self->{"proto"} eq "stream") {
524 if(defined($self->{"fh"}->fileno())) {
525 croak("socket is already open");
527 $self->tcp_connect($ip, $timeout);
532 # Description: Perform a udp echo ping. Construct a message of
533 # at least the one-byte sequence number and any additional data bytes.
534 # Send the message out and wait for a message to come back. If we
535 # get a message, make sure all of its parts match. If they do, we are
536 # done. Otherwise go back and wait for the message until we run out
537 # of time. Return the result of our efforts.
542 $ip, # Packed IP number of the host
543 $timeout # Seconds after which ping times out
546 my $flags = 0; # Nothing special on open
548 my ($saddr, # sockaddr_in with port and ip
549 $ret, # The return value
550 $msg, # Message to be echoed
551 $finish_time, # Time ping should be finished
552 $done, # Set to 1 when we are done pinging
553 $rbits, # Read bits, filehandles for reading
554 $nfound, # Number of ready filehandles found
555 $from_saddr, # sockaddr_in of sender
556 $from_msg, # Characters echoed by $host
557 $from_port, # Port message was echoed from
558 $from_ip # Packed IP number of sender
561 $saddr = sockaddr_in($self->{"port_num"}, $ip);
562 $self->{"seq"} = ($self->{"seq"} + 1) % 256; # Increment sequence
563 $msg = chr($self->{"seq"}) . $self->{"data"}; # Add data if any
564 send($self->{"fh"}, $msg, $flags, $saddr); # Send it
567 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
568 $ret = 0; # Default to unreachable
570 $finish_time = time() + $timeout; # Ping needs to be done by then
571 while (!$done && $timeout > 0)
573 $nfound = select($rbits, undef, undef, $timeout); # Wait for response
574 $timeout = $finish_time - time(); # Get remaining time
576 if (!defined($nfound)) # Hmm, a strange error
581 elsif ($nfound) # A packet is waiting
584 $from_saddr = recv($self->{"fh"}, $from_msg, 1500, $flags)
585 or last; # For example an unreachable host will make recv() fail.
586 ($from_port, $from_ip) = sockaddr_in($from_saddr);
587 if (($from_ip eq $ip) && # Does the packet check out?
588 ($from_port == $self->{"port_num"}) &&
591 $ret = 1; # It's a winner
595 else # Oops, timed out
603 # Description: Close the connection unless we are using the tcp
604 # protocol, since it will already be closed.
610 $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
619 Net::Ping - check a remote host for reachability
625 $p = Net::Ping->new();
626 print "$host is alive.\n" if $p->ping($host);
629 $p = Net::Ping->new("icmp");
630 foreach $host (@host_array)
633 print "NOT " unless $p->ping($host, 2);
634 print "reachable.\n";
639 $p = Net::Ping->new("tcp", 2);
640 while ($stop_time > time())
642 print "$host not reachable ", scalar(localtime()), "\n"
643 unless $p->ping($host);
648 # For backward compatibility
649 print "$host is alive.\n" if pingecho($host);
653 This module contains methods to test the reachability of remote
654 hosts on a network. A ping object is first created with optional
655 parameters, a variable number of hosts may be pinged multiple
656 times and then the connection is closed.
658 Ping supports five ping protocols, each with its own strengths
659 and weaknesses. The "udp" protocol is the default. A host
660 may be configured to respond to only a few of these protocols,
661 or even none at all. For example, www.microsoft.com is generally
662 alive but not pingable.
668 The C<ping()> method sends an icmp echo message to the remote host
669 (this is what the UNIX ping program does).
670 If the echoed message is received from the remote host and
671 the echoed information is correct, the remote host is considered
672 reachable. Specifying this protocol requires that the program
673 be run as root or that the program be setuid to root.
677 The C<ping()> method sends a udp
678 packet to the remote host's echo port. If the echoed packet is
679 received from the remote host and the received packet contains the
680 same data as the packet that was sent, the remote host is considered
681 reachable. This protocol does not require any special privileges.
683 It should be borne in mind that, for both udp and tcp ping, a host
684 will be reported as unreachable if it is not running the
685 appropriate echo service. For Unix-like systems see L<inetd(8)> for
690 The C<ping()> method attempts to establish a
691 connection to the remote host's echo port. If the connection is
692 successfully established, the remote host is considered reachable.
693 Once the connection is made, it is torn down immediately -- no data
694 is actually echoed. This protocol does not require any special
695 privileges but has highest overhead of the protocols.
699 This is just like the tcp protocol, except that once it establishes
700 the tcp connection, it keeps it up. Each subsequent ping
701 request re-uses the existing connection. stream
702 provides better performance than tcp since the connection
703 doesn't need to be created and torn down with every ping. It is
704 also the only protocol that will recognize that the original host is
705 gone, even if it is immediately replaced by an
706 identical host responding in exactly the same way. The drawback
707 is that you can only ping one host per Ping instance. You will get
708 an error if you neglect to call C<close()> before trying to ping
709 a different network device.
713 The ping() method attempts to use the C<Net::Ping::External> module to ping
714 the remote host. C<Net::Ping::External> interfaces with your system's default
715 L<ping(8)> utility to perform the ping, and generally produces relatively
716 accurate results. If C<Net::Ping::External> if not installed on your
717 system, specifying the "external" protocol will result in an error.
723 =item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
725 Create a new ping object. All of the parameters are optional. $proto
726 specifies the protocol to use when doing a ping. The current choices
727 are "tcp", "udp" or "icmp". The default is "udp".
729 If a default timeout ($def_timeout) in seconds is provided, it is used
730 when a timeout is not given to the ping() method (below). The timeout
731 must be greater than 0 and the default, if not specified, is 5 seconds.
733 If the number of data bytes ($bytes) is given, that many data bytes
734 are included in the ping packet sent to the remote host. The number of
735 data bytes is ignored if the protocol is "tcp". The minimum (and
736 default) number of data bytes is 1 if the protocol is "udp" and 0
737 otherwise. The maximum number of data bytes that can be specified is
740 =item $p->ping($host [, $timeout]);
742 Ping the remote host and wait for a response. $host can be either the
743 hostname or the IP number of the remote host. The optional timeout
744 must be greater than 0 seconds and defaults to whatever was specified
745 when the ping object was created. If the hostname cannot be found or
746 there is a problem with the IP number, undef is returned. Otherwise,
747 1 is returned if the host is reachable and 0 if it is not. For all
748 practical purposes, undef and 0 and can be treated as the same case.
750 =item $p->open($host);
752 When you are using the stream protocol, this call pre-opens the
753 tcp socket. It's only necessary to do this if you want to
754 provide a different timeout when creating the connection, or
755 remove the overhead of establishing the connection from the
756 first ping. If you don't call C<open()>, the connection is
757 automatically openeed the first time C<ping()> is called.
758 This call simply does nothing if you are using any protocol other
763 Close the network connection for this ping object. The network
764 connection is also closed by "undef $p". The network connection is
765 automatically closed if the ping object goes out of scope (e.g. $p is
766 local to a subroutine and you leave the subroutine).
768 =item pingecho($host [, $timeout]);
770 To provide backward compatibility with the previous version of
771 Net::Ping, a pingecho() subroutine is available with the same
772 functionality as before. pingecho() uses the tcp protocol. The
773 return values and parameters are the same as described for the ping()
774 method. This subroutine is obsolete and may be removed in a future
775 version of Net::Ping.
781 There will be less network overhead (and some efficiency in your
782 program) if you specify either the udp or the icmp protocol. The tcp
783 protocol will generate 2.5 times or more traffic for each ping than
784 either udp or icmp. If many hosts are pinged frequently, you may wish
785 to implement a small wait (e.g. 25ms or more) between each ping to
786 avoid flooding your network with packets.
788 The icmp protocol requires that the program be run as root or that it
789 be setuid to root. The other protocols do not require special
790 privileges, but not all network devices implement tcp or udp echo.
792 Local hosts should normally respond to pings within milliseconds.
793 However, on a very congested network it may take up to 3 seconds or
794 longer to receive an echo packet from the remote host. If the timeout
795 is set too low under these conditions, it will appear that the remote
796 host is not reachable (which is almost the truth).
798 Reachability doesn't necessarily mean that the remote host is actually
799 functioning beyond its ability to echo packets. tcp is slightly better
800 at indicating the health of a system than icmp because it uses more
801 of the networking stack to respond.
803 Because of a lack of anything better, this module uses its own
804 routines to pack and unpack ICMP packets. It would be better for a
805 separate module to be written which understands all of the different
806 kinds of ICMP packets.