3 # Author: mose@ccsn.edu (Russell Mosemann)
5 # Authors of the original pingecho():
6 # karrer@bernina.ethz.ch (Andreas Karrer)
7 # pmarquess@bfsec.bt.co.uk (Paul Marquess)
9 # Copyright (c) 1996 Russell Mosemann. All rights reserved. This
10 # program is free software; you may redistribute it and/or modify it
11 # under the same terms as Perl itself.
17 use vars qw(@ISA @EXPORT $VERSION
18 $def_timeout $def_proto $max_datasize);
20 use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
21 inet_aton 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 \"tcp\", \"udp\" or \"icmp\"")
74 unless $proto =~ m/^(tcp|udp|icmp)$/;
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 $>;
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 if ($self->{"proto"} eq "udp")
154 $ret = $self->ping_udp($ip, $timeout);
156 elsif ($self->{"proto"} eq "icmp")
158 $ret = $self->ping_icmp($ip, $timeout);
160 elsif ($self->{"proto"} eq "tcp")
162 $ret = $self->ping_tcp($ip, $timeout);
166 croak("Unknown protocol \"$self->{proto}\" in ping()");
174 $ip, # Packed IP number of the host
175 $timeout # Seconds after which ping times out
178 my $ICMP_ECHOREPLY = 0; # ICMP packet types
180 my $icmp_struct = "C2 S3 A"; # Structure of a minimal ICMP packet
181 my $subcode = 0; # No ICMP subcode for ECHO and ECHOREPLY
182 my $flags = 0; # No special flags when opening a socket
183 my $port = 0; # No port with ICMP
185 my ($saddr, # sockaddr_in with port and ip
186 $checksum, # Checksum of ICMP packet
187 $msg, # ICMP packet to send
188 $len_msg, # Length of $msg
189 $rbits, # Read bits, filehandles for reading
190 $nfound, # Number of ready filehandles found
191 $finish_time, # Time ping should be finished
192 $done, # set to 1 when we are done
194 $recv_msg, # Received message including IP header
195 $from_saddr, # sockaddr_in of sender
196 $from_port, # Port packet was sent from
197 $from_ip, # Packed IP of sender
198 $from_type, # ICMP type
199 $from_subcode, # ICMP subcode
200 $from_chk, # ICMP packet checksum
201 $from_pid, # ICMP packet id
202 $from_seq, # ICMP packet sequence
203 $from_msg # ICMP message
206 $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
207 $checksum = 0; # No checksum for starters
208 $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
209 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
210 $checksum = Net::Ping->checksum($msg);
211 $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
212 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
213 $len_msg = length($msg);
214 $saddr = sockaddr_in($port, $ip);
215 send($self->{"fh"}, $msg, $flags, $saddr); # Send the message
218 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
221 $finish_time = time() + $timeout; # Must be done by this time
222 while (!$done && $timeout > 0) # Keep trying if we have time
224 $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
225 $timeout = $finish_time - time(); # Get remaining time
226 if (!defined($nfound)) # Hmm, a strange error
231 elsif ($nfound) # Got a packet from somewhere
234 $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, $flags);
235 ($from_port, $from_ip) = sockaddr_in($from_saddr);
236 ($from_type, $from_subcode, $from_chk,
237 $from_pid, $from_seq, $from_msg) =
238 unpack($icmp_struct . $self->{"data_size"},
239 substr($recv_msg, length($recv_msg) - $len_msg,
241 if (($from_type == $ICMP_ECHOREPLY) &&
243 ($from_pid == $self->{"pid"}) && # Does the packet check out?
244 ($from_seq == $self->{"seq"}))
246 $ret = 1; # It's a winner
250 else # Oops, timed out
258 # Description: Do a checksum on the message. Basically sum all of
259 # the short words and fold the high order bits into the low order bits.
264 $msg # The message to checksum
266 my ($len_msg, # Length of the message
267 $num_short, # The number of short words in the message
268 $short, # One short word
272 $len_msg = length($msg);
273 $num_short = $len_msg / 2;
275 foreach $short (unpack("S$num_short", $msg))
278 } # Add the odd byte in
279 $chk += unpack("C", substr($msg, $len_msg - 1, 1)) if $len_msg % 2;
280 $chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low
281 return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement
284 # Description: Perform a tcp echo ping. Since a tcp connection is
285 # host specific, we have to open and close each connection here. We
286 # can't just leave a socket open. Because of the robust nature of
287 # tcp, it will take a while before it gives up trying to establish a
288 # connection. Therefore, we have to set the alarm to break out of the
289 # connection sooner if the timeout expires. No data bytes are actually
290 # sent since the successful establishment of a connection is proof
291 # enough of the reachability of the remote host. Also, tcp is
292 # expensive and doesn't need our help to add to the overhead.
297 $ip, # Packed IP number of the host
298 $timeout # Seconds after which ping times out
300 my ($saddr, # sockaddr_in with port and ip
301 $ret # The return value
304 socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
305 croak("tcp socket error - $!");
306 $saddr = sockaddr_in($self->{"port_num"}, $ip);
308 $SIG{'ALRM'} = sub { die };
309 alarm($timeout); # Interrupt connect() if we have to
311 $ret = 0; # Default to unreachable
313 return unless connect($self->{"fh"}, $saddr);
317 $self->{"fh"}->close();
321 # Description: Perform a udp echo ping. Construct a message of
322 # at least the one-byte sequence number and any additional data bytes.
323 # Send the message out and wait for a message to come back. If we
324 # get a message, make sure all of its parts match. If they do, we are
325 # done. Otherwise go back and wait for the message until we run out
326 # of time. Return the result of our efforts.
331 $ip, # Packed IP number of the host
332 $timeout # Seconds after which ping times out
335 my $flags = 0; # Nothing special on open
337 my ($saddr, # sockaddr_in with port and ip
338 $ret, # The return value
339 $msg, # Message to be echoed
340 $finish_time, # Time ping should be finished
341 $done, # Set to 1 when we are done pinging
342 $rbits, # Read bits, filehandles for reading
343 $nfound, # Number of ready filehandles found
344 $from_saddr, # sockaddr_in of sender
345 $from_msg, # Characters echoed by $host
346 $from_port, # Port message was echoed from
347 $from_ip # Packed IP number of sender
350 $saddr = sockaddr_in($self->{"port_num"}, $ip);
351 $self->{"seq"} = ($self->{"seq"} + 1) % 256; # Increment sequence
352 $msg = chr($self->{"seq"}) . $self->{"data"}; # Add data if any
353 send($self->{"fh"}, $msg, $flags, $saddr); # Send it
356 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
357 $ret = 0; # Default to unreachable
359 $finish_time = time() + $timeout; # Ping needs to be done by then
360 while (!$done && $timeout > 0)
362 $nfound = select($rbits, undef, undef, $timeout); # Wait for response
363 $timeout = $finish_time - time(); # Get remaining time
365 if (!defined($nfound)) # Hmm, a strange error
370 elsif ($nfound) # A packet is waiting
373 $from_saddr = recv($self->{"fh"}, $from_msg, 1500, $flags);
374 ($from_port, $from_ip) = sockaddr_in($from_saddr);
375 if (($from_ip eq $ip) && # Does the packet check out?
376 ($from_port == $self->{"port_num"}) &&
379 $ret = 1; # It's a winner
383 else # Oops, timed out
391 # Description: Close the connection unless we are using the tcp
392 # protocol, since it will already be closed.
398 $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
407 Net::Ping - check a remote host for reachability
413 $p = Net::Ping->new();
414 print "$host is alive.\n" if $p->ping($host);
417 $p = Net::Ping->new("icmp");
418 foreach $host (@host_array)
421 print "NOT " unless $p->ping($host, 2);
422 print "reachable.\n";
427 $p = Net::Ping->new("tcp", 2);
428 while ($stop_time > time())
430 print "$host not reachable ", scalar(localtime()), "\n"
431 unless $p->ping($host);
436 # For backward compatibility
437 print "$host is alive.\n" if pingecho($host);
441 This module contains methods to test the reachability of remote
442 hosts on a network. A ping object is first created with optional
443 parameters, a variable number of hosts may be pinged multiple
444 times and then the connection is closed.
446 You may choose one of three different protocols to use for the ping.
447 With the "tcp" protocol the ping() method attempts to establish a
448 connection to the remote host's echo port. If the connection is
449 successfully established, the remote host is considered reachable. No
450 data is actually echoed. This protocol does not require any special
451 privileges but has higher overhead than the other two protocols.
453 Specifying the "udp" protocol causes the ping() method to send a udp
454 packet to the remote host's echo port. If the echoed packet is
455 received from the remote host and the received packet contains the
456 same data as the packet that was sent, the remote host is considered
457 reachable. This protocol does not require any special privileges.
459 If the "icmp" protocol is specified, the ping() method sends an icmp
460 echo message to the remote host, which is what the UNIX ping program
461 does. If the echoed message is received from the remote host and
462 the echoed information is correct, the remote host is considered
463 reachable. Specifying the "icmp" protocol requires that the program
464 be run as root or that the program be setuid to root.
470 =item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
472 Create a new ping object. All of the parameters are optional. $proto
473 specifies the protocol to use when doing a ping. The current choices
474 are "tcp", "udp" or "icmp". The default is "udp".
476 If a default timeout ($def_timeout) in seconds is provided, it is used
477 when a timeout is not given to the ping() method (below). The timeout
478 must be greater than 0 and the default, if not specified, is 5 seconds.
480 If the number of data bytes ($bytes) is given, that many data bytes
481 are included in the ping packet sent to the remote host. The number of
482 data bytes is ignored if the protocol is "tcp". The minimum (and
483 default) number of data bytes is 1 if the protocol is "udp" and 0
484 otherwise. The maximum number of data bytes that can be specified is
487 =item $p->ping($host [, $timeout]);
489 Ping the remote host and wait for a response. $host can be either the
490 hostname or the IP number of the remote host. The optional timeout
491 must be greater than 0 seconds and defaults to whatever was specified
492 when the ping object was created. If the hostname cannot be found or
493 there is a problem with the IP number, undef is returned. Otherwise,
494 1 is returned if the host is reachable and 0 if it is not. For all
495 practical purposes, undef and 0 and can be treated as the same case.
499 Close the network connection for this ping object. The network
500 connection is also closed by "undef $p". The network connection is
501 automatically closed if the ping object goes out of scope (e.g. $p is
502 local to a subroutine and you leave the subroutine).
504 =item pingecho($host [, $timeout]);
506 To provide backward compatibility with the previous version of
507 Net::Ping, a pingecho() subroutine is available with the same
508 functionality as before. pingecho() uses the tcp protocol. The
509 return values and parameters are the same as described for the ping()
510 method. This subroutine is obsolete and may be removed in a future
511 version of Net::Ping.
517 pingecho() or a ping object with the tcp protocol use alarm() to
518 implement the timeout. So, don't use alarm() in your program while
519 you are using pingecho() or a ping object with the tcp protocol. The
520 udp and icmp protocols do not use alarm() to implement the timeout.
524 There will be less network overhead (and some efficiency in your
525 program) if you specify either the udp or the icmp protocol. The tcp
526 protocol will generate 2.5 times or more traffic for each ping than
527 either udp or icmp. If many hosts are pinged frequently, you may wish
528 to implement a small wait (e.g. 25ms or more) between each ping to
529 avoid flooding your network with packets.
531 The icmp protocol requires that the program be run as root or that it
532 be setuid to root. The tcp and udp protocols do not require special
533 privileges, but not all network devices implement the echo protocol
536 Local hosts should normally respond to pings within milliseconds.
537 However, on a very congested network it may take up to 3 seconds or
538 longer to receive an echo packet from the remote host. If the timeout
539 is set too low under these conditions, it will appear that the remote
540 host is not reachable (which is almost the truth).
542 Reachability doesn't necessarily mean that the remote host is actually
543 functioning beyond its ability to echo packets.
545 Because of a lack of anything better, this module uses its own
546 routines to pack and unpack ICMP packets. It would be better for a
547 separate module to be written which understands all of the different
548 kinds of ICMP packets.