3 # Current maintainer: colinm@cpan.org (Colin McMillen)
5 # Original author: mose@ccsn.edu (Russell Mosemann)
7 # Authors of the original pingecho():
8 # karrer@bernina.ethz.ch (Andreas Karrer)
9 # Paul.Marquess@btinternet.com (Paul Marquess)
11 # Copyright (c) 2001, Colin McMillen. All rights reserved. This
12 # program is free software; you may redistribute it and/or modify it
13 # under the same terms as Perl itself.
18 our(@ISA, @EXPORT, $VERSION, $def_timeout, $def_proto, $max_datasize);
20 use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
21 inet_aton inet_ntoa sockaddr_in );
25 @EXPORT = qw(pingecho);
30 $def_timeout = 5; # Default timeout to wait for a reply
31 $def_proto = "udp"; # Default protocol to use for pinging
32 $max_datasize = 1024; # Maximum data bytes in a packet
34 # Description: The pingecho() subroutine is provided for backward
35 # compatibility with the original Net::Ping. It accepts a host
36 # name/IP and an optional timeout in seconds. Create a tcp ping
37 # object and try pinging the host. The result of the ping is returned.
41 my ($host, # Name or IP number of host to ping
42 $timeout # Optional timeout in seconds
44 my ($p); # A ping object
46 $p = Net::Ping->new("tcp", $timeout);
47 $p->ping($host); # Going out of scope closes the connection
50 # Description: The new() method creates a new ping object. Optional
51 # parameters may be specified for the protocol to use, the timeout in
52 # seconds and the size in bytes of additional data which should be
53 # included in the packet.
54 # After the optional parameters are checked, the data is constructed
55 # and a socket is opened if appropriate. The object is returned.
60 $proto, # Optional protocol to use for pinging
61 $timeout, # Optional timeout in seconds
62 $data_size # Optional additional bytes of data
64 my $class = ref($this) || $this;
66 my ($cnt, # Count through data bytes
67 $min_datasize # Minimum data bytes required
72 $proto = $def_proto unless $proto; # Determine the protocol
73 croak('Protocol for ping must be "icmp", "tcp", "udp", or "external"')
74 unless $proto =~ m/^(tcp|udp|icmp|external)$/;
75 $self->{"proto"} = $proto;
77 $timeout = $def_timeout unless $timeout; # Determine the timeout
78 croak("Default timeout for ping must be greater than 0 seconds")
80 $self->{"timeout"} = $timeout;
82 $min_datasize = ($proto eq "udp") ? 1 : 0; # Determine data size
83 $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
84 croak("Data for ping must be from $min_datasize to $max_datasize bytes")
85 if ($data_size < $min_datasize) || ($data_size > $max_datasize);
86 $data_size-- if $self->{"proto"} eq "udp"; # We provide the first byte
87 $self->{"data_size"} = $data_size;
89 $self->{"data"} = ""; # Construct data bytes
90 for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
92 $self->{"data"} .= chr($cnt % 256);
95 $self->{"seq"} = 0; # For counting packets
96 if ($self->{"proto"} eq "udp") # Open a socket
98 $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
99 croak("Can't udp protocol by name");
100 $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
101 croak("Can't get udp echo port by name");
102 $self->{"fh"} = FileHandle->new();
103 socket($self->{"fh"}, &PF_INET(), &SOCK_DGRAM(),
104 $self->{"proto_num"}) ||
105 croak("udp socket error - $!");
107 elsif ($self->{"proto"} eq "icmp")
109 croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
110 $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
111 croak("Can't get icmp protocol by name");
112 $self->{"pid"} = $$ & 0xffff; # Save lower 16 bits of pid
113 $self->{"fh"} = FileHandle->new();
114 socket($self->{"fh"}, &PF_INET(), &SOCK_RAW(), $self->{"proto_num"}) ||
115 croak("icmp socket error - $!");
117 elsif ($self->{"proto"} eq "tcp") # Just a file handle for now
119 $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
120 croak("Can't get tcp protocol by name");
121 $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
122 croak("Can't get tcp echo port by name");
123 $self->{"fh"} = FileHandle->new();
130 # Description: Ping a host name or IP number with an optional timeout.
131 # First lookup the host, and return undef if it is not found. Otherwise
132 # perform the specific ping method based on the protocol. Return the
133 # result of the ping.
138 $host, # Name or IP number of host to ping
139 $timeout # Seconds after which ping times out
141 my ($ip, # Packed IP number of $host
142 $ret # The return value
145 croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
146 $timeout = $self->{"timeout"} unless $timeout;
147 croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
149 $ip = inet_aton($host);
150 return(undef) unless defined($ip); # Does host exist?
152 # Dispatch to the appropriate routine.
153 return $self->ping_external($ip, $timeout) if $self->{"proto"} eq "external";
154 return $self->ping_udp($ip, $timeout) if $self->{"proto"} eq "udp";
155 return $self->ping_icmp($ip, $timeout) if $self->{"proto"} eq "icmp";
156 return $self->ping_tcp($ip, $timeout) if $self->{"proto"} eq "tcp";
158 croak("Unknown protocol \"$self->{proto}\" in ping()");
161 # Uses Net::Ping::External to do an external ping.
164 $ip, # Packed IP number of the host
165 $timeout # Seconds after which ping times out
168 eval { require Net::Ping::External; };
169 croak('Protocol "external" not supported on your system: Net::Ping::External not found') if $@;
170 return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
176 $ip, # Packed IP number of the host
177 $timeout # Seconds after which ping times out
180 my $ICMP_ECHOREPLY = 0; # ICMP packet types
182 my $icmp_struct = "C2 S3 A"; # Structure of a minimal ICMP packet
183 my $subcode = 0; # No ICMP subcode for ECHO and ECHOREPLY
184 my $flags = 0; # No special flags when opening a socket
185 my $port = 0; # No port with ICMP
187 my ($saddr, # sockaddr_in with port and ip
188 $checksum, # Checksum of ICMP packet
189 $msg, # ICMP packet to send
190 $len_msg, # Length of $msg
191 $rbits, # Read bits, filehandles for reading
192 $nfound, # Number of ready filehandles found
193 $finish_time, # Time ping should be finished
194 $done, # set to 1 when we are done
196 $recv_msg, # Received message including IP header
197 $from_saddr, # sockaddr_in of sender
198 $from_port, # Port packet was sent from
199 $from_ip, # Packed IP of sender
200 $from_type, # ICMP type
201 $from_subcode, # ICMP subcode
202 $from_chk, # ICMP packet checksum
203 $from_pid, # ICMP packet id
204 $from_seq, # ICMP packet sequence
205 $from_msg # ICMP message
208 $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
209 $checksum = 0; # No checksum for starters
210 $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
211 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
212 $checksum = Net::Ping->checksum($msg);
213 $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
214 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
215 $len_msg = length($msg);
216 $saddr = sockaddr_in($port, $ip);
217 send($self->{"fh"}, $msg, $flags, $saddr); # Send the message
220 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
223 $finish_time = time() + $timeout; # Must be done by this time
224 while (!$done && $timeout > 0) # Keep trying if we have time
226 $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
227 $timeout = $finish_time - time(); # Get remaining time
228 if (!defined($nfound)) # Hmm, a strange error
233 elsif ($nfound) # Got a packet from somewhere
236 $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, $flags);
237 ($from_port, $from_ip) = sockaddr_in($from_saddr);
238 ($from_type, $from_subcode, $from_chk,
239 $from_pid, $from_seq, $from_msg) =
240 unpack($icmp_struct . $self->{"data_size"},
241 substr($recv_msg, length($recv_msg) - $len_msg,
243 if (($from_type == $ICMP_ECHOREPLY) &&
245 ($from_pid == $self->{"pid"}) && # Does the packet check out?
246 ($from_seq == $self->{"seq"}))
248 $ret = 1; # It's a winner
252 else # Oops, timed out
260 # Description: Do a checksum on the message. Basically sum all of
261 # the short words and fold the high order bits into the low order bits.
266 $msg # The message to checksum
268 my ($len_msg, # Length of the message
269 $num_short, # The number of short words in the message
270 $short, # One short word
274 $len_msg = length($msg);
275 $num_short = int($len_msg / 2);
277 foreach $short (unpack("S$num_short", $msg))
280 } # Add the odd byte in
281 $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
282 $chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low
283 return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement
286 # Description: Perform a tcp echo ping. Since a tcp connection is
287 # host specific, we have to open and close each connection here. We
288 # can't just leave a socket open. Because of the robust nature of
289 # tcp, it will take a while before it gives up trying to establish a
290 # connection. Therefore, we use select() on a non-blocking socket to
291 # check against our timeout. No data bytes are actually
292 # sent since the successful establishment of a connection is proof
293 # enough of the reachability of the remote host. Also, tcp is
294 # expensive and doesn't need our help to add to the overhead.
299 $ip, # Packed IP number of the host
300 $timeout # Seconds after which ping times out
302 my ($saddr, # sockaddr_in with port and ip
303 $rin, # Used in select()
304 $ret # The return value
307 socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
308 croak("tcp socket error - $!");
310 $saddr = sockaddr_in($self->{"port_num"}, $ip);
312 $ret = 0; # Default to unreachable
314 # Buggy Winsock API doesn't allow us to use non-blocking connect()
315 # calls. Hence, if our OS is Windows, we need to create a new process
316 # to run a blocking connect attempt, and kill it after the timeout has
320 my ($child, $ret, $pid, $time);
321 my $host = inet_ntoa($ip);
323 # The code we will be executing in our new process.
324 my $code = '"use Net::Ping; $p = Net::Ping->new(\'tcp\'); ';
325 $code .= 'exit($p->_ping_tcp_win(' . $host . '))"';
328 $pid = system(1, "perl", "-e", $code);
330 # Import the POSIX version of <sys/wait.h>
332 import POSIX qw(:sys_wait_h);
334 # Get the current time; will be used to tell if we've timed out.
337 # Wait for the child to return or for the timeout to expire.
339 $child = waitpid($pid, &WNOHANG);
341 } until time > ($time + $timeout) or $child;
343 # Return an appropriate value; 0 if the child didn't return,
344 # the return value of the child otherwise.
345 return $ret >> 8 if $child;
351 # If our OS isn't Windows, do this stuff instead...
354 # Try a non-blocking TCP connect to the remote echo port.
355 # Our call to select() below will stop after the timeout has
356 # passed or set the return value to true if the connection
358 $self->{"fh"}->blocking(0);
359 connect($self->{"fh"}, $saddr);
362 vec($rin, fileno($self->{"fh"}), 1) = 1;
363 $ret = 1 if select($rin, undef, undef, $timeout);
365 # Close our filehandle, restore it to its default state (i.e. blocking),
366 # and return our result.
367 $self->{"fh"}->blocking(1);
368 $self->{"fh"}->close();
373 # Warning: this method may generate false positives.
374 # It is meant to be a private method and should only
375 # be invoked by ping_tcp() if $^O =~ /win32/i.
379 $ip, # Packed IP number of the host
381 my ($saddr, # sockaddr_in with port and ip
382 $ret # The return value
385 socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
386 croak("tcp socket error - $!");
388 $saddr = sockaddr_in($self->{"port_num"}, $ip);
390 $ret = 0; # Default to unreachable
392 eval { $ret = connect($self->{"fh"}, $saddr) };
394 # If the remote host exists but returns "Connection refused",
395 # the call to connect() sets $! to "Unknown error". So, we
396 # assume that an "Unknown error" actually means the host is
397 # alive. This assumption may occassionally give false positives.
398 $ret = 1 if $! =~ /Unknown error/i;
400 $self->{"fh"}->close();
404 # Description: Perform a udp echo ping. Construct a message of
405 # at least the one-byte sequence number and any additional data bytes.
406 # Send the message out and wait for a message to come back. If we
407 # get a message, make sure all of its parts match. If they do, we are
408 # done. Otherwise go back and wait for the message until we run out
409 # of time. Return the result of our efforts.
414 $ip, # Packed IP number of the host
415 $timeout # Seconds after which ping times out
418 my $flags = 0; # Nothing special on open
420 my ($saddr, # sockaddr_in with port and ip
421 $ret, # The return value
422 $msg, # Message to be echoed
423 $finish_time, # Time ping should be finished
424 $done, # Set to 1 when we are done pinging
425 $rbits, # Read bits, filehandles for reading
426 $nfound, # Number of ready filehandles found
427 $from_saddr, # sockaddr_in of sender
428 $from_msg, # Characters echoed by $host
429 $from_port, # Port message was echoed from
430 $from_ip # Packed IP number of sender
433 $saddr = sockaddr_in($self->{"port_num"}, $ip);
434 $self->{"seq"} = ($self->{"seq"} + 1) % 256; # Increment sequence
435 $msg = chr($self->{"seq"}) . $self->{"data"}; # Add data if any
436 send($self->{"fh"}, $msg, $flags, $saddr); # Send it
439 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
440 $ret = 0; # Default to unreachable
442 $finish_time = time() + $timeout; # Ping needs to be done by then
443 while (!$done && $timeout > 0)
445 $nfound = select($rbits, undef, undef, $timeout); # Wait for response
446 $timeout = $finish_time - time(); # Get remaining time
448 if (!defined($nfound)) # Hmm, a strange error
453 elsif ($nfound) # A packet is waiting
456 $from_saddr = recv($self->{"fh"}, $from_msg, 1500, $flags)
457 or last; # For example an unreachable host will make recv() fail.
458 ($from_port, $from_ip) = sockaddr_in($from_saddr);
459 if (($from_ip eq $ip) && # Does the packet check out?
460 ($from_port == $self->{"port_num"}) &&
463 $ret = 1; # It's a winner
467 else # Oops, timed out
475 # Description: Close the connection unless we are using the tcp
476 # protocol, since it will already be closed.
482 $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
491 Net::Ping - check a remote host for reachability
497 $p = Net::Ping->new();
498 print "$host is alive.\n" if $p->ping($host);
501 $p = Net::Ping->new("icmp");
502 foreach $host (@host_array)
505 print "NOT " unless $p->ping($host, 2);
506 print "reachable.\n";
511 $p = Net::Ping->new("tcp", 2);
512 while ($stop_time > time())
514 print "$host not reachable ", scalar(localtime()), "\n"
515 unless $p->ping($host);
520 # For backward compatibility
521 print "$host is alive.\n" if pingecho($host);
525 This module contains methods to test the reachability of remote
526 hosts on a network. A ping object is first created with optional
527 parameters, a variable number of hosts may be pinged multiple
528 times and then the connection is closed.
530 You may choose one of four different protocols to use for the
531 ping. The "udp" protocol is the default. Note that a live remote host
532 may still fail to be pingable by one or more of these protocols. For
533 example, www.microsoft.com is generally alive but not pingable.
535 With the "tcp" protocol the ping() method attempts to establish a
536 connection to the remote host's echo port. If the connection is
537 successfully established, the remote host is considered reachable. No
538 data is actually echoed. This protocol does not require any special
539 privileges but has higher overhead than the other two protocols.
541 Specifying the "udp" protocol causes the ping() method to send a udp
542 packet to the remote host's echo port. If the echoed packet is
543 received from the remote host and the received packet contains the
544 same data as the packet that was sent, the remote host is considered
545 reachable. This protocol does not require any special privileges.
547 It should be borne in mind that, for both udp ping, a host
548 will be reported as unreachable if it is not running the
549 appropriate echo service. For Unix-like systems see L<inetd(8)> for
552 If the "icmp" protocol is specified, the ping() method sends an icmp
553 echo message to the remote host, which is what the UNIX ping program
554 does. If the echoed message is received from the remote host and
555 the echoed information is correct, the remote host is considered
556 reachable. Specifying the "icmp" protocol requires that the program
557 be run as root or that the program be setuid to root.
559 If the "external" protocol is specified, the ping() method attempts to
560 use the C<Net::Ping::External> module to ping the remote host.
561 C<Net::Ping::External> interfaces with your system's default C<ping>
562 utility to perform the ping, and generally produces relatively
563 accurate results. If C<Net::Ping::External> if not installed on your
564 system, specifying the "external" protocol will result in an error.
570 =item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
572 Create a new ping object. All of the parameters are optional. $proto
573 specifies the protocol to use when doing a ping. The current choices
574 are "tcp", "udp" or "icmp". The default is "udp".
576 If a default timeout ($def_timeout) in seconds is provided, it is used
577 when a timeout is not given to the ping() method (below). The timeout
578 must be greater than 0 and the default, if not specified, is 5 seconds.
580 If the number of data bytes ($bytes) is given, that many data bytes
581 are included in the ping packet sent to the remote host. The number of
582 data bytes is ignored if the protocol is "tcp". The minimum (and
583 default) number of data bytes is 1 if the protocol is "udp" and 0
584 otherwise. The maximum number of data bytes that can be specified is
587 =item $p->ping($host [, $timeout]);
589 Ping the remote host and wait for a response. $host can be either the
590 hostname or the IP number of the remote host. The optional timeout
591 must be greater than 0 seconds and defaults to whatever was specified
592 when the ping object was created. If the hostname cannot be found or
593 there is a problem with the IP number, undef is returned. Otherwise,
594 1 is returned if the host is reachable and 0 if it is not. For all
595 practical purposes, undef and 0 and can be treated as the same case.
599 Close the network connection for this ping object. The network
600 connection is also closed by "undef $p". The network connection is
601 automatically closed if the ping object goes out of scope (e.g. $p is
602 local to a subroutine and you leave the subroutine).
604 =item pingecho($host [, $timeout]);
606 To provide backward compatibility with the previous version of
607 Net::Ping, a pingecho() subroutine is available with the same
608 functionality as before. pingecho() uses the tcp protocol. The
609 return values and parameters are the same as described for the ping()
610 method. This subroutine is obsolete and may be removed in a future
611 version of Net::Ping.
617 There will be less network overhead (and some efficiency in your
618 program) if you specify either the udp or the icmp protocol. The tcp
619 protocol will generate 2.5 times or more traffic for each ping than
620 either udp or icmp. If many hosts are pinged frequently, you may wish
621 to implement a small wait (e.g. 25ms or more) between each ping to
622 avoid flooding your network with packets.
624 The icmp protocol requires that the program be run as root or that it
625 be setuid to root. The tcp and udp protocols do not require special
626 privileges, but not all network devices implement the echo protocol
629 Local hosts should normally respond to pings within milliseconds.
630 However, on a very congested network it may take up to 3 seconds or
631 longer to receive an echo packet from the remote host. If the timeout
632 is set too low under these conditions, it will appear that the remote
633 host is not reachable (which is almost the truth).
635 Reachability doesn't necessarily mean that the remote host is actually
636 functioning beyond its ability to echo packets.
638 Because of a lack of anything better, this module uses its own
639 routines to pack and unpack ICMP packets. It would be better for a
640 separate module to be written which understands all of the different
641 kinds of ICMP packets.