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);
23 $def_timeout = 5; # Default timeout to wait for a reply
24 $def_proto = "tcp"; # Default protocol to use for pinging
25 $def_factor = 1.2; # Default exponential backoff rate.
26 $max_datasize = 1024; # Maximum data bytes in a packet
27 # The data we exchange with the server for the stream protocol
28 $pingstring = "pingschwingping!\n";
29 $source_verify = 1; # Default is to verify source endpoint
32 if ($^O =~ /Win32/i) {
33 # Hack to avoid this Win32 spewage:
34 # Your vendor has not defined POSIX macro ECONNREFUSED
35 *ECONNREFUSED = sub {10061;}; # "Unknown Error" Special Win32 Response?
36 *ENOTCONN = sub {10057;};
37 *ECONNRESET = sub {10054;};
38 *EINPROGRESS = sub {10036;};
39 *EWOULDBLOCK = sub {10035;};
40 # $syn_forking = 1; # XXX possibly useful in < Win2K ?
44 # require "asm/socket.ph";
45 sub SO_BINDTODEVICE {25;}
47 # Description: The pingecho() subroutine is provided for backward
48 # compatibility with the original Net::Ping. It accepts a host
49 # name/IP and an optional timeout in seconds. Create a tcp ping
50 # object and try pinging the host. The result of the ping is returned.
54 my ($host, # Name or IP number of host to ping
55 $timeout # Optional timeout in seconds
57 my ($p); # A ping object
59 $p = Net::Ping->new("tcp", $timeout);
60 $p->ping($host); # Going out of scope closes the connection
63 # Description: The new() method creates a new ping object. Optional
64 # parameters may be specified for the protocol to use, the timeout in
65 # seconds and the size in bytes of additional data which should be
66 # included in the packet.
67 # After the optional parameters are checked, the data is constructed
68 # and a socket is opened if appropriate. The object is returned.
73 $proto, # Optional protocol to use for pinging
74 $timeout, # Optional timeout in seconds
75 $data_size, # Optional additional bytes of data
76 $device, # Optional device to use
78 my $class = ref($this) || $this;
80 my ($cnt, # Count through data bytes
81 $min_datasize # Minimum data bytes required
86 $proto = $def_proto unless $proto; # Determine the protocol
87 croak('Protocol for ping must be "icmp", "udp", "tcp", "syn", "stream", or "external"')
88 unless $proto =~ m/^(icmp|udp|tcp|syn|stream|external)$/;
89 $self->{"proto"} = $proto;
91 $timeout = $def_timeout unless $timeout; # Determine the timeout
92 croak("Default timeout for ping must be greater than 0 seconds")
94 $self->{"timeout"} = $timeout;
96 $self->{"device"} = $device;
98 $min_datasize = ($proto eq "udp") ? 1 : 0; # Determine data size
99 $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
100 croak("Data for ping must be from $min_datasize to $max_datasize bytes")
101 if ($data_size < $min_datasize) || ($data_size > $max_datasize);
102 $data_size-- if $self->{"proto"} eq "udp"; # We provide the first byte
103 $self->{"data_size"} = $data_size;
105 $self->{"data"} = ""; # Construct data bytes
106 for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
108 $self->{"data"} .= chr($cnt % 256);
111 $self->{"local_addr"} = undef; # Don't bind by default
112 $self->{"retrans"} = $def_factor; # Default exponential backoff rate
113 $self->{"econnrefused"} = undef; # Default Connection refused behavior
115 $self->{"seq"} = 0; # For counting packets
116 if ($self->{"proto"} eq "udp") # Open a socket
118 $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
119 croak("Can't udp protocol by name");
120 $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
121 croak("Can't get udp echo port by name");
122 $self->{"fh"} = FileHandle->new();
123 socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
124 $self->{"proto_num"}) ||
125 croak("udp socket error - $!");
126 if ($self->{'device'}) {
127 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
128 or croak "error binding to device $self->{'device'} $!";
131 elsif ($self->{"proto"} eq "icmp")
133 croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS' and $^O ne 'cygwin');
134 $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
135 croak("Can't get icmp protocol by name");
136 $self->{"pid"} = $$ & 0xffff; # Save lower 16 bits of pid
137 $self->{"fh"} = FileHandle->new();
138 socket($self->{"fh"}, PF_INET, SOCK_RAW, $self->{"proto_num"}) ||
139 croak("icmp socket error - $!");
140 if ($self->{'device'}) {
141 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
142 or croak "error binding to device $self->{'device'} $!";
145 elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
147 $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
148 croak("Can't get tcp protocol by name");
149 $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
150 croak("Can't get tcp echo port by name");
151 $self->{"fh"} = FileHandle->new();
153 elsif ($self->{"proto"} eq "syn")
155 $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
156 croak("Can't get tcp protocol by name");
157 $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
158 croak("Can't get tcp echo port by name");
160 $self->{"fork_rd"} = FileHandle->new();
161 $self->{"fork_wr"} = FileHandle->new();
162 pipe($self->{"fork_rd"}, $self->{"fork_wr"});
163 $self->{"fh"} = FileHandle->new();
164 $self->{"good"} = {};
167 $self->{"wbits"} = "";
171 $self->{"stop_time"} = 0;
173 elsif ($self->{"proto"} eq "external")
175 # No preliminary work needs to be done.
181 # Description: Set the local IP address from which pings will be sent.
182 # For ICMP and UDP pings, this calls bind() on the already-opened socket;
183 # for TCP pings, just saves the address to be used when the socket is
184 # opened. Returns non-zero if successful; croaks on error.
188 $local_addr # Name or IP number of local interface
190 my ($ip # Packed IP number of $local_addr
193 croak("Usage: \$p->bind(\$local_addr)") unless @_ == 2;
194 croak("already bound") if defined($self->{"local_addr"}) &&
195 ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp");
197 $ip = inet_aton($local_addr);
198 croak("nonexistent local address $local_addr") unless defined($ip);
199 $self->{"local_addr"} = $ip; # Only used if proto is tcp
201 if ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp")
203 CORE::bind($self->{"fh"}, sockaddr_in(0, $ip)) ||
204 croak("$self->{'proto'} bind error - $!");
206 elsif ($self->{"proto"} ne "tcp")
208 croak("Unknown protocol \"$self->{proto}\" in bind()");
214 # Description: A select() wrapper that compensates for platform
218 if ($_[3] > 0 and $^O eq 'MSWin32') {
219 # On windows, select() doesn't process the message loop,
220 # but sleep() will, allowing alarm() to interrupt the latter.
221 # So we chop up the timeout into smaller pieces and interleave
222 # select() and sleep() calls.
224 my $gran = 0.5; # polling granularity in seconds
227 $gran = $t if $gran > $t;
228 my $nfound = select($_[0], $_[1], $_[2], $gran);
230 return $nfound if $nfound or !defined($nfound) or $t <= 0;
233 ($_[0], $_[1], $_[2]) = @args;
237 return select($_[0], $_[1], $_[2], $_[3]);
241 # Description: Allow UDP source endpoint comparision to be
242 # skipped for those remote interfaces that do
243 # not response from the same endpoint.
248 $source_verify = 1 unless defined
249 ($source_verify = ((defined $self) && (ref $self)) ? shift() : $self);
252 # Description: Set whether or not the connect
253 # behavior should enforce remote service
254 # availability as well as reachability.
259 $self->{"econnrefused"} = 1 unless defined
260 ($self->{"econnrefused"} = shift());
263 sub tcp_service_check
268 # Description: Set exponential backoff for retransmission.
269 # Should be > 1 to retain exponential properties.
270 # If set to 0, retransmissions are disabled.
275 $self->{"retrans"} = shift;
278 # Description: allows the module to use milliseconds as returned by
279 # the Time::HiRes module
285 $hires = 1 unless defined
286 ($hires = ((defined $self) && (ref $self)) ? shift() : $self);
287 require Time::HiRes if $hires;
292 return $hires ? Time::HiRes::time() : CORE::time();
295 # Description: Sets or clears the O_NONBLOCK flag on a file handle.
296 sub socket_blocking_mode
299 $fh, # the file handle whose flags are to be modified
300 $block) = @_; # if true then set the blocking
301 # mode (clear O_NONBLOCK), otherwise
302 # set the non-blocking mode (set O_NONBLOCK)
305 if ($^O eq 'MSWin32') {
306 # FIONBIO enables non-blocking sockets on windows.
307 # FIONBIO is (0x80000000|(4<<16)|(ord('f')<<8)|126), as per winsock.h.
309 my $v = pack("L", $block ? 0 : 1);
310 ioctl($fh, $f, $v) or croak("ioctl failed: $!");
313 if ($flags = fcntl($fh, F_GETFL, 0)) {
314 $flags = $block ? ($flags & ~O_NONBLOCK) : ($flags | O_NONBLOCK);
315 if (!fcntl($fh, F_SETFL, $flags)) {
316 croak("fcntl F_SETFL: $!");
319 croak("fcntl F_GETFL: $!");
323 # Description: Ping a host name or IP number with an optional timeout.
324 # First lookup the host, and return undef if it is not found. Otherwise
325 # perform the specific ping method based on the protocol. Return the
326 # result of the ping.
331 $host, # Name or IP number of host to ping
332 $timeout, # Seconds after which ping times out
334 my ($ip, # Packed IP number of $host
335 $ret, # The return value
336 $ping_time, # When ping began
339 croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
340 $timeout = $self->{"timeout"} unless $timeout;
341 croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
343 $ip = inet_aton($host);
344 return () unless defined($ip); # Does host exist?
346 # Dispatch to the appropriate routine.
347 $ping_time = &time();
348 if ($self->{"proto"} eq "external") {
349 $ret = $self->ping_external($ip, $timeout);
351 elsif ($self->{"proto"} eq "udp") {
352 $ret = $self->ping_udp($ip, $timeout);
354 elsif ($self->{"proto"} eq "icmp") {
355 $ret = $self->ping_icmp($ip, $timeout);
357 elsif ($self->{"proto"} eq "tcp") {
358 $ret = $self->ping_tcp($ip, $timeout);
360 elsif ($self->{"proto"} eq "stream") {
361 $ret = $self->ping_stream($ip, $timeout);
363 elsif ($self->{"proto"} eq "syn") {
364 $ret = $self->ping_syn($host, $ip, $ping_time, $ping_time+$timeout);
366 croak("Unknown protocol \"$self->{proto}\" in ping()");
369 return wantarray ? ($ret, &time() - $ping_time, inet_ntoa($ip)) : $ret;
372 # Uses Net::Ping::External to do an external ping.
375 $ip, # Packed IP number of the host
376 $timeout # Seconds after which ping times out
379 eval { require Net::Ping::External; }
380 or croak('Protocol "external" not supported on your system: Net::Ping::External not found');
381 return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
384 use constant ICMP_ECHOREPLY => 0; # ICMP packet types
385 use constant ICMP_ECHO => 8;
386 use constant ICMP_STRUCT => "C2 n3 A"; # Structure of a minimal ICMP packet
387 use constant SUBCODE => 0; # No ICMP subcode for ECHO and ECHOREPLY
388 use constant ICMP_FLAGS => 0; # No special flags for send or recv
389 use constant ICMP_PORT => 0; # No port with ICMP
394 $ip, # Packed IP number of the host
395 $timeout # Seconds after which ping times out
398 my ($saddr, # sockaddr_in with port and ip
399 $checksum, # Checksum of ICMP packet
400 $msg, # ICMP packet to send
401 $len_msg, # Length of $msg
402 $rbits, # Read bits, filehandles for reading
403 $nfound, # Number of ready filehandles found
404 $finish_time, # Time ping should be finished
405 $done, # set to 1 when we are done
407 $recv_msg, # Received message including IP header
408 $from_saddr, # sockaddr_in of sender
409 $from_port, # Port packet was sent from
410 $from_ip, # Packed IP of sender
411 $from_type, # ICMP type
412 $from_subcode, # ICMP subcode
413 $from_chk, # ICMP packet checksum
414 $from_pid, # ICMP packet id
415 $from_seq, # ICMP packet sequence
416 $from_msg # ICMP message
419 $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
420 $checksum = 0; # No checksum for starters
421 $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
422 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
423 $checksum = Net::Ping->checksum($msg);
424 $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
425 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
426 $len_msg = length($msg);
427 $saddr = sockaddr_in(ICMP_PORT, $ip);
428 $self->{"from_ip"} = undef;
429 $self->{"from_type"} = undef;
430 $self->{"from_subcode"} = undef;
431 send($self->{"fh"}, $msg, ICMP_FLAGS, $saddr); # Send the message
434 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
437 $finish_time = &time() + $timeout; # Must be done by this time
438 while (!$done && $timeout > 0) # Keep trying if we have time
440 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for packet
441 $timeout = $finish_time - &time(); # Get remaining time
442 if (!defined($nfound)) # Hmm, a strange error
447 elsif ($nfound) # Got a packet from somewhere
452 $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, ICMP_FLAGS);
453 ($from_port, $from_ip) = sockaddr_in($from_saddr);
454 ($from_type, $from_subcode) = unpack("C2", substr($recv_msg, 20, 2));
455 if ($from_type == ICMP_ECHOREPLY) {
456 ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 24, 4))
457 if length $recv_msg >= 28;
459 ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 52, 4))
460 if length $recv_msg >= 56;
462 $self->{"from_ip"} = $from_ip;
463 $self->{"from_type"} = $from_type;
464 $self->{"from_subcode"} = $from_subcode;
465 if (($from_pid == $self->{"pid"}) && # Does the packet check out?
466 ($from_seq == $self->{"seq"})) {
467 if ($from_type == ICMP_ECHOREPLY){
472 } else { # Oops, timed out
481 my $ip = $self->{"from_ip"} || "";
482 $ip = "\0\0\0\0" unless 4 == length $ip;
483 return (inet_ntoa($ip),($self->{"from_type"} || 0), ($self->{"from_subcode"} || 0));
486 # Description: Do a checksum on the message. Basically sum all of
487 # the short words and fold the high order bits into the low order bits.
492 $msg # The message to checksum
494 my ($len_msg, # Length of the message
495 $num_short, # The number of short words in the message
496 $short, # One short word
500 $len_msg = length($msg);
501 $num_short = int($len_msg / 2);
503 foreach $short (unpack("n$num_short", $msg))
506 } # Add the odd byte in
507 $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
508 $chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low
509 return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement
513 # Description: Perform a tcp echo ping. Since a tcp connection is
514 # host specific, we have to open and close each connection here. We
515 # can't just leave a socket open. Because of the robust nature of
516 # tcp, it will take a while before it gives up trying to establish a
517 # connection. Therefore, we use select() on a non-blocking socket to
518 # check against our timeout. No data bytes are actually
519 # sent since the successful establishment of a connection is proof
520 # enough of the reachability of the remote host. Also, tcp is
521 # expensive and doesn't need our help to add to the overhead.
526 $ip, # Packed IP number of the host
527 $timeout # Seconds after which ping times out
529 my ($ret # The return value
533 $ret = $self -> tcp_connect( $ip, $timeout);
534 if (!$self->{"econnrefused"} &&
535 $! == ECONNREFUSED) {
536 $ret = 1; # "Connection refused" means reachable
538 $self->{"fh"}->close();
545 $ip, # Packed IP number of the host
546 $timeout # Seconds after which connect times out
548 my ($saddr); # Packed IP and Port
550 $saddr = sockaddr_in($self->{"port_num"}, $ip);
552 my $ret = 0; # Default to unreachable
554 my $do_socket = sub {
555 socket($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"}) ||
556 croak("tcp socket error - $!");
557 if (defined $self->{"local_addr"} &&
558 !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
559 croak("tcp bind error - $!");
561 if ($self->{'device'}) {
562 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
563 or croak("error binding to device $self->{'device'} $!");
566 my $do_connect = sub {
568 # ECONNREFUSED is 10061 on MSWin32. If we pass it as child error through $?,
569 # we'll get (10061 & 255) = 77, so we cannot check it in the parent process.
570 return ($ret = connect($self->{"fh"}, $saddr) || ($! == ECONNREFUSED && !$self->{"econnrefused"}));
572 my $do_connect_nb = sub {
573 # Set O_NONBLOCK property on filehandle
574 $self->socket_blocking_mode($self->{"fh"}, 0);
576 # start the connection attempt
577 if (!connect($self->{"fh"}, $saddr)) {
578 if ($! == ECONNREFUSED) {
579 $ret = 1 unless $self->{"econnrefused"};
580 } elsif ($! != EINPROGRESS && ($^O ne 'MSWin32' || $! != EWOULDBLOCK)) {
581 # EINPROGRESS is the expected error code after a connect()
582 # on a non-blocking socket. But if the kernel immediately
583 # determined that this connect() will never work,
584 # Simply respond with "unreachable" status.
585 # (This can occur on some platforms with errno
586 # EHOSTUNREACH or ENETUNREACH.)
589 # Got the expected EINPROGRESS.
590 # Just wait for connection completion...
591 my ($wbits, $wout, $wexc);
592 $wout = $wexc = $wbits = "";
593 vec($wbits, $self->{"fh"}->fileno, 1) = 1;
595 my $nfound = mselect(undef,
597 ($^O eq 'MSWin32' ? ($wexc = $wbits) : undef),
599 warn("select: $!") unless defined $nfound;
601 if ($nfound && vec($wout, $self->{"fh"}->fileno, 1)) {
602 # the socket is ready for writing so the connection
603 # attempt completed. test whether the connection
604 # attempt was successful or not
606 if (getpeername($self->{"fh"})) {
607 # Connection established to remote host
610 # TCP ACK will never come from this host
611 # because there was an error connecting.
613 # This should set $! to the correct error.
615 sysread($self->{"fh"},$char,1);
616 $! = ECONNREFUSED if ($! == EAGAIN && $^O =~ /cygwin/i);
618 $ret = 1 if (!$self->{"econnrefused"}
619 && $! == ECONNREFUSED);
622 # the connection attempt timed out (or there were connect
624 if ($^O =~ 'MSWin32') {
625 # If the connect will fail on a non-blocking socket,
626 # winsock reports ECONNREFUSED as an exception, and we
627 # need to fetch the socket-level error code via getsockopt()
628 # instead of using the thread-level error code that is in $!.
629 if ($nfound && vec($wexc, $self->{"fh"}->fileno, 1)) {
630 $! = unpack("i", getsockopt($self->{"fh"}, SOL_SOCKET,
637 # Connection established to remote host
641 # Unset O_NONBLOCK property on filehandle
642 $self->socket_blocking_mode($self->{"fh"}, 1);
648 # Buggy Winsock API doesn't allow nonblocking connect.
649 # Hence, if our OS is Windows, we need to create a separate
650 # process to do the blocking connect attempt.
651 # XXX Above comments are not true at least for Win2K, where
652 # nonblocking connect works.
654 $| = 1; # Clear buffer prior to fork to prevent duplicate flushing.
655 $self->{'tcp_chld'} = fork;
656 if (!$self->{'tcp_chld'}) {
657 if (!defined $self->{'tcp_chld'}) {
659 warn "Fork error: $!";
664 # Try a slow blocking connect() call
665 # and report the status to the parent.
666 if ( &{ $do_connect }() ) {
667 $self->{"fh"}->close();
671 # Pass the error status to the parent
672 # Make sure that $! <= 255
673 exit($! <= 255 ? $! : 255);
679 my $patience = &time() + $timeout;
681 my ($child, $child_errno);
682 $? = 0; $child_errno = 0;
683 # Wait up to the timeout
684 # And clean off the zombie
686 $child = waitpid($self->{'tcp_chld'}, &WNOHANG());
687 $child_errno = $? >> 8;
688 select(undef, undef, undef, 0.1);
689 } while &time() < $patience && $child != $self->{'tcp_chld'};
691 if ($child == $self->{'tcp_chld'}) {
692 if ($self->{"proto"} eq "stream") {
693 # We need the socket connected here, in parent
694 # Should be safe to connect because the child finished
698 # $ret cannot be set by the child process
699 $ret = !$child_errno;
701 # Time must have run out.
702 # Put that choking client out of its misery
703 kill "KILL", $self->{'tcp_chld'};
704 # Clean off the zombie
705 waitpid($self->{'tcp_chld'}, 0);
708 delete $self->{'tcp_chld'};
711 # Otherwise don't waste the resources to fork
715 &{ $do_connect_nb }();
723 if ($self->{'proto'} eq 'tcp' &&
724 $self->{'tcp_chld'}) {
725 # Put that choking client out of its misery
726 kill "KILL", $self->{'tcp_chld'};
727 # Clean off the zombie
728 waitpid($self->{'tcp_chld'}, 0);
732 # This writes the given string to the socket and then reads it
733 # back. It returns 1 on success, 0 on failure.
738 my $pingstring = shift;
742 my $wrstr = $pingstring;
748 vec($rin, $self->{"fh"}->fileno(), 1) = 1;
753 vec($rout, $self->{"fh"}->fileno(), 1) = 1;
756 if(mselect($rin, $rout, undef, ($time + $timeout) - &time())) {
758 if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
759 my $num = syswrite($self->{"fh"}, $wrstr, length $wrstr);
761 # If it was a partial write, update and try again.
762 $wrstr = substr($wrstr,$num);
764 # There was an error.
769 if(vec($rin,$self->{"fh"}->fileno(),1)) {
771 if(sysread($self->{"fh"},$reply,length($pingstring)-length($rdstr))) {
773 $ret = 1 if $rdstr eq $pingstring;
775 # There was an error.
781 } until &time() > ($time + $timeout) || defined($ret);
790 # Description: Perform a stream ping. If the tcp connection isn't
791 # already open, it opens it. It then sends some data and waits for
792 # a reply. It leaves the stream open on exit.
797 $ip, # Packed IP number of the host
798 $timeout # Seconds after which ping times out
801 # Open the stream if it's not already open
802 if(!defined $self->{"fh"}->fileno()) {
803 $self->tcp_connect($ip, $timeout) or return 0;
806 croak "tried to switch servers while stream pinging"
807 if $self->{"ip"} ne $ip;
809 return $self->tcp_echo($timeout, $pingstring);
812 # Description: opens the stream. You would do this if you want to
813 # separate the overhead of opening the stream from the first ping.
818 $host, # Host or IP address
819 $timeout # Seconds after which open times out
822 my ($ip); # Packed IP number of the host
823 $ip = inet_aton($host);
824 $timeout = $self->{"timeout"} unless $timeout;
826 if($self->{"proto"} eq "stream") {
827 if(defined($self->{"fh"}->fileno())) {
828 croak("socket is already open");
830 $self->tcp_connect($ip, $timeout);
836 # Description: Perform a udp echo ping. Construct a message of
837 # at least the one-byte sequence number and any additional data bytes.
838 # Send the message out and wait for a message to come back. If we
839 # get a message, make sure all of its parts match. If they do, we are
840 # done. Otherwise go back and wait for the message until we run out
841 # of time. Return the result of our efforts.
843 use constant UDP_FLAGS => 0; # Nothing special on send or recv
847 $ip, # Packed IP number of the host
848 $timeout # Seconds after which ping times out
851 my ($saddr, # sockaddr_in with port and ip
852 $ret, # The return value
853 $msg, # Message to be echoed
854 $finish_time, # Time ping should be finished
855 $flush, # Whether socket needs to be disconnected
856 $connect, # Whether socket needs to be connected
857 $done, # Set to 1 when we are done pinging
858 $rbits, # Read bits, filehandles for reading
859 $nfound, # Number of ready filehandles found
860 $from_saddr, # sockaddr_in of sender
861 $from_msg, # Characters echoed by $host
862 $from_port, # Port message was echoed from
863 $from_ip # Packed IP number of sender
866 $saddr = sockaddr_in($self->{"port_num"}, $ip);
867 $self->{"seq"} = ($self->{"seq"} + 1) % 256; # Increment sequence
868 $msg = chr($self->{"seq"}) . $self->{"data"}; # Add data if any
870 if ($self->{"connected"}) {
871 if ($self->{"connected"} ne $saddr) {
872 # Still connected to wrong destination.
873 # Need to flush out the old one.
878 # Need to connect() before send()
882 # Have to connect() and send() instead of sendto()
883 # in order to pick up on the ECONNREFUSED setting
884 # from recv() or double send() errno as utilized in
885 # the concept by rdw @ perlmonks. See:
886 # http://perlmonks.thepen.com/42898.html
888 # Need to socket() again to flush the descriptor
889 # This will disconnect from the old saddr.
890 socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
891 $self->{"proto_num"});
893 # Connect the socket if it isn't already connected
894 # to the right destination.
895 if ($flush || $connect) {
896 connect($self->{"fh"}, $saddr); # Tie destination to socket
897 $self->{"connected"} = $saddr;
899 send($self->{"fh"}, $msg, UDP_FLAGS); # Send it
902 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
903 $ret = 0; # Default to unreachable
906 my $factor = $self->{"retrans"};
907 $finish_time = &time() + $timeout; # Ping needs to be done by then
908 while (!$done && $timeout > 0)
912 $timeout = $retrans if $timeout > $retrans;
913 $retrans*= $factor; # Exponential backoff
915 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for response
917 $timeout = $finish_time - &time(); # Get remaining time
919 if (!defined($nfound)) # Hmm, a strange error
924 elsif ($nfound) # A packet is waiting
927 $from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS);
929 # For example an unreachable host will make recv() fail.
930 if (!$self->{"econnrefused"} &&
931 ($! == ECONNREFUSED ||
933 # "Connection refused" means reachable
939 ($from_port, $from_ip) = sockaddr_in($from_saddr);
940 if (!$source_verify ||
941 (($from_ip eq $ip) && # Does the packet check out?
942 ($from_port == $self->{"port_num"}) &&
943 ($from_msg eq $msg)))
945 $ret = 1; # It's a winner
950 elsif ($timeout <= 0) # Oops, timed out
956 # Send another in case the last one dropped
957 if (send($self->{"fh"}, $msg, UDP_FLAGS)) {
958 # Another send worked? The previous udp packet
959 # must have gotten lost or is still in transit.
960 # Hopefully this new packet will arrive safely.
962 if (!$self->{"econnrefused"} &&
963 $! == ECONNREFUSED) {
964 # "Connection refused" means reachable
975 # Description: Send a TCP SYN packet to host specified.
981 my $start_time = shift;
982 my $stop_time = shift;
985 return $self->ping_syn_fork($host, $ip, $start_time, $stop_time);
988 my $fh = FileHandle->new();
989 my $saddr = sockaddr_in($self->{"port_num"}, $ip);
992 if (!socket ($fh, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
993 croak("tcp socket error - $!");
996 if (defined $self->{"local_addr"} &&
997 !CORE::bind($fh, sockaddr_in(0, $self->{"local_addr"}))) {
998 croak("tcp bind error - $!");
1001 if ($self->{'device'}) {
1002 setsockopt($fh, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
1003 or croak("error binding to device $self->{'device'} $!");
1006 # Set O_NONBLOCK property on filehandle
1007 $self->socket_blocking_mode($fh, 0);
1009 # Attempt the non-blocking connect
1010 # by just sending the TCP SYN packet
1011 if (connect($fh, $saddr)) {
1012 # Non-blocking, yet still connected?
1013 # Must have connected very quickly,
1014 # or else it wasn't very non-blocking.
1015 #warn "WARNING: Nonblocking connect connected anyway? ($^O)";
1017 # Error occurred connecting.
1018 if ($! == EINPROGRESS || ($^O eq 'MSWin32' && $! == EWOULDBLOCK)) {
1019 # The connection is just still in progress.
1020 # This is the expected condition.
1022 # Just save the error and continue on.
1023 # The ack() can check the status later.
1024 $self->{"bad"}->{$host} = $!;
1028 my $entry = [ $host, $ip, $fh, $start_time, $stop_time ];
1029 $self->{"syn"}->{$fh->fileno} = $entry;
1030 if ($self->{"stop_time"} < $stop_time) {
1031 $self->{"stop_time"} = $stop_time;
1033 vec($self->{"wbits"}, $fh->fileno, 1) = 1;
1039 my ($self, $host, $ip, $start_time, $stop_time) = @_;
1041 # Buggy Winsock API doesn't allow nonblocking connect.
1042 # Hence, if our OS is Windows, we need to create a separate
1043 # process to do the blocking connect attempt.
1048 my $entry = [ $host, $ip, $pid, $start_time, $stop_time ];
1049 $self->{"syn"}->{$pid} = $entry;
1050 if ($self->{"stop_time"} < $stop_time) {
1051 $self->{"stop_time"} = $stop_time;
1055 my $saddr = sockaddr_in($self->{"port_num"}, $ip);
1058 if (!socket ($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
1059 croak("tcp socket error - $!");
1062 if (defined $self->{"local_addr"} &&
1063 !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
1064 croak("tcp bind error - $!");
1067 if ($self->{'device'}) {
1068 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
1069 or croak("error binding to device $self->{'device'} $!");
1073 # Try to connect (could take a long time)
1074 connect($self->{"fh"}, $saddr);
1075 # Notify parent of connect error status
1077 my $wrstr = "$$ $err";
1078 # Force to 16 chars including \n
1079 $wrstr .= " "x(15 - length $wrstr). "\n";
1080 syswrite($self->{"fork_wr"}, $wrstr, length $wrstr);
1090 # Description: Wait for TCP ACK from host specified
1091 # from ping_syn above. If no host is specified, wait
1092 # for TCP ACK from any of the hosts in the SYN queue.
1097 if ($self->{"proto"} eq "syn") {
1099 my @answer = $self->ack_unfork(shift);
1100 return wantarray ? @answer : $answer[0];
1104 if (my $host = shift) {
1105 # Host passed as arg
1106 if (exists $self->{"bad"}->{$host}) {
1107 if (!$self->{"econnrefused"} &&
1108 $self->{"bad"}->{ $host } &&
1109 (($! = ECONNREFUSED)>0) &&
1110 $self->{"bad"}->{ $host } eq "$!") {
1111 # "Connection refused" means reachable
1114 # ECONNREFUSED means no good
1118 my $host_fd = undef;
1119 foreach my $fd (keys %{ $self->{"syn"} }) {
1120 my $entry = $self->{"syn"}->{$fd};
1121 if ($entry->[0] eq $host) {
1123 $stop_time = $entry->[4]
1124 || croak("Corrupted SYN entry for [$host]");
1128 croak("ack called on [$host] without calling ping first!")
1129 unless defined $host_fd;
1130 vec($wbits, $host_fd, 1) = 1;
1132 # No $host passed so scan all hosts
1133 # Use the latest stop_time
1134 $stop_time = $self->{"stop_time"};
1136 $wbits = $self->{"wbits"};
1139 while ($wbits !~ /^\0*\z/) {
1140 my $timeout = $stop_time - &time();
1141 # Force a minimum of 10 ms timeout.
1142 $timeout = 0.01 if $timeout <= 0.01;
1144 my $winner_fd = undef;
1147 # Do "bad" fds from $wbits first
1148 while ($wout !~ /^\0*\z/) {
1149 if (vec($wout, $fd, 1)) {
1150 # Wipe it from future scanning.
1151 vec($wout, $fd, 1) = 0;
1152 if (my $entry = $self->{"syn"}->{$fd}) {
1153 if ($self->{"bad"}->{ $entry->[0] }) {
1162 if (defined($winner_fd) or my $nfound = mselect(undef, ($wout=$wbits), undef, $timeout)) {
1163 if (defined $winner_fd) {
1166 # Done waiting for one of the ACKs
1168 # Determine which one
1169 while ($wout !~ /^\0*\z/ &&
1170 !vec($wout, $fd, 1)) {
1174 if (my $entry = $self->{"syn"}->{$fd}) {
1175 # Wipe it from future scanning.
1176 delete $self->{"syn"}->{$fd};
1177 vec($self->{"wbits"}, $fd, 1) = 0;
1178 vec($wbits, $fd, 1) = 0;
1179 if (!$self->{"econnrefused"} &&
1180 $self->{"bad"}->{ $entry->[0] } &&
1181 (($! = ECONNREFUSED)>0) &&
1182 $self->{"bad"}->{ $entry->[0] } eq "$!") {
1183 # "Connection refused" means reachable
1185 } elsif (getpeername($entry->[2])) {
1186 # Connection established to remote host
1189 # TCP ACK will never come from this host
1190 # because there was an error connecting.
1192 # This should set $! to the correct error.
1194 sysread($entry->[2],$char,1);
1195 # Store the excuse why the connection failed.
1196 $self->{"bad"}->{$entry->[0]} = $!;
1197 if (!$self->{"econnrefused"} &&
1198 (($! == ECONNREFUSED) ||
1199 ($! == EAGAIN && $^O =~ /cygwin/i))) {
1200 # "Connection refused" means reachable
1203 # No good, try the next socket...
1207 # Everything passed okay, return the answer
1209 ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
1212 warn "Corrupted SYN entry: unknown fd [$fd] ready!";
1213 vec($wbits, $fd, 1) = 0;
1214 vec($self->{"wbits"}, $fd, 1) = 0;
1216 } elsif (defined $nfound) {
1217 # Timed out waiting for ACK
1218 foreach my $fd (keys %{ $self->{"syn"} }) {
1219 if (vec($wbits, $fd, 1)) {
1220 my $entry = $self->{"syn"}->{$fd};
1221 $self->{"bad"}->{$entry->[0]} = "Timed out";
1222 vec($wbits, $fd, 1) = 0;
1223 vec($self->{"wbits"}, $fd, 1) = 0;
1224 delete $self->{"syn"}->{$fd};
1228 # Weird error occurred with select()
1230 $self->{"syn"} = {};
1239 my ($self,$host) = @_;
1240 my $stop_time = $self->{"stop_time"};
1242 # Host passed as arg
1243 if (my $entry = $self->{"good"}->{$host}) {
1244 delete $self->{"good"}->{$host};
1245 return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
1252 if (keys %{ $self->{"syn"} }) {
1253 # Scan all hosts that are left
1254 vec($rbits, fileno($self->{"fork_rd"}), 1) = 1;
1255 $timeout = $stop_time - &time();
1256 # Force a minimum of 10 ms timeout.
1257 $timeout = 0.01 if $timeout < 0.01;
1259 # No hosts left to wait for
1265 while ( keys %{ $self->{"syn"} } and
1266 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout)) {
1267 # Done waiting for one of the ACKs
1268 if (!sysread($self->{"fork_rd"}, $_, 16)) {
1269 # Socket closed, which means all children are done.
1272 my ($pid, $how) = split;
1276 if (my $entry = $self->{"syn"}->{$pid}) {
1277 # Connection attempt to remote host is done
1278 delete $self->{"syn"}->{$pid};
1279 if (!$how || # If there was no error connecting
1280 (!$self->{"econnrefused"} &&
1281 $how == ECONNREFUSED)) { # "Connection refused" means reachable
1282 if ($host && $entry->[0] ne $host) {
1283 # A good connection, but not the host we need.
1284 # Move it from the "syn" hash to the "good" hash.
1285 $self->{"good"}->{$entry->[0]} = $entry;
1286 # And wait for the next winner
1289 return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
1292 # Should never happen
1293 die "Unknown ping from pid [$pid]";
1296 die "Empty response from status socket?";
1299 if (defined $nfound) {
1300 # Timed out waiting for ACK status
1302 # Weird error occurred with select()
1306 if (my @synners = keys %{ $self->{"syn"} }) {
1307 # Kill all the synners
1309 foreach my $pid (@synners) {
1310 # Wait for the deaths to finish
1311 # Then flush off the zombie
1315 $self->{"syn"} = {};
1319 # Description: Tell why the ack() failed
1322 my $host = shift || croak('Usage> nack($failed_ack_host)');
1323 return $self->{"bad"}->{$host} || undef;
1326 # Description: Close the connection.
1332 if ($self->{"proto"} eq "syn") {
1333 delete $self->{"syn"};
1334 } elsif ($self->{"proto"} eq "tcp") {
1335 # The connection will already be closed
1337 $self->{"fh"}->close();
1347 Net::Ping - check a remote host for reachability
1353 $p = Net::Ping->new();
1354 print "$host is alive.\n" if $p->ping($host);
1357 $p = Net::Ping->new("icmp");
1358 $p->bind($my_addr); # Specify source interface of pings
1359 foreach $host (@host_array)
1362 print "NOT " unless $p->ping($host, 2);
1363 print "reachable.\n";
1368 $p = Net::Ping->new("tcp", 2);
1369 # Try connecting to the www port instead of the echo port
1370 $p->{port_num} = getservbyname("http", "tcp");
1371 while ($stop_time > time())
1373 print "$host not reachable ", scalar(localtime()), "\n"
1374 unless $p->ping($host);
1379 # Like tcp protocol, but with many hosts
1380 $p = Net::Ping->new("syn");
1381 $p->{port_num} = getservbyname("http", "tcp");
1382 foreach $host (@host_array) {
1385 while (($host,$rtt,$ip) = $p->ack) {
1386 print "HOST: $host [$ip] ACKed in $rtt seconds.\n";
1389 # High precision syntax (requires Time::HiRes)
1390 $p = Net::Ping->new();
1392 ($ret, $duration, $ip) = $p->ping($host, 5.5);
1393 printf("$host [ip: $ip] is alive (packet return time: %.2f ms)\n", 1000 * $duration)
1397 # For backward compatibility
1398 print "$host is alive.\n" if pingecho($host);
1402 This module contains methods to test the reachability of remote
1403 hosts on a network. A ping object is first created with optional
1404 parameters, a variable number of hosts may be pinged multiple
1405 times and then the connection is closed.
1407 You may choose one of six different protocols to use for the
1408 ping. The "tcp" protocol is the default. Note that a live remote host
1409 may still fail to be pingable by one or more of these protocols. For
1410 example, www.microsoft.com is generally alive but not "icmp" pingable.
1412 With the "tcp" protocol the ping() method attempts to establish a
1413 connection to the remote host's echo port. If the connection is
1414 successfully established, the remote host is considered reachable. No
1415 data is actually echoed. This protocol does not require any special
1416 privileges but has higher overhead than the "udp" and "icmp" protocols.
1418 Specifying the "udp" protocol causes the ping() method to send a udp
1419 packet to the remote host's echo port. If the echoed packet is
1420 received from the remote host and the received packet contains the
1421 same data as the packet that was sent, the remote host is considered
1422 reachable. This protocol does not require any special privileges.
1423 It should be borne in mind that, for a udp ping, a host
1424 will be reported as unreachable if it is not running the
1425 appropriate echo service. For Unix-like systems see L<inetd(8)>
1426 for more information.
1428 If the "icmp" protocol is specified, the ping() method sends an icmp
1429 echo message to the remote host, which is what the UNIX ping program
1430 does. If the echoed message is received from the remote host and
1431 the echoed information is correct, the remote host is considered
1432 reachable. Specifying the "icmp" protocol requires that the program
1433 be run as root or that the program be setuid to root.
1435 If the "external" protocol is specified, the ping() method attempts to
1436 use the C<Net::Ping::External> module to ping the remote host.
1437 C<Net::Ping::External> interfaces with your system's default C<ping>
1438 utility to perform the ping, and generally produces relatively
1439 accurate results. If C<Net::Ping::External> if not installed on your
1440 system, specifying the "external" protocol will result in an error.
1442 If the "syn" protocol is specified, the ping() method will only
1443 send a TCP SYN packet to the remote host then immediately return.
1444 If the syn packet was sent successfully, it will return a true value,
1445 otherwise it will return false. NOTE: Unlike the other protocols,
1446 the return value does NOT determine if the remote host is alive or
1447 not since the full TCP three-way handshake may not have completed
1448 yet. The remote host is only considered reachable if it receives
1449 a TCP ACK within the timeout specifed. To begin waiting for the
1450 ACK packets, use the ack() method as explained below. Use the
1451 "syn" protocol instead the "tcp" protocol to determine reachability
1452 of multiple destinations simultaneously by sending parallel TCP
1453 SYN packets. It will not block while testing each remote host.
1454 demo/fping is provided in this distribution to demonstrate the
1455 "syn" protocol as an example.
1456 This protocol does not require any special privileges.
1462 =item Net::Ping->new([$proto [, $def_timeout [, $bytes [, $device ]]]]);
1464 Create a new ping object. All of the parameters are optional. $proto
1465 specifies the protocol to use when doing a ping. The current choices
1466 are "tcp", "udp", "icmp", "stream", "syn", or "external".
1467 The default is "tcp".
1469 If a default timeout ($def_timeout) in seconds is provided, it is used
1470 when a timeout is not given to the ping() method (below). The timeout
1471 must be greater than 0 and the default, if not specified, is 5 seconds.
1473 If the number of data bytes ($bytes) is given, that many data bytes
1474 are included in the ping packet sent to the remote host. The number of
1475 data bytes is ignored if the protocol is "tcp". The minimum (and
1476 default) number of data bytes is 1 if the protocol is "udp" and 0
1477 otherwise. The maximum number of data bytes that can be specified is
1480 If $device is given, this device is used to bind the source endpoint
1481 before sending the ping packet. I beleive this only works with
1482 superuser privileges and with udp and icmp protocols at this time.
1484 =item $p->ping($host [, $timeout]);
1486 Ping the remote host and wait for a response. $host can be either the
1487 hostname or the IP number of the remote host. The optional timeout
1488 must be greater than 0 seconds and defaults to whatever was specified
1489 when the ping object was created. Returns a success flag. If the
1490 hostname cannot be found or there is a problem with the IP number, the
1491 success flag returned will be undef. Otherwise, the success flag will
1492 be 1 if the host is reachable and 0 if it is not. For most practical
1493 purposes, undef and 0 and can be treated as the same case. In array
1494 context, the elapsed time as well as the string form of the ip the
1495 host resolved to are also returned. The elapsed time value will
1496 be a float, as retuned by the Time::HiRes::time() function, if hires()
1497 has been previously called, otherwise it is returned as an integer.
1499 =item $p->source_verify( { 0 | 1 } );
1501 Allows source endpoint verification to be enabled or disabled.
1502 This is useful for those remote destinations with multiples
1503 interfaces where the response may not originate from the same
1504 endpoint that the original destination endpoint was sent to.
1505 This only affects udp and icmp protocol pings.
1507 This is enabled by default.
1509 =item $p->service_check( { 0 | 1 } );
1511 Set whether or not the connect behavior should enforce
1512 remote service availability as well as reachability. Normally,
1513 if the remote server reported ECONNREFUSED, it must have been
1514 reachable because of the status packet that it reported.
1515 With this option enabled, the full three-way tcp handshake
1516 must have been established successfully before it will
1517 claim it is reachable. NOTE: It still does nothing more
1518 than connect and disconnect. It does not speak any protocol
1519 (i.e., HTTP or FTP) to ensure the remote server is sane in
1520 any way. The remote server CPU could be grinding to a halt
1521 and unresponsive to any clients connecting, but if the kernel
1522 throws the ACK packet, it is considered alive anyway. To
1523 really determine if the server is responding well would be
1524 application specific and is beyond the scope of Net::Ping.
1525 For udp protocol, enabling this option demands that the
1526 remote server replies with the same udp data that it was sent
1527 as defined by the udp echo service.
1529 This affects the "udp", "tcp", and "syn" protocols.
1531 This is disabled by default.
1533 =item $p->tcp_service_check( { 0 | 1 } );
1535 Depricated method, but does the same as service_check() method.
1537 =item $p->hires( { 0 | 1 } );
1539 Causes this module to use Time::HiRes module, allowing milliseconds
1540 to be returned by subsequent calls to ping().
1542 This is disabled by default.
1544 =item $p->bind($local_addr);
1546 Sets the source address from which pings will be sent. This must be
1547 the address of one of the interfaces on the local host. $local_addr
1548 may be specified as a hostname or as a text IP address such as
1551 If the protocol is set to "tcp", this method may be called any
1552 number of times, and each call to the ping() method (below) will use
1553 the most recent $local_addr. If the protocol is "icmp" or "udp",
1554 then bind() must be called at most once per object, and (if it is
1555 called at all) must be called before the first call to ping() for that
1558 =item $p->open($host);
1560 When you are using the "stream" protocol, this call pre-opens the
1561 tcp socket. It's only necessary to do this if you want to
1562 provide a different timeout when creating the connection, or
1563 remove the overhead of establishing the connection from the
1564 first ping. If you don't call C<open()>, the connection is
1565 automatically opened the first time C<ping()> is called.
1566 This call simply does nothing if you are using any protocol other
1569 =item $p->ack( [ $host ] );
1571 When using the "syn" protocol, use this method to determine
1572 the reachability of the remote host. This method is meant
1573 to be called up to as many times as ping() was called. Each
1574 call returns the host (as passed to ping()) that came back
1575 with the TCP ACK. The order in which the hosts are returned
1576 may not necessarily be the same order in which they were
1577 SYN queued using the ping() method. If the timeout is
1578 reached before the TCP ACK is received, or if the remote
1579 host is not listening on the port attempted, then the TCP
1580 connection will not be established and ack() will return
1581 undef. In list context, the host, the ack time, and the
1582 dotted ip string will be returned instead of just the host.
1583 If the optional $host argument is specified, the return
1584 value will be partaining to that host only.
1585 This call simply does nothing if you are using any protocol
1588 =item $p->nack( $failed_ack_host );
1590 The reason that host $failed_ack_host did not receive a
1591 valid ACK. Useful to find out why when ack( $fail_ack_host )
1592 returns a false value.
1596 Close the network connection for this ping object. The network
1597 connection is also closed by "undef $p". The network connection is
1598 automatically closed if the ping object goes out of scope (e.g. $p is
1599 local to a subroutine and you leave the subroutine).
1601 =item pingecho($host [, $timeout]);
1603 To provide backward compatibility with the previous version of
1604 Net::Ping, a pingecho() subroutine is available with the same
1605 functionality as before. pingecho() uses the tcp protocol. The
1606 return values and parameters are the same as described for the ping()
1607 method. This subroutine is obsolete and may be removed in a future
1608 version of Net::Ping.
1614 There will be less network overhead (and some efficiency in your
1615 program) if you specify either the udp or the icmp protocol. The tcp
1616 protocol will generate 2.5 times or more traffic for each ping than
1617 either udp or icmp. If many hosts are pinged frequently, you may wish
1618 to implement a small wait (e.g. 25ms or more) between each ping to
1619 avoid flooding your network with packets.
1621 The icmp protocol requires that the program be run as root or that it
1622 be setuid to root. The other protocols do not require special
1623 privileges, but not all network devices implement tcp or udp echo.
1625 Local hosts should normally respond to pings within milliseconds.
1626 However, on a very congested network it may take up to 3 seconds or
1627 longer to receive an echo packet from the remote host. If the timeout
1628 is set too low under these conditions, it will appear that the remote
1629 host is not reachable (which is almost the truth).
1631 Reachability doesn't necessarily mean that the remote host is actually
1632 functioning beyond its ability to echo packets. tcp is slightly better
1633 at indicating the health of a system than icmp because it uses more
1634 of the networking stack to respond.
1636 Because of a lack of anything better, this module uses its own
1637 routines to pack and unpack ICMP packets. It would be better for a
1638 separate module to be written which understands all of the different
1639 kinds of ICMP packets.
1643 The latest source tree is available via cvs:
1645 cvs -z3 -q -d :pserver:anonymous@cvs.roobik.com.:/usr/local/cvsroot/freeware checkout Net-Ping
1648 The tarball can be created as follows:
1650 perl Makefile.PL ; make ; make dist
1652 The latest Net::Ping release can be found at CPAN:
1654 $CPAN/modules/by-module/Net/
1656 1) Extract the tarball
1658 gtar -zxvf Net-Ping-xxxx.tar.gz
1672 Or install it RPM Style:
1674 rpm -ta SOURCES/Net-Ping-xxxx.tar.gz
1676 rpm -ih RPMS/noarch/perl-Net-Ping-xxxx.rpm
1680 For a list of known issues, visit:
1682 https://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Ping
1684 To report a new bug, visit:
1686 https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-Ping
1691 bbb@cpan.org (Rob Brown)
1694 colinm@cpan.org (Colin McMillen)
1697 bronson@trestle.com (Scott Bronson)
1699 Original pingecho():
1700 karrer@bernina.ethz.ch (Andreas Karrer)
1701 pmarquess@bfsec.bt.co.uk (Paul Marquess)
1703 Original Net::Ping author:
1704 mose@ns.ccsn.edu (Russell Mosemann)
1708 Copyright (c) 2002-2003, Rob Brown. All rights reserved.
1710 Copyright (c) 2001, Colin McMillen. All rights reserved.
1712 This program is free software; you may redistribute it and/or
1713 modify it under the same terms as Perl itself.
1715 $Id: Ping.pm,v 1.81 2003/04/18 04:16:03 rob Exp $