c963a07afd99fd2addb2005405d6f73a893127fa
[p5sagit/p5-mst-13.2.git] / lib / Net / Ping.pm
1 package Net::Ping;
2
3 # Current maintainer: colinm@cpan.org (Colin McMillen)
4 #               stream protocol: bronson@trestle.com (Scott Bronson)
5 #
6 # Original author:   mose@ccsn.edu (Russell Mosemann)
7 #
8 # Authors of the original pingecho():
9 #           karrer@bernina.ethz.ch (Andreas Karrer)
10 #           Paul.Marquess@btinternet.com (Paul Marquess)
11 #
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.
15 use 5.006_001;
16 require Exporter;
17
18 use strict;
19 our(@ISA, @EXPORT, $VERSION, $def_timeout, $def_proto, $max_datasize);
20 use FileHandle;
21 use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
22                inet_aton inet_ntoa sockaddr_in );
23 use Carp;
24
25 @ISA = qw(Exporter);
26 @EXPORT = qw(pingecho);
27 $VERSION = 2.04;
28
29 # Constants
30
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
34
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.
39
40 sub pingecho
41 {
42     my ($host,              # Name or IP number of host to ping
43         $timeout            # Optional timeout in seconds
44         ) = @_;
45     my ($p);                # A ping object
46
47     $p = Net::Ping->new("tcp", $timeout);
48     $p->ping($host);        # Going out of scope closes the connection
49 }
50
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.
57
58 sub new
59 {
60     my ($this,
61         $proto,             # Optional protocol to use for pinging
62         $timeout,           # Optional timeout in seconds
63         $data_size          # Optional additional bytes of data
64         ) = @_;
65     my  $class = ref($this) || $this;
66     my  $self = {};
67     my ($cnt,               # Count through data bytes
68         $min_datasize       # Minimum data bytes required
69         );
70
71     bless($self, $class);
72
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;
77
78     $timeout = $def_timeout unless $timeout;    # Determine the timeout
79     croak("Default timeout for ping must be greater than 0 seconds")
80         if $timeout <= 0;
81     $self->{"timeout"} = $timeout;
82
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;
89
90     $self->{"data"} = "";                       # Construct data bytes
91     for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
92     {
93         $self->{"data"} .= chr($cnt % 256);
94     }
95
96     $self->{"seq"} = 0;                         # For counting packets
97     if ($self->{"proto"} eq "udp")              # Open a socket
98     {
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 - $!");
107     }
108     elsif ($self->{"proto"} eq "icmp")
109     {
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 - $!");
117     }
118     elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
119     {
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();
125     }
126
127
128     return($self);
129 }
130
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.
135
136 sub ping
137 {
138     my ($self,
139         $host,              # Name or IP number of host to ping
140         $timeout            # Seconds after which ping times out
141         ) = @_;
142     my ($ip,                # Packed IP number of $host
143         $ret                # The return value
144         );
145
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;
149
150     $ip = inet_aton($host);
151     return(undef) unless defined($ip);      # Does host exist?
152
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";
159
160     croak("Unknown protocol \"$self->{proto}\" in ping()");
161 }
162
163 # Uses Net::Ping::External to do an external ping.
164 sub ping_external {
165   my ($self,
166       $ip,                # Packed IP number of the host
167       $timeout            # Seconds after which ping times out
168      ) = @_;
169
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);
173 }
174
175 sub ping_icmp
176 {
177     my ($self,
178         $ip,                # Packed IP number of the host
179         $timeout            # Seconds after which ping times out
180         ) = @_;
181
182     my $ICMP_ECHOREPLY = 0; # ICMP packet types
183     my $ICMP_ECHO = 8;
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
188
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
197         $ret,               # Return value
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
208         );
209
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
220
221     $rbits = "";
222     vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
223     $ret = 0;
224     $done = 0;
225     $finish_time = time() + $timeout;       # Must be done by this time
226     while (!$done && $timeout > 0)          # Keep trying if we have time
227     {
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
231         {
232             $ret = undef;
233             $done = 1;
234         }
235         elsif ($nfound)                     # Got a packet from somewhere
236         {
237             $recv_msg = "";
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,
244                               $len_msg));
245             if (($from_type == $ICMP_ECHOREPLY) &&
246                 ($from_ip eq $ip) &&
247                 ($from_pid == $self->{"pid"}) && # Does the packet check out?
248                 ($from_seq == $self->{"seq"}))
249             {
250                 $ret = 1;                   # It's a winner
251                 $done = 1;
252             }
253         }
254         else                                # Oops, timed out
255         {
256             $done = 1;
257         }
258     }
259     return($ret)
260 }
261
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.
264
265 sub checksum
266 {
267     my ($class,
268         $msg            # The message to checksum
269         ) = @_;
270     my ($len_msg,       # Length of the message
271         $num_short,     # The number of short words in the message
272         $short,         # One short word
273         $chk            # The checksum
274         );
275
276     $len_msg = length($msg);
277     $num_short = int($len_msg / 2);
278     $chk = 0;
279     foreach $short (unpack("S$num_short", $msg))
280     {
281         $chk += $short;
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
286 }
287
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.
291
292 sub _ping_tcp_win
293 {
294     my ($self,
295         $ip,                # Packed IP number of the host
296         ) = @_;
297     my ($saddr,             # sockaddr_in with port and ip
298         $ret                # The return value
299         );
300
301     socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
302         croak("tcp socket error - $!");
303
304     $saddr = sockaddr_in($self->{"port_num"}, $ip);
305
306     $ret = 0;               # Default to unreachable
307
308     eval { $ret = connect($self->{"fh"}, $saddr) };
309
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;
315
316     $self->{"fh"}->close();
317     return $ret;
318 }
319
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.
324
325 sub ping_tcp_win32
326 {
327     my ($self,
328         $ip,                # Packed IP number of the host
329         $timeout            # Seconds after which open times out
330         ) = @_;
331
332     socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
333       croak("tcp socket error - $!");
334
335     my $saddr = sockaddr_in($self->{"port_num"}, $ip);
336
337         my ($child, $ret, $pid, $time);
338         my $host = inet_ntoa($ip);
339
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 . '))"';
343
344         # Call the process.
345         $pid = system(1, "perl", "-e", $code);
346
347         # Import the POSIX version of <sys/wait.h>
348         require POSIX;
349         import POSIX qw(:sys_wait_h);
350
351         # Get the current time; will be used to tell if we've timed out.
352         $time = time;
353
354         # Wait for the child to return or for the timeout to expire.
355         do {
356                 $child = waitpid($pid, &WNOHANG());
357                 $ret = $?;
358         } until time > ($time + $timeout) or $child;
359
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;
363
364         kill $pid;
365         return 0;
366 }
367
368 # This writes the given string to the socket and then reads it
369 # back.  It returns 1 on success, 0 on failure.
370 sub tcp_echo
371 {
372         my $self = shift;
373         my $timeout = shift;
374         my $pingstring = shift;
375
376         my $ret = undef;
377         my $time = time;
378         my $wrstr = $pingstring;
379         my $rdstr = "";
380
381     eval <<'EOM';
382         do {
383                 my $rin = "";
384                 vec($rin, $self->{"fh"}->fileno(), 1) = 1;
385
386                 my $rout = undef;
387                 if($wrstr) {
388                         $rout = "";
389                         vec($rout, $self->{"fh"}->fileno(), 1) = 1;
390                 }
391
392                 if(select($rin, $rout, undef, ($time + $timeout) - time())) {
393
394                         if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
395                                 my $num = syswrite($self->{"fh"}, $wrstr);
396                                 if($num) {
397                                         # If it was a partial write, update and try again.
398                                         $wrstr = substr($wrstr,$num);
399                                 } else {
400                                         # There was an error.
401                                         $ret = 0;
402                                 }
403                         }
404
405                         if(vec($rin,$self->{"fh"}->fileno(),1)) {
406                                 my $reply;
407                                 if(sysread($self->{"fh"},$reply,length($pingstring)-length($rdstr))) {
408                                         $rdstr .= $reply;
409                                         $ret = 1 if $rdstr eq $pingstring;
410                                 } else {
411                                         # There was an error.
412                                         $ret = 0;
413                                 }
414                         }
415
416                 }
417         } until time() > ($time + $timeout) || defined($ret);
418 EOM
419
420         return $ret;
421 }
422
423 sub tcp_connect
424 {
425     my ($self,
426         $ip,                # Packed IP number of the host
427         $timeout            # Seconds after which open times out
428         ) = @_;
429
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);
434
435         $self->{"ip"} = $ip;
436
437     socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
438       croak("tcp socket error - $!");
439
440     my $saddr = sockaddr_in($self->{"port_num"}, $ip);
441     my $ret = 0;
442
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
446         # succeeds in time.
447         $self->{"fh"}->blocking(0);
448         connect($self->{"fh"}, $saddr);
449
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");
455 }
456
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.
466
467 sub ping_tcp
468 {
469     my ($self,
470         $ip,                # Packed IP number of the host
471         $timeout            # Seconds after which ping times out
472        ) = @_;
473
474         my $ret;
475
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);
479         } else {
480         $ret = $self->tcp_connect($ip, $timeout);
481         $self->{"fh"}->close();
482         }
483
484     return $ret;
485 }
486
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.
490
491 sub ping_stream
492 {
493     my ($self,
494         $ip,                # Packed IP number of the host
495         $timeout            # Seconds after which ping times out
496         ) = @_;
497
498     my $pingstring = "ping!\n";   # The data we exchange with the server
499
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;
503     }
504
505     croak "tried to switch servers while stream pinging"
506        if $self->{"ip"} ne $ip;
507
508     return $self->tcp_echo($timeout, "pingschwingping!\n");
509 }
510
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.
513
514 sub open
515 {
516    my ($self,
517        $ip,                # Packed IP number of the host
518         $timeout            # Seconds after which open times out
519        ) = @_;
520
521    $timeout = $self->{"timeout"} unless $timeout;
522
523    if($self->{"proto"} eq "stream") {
524        if(defined($self->{"fh"}->fileno())) {
525            croak("socket is already open");
526        } else {
527            $self->tcp_connect($ip, $timeout);
528        }
529    }
530 }
531
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.
538
539 sub ping_udp
540 {
541     my ($self,
542         $ip,                # Packed IP number of the host
543         $timeout            # Seconds after which ping times out
544         ) = @_;
545
546     my $flags = 0;          # Nothing special on open
547
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
559         );
560
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
565
566     $rbits = "";
567     vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
568     $ret = 0;                   # Default to unreachable
569     $done = 0;
570     $finish_time = time() + $timeout;       # Ping needs to be done by then
571     while (!$done && $timeout > 0)
572     {
573         $nfound = select($rbits, undef, undef, $timeout); # Wait for response
574         $timeout = $finish_time - time();   # Get remaining time
575
576         if (!defined($nfound))  # Hmm, a strange error
577         {
578             $ret = undef;
579             $done = 1;
580         }
581         elsif ($nfound)         # A packet is waiting
582         {
583             $from_msg = "";
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"}) &&
589                 ($from_msg eq $msg))
590             {
591                 $ret = 1;       # It's a winner
592                 $done = 1;
593             }
594         }
595         else                    # Oops, timed out
596         {
597             $done = 1;
598         }
599     }
600     return($ret);
601 }   
602
603 # Description:  Close the connection unless we are using the tcp
604 # protocol, since it will already be closed.
605
606 sub close
607 {
608     my ($self) = @_;
609
610     $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
611 }
612
613
614 1;
615 __END__
616
617 =head1 NAME
618
619 Net::Ping - check a remote host for reachability
620
621 =head1 SYNOPSIS
622
623     use Net::Ping;
624
625     $p = Net::Ping->new();
626     print "$host is alive.\n" if $p->ping($host);
627     $p->close();
628
629     $p = Net::Ping->new("icmp");
630     foreach $host (@host_array)
631     {
632         print "$host is ";
633         print "NOT " unless $p->ping($host, 2);
634         print "reachable.\n";
635         sleep(1);
636     }
637     $p->close();
638     
639     $p = Net::Ping->new("tcp", 2);
640     while ($stop_time > time())
641     {
642         print "$host not reachable ", scalar(localtime()), "\n"
643             unless $p->ping($host);
644         sleep(300);
645     }
646     undef($p);
647     
648     # For backward compatibility
649     print "$host is alive.\n" if pingecho($host);
650
651 =head1 DESCRIPTION
652
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.
657
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.
663
664 =over 4
665
666 =item icmp
667
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.
674
675 =item udp
676
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.
682
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
686 more information.
687
688 =item tcp
689
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.
696
697 =item stream
698
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.
710
711 =item external
712
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.
718
719 =head2 Functions
720
721 =over 4
722
723 =item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
724
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".
728
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.
732
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
738 1024.
739
740 =item $p->ping($host [, $timeout]);
741
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.
749
750 =item $p->open($host);
751
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
759 than stream.
760
761 =item $p->close();
762
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).
767
768 =item pingecho($host [, $timeout]);
769
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.
776
777 =back
778
779 =head1 NOTES
780
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.
787
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.
791
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).
797
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.
802
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.
807
808 =cut