lib/Net/Ping.pm

   1 package Net::Ping;
   2
   3 # $Id: Ping.pm,v 1.11 2001/12/04 02:41:51 rob Exp $
   4
   5 require 5.002;
   6 require Exporter;
   7
   8 use strict;
   9 use vars qw(@ISA @EXPORT $VERSION
  10             $def_timeout $def_proto $max_datasize $pingstring);
  11 use FileHandle;
  12 use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
  13                inet_aton sockaddr_in );
  14 use Carp;
  15
  16 @ISA = qw(Exporter);
  17 @EXPORT = qw(pingecho);
  18 $VERSION = 2.07;
  19
  20 # Constants
  21
  22 $def_timeout = 5;           # Default timeout to wait for a reply
  23 $def_proto = "udp";         # Default protocol to use for pinging
  24 $max_datasize = 1024;       # Maximum data bytes in a packet
  25 # The data we exchange with the server for the stream protocol
  26 $pingstring = "pingschwingping!\n";
  27
  28 # Description:  The pingecho() subroutine is provided for backward
  29 # compatibility with the original Net::Ping.  It accepts a host
  30 # name/IP and an optional timeout in seconds.  Create a tcp ping
  31 # object and try pinging the host.  The result of the ping is returned.
  32
  33 sub pingecho
  34 {
  35     my ($host,              # Name or IP number of host to ping
  36         $timeout            # Optional timeout in seconds
  37         ) = @_;
  38     my ($p);                # A ping object
  39
  40     $p = Net::Ping->new("tcp", $timeout);
  41     $p->ping($host);        # Going out of scope closes the connection
  42 }
  43
  44 # Description:  The new() method creates a new ping object.  Optional
  45 # parameters may be specified for the protocol to use, the timeout in
  46 # seconds and the size in bytes of additional data which should be
  47 # included in the packet.
  48 #   After the optional parameters are checked, the data is constructed
  49 # and a socket is opened if appropriate.  The object is returned.
  50
  51 sub new
  52 {
  53     my ($this,
  54         $proto,             # Optional protocol to use for pinging
  55         $timeout,           # Optional timeout in seconds
  56         $data_size          # Optional additional bytes of data
  57         ) = @_;
  58     my  $class = ref($this) || $this;
  59     my  $self = {};
  60     my ($cnt,               # Count through data bytes
  61         $min_datasize       # Minimum data bytes required
  62         );
  63
  64     bless($self, $class);
  65
  66     $proto = $def_proto unless $proto;          # Determine the protocol
  67     croak('Protocol for ping must be "icmp", "udp", "tcp", "stream", or "external"')
  68         unless $proto =~ m/^(icmp|udp|tcp|stream|external)$/;
  69     $self->{"proto"} = $proto;
  70
  71     $timeout = $def_timeout unless $timeout;    # Determine the timeout
  72     croak("Default timeout for ping must be greater than 0 seconds")
  73         if $timeout <= 0;
  74     $self->{"timeout"} = $timeout;
  75
  76     $min_datasize = ($proto eq "udp") ? 1 : 0;  # Determine data size
  77     $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
  78     croak("Data for ping must be from $min_datasize to $max_datasize bytes")
  79         if ($data_size < $min_datasize) || ($data_size > $max_datasize);
  80     $data_size-- if $self->{"proto"} eq "udp";  # We provide the first byte
  81     $self->{"data_size"} = $data_size;
  82
  83     $self->{"data"} = "";                       # Construct data bytes
  84     for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
  85     {
  86         $self->{"data"} .= chr($cnt % 256);
  87     }
  88
  89     $self->{"seq"} = 0;                         # For counting packets
  90     if ($self->{"proto"} eq "udp")              # Open a socket
  91     {
  92         $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
  93             croak("Can't udp protocol by name");
  94         $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
  95             croak("Can't get udp echo port by name");
  96         $self->{"fh"} = FileHandle->new();
  97         socket($self->{"fh"}, &PF_INET(), &SOCK_DGRAM(),
  98                $self->{"proto_num"}) ||
  99             croak("udp socket error - $!");
 100     }
 101     elsif ($self->{"proto"} eq "icmp")
 102     {
 103         croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
 104         $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
 105                     croak("Can't get icmp protocol by name");
 106         $self->{"pid"} = $$ & 0xffff;           # Save lower 16 bits of pid
 107         $self->{"fh"} = FileHandle->new();
 108         socket($self->{"fh"}, &PF_INET(), &SOCK_RAW(), $self->{"proto_num"}) ||
 109             croak("icmp socket error - $!");
 110     }
 111     elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
 112     {
 113         $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
 114             croak("Can't get tcp protocol by name");
 115         $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
 116             croak("Can't get tcp echo port by name");
 117         $self->{"fh"} = FileHandle->new();
 118     }
 119
 120
 121     return($self);
 122 }
 123
 124 # Description: Ping a host name or IP number with an optional timeout.
 125 # First lookup the host, and return undef if it is not found.  Otherwise
 126 # perform the specific ping method based on the protocol.  Return the
 127 # result of the ping.
 128
 129 sub ping
 130 {
 131     my ($self,
 132         $host,              # Name or IP number of host to ping
 133         $timeout            # Seconds after which ping times out
 134         ) = @_;
 135     my ($ip,                # Packed IP number of $host
 136         $ret                # The return value
 137         );
 138
 139     croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
 140     $timeout = $self->{"timeout"} unless $timeout;
 141     croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
 142
 143     $ip = inet_aton($host);
 144     return(undef) unless defined($ip);      # Does host exist?
 145
 146     # Dispatch to the appropriate routine.
 147     return $self->ping_external($ip, $timeout) if $self->{"proto"} eq "external";
 148     return $self->ping_udp($ip, $timeout)      if $self->{"proto"} eq "udp";
 149     return $self->ping_icmp($ip, $timeout)     if $self->{"proto"} eq "icmp";
 150     return $self->ping_tcp($ip, $timeout)      if $self->{"proto"} eq "tcp";
 151     return $self->ping_stream($ip, $timeout)   if $self->{"proto"} eq "stream";
 152
 153     croak("Unknown protocol \"$self->{proto}\" in ping()");
 154 }
 155
 156 # Uses Net::Ping::External to do an external ping.
 157 sub ping_external {
 158   my ($self,
 159       $ip,                # Packed IP number of the host
 160       $timeout            # Seconds after which ping times out
 161      ) = @_;
 162
 163   eval { require Net::Ping::External; }
 164     or croak('Protocol "external" not supported on your system: Net::Ping::External not found');
 165   return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
 166 }
 167
 168 sub ping_icmp
 169 {
 170     my ($self,
 171         $ip,                # Packed IP number of the host
 172         $timeout            # Seconds after which ping times out
 173         ) = @_;
 174
 175     my $ICMP_ECHOREPLY = 0; # ICMP packet types
 176     my $ICMP_ECHO = 8;
 177     my $icmp_struct = "C2 S3 A";  # Structure of a minimal ICMP packet
 178     my $subcode = 0;        # No ICMP subcode for ECHO and ECHOREPLY
 179     my $flags = 0;          # No special flags when opening a socket
 180     my $port = 0;           # No port with ICMP
 181
 182     my ($saddr,             # sockaddr_in with port and ip
 183         $checksum,          # Checksum of ICMP packet
 184         $msg,               # ICMP packet to send
 185         $len_msg,           # Length of $msg
 186         $rbits,             # Read bits, filehandles for reading
 187         $nfound,            # Number of ready filehandles found
 188         $finish_time,       # Time ping should be finished
 189         $done,              # set to 1 when we are done
 190         $ret,               # Return value
 191         $recv_msg,          # Received message including IP header
 192         $from_saddr,        # sockaddr_in of sender
 193         $from_port,         # Port packet was sent from
 194         $from_ip,           # Packed IP of sender
 195         $from_type,         # ICMP type
 196         $from_subcode,      # ICMP subcode
 197         $from_chk,          # ICMP packet checksum
 198         $from_pid,          # ICMP packet id
 199         $from_seq,          # ICMP packet sequence
 200         $from_msg           # ICMP message
 201         );
 202
 203     $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
 204     $checksum = 0;                          # No checksum for starters
 205     $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
 206                 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
 207     $checksum = Net::Ping->checksum($msg);
 208     $msg = pack($icmp_struct . $self->{"data_size"}, $ICMP_ECHO, $subcode,
 209                 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
 210     $len_msg = length($msg);
 211     $saddr = sockaddr_in($port, $ip);
 212     send($self->{"fh"}, $msg, $flags, $saddr); # Send the message
 213
 214     $rbits = "";
 215     vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
 216     $ret = 0;
 217     $done = 0;
 218     $finish_time = time() + $timeout;       # Must be done by this time
 219     while (!$done && $timeout > 0)          # Keep trying if we have time
 220     {
 221         $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
 222         $timeout = $finish_time - time();   # Get remaining time
 223         if (!defined($nfound))              # Hmm, a strange error
 224         {
 225             $ret = undef;
 226             $done = 1;
 227         }
 228         elsif ($nfound)                     # Got a packet from somewhere
 229         {
 230             $recv_msg = "";
 231             $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, $flags);
 232             ($from_port, $from_ip) = sockaddr_in($from_saddr);
 233             ($from_type, $from_subcode, $from_chk,
 234              $from_pid, $from_seq, $from_msg) =
 235                 unpack($icmp_struct . $self->{"data_size"},
 236                        substr($recv_msg, length($recv_msg) - $len_msg,
 237                               $len_msg));
 238             if (($from_type == $ICMP_ECHOREPLY) &&
 239                 ($from_ip eq $ip) &&
 240                 ($from_pid == $self->{"pid"}) && # Does the packet check out?
 241                 ($from_seq == $self->{"seq"}))
 242             {
 243                 $ret = 1;                   # It's a winner
 244                 $done = 1;
 245             }
 246         }
 247         else                                # Oops, timed out
 248         {
 249             $done = 1;
 250         }
 251     }
 252     return($ret)
 253 }
 254
 255 # Description:  Do a checksum on the message.  Basically sum all of
 256 # the short words and fold the high order bits into the low order bits.
 257
 258 sub checksum
 259 {
 260     my ($class,
 261         $msg            # The message to checksum
 262         ) = @_;
 263     my ($len_msg,       # Length of the message
 264         $num_short,     # The number of short words in the message
 265         $short,         # One short word
 266         $chk            # The checksum
 267         );
 268
 269     $len_msg = length($msg);
 270     $num_short = int($len_msg / 2);
 271     $chk = 0;
 272     foreach $short (unpack("S$num_short", $msg))
 273     {
 274         $chk += $short;
 275     }                                           # Add the odd byte in
 276     $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
 277     $chk = ($chk >> 16) + ($chk & 0xffff);      # Fold high into low
 278     return(~(($chk >> 16) + $chk) & 0xffff);    # Again and complement
 279 }
 280
 281
 282 # Description:  Perform a tcp echo ping.  Since a tcp connection is
 283 # host specific, we have to open and close each connection here.  We
 284 # can't just leave a socket open.  Because of the robust nature of
 285 # tcp, it will take a while before it gives up trying to establish a
 286 # connection.  Therefore, we use select() on a non-blocking socket to
 287 # check against our timeout.  No data bytes are actually
 288 # sent since the successful establishment of a connection is proof
 289 # enough of the reachability of the remote host.  Also, tcp is
 290 # expensive and doesn't need our help to add to the overhead.
 291
 292 sub ping_tcp
 293 {
 294     my ($self,
 295         $ip,                # Packed IP number of the host
 296         $timeout            # Seconds after which ping times out
 297         ) = @_;
 298     my ($ret                # The return value
 299         );
 300
 301     $@ = "";
 302     $ret = $self -> tcp_connect( $ip, $timeout);
 303     $ret = 1 if $@ =~ /(Connection Refused|Unknown Error)/i;
 304     $self->{"fh"}->close();
 305     return($ret);
 306 }
 307
 308 sub tcp_connect
 309 {
 310     my ($self,
 311         $ip,                # Packed IP number of the host
 312         $timeout            # Seconds after which connect times out
 313         ) = @_;
 314     my ($saddr);            # Packed IP and Port
 315
 316     $saddr = sockaddr_in($self->{"port_num"}, $ip);
 317
 318     my $ret = 0;            # Default to unreachable
 319
 320     my $do_socket = sub {
 321       socket($self->{"fh"}, &PF_INET(), &SOCK_STREAM(), $self->{"proto_num"}) ||
 322         croak("tcp socket error - $!");
 323     };
 324     my $do_connect = sub {
 325       eval {
 326         die $! unless connect($self->{"fh"}, $saddr);
 327         $self->{"ip"} = $ip;
 328         $ret = 1;
 329       };
 330       $ret;
 331     };
 332
 333     if ($^O =~ /Win32/i) {
 334
 335       # Buggy Winsock API doesn't allow us to use alarm() calls.
 336       # Hence, if our OS is Windows, we need to create a separate
 337       # process to do the blocking connect attempt.
 338
 339       $| = 1; # Clear buffer prior to fork to prevent duplicate flushing.
 340       my $pid = fork;
 341       if (!$pid) {
 342         if (!defined $pid) {
 343           # Fork did not work
 344           warn "Win32 Fork error: $!";
 345           return 0;
 346         }
 347         &{ $do_socket }();
 348
 349         # Try a slow blocking connect() call
 350         # and report the status to the pipe.
 351         if ( &{ $do_connect }() ) {
 352           $self->{"fh"}->close();
 353           # No error
 354           exit 0;
 355         } else {
 356           # Pass the error status to the parent
 357           exit $!;
 358         }
 359       }
 360
 361       &{ $do_socket }();
 362
 363       my $patience = time + $timeout;
 364
 365       require POSIX;
 366       my ($child);
 367       $? = 0;
 368       # Wait up to the timeout
 369       # And clean off the zombie
 370       do {
 371         $child = waitpid($pid, &POSIX::WNOHANG);
 372         $! = $? >> 8;
 373         $@ = $!;
 374         sleep 1;
 375       } while time < $patience && $child != $pid;
 376
 377       if ($child == $pid) {
 378         # Since she finished within the timeout,
 379         # it is probably safe for me to try it too
 380         &{ $do_connect }();
 381       } else {
 382         # Time must have run out.
 383         $@ = "Timed out!";
 384         # Put that choking client out of its misery
 385         kill "KILL", $pid;
 386         # Clean off the zombie
 387         waitpid($pid, 0);
 388         $ret = 0;
 389       }
 390     } else { # Win32
 391       # Otherwise don't waste the resources to fork
 392
 393       &{ $do_socket }();
 394
 395       $SIG{'ALRM'} = sub { die "Timed out!"; };
 396       alarm($timeout);        # Interrupt connect() if we have to
 397
 398       &{ $do_connect }();
 399       alarm(0);
 400     }
 401
 402     return $ret;
 403 }
 404
 405 # This writes the given string to the socket and then reads it
 406 # back.  It returns 1 on success, 0 on failure.
 407 sub tcp_echo
 408 {
 409     my $self = shift;
 410     my $timeout = shift;
 411     my $pingstring = shift;
 412
 413     my $ret = undef;
 414     my $time = time;
 415     my $wrstr = $pingstring;
 416     my $rdstr = "";
 417
 418     eval <<'EOM';
 419         do {
 420                 my $rin = "";
 421                 vec($rin, $self->{"fh"}->fileno(), 1) = 1;
 422
 423                 my $rout = undef;
 424                 if($wrstr) {
 425                         $rout = "";
 426                         vec($rout, $self->{"fh"}->fileno(), 1) = 1;
 427                 }
 428
 429                 if(select($rin, $rout, undef, ($time + $timeout) - time())) {
 430
 431                         if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
 432                                 my $num = syswrite($self->{"fh"}, $wrstr);
 433                                 if($num) {
 434                                         # If it was a partial write, update and try again.
 435                                         $wrstr = substr($wrstr,$num);
 436                                 } else {
 437                                         # There was an error.
 438                                         $ret = 0;
 439                                 }
 440                         }
 441
 442                         if(vec($rin,$self->{"fh"}->fileno(),1)) {
 443                                 my $reply;
 444                                 if(sysread($self->{"fh"},$reply,length($pingstring)-length($rdstr))) {
 445                                         $rdstr .= $reply;
 446                                         $ret = 1 if $rdstr eq $pingstring;
 447                                 } else {
 448                                         # There was an error.
 449                                         $ret = 0;
 450                                 }
 451                         }
 452
 453                 }
 454         } until time() > ($time + $timeout) || defined($ret);
 455 EOM
 456
 457     return $ret;
 458 }
 459
 460
 461
 462
 463 # Description: Perform a stream ping.  If the tcp connection isn't
 464 # already open, it opens it.  It then sends some data and waits for
 465 # a reply.  It leaves the stream open on exit.
 466
 467 sub ping_stream
 468 {
 469     my ($self,
 470         $ip,                # Packed IP number of the host
 471         $timeout            # Seconds after which ping times out
 472         ) = @_;
 473
 474     # Open the stream if it's not already open
 475     if(!defined $self->{"fh"}->fileno()) {
 476         $self->tcp_connect($ip, $timeout) or return 0;
 477     }
 478
 479     croak "tried to switch servers while stream pinging"
 480        if $self->{"ip"} ne $ip;
 481
 482     return $self->tcp_echo($timeout, $pingstring);
 483 }
 484
 485 # Description: opens the stream.  You would do this if you want to
 486 # separate the overhead of opening the stream from the first ping.
 487
 488 sub open
 489 {
 490     my ($self,
 491         $host,              # Host or IP address
 492         $timeout            # Seconds after which open times out
 493         ) = @_;
 494
 495     my ($ip);               # Packed IP number of the host
 496     $ip = inet_aton($host);
 497     $timeout = $self->{"timeout"} unless $timeout;
 498
 499     if($self->{"proto"} eq "stream") {
 500       if(defined($self->{"fh"}->fileno())) {
 501         croak("socket is already open");
 502       } else {
 503         $self->tcp_connect($ip, $timeout);
 504       }
 505     }
 506 }
 507
 508
 509 # Description:  Perform a udp echo ping.  Construct a message of
 510 # at least the one-byte sequence number and any additional data bytes.
 511 # Send the message out and wait for a message to come back.  If we
 512 # get a message, make sure all of its parts match.  If they do, we are
 513 # done.  Otherwise go back and wait for the message until we run out
 514 # of time.  Return the result of our efforts.
 515
 516 sub ping_udp
 517 {
 518     my ($self,
 519         $ip,                # Packed IP number of the host
 520         $timeout            # Seconds after which ping times out
 521         ) = @_;
 522
 523     my $flags = 0;          # Nothing special on open
 524
 525     my ($saddr,             # sockaddr_in with port and ip
 526         $ret,               # The return value
 527         $msg,               # Message to be echoed
 528         $finish_time,       # Time ping should be finished
 529         $done,              # Set to 1 when we are done pinging
 530         $rbits,             # Read bits, filehandles for reading
 531         $nfound,            # Number of ready filehandles found
 532         $from_saddr,        # sockaddr_in of sender
 533         $from_msg,          # Characters echoed by $host
 534         $from_port,         # Port message was echoed from
 535         $from_ip            # Packed IP number of sender
 536         );
 537
 538     $saddr = sockaddr_in($self->{"port_num"}, $ip);
 539     $self->{"seq"} = ($self->{"seq"} + 1) % 256;    # Increment sequence
 540     $msg = chr($self->{"seq"}) . $self->{"data"};   # Add data if any
 541     send($self->{"fh"}, $msg, $flags, $saddr);      # Send it
 542
 543     $rbits = "";
 544     vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
 545     $ret = 0;                   # Default to unreachable
 546     $done = 0;
 547     $finish_time = time() + $timeout;       # Ping needs to be done by then
 548     while (!$done && $timeout > 0)
 549     {
 550         $nfound = select($rbits, undef, undef, $timeout); # Wait for response
 551         $timeout = $finish_time - time();   # Get remaining time
 552
 553         if (!defined($nfound))  # Hmm, a strange error
 554         {
 555             $ret = undef;
 556             $done = 1;
 557         }
 558         elsif ($nfound)         # A packet is waiting
 559         {
 560             $from_msg = "";
 561             $from_saddr = recv($self->{"fh"}, $from_msg, 1500, $flags)
 562                 or last; # For example an unreachable host will make recv() fail.
 563             ($from_port, $from_ip) = sockaddr_in($from_saddr);
 564             if (($from_ip eq $ip) &&        # Does the packet check out?
 565                 ($from_port == $self->{"port_num"}) &&
 566                 ($from_msg eq $msg))
 567             {
 568                 $ret = 1;       # It's a winner
 569                 $done = 1;
 570             }
 571         }
 572         else                    # Oops, timed out
 573         {
 574             $done = 1;
 575         }
 576     }
 577     return($ret);
 578 }
 579
 580 # Description:  Close the connection unless we are using the tcp
 581 # protocol, since it will already be closed.
 582
 583 sub close
 584 {
 585     my ($self) = @_;
 586
 587     $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
 588 }
 589
 590
 591 1;
 592 __END__
 593
 594 =head1 NAME
 595
 596 Net::Ping - check a remote host for reachability
 597
 598 $Id: Ping.pm,v 1.11 2001/12/04 02:41:51 rob Exp $
 599
 600 =head1 SYNOPSIS
 601
 602     use Net::Ping;
 603
 604     $p = Net::Ping->new();
 605     print "$host is alive.\n" if $p->ping($host);
 606     $p->close();
 607
 608     $p = Net::Ping->new("icmp");
 609     foreach $host (@host_array)
 610     {
 611         print "$host is ";
 612         print "NOT " unless $p->ping($host, 2);
 613         print "reachable.\n";
 614         sleep(1);
 615     }
 616     $p->close();
 617
 618     $p = Net::Ping->new("tcp", 2);
 619     # Try connecting to the www port instead of the echo port
 620     $p->{port_num} = getservbyname("http", "tcp");
 621     while ($stop_time > time())
 622     {
 623         print "$host not reachable ", scalar(localtime()), "\n"
 624             unless $p->ping($host);
 625         sleep(300);
 626     }
 627     undef($p);
 628
 629     # For backward compatibility
 630     print "$host is alive.\n" if pingecho($host);
 631
 632 =head1 DESCRIPTION
 633
 634 This module contains methods to test the reachability of remote
 635 hosts on a network.  A ping object is first created with optional
 636 parameters, a variable number of hosts may be pinged multiple
 637 times and then the connection is closed.
 638
 639 You may choose one of four different protocols to use for the
 640 ping. The "udp" protocol is the default. Note that a live remote host
 641 may still fail to be pingable by one or more of these protocols. For
 642 example, www.microsoft.com is generally alive but not pingable.
 643
 644 With the "tcp" protocol the ping() method attempts to establish a
 645 connection to the remote host's echo port.  If the connection is
 646 successfully established, the remote host is considered reachable.  No
 647 data is actually echoed.  This protocol does not require any special
 648 privileges but has higher overhead than the other two protocols.
 649
 650 Specifying the "udp" protocol causes the ping() method to send a udp
 651 packet to the remote host's echo port.  If the echoed packet is
 652 received from the remote host and the received packet contains the
 653 same data as the packet that was sent, the remote host is considered
 654 reachable.  This protocol does not require any special privileges.
 655 It should be borne in mind that, for a udp ping, a host
 656 will be reported as unreachable if it is not running the
 657 appropriate echo service.  For Unix-like systems see L<inetd(8)>
 658 for more information.
 659
 660 If the "icmp" protocol is specified, the ping() method sends an icmp
 661 echo message to the remote host, which is what the UNIX ping program
 662 does.  If the echoed message is received from the remote host and
 663 the echoed information is correct, the remote host is considered
 664 reachable.  Specifying the "icmp" protocol requires that the program
 665 be run as root or that the program be setuid to root.
 666
 667 If the "external" protocol is specified, the ping() method attempts to
 668 use the C<Net::Ping::External> module to ping the remote host.
 669 C<Net::Ping::External> interfaces with your system's default C<ping>
 670 utility to perform the ping, and generally produces relatively
 671 accurate results. If C<Net::Ping::External> if not installed on your
 672 system, specifying the "external" protocol will result in an error.
 673
 674 =head2 Functions
 675
 676 =over 4
 677
 678 =item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
 679
 680 Create a new ping object.  All of the parameters are optional.  $proto
 681 specifies the protocol to use when doing a ping.  The current choices
 682 are "tcp", "udp" or "icmp".  The default is "udp".
 683
 684 If a default timeout ($def_timeout) in seconds is provided, it is used
 685 when a timeout is not given to the ping() method (below).  The timeout
 686 must be greater than 0 and the default, if not specified, is 5 seconds.
 687
 688 If the number of data bytes ($bytes) is given, that many data bytes
 689 are included in the ping packet sent to the remote host. The number of
 690 data bytes is ignored if the protocol is "tcp".  The minimum (and
 691 default) number of data bytes is 1 if the protocol is "udp" and 0
 692 otherwise.  The maximum number of data bytes that can be specified is
 693 1024.
 694
 695 =item $p->ping($host [, $timeout]);
 696
 697 Ping the remote host and wait for a response.  $host can be either the
 698 hostname or the IP number of the remote host.  The optional timeout
 699 must be greater than 0 seconds and defaults to whatever was specified
 700 when the ping object was created.  If the hostname cannot be found or
 701 there is a problem with the IP number, undef is returned.  Otherwise,
 702 1 is returned if the host is reachable and 0 if it is not.  For all
 703 practical purposes, undef and 0 and can be treated as the same case.
 704
 705 =item $p->open($host);
 706
 707 When you are using the stream protocol, this call pre-opens the
 708 tcp socket.  It's only necessary to do this if you want to
 709 provide a different timeout when creating the connection, or
 710 remove the overhead of establishing the connection from the
 711 first ping.  If you don't call C<open()>, the connection is
 712 automatically opened the first time C<ping()> is called.
 713 This call simply does nothing if you are using any protocol other
 714 than stream.
 715
 716 =item $p->open($host);
 717
 718 When you are using the stream protocol, this call pre-opens the
 719 tcp socket.  It's only necessary to do this if you want to
 720 provide a different timeout when creating the connection, or
 721 remove the overhead of establishing the connection from the
 722 first ping.  If you don't call C<open()>, the connection is
 723 automatically opened the first time C<ping()> is called.
 724 This call simply does nothing if you are using any protocol other
 725 than stream.
 726
 727 =item $p->close();
 728
 729 Close the network connection for this ping object.  The network
 730 connection is also closed by "undef $p".  The network connection is
 731 automatically closed if the ping object goes out of scope (e.g. $p is
 732 local to a subroutine and you leave the subroutine).
 733
 734 =item pingecho($host [, $timeout]);
 735
 736 To provide backward compatibility with the previous version of
 737 Net::Ping, a pingecho() subroutine is available with the same
 738 functionality as before.  pingecho() uses the tcp protocol.  The
 739 return values and parameters are the same as described for the ping()
 740 method.  This subroutine is obsolete and may be removed in a future
 741 version of Net::Ping.
 742
 743 =back
 744
 745 =head1 WARNING
 746
 747 pingecho() or a ping object with the tcp protocol use alarm() to
 748 implement the timeout.  So, don't use alarm() in your program while
 749 you are using pingecho() or a ping object with the tcp protocol.  The
 750 udp and icmp protocols do not use alarm() to implement the timeout.
 751
 752 =head1 NOTES
 753
 754 There will be less network overhead (and some efficiency in your
 755 program) if you specify either the udp or the icmp protocol.  The tcp
 756 protocol will generate 2.5 times or more traffic for each ping than
 757 either udp or icmp.  If many hosts are pinged frequently, you may wish
 758 to implement a small wait (e.g. 25ms or more) between each ping to
 759 avoid flooding your network with packets.
 760
 761 The icmp protocol requires that the program be run as root or that it
 762 be setuid to root.  The other protocols do not require special
 763 privileges, but not all network devices implement tcp or udp echo.
 764
 765 Local hosts should normally respond to pings within milliseconds.
 766 However, on a very congested network it may take up to 3 seconds or
 767 longer to receive an echo packet from the remote host.  If the timeout
 768 is set too low under these conditions, it will appear that the remote
 769 host is not reachable (which is almost the truth).
 770
 771 Reachability doesn't necessarily mean that the remote host is actually
 772 functioning beyond its ability to echo packets.  tcp is slightly better
 773 at indicating the health of a system than icmp because it uses more
 774 of the networking stack to respond.
 775
 776 Because of a lack of anything better, this module uses its own
 777 routines to pack and unpack ICMP packets.  It would be better for a
 778 separate module to be written which understands all of the different
 779 kinds of ICMP packets.
 780
 781 =head1 AUTHOR(S)
 782
 783   Current maintainer Net::Ping base code:
 784     colinm@cpan.org (Colin McMillen)
 785
 786   Stream protocol:
 787     bronson@trestle.com (Scott Bronson)
 788
 789   Original pingecho():
 790     karrer@bernina.ethz.ch (Andreas Karrer)
 791     pmarquess@bfsec.bt.co.uk (Paul Marquess)
 792
 793   Original Net::Ping author:
 794     mose@ns.ccsn.edu (Russell Mosemann)
 795
 796   Compatibility porting:
 797     bbb@cpan.org (Rob Brown)
 798
 799 =head1 COPYRIGHT
 800
 801 Copyright (c) 2001, Colin McMillen.  All rights reserved.
 802 Copyright (c) 2001, Rob Brown.  All rights reserved.
 803
 804 This program is free software; you may redistribute it and/or
 805 modify it under the same terms as Perl itself.
 806
 807 =cut