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);
243 undef $nfound if $nfound == -1;
245 return $nfound if $nfound or !defined($nfound) or $t <= 0;
248 ($_[0], $_[1], $_[2]) = @args;
252 my $nfound = select($_[0], $_[1], $_[2], $_[3]);
253 undef $nfound if $nfound == -1;
258 # Description: Allow UDP source endpoint comparison to be
259 # skipped for those remote interfaces that do
260 # not response from the same endpoint.
265 $source_verify = 1 unless defined
266 ($source_verify = ((defined $self) && (ref $self)) ? shift() : $self);
269 # Description: Set whether or not the connect
270 # behavior should enforce remote service
271 # availability as well as reachability.
276 $self->{"econnrefused"} = 1 unless defined
277 ($self->{"econnrefused"} = shift());
280 sub tcp_service_check
285 # Description: Set exponential backoff for retransmission.
286 # Should be > 1 to retain exponential properties.
287 # If set to 0, retransmissions are disabled.
292 $self->{"retrans"} = shift;
295 # Description: allows the module to use milliseconds as returned by
296 # the Time::HiRes module
302 $hires = 1 unless defined
303 ($hires = ((defined $self) && (ref $self)) ? shift() : $self);
304 require Time::HiRes if $hires;
309 return $hires ? Time::HiRes::time() : CORE::time();
312 # Description: Sets or clears the O_NONBLOCK flag on a file handle.
313 sub socket_blocking_mode
316 $fh, # the file handle whose flags are to be modified
317 $block) = @_; # if true then set the blocking
318 # mode (clear O_NONBLOCK), otherwise
319 # set the non-blocking mode (set O_NONBLOCK)
322 if ($^O eq 'MSWin32' || $^O eq 'VMS') {
323 # FIONBIO enables non-blocking sockets on windows and vms.
324 # FIONBIO is (0x80000000|(4<<16)|(ord('f')<<8)|126), as per winsock.h, ioctl.h
326 my $v = pack("L", $block ? 0 : 1);
327 ioctl($fh, $f, $v) or croak("ioctl failed: $!");
330 if ($flags = fcntl($fh, F_GETFL, 0)) {
331 $flags = $block ? ($flags & ~O_NONBLOCK) : ($flags | O_NONBLOCK);
332 if (!fcntl($fh, F_SETFL, $flags)) {
333 croak("fcntl F_SETFL: $!");
336 croak("fcntl F_GETFL: $!");
340 # Description: Ping a host name or IP number with an optional timeout.
341 # First lookup the host, and return undef if it is not found. Otherwise
342 # perform the specific ping method based on the protocol. Return the
343 # result of the ping.
348 $host, # Name or IP number of host to ping
349 $timeout, # Seconds after which ping times out
351 my ($ip, # Packed IP number of $host
352 $ret, # The return value
353 $ping_time, # When ping began
356 croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
357 $timeout = $self->{"timeout"} unless $timeout;
358 croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
360 $ip = inet_aton($host);
361 return () unless defined($ip); # Does host exist?
363 # Dispatch to the appropriate routine.
364 $ping_time = &time();
365 if ($self->{"proto"} eq "external") {
366 $ret = $self->ping_external($ip, $timeout);
368 elsif ($self->{"proto"} eq "udp") {
369 $ret = $self->ping_udp($ip, $timeout);
371 elsif ($self->{"proto"} eq "icmp") {
372 $ret = $self->ping_icmp($ip, $timeout);
374 elsif ($self->{"proto"} eq "tcp") {
375 $ret = $self->ping_tcp($ip, $timeout);
377 elsif ($self->{"proto"} eq "stream") {
378 $ret = $self->ping_stream($ip, $timeout);
380 elsif ($self->{"proto"} eq "syn") {
381 $ret = $self->ping_syn($host, $ip, $ping_time, $ping_time+$timeout);
383 croak("Unknown protocol \"$self->{proto}\" in ping()");
386 return wantarray ? ($ret, &time() - $ping_time, inet_ntoa($ip)) : $ret;
389 # Uses Net::Ping::External to do an external ping.
392 $ip, # Packed IP number of the host
393 $timeout # Seconds after which ping times out
396 eval { require Net::Ping::External; }
397 or croak('Protocol "external" not supported on your system: Net::Ping::External not found');
398 return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
401 use constant ICMP_ECHOREPLY => 0; # ICMP packet types
402 use constant ICMP_UNREACHABLE => 3; # ICMP packet types
403 use constant ICMP_ECHO => 8;
404 use constant ICMP_STRUCT => "C2 n3 A"; # Structure of a minimal ICMP packet
405 use constant SUBCODE => 0; # No ICMP subcode for ECHO and ECHOREPLY
406 use constant ICMP_FLAGS => 0; # No special flags for send or recv
407 use constant ICMP_PORT => 0; # No port with ICMP
412 $ip, # Packed IP number of the host
413 $timeout # Seconds after which ping times out
416 my ($saddr, # sockaddr_in with port and ip
417 $checksum, # Checksum of ICMP packet
418 $msg, # ICMP packet to send
419 $len_msg, # Length of $msg
420 $rbits, # Read bits, filehandles for reading
421 $nfound, # Number of ready filehandles found
422 $finish_time, # Time ping should be finished
423 $done, # set to 1 when we are done
425 $recv_msg, # Received message including IP header
426 $from_saddr, # sockaddr_in of sender
427 $from_port, # Port packet was sent from
428 $from_ip, # Packed IP of sender
429 $from_type, # ICMP type
430 $from_subcode, # ICMP subcode
431 $from_chk, # ICMP packet checksum
432 $from_pid, # ICMP packet id
433 $from_seq, # ICMP packet sequence
434 $from_msg # ICMP message
437 $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
438 $checksum = 0; # No checksum for starters
439 $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
440 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
441 $checksum = Net::Ping->checksum($msg);
442 $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
443 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
444 $len_msg = length($msg);
445 $saddr = sockaddr_in(ICMP_PORT, $ip);
446 $self->{"from_ip"} = undef;
447 $self->{"from_type"} = undef;
448 $self->{"from_subcode"} = undef;
449 send($self->{"fh"}, $msg, ICMP_FLAGS, $saddr); # Send the message
452 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
455 $finish_time = &time() + $timeout; # Must be done by this time
456 while (!$done && $timeout > 0) # Keep trying if we have time
458 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for packet
459 $timeout = $finish_time - &time(); # Get remaining time
460 if (!defined($nfound)) # Hmm, a strange error
465 elsif ($nfound) # Got a packet from somewhere
470 $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, ICMP_FLAGS);
471 ($from_port, $from_ip) = sockaddr_in($from_saddr);
472 ($from_type, $from_subcode) = unpack("C2", substr($recv_msg, 20, 2));
473 if ($from_type == ICMP_ECHOREPLY) {
474 ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 24, 4))
475 if length $recv_msg >= 28;
477 ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 52, 4))
478 if length $recv_msg >= 56;
480 $self->{"from_ip"} = $from_ip;
481 $self->{"from_type"} = $from_type;
482 $self->{"from_subcode"} = $from_subcode;
483 if (($from_pid == $self->{"pid"}) && # Does the packet check out?
484 (! $source_verify || (inet_ntoa($from_ip) eq inet_ntoa($ip))) &&
485 ($from_seq == $self->{"seq"})) {
486 if ($from_type == ICMP_ECHOREPLY) {
489 } elsif ($from_type == ICMP_UNREACHABLE) {
493 } else { # Oops, timed out
502 my $ip = $self->{"from_ip"} || "";
503 $ip = "\0\0\0\0" unless 4 == length $ip;
504 return (inet_ntoa($ip),($self->{"from_type"} || 0), ($self->{"from_subcode"} || 0));
507 # Description: Do a checksum on the message. Basically sum all of
508 # the short words and fold the high order bits into the low order bits.
513 $msg # The message to checksum
515 my ($len_msg, # Length of the message
516 $num_short, # The number of short words in the message
517 $short, # One short word
521 $len_msg = length($msg);
522 $num_short = int($len_msg / 2);
524 foreach $short (unpack("n$num_short", $msg))
527 } # Add the odd byte in
528 $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
529 $chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low
530 return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement
534 # Description: Perform a tcp echo ping. Since a tcp connection is
535 # host specific, we have to open and close each connection here. We
536 # can't just leave a socket open. Because of the robust nature of
537 # tcp, it will take a while before it gives up trying to establish a
538 # connection. Therefore, we use select() on a non-blocking socket to
539 # check against our timeout. No data bytes are actually
540 # sent since the successful establishment of a connection is proof
541 # enough of the reachability of the remote host. Also, tcp is
542 # expensive and doesn't need our help to add to the overhead.
547 $ip, # Packed IP number of the host
548 $timeout # Seconds after which ping times out
550 my ($ret # The return value
554 $ret = $self -> tcp_connect( $ip, $timeout);
555 if (!$self->{"econnrefused"} &&
556 $! == ECONNREFUSED) {
557 $ret = 1; # "Connection refused" means reachable
559 $self->{"fh"}->close();
566 $ip, # Packed IP number of the host
567 $timeout # Seconds after which connect times out
569 my ($saddr); # Packed IP and Port
571 $saddr = sockaddr_in($self->{"port_num"}, $ip);
573 my $ret = 0; # Default to unreachable
575 my $do_socket = sub {
576 socket($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"}) ||
577 croak("tcp socket error - $!");
578 if (defined $self->{"local_addr"} &&
579 !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
580 croak("tcp bind error - $!");
582 if ($self->{'device'}) {
583 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
584 or croak("error binding to device $self->{'device'} $!");
586 if ($self->{'tos'}) {
587 setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
588 or croak "error configuring tos to $self->{'tos'} $!";
591 my $do_connect = sub {
593 # ECONNREFUSED is 10061 on MSWin32. If we pass it as child error through $?,
594 # we'll get (10061 & 255) = 77, so we cannot check it in the parent process.
595 return ($ret = connect($self->{"fh"}, $saddr) || ($! == ECONNREFUSED && !$self->{"econnrefused"}));
597 my $do_connect_nb = sub {
598 # Set O_NONBLOCK property on filehandle
599 $self->socket_blocking_mode($self->{"fh"}, 0);
601 # start the connection attempt
602 if (!connect($self->{"fh"}, $saddr)) {
603 if ($! == ECONNREFUSED) {
604 $ret = 1 unless $self->{"econnrefused"};
605 } elsif ($! != EINPROGRESS && ($^O ne 'MSWin32' || $! != EWOULDBLOCK)) {
606 # EINPROGRESS is the expected error code after a connect()
607 # on a non-blocking socket. But if the kernel immediately
608 # determined that this connect() will never work,
609 # Simply respond with "unreachable" status.
610 # (This can occur on some platforms with errno
611 # EHOSTUNREACH or ENETUNREACH.)
614 # Got the expected EINPROGRESS.
615 # Just wait for connection completion...
616 my ($wbits, $wout, $wexc);
617 $wout = $wexc = $wbits = "";
618 vec($wbits, $self->{"fh"}->fileno, 1) = 1;
620 my $nfound = mselect(undef,
622 ($^O eq 'MSWin32' ? ($wexc = $wbits) : undef),
624 warn("select: $!") unless defined $nfound;
626 if ($nfound && vec($wout, $self->{"fh"}->fileno, 1)) {
627 # the socket is ready for writing so the connection
628 # attempt completed. test whether the connection
629 # attempt was successful or not
631 if (getpeername($self->{"fh"})) {
632 # Connection established to remote host
635 # TCP ACK will never come from this host
636 # because there was an error connecting.
638 # This should set $! to the correct error.
640 sysread($self->{"fh"},$char,1);
641 $! = ECONNREFUSED if ($! == EAGAIN && $^O =~ /cygwin/i);
643 $ret = 1 if (!$self->{"econnrefused"}
644 && $! == ECONNREFUSED);
647 # the connection attempt timed out (or there were connect
649 if ($^O =~ 'MSWin32') {
650 # If the connect will fail on a non-blocking socket,
651 # winsock reports ECONNREFUSED as an exception, and we
652 # need to fetch the socket-level error code via getsockopt()
653 # instead of using the thread-level error code that is in $!.
654 if ($nfound && vec($wexc, $self->{"fh"}->fileno, 1)) {
655 $! = unpack("i", getsockopt($self->{"fh"}, SOL_SOCKET,
662 # Connection established to remote host
666 # Unset O_NONBLOCK property on filehandle
667 $self->socket_blocking_mode($self->{"fh"}, 1);
673 # Buggy Winsock API doesn't allow nonblocking connect.
674 # Hence, if our OS is Windows, we need to create a separate
675 # process to do the blocking connect attempt.
676 # XXX Above comments are not true at least for Win2K, where
677 # nonblocking connect works.
679 $| = 1; # Clear buffer prior to fork to prevent duplicate flushing.
680 $self->{'tcp_chld'} = fork;
681 if (!$self->{'tcp_chld'}) {
682 if (!defined $self->{'tcp_chld'}) {
684 warn "Fork error: $!";
689 # Try a slow blocking connect() call
690 # and report the status to the parent.
691 if ( &{ $do_connect }() ) {
692 $self->{"fh"}->close();
696 # Pass the error status to the parent
697 # Make sure that $! <= 255
698 exit($! <= 255 ? $! : 255);
704 my $patience = &time() + $timeout;
706 my ($child, $child_errno);
707 $? = 0; $child_errno = 0;
708 # Wait up to the timeout
709 # And clean off the zombie
711 $child = waitpid($self->{'tcp_chld'}, &WNOHANG());
712 $child_errno = $? >> 8;
713 select(undef, undef, undef, 0.1);
714 } while &time() < $patience && $child != $self->{'tcp_chld'};
716 if ($child == $self->{'tcp_chld'}) {
717 if ($self->{"proto"} eq "stream") {
718 # We need the socket connected here, in parent
719 # Should be safe to connect because the child finished
723 # $ret cannot be set by the child process
724 $ret = !$child_errno;
726 # Time must have run out.
727 # Put that choking client out of its misery
728 kill "KILL", $self->{'tcp_chld'};
729 # Clean off the zombie
730 waitpid($self->{'tcp_chld'}, 0);
733 delete $self->{'tcp_chld'};
736 # Otherwise don't waste the resources to fork
740 &{ $do_connect_nb }();
748 if ($self->{'proto'} eq 'tcp' &&
749 $self->{'tcp_chld'}) {
750 # Put that choking client out of its misery
751 kill "KILL", $self->{'tcp_chld'};
752 # Clean off the zombie
753 waitpid($self->{'tcp_chld'}, 0);
757 # This writes the given string to the socket and then reads it
758 # back. It returns 1 on success, 0 on failure.
763 my $pingstring = shift;
767 my $wrstr = $pingstring;
773 vec($rin, $self->{"fh"}->fileno(), 1) = 1;
778 vec($rout, $self->{"fh"}->fileno(), 1) = 1;
781 if(mselect($rin, $rout, undef, ($time + $timeout) - &time())) {
783 if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
784 my $num = syswrite($self->{"fh"}, $wrstr, length $wrstr);
786 # If it was a partial write, update and try again.
787 $wrstr = substr($wrstr,$num);
789 # There was an error.
794 if(vec($rin,$self->{"fh"}->fileno(),1)) {
796 if(sysread($self->{"fh"},$reply,length($pingstring)-length($rdstr))) {
798 $ret = 1 if $rdstr eq $pingstring;
800 # There was an error.
806 } until &time() > ($time + $timeout) || defined($ret);
815 # Description: Perform a stream ping. If the tcp connection isn't
816 # already open, it opens it. It then sends some data and waits for
817 # a reply. It leaves the stream open on exit.
822 $ip, # Packed IP number of the host
823 $timeout # Seconds after which ping times out
826 # Open the stream if it's not already open
827 if(!defined $self->{"fh"}->fileno()) {
828 $self->tcp_connect($ip, $timeout) or return 0;
831 croak "tried to switch servers while stream pinging"
832 if $self->{"ip"} ne $ip;
834 return $self->tcp_echo($timeout, $pingstring);
837 # Description: opens the stream. You would do this if you want to
838 # separate the overhead of opening the stream from the first ping.
843 $host, # Host or IP address
844 $timeout # Seconds after which open times out
847 my ($ip); # Packed IP number of the host
848 $ip = inet_aton($host);
849 $timeout = $self->{"timeout"} unless $timeout;
851 if($self->{"proto"} eq "stream") {
852 if(defined($self->{"fh"}->fileno())) {
853 croak("socket is already open");
855 $self->tcp_connect($ip, $timeout);
861 # Description: Perform a udp echo ping. Construct a message of
862 # at least the one-byte sequence number and any additional data bytes.
863 # Send the message out and wait for a message to come back. If we
864 # get a message, make sure all of its parts match. If they do, we are
865 # done. Otherwise go back and wait for the message until we run out
866 # of time. Return the result of our efforts.
868 use constant UDP_FLAGS => 0; # Nothing special on send or recv
872 $ip, # Packed IP number of the host
873 $timeout # Seconds after which ping times out
876 my ($saddr, # sockaddr_in with port and ip
877 $ret, # The return value
878 $msg, # Message to be echoed
879 $finish_time, # Time ping should be finished
880 $flush, # Whether socket needs to be disconnected
881 $connect, # Whether socket needs to be connected
882 $done, # Set to 1 when we are done pinging
883 $rbits, # Read bits, filehandles for reading
884 $nfound, # Number of ready filehandles found
885 $from_saddr, # sockaddr_in of sender
886 $from_msg, # Characters echoed by $host
887 $from_port, # Port message was echoed from
888 $from_ip # Packed IP number of sender
891 $saddr = sockaddr_in($self->{"port_num"}, $ip);
892 $self->{"seq"} = ($self->{"seq"} + 1) % 256; # Increment sequence
893 $msg = chr($self->{"seq"}) . $self->{"data"}; # Add data if any
895 if ($self->{"connected"}) {
896 if ($self->{"connected"} ne $saddr) {
897 # Still connected to wrong destination.
898 # Need to flush out the old one.
903 # Need to connect() before send()
907 # Have to connect() and send() instead of sendto()
908 # in order to pick up on the ECONNREFUSED setting
909 # from recv() or double send() errno as utilized in
910 # the concept by rdw @ perlmonks. See:
911 # http://perlmonks.thepen.com/42898.html
913 # Need to socket() again to flush the descriptor
914 # This will disconnect from the old saddr.
915 socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
916 $self->{"proto_num"});
918 # Connect the socket if it isn't already connected
919 # to the right destination.
920 if ($flush || $connect) {
921 connect($self->{"fh"}, $saddr); # Tie destination to socket
922 $self->{"connected"} = $saddr;
924 send($self->{"fh"}, $msg, UDP_FLAGS); # Send it
927 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
928 $ret = 0; # Default to unreachable
931 my $factor = $self->{"retrans"};
932 $finish_time = &time() + $timeout; # Ping needs to be done by then
933 while (!$done && $timeout > 0)
937 $timeout = $retrans if $timeout > $retrans;
938 $retrans*= $factor; # Exponential backoff
940 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for response
942 $timeout = $finish_time - &time(); # Get remaining time
944 if (!defined($nfound)) # Hmm, a strange error
949 elsif ($nfound) # A packet is waiting
952 $from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS);
954 # For example an unreachable host will make recv() fail.
955 if (!$self->{"econnrefused"} &&
956 ($! == ECONNREFUSED ||
958 # "Connection refused" means reachable
964 ($from_port, $from_ip) = sockaddr_in($from_saddr);
965 if (!$source_verify ||
966 (($from_ip eq $ip) && # Does the packet check out?
967 ($from_port == $self->{"port_num"}) &&
968 ($from_msg eq $msg)))
970 $ret = 1; # It's a winner
975 elsif ($timeout <= 0) # Oops, timed out
981 # Send another in case the last one dropped
982 if (send($self->{"fh"}, $msg, UDP_FLAGS)) {
983 # Another send worked? The previous udp packet
984 # must have gotten lost or is still in transit.
985 # Hopefully this new packet will arrive safely.
987 if (!$self->{"econnrefused"} &&
988 $! == ECONNREFUSED) {
989 # "Connection refused" means reachable
1000 # Description: Send a TCP SYN packet to host specified.
1006 my $start_time = shift;
1007 my $stop_time = shift;
1010 return $self->ping_syn_fork($host, $ip, $start_time, $stop_time);
1013 my $fh = FileHandle->new();
1014 my $saddr = sockaddr_in($self->{"port_num"}, $ip);
1017 if (!socket ($fh, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
1018 croak("tcp socket error - $!");
1021 if (defined $self->{"local_addr"} &&
1022 !CORE::bind($fh, sockaddr_in(0, $self->{"local_addr"}))) {
1023 croak("tcp bind error - $!");
1026 if ($self->{'device'}) {
1027 setsockopt($fh, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
1028 or croak("error binding to device $self->{'device'} $!");
1030 if ($self->{'tos'}) {
1031 setsockopt($fh, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
1032 or croak "error configuring tos to $self->{'tos'} $!";
1034 # Set O_NONBLOCK property on filehandle
1035 $self->socket_blocking_mode($fh, 0);
1037 # Attempt the non-blocking connect
1038 # by just sending the TCP SYN packet
1039 if (connect($fh, $saddr)) {
1040 # Non-blocking, yet still connected?
1041 # Must have connected very quickly,
1042 # or else it wasn't very non-blocking.
1043 #warn "WARNING: Nonblocking connect connected anyway? ($^O)";
1045 # Error occurred connecting.
1046 if ($! == EINPROGRESS || ($^O eq 'MSWin32' && $! == EWOULDBLOCK)) {
1047 # The connection is just still in progress.
1048 # This is the expected condition.
1050 # Just save the error and continue on.
1051 # The ack() can check the status later.
1052 $self->{"bad"}->{$host} = $!;
1056 my $entry = [ $host, $ip, $fh, $start_time, $stop_time ];
1057 $self->{"syn"}->{$fh->fileno} = $entry;
1058 if ($self->{"stop_time"} < $stop_time) {
1059 $self->{"stop_time"} = $stop_time;
1061 vec($self->{"wbits"}, $fh->fileno, 1) = 1;
1067 my ($self, $host, $ip, $start_time, $stop_time) = @_;
1069 # Buggy Winsock API doesn't allow nonblocking connect.
1070 # Hence, if our OS is Windows, we need to create a separate
1071 # process to do the blocking connect attempt.
1076 my $entry = [ $host, $ip, $pid, $start_time, $stop_time ];
1077 $self->{"syn"}->{$pid} = $entry;
1078 if ($self->{"stop_time"} < $stop_time) {
1079 $self->{"stop_time"} = $stop_time;
1083 my $saddr = sockaddr_in($self->{"port_num"}, $ip);
1086 if (!socket ($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
1087 croak("tcp socket error - $!");
1090 if (defined $self->{"local_addr"} &&
1091 !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
1092 croak("tcp bind error - $!");
1095 if ($self->{'device'}) {
1096 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
1097 or croak("error binding to device $self->{'device'} $!");
1099 if ($self->{'tos'}) {
1100 setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
1101 or croak "error configuring tos to $self->{'tos'} $!";
1105 # Try to connect (could take a long time)
1106 connect($self->{"fh"}, $saddr);
1107 # Notify parent of connect error status
1109 my $wrstr = "$$ $err";
1110 # Force to 16 chars including \n
1111 $wrstr .= " "x(15 - length $wrstr). "\n";
1112 syswrite($self->{"fork_wr"}, $wrstr, length $wrstr);
1122 # Description: Wait for TCP ACK from host specified
1123 # from ping_syn above. If no host is specified, wait
1124 # for TCP ACK from any of the hosts in the SYN queue.
1129 if ($self->{"proto"} eq "syn") {
1131 my @answer = $self->ack_unfork(shift);
1132 return wantarray ? @answer : $answer[0];
1136 if (my $host = shift) {
1137 # Host passed as arg
1138 if (exists $self->{"bad"}->{$host}) {
1139 if (!$self->{"econnrefused"} &&
1140 $self->{"bad"}->{ $host } &&
1141 (($! = ECONNREFUSED)>0) &&
1142 $self->{"bad"}->{ $host } eq "$!") {
1143 # "Connection refused" means reachable
1146 # ECONNREFUSED means no good
1150 my $host_fd = undef;
1151 foreach my $fd (keys %{ $self->{"syn"} }) {
1152 my $entry = $self->{"syn"}->{$fd};
1153 if ($entry->[0] eq $host) {
1155 $stop_time = $entry->[4]
1156 || croak("Corrupted SYN entry for [$host]");
1160 croak("ack called on [$host] without calling ping first!")
1161 unless defined $host_fd;
1162 vec($wbits, $host_fd, 1) = 1;
1164 # No $host passed so scan all hosts
1165 # Use the latest stop_time
1166 $stop_time = $self->{"stop_time"};
1168 $wbits = $self->{"wbits"};
1171 while ($wbits !~ /^\0*\z/) {
1172 my $timeout = $stop_time - &time();
1173 # Force a minimum of 10 ms timeout.
1174 $timeout = 0.01 if $timeout <= 0.01;
1176 my $winner_fd = undef;
1179 # Do "bad" fds from $wbits first
1180 while ($wout !~ /^\0*\z/) {
1181 if (vec($wout, $fd, 1)) {
1182 # Wipe it from future scanning.
1183 vec($wout, $fd, 1) = 0;
1184 if (my $entry = $self->{"syn"}->{$fd}) {
1185 if ($self->{"bad"}->{ $entry->[0] }) {
1194 if (defined($winner_fd) or my $nfound = mselect(undef, ($wout=$wbits), undef, $timeout)) {
1195 if (defined $winner_fd) {
1198 # Done waiting for one of the ACKs
1200 # Determine which one
1201 while ($wout !~ /^\0*\z/ &&
1202 !vec($wout, $fd, 1)) {
1206 if (my $entry = $self->{"syn"}->{$fd}) {
1207 # Wipe it from future scanning.
1208 delete $self->{"syn"}->{$fd};
1209 vec($self->{"wbits"}, $fd, 1) = 0;
1210 vec($wbits, $fd, 1) = 0;
1211 if (!$self->{"econnrefused"} &&
1212 $self->{"bad"}->{ $entry->[0] } &&
1213 (($! = ECONNREFUSED)>0) &&
1214 $self->{"bad"}->{ $entry->[0] } eq "$!") {
1215 # "Connection refused" means reachable
1217 } elsif (getpeername($entry->[2])) {
1218 # Connection established to remote host
1221 # TCP ACK will never come from this host
1222 # because there was an error connecting.
1224 # This should set $! to the correct error.
1226 sysread($entry->[2],$char,1);
1227 # Store the excuse why the connection failed.
1228 $self->{"bad"}->{$entry->[0]} = $!;
1229 if (!$self->{"econnrefused"} &&
1230 (($! == ECONNREFUSED) ||
1231 ($! == EAGAIN && $^O =~ /cygwin/i))) {
1232 # "Connection refused" means reachable
1235 # No good, try the next socket...
1239 # Everything passed okay, return the answer
1241 ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
1244 warn "Corrupted SYN entry: unknown fd [$fd] ready!";
1245 vec($wbits, $fd, 1) = 0;
1246 vec($self->{"wbits"}, $fd, 1) = 0;
1248 } elsif (defined $nfound) {
1249 # Timed out waiting for ACK
1250 foreach my $fd (keys %{ $self->{"syn"} }) {
1251 if (vec($wbits, $fd, 1)) {
1252 my $entry = $self->{"syn"}->{$fd};
1253 $self->{"bad"}->{$entry->[0]} = "Timed out";
1254 vec($wbits, $fd, 1) = 0;
1255 vec($self->{"wbits"}, $fd, 1) = 0;
1256 delete $self->{"syn"}->{$fd};
1260 # Weird error occurred with select()
1262 $self->{"syn"} = {};
1271 my ($self,$host) = @_;
1272 my $stop_time = $self->{"stop_time"};
1274 # Host passed as arg
1275 if (my $entry = $self->{"good"}->{$host}) {
1276 delete $self->{"good"}->{$host};
1277 return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
1284 if (keys %{ $self->{"syn"} }) {
1285 # Scan all hosts that are left
1286 vec($rbits, fileno($self->{"fork_rd"}), 1) = 1;
1287 $timeout = $stop_time - &time();
1288 # Force a minimum of 10 ms timeout.
1289 $timeout = 0.01 if $timeout < 0.01;
1291 # No hosts left to wait for
1297 while ( keys %{ $self->{"syn"} } and
1298 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout)) {
1299 # Done waiting for one of the ACKs
1300 if (!sysread($self->{"fork_rd"}, $_, 16)) {
1301 # Socket closed, which means all children are done.
1304 my ($pid, $how) = split;
1308 if (my $entry = $self->{"syn"}->{$pid}) {
1309 # Connection attempt to remote host is done
1310 delete $self->{"syn"}->{$pid};
1311 if (!$how || # If there was no error connecting
1312 (!$self->{"econnrefused"} &&
1313 $how == ECONNREFUSED)) { # "Connection refused" means reachable
1314 if ($host && $entry->[0] ne $host) {
1315 # A good connection, but not the host we need.
1316 # Move it from the "syn" hash to the "good" hash.
1317 $self->{"good"}->{$entry->[0]} = $entry;
1318 # And wait for the next winner
1321 return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
1324 # Should never happen
1325 die "Unknown ping from pid [$pid]";
1328 die "Empty response from status socket?";
1331 if (defined $nfound) {
1332 # Timed out waiting for ACK status
1334 # Weird error occurred with select()
1338 if (my @synners = keys %{ $self->{"syn"} }) {
1339 # Kill all the synners
1341 foreach my $pid (@synners) {
1342 # Wait for the deaths to finish
1343 # Then flush off the zombie
1347 $self->{"syn"} = {};
1351 # Description: Tell why the ack() failed
1354 my $host = shift || croak('Usage> nack($failed_ack_host)');
1355 return $self->{"bad"}->{$host} || undef;
1358 # Description: Close the connection.
1364 if ($self->{"proto"} eq "syn") {
1365 delete $self->{"syn"};
1366 } elsif ($self->{"proto"} eq "tcp") {
1367 # The connection will already be closed
1369 $self->{"fh"}->close();
1376 $self->{port_num} = shift @_;
1377 $self->service_check(1);
1379 return $self->{port_num};
1388 Net::Ping - check a remote host for reachability
1394 $p = Net::Ping->new();
1395 print "$host is alive.\n" if $p->ping($host);
1398 $p = Net::Ping->new("icmp");
1399 $p->bind($my_addr); # Specify source interface of pings
1400 foreach $host (@host_array)
1403 print "NOT " unless $p->ping($host, 2);
1404 print "reachable.\n";
1409 $p = Net::Ping->new("tcp", 2);
1410 # Try connecting to the www port instead of the echo port
1411 $p->port_number(getservbyname("http", "tcp"));
1412 while ($stop_time > time())
1414 print "$host not reachable ", scalar(localtime()), "\n"
1415 unless $p->ping($host);
1420 # Like tcp protocol, but with many hosts
1421 $p = Net::Ping->new("syn");
1422 $p->port_number(getservbyname("http", "tcp"));
1423 foreach $host (@host_array) {
1426 while (($host,$rtt,$ip) = $p->ack) {
1427 print "HOST: $host [$ip] ACKed in $rtt seconds.\n";
1430 # High precision syntax (requires Time::HiRes)
1431 $p = Net::Ping->new();
1433 ($ret, $duration, $ip) = $p->ping($host, 5.5);
1434 printf("$host [ip: $ip] is alive (packet return time: %.2f ms)\n", 1000 * $duration)
1438 # For backward compatibility
1439 print "$host is alive.\n" if pingecho($host);
1443 This module contains methods to test the reachability of remote
1444 hosts on a network. A ping object is first created with optional
1445 parameters, a variable number of hosts may be pinged multiple
1446 times and then the connection is closed.
1448 You may choose one of six different protocols to use for the
1449 ping. The "tcp" protocol is the default. Note that a live remote host
1450 may still fail to be pingable by one or more of these protocols. For
1451 example, www.microsoft.com is generally alive but not "icmp" pingable.
1453 With the "tcp" protocol the ping() method attempts to establish a
1454 connection to the remote host's echo port. If the connection is
1455 successfully established, the remote host is considered reachable. No
1456 data is actually echoed. This protocol does not require any special
1457 privileges but has higher overhead than the "udp" and "icmp" protocols.
1459 Specifying the "udp" protocol causes the ping() method to send a udp
1460 packet to the remote host's echo port. If the echoed packet is
1461 received from the remote host and the received packet contains the
1462 same data as the packet that was sent, the remote host is considered
1463 reachable. This protocol does not require any special privileges.
1464 It should be borne in mind that, for a udp ping, a host
1465 will be reported as unreachable if it is not running the
1466 appropriate echo service. For Unix-like systems see L<inetd(8)>
1467 for more information.
1469 If the "icmp" protocol is specified, the ping() method sends an icmp
1470 echo message to the remote host, which is what the UNIX ping program
1471 does. If the echoed message is received from the remote host and
1472 the echoed information is correct, the remote host is considered
1473 reachable. Specifying the "icmp" protocol requires that the program
1474 be run as root or that the program be setuid to root.
1476 If the "external" protocol is specified, the ping() method attempts to
1477 use the C<Net::Ping::External> module to ping the remote host.
1478 C<Net::Ping::External> interfaces with your system's default C<ping>
1479 utility to perform the ping, and generally produces relatively
1480 accurate results. If C<Net::Ping::External> if not installed on your
1481 system, specifying the "external" protocol will result in an error.
1483 If the "syn" protocol is specified, the ping() method will only
1484 send a TCP SYN packet to the remote host then immediately return.
1485 If the syn packet was sent successfully, it will return a true value,
1486 otherwise it will return false. NOTE: Unlike the other protocols,
1487 the return value does NOT determine if the remote host is alive or
1488 not since the full TCP three-way handshake may not have completed
1489 yet. The remote host is only considered reachable if it receives
1490 a TCP ACK within the timeout specified. To begin waiting for the
1491 ACK packets, use the ack() method as explained below. Use the
1492 "syn" protocol instead the "tcp" protocol to determine reachability
1493 of multiple destinations simultaneously by sending parallel TCP
1494 SYN packets. It will not block while testing each remote host.
1495 demo/fping is provided in this distribution to demonstrate the
1496 "syn" protocol as an example.
1497 This protocol does not require any special privileges.
1503 =item Net::Ping->new([$proto [, $def_timeout [, $bytes [, $device [, $tos ]]]]]);
1505 Create a new ping object. All of the parameters are optional. $proto
1506 specifies the protocol to use when doing a ping. The current choices
1507 are "tcp", "udp", "icmp", "stream", "syn", or "external".
1508 The default is "tcp".
1510 If a default timeout ($def_timeout) in seconds is provided, it is used
1511 when a timeout is not given to the ping() method (below). The timeout
1512 must be greater than 0 and the default, if not specified, is 5 seconds.
1514 If the number of data bytes ($bytes) is given, that many data bytes
1515 are included in the ping packet sent to the remote host. The number of
1516 data bytes is ignored if the protocol is "tcp". The minimum (and
1517 default) number of data bytes is 1 if the protocol is "udp" and 0
1518 otherwise. The maximum number of data bytes that can be specified is
1521 If $device is given, this device is used to bind the source endpoint
1522 before sending the ping packet. I believe this only works with
1523 superuser privileges and with udp and icmp protocols at this time.
1525 If $tos is given, this ToS is configured into the socket.
1527 =item $p->ping($host [, $timeout]);
1529 Ping the remote host and wait for a response. $host can be either the
1530 hostname or the IP number of the remote host. The optional timeout
1531 must be greater than 0 seconds and defaults to whatever was specified
1532 when the ping object was created. Returns a success flag. If the
1533 hostname cannot be found or there is a problem with the IP number, the
1534 success flag returned will be undef. Otherwise, the success flag will
1535 be 1 if the host is reachable and 0 if it is not. For most practical
1536 purposes, undef and 0 and can be treated as the same case. In array
1537 context, the elapsed time as well as the string form of the ip the
1538 host resolved to are also returned. The elapsed time value will
1539 be a float, as retuned by the Time::HiRes::time() function, if hires()
1540 has been previously called, otherwise it is returned as an integer.
1542 =item $p->source_verify( { 0 | 1 } );
1544 Allows source endpoint verification to be enabled or disabled.
1545 This is useful for those remote destinations with multiples
1546 interfaces where the response may not originate from the same
1547 endpoint that the original destination endpoint was sent to.
1548 This only affects udp and icmp protocol pings.
1550 This is enabled by default.
1552 =item $p->service_check( { 0 | 1 } );
1554 Set whether or not the connect behavior should enforce
1555 remote service availability as well as reachability. Normally,
1556 if the remote server reported ECONNREFUSED, it must have been
1557 reachable because of the status packet that it reported.
1558 With this option enabled, the full three-way tcp handshake
1559 must have been established successfully before it will
1560 claim it is reachable. NOTE: It still does nothing more
1561 than connect and disconnect. It does not speak any protocol
1562 (i.e., HTTP or FTP) to ensure the remote server is sane in
1563 any way. The remote server CPU could be grinding to a halt
1564 and unresponsive to any clients connecting, but if the kernel
1565 throws the ACK packet, it is considered alive anyway. To
1566 really determine if the server is responding well would be
1567 application specific and is beyond the scope of Net::Ping.
1568 For udp protocol, enabling this option demands that the
1569 remote server replies with the same udp data that it was sent
1570 as defined by the udp echo service.
1572 This affects the "udp", "tcp", and "syn" protocols.
1574 This is disabled by default.
1576 =item $p->tcp_service_check( { 0 | 1 } );
1578 Deprecated method, but does the same as service_check() method.
1580 =item $p->hires( { 0 | 1 } );
1582 Causes this module to use Time::HiRes module, allowing milliseconds
1583 to be returned by subsequent calls to ping().
1585 This is disabled by default.
1587 =item $p->bind($local_addr);
1589 Sets the source address from which pings will be sent. This must be
1590 the address of one of the interfaces on the local host. $local_addr
1591 may be specified as a hostname or as a text IP address such as
1594 If the protocol is set to "tcp", this method may be called any
1595 number of times, and each call to the ping() method (below) will use
1596 the most recent $local_addr. If the protocol is "icmp" or "udp",
1597 then bind() must be called at most once per object, and (if it is
1598 called at all) must be called before the first call to ping() for that
1601 =item $p->open($host);
1603 When you are using the "stream" protocol, this call pre-opens the
1604 tcp socket. It's only necessary to do this if you want to
1605 provide a different timeout when creating the connection, or
1606 remove the overhead of establishing the connection from the
1607 first ping. If you don't call C<open()>, the connection is
1608 automatically opened the first time C<ping()> is called.
1609 This call simply does nothing if you are using any protocol other
1612 =item $p->ack( [ $host ] );
1614 When using the "syn" protocol, use this method to determine
1615 the reachability of the remote host. This method is meant
1616 to be called up to as many times as ping() was called. Each
1617 call returns the host (as passed to ping()) that came back
1618 with the TCP ACK. The order in which the hosts are returned
1619 may not necessarily be the same order in which they were
1620 SYN queued using the ping() method. If the timeout is
1621 reached before the TCP ACK is received, or if the remote
1622 host is not listening on the port attempted, then the TCP
1623 connection will not be established and ack() will return
1624 undef. In list context, the host, the ack time, and the
1625 dotted ip string will be returned instead of just the host.
1626 If the optional $host argument is specified, the return
1627 value will be pertaining to that host only.
1628 This call simply does nothing if you are using any protocol
1631 =item $p->nack( $failed_ack_host );
1633 The reason that host $failed_ack_host did not receive a
1634 valid ACK. Useful to find out why when ack( $fail_ack_host )
1635 returns a false value.
1639 Close the network connection for this ping object. The network
1640 connection is also closed by "undef $p". The network connection is
1641 automatically closed if the ping object goes out of scope (e.g. $p is
1642 local to a subroutine and you leave the subroutine).
1644 =item $p->port_number([$port_number])
1646 When called with a port number, the port number used to ping is set to
1647 $port_number rather than using the echo port. It also has the effect
1648 of calling C<$p-E<gt>service_check(1)> causing a ping to return a successful
1649 response only if that specific port is accessible. This function returns
1650 the value of the port that C<ping()> will connect to.
1652 =item pingecho($host [, $timeout]);
1654 To provide backward compatibility with the previous version of
1655 Net::Ping, a pingecho() subroutine is available with the same
1656 functionality as before. pingecho() uses the tcp protocol. The
1657 return values and parameters are the same as described for the ping()
1658 method. This subroutine is obsolete and may be removed in a future
1659 version of Net::Ping.
1665 There will be less network overhead (and some efficiency in your
1666 program) if you specify either the udp or the icmp protocol. The tcp
1667 protocol will generate 2.5 times or more traffic for each ping than
1668 either udp or icmp. If many hosts are pinged frequently, you may wish
1669 to implement a small wait (e.g. 25ms or more) between each ping to
1670 avoid flooding your network with packets.
1672 The icmp protocol requires that the program be run as root or that it
1673 be setuid to root. The other protocols do not require special
1674 privileges, but not all network devices implement tcp or udp echo.
1676 Local hosts should normally respond to pings within milliseconds.
1677 However, on a very congested network it may take up to 3 seconds or
1678 longer to receive an echo packet from the remote host. If the timeout
1679 is set too low under these conditions, it will appear that the remote
1680 host is not reachable (which is almost the truth).
1682 Reachability doesn't necessarily mean that the remote host is actually
1683 functioning beyond its ability to echo packets. tcp is slightly better
1684 at indicating the health of a system than icmp because it uses more
1685 of the networking stack to respond.
1687 Because of a lack of anything better, this module uses its own
1688 routines to pack and unpack ICMP packets. It would be better for a
1689 separate module to be written which understands all of the different
1690 kinds of ICMP packets.
1694 The latest source tree is available via cvs:
1696 cvs -z3 -q -d :pserver:anonymous@cvs.roobik.com.:/usr/local/cvsroot/freeware checkout Net-Ping
1699 The tarball can be created as follows:
1701 perl Makefile.PL ; make ; make dist
1703 The latest Net::Ping release can be found at CPAN:
1705 $CPAN/modules/by-module/Net/
1707 1) Extract the tarball
1709 gtar -zxvf Net-Ping-xxxx.tar.gz
1723 Or install it RPM Style:
1725 rpm -ta SOURCES/Net-Ping-xxxx.tar.gz
1727 rpm -ih RPMS/noarch/perl-Net-Ping-xxxx.rpm
1731 For a list of known issues, visit:
1733 https://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Ping
1735 To report a new bug, visit:
1737 https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-Ping
1742 bbb@cpan.org (Rob Brown)
1745 colinm@cpan.org (Colin McMillen)
1748 bronson@trestle.com (Scott Bronson)
1750 Original pingecho():
1751 karrer@bernina.ethz.ch (Andreas Karrer)
1752 pmarquess@bfsec.bt.co.uk (Paul Marquess)
1754 Original Net::Ping author:
1755 mose@ns.ccsn.edu (Russell Mosemann)
1759 Copyright (c) 2002-2003, Rob Brown. All rights reserved.
1761 Copyright (c) 2001, Colin McMillen. All rights reserved.
1763 This program is free software; you may redistribute it and/or
1764 modify it under the same terms as Perl itself.
1766 $Id: Ping.pm,v 1.86 2003/06/27 21:31:07 rob Exp $