7 use vars qw(@ISA @EXPORT $VERSION
8 $def_timeout $def_proto $def_factor
9 $max_datasize $pingstring $hires $source_verify $syn_forking);
10 use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK );
11 use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET SOL_SOCKET SO_ERROR
12 inet_aton inet_ntoa sockaddr_in );
13 use POSIX qw( ENOTCONN ECONNREFUSED ECONNRESET EINPROGRESS EWOULDBLOCK EAGAIN WNOHANG );
18 @EXPORT = qw(pingecho);
26 $def_timeout = 5; # Default timeout to wait for a reply
27 $def_proto = "tcp"; # Default protocol to use for pinging
28 $def_factor = 1.2; # Default exponential backoff rate.
29 $max_datasize = 1024; # Maximum data bytes in a packet
30 # The data we exchange with the server for the stream protocol
31 $pingstring = "pingschwingping!\n";
32 $source_verify = 1; # Default is to verify source endpoint
35 if ($^O =~ /Win32/i) {
36 # Hack to avoid this Win32 spewage:
37 # Your vendor has not defined POSIX macro ECONNREFUSED
38 *ECONNREFUSED = sub {10061;}; # "Unknown Error" Special Win32 Response?
39 *ENOTCONN = sub {10057;};
40 *ECONNRESET = sub {10054;};
41 *EINPROGRESS = sub {10036;};
42 *EWOULDBLOCK = sub {10035;};
43 # $syn_forking = 1; # XXX possibly useful in < Win2K ?
47 # require "asm/socket.ph";
48 sub SO_BINDTODEVICE {25;}
50 # Description: The pingecho() subroutine is provided for backward
51 # compatibility with the original Net::Ping. It accepts a host
52 # name/IP and an optional timeout in seconds. Create a tcp ping
53 # object and try pinging the host. The result of the ping is returned.
57 my ($host, # Name or IP number of host to ping
58 $timeout # Optional timeout in seconds
60 my ($p); # A ping object
62 $p = Net::Ping->new("tcp", $timeout);
63 $p->ping($host); # Going out of scope closes the connection
66 # Description: The new() method creates a new ping object. Optional
67 # parameters may be specified for the protocol to use, the timeout in
68 # seconds and the size in bytes of additional data which should be
69 # included in the packet.
70 # After the optional parameters are checked, the data is constructed
71 # and a socket is opened if appropriate. The object is returned.
76 $proto, # Optional protocol to use for pinging
77 $timeout, # Optional timeout in seconds
78 $data_size, # Optional additional bytes of data
79 $device, # Optional device to use
80 $tos, # Optional ToS to set
82 my $class = ref($this) || $this;
84 my ($cnt, # Count through data bytes
85 $min_datasize # Minimum data bytes required
90 $proto = $def_proto unless $proto; # Determine the protocol
91 croak('Protocol for ping must be "icmp", "udp", "tcp", "syn", "stream", or "external"')
92 unless $proto =~ m/^(icmp|udp|tcp|syn|stream|external)$/;
93 $self->{"proto"} = $proto;
95 $timeout = $def_timeout unless $timeout; # Determine the timeout
96 croak("Default timeout for ping must be greater than 0 seconds")
98 $self->{"timeout"} = $timeout;
100 $self->{"device"} = $device;
102 $self->{"tos"} = $tos;
104 $min_datasize = ($proto eq "udp") ? 1 : 0; # Determine data size
105 $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
106 croak("Data for ping must be from $min_datasize to $max_datasize bytes")
107 if ($data_size < $min_datasize) || ($data_size > $max_datasize);
108 $data_size-- if $self->{"proto"} eq "udp"; # We provide the first byte
109 $self->{"data_size"} = $data_size;
111 $self->{"data"} = ""; # Construct data bytes
112 for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
114 $self->{"data"} .= chr($cnt % 256);
117 $self->{"local_addr"} = undef; # Don't bind by default
118 $self->{"retrans"} = $def_factor; # Default exponential backoff rate
119 $self->{"econnrefused"} = undef; # Default Connection refused behavior
121 $self->{"seq"} = 0; # For counting packets
122 if ($self->{"proto"} eq "udp") # Open a socket
124 $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
125 croak("Can't udp protocol by name");
126 $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
127 croak("Can't get udp echo port by name");
128 $self->{"fh"} = FileHandle->new();
129 socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
130 $self->{"proto_num"}) ||
131 croak("udp socket error - $!");
132 if ($self->{'device'}) {
133 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
134 or croak "error binding to device $self->{'device'} $!";
136 if ($self->{'tos'}) {
137 setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
138 or croak "error configuring tos to $self->{'tos'} $!";
141 elsif ($self->{"proto"} eq "icmp")
143 croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS' and $^O ne 'cygwin');
144 $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
145 croak("Can't get icmp protocol by name");
146 $self->{"pid"} = $$ & 0xffff; # Save lower 16 bits of pid
147 $self->{"fh"} = FileHandle->new();
148 socket($self->{"fh"}, PF_INET, SOCK_RAW, $self->{"proto_num"}) ||
149 croak("icmp socket error - $!");
150 if ($self->{'device'}) {
151 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
152 or croak "error binding to device $self->{'device'} $!";
154 if ($self->{'tos'}) {
155 setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
156 or croak "error configuring tos to $self->{'tos'} $!";
159 elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
161 $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
162 croak("Can't get tcp protocol by name");
163 $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
164 croak("Can't get tcp echo port by name");
165 $self->{"fh"} = FileHandle->new();
167 elsif ($self->{"proto"} eq "syn")
169 $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
170 croak("Can't get tcp protocol by name");
171 $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
172 croak("Can't get tcp echo port by name");
174 $self->{"fork_rd"} = FileHandle->new();
175 $self->{"fork_wr"} = FileHandle->new();
176 pipe($self->{"fork_rd"}, $self->{"fork_wr"});
177 $self->{"fh"} = FileHandle->new();
178 $self->{"good"} = {};
181 $self->{"wbits"} = "";
185 $self->{"stop_time"} = 0;
187 elsif ($self->{"proto"} eq "external")
189 # No preliminary work needs to be done.
195 # Description: Set the local IP address from which pings will be sent.
196 # For ICMP and UDP pings, this calls bind() on the already-opened socket;
197 # for TCP pings, just saves the address to be used when the socket is
198 # opened. Returns non-zero if successful; croaks on error.
202 $local_addr # Name or IP number of local interface
204 my ($ip # Packed IP number of $local_addr
207 croak("Usage: \$p->bind(\$local_addr)") unless @_ == 2;
208 croak("already bound") if defined($self->{"local_addr"}) &&
209 ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp");
211 $ip = inet_aton($local_addr);
212 croak("nonexistent local address $local_addr") unless defined($ip);
213 $self->{"local_addr"} = $ip; # Only used if proto is tcp
215 if ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp")
217 CORE::bind($self->{"fh"}, sockaddr_in(0, $ip)) ||
218 croak("$self->{'proto'} bind error - $!");
220 elsif (($self->{"proto"} ne "tcp") && ($self->{"proto"} ne "syn"))
222 croak("Unknown protocol \"$self->{proto}\" in bind()");
228 # Description: A select() wrapper that compensates for platform
232 if ($_[3] > 0 and $^O eq 'MSWin32') {
233 # On windows, select() doesn't process the message loop,
234 # but sleep() will, allowing alarm() to interrupt the latter.
235 # So we chop up the timeout into smaller pieces and interleave
236 # select() and sleep() calls.
238 my $gran = 0.5; # polling granularity in seconds
241 $gran = $t if $gran > $t;
242 my $nfound = select($_[0], $_[1], $_[2], $gran);
244 return $nfound if $nfound or !defined($nfound) or $t <= 0;
247 ($_[0], $_[1], $_[2]) = @args;
251 return select($_[0], $_[1], $_[2], $_[3]);
255 # Description: Allow UDP source endpoint comparision to be
256 # skipped for those remote interfaces that do
257 # not response from the same endpoint.
262 $source_verify = 1 unless defined
263 ($source_verify = ((defined $self) && (ref $self)) ? shift() : $self);
266 # Description: Set whether or not the connect
267 # behavior should enforce remote service
268 # availability as well as reachability.
273 $self->{"econnrefused"} = 1 unless defined
274 ($self->{"econnrefused"} = shift());
277 sub tcp_service_check
282 # Description: Set exponential backoff for retransmission.
283 # Should be > 1 to retain exponential properties.
284 # If set to 0, retransmissions are disabled.
289 $self->{"retrans"} = shift;
292 # Description: allows the module to use milliseconds as returned by
293 # the Time::HiRes module
299 $hires = 1 unless defined
300 ($hires = ((defined $self) && (ref $self)) ? shift() : $self);
301 require Time::HiRes if $hires;
306 return $hires ? Time::HiRes::time() : CORE::time();
309 # Description: Sets or clears the O_NONBLOCK flag on a file handle.
310 sub socket_blocking_mode
313 $fh, # the file handle whose flags are to be modified
314 $block) = @_; # if true then set the blocking
315 # mode (clear O_NONBLOCK), otherwise
316 # set the non-blocking mode (set O_NONBLOCK)
319 if ($^O eq 'MSWin32' || $^O eq 'VMS') {
320 # FIONBIO enables non-blocking sockets on windows and vms.
321 # FIONBIO is (0x80000000|(4<<16)|(ord('f')<<8)|126), as per winsock.h, ioctl.h
323 my $v = pack("L", $block ? 0 : 1);
324 ioctl($fh, $f, $v) or croak("ioctl failed: $!");
327 if ($flags = fcntl($fh, F_GETFL, 0)) {
328 $flags = $block ? ($flags & ~O_NONBLOCK) : ($flags | O_NONBLOCK);
329 if (!fcntl($fh, F_SETFL, $flags)) {
330 croak("fcntl F_SETFL: $!");
333 croak("fcntl F_GETFL: $!");
337 # Description: Ping a host name or IP number with an optional timeout.
338 # First lookup the host, and return undef if it is not found. Otherwise
339 # perform the specific ping method based on the protocol. Return the
340 # result of the ping.
345 $host, # Name or IP number of host to ping
346 $timeout, # Seconds after which ping times out
348 my ($ip, # Packed IP number of $host
349 $ret, # The return value
350 $ping_time, # When ping began
353 croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
354 $timeout = $self->{"timeout"} unless $timeout;
355 croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
357 $ip = inet_aton($host);
358 return () unless defined($ip); # Does host exist?
360 # Dispatch to the appropriate routine.
361 $ping_time = &time();
362 if ($self->{"proto"} eq "external") {
363 $ret = $self->ping_external($ip, $timeout);
365 elsif ($self->{"proto"} eq "udp") {
366 $ret = $self->ping_udp($ip, $timeout);
368 elsif ($self->{"proto"} eq "icmp") {
369 $ret = $self->ping_icmp($ip, $timeout);
371 elsif ($self->{"proto"} eq "tcp") {
372 $ret = $self->ping_tcp($ip, $timeout);
374 elsif ($self->{"proto"} eq "stream") {
375 $ret = $self->ping_stream($ip, $timeout);
377 elsif ($self->{"proto"} eq "syn") {
378 $ret = $self->ping_syn($host, $ip, $ping_time, $ping_time+$timeout);
380 croak("Unknown protocol \"$self->{proto}\" in ping()");
383 return wantarray ? ($ret, &time() - $ping_time, inet_ntoa($ip)) : $ret;
386 # Uses Net::Ping::External to do an external ping.
389 $ip, # Packed IP number of the host
390 $timeout # Seconds after which ping times out
393 eval { require Net::Ping::External; }
394 or croak('Protocol "external" not supported on your system: Net::Ping::External not found');
395 return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
398 use constant ICMP_ECHOREPLY => 0; # ICMP packet types
399 use constant ICMP_ECHO => 8;
400 use constant ICMP_STRUCT => "C2 n3 A"; # Structure of a minimal ICMP packet
401 use constant SUBCODE => 0; # No ICMP subcode for ECHO and ECHOREPLY
402 use constant ICMP_FLAGS => 0; # No special flags for send or recv
403 use constant ICMP_PORT => 0; # No port with ICMP
408 $ip, # Packed IP number of the host
409 $timeout # Seconds after which ping times out
412 my ($saddr, # sockaddr_in with port and ip
413 $checksum, # Checksum of ICMP packet
414 $msg, # ICMP packet to send
415 $len_msg, # Length of $msg
416 $rbits, # Read bits, filehandles for reading
417 $nfound, # Number of ready filehandles found
418 $finish_time, # Time ping should be finished
419 $done, # set to 1 when we are done
421 $recv_msg, # Received message including IP header
422 $from_saddr, # sockaddr_in of sender
423 $from_port, # Port packet was sent from
424 $from_ip, # Packed IP of sender
425 $from_type, # ICMP type
426 $from_subcode, # ICMP subcode
427 $from_chk, # ICMP packet checksum
428 $from_pid, # ICMP packet id
429 $from_seq, # ICMP packet sequence
430 $from_msg # ICMP message
433 $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
434 $checksum = 0; # No checksum for starters
435 $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
436 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
437 $checksum = Net::Ping->checksum($msg);
438 $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
439 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
440 $len_msg = length($msg);
441 $saddr = sockaddr_in(ICMP_PORT, $ip);
442 $self->{"from_ip"} = undef;
443 $self->{"from_type"} = undef;
444 $self->{"from_subcode"} = undef;
445 send($self->{"fh"}, $msg, ICMP_FLAGS, $saddr); # Send the message
448 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
451 $finish_time = &time() + $timeout; # Must be done by this time
452 while (!$done && $timeout > 0) # Keep trying if we have time
454 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for packet
455 $timeout = $finish_time - &time(); # Get remaining time
456 if (!defined($nfound)) # Hmm, a strange error
461 elsif ($nfound) # Got a packet from somewhere
466 $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, ICMP_FLAGS);
467 ($from_port, $from_ip) = sockaddr_in($from_saddr);
468 ($from_type, $from_subcode) = unpack("C2", substr($recv_msg, 20, 2));
469 if ($from_type == ICMP_ECHOREPLY) {
470 ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 24, 4))
471 if length $recv_msg >= 28;
473 ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 52, 4))
474 if length $recv_msg >= 56;
476 $self->{"from_ip"} = $from_ip;
477 $self->{"from_type"} = $from_type;
478 $self->{"from_subcode"} = $from_subcode;
479 if (($from_pid == $self->{"pid"}) && # Does the packet check out?
480 ($from_seq == $self->{"seq"})) {
481 if ($from_type == ICMP_ECHOREPLY){
486 } else { # Oops, timed out
495 my $ip = $self->{"from_ip"} || "";
496 $ip = "\0\0\0\0" unless 4 == length $ip;
497 return (inet_ntoa($ip),($self->{"from_type"} || 0), ($self->{"from_subcode"} || 0));
500 # Description: Do a checksum on the message. Basically sum all of
501 # the short words and fold the high order bits into the low order bits.
506 $msg # The message to checksum
508 my ($len_msg, # Length of the message
509 $num_short, # The number of short words in the message
510 $short, # One short word
514 $len_msg = length($msg);
515 $num_short = int($len_msg / 2);
517 foreach $short (unpack("n$num_short", $msg))
520 } # Add the odd byte in
521 $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
522 $chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low
523 return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement
527 # Description: Perform a tcp echo ping. Since a tcp connection is
528 # host specific, we have to open and close each connection here. We
529 # can't just leave a socket open. Because of the robust nature of
530 # tcp, it will take a while before it gives up trying to establish a
531 # connection. Therefore, we use select() on a non-blocking socket to
532 # check against our timeout. No data bytes are actually
533 # sent since the successful establishment of a connection is proof
534 # enough of the reachability of the remote host. Also, tcp is
535 # expensive and doesn't need our help to add to the overhead.
540 $ip, # Packed IP number of the host
541 $timeout # Seconds after which ping times out
543 my ($ret # The return value
547 $ret = $self -> tcp_connect( $ip, $timeout);
548 if (!$self->{"econnrefused"} &&
549 $! == ECONNREFUSED) {
550 $ret = 1; # "Connection refused" means reachable
552 $self->{"fh"}->close();
559 $ip, # Packed IP number of the host
560 $timeout # Seconds after which connect times out
562 my ($saddr); # Packed IP and Port
564 $saddr = sockaddr_in($self->{"port_num"}, $ip);
566 my $ret = 0; # Default to unreachable
568 my $do_socket = sub {
569 socket($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"}) ||
570 croak("tcp socket error - $!");
571 if (defined $self->{"local_addr"} &&
572 !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
573 croak("tcp bind error - $!");
575 if ($self->{'device'}) {
576 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
577 or croak("error binding to device $self->{'device'} $!");
579 if ($self->{'tos'}) {
580 setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
581 or croak "error configuring tos to $self->{'tos'} $!";
584 my $do_connect = sub {
586 # ECONNREFUSED is 10061 on MSWin32. If we pass it as child error through $?,
587 # we'll get (10061 & 255) = 77, so we cannot check it in the parent process.
588 return ($ret = connect($self->{"fh"}, $saddr) || ($! == ECONNREFUSED && !$self->{"econnrefused"}));
590 my $do_connect_nb = sub {
591 # Set O_NONBLOCK property on filehandle
592 $self->socket_blocking_mode($self->{"fh"}, 0);
594 # start the connection attempt
595 if (!connect($self->{"fh"}, $saddr)) {
596 if ($! == ECONNREFUSED) {
597 $ret = 1 unless $self->{"econnrefused"};
598 } elsif ($! != EINPROGRESS && ($^O ne 'MSWin32' || $! != EWOULDBLOCK)) {
599 # EINPROGRESS is the expected error code after a connect()
600 # on a non-blocking socket. But if the kernel immediately
601 # determined that this connect() will never work,
602 # Simply respond with "unreachable" status.
603 # (This can occur on some platforms with errno
604 # EHOSTUNREACH or ENETUNREACH.)
607 # Got the expected EINPROGRESS.
608 # Just wait for connection completion...
609 my ($wbits, $wout, $wexc);
610 $wout = $wexc = $wbits = "";
611 vec($wbits, $self->{"fh"}->fileno, 1) = 1;
613 my $nfound = mselect(undef,
615 ($^O eq 'MSWin32' ? ($wexc = $wbits) : undef),
617 warn("select: $!") unless defined $nfound;
619 if ($nfound && vec($wout, $self->{"fh"}->fileno, 1)) {
620 # the socket is ready for writing so the connection
621 # attempt completed. test whether the connection
622 # attempt was successful or not
624 if (getpeername($self->{"fh"})) {
625 # Connection established to remote host
628 # TCP ACK will never come from this host
629 # because there was an error connecting.
631 # This should set $! to the correct error.
633 sysread($self->{"fh"},$char,1);
634 $! = ECONNREFUSED if ($! == EAGAIN && $^O =~ /cygwin/i);
636 $ret = 1 if (!$self->{"econnrefused"}
637 && $! == ECONNREFUSED);
640 # the connection attempt timed out (or there were connect
642 if ($^O =~ 'MSWin32') {
643 # If the connect will fail on a non-blocking socket,
644 # winsock reports ECONNREFUSED as an exception, and we
645 # need to fetch the socket-level error code via getsockopt()
646 # instead of using the thread-level error code that is in $!.
647 if ($nfound && vec($wexc, $self->{"fh"}->fileno, 1)) {
648 $! = unpack("i", getsockopt($self->{"fh"}, SOL_SOCKET,
655 # Connection established to remote host
659 # Unset O_NONBLOCK property on filehandle
660 $self->socket_blocking_mode($self->{"fh"}, 1);
666 # Buggy Winsock API doesn't allow nonblocking connect.
667 # Hence, if our OS is Windows, we need to create a separate
668 # process to do the blocking connect attempt.
669 # XXX Above comments are not true at least for Win2K, where
670 # nonblocking connect works.
672 $| = 1; # Clear buffer prior to fork to prevent duplicate flushing.
673 $self->{'tcp_chld'} = fork;
674 if (!$self->{'tcp_chld'}) {
675 if (!defined $self->{'tcp_chld'}) {
677 warn "Fork error: $!";
682 # Try a slow blocking connect() call
683 # and report the status to the parent.
684 if ( &{ $do_connect }() ) {
685 $self->{"fh"}->close();
689 # Pass the error status to the parent
690 # Make sure that $! <= 255
691 exit($! <= 255 ? $! : 255);
697 my $patience = &time() + $timeout;
699 my ($child, $child_errno);
700 $? = 0; $child_errno = 0;
701 # Wait up to the timeout
702 # And clean off the zombie
704 $child = waitpid($self->{'tcp_chld'}, &WNOHANG());
705 $child_errno = $? >> 8;
706 select(undef, undef, undef, 0.1);
707 } while &time() < $patience && $child != $self->{'tcp_chld'};
709 if ($child == $self->{'tcp_chld'}) {
710 if ($self->{"proto"} eq "stream") {
711 # We need the socket connected here, in parent
712 # Should be safe to connect because the child finished
716 # $ret cannot be set by the child process
717 $ret = !$child_errno;
719 # Time must have run out.
720 # Put that choking client out of its misery
721 kill "KILL", $self->{'tcp_chld'};
722 # Clean off the zombie
723 waitpid($self->{'tcp_chld'}, 0);
726 delete $self->{'tcp_chld'};
729 # Otherwise don't waste the resources to fork
733 &{ $do_connect_nb }();
741 if ($self->{'proto'} eq 'tcp' &&
742 $self->{'tcp_chld'}) {
743 # Put that choking client out of its misery
744 kill "KILL", $self->{'tcp_chld'};
745 # Clean off the zombie
746 waitpid($self->{'tcp_chld'}, 0);
750 # This writes the given string to the socket and then reads it
751 # back. It returns 1 on success, 0 on failure.
756 my $pingstring = shift;
760 my $wrstr = $pingstring;
766 vec($rin, $self->{"fh"}->fileno(), 1) = 1;
771 vec($rout, $self->{"fh"}->fileno(), 1) = 1;
774 if(mselect($rin, $rout, undef, ($time + $timeout) - &time())) {
776 if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
777 my $num = syswrite($self->{"fh"}, $wrstr, length $wrstr);
779 # If it was a partial write, update and try again.
780 $wrstr = substr($wrstr,$num);
782 # There was an error.
787 if(vec($rin,$self->{"fh"}->fileno(),1)) {
789 if(sysread($self->{"fh"},$reply,length($pingstring)-length($rdstr))) {
791 $ret = 1 if $rdstr eq $pingstring;
793 # There was an error.
799 } until &time() > ($time + $timeout) || defined($ret);
808 # Description: Perform a stream ping. If the tcp connection isn't
809 # already open, it opens it. It then sends some data and waits for
810 # a reply. It leaves the stream open on exit.
815 $ip, # Packed IP number of the host
816 $timeout # Seconds after which ping times out
819 # Open the stream if it's not already open
820 if(!defined $self->{"fh"}->fileno()) {
821 $self->tcp_connect($ip, $timeout) or return 0;
824 croak "tried to switch servers while stream pinging"
825 if $self->{"ip"} ne $ip;
827 return $self->tcp_echo($timeout, $pingstring);
830 # Description: opens the stream. You would do this if you want to
831 # separate the overhead of opening the stream from the first ping.
836 $host, # Host or IP address
837 $timeout # Seconds after which open times out
840 my ($ip); # Packed IP number of the host
841 $ip = inet_aton($host);
842 $timeout = $self->{"timeout"} unless $timeout;
844 if($self->{"proto"} eq "stream") {
845 if(defined($self->{"fh"}->fileno())) {
846 croak("socket is already open");
848 $self->tcp_connect($ip, $timeout);
854 # Description: Perform a udp echo ping. Construct a message of
855 # at least the one-byte sequence number and any additional data bytes.
856 # Send the message out and wait for a message to come back. If we
857 # get a message, make sure all of its parts match. If they do, we are
858 # done. Otherwise go back and wait for the message until we run out
859 # of time. Return the result of our efforts.
861 use constant UDP_FLAGS => 0; # Nothing special on send or recv
865 $ip, # Packed IP number of the host
866 $timeout # Seconds after which ping times out
869 my ($saddr, # sockaddr_in with port and ip
870 $ret, # The return value
871 $msg, # Message to be echoed
872 $finish_time, # Time ping should be finished
873 $flush, # Whether socket needs to be disconnected
874 $connect, # Whether socket needs to be connected
875 $done, # Set to 1 when we are done pinging
876 $rbits, # Read bits, filehandles for reading
877 $nfound, # Number of ready filehandles found
878 $from_saddr, # sockaddr_in of sender
879 $from_msg, # Characters echoed by $host
880 $from_port, # Port message was echoed from
881 $from_ip # Packed IP number of sender
884 $saddr = sockaddr_in($self->{"port_num"}, $ip);
885 $self->{"seq"} = ($self->{"seq"} + 1) % 256; # Increment sequence
886 $msg = chr($self->{"seq"}) . $self->{"data"}; # Add data if any
888 if ($self->{"connected"}) {
889 if ($self->{"connected"} ne $saddr) {
890 # Still connected to wrong destination.
891 # Need to flush out the old one.
896 # Need to connect() before send()
900 # Have to connect() and send() instead of sendto()
901 # in order to pick up on the ECONNREFUSED setting
902 # from recv() or double send() errno as utilized in
903 # the concept by rdw @ perlmonks. See:
904 # http://perlmonks.thepen.com/42898.html
906 # Need to socket() again to flush the descriptor
907 # This will disconnect from the old saddr.
908 socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
909 $self->{"proto_num"});
911 # Connect the socket if it isn't already connected
912 # to the right destination.
913 if ($flush || $connect) {
914 connect($self->{"fh"}, $saddr); # Tie destination to socket
915 $self->{"connected"} = $saddr;
917 send($self->{"fh"}, $msg, UDP_FLAGS); # Send it
920 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
921 $ret = 0; # Default to unreachable
924 my $factor = $self->{"retrans"};
925 $finish_time = &time() + $timeout; # Ping needs to be done by then
926 while (!$done && $timeout > 0)
930 $timeout = $retrans if $timeout > $retrans;
931 $retrans*= $factor; # Exponential backoff
933 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for response
935 $timeout = $finish_time - &time(); # Get remaining time
937 if (!defined($nfound)) # Hmm, a strange error
942 elsif ($nfound) # A packet is waiting
945 $from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS);
947 # For example an unreachable host will make recv() fail.
948 if (!$self->{"econnrefused"} &&
949 ($! == ECONNREFUSED ||
951 # "Connection refused" means reachable
957 ($from_port, $from_ip) = sockaddr_in($from_saddr);
958 if (!$source_verify ||
959 (($from_ip eq $ip) && # Does the packet check out?
960 ($from_port == $self->{"port_num"}) &&
961 ($from_msg eq $msg)))
963 $ret = 1; # It's a winner
968 elsif ($timeout <= 0) # Oops, timed out
974 # Send another in case the last one dropped
975 if (send($self->{"fh"}, $msg, UDP_FLAGS)) {
976 # Another send worked? The previous udp packet
977 # must have gotten lost or is still in transit.
978 # Hopefully this new packet will arrive safely.
980 if (!$self->{"econnrefused"} &&
981 $! == ECONNREFUSED) {
982 # "Connection refused" means reachable
993 # Description: Send a TCP SYN packet to host specified.
999 my $start_time = shift;
1000 my $stop_time = shift;
1003 return $self->ping_syn_fork($host, $ip, $start_time, $stop_time);
1006 my $fh = FileHandle->new();
1007 my $saddr = sockaddr_in($self->{"port_num"}, $ip);
1010 if (!socket ($fh, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
1011 croak("tcp socket error - $!");
1014 if (defined $self->{"local_addr"} &&
1015 !CORE::bind($fh, sockaddr_in(0, $self->{"local_addr"}))) {
1016 croak("tcp bind error - $!");
1019 if ($self->{'device'}) {
1020 setsockopt($fh, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
1021 or croak("error binding to device $self->{'device'} $!");
1023 if ($self->{'tos'}) {
1024 setsockopt($fh, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
1025 or croak "error configuring tos to $self->{'tos'} $!";
1027 # Set O_NONBLOCK property on filehandle
1028 $self->socket_blocking_mode($fh, 0);
1030 # Attempt the non-blocking connect
1031 # by just sending the TCP SYN packet
1032 if (connect($fh, $saddr)) {
1033 # Non-blocking, yet still connected?
1034 # Must have connected very quickly,
1035 # or else it wasn't very non-blocking.
1036 #warn "WARNING: Nonblocking connect connected anyway? ($^O)";
1038 # Error occurred connecting.
1039 if ($! == EINPROGRESS || ($^O eq 'MSWin32' && $! == EWOULDBLOCK)) {
1040 # The connection is just still in progress.
1041 # This is the expected condition.
1043 # Just save the error and continue on.
1044 # The ack() can check the status later.
1045 $self->{"bad"}->{$host} = $!;
1049 my $entry = [ $host, $ip, $fh, $start_time, $stop_time ];
1050 $self->{"syn"}->{$fh->fileno} = $entry;
1051 if ($self->{"stop_time"} < $stop_time) {
1052 $self->{"stop_time"} = $stop_time;
1054 vec($self->{"wbits"}, $fh->fileno, 1) = 1;
1060 my ($self, $host, $ip, $start_time, $stop_time) = @_;
1062 # Buggy Winsock API doesn't allow nonblocking connect.
1063 # Hence, if our OS is Windows, we need to create a separate
1064 # process to do the blocking connect attempt.
1069 my $entry = [ $host, $ip, $pid, $start_time, $stop_time ];
1070 $self->{"syn"}->{$pid} = $entry;
1071 if ($self->{"stop_time"} < $stop_time) {
1072 $self->{"stop_time"} = $stop_time;
1076 my $saddr = sockaddr_in($self->{"port_num"}, $ip);
1079 if (!socket ($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
1080 croak("tcp socket error - $!");
1083 if (defined $self->{"local_addr"} &&
1084 !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
1085 croak("tcp bind error - $!");
1088 if ($self->{'device'}) {
1089 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
1090 or croak("error binding to device $self->{'device'} $!");
1092 if ($self->{'tos'}) {
1093 setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
1094 or croak "error configuring tos to $self->{'tos'} $!";
1098 # Try to connect (could take a long time)
1099 connect($self->{"fh"}, $saddr);
1100 # Notify parent of connect error status
1102 my $wrstr = "$$ $err";
1103 # Force to 16 chars including \n
1104 $wrstr .= " "x(15 - length $wrstr). "\n";
1105 syswrite($self->{"fork_wr"}, $wrstr, length $wrstr);
1115 # Description: Wait for TCP ACK from host specified
1116 # from ping_syn above. If no host is specified, wait
1117 # for TCP ACK from any of the hosts in the SYN queue.
1122 if ($self->{"proto"} eq "syn") {
1124 my @answer = $self->ack_unfork(shift);
1125 return wantarray ? @answer : $answer[0];
1129 if (my $host = shift) {
1130 # Host passed as arg
1131 if (exists $self->{"bad"}->{$host}) {
1132 if (!$self->{"econnrefused"} &&
1133 $self->{"bad"}->{ $host } &&
1134 (($! = ECONNREFUSED)>0) &&
1135 $self->{"bad"}->{ $host } eq "$!") {
1136 # "Connection refused" means reachable
1139 # ECONNREFUSED means no good
1143 my $host_fd = undef;
1144 foreach my $fd (keys %{ $self->{"syn"} }) {
1145 my $entry = $self->{"syn"}->{$fd};
1146 if ($entry->[0] eq $host) {
1148 $stop_time = $entry->[4]
1149 || croak("Corrupted SYN entry for [$host]");
1153 croak("ack called on [$host] without calling ping first!")
1154 unless defined $host_fd;
1155 vec($wbits, $host_fd, 1) = 1;
1157 # No $host passed so scan all hosts
1158 # Use the latest stop_time
1159 $stop_time = $self->{"stop_time"};
1161 $wbits = $self->{"wbits"};
1164 while ($wbits !~ /^\0*\z/) {
1165 my $timeout = $stop_time - &time();
1166 # Force a minimum of 10 ms timeout.
1167 $timeout = 0.01 if $timeout <= 0.01;
1169 my $winner_fd = undef;
1172 # Do "bad" fds from $wbits first
1173 while ($wout !~ /^\0*\z/) {
1174 if (vec($wout, $fd, 1)) {
1175 # Wipe it from future scanning.
1176 vec($wout, $fd, 1) = 0;
1177 if (my $entry = $self->{"syn"}->{$fd}) {
1178 if ($self->{"bad"}->{ $entry->[0] }) {
1187 if (defined($winner_fd) or my $nfound = mselect(undef, ($wout=$wbits), undef, $timeout)) {
1188 if (defined $winner_fd) {
1191 # Done waiting for one of the ACKs
1193 # Determine which one
1194 while ($wout !~ /^\0*\z/ &&
1195 !vec($wout, $fd, 1)) {
1199 if (my $entry = $self->{"syn"}->{$fd}) {
1200 # Wipe it from future scanning.
1201 delete $self->{"syn"}->{$fd};
1202 vec($self->{"wbits"}, $fd, 1) = 0;
1203 vec($wbits, $fd, 1) = 0;
1204 if (!$self->{"econnrefused"} &&
1205 $self->{"bad"}->{ $entry->[0] } &&
1206 (($! = ECONNREFUSED)>0) &&
1207 $self->{"bad"}->{ $entry->[0] } eq "$!") {
1208 # "Connection refused" means reachable
1210 } elsif (getpeername($entry->[2])) {
1211 # Connection established to remote host
1214 # TCP ACK will never come from this host
1215 # because there was an error connecting.
1217 # This should set $! to the correct error.
1219 sysread($entry->[2],$char,1);
1220 # Store the excuse why the connection failed.
1221 $self->{"bad"}->{$entry->[0]} = $!;
1222 if (!$self->{"econnrefused"} &&
1223 (($! == ECONNREFUSED) ||
1224 ($! == EAGAIN && $^O =~ /cygwin/i))) {
1225 # "Connection refused" means reachable
1228 # No good, try the next socket...
1232 # Everything passed okay, return the answer
1234 ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
1237 warn "Corrupted SYN entry: unknown fd [$fd] ready!";
1238 vec($wbits, $fd, 1) = 0;
1239 vec($self->{"wbits"}, $fd, 1) = 0;
1241 } elsif (defined $nfound) {
1242 # Timed out waiting for ACK
1243 foreach my $fd (keys %{ $self->{"syn"} }) {
1244 if (vec($wbits, $fd, 1)) {
1245 my $entry = $self->{"syn"}->{$fd};
1246 $self->{"bad"}->{$entry->[0]} = "Timed out";
1247 vec($wbits, $fd, 1) = 0;
1248 vec($self->{"wbits"}, $fd, 1) = 0;
1249 delete $self->{"syn"}->{$fd};
1253 # Weird error occurred with select()
1255 $self->{"syn"} = {};
1264 my ($self,$host) = @_;
1265 my $stop_time = $self->{"stop_time"};
1267 # Host passed as arg
1268 if (my $entry = $self->{"good"}->{$host}) {
1269 delete $self->{"good"}->{$host};
1270 return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
1277 if (keys %{ $self->{"syn"} }) {
1278 # Scan all hosts that are left
1279 vec($rbits, fileno($self->{"fork_rd"}), 1) = 1;
1280 $timeout = $stop_time - &time();
1281 # Force a minimum of 10 ms timeout.
1282 $timeout = 0.01 if $timeout < 0.01;
1284 # No hosts left to wait for
1290 while ( keys %{ $self->{"syn"} } and
1291 $nfound = mselect((my $rout=$rbits), undef, undef, $timeout)) {
1292 # Done waiting for one of the ACKs
1293 if (!sysread($self->{"fork_rd"}, $_, 16)) {
1294 # Socket closed, which means all children are done.
1297 my ($pid, $how) = split;
1301 if (my $entry = $self->{"syn"}->{$pid}) {
1302 # Connection attempt to remote host is done
1303 delete $self->{"syn"}->{$pid};
1304 if (!$how || # If there was no error connecting
1305 (!$self->{"econnrefused"} &&
1306 $how == ECONNREFUSED)) { # "Connection refused" means reachable
1307 if ($host && $entry->[0] ne $host) {
1308 # A good connection, but not the host we need.
1309 # Move it from the "syn" hash to the "good" hash.
1310 $self->{"good"}->{$entry->[0]} = $entry;
1311 # And wait for the next winner
1314 return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
1317 # Should never happen
1318 die "Unknown ping from pid [$pid]";
1321 die "Empty response from status socket?";
1324 if (defined $nfound) {
1325 # Timed out waiting for ACK status
1327 # Weird error occurred with select()
1331 if (my @synners = keys %{ $self->{"syn"} }) {
1332 # Kill all the synners
1334 foreach my $pid (@synners) {
1335 # Wait for the deaths to finish
1336 # Then flush off the zombie
1340 $self->{"syn"} = {};
1344 # Description: Tell why the ack() failed
1347 my $host = shift || croak('Usage> nack($failed_ack_host)');
1348 return $self->{"bad"}->{$host} || undef;
1351 # Description: Close the connection.
1357 if ($self->{"proto"} eq "syn") {
1358 delete $self->{"syn"};
1359 } elsif ($self->{"proto"} eq "tcp") {
1360 # The connection will already be closed
1362 $self->{"fh"}->close();
1372 Net::Ping - check a remote host for reachability
1378 $p = Net::Ping->new();
1379 print "$host is alive.\n" if $p->ping($host);
1382 $p = Net::Ping->new("icmp");
1383 $p->bind($my_addr); # Specify source interface of pings
1384 foreach $host (@host_array)
1387 print "NOT " unless $p->ping($host, 2);
1388 print "reachable.\n";
1393 $p = Net::Ping->new("tcp", 2);
1394 # Try connecting to the www port instead of the echo port
1395 $p->{port_num} = getservbyname("http", "tcp");
1396 while ($stop_time > time())
1398 print "$host not reachable ", scalar(localtime()), "\n"
1399 unless $p->ping($host);
1404 # Like tcp protocol, but with many hosts
1405 $p = Net::Ping->new("syn");
1406 $p->{port_num} = getservbyname("http", "tcp");
1407 foreach $host (@host_array) {
1410 while (($host,$rtt,$ip) = $p->ack) {
1411 print "HOST: $host [$ip] ACKed in $rtt seconds.\n";
1414 # High precision syntax (requires Time::HiRes)
1415 $p = Net::Ping->new();
1417 ($ret, $duration, $ip) = $p->ping($host, 5.5);
1418 printf("$host [ip: $ip] is alive (packet return time: %.2f ms)\n", 1000 * $duration)
1422 # For backward compatibility
1423 print "$host is alive.\n" if pingecho($host);
1427 This module contains methods to test the reachability of remote
1428 hosts on a network. A ping object is first created with optional
1429 parameters, a variable number of hosts may be pinged multiple
1430 times and then the connection is closed.
1432 You may choose one of six different protocols to use for the
1433 ping. The "tcp" protocol is the default. Note that a live remote host
1434 may still fail to be pingable by one or more of these protocols. For
1435 example, www.microsoft.com is generally alive but not "icmp" pingable.
1437 With the "tcp" protocol the ping() method attempts to establish a
1438 connection to the remote host's echo port. If the connection is
1439 successfully established, the remote host is considered reachable. No
1440 data is actually echoed. This protocol does not require any special
1441 privileges but has higher overhead than the "udp" and "icmp" protocols.
1443 Specifying the "udp" protocol causes the ping() method to send a udp
1444 packet to the remote host's echo port. If the echoed packet is
1445 received from the remote host and the received packet contains the
1446 same data as the packet that was sent, the remote host is considered
1447 reachable. This protocol does not require any special privileges.
1448 It should be borne in mind that, for a udp ping, a host
1449 will be reported as unreachable if it is not running the
1450 appropriate echo service. For Unix-like systems see L<inetd(8)>
1451 for more information.
1453 If the "icmp" protocol is specified, the ping() method sends an icmp
1454 echo message to the remote host, which is what the UNIX ping program
1455 does. If the echoed message is received from the remote host and
1456 the echoed information is correct, the remote host is considered
1457 reachable. Specifying the "icmp" protocol requires that the program
1458 be run as root or that the program be setuid to root.
1460 If the "external" protocol is specified, the ping() method attempts to
1461 use the C<Net::Ping::External> module to ping the remote host.
1462 C<Net::Ping::External> interfaces with your system's default C<ping>
1463 utility to perform the ping, and generally produces relatively
1464 accurate results. If C<Net::Ping::External> if not installed on your
1465 system, specifying the "external" protocol will result in an error.
1467 If the "syn" protocol is specified, the ping() method will only
1468 send a TCP SYN packet to the remote host then immediately return.
1469 If the syn packet was sent successfully, it will return a true value,
1470 otherwise it will return false. NOTE: Unlike the other protocols,
1471 the return value does NOT determine if the remote host is alive or
1472 not since the full TCP three-way handshake may not have completed
1473 yet. The remote host is only considered reachable if it receives
1474 a TCP ACK within the timeout specifed. To begin waiting for the
1475 ACK packets, use the ack() method as explained below. Use the
1476 "syn" protocol instead the "tcp" protocol to determine reachability
1477 of multiple destinations simultaneously by sending parallel TCP
1478 SYN packets. It will not block while testing each remote host.
1479 demo/fping is provided in this distribution to demonstrate the
1480 "syn" protocol as an example.
1481 This protocol does not require any special privileges.
1487 =item Net::Ping->new([$proto [, $def_timeout [, $bytes [, $device [, $tos ]]]]]);
1489 Create a new ping object. All of the parameters are optional. $proto
1490 specifies the protocol to use when doing a ping. The current choices
1491 are "tcp", "udp", "icmp", "stream", "syn", or "external".
1492 The default is "tcp".
1494 If a default timeout ($def_timeout) in seconds is provided, it is used
1495 when a timeout is not given to the ping() method (below). The timeout
1496 must be greater than 0 and the default, if not specified, is 5 seconds.
1498 If the number of data bytes ($bytes) is given, that many data bytes
1499 are included in the ping packet sent to the remote host. The number of
1500 data bytes is ignored if the protocol is "tcp". The minimum (and
1501 default) number of data bytes is 1 if the protocol is "udp" and 0
1502 otherwise. The maximum number of data bytes that can be specified is
1505 If $device is given, this device is used to bind the source endpoint
1506 before sending the ping packet. I beleive this only works with
1507 superuser privileges and with udp and icmp protocols at this time.
1509 If $tos is given, this ToS is configured into the soscket.
1511 =item $p->ping($host [, $timeout]);
1513 Ping the remote host and wait for a response. $host can be either the
1514 hostname or the IP number of the remote host. The optional timeout
1515 must be greater than 0 seconds and defaults to whatever was specified
1516 when the ping object was created. Returns a success flag. If the
1517 hostname cannot be found or there is a problem with the IP number, the
1518 success flag returned will be undef. Otherwise, the success flag will
1519 be 1 if the host is reachable and 0 if it is not. For most practical
1520 purposes, undef and 0 and can be treated as the same case. In array
1521 context, the elapsed time as well as the string form of the ip the
1522 host resolved to are also returned. The elapsed time value will
1523 be a float, as retuned by the Time::HiRes::time() function, if hires()
1524 has been previously called, otherwise it is returned as an integer.
1526 =item $p->source_verify( { 0 | 1 } );
1528 Allows source endpoint verification to be enabled or disabled.
1529 This is useful for those remote destinations with multiples
1530 interfaces where the response may not originate from the same
1531 endpoint that the original destination endpoint was sent to.
1532 This only affects udp and icmp protocol pings.
1534 This is enabled by default.
1536 =item $p->service_check( { 0 | 1 } );
1538 Set whether or not the connect behavior should enforce
1539 remote service availability as well as reachability. Normally,
1540 if the remote server reported ECONNREFUSED, it must have been
1541 reachable because of the status packet that it reported.
1542 With this option enabled, the full three-way tcp handshake
1543 must have been established successfully before it will
1544 claim it is reachable. NOTE: It still does nothing more
1545 than connect and disconnect. It does not speak any protocol
1546 (i.e., HTTP or FTP) to ensure the remote server is sane in
1547 any way. The remote server CPU could be grinding to a halt
1548 and unresponsive to any clients connecting, but if the kernel
1549 throws the ACK packet, it is considered alive anyway. To
1550 really determine if the server is responding well would be
1551 application specific and is beyond the scope of Net::Ping.
1552 For udp protocol, enabling this option demands that the
1553 remote server replies with the same udp data that it was sent
1554 as defined by the udp echo service.
1556 This affects the "udp", "tcp", and "syn" protocols.
1558 This is disabled by default.
1560 =item $p->tcp_service_check( { 0 | 1 } );
1562 Depricated method, but does the same as service_check() method.
1564 =item $p->hires( { 0 | 1 } );
1566 Causes this module to use Time::HiRes module, allowing milliseconds
1567 to be returned by subsequent calls to ping().
1569 This is disabled by default.
1571 =item $p->bind($local_addr);
1573 Sets the source address from which pings will be sent. This must be
1574 the address of one of the interfaces on the local host. $local_addr
1575 may be specified as a hostname or as a text IP address such as
1578 If the protocol is set to "tcp", this method may be called any
1579 number of times, and each call to the ping() method (below) will use
1580 the most recent $local_addr. If the protocol is "icmp" or "udp",
1581 then bind() must be called at most once per object, and (if it is
1582 called at all) must be called before the first call to ping() for that
1585 =item $p->open($host);
1587 When you are using the "stream" protocol, this call pre-opens the
1588 tcp socket. It's only necessary to do this if you want to
1589 provide a different timeout when creating the connection, or
1590 remove the overhead of establishing the connection from the
1591 first ping. If you don't call C<open()>, the connection is
1592 automatically opened the first time C<ping()> is called.
1593 This call simply does nothing if you are using any protocol other
1596 =item $p->ack( [ $host ] );
1598 When using the "syn" protocol, use this method to determine
1599 the reachability of the remote host. This method is meant
1600 to be called up to as many times as ping() was called. Each
1601 call returns the host (as passed to ping()) that came back
1602 with the TCP ACK. The order in which the hosts are returned
1603 may not necessarily be the same order in which they were
1604 SYN queued using the ping() method. If the timeout is
1605 reached before the TCP ACK is received, or if the remote
1606 host is not listening on the port attempted, then the TCP
1607 connection will not be established and ack() will return
1608 undef. In list context, the host, the ack time, and the
1609 dotted ip string will be returned instead of just the host.
1610 If the optional $host argument is specified, the return
1611 value will be partaining to that host only.
1612 This call simply does nothing if you are using any protocol
1615 =item $p->nack( $failed_ack_host );
1617 The reason that host $failed_ack_host did not receive a
1618 valid ACK. Useful to find out why when ack( $fail_ack_host )
1619 returns a false value.
1623 Close the network connection for this ping object. The network
1624 connection is also closed by "undef $p". The network connection is
1625 automatically closed if the ping object goes out of scope (e.g. $p is
1626 local to a subroutine and you leave the subroutine).
1628 =item pingecho($host [, $timeout]);
1630 To provide backward compatibility with the previous version of
1631 Net::Ping, a pingecho() subroutine is available with the same
1632 functionality as before. pingecho() uses the tcp protocol. The
1633 return values and parameters are the same as described for the ping()
1634 method. This subroutine is obsolete and may be removed in a future
1635 version of Net::Ping.
1641 There will be less network overhead (and some efficiency in your
1642 program) if you specify either the udp or the icmp protocol. The tcp
1643 protocol will generate 2.5 times or more traffic for each ping than
1644 either udp or icmp. If many hosts are pinged frequently, you may wish
1645 to implement a small wait (e.g. 25ms or more) between each ping to
1646 avoid flooding your network with packets.
1648 The icmp protocol requires that the program be run as root or that it
1649 be setuid to root. The other protocols do not require special
1650 privileges, but not all network devices implement tcp or udp echo.
1652 Local hosts should normally respond to pings within milliseconds.
1653 However, on a very congested network it may take up to 3 seconds or
1654 longer to receive an echo packet from the remote host. If the timeout
1655 is set too low under these conditions, it will appear that the remote
1656 host is not reachable (which is almost the truth).
1658 Reachability doesn't necessarily mean that the remote host is actually
1659 functioning beyond its ability to echo packets. tcp is slightly better
1660 at indicating the health of a system than icmp because it uses more
1661 of the networking stack to respond.
1663 Because of a lack of anything better, this module uses its own
1664 routines to pack and unpack ICMP packets. It would be better for a
1665 separate module to be written which understands all of the different
1666 kinds of ICMP packets.
1670 The latest source tree is available via cvs:
1672 cvs -z3 -q -d :pserver:anonymous@cvs.roobik.com.:/usr/local/cvsroot/freeware checkout Net-Ping
1675 The tarball can be created as follows:
1677 perl Makefile.PL ; make ; make dist
1679 The latest Net::Ping release can be found at CPAN:
1681 $CPAN/modules/by-module/Net/
1683 1) Extract the tarball
1685 gtar -zxvf Net-Ping-xxxx.tar.gz
1699 Or install it RPM Style:
1701 rpm -ta SOURCES/Net-Ping-xxxx.tar.gz
1703 rpm -ih RPMS/noarch/perl-Net-Ping-xxxx.rpm
1707 For a list of known issues, visit:
1709 https://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Ping
1711 To report a new bug, visit:
1713 https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-Ping
1718 bbb@cpan.org (Rob Brown)
1721 colinm@cpan.org (Colin McMillen)
1724 bronson@trestle.com (Scott Bronson)
1726 Original pingecho():
1727 karrer@bernina.ethz.ch (Andreas Karrer)
1728 pmarquess@bfsec.bt.co.uk (Paul Marquess)
1730 Original Net::Ping author:
1731 mose@ns.ccsn.edu (Russell Mosemann)
1735 Copyright (c) 2002-2003, Rob Brown. All rights reserved.
1737 Copyright (c) 2001, Colin McMillen. All rights reserved.
1739 This program is free software; you may redistribute it and/or
1740 modify it under the same terms as Perl itself.
1742 $Id: Ping.pm,v 1.86 2003/06/27 21:31:07 rob Exp $