7 use vars qw(@ISA @EXPORT $VERSION
8 $def_timeout $def_proto $def_factor
9 $max_datasize $pingstring $hires $source_verify $syn_forking);
10 use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK );
11 use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET SOL_SOCKET SO_ERROR
12 inet_aton inet_ntoa sockaddr_in );
13 use POSIX qw( ENOTCONN ECONNREFUSED ECONNRESET EINPROGRESS EWOULDBLOCK EAGAIN WNOHANG );
18 @EXPORT = qw(pingecho);
26 $def_timeout = 5; # Default timeout to wait for a reply
27 $def_proto = "tcp"; # Default protocol to use for pinging
28 $def_factor = 1.2; # Default exponential backoff rate.
29 $max_datasize = 1024; # Maximum data bytes in a packet
30 # The data we exchange with the server for the stream protocol
31 $pingstring = "pingschwingping!\n";
32 $source_verify = 1; # Default is to verify source endpoint
35 if ($^O =~ /Win32/i) {
36 # Hack to avoid this Win32 spewage:
37 # Your vendor has not defined POSIX macro ECONNREFUSED
38 *ECONNREFUSED = sub {10061;}; # "Unknown Error" Special Win32 Response?
39 *ENOTCONN = sub {10057;};
40 *ECONNRESET = sub {10054;};
41 *EINPROGRESS = sub {10036;};
42 *EWOULDBLOCK = sub {10035;};
43 # $syn_forking = 1; # XXX possibly useful in < Win2K ?
47 # require "asm/socket.ph";
48 sub SO_BINDTODEVICE {25;}
50 # Description: The pingecho() subroutine is provided for backward
51 # compatibility with the original Net::Ping. It accepts a host
52 # name/IP and an optional timeout in seconds. Create a tcp ping
53 # object and try pinging the host. The result of the ping is returned.
57 my ($host, # Name or IP number of host to ping
58 $timeout # Optional timeout in seconds
60 my ($p); # A ping object
62 $p = Net::Ping->new("tcp", $timeout);
63 $p->ping($host); # Going out of scope closes the connection
66 # Description: The new() method creates a new ping object. Optional
67 # parameters may be specified for the protocol to use, the timeout in
68 # seconds and the size in bytes of additional data which should be
69 # included in the packet.
70 # After the optional parameters are checked, the data is constructed
71 # and a socket is opened if appropriate. The object is returned.
76 $proto, # Optional protocol to use for pinging
77 $timeout, # Optional timeout in seconds
78 $data_size, # Optional additional bytes of data
79 $device, # Optional device to use
80 $tos, # Optional ToS to set
82 my $class = ref($this) || $this;
84 my ($cnt, # Count through data bytes
85 $min_datasize # Minimum data bytes required
90 $proto = $def_proto unless $proto; # Determine the protocol
91 croak('Protocol for ping must be "icmp", "udp", "tcp", "syn", "stream", or "external"')
92 unless $proto =~ m/^(icmp|udp|tcp|syn|stream|external)$/;
93 $self->{"proto"} = $proto;
95 $timeout = $def_timeout unless $timeout; # Determine the timeout
96 croak("Default timeout for ping must be greater than 0 seconds")
98 $self->{"timeout"} = $timeout;
100 $self->{"device"} = $device;
102 $self->{"tos"} = $tos;
104 $min_datasize = ($proto eq "udp") ? 1 : 0; # Determine data size
105 $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
106 croak("Data for ping must be from $min_datasize to $max_datasize bytes")
107 if ($data_size < $min_datasize) || ($data_size > $max_datasize);
108 $data_size-- if $self->{"proto"} eq "udp"; # We provide the first byte
109 $self->{"data_size"} = $data_size;
111 $self->{"data"} = ""; # Construct data bytes
112 for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
114 $self->{"data"} .= chr($cnt % 256);
117 $self->{"local_addr"} = undef; # Don't bind by default
118 $self->{"retrans"} = $def_factor; # Default exponential backoff rate
119 $self->{"econnrefused"} = undef; # Default Connection refused behavior
121 $self->{"seq"} = 0; # For counting packets
122 if ($self->{"proto"} eq "udp") # Open a socket
124 $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
125 croak("Can't udp protocol by name");
126 $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
127 croak("Can't get udp echo port by name");
128 $self->{"fh"} = FileHandle->new();
129 socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
130 $self->{"proto_num"}) ||
131 croak("udp socket error - $!");
132 if ($self->{'device'}) {
133 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
134 or croak "error binding to device $self->{'device'} $!";
136 if ($self->{'tos'}) {
137 setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
138 or croak "error configuring tos to $self->{'tos'} $!";
141 elsif ($self->{"proto"} eq "icmp")
143 croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS' and $^O ne 'cygwin');
144 $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
145 croak("Can't get icmp protocol by name");
146 $self->{"pid"} = $$ & 0xffff; # Save lower 16 bits of pid
147 $self->{"fh"} = FileHandle->new();
148 socket($self->{"fh"}, PF_INET, SOCK_RAW, $self->{"proto_num"}) ||
149 croak("icmp socket error - $!");
150 if ($self->{'device'}) {
151 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
152 or croak "error binding to device $self->{'device'} $!";
154 if ($self->{'tos'}) {
155 setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
156 or croak "error configuring tos to $self->{'tos'} $!";
159 elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
161 $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
162 croak("Can't get tcp protocol by name");
163 $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
164 croak("Can't get tcp echo port by name");
165 $self->{"fh"} = FileHandle->new();
167 elsif ($self->{"proto"} eq "syn")
169 $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
170 croak("Can't get tcp protocol by name");
171 $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
172 croak("Can't get tcp echo port by name");
174 $self->{"fork_rd"} = FileHandle->new();
175 $self->{"fork_wr"} = FileHandle->new();
176 pipe($self->{"fork_rd"}, $self->{"fork_wr"});
177 $self->{"fh"} = FileHandle->new();
178 $self->{"good"} = {};
181 $self->{"wbits"} = "";
185 $self->{"stop_time"} = 0;
187 elsif ($self->{"proto"} eq "external")
189 # No preliminary work needs to be done.
195 # Description: Set the local IP address from which pings will be sent.
196 # For ICMP and UDP pings, this calls bind() on the already-opened socket;
197 # for TCP pings, just saves the address to be used when the socket is
198 # opened. Returns non-zero if successful; croaks on error.
202 $local_addr # Name or IP number of local interface
204 my ($ip # Packed IP number of $local_addr
207 croak("Usage: \$p->bind(\$local_addr)") unless @_ == 2;
208 croak("already bound") if defined($self->{"local_addr"}) &&
209 ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp");
211 $ip = inet_aton($local_addr);
212 croak("nonexistent local address $local_addr") unless defined($ip);
213 $self->{"local_addr"} = $ip; # Only used if proto is tcp
215 if ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp")
217 CORE::bind($self->{"fh"}, sockaddr_in(0, $ip)) ||
218 croak("$self->{'proto'} bind error - $!");
220 elsif (($self->{"proto"} ne "tcp") && ($self->{"proto"} ne "syn"))
222 croak("Unknown protocol \"$self->{proto}\" in bind()");
228 # Description: A select() wrapper that compensates for platform
232 if ($_[3] > 0 and $^O eq 'MSWin32') {
233 # On windows, select() doesn't process the message loop,
234 # but sleep() will, allowing alarm() to interrupt the latter.
235 # So we chop up the timeout into smaller pieces and interleave
236 # select() and sleep() calls.
238 my $gran = 0.5; # polling granularity in seconds
241 $gran = $t if $gran > $t;
242 my $nfound = select($_[0], $_[1], $_[2], $gran);
244 return $nfound if $nfound or !defined($nfound) or $t <= 0;
247 ($_[0], $_[1], $_[2]) = @args;
251 return select($_[0], $_[1], $_[2], $_[3]);
255 # Description: Allow UDP source endpoint comparison to be
256 # skipped for those remote interfaces that do
257 # not response from the same endpoint.
262 $source_verify = 1 unless defined
263 ($source_verify = ((defined $self) && (ref $self)) ? shift() : $self);
266 # Description: Set whether or not the connect
267 # behavior should enforce remote service
268 # availability as well as reachability.
273 $self->{"econnrefused"} = 1 unless defined
274 ($self->{"econnrefused"} = shift());
277 sub tcp_service_check
282 # Description: Set exponential backoff for retransmission.
283 # Should be > 1 to retain exponential properties.
284 # If set to 0, retransmissions are disabled.
289 $self->{"retrans"} = shift;
292 # Description: allows the module to use milliseconds as returned by
293 # the Time::HiRes module
299 $hires = 1 unless defined
300 ($hires = ((defined $self) && (ref $self)) ? shift() : $self);
301 require Time::HiRes if $hires;
306 return $hires ? Time::HiRes::time() : CORE::time();
309 # Description: Sets or clears the O_NONBLOCK flag on a file handle.
310 sub socket_blocking_mode
313 $fh, # the file handle whose flags are to be modified
314 $block) = @_; # if true then set the blocking
315 # mode (clear O_NONBLOCK), otherwise
316 # set the non-blocking mode (set O_NONBLOCK)
319 if ($^O eq 'MSWin32' || $^O eq 'VMS') {
320 # FIONBIO enables non-blocking sockets on windows and vms.
321 # FIONBIO is (0x80000000|(4<<16)|(ord('f')<<8)|126), as per winsock.h, ioctl.h
323 my $v = pack("L", $block ? 0 : 1);
324 ioctl($fh, $f, $v) or croak("ioctl failed: $!");
327 if ($flags = fcntl($fh, F_GETFL, 0)) {
328 $flags = $block ? ($flags & ~O_NONBLOCK) : ($flags | O_NONBLOCK);
329 if (!fcntl($fh, F_SETFL, $flags)) {
330 croak("fcntl F_SETFL: $!");
333 croak("fcntl F_GETFL: $!");
337 # Description: Ping a host name or IP number with an optional timeout.
338 # First lookup the host, and return undef if it is not found. Otherwise
339 # perform the specific ping method based on the protocol. Return the
340 # result of the ping.
345 $host, # Name or IP number of host to ping
346 $timeout, # Seconds after which ping times out
348 my ($ip, # Packed IP number of $host
349 $ret, # The return value
350 $ping_time, # When ping began
353 croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
354 $timeout = $self->{"timeout"} unless $timeout;
355 croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
357 $ip = inet_aton($host);
358 return () unless defined($ip); # Does host exist?
360 # Dispatch to the appropriate routine.
361 $ping_time = &time();
362 if ($self->{"proto"} eq "external") {
363 $ret = $self->ping_external($ip, $timeout);
365 elsif ($self->{"proto"} eq "udp") {
366 $ret = $self->ping_udp($ip, $timeout);
368 elsif ($self->{"proto"} eq "icmp") {
369 $ret = $self->ping_icmp($ip, $timeout);
371 elsif ($self->{"proto"} eq "tcp") {
372 $ret = $self->ping_tcp($ip, $timeout);
374 elsif ($self->{"proto"} eq "stream") {
375 $ret = $self->ping_stream($ip, $timeout);
377 elsif ($self->{"proto"} eq "syn") {
378 $ret = $self->ping_syn($host, $ip, $ping_time, $ping_time+$timeout);
380 croak("Unknown protocol \"$self->{proto}\" in ping()");
383 return wantarray ? ($ret, &time() - $ping_time, inet_ntoa($ip)) : $ret;
386 # Uses Net::Ping::External to do an external ping.
389 $ip, # Packed IP number of the host
390 $timeout # Seconds after which ping times out
393 eval { require Net::Ping::External; }
394 or croak('Protocol "external" not supported on your system: Net::Ping::External not found');
395 return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
398 use constant ICMP_ECHOREPLY => 0; # ICMP packet types
399 use constant ICMP_UNREACHABLE => 3; # ICMP packet types
400 use constant ICMP_ECHO => 8;
401 use constant ICMP_STRUCT => "C2 n3 A"; # Structure of a minimal ICMP packet
402 use constant SUBCODE => 0; # No ICMP subcode for ECHO and ECHOREPLY
403 use constant ICMP_FLAGS => 0; # No special flags for send or recv
404 use constant ICMP_PORT => 0; # No port with ICMP
409 $ip, # Packed IP number of the host
410 $timeout # Seconds after which ping times out
413 my ($saddr, # sockaddr_in with port and ip
414 $checksum, # Checksum of ICMP packet
415 $msg, # ICMP packet to send
416 $len_msg, # Length of $msg
417 $rbits, # Read bits, filehandles for reading
418 $nfound, # Number of ready filehandles found
419 $finish_time, # Time ping should be finished
420 $done, # set to 1 when we are done
422 $recv_msg, # Received message including IP header
423 $from_saddr, # sockaddr_in of sender
424 $from_port, # Port packet was sent from
425 $from_ip, # Packed IP of sender
426 $from_type, # ICMP type
427 $from_subcode, # ICMP subcode
428 $from_chk, # ICMP packet checksum
429 $from_pid, # ICMP packet id
430 $from_seq, # ICMP packet sequence
431 $from_msg # ICMP message
434 $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
435 $checksum = 0; # No checksum for starters
436 $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
437 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
438 $checksum = Net::Ping->checksum($msg);
439 $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
440 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
441 $len_msg = length($msg);
442 $saddr = sockaddr_in(ICMP_PORT, $ip);
443 $self->{"from_ip"} = undef;
444 $self->{"from_type"} = undef;
445 $self->{"from_subcode"} = undef;
446 send($self->{"fh"}, $msg, ICMP_FLAGS, $saddr); # Send the message
449 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
452 $finish_time = &time() + $timeout; # Must be done by this time
453 while (!$done && $timeout > 0) # Keep trying if we have time
455 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for packet
456 $timeout = $finish_time - &time(); # Get remaining time
457 if ($nfound == -1) # Hmm, a strange error
462 elsif ($nfound) # Got a packet from somewhere
467 $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, ICMP_FLAGS);
468 ($from_port, $from_ip) = sockaddr_in($from_saddr);
469 ($from_type, $from_subcode) = unpack("C2", substr($recv_msg, 20, 2));
470 if ($from_type == ICMP_ECHOREPLY) {
471 ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 24, 4))
472 if length $recv_msg >= 28;
474 ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 52, 4))
475 if length $recv_msg >= 56;
477 $self->{"from_ip"} = $from_ip;
478 $self->{"from_type"} = $from_type;
479 $self->{"from_subcode"} = $from_subcode;
480 if (($from_pid == $self->{"pid"}) && # Does the packet check out?
481 ($from_seq == $self->{"seq"})) {
482 if ($from_type == ICMP_ECHOREPLY) {
485 } elsif ($from_type == ICMP_UNREACHABLE) {
489 } else { # Oops, timed out
498 my $ip = $self->{"from_ip"} || "";
499 $ip = "\0\0\0\0" unless 4 == length $ip;
500 return (inet_ntoa($ip),($self->{"from_type"} || 0), ($self->{"from_subcode"} || 0));
503 # Description: Do a checksum on the message. Basically sum all of
504 # the short words and fold the high order bits into the low order bits.
509 $msg # The message to checksum
511 my ($len_msg, # Length of the message
512 $num_short, # The number of short words in the message
513 $short, # One short word
517 $len_msg = length($msg);
518 $num_short = int($len_msg / 2);
520 foreach $short (unpack("n$num_short", $msg))
523 } # Add the odd byte in
524 $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
525 $chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low
526 return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement
530 # Description: Perform a tcp echo ping. Since a tcp connection is
531 # host specific, we have to open and close each connection here. We
532 # can't just leave a socket open. Because of the robust nature of
533 # tcp, it will take a while before it gives up trying to establish a
534 # connection. Therefore, we use select() on a non-blocking socket to
535 # check against our timeout. No data bytes are actually
536 # sent since the successful establishment of a connection is proof
537 # enough of the reachability of the remote host. Also, tcp is
538 # expensive and doesn't need our help to add to the overhead.
543 $ip, # Packed IP number of the host
544 $timeout # Seconds after which ping times out
546 my ($ret # The return value
550 $ret = $self -> tcp_connect( $ip, $timeout);
551 if (!$self->{"econnrefused"} &&
552 $! == ECONNREFUSED) {
553 $ret = 1; # "Connection refused" means reachable
555 $self->{"fh"}->close();
562 $ip, # Packed IP number of the host
563 $timeout # Seconds after which connect times out
565 my ($saddr); # Packed IP and Port
567 $saddr = sockaddr_in($self->{"port_num"}, $ip);
569 my $ret = 0; # Default to unreachable
571 my $do_socket = sub {
572 socket($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"}) ||
573 croak("tcp socket error - $!");
574 if (defined $self->{"local_addr"} &&
575 !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
576 croak("tcp bind error - $!");
578 if ($self->{'device'}) {
579 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
580 or croak("error binding to device $self->{'device'} $!");
582 if ($self->{'tos'}) {
583 setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
584 or croak "error configuring tos to $self->{'tos'} $!";
587 my $do_connect = sub {
589 # ECONNREFUSED is 10061 on MSWin32. If we pass it as child error through $?,
590 # we'll get (10061 & 255) = 77, so we cannot check it in the parent process.
591 return ($ret = connect($self->{"fh"}, $saddr) || ($! == ECONNREFUSED && !$self->{"econnrefused"}));
593 my $do_connect_nb = sub {
594 # Set O_NONBLOCK property on filehandle
595 $self->socket_blocking_mode($self->{"fh"}, 0);
597 # start the connection attempt
598 if (!connect($self->{"fh"}, $saddr)) {
599 if ($! == ECONNREFUSED) {
600 $ret = 1 unless $self->{"econnrefused"};
601 } elsif ($! != EINPROGRESS && ($^O ne 'MSWin32' || $! != EWOULDBLOCK)) {
602 # EINPROGRESS is the expected error code after a connect()
603 # on a non-blocking socket. But if the kernel immediately
604 # determined that this connect() will never work,
605 # Simply respond with "unreachable" status.
606 # (This can occur on some platforms with errno
607 # EHOSTUNREACH or ENETUNREACH.)
610 # Got the expected EINPROGRESS.
611 # Just wait for connection completion...
612 my ($wbits, $wout, $wexc);
613 $wout = $wexc = $wbits = "";
614 vec($wbits, $self->{"fh"}->fileno, 1) = 1;
616 my $nfound = mselect(undef,
618 ($^O eq 'MSWin32' ? ($wexc = $wbits) : undef),
620 warn("select: $!") unless defined $nfound;
622 if ($nfound && vec($wout, $self->{"fh"}->fileno, 1)) {
623 # the socket is ready for writing so the connection
624 # attempt completed. test whether the connection
625 # attempt was successful or not
627 if (getpeername($self->{"fh"})) {
628 # Connection established to remote host
631 # TCP ACK will never come from this host
632 # because there was an error connecting.
634 # This should set $! to the correct error.
636 sysread($self->{"fh"},$char,1);
637 $! = ECONNREFUSED if ($! == EAGAIN && $^O =~ /cygwin/i);
639 $ret = 1 if (!$self->{"econnrefused"}
640 && $! == ECONNREFUSED);
643 # the connection attempt timed out (or there were connect
645 if ($^O =~ 'MSWin32') {
646 # If the connect will fail on a non-blocking socket,
647 # winsock reports ECONNREFUSED as an exception, and we
648 # need to fetch the socket-level error code via getsockopt()
649 # instead of using the thread-level error code that is in $!.
650 if ($nfound && vec($wexc, $self->{"fh"}->fileno, 1)) {
651 $! = unpack("i", getsockopt($self->{"fh"}, SOL_SOCKET,
658 # Connection established to remote host
662 # Unset O_NONBLOCK property on filehandle
663 $self->socket_blocking_mode($self->{"fh"}, 1);
669 # Buggy Winsock API doesn't allow nonblocking connect.
670 # Hence, if our OS is Windows, we need to create a separate
671 # process to do the blocking connect attempt.
672 # XXX Above comments are not true at least for Win2K, where
673 # nonblocking connect works.
675 $| = 1; # Clear buffer prior to fork to prevent duplicate flushing.
676 $self->{'tcp_chld'} = fork;
677 if (!$self->{'tcp_chld'}) {
678 if (!defined $self->{'tcp_chld'}) {
680 warn "Fork error: $!";
685 # Try a slow blocking connect() call
686 # and report the status to the parent.
687 if ( &{ $do_connect }() ) {
688 $self->{"fh"}->close();
692 # Pass the error status to the parent
693 # Make sure that $! <= 255
694 exit($! <= 255 ? $! : 255);
700 my $patience = &time() + $timeout;
702 my ($child, $child_errno);
703 $? = 0; $child_errno = 0;
704 # Wait up to the timeout
705 # And clean off the zombie
707 $child = waitpid($self->{'tcp_chld'}, &WNOHANG());
708 $child_errno = $? >> 8;
709 select(undef, undef, undef, 0.1);
710 } while &time() < $patience && $child != $self->{'tcp_chld'};
712 if ($child == $self->{'tcp_chld'}) {
713 if ($self->{"proto"} eq "stream") {
714 # We need the socket connected here, in parent
715 # Should be safe to connect because the child finished
719 # $ret cannot be set by the child process
720 $ret = !$child_errno;
722 # Time must have run out.
723 # Put that choking client out of its misery
724 kill "KILL", $self->{'tcp_chld'};
725 # Clean off the zombie
726 waitpid($self->{'tcp_chld'}, 0);
729 delete $self->{'tcp_chld'};
732 # Otherwise don't waste the resources to fork
736 &{ $do_connect_nb }();
744 if ($self->{'proto'} eq 'tcp' &&
745 $self->{'tcp_chld'}) {
746 # Put that choking client out of its misery
747 kill "KILL", $self->{'tcp_chld'};
748 # Clean off the zombie
749 waitpid($self->{'tcp_chld'}, 0);
753 # This writes the given string to the socket and then reads it
754 # back. It returns 1 on success, 0 on failure.
759 my $pingstring = shift;
763 my $wrstr = $pingstring;
769 vec($rin, $self->{"fh"}->fileno(), 1) = 1;
774 vec($rout, $self->{"fh"}->fileno(), 1) = 1;
777 if(mselect($rin, $rout, undef, ($time + $timeout) - &time())) {
779 if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
780 my $num = syswrite($self->{"fh"}, $wrstr, length $wrstr);
782 # If it was a partial write, update and try again.
783 $wrstr = substr($wrstr,$num);
785 # There was an error.
790 if(vec($rin,$self->{"fh"}->fileno(),1)) {
792 if(sysread($self->{"fh"},$reply,length($pingstring)-length($rdstr))) {
794 $ret = 1 if $rdstr eq $pingstring;
796 # There was an error.
802 } until &time() > ($time + $timeout) || defined($ret);
811 # Description: Perform a stream ping. If the tcp connection isn't
812 # already open, it opens it. It then sends some data and waits for
813 # a reply. It leaves the stream open on exit.
818 $ip, # Packed IP number of the host
819 $timeout # Seconds after which ping times out
822 # Open the stream if it's not already open
823 if(!defined $self->{"fh"}->fileno()) {
824 $self->tcp_connect($ip, $timeout) or return 0;
827 croak "tried to switch servers while stream pinging"
828 if $self->{"ip"} ne $ip;
830 return $self->tcp_echo($timeout, $pingstring);
833 # Description: opens the stream. You would do this if you want to
834 # separate the overhead of opening the stream from the first ping.
839 $host, # Host or IP address
840 $timeout # Seconds after which open times out
843 my ($ip); # Packed IP number of the host
844 $ip = inet_aton($host);
845 $timeout = $self->{"timeout"} unless $timeout;
847 if($self->{"proto"} eq "stream") {
848 if(defined($self->{"fh"}->fileno())) {
849 croak("socket is already open");
851 $self->tcp_connect($ip, $timeout);
857 # Description: Perform a udp echo ping. Construct a message of
858 # at least the one-byte sequence number and any additional data bytes.
859 # Send the message out and wait for a message to come back. If we
860 # get a message, make sure all of its parts match. If they do, we are
861 # done. Otherwise go back and wait for the message until we run out
862 # of time. Return the result of our efforts.
864 use constant UDP_FLAGS => 0; # Nothing special on send or recv
868 $ip, # Packed IP number of the host
869 $timeout # Seconds after which ping times out
872 my ($saddr, # sockaddr_in with port and ip
873 $ret, # The return value
874 $msg, # Message to be echoed
875 $finish_time, # Time ping should be finished
876 $flush, # Whether socket needs to be disconnected
877 $connect, # Whether socket needs to be connected
878 $done, # Set to 1 when we are done pinging
879 $rbits, # Read bits, filehandles for reading
880 $nfound, # Number of ready filehandles found
881 $from_saddr, # sockaddr_in of sender
882 $from_msg, # Characters echoed by $host
883 $from_port, # Port message was echoed from
884 $from_ip # Packed IP number of sender
887 $saddr = sockaddr_in($self->{"port_num"}, $ip);
888 $self->{"seq"} = ($self->{"seq"} + 1) % 256; # Increment sequence
889 $msg = chr($self->{"seq"}) . $self->{"data"}; # Add data if any
891 if ($self->{"connected"}) {
892 if ($self->{"connected"} ne $saddr) {
893 # Still connected to wrong destination.
894 # Need to flush out the old one.
899 # Need to connect() before send()
903 # Have to connect() and send() instead of sendto()
904 # in order to pick up on the ECONNREFUSED setting
905 # from recv() or double send() errno as utilized in
906 # the concept by rdw @ perlmonks. See:
907 # http://perlmonks.thepen.com/42898.html
909 # Need to socket() again to flush the descriptor
910 # This will disconnect from the old saddr.
911 socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
912 $self->{"proto_num"});
914 # Connect the socket if it isn't already connected
915 # to the right destination.
916 if ($flush || $connect) {
917 connect($self->{"fh"}, $saddr); # Tie destination to socket
918 $self->{"connected"} = $saddr;
920 send($self->{"fh"}, $msg, UDP_FLAGS); # Send it
923 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
924 $ret = 0; # Default to unreachable
927 my $factor = $self->{"retrans"};
928 $finish_time = &time() + $timeout; # Ping needs to be done by then
929 while (!$done && $timeout > 0)
933 $timeout = $retrans if $timeout > $retrans;
934 $retrans*= $factor; # Exponential backoff
936 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for response
938 $timeout = $finish_time - &time(); # Get remaining time
940 if (!defined($nfound)) # Hmm, a strange error
945 elsif ($nfound) # A packet is waiting
948 $from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS);
950 # For example an unreachable host will make recv() fail.
951 if (!$self->{"econnrefused"} &&
952 ($! == ECONNREFUSED ||
954 # "Connection refused" means reachable
960 ($from_port, $from_ip) = sockaddr_in($from_saddr);
961 if (!$source_verify ||
962 (($from_ip eq $ip) && # Does the packet check out?
963 ($from_port == $self->{"port_num"}) &&
964 ($from_msg eq $msg)))
966 $ret = 1; # It's a winner
971 elsif ($timeout <= 0) # Oops, timed out
977 # Send another in case the last one dropped
978 if (send($self->{"fh"}, $msg, UDP_FLAGS)) {
979 # Another send worked? The previous udp packet
980 # must have gotten lost or is still in transit.
981 # Hopefully this new packet will arrive safely.
983 if (!$self->{"econnrefused"} &&
984 $! == ECONNREFUSED) {
985 # "Connection refused" means reachable
996 # Description: Send a TCP SYN packet to host specified.
1002 my $start_time = shift;
1003 my $stop_time = shift;
1006 return $self->ping_syn_fork($host, $ip, $start_time, $stop_time);
1009 my $fh = FileHandle->new();
1010 my $saddr = sockaddr_in($self->{"port_num"}, $ip);
1013 if (!socket ($fh, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
1014 croak("tcp socket error - $!");
1017 if (defined $self->{"local_addr"} &&
1018 !CORE::bind($fh, sockaddr_in(0, $self->{"local_addr"}))) {
1019 croak("tcp bind error - $!");
1022 if ($self->{'device'}) {
1023 setsockopt($fh, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
1024 or croak("error binding to device $self->{'device'} $!");
1026 if ($self->{'tos'}) {
1027 setsockopt($fh, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
1028 or croak "error configuring tos to $self->{'tos'} $!";
1030 # Set O_NONBLOCK property on filehandle
1031 $self->socket_blocking_mode($fh, 0);
1033 # Attempt the non-blocking connect
1034 # by just sending the TCP SYN packet
1035 if (connect($fh, $saddr)) {
1036 # Non-blocking, yet still connected?
1037 # Must have connected very quickly,
1038 # or else it wasn't very non-blocking.
1039 #warn "WARNING: Nonblocking connect connected anyway? ($^O)";
1041 # Error occurred connecting.
1042 if ($! == EINPROGRESS || ($^O eq 'MSWin32' && $! == EWOULDBLOCK)) {
1043 # The connection is just still in progress.
1044 # This is the expected condition.
1046 # Just save the error and continue on.
1047 # The ack() can check the status later.
1048 $self->{"bad"}->{$host} = $!;
1052 my $entry = [ $host, $ip, $fh, $start_time, $stop_time ];
1053 $self->{"syn"}->{$fh->fileno} = $entry;
1054 if ($self->{"stop_time"} < $stop_time) {
1055 $self->{"stop_time"} = $stop_time;
1057 vec($self->{"wbits"}, $fh->fileno, 1) = 1;
1063 my ($self, $host, $ip, $start_time, $stop_time) = @_;
1065 # Buggy Winsock API doesn't allow nonblocking connect.
1066 # Hence, if our OS is Windows, we need to create a separate
1067 # process to do the blocking connect attempt.
1072 my $entry = [ $host, $ip, $pid, $start_time, $stop_time ];
1073 $self->{"syn"}->{$pid} = $entry;
1074 if ($self->{"stop_time"} < $stop_time) {
1075 $self->{"stop_time"} = $stop_time;
1079 my $saddr = sockaddr_in($self->{"port_num"}, $ip);
1082 if (!socket ($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
1083 croak("tcp socket error - $!");
1086 if (defined $self->{"local_addr"} &&
1087 !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
1088 croak("tcp bind error - $!");
1091 if ($self->{'device'}) {
1092 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
1093 or croak("error binding to device $self->{'device'} $!");
1095 if ($self->{'tos'}) {
1096 setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
1097 or croak "error configuring tos to $self->{'tos'} $!";
1101 # Try to connect (could take a long time)
1102 connect($self->{"fh"}, $saddr);
1103 # Notify parent of connect error status
1105 my $wrstr = "$$ $err";
1106 # Force to 16 chars including \n
1107 $wrstr .= " "x(15 - length $wrstr). "\n";
1108 syswrite($self->{"fork_wr"}, $wrstr, length $wrstr);
1118 # Description: Wait for TCP ACK from host specified
1119 # from ping_syn above. If no host is specified, wait
1120 # for TCP ACK from any of the hosts in the SYN queue.
1125 if ($self->{"proto"} eq "syn") {
1127 my @answer = $self->ack_unfork(shift);
1128 return wantarray ? @answer : $answer[0];
1132 if (my $host = shift) {
1133 # Host passed as arg
1134 if (exists $self->{"bad"}->{$host}) {
1135 if (!$self->{"econnrefused"} &&
1136 $self->{"bad"}->{ $host } &&
1137 (($! = ECONNREFUSED)>0) &&
1138 $self->{"bad"}->{ $host } eq "$!") {
1139 # "Connection refused" means reachable
1142 # ECONNREFUSED means no good
1146 my $host_fd = undef;
1147 foreach my $fd (keys %{ $self->{"syn"} }) {
1148 my $entry = $self->{"syn"}->{$fd};
1149 if ($entry->[0] eq $host) {
1151 $stop_time = $entry->[4]
1152 || croak("Corrupted SYN entry for [$host]");
1156 croak("ack called on [$host] without calling ping first!")
1157 unless defined $host_fd;
1158 vec($wbits, $host_fd, 1) = 1;
1160 # No $host passed so scan all hosts
1161 # Use the latest stop_time
1162 $stop_time = $self->{"stop_time"};
1164 $wbits = $self->{"wbits"};
1167 while ($wbits !~ /^\0*\z/) {
1168 my $timeout = $stop_time - &time();
1169 # Force a minimum of 10 ms timeout.
1170 $timeout = 0.01 if $timeout <= 0.01;
1172 my $winner_fd = undef;
1175 # Do "bad" fds from $wbits first
1176 while ($wout !~ /^\0*\z/) {
1177 if (vec($wout, $fd, 1)) {
1178 # Wipe it from future scanning.
1179 vec($wout, $fd, 1) = 0;
1180 if (my $entry = $self->{"syn"}->{$fd}) {
1181 if ($self->{"bad"}->{ $entry->[0] }) {
1190 if (defined($winner_fd) or my $nfound = mselect(undef, ($wout=$wbits), undef, $timeout)) {
1191 if (defined $winner_fd) {
1194 # Done waiting for one of the ACKs
1196 # Determine which one
1197 while ($wout !~ /^\0*\z/ &&
1198 !vec($wout, $fd, 1)) {
1202 if (my $entry = $self->{"syn"}->{$fd}) {
1203 # Wipe it from future scanning.
1204 delete $self->{"syn"}->{$fd};
1205 vec($self->{"wbits"}, $fd, 1) = 0;
1206 vec($wbits, $fd, 1) = 0;
1207 if (!$self->{"econnrefused"} &&
1208 $self->{"bad"}->{ $entry->[0] } &&
1209 (($! = ECONNREFUSED)>0) &&
1210 $self->{"bad"}->{ $entry->[0] } eq "$!") {
1211 # "Connection refused" means reachable
1213 } elsif (getpeername($entry->[2])) {
1214 # Connection established to remote host
1217 # TCP ACK will never come from this host
1218 # because there was an error connecting.
1220 # This should set $! to the correct error.
1222 sysread($entry->[2],$char,1);
1223 # Store the excuse why the connection failed.
1224 $self->{"bad"}->{$entry->[0]} = $!;
1225 if (!$self->{"econnrefused"} &&
1226 (($! == ECONNREFUSED) ||
1227 ($! == EAGAIN && $^O =~ /cygwin/i))) {
1228 # "Connection refused" means reachable
1231 # No good, try the next socket...
1235 # Everything passed okay, return the answer
1237 ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
1240 warn "Corrupted SYN entry: unknown fd [$fd] ready!";
1241 vec($wbits, $fd, 1) = 0;
1242 vec($self->{"wbits"}, $fd, 1) = 0;
1244 } elsif (defined $nfound) {
1245 # Timed out waiting for ACK
1246 foreach my $fd (keys %{ $self->{"syn"} }) {
1247 if (vec($wbits, $fd, 1)) {
1248 my $entry = $self->{"syn"}->{$fd};
1249 $self->{"bad"}->{$entry->[0]} = "Timed out";
1250 vec($wbits, $fd, 1) = 0;
1251 vec($self->{"wbits"}, $fd, 1) = 0;
1252 delete $self->{"syn"}->{$fd};
1256 # Weird error occurred with select()
1258 $self->{"syn"} = {};
1267 my ($self,$host) = @_;
1268 my $stop_time = $self->{"stop_time"};
1270 # Host passed as arg
1271 if (my $entry = $self->{"good"}->{$host}) {
1272 delete $self->{"good"}->{$host};
1273 return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
1280 if (keys %{ $self->{"syn"} }) {
1281 # Scan all hosts that are left
1282 vec($rbits, fileno($self->{"fork_rd"}), 1) = 1;
1283 $timeout = $stop_time - &time();
1284 # Force a minimum of 10 ms timeout.
1285 $timeout = 0.01 if $timeout < 0.01;
1287 # No hosts left to wait for
1293 while ( keys %{ $self->{"syn"} } and
1294 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout)) {
1295 # Done waiting for one of the ACKs
1296 if (!sysread($self->{"fork_rd"}, $_, 16)) {
1297 # Socket closed, which means all children are done.
1300 my ($pid, $how) = split;
1304 if (my $entry = $self->{"syn"}->{$pid}) {
1305 # Connection attempt to remote host is done
1306 delete $self->{"syn"}->{$pid};
1307 if (!$how || # If there was no error connecting
1308 (!$self->{"econnrefused"} &&
1309 $how == ECONNREFUSED)) { # "Connection refused" means reachable
1310 if ($host && $entry->[0] ne $host) {
1311 # A good connection, but not the host we need.
1312 # Move it from the "syn" hash to the "good" hash.
1313 $self->{"good"}->{$entry->[0]} = $entry;
1314 # And wait for the next winner
1317 return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
1320 # Should never happen
1321 die "Unknown ping from pid [$pid]";
1324 die "Empty response from status socket?";
1327 if (defined $nfound) {
1328 # Timed out waiting for ACK status
1330 # Weird error occurred with select()
1334 if (my @synners = keys %{ $self->{"syn"} }) {
1335 # Kill all the synners
1337 foreach my $pid (@synners) {
1338 # Wait for the deaths to finish
1339 # Then flush off the zombie
1343 $self->{"syn"} = {};
1347 # Description: Tell why the ack() failed
1350 my $host = shift || croak('Usage> nack($failed_ack_host)');
1351 return $self->{"bad"}->{$host} || undef;
1354 # Description: Close the connection.
1360 if ($self->{"proto"} eq "syn") {
1361 delete $self->{"syn"};
1362 } elsif ($self->{"proto"} eq "tcp") {
1363 # The connection will already be closed
1365 $self->{"fh"}->close();
1375 Net::Ping - check a remote host for reachability
1381 $p = Net::Ping->new();
1382 print "$host is alive.\n" if $p->ping($host);
1385 $p = Net::Ping->new("icmp");
1386 $p->bind($my_addr); # Specify source interface of pings
1387 foreach $host (@host_array)
1390 print "NOT " unless $p->ping($host, 2);
1391 print "reachable.\n";
1396 $p = Net::Ping->new("tcp", 2);
1397 # Try connecting to the www port instead of the echo port
1398 $p->{port_num} = getservbyname("http", "tcp");
1399 while ($stop_time > time())
1401 print "$host not reachable ", scalar(localtime()), "\n"
1402 unless $p->ping($host);
1407 # Like tcp protocol, but with many hosts
1408 $p = Net::Ping->new("syn");
1409 $p->{port_num} = getservbyname("http", "tcp");
1410 foreach $host (@host_array) {
1413 while (($host,$rtt,$ip) = $p->ack) {
1414 print "HOST: $host [$ip] ACKed in $rtt seconds.\n";
1417 # High precision syntax (requires Time::HiRes)
1418 $p = Net::Ping->new();
1420 ($ret, $duration, $ip) = $p->ping($host, 5.5);
1421 printf("$host [ip: $ip] is alive (packet return time: %.2f ms)\n", 1000 * $duration)
1425 # For backward compatibility
1426 print "$host is alive.\n" if pingecho($host);
1430 This module contains methods to test the reachability of remote
1431 hosts on a network. A ping object is first created with optional
1432 parameters, a variable number of hosts may be pinged multiple
1433 times and then the connection is closed.
1435 You may choose one of six different protocols to use for the
1436 ping. The "tcp" protocol is the default. Note that a live remote host
1437 may still fail to be pingable by one or more of these protocols. For
1438 example, www.microsoft.com is generally alive but not "icmp" pingable.
1440 With the "tcp" protocol the ping() method attempts to establish a
1441 connection to the remote host's echo port. If the connection is
1442 successfully established, the remote host is considered reachable. No
1443 data is actually echoed. This protocol does not require any special
1444 privileges but has higher overhead than the "udp" and "icmp" protocols.
1446 Specifying the "udp" protocol causes the ping() method to send a udp
1447 packet to the remote host's echo port. If the echoed packet is
1448 received from the remote host and the received packet contains the
1449 same data as the packet that was sent, the remote host is considered
1450 reachable. This protocol does not require any special privileges.
1451 It should be borne in mind that, for a udp ping, a host
1452 will be reported as unreachable if it is not running the
1453 appropriate echo service. For Unix-like systems see L<inetd(8)>
1454 for more information.
1456 If the "icmp" protocol is specified, the ping() method sends an icmp
1457 echo message to the remote host, which is what the UNIX ping program
1458 does. If the echoed message is received from the remote host and
1459 the echoed information is correct, the remote host is considered
1460 reachable. Specifying the "icmp" protocol requires that the program
1461 be run as root or that the program be setuid to root.
1463 If the "external" protocol is specified, the ping() method attempts to
1464 use the C<Net::Ping::External> module to ping the remote host.
1465 C<Net::Ping::External> interfaces with your system's default C<ping>
1466 utility to perform the ping, and generally produces relatively
1467 accurate results. If C<Net::Ping::External> if not installed on your
1468 system, specifying the "external" protocol will result in an error.
1470 If the "syn" protocol is specified, the ping() method will only
1471 send a TCP SYN packet to the remote host then immediately return.
1472 If the syn packet was sent successfully, it will return a true value,
1473 otherwise it will return false. NOTE: Unlike the other protocols,
1474 the return value does NOT determine if the remote host is alive or
1475 not since the full TCP three-way handshake may not have completed
1476 yet. The remote host is only considered reachable if it receives
1477 a TCP ACK within the timeout specified. To begin waiting for the
1478 ACK packets, use the ack() method as explained below. Use the
1479 "syn" protocol instead the "tcp" protocol to determine reachability
1480 of multiple destinations simultaneously by sending parallel TCP
1481 SYN packets. It will not block while testing each remote host.
1482 demo/fping is provided in this distribution to demonstrate the
1483 "syn" protocol as an example.
1484 This protocol does not require any special privileges.
1490 =item Net::Ping->new([$proto [, $def_timeout [, $bytes [, $device [, $tos ]]]]]);
1492 Create a new ping object. All of the parameters are optional. $proto
1493 specifies the protocol to use when doing a ping. The current choices
1494 are "tcp", "udp", "icmp", "stream", "syn", or "external".
1495 The default is "tcp".
1497 If a default timeout ($def_timeout) in seconds is provided, it is used
1498 when a timeout is not given to the ping() method (below). The timeout
1499 must be greater than 0 and the default, if not specified, is 5 seconds.
1501 If the number of data bytes ($bytes) is given, that many data bytes
1502 are included in the ping packet sent to the remote host. The number of
1503 data bytes is ignored if the protocol is "tcp". The minimum (and
1504 default) number of data bytes is 1 if the protocol is "udp" and 0
1505 otherwise. The maximum number of data bytes that can be specified is
1508 If $device is given, this device is used to bind the source endpoint
1509 before sending the ping packet. I believe this only works with
1510 superuser privileges and with udp and icmp protocols at this time.
1512 If $tos is given, this ToS is configured into the socket.
1514 =item $p->ping($host [, $timeout]);
1516 Ping the remote host and wait for a response. $host can be either the
1517 hostname or the IP number of the remote host. The optional timeout
1518 must be greater than 0 seconds and defaults to whatever was specified
1519 when the ping object was created. Returns a success flag. If the
1520 hostname cannot be found or there is a problem with the IP number, the
1521 success flag returned will be undef. Otherwise, the success flag will
1522 be 1 if the host is reachable and 0 if it is not. For most practical
1523 purposes, undef and 0 and can be treated as the same case. In array
1524 context, the elapsed time as well as the string form of the ip the
1525 host resolved to are also returned. The elapsed time value will
1526 be a float, as retuned by the Time::HiRes::time() function, if hires()
1527 has been previously called, otherwise it is returned as an integer.
1529 =item $p->source_verify( { 0 | 1 } );
1531 Allows source endpoint verification to be enabled or disabled.
1532 This is useful for those remote destinations with multiples
1533 interfaces where the response may not originate from the same
1534 endpoint that the original destination endpoint was sent to.
1535 This only affects udp and icmp protocol pings.
1537 This is enabled by default.
1539 =item $p->service_check( { 0 | 1 } );
1541 Set whether or not the connect behavior should enforce
1542 remote service availability as well as reachability. Normally,
1543 if the remote server reported ECONNREFUSED, it must have been
1544 reachable because of the status packet that it reported.
1545 With this option enabled, the full three-way tcp handshake
1546 must have been established successfully before it will
1547 claim it is reachable. NOTE: It still does nothing more
1548 than connect and disconnect. It does not speak any protocol
1549 (i.e., HTTP or FTP) to ensure the remote server is sane in
1550 any way. The remote server CPU could be grinding to a halt
1551 and unresponsive to any clients connecting, but if the kernel
1552 throws the ACK packet, it is considered alive anyway. To
1553 really determine if the server is responding well would be
1554 application specific and is beyond the scope of Net::Ping.
1555 For udp protocol, enabling this option demands that the
1556 remote server replies with the same udp data that it was sent
1557 as defined by the udp echo service.
1559 This affects the "udp", "tcp", and "syn" protocols.
1561 This is disabled by default.
1563 =item $p->tcp_service_check( { 0 | 1 } );
1565 Deprecated method, but does the same as service_check() method.
1567 =item $p->hires( { 0 | 1 } );
1569 Causes this module to use Time::HiRes module, allowing milliseconds
1570 to be returned by subsequent calls to ping().
1572 This is disabled by default.
1574 =item $p->bind($local_addr);
1576 Sets the source address from which pings will be sent. This must be
1577 the address of one of the interfaces on the local host. $local_addr
1578 may be specified as a hostname or as a text IP address such as
1581 If the protocol is set to "tcp", this method may be called any
1582 number of times, and each call to the ping() method (below) will use
1583 the most recent $local_addr. If the protocol is "icmp" or "udp",
1584 then bind() must be called at most once per object, and (if it is
1585 called at all) must be called before the first call to ping() for that
1588 =item $p->open($host);
1590 When you are using the "stream" protocol, this call pre-opens the
1591 tcp socket. It's only necessary to do this if you want to
1592 provide a different timeout when creating the connection, or
1593 remove the overhead of establishing the connection from the
1594 first ping. If you don't call C<open()>, the connection is
1595 automatically opened the first time C<ping()> is called.
1596 This call simply does nothing if you are using any protocol other
1599 =item $p->ack( [ $host ] );
1601 When using the "syn" protocol, use this method to determine
1602 the reachability of the remote host. This method is meant
1603 to be called up to as many times as ping() was called. Each
1604 call returns the host (as passed to ping()) that came back
1605 with the TCP ACK. The order in which the hosts are returned
1606 may not necessarily be the same order in which they were
1607 SYN queued using the ping() method. If the timeout is
1608 reached before the TCP ACK is received, or if the remote
1609 host is not listening on the port attempted, then the TCP
1610 connection will not be established and ack() will return
1611 undef. In list context, the host, the ack time, and the
1612 dotted ip string will be returned instead of just the host.
1613 If the optional $host argument is specified, the return
1614 value will be pertaining to that host only.
1615 This call simply does nothing if you are using any protocol
1618 =item $p->nack( $failed_ack_host );
1620 The reason that host $failed_ack_host did not receive a
1621 valid ACK. Useful to find out why when ack( $fail_ack_host )
1622 returns a false value.
1626 Close the network connection for this ping object. The network
1627 connection is also closed by "undef $p". The network connection is
1628 automatically closed if the ping object goes out of scope (e.g. $p is
1629 local to a subroutine and you leave the subroutine).
1631 =item pingecho($host [, $timeout]);
1633 To provide backward compatibility with the previous version of
1634 Net::Ping, a pingecho() subroutine is available with the same
1635 functionality as before. pingecho() uses the tcp protocol. The
1636 return values and parameters are the same as described for the ping()
1637 method. This subroutine is obsolete and may be removed in a future
1638 version of Net::Ping.
1644 There will be less network overhead (and some efficiency in your
1645 program) if you specify either the udp or the icmp protocol. The tcp
1646 protocol will generate 2.5 times or more traffic for each ping than
1647 either udp or icmp. If many hosts are pinged frequently, you may wish
1648 to implement a small wait (e.g. 25ms or more) between each ping to
1649 avoid flooding your network with packets.
1651 The icmp protocol requires that the program be run as root or that it
1652 be setuid to root. The other protocols do not require special
1653 privileges, but not all network devices implement tcp or udp echo.
1655 Local hosts should normally respond to pings within milliseconds.
1656 However, on a very congested network it may take up to 3 seconds or
1657 longer to receive an echo packet from the remote host. If the timeout
1658 is set too low under these conditions, it will appear that the remote
1659 host is not reachable (which is almost the truth).
1661 Reachability doesn't necessarily mean that the remote host is actually
1662 functioning beyond its ability to echo packets. tcp is slightly better
1663 at indicating the health of a system than icmp because it uses more
1664 of the networking stack to respond.
1666 Because of a lack of anything better, this module uses its own
1667 routines to pack and unpack ICMP packets. It would be better for a
1668 separate module to be written which understands all of the different
1669 kinds of ICMP packets.
1673 The latest source tree is available via cvs:
1675 cvs -z3 -q -d :pserver:anonymous@cvs.roobik.com.:/usr/local/cvsroot/freeware checkout Net-Ping
1678 The tarball can be created as follows:
1680 perl Makefile.PL ; make ; make dist
1682 The latest Net::Ping release can be found at CPAN:
1684 $CPAN/modules/by-module/Net/
1686 1) Extract the tarball
1688 gtar -zxvf Net-Ping-xxxx.tar.gz
1702 Or install it RPM Style:
1704 rpm -ta SOURCES/Net-Ping-xxxx.tar.gz
1706 rpm -ih RPMS/noarch/perl-Net-Ping-xxxx.rpm
1710 For a list of known issues, visit:
1712 https://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Ping
1714 To report a new bug, visit:
1716 https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-Ping
1721 bbb@cpan.org (Rob Brown)
1724 colinm@cpan.org (Colin McMillen)
1727 bronson@trestle.com (Scott Bronson)
1729 Original pingecho():
1730 karrer@bernina.ethz.ch (Andreas Karrer)
1731 pmarquess@bfsec.bt.co.uk (Paul Marquess)
1733 Original Net::Ping author:
1734 mose@ns.ccsn.edu (Russell Mosemann)
1738 Copyright (c) 2002-2003, Rob Brown. All rights reserved.
1740 Copyright (c) 2001, Colin McMillen. All rights reserved.
1742 This program is free software; you may redistribute it and/or
1743 modify it under the same terms as Perl itself.
1745 $Id: Ping.pm,v 1.86 2003/06/27 21:31:07 rob Exp $