Commit | Line | Data |
a0d0e21e |
1 | package Net::Ping; |
2 | |
a3b93737 |
3 | # Author: mose@ccsn.edu (Russell Mosemann) |
4 | # |
5 | # Authors of the original pingecho(): |
6 | # karrer@bernina.ethz.ch (Andreas Karrer) |
7 | # pmarquess@bfsec.bt.co.uk (Paul Marquess) |
8 | # |
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. |
12 | |
13 | require 5.002; |
a0d0e21e |
14 | require Exporter; |
15 | |
a3b93737 |
16 | use strict; |
17 | use vars qw(@ISA @EXPORT $VERSION |
18 | $def_timeout $def_proto $max_datasize); |
19 | use FileHandle; |
20 | use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET |
21 | inet_aton sockaddr_in ); |
22 | use Carp; |
a79c1648 |
23 | |
a0d0e21e |
24 | @ISA = qw(Exporter); |
a3b93737 |
25 | @EXPORT = qw(pingecho); |
26 | $VERSION = 2.02; |
a0d0e21e |
27 | |
a3b93737 |
28 | # Constants |
a0d0e21e |
29 | |
a3b93737 |
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 |
a0d0e21e |
33 | |
a3b93737 |
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. |
a0d0e21e |
38 | |
a3b93737 |
39 | sub pingecho |
40 | { |
41 | my ($host, # Name or IP number of host to ping |
42 | $timeout # Optional timeout in seconds |
43 | ) = @_; |
44 | my ($p); # A ping object |
a0d0e21e |
45 | |
a3b93737 |
46 | $p = Net::Ping->new("tcp", $timeout); |
47 | $p->ping($host); # Going out of scope closes the connection |
48 | } |
a0d0e21e |
49 | |
a3b93737 |
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. |
56 | |
57 | sub new |
58 | { |
59 | my ($this, |
60 | $proto, # Optional protocol to use for pinging |
61 | $timeout, # Optional timeout in seconds |
62 | $data_size # Optional additional bytes of data |
63 | ) = @_; |
64 | my $class = ref($this) || $this; |
65 | my $self = {}; |
66 | my ($cnt, # Count through data bytes |
67 | $min_datasize # Minimum data bytes required |
68 | ); |
69 | |
70 | bless($self, $class); |
71 | |
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; |
76 | |
77 | $timeout = $def_timeout unless $timeout; # Determine the timeout |
78 | croak("Default timeout for ping must be greater than 0 seconds") |
79 | if $timeout <= 0; |
80 | $self->{"timeout"} = $timeout; |
81 | |
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; |
88 | |
89 | $self->{"data"} = ""; # Construct data bytes |
90 | for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++) |
91 | { |
92 | $self->{"data"} .= chr($cnt % 256); |
93 | } |
94 | |
95 | $self->{"seq"} = 0; # For counting packets |
96 | if ($self->{"proto"} eq "udp") # Open a socket |
97 | { |
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 - $!"); |
106 | } |
107 | elsif ($self->{"proto"} eq "icmp") |
108 | { |
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 - $!"); |
116 | } |
117 | elsif ($self->{"proto"} eq "tcp") # Just a file handle for now |
118 | { |
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(); |
124 | } |
125 | |
126 | |
127 | return($self); |
128 | } |
a0d0e21e |
129 | |
a3b93737 |
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. |
134 | |
135 | sub ping |
136 | { |
137 | my ($self, |
138 | $host, # Name or IP number of host to ping |
139 | $timeout # Seconds after which ping times out |
140 | ) = @_; |
141 | my ($ip, # Packed IP number of $host |
142 | $ret # The return value |
143 | ); |
144 | |
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; |
148 | |
149 | $ip = inet_aton($host); |
150 | return(undef) unless defined($ip); # Does host exist? |
151 | |
152 | if ($self->{"proto"} eq "udp") |
153 | { |
154 | $ret = $self->ping_udp($ip, $timeout); |
155 | } |
156 | elsif ($self->{"proto"} eq "icmp") |
157 | { |
158 | $ret = $self->ping_icmp($ip, $timeout); |
159 | } |
160 | elsif ($self->{"proto"} eq "tcp") |
161 | { |
162 | $ret = $self->ping_tcp($ip, $timeout); |
163 | } |
a0d0e21e |
164 | else |
a3b93737 |
165 | { |
166 | croak("Unknown protocol \"$self->{proto}\" in ping()"); |
167 | } |
168 | return($ret); |
169 | } |
a0d0e21e |
170 | |
a3b93737 |
171 | sub ping_icmp |
172 | { |
173 | my ($self, |
174 | $ip, # Packed IP number of the host |
175 | $timeout # Seconds after which ping times out |
176 | ) = @_; |
177 | |
178 | my $ICMP_ECHOREPLY = 0; # ICMP packet types |
179 | my $ICMP_ECHO = 8; |
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 |
184 | |
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 |
193 | $ret, # Return value |
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 |
204 | ); |
205 | |
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 |
216 | |
217 | $rbits = ""; |
218 | vec($rbits, $self->{"fh"}->fileno(), 1) = 1; |
8e07c86e |
219 | $ret = 0; |
a3b93737 |
220 | $done = 0; |
221 | $finish_time = time() + $timeout; # Must be done by this time |
222 | while (!$done && $timeout > 0) # Keep trying if we have time |
223 | { |
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 |
227 | { |
228 | $ret = undef; |
229 | $done = 1; |
230 | } |
231 | elsif ($nfound) # Got a packet from somewhere |
232 | { |
233 | $recv_msg = ""; |
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, |
240 | $len_msg)); |
241 | if (($from_type == $ICMP_ECHOREPLY) && |
242 | ($from_ip eq $ip) && |
243 | ($from_pid == $self->{"pid"}) && # Does the packet check out? |
244 | ($from_seq == $self->{"seq"})) |
245 | { |
246 | $ret = 1; # It's a winner |
247 | $done = 1; |
248 | } |
249 | } |
250 | else # Oops, timed out |
251 | { |
252 | $done = 1; |
253 | } |
254 | } |
255 | return($ret) |
256 | } |
257 | |
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. |
260 | |
261 | sub checksum |
262 | { |
263 | my ($class, |
264 | $msg # The message to checksum |
265 | ) = @_; |
266 | my ($len_msg, # Length of the message |
267 | $num_short, # The number of short words in the message |
268 | $short, # One short word |
269 | $chk # The checksum |
270 | ); |
271 | |
272 | $len_msg = length($msg); |
273 | $num_short = $len_msg / 2; |
274 | $chk = 0; |
275 | foreach $short (unpack("S$num_short", $msg)) |
276 | { |
277 | $chk += $short; |
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 |
282 | } |
283 | |
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. |
293 | |
294 | sub ping_tcp |
295 | { |
296 | my ($self, |
297 | $ip, # Packed IP number of the host |
298 | $timeout # Seconds after which ping times out |
299 | ) = @_; |
300 | my ($saddr, # sockaddr_in with port and ip |
301 | $ret # The return value |
302 | ); |
303 | |
304 | socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) || |
305 | croak("tcp socket error - $!"); |
306 | $saddr = sockaddr_in($self->{"port_num"}, $ip); |
307 | |
308 | $SIG{'ALRM'} = sub { die }; |
309 | alarm($timeout); # Interrupt connect() if we have to |
310 | |
311 | $ret = 0; # Default to unreachable |
8e07c86e |
312 | eval <<'EOM' ; |
a3b93737 |
313 | return unless connect($self->{"fh"}, $saddr); |
314 | $ret = 1; |
a0d0e21e |
315 | EOM |
a0d0e21e |
316 | alarm(0); |
a3b93737 |
317 | $self->{"fh"}->close(); |
318 | return($ret); |
319 | } |
320 | |
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. |
327 | |
328 | sub ping_udp |
329 | { |
330 | my ($self, |
331 | $ip, # Packed IP number of the host |
332 | $timeout # Seconds after which ping times out |
333 | ) = @_; |
334 | |
335 | my $flags = 0; # Nothing special on open |
336 | |
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 |
348 | ); |
349 | |
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 |
354 | |
355 | $rbits = ""; |
356 | vec($rbits, $self->{"fh"}->fileno(), 1) = 1; |
357 | $ret = 0; # Default to unreachable |
358 | $done = 0; |
359 | $finish_time = time() + $timeout; # Ping needs to be done by then |
360 | while (!$done && $timeout > 0) |
361 | { |
362 | $nfound = select($rbits, undef, undef, $timeout); # Wait for response |
363 | $timeout = $finish_time - time(); # Get remaining time |
364 | |
365 | if (!defined($nfound)) # Hmm, a strange error |
366 | { |
367 | $ret = undef; |
368 | $done = 1; |
369 | } |
370 | elsif ($nfound) # A packet is waiting |
371 | { |
372 | $from_msg = ""; |
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"}) && |
377 | ($from_msg eq $msg)) |
378 | { |
379 | $ret = 1; # It's a winner |
380 | $done = 1; |
381 | } |
382 | } |
383 | else # Oops, timed out |
384 | { |
385 | $done = 1; |
386 | } |
387 | } |
388 | return($ret); |
a0d0e21e |
389 | } |
390 | |
a3b93737 |
391 | # Description: Close the connection unless we are using the tcp |
392 | # protocol, since it will already be closed. |
393 | |
394 | sub close |
395 | { |
396 | my ($self) = @_; |
397 | |
398 | $self->{"fh"}->close() unless $self->{"proto"} eq "tcp"; |
399 | } |
400 | |
401 | |
a0d0e21e |
402 | 1; |
8e07c86e |
403 | __END__ |
404 | |
8e07c86e |
405 | =head1 NAME |
406 | |
a3b93737 |
407 | Net::Ping - check a remote host for reachability |
8e07c86e |
408 | |
409 | =head1 SYNOPSIS |
410 | |
411 | use Net::Ping; |
8e07c86e |
412 | |
a3b93737 |
413 | $p = Net::Ping->new(); |
414 | print "$host is alive.\n" if $p->ping($host); |
415 | $p->close(); |
416 | |
417 | $p = Net::Ping->new("icmp"); |
418 | foreach $host (@host_array) |
419 | { |
420 | print "$host is "; |
421 | print "NOT " unless $p->ping($host, 2); |
422 | print "reachable.\n"; |
423 | sleep(1); |
424 | } |
425 | $p->close(); |
426 | |
427 | $p = Net::Ping->new("tcp", 2); |
428 | while ($stop_time > time()) |
429 | { |
430 | print "$host not reachable ", scalar(localtime()), "\n" |
431 | unless $p->ping($host); |
432 | sleep(300); |
433 | } |
434 | undef($p); |
435 | |
436 | # For backward compatibility |
437 | print "$host is alive.\n" if pingecho($host); |
8e07c86e |
438 | |
a3b93737 |
439 | =head1 DESCRIPTION |
8e07c86e |
440 | |
a3b93737 |
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. |
445 | |
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. |
452 | |
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. |
458 | |
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. |
465 | |
466 | =head2 Functions |
467 | |
468 | =over 4 |
469 | |
470 | =item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]); |
471 | |
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". |
475 | |
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. |
479 | |
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 |
485 | 1024. |
486 | |
487 | =item $p->ping($host [, $timeout]); |
488 | |
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. |
496 | |
497 | =item $p->close(); |
498 | |
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). |
503 | |
504 | =item pingecho($host [, $timeout]); |
505 | |
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. |
8e07c86e |
512 | |
a3b93737 |
513 | =back |
8e07c86e |
514 | |
a3b93737 |
515 | =head1 WARNING |
8e07c86e |
516 | |
a3b93737 |
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. |
8e07c86e |
521 | |
a3b93737 |
522 | =head1 NOTES |
8e07c86e |
523 | |
a3b93737 |
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. |
8e07c86e |
530 | |
a3b93737 |
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 |
534 | for tcp or udp. |
8e07c86e |
535 | |
a3b93737 |
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). |
8e07c86e |
541 | |
a3b93737 |
542 | Reachability doesn't necessarily mean that the remote host is actually |
543 | functioning beyond its ability to echo packets. |
8e07c86e |
544 | |
a3b93737 |
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. |
8e07c86e |
549 | |
a3b93737 |
550 | =cut |