This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perluniintro nit
[perl5.git] / lib / Net / Ping.pm
CommitLineData
a0d0e21e
LW
1package Net::Ping;
2
69c74a9c 3# $Id: Ping.pm,v 1.46 2002/12/02 19:17:09 rob Exp $
b124990b
JH
4
5require 5.002;
a0d0e21e
LW
6require Exporter;
7
a3b93737 8use strict;
b124990b 9use vars qw(@ISA @EXPORT $VERSION
f569508e
HS
10 $def_timeout $def_proto $max_datasize $pingstring $hires $source_verify $syn_forking);
11use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK );
12use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET SOL_SOCKET
e82f584b 13 inet_aton inet_ntoa sockaddr_in );
69c74a9c 14use POSIX qw( ECONNREFUSED EINPROGRESS EAGAIN WNOHANG );
f569508e 15use FileHandle;
a3b93737 16use Carp;
a79c1648 17
a0d0e21e 18@ISA = qw(Exporter);
a3b93737 19@EXPORT = qw(pingecho);
69c74a9c 20$VERSION = "2.26";
a0d0e21e 21
a3b93737 22# Constants
a0d0e21e 23
a3b93737 24$def_timeout = 5; # Default timeout to wait for a reply
a5a165b1 25$def_proto = "tcp"; # Default protocol to use for pinging
a3b93737 26$max_datasize = 1024; # Maximum data bytes in a packet
b124990b
JH
27# The data we exchange with the server for the stream protocol
28$pingstring = "pingschwingping!\n";
5d20095f 29$source_verify = 1; # Default is to verify source endpoint
f569508e 30$syn_forking = 0;
a0d0e21e 31
ef73e1db
JH
32if ($^O =~ /Win32/i) {
33 # Hack to avoid this Win32 spewage:
34 # Your vendor has not defined POSIX macro ECONNREFUSED
35 *ECONNREFUSED = sub {10061;}; # "Unknown Error" Special Win32 Response?
f569508e 36 $syn_forking = 1;
ef73e1db
JH
37};
38
f569508e
HS
39# h2ph "asm/socket.h"
40# require "asm/socket.ph";
41sub SO_BINDTODEVICE {25;}
42
a3b93737
RM
43# Description: The pingecho() subroutine is provided for backward
44# compatibility with the original Net::Ping. It accepts a host
45# name/IP and an optional timeout in seconds. Create a tcp ping
46# object and try pinging the host. The result of the ping is returned.
a0d0e21e 47
a3b93737
RM
48sub pingecho
49{
e82f584b
JH
50 my ($host, # Name or IP number of host to ping
51 $timeout # Optional timeout in seconds
52 ) = @_;
53 my ($p); # A ping object
a0d0e21e 54
e82f584b
JH
55 $p = Net::Ping->new("tcp", $timeout);
56 $p->ping($host); # Going out of scope closes the connection
a3b93737 57}
a0d0e21e 58
a3b93737
RM
59# Description: The new() method creates a new ping object. Optional
60# parameters may be specified for the protocol to use, the timeout in
61# seconds and the size in bytes of additional data which should be
62# included in the packet.
63# After the optional parameters are checked, the data is constructed
64# and a socket is opened if appropriate. The object is returned.
65
66sub new
67{
e82f584b
JH
68 my ($this,
69 $proto, # Optional protocol to use for pinging
70 $timeout, # Optional timeout in seconds
f569508e
HS
71 $data_size, # Optional additional bytes of data
72 $device, # Optional device to use
e82f584b
JH
73 ) = @_;
74 my $class = ref($this) || $this;
75 my $self = {};
76 my ($cnt, # Count through data bytes
77 $min_datasize # Minimum data bytes required
78 );
79
80 bless($self, $class);
81
82 $proto = $def_proto unless $proto; # Determine the protocol
f569508e
HS
83 croak('Protocol for ping must be "icmp", "udp", "tcp", "syn", "stream", or "external"')
84 unless $proto =~ m/^(icmp|udp|tcp|syn|stream|external)$/;
e82f584b
JH
85 $self->{"proto"} = $proto;
86
87 $timeout = $def_timeout unless $timeout; # Determine the timeout
88 croak("Default timeout for ping must be greater than 0 seconds")
89 if $timeout <= 0;
90 $self->{"timeout"} = $timeout;
91
f569508e
HS
92 $self->{"device"} = $device;
93
e82f584b
JH
94 $min_datasize = ($proto eq "udp") ? 1 : 0; # Determine data size
95 $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
96 croak("Data for ping must be from $min_datasize to $max_datasize bytes")
97 if ($data_size < $min_datasize) || ($data_size > $max_datasize);
98 $data_size-- if $self->{"proto"} eq "udp"; # We provide the first byte
99 $self->{"data_size"} = $data_size;
100
101 $self->{"data"} = ""; # Construct data bytes
102 for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
103 {
104 $self->{"data"} .= chr($cnt % 256);
105 }
106
107 $self->{"local_addr"} = undef; # Don't bind by default
108
f569508e
HS
109 $self->{"tcp_econnrefused"} = undef; # Default Connection refused behavior
110
e82f584b
JH
111 $self->{"seq"} = 0; # For counting packets
112 if ($self->{"proto"} eq "udp") # Open a socket
113 {
114 $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
115 croak("Can't udp protocol by name");
116 $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
117 croak("Can't get udp echo port by name");
118 $self->{"fh"} = FileHandle->new();
119 socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
120 $self->{"proto_num"}) ||
121 croak("udp socket error - $!");
f569508e
HS
122 if ($self->{'device'}) {
123 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
124 or croak "error binding to device $self->{'device'} $!";
125 }
e82f584b
JH
126 }
127 elsif ($self->{"proto"} eq "icmp")
128 {
f569508e 129 croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS' and $^O ne 'cygwin');
e82f584b
JH
130 $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
131 croak("Can't get icmp protocol by name");
132 $self->{"pid"} = $$ & 0xffff; # Save lower 16 bits of pid
133 $self->{"fh"} = FileHandle->new();
134 socket($self->{"fh"}, PF_INET, SOCK_RAW, $self->{"proto_num"}) ||
135 croak("icmp socket error - $!");
f569508e
HS
136 if ($self->{'device'}) {
137 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
138 or croak "error binding to device $self->{'device'} $!";
139 }
e82f584b
JH
140 }
141 elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
142 {
143 $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
144 croak("Can't get tcp protocol by name");
145 $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
146 croak("Can't get tcp echo port by name");
147 $self->{"fh"} = FileHandle->new();
148 }
f569508e
HS
149 elsif ($self->{"proto"} eq "syn")
150 {
151 $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
152 croak("Can't get tcp protocol by name");
153 $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
154 croak("Can't get tcp echo port by name");
155 if ($syn_forking) {
156 $self->{"fork_rd"} = FileHandle->new();
157 $self->{"fork_wr"} = FileHandle->new();
158 pipe($self->{"fork_rd"}, $self->{"fork_wr"});
159 $self->{"fh"} = FileHandle->new();
69c74a9c
HS
160 $self->{"good"} = {};
161 $self->{"bad"} = {};
f569508e
HS
162 } else {
163 $self->{"wbits"} = "";
164 $self->{"bad"} = {};
165 }
166 $self->{"syn"} = {};
167 $self->{"stop_time"} = 0;
168 }
169 elsif ($self->{"proto"} eq "external")
170 {
171 # No preliminary work needs to be done.
172 }
e82f584b
JH
173
174 return($self);
a3b93737 175}
a0d0e21e 176
49afa5f6
JH
177# Description: Set the local IP address from which pings will be sent.
178# For ICMP and UDP pings, this calls bind() on the already-opened socket;
179# for TCP pings, just saves the address to be used when the socket is
180# opened. Returns non-zero if successful; croaks on error.
181sub bind
182{
e82f584b
JH
183 my ($self,
184 $local_addr # Name or IP number of local interface
185 ) = @_;
186 my ($ip # Packed IP number of $local_addr
187 );
188
189 croak("Usage: \$p->bind(\$local_addr)") unless @_ == 2;
190 croak("already bound") if defined($self->{"local_addr"}) &&
191 ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp");
192
193 $ip = inet_aton($local_addr);
194 croak("nonexistent local address $local_addr") unless defined($ip);
195 $self->{"local_addr"} = $ip; # Only used if proto is tcp
196
197 if ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp")
198 {
199 CORE::bind($self->{"fh"}, sockaddr_in(0, $ip)) ||
200 croak("$self->{'proto'} bind error - $!");
201 }
202 elsif ($self->{"proto"} ne "tcp")
203 {
204 croak("Unknown protocol \"$self->{proto}\" in bind()");
205 }
206
207 return 1;
208}
49afa5f6 209
49afa5f6 210
15d96390
JH
211# Description: Allow UDP source endpoint comparision to be
212# skipped for those remote interfaces that do
213# not response from the same endpoint.
214
215sub source_verify
216{
217 my $self = shift;
5d20095f
JH
218 $source_verify = 1 unless defined
219 ($source_verify = ((defined $self) && (ref $self)) ? shift() : $self);
15d96390
JH
220}
221
f569508e
HS
222# Description: Set whether or not the tcp connect
223# behavior should enforce remote service availability
224# as well as reachability.
225
226sub tcp_service_check
227{
228 my $self = shift;
229 $self->{"tcp_econnrefused"} = 1 unless defined
230 ($self->{"tcp_econnrefused"} = shift());
231}
232
e82f584b
JH
233# Description: allows the module to use milliseconds as returned by
234# the Time::HiRes module
49afa5f6 235
e82f584b
JH
236$hires = 0;
237sub hires
238{
239 my $self = shift;
240 $hires = 1 unless defined
241 ($hires = ((defined $self) && (ref $self)) ? shift() : $self);
242 require Time::HiRes if $hires;
49afa5f6
JH
243}
244
e82f584b
JH
245sub time
246{
247 return $hires ? Time::HiRes::time() : CORE::time();
248}
49afa5f6 249
a3b93737
RM
250# Description: Ping a host name or IP number with an optional timeout.
251# First lookup the host, and return undef if it is not found. Otherwise
b124990b 252# perform the specific ping method based on the protocol. Return the
a3b93737
RM
253# result of the ping.
254
255sub ping
256{
e82f584b
JH
257 my ($self,
258 $host, # Name or IP number of host to ping
259 $timeout, # Seconds after which ping times out
260 ) = @_;
261 my ($ip, # Packed IP number of $host
262 $ret, # The return value
263 $ping_time, # When ping began
264 );
265
266 croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
267 $timeout = $self->{"timeout"} unless $timeout;
268 croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
269
270 $ip = inet_aton($host);
271 return(undef) unless defined($ip); # Does host exist?
272
273 # Dispatch to the appropriate routine.
274 $ping_time = &time();
275 if ($self->{"proto"} eq "external") {
276 $ret = $self->ping_external($ip, $timeout);
277 }
278 elsif ($self->{"proto"} eq "udp") {
279 $ret = $self->ping_udp($ip, $timeout);
280 }
281 elsif ($self->{"proto"} eq "icmp") {
282 $ret = $self->ping_icmp($ip, $timeout);
283 }
284 elsif ($self->{"proto"} eq "tcp") {
285 $ret = $self->ping_tcp($ip, $timeout);
286 }
287 elsif ($self->{"proto"} eq "stream") {
288 $ret = $self->ping_stream($ip, $timeout);
f569508e
HS
289 }
290 elsif ($self->{"proto"} eq "syn") {
291 $ret = $self->ping_syn($host, $ip, $ping_time, $ping_time+$timeout);
e82f584b 292 } else {
787ecdfa 293 croak("Unknown protocol \"$self->{proto}\" in ping()");
e82f584b
JH
294 }
295
296 return wantarray ? ($ret, &time() - $ping_time, inet_ntoa($ip)) : $ret;
787ecdfa
JH
297}
298
299# Uses Net::Ping::External to do an external ping.
300sub ping_external {
301 my ($self,
302 $ip, # Packed IP number of the host
303 $timeout # Seconds after which ping times out
304 ) = @_;
305
b124990b
JH
306 eval { require Net::Ping::External; }
307 or croak('Protocol "external" not supported on your system: Net::Ping::External not found');
787ecdfa 308 return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
a3b93737 309}
a0d0e21e 310
49afa5f6
JH
311use constant ICMP_ECHOREPLY => 0; # ICMP packet types
312use constant ICMP_ECHO => 8;
313use constant ICMP_STRUCT => "C2 S3 A"; # Structure of a minimal ICMP packet
314use constant SUBCODE => 0; # No ICMP subcode for ECHO and ECHOREPLY
315use constant ICMP_FLAGS => 0; # No special flags for send or recv
316use constant ICMP_PORT => 0; # No port with ICMP
317
a3b93737
RM
318sub ping_icmp
319{
e82f584b
JH
320 my ($self,
321 $ip, # Packed IP number of the host
322 $timeout # Seconds after which ping times out
323 ) = @_;
324
325 my ($saddr, # sockaddr_in with port and ip
326 $checksum, # Checksum of ICMP packet
327 $msg, # ICMP packet to send
328 $len_msg, # Length of $msg
329 $rbits, # Read bits, filehandles for reading
330 $nfound, # Number of ready filehandles found
331 $finish_time, # Time ping should be finished
332 $done, # set to 1 when we are done
333 $ret, # Return value
334 $recv_msg, # Received message including IP header
335 $from_saddr, # sockaddr_in of sender
336 $from_port, # Port packet was sent from
337 $from_ip, # Packed IP of sender
338 $from_type, # ICMP type
339 $from_subcode, # ICMP subcode
340 $from_chk, # ICMP packet checksum
341 $from_pid, # ICMP packet id
342 $from_seq, # ICMP packet sequence
343 $from_msg # ICMP message
344 );
345
346 $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
347 $checksum = 0; # No checksum for starters
348 $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
349 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
350 $checksum = Net::Ping->checksum($msg);
351 $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
352 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
353 $len_msg = length($msg);
354 $saddr = sockaddr_in(ICMP_PORT, $ip);
355 send($self->{"fh"}, $msg, ICMP_FLAGS, $saddr); # Send the message
356
357 $rbits = "";
358 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
359 $ret = 0;
360 $done = 0;
361 $finish_time = &time() + $timeout; # Must be done by this time
362 while (!$done && $timeout > 0) # Keep trying if we have time
363 {
364 $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
365 $timeout = $finish_time - &time(); # Get remaining time
366 if (!defined($nfound)) # Hmm, a strange error
a3b93737 367 {
e82f584b
JH
368 $ret = undef;
369 $done = 1;
370 }
371 elsif ($nfound) # Got a packet from somewhere
372 {
373 $recv_msg = "";
374 $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, ICMP_FLAGS);
375 ($from_port, $from_ip) = sockaddr_in($from_saddr);
376 ($from_type, $from_subcode, $from_chk,
377 $from_pid, $from_seq, $from_msg) =
378 unpack(ICMP_STRUCT . $self->{"data_size"},
379 substr($recv_msg, length($recv_msg) - $len_msg,
380 $len_msg));
381 if (($from_type == ICMP_ECHOREPLY) &&
5d20095f 382 (!$source_verify || $from_ip eq $ip) &&
e82f584b
JH
383 ($from_pid == $self->{"pid"}) && # Does the packet check out?
384 ($from_seq == $self->{"seq"}))
385 {
386 $ret = 1; # It's a winner
387 $done = 1;
388 }
a3b93737 389 }
e82f584b
JH
390 else # Oops, timed out
391 {
392 $done = 1;
393 }
394 }
395 return $ret;
a3b93737
RM
396}
397
398# Description: Do a checksum on the message. Basically sum all of
399# the short words and fold the high order bits into the low order bits.
400
401sub checksum
402{
e82f584b
JH
403 my ($class,
404 $msg # The message to checksum
405 ) = @_;
406 my ($len_msg, # Length of the message
407 $num_short, # The number of short words in the message
408 $short, # One short word
409 $chk # The checksum
410 );
411
412 $len_msg = length($msg);
413 $num_short = int($len_msg / 2);
414 $chk = 0;
415 foreach $short (unpack("S$num_short", $msg))
416 {
417 $chk += $short;
418 } # Add the odd byte in
419 $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
420 $chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low
421 return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement
a3b93737
RM
422}
423
787ecdfa 424
b124990b
JH
425# Description: Perform a tcp echo ping. Since a tcp connection is
426# host specific, we have to open and close each connection here. We
427# can't just leave a socket open. Because of the robust nature of
428# tcp, it will take a while before it gives up trying to establish a
429# connection. Therefore, we use select() on a non-blocking socket to
430# check against our timeout. No data bytes are actually
431# sent since the successful establishment of a connection is proof
432# enough of the reachability of the remote host. Also, tcp is
433# expensive and doesn't need our help to add to the overhead.
434
435sub ping_tcp
787ecdfa 436{
e82f584b
JH
437 my ($self,
438 $ip, # Packed IP number of the host
439 $timeout # Seconds after which ping times out
440 ) = @_;
441 my ($ret # The return value
442 );
443
444 $@ = ""; $! = 0;
445 $ret = $self -> tcp_connect( $ip, $timeout);
f569508e
HS
446 if (!$self->{"tcp_econnrefused"} &&
447 $! == ECONNREFUSED) {
448 $ret = 1; # "Connection refused" means reachable
449 }
e82f584b
JH
450 $self->{"fh"}->close();
451 return $ret;
787ecdfa
JH
452}
453
b124990b 454sub tcp_connect
787ecdfa 455{
e82f584b
JH
456 my ($self,
457 $ip, # Packed IP number of the host
458 $timeout # Seconds after which connect times out
459 ) = @_;
460 my ($saddr); # Packed IP and Port
b124990b 461
e82f584b 462 $saddr = sockaddr_in($self->{"port_num"}, $ip);
b124990b 463
e82f584b 464 my $ret = 0; # Default to unreachable
b124990b 465
e82f584b
JH
466 my $do_socket = sub {
467 socket($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"}) ||
468 croak("tcp socket error - $!");
469 if (defined $self->{"local_addr"} &&
470 !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
471 croak("tcp bind error - $!");
472 }
f569508e
HS
473 if ($self->{'device'}) {
474 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
475 or croak("error binding to device $self->{'device'} $!");
476 }
e82f584b
JH
477 };
478 my $do_connect = sub {
479 eval {
480 die $! unless connect($self->{"fh"}, $saddr);
481 $self->{"ip"} = $ip;
482 $ret = 1;
483 };
484 $ret;
485 };
486
487 if ($^O =~ /Win32/i) {
488
489 # Buggy Winsock API doesn't allow us to use alarm() calls.
490 # Hence, if our OS is Windows, we need to create a separate
491 # process to do the blocking connect attempt.
492
493 $| = 1; # Clear buffer prior to fork to prevent duplicate flushing.
494 my $pid = fork;
495 if (!$pid) {
496 if (!defined $pid) {
497 # Fork did not work
498 warn "Win32 Fork error: $!";
499 return 0;
b124990b 500 }
b124990b
JH
501 &{ $do_socket }();
502
e82f584b
JH
503 # Try a slow blocking connect() call
504 # and report the status to the pipe.
505 if ( &{ $do_connect }() ) {
506 $self->{"fh"}->close();
507 # No error
508 exit 0;
b124990b 509 } else {
e82f584b
JH
510 # Pass the error status to the parent
511 exit $!;
b124990b 512 }
e82f584b 513 }
b124990b 514
e82f584b
JH
515 &{ $do_socket }();
516
517 my $patience = &time() + $timeout;
518
e82f584b
JH
519 my ($child);
520 $? = 0;
521 # Wait up to the timeout
522 # And clean off the zombie
523 do {
f569508e 524 $child = waitpid($pid, &WNOHANG());
e82f584b
JH
525 $! = $? >> 8;
526 $@ = $!;
527 select(undef, undef, undef, 0.1);
528 } while &time() < $patience && $child != $pid;
529
530 if ($child == $pid) {
531 # Since she finished within the timeout,
532 # it is probably safe for me to try it too
b124990b 533 &{ $do_connect }();
e82f584b
JH
534 } else {
535 # Time must have run out.
536 $@ = "Timed out!";
537 # Put that choking client out of its misery
538 kill "KILL", $pid;
539 # Clean off the zombie
540 waitpid($pid, 0);
541 $ret = 0;
b124990b 542 }
e82f584b
JH
543 } else { # Win32
544 # Otherwise don't waste the resources to fork
545
546 &{ $do_socket }();
547
f569508e
HS
548 local $SIG{'ALRM'} = sub { die "Timed out!"; };
549 my $old = alarm($timeout); # Interrupt connect() if we have to
e82f584b
JH
550
551 &{ $do_connect }();
f569508e 552 alarm($old);
e82f584b 553 }
787ecdfa 554
e82f584b 555 return $ret;
787ecdfa
JH
556}
557
558# This writes the given string to the socket and then reads it
559# back. It returns 1 on success, 0 on failure.
560sub tcp_echo
561{
e82f584b
JH
562 my $self = shift;
563 my $timeout = shift;
564 my $pingstring = shift;
565
566 my $ret = undef;
567 my $time = &time();
568 my $wrstr = $pingstring;
569 my $rdstr = "";
570
571 eval <<'EOM';
572 do {
573 my $rin = "";
574 vec($rin, $self->{"fh"}->fileno(), 1) = 1;
575
576 my $rout = undef;
577 if($wrstr) {
578 $rout = "";
579 vec($rout, $self->{"fh"}->fileno(), 1) = 1;
580 }
581
582 if(select($rin, $rout, undef, ($time + $timeout) - &time())) {
583
584 if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
585 my $num = syswrite($self->{"fh"}, $wrstr);
586 if($num) {
587 # If it was a partial write, update and try again.
588 $wrstr = substr($wrstr,$num);
589 } else {
590 # There was an error.
591 $ret = 0;
592 }
593 }
594
595 if(vec($rin,$self->{"fh"}->fileno(),1)) {
596 my $reply;
597 if(sysread($self->{"fh"},$reply,length($pingstring)-length($rdstr))) {
598 $rdstr .= $reply;
599 $ret = 1 if $rdstr eq $pingstring;
600 } else {
601 # There was an error.
602 $ret = 0;
603 }
604 }
605
606 }
607 } until &time() > ($time + $timeout) || defined($ret);
787ecdfa
JH
608EOM
609
e82f584b 610 return $ret;
787ecdfa
JH
611}
612
787ecdfa 613
787ecdfa 614
787ecdfa
JH
615
616# Description: Perform a stream ping. If the tcp connection isn't
617# already open, it opens it. It then sends some data and waits for
618# a reply. It leaves the stream open on exit.
619
620sub ping_stream
621{
e82f584b
JH
622 my ($self,
623 $ip, # Packed IP number of the host
624 $timeout # Seconds after which ping times out
625 ) = @_;
072620d9 626
e82f584b
JH
627 # Open the stream if it's not already open
628 if(!defined $self->{"fh"}->fileno()) {
629 $self->tcp_connect($ip, $timeout) or return 0;
630 }
787ecdfa 631
e82f584b
JH
632 croak "tried to switch servers while stream pinging"
633 if $self->{"ip"} ne $ip;
634
635 return $self->tcp_echo($timeout, $pingstring);
787ecdfa
JH
636}
637
638# Description: opens the stream. You would do this if you want to
639# separate the overhead of opening the stream from the first ping.
640
641sub open
642{
e82f584b
JH
643 my ($self,
644 $host, # Host or IP address
645 $timeout # Seconds after which open times out
646 ) = @_;
647
648 my ($ip); # Packed IP number of the host
649 $ip = inet_aton($host);
650 $timeout = $self->{"timeout"} unless $timeout;
651
652 if($self->{"proto"} eq "stream") {
653 if(defined($self->{"fh"}->fileno())) {
654 croak("socket is already open");
655 } else {
656 $self->tcp_connect($ip, $timeout);
b124990b 657 }
e82f584b 658 }
072620d9
SB
659}
660
b124990b 661
a3b93737
RM
662# Description: Perform a udp echo ping. Construct a message of
663# at least the one-byte sequence number and any additional data bytes.
664# Send the message out and wait for a message to come back. If we
665# get a message, make sure all of its parts match. If they do, we are
666# done. Otherwise go back and wait for the message until we run out
667# of time. Return the result of our efforts.
668
49afa5f6 669use constant UDP_FLAGS => 0; # Nothing special on send or recv
69c74a9c
HS
670# XXX - Use concept by rdw @ perlmonks
671# http://perlmonks.thepen.com/42898.html
a3b93737
RM
672sub ping_udp
673{
e82f584b
JH
674 my ($self,
675 $ip, # Packed IP number of the host
676 $timeout # Seconds after which ping times out
677 ) = @_;
678
679 my ($saddr, # sockaddr_in with port and ip
680 $ret, # The return value
681 $msg, # Message to be echoed
682 $finish_time, # Time ping should be finished
e82f584b
JH
683 $done, # Set to 1 when we are done pinging
684 $rbits, # Read bits, filehandles for reading
685 $nfound, # Number of ready filehandles found
686 $from_saddr, # sockaddr_in of sender
687 $from_msg, # Characters echoed by $host
688 $from_port, # Port message was echoed from
689 $from_ip # Packed IP number of sender
690 );
691
692 $saddr = sockaddr_in($self->{"port_num"}, $ip);
693 $self->{"seq"} = ($self->{"seq"} + 1) % 256; # Increment sequence
694 $msg = chr($self->{"seq"}) . $self->{"data"}; # Add data if any
695 send($self->{"fh"}, $msg, UDP_FLAGS, $saddr); # Send it
696
697 $rbits = "";
698 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
699 $ret = 0; # Default to unreachable
700 $done = 0;
e82f584b
JH
701 $finish_time = &time() + $timeout; # Ping needs to be done by then
702 while (!$done && $timeout > 0)
703 {
704 $nfound = select($rbits, undef, undef, $timeout); # Wait for response
705 $timeout = $finish_time - &time(); # Get remaining time
706
707 if (!defined($nfound)) # Hmm, a strange error
a3b93737 708 {
e82f584b
JH
709 $ret = undef;
710 $done = 1;
a3b93737 711 }
e82f584b
JH
712 elsif ($nfound) # A packet is waiting
713 {
714 $from_msg = "";
715 $from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS)
716 or last; # For example an unreachable host will make recv() fail.
717 ($from_port, $from_ip) = sockaddr_in($from_saddr);
5d20095f 718 if (!$source_verify ||
15d96390
JH
719 (($from_ip eq $ip) && # Does the packet check out?
720 ($from_port == $self->{"port_num"}) &&
721 ($from_msg eq $msg)))
e82f584b
JH
722 {
723 $ret = 1; # It's a winner
724 $done = 1;
725 }
726 }
727 else # Oops, timed out
728 {
729 $done = 1;
730 }
731 }
a5a165b1 732 return $ret;
b124990b 733}
a0d0e21e 734
f569508e
HS
735# Description: Send a TCP SYN packet to host specified.
736sub ping_syn
737{
738 my $self = shift;
739 my $host = shift;
740 my $ip = shift;
741 my $start_time = shift;
742 my $stop_time = shift;
743
744 if ($syn_forking) {
745 return $self->ping_syn_fork($host, $ip, $start_time, $stop_time);
746 }
747
748 my $fh = FileHandle->new();
749 my $saddr = sockaddr_in($self->{"port_num"}, $ip);
750
751 # Create TCP socket
752 if (!socket ($fh, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
753 croak("tcp socket error - $!");
754 }
755
756 if (defined $self->{"local_addr"} &&
757 !CORE::bind($fh, sockaddr_in(0, $self->{"local_addr"}))) {
758 croak("tcp bind error - $!");
759 }
760
761 if ($self->{'device'}) {
762 setsockopt($fh, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
763 or croak("error binding to device $self->{'device'} $!");
764 }
765
766 # Set O_NONBLOCK property on filehandle
69c74a9c
HS
767 my $flags = 0;
768 if (fcntl($fh, F_GETFL, $flags)) {
769 if (!fcntl($fh, F_SETFL, $flags | O_NONBLOCK)) {
770 croak("fcntl F_SETFL: $!");
771 }
f569508e
HS
772 } else {
773 croak("fcntl F_GETFL: $!");
774 }
775
776 # Attempt the non-blocking connect
777 # by just sending the TCP SYN packet
778 if (connect($fh, $saddr)) {
779 # Non-blocking, yet still connected?
69c74a9c
HS
780 # Must have connected very quickly,
781 # or else it wasn't very non-blocking.
782 #warn "WARNING: Nonblocking connect connected anyway? ($^O)";
783 } else {
f569508e 784 # Error occurred connecting.
69c74a9c
HS
785 if ($! == EINPROGRESS) {
786 # The connection is just still in progress.
787 # This is the expected condition.
788 } else {
789 # Just save the error and continue on.
790 # The ack() can check the status later.
f569508e 791 $self->{"bad"}->{$host} = $!;
f569508e
HS
792 }
793 }
794
795 my $entry = [ $host, $ip, $fh, $start_time, $stop_time ];
796 $self->{"syn"}->{$fh->fileno} = $entry;
797 if ($self->{"stop_time"} < $stop_time) {
798 $self->{"stop_time"} = $stop_time;
799 }
800 vec($self->{"wbits"}, $fh->fileno, 1) = 1;
801
802 return 1;
803}
804
805sub ping_syn_fork {
806 my ($self, $host, $ip, $start_time, $stop_time) = @_;
807
808 # Buggy Winsock API doesn't allow nonblocking connect.
809 # Hence, if our OS is Windows, we need to create a separate
810 # process to do the blocking connect attempt.
811 my $pid = fork();
812 if (defined $pid) {
813 if ($pid) {
814 # Parent process
815 my $entry = [ $host, $ip, $pid, $start_time, $stop_time ];
816 $self->{"syn"}->{$pid} = $entry;
817 if ($self->{"stop_time"} < $stop_time) {
818 $self->{"stop_time"} = $stop_time;
819 }
820 } else {
821 # Child process
822 my $saddr = sockaddr_in($self->{"port_num"}, $ip);
823
824 # Create TCP socket
825 if (!socket ($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
826 croak("tcp socket error - $!");
827 }
828
829 if (defined $self->{"local_addr"} &&
830 !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
831 croak("tcp bind error - $!");
832 }
833
834 if ($self->{'device'}) {
835 setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
836 or croak("error binding to device $self->{'device'} $!");
837 }
838
839 $!=0;
840 # Try to connect (could take a long time)
841 connect($self->{"fh"}, $saddr);
842 # Notify parent of connect error status
843 my $err = $!+0;
844 my $wrstr = "$$ $err";
845 # Force to 10 chars including \n
846 $wrstr .= " "x(9 - length $wrstr). "\n";
847 syswrite($self->{"fork_wr"}, $wrstr);
848 exit;
849 }
850 } else {
851 # fork() failed?
852 die "fork: $!";
853 }
854 return 1;
855}
856
857# Description: Wait for TCP ACK from host specified
858# from ping_syn above. If no host is specified, wait
859# for TCP ACK from any of the hosts in the SYN queue.
860sub ack
861{
862 my $self = shift;
863
864 if ($self->{"proto"} eq "syn") {
865 if ($syn_forking) {
866 my @answer = $self->ack_unfork(shift);
867 return wantarray ? @answer : $answer[0];
868 }
869 my $wbits = "";
870 my $stop_time = 0;
871 if (my $host = shift) {
872 # Host passed as arg
873 if (exists $self->{"bad"}->{$host}) {
69c74a9c
HS
874 if (!$self->{"tcp_econnrefused"} &&
875 $self->{"bad"}->{ $host } &&
876 (($! = ECONNREFUSED)>0) &&
877 $self->{"bad"}->{ $host } eq "$!") {
878 # "Connection refused" means reachable
879 # Good, continue
880 } else {
881 # ECONNREFUSED means no good
882 return ();
883 }
f569508e
HS
884 }
885 my $host_fd = undef;
886 foreach my $fd (keys %{ $self->{"syn"} }) {
887 my $entry = $self->{"syn"}->{$fd};
888 if ($entry->[0] eq $host) {
889 $host_fd = $fd;
890 $stop_time = $entry->[4]
891 || croak("Corrupted SYN entry for [$host]");
892 last;
893 }
894 }
895 croak("ack called on [$host] without calling ping first!")
896 unless defined $host_fd;
897 vec($wbits, $host_fd, 1) = 1;
898 } else {
899 # No $host passed so scan all hosts
900 # Use the latest stop_time
901 $stop_time = $self->{"stop_time"};
902 # Use all the bits
903 $wbits = $self->{"wbits"};
904 }
905
906 while ($wbits !~ /^\0*$/) {
907 my $timeout = $stop_time - &time();
908 # Force a minimum of 10 ms timeout.
69c74a9c
HS
909 $timeout = 0.01 if $timeout <= 0.01;
910
911 my $winner_fd = undef;
912 my $wout = $wbits;
913 my $fd = 0;
914 # Do "bad" fds from $wbits first
915 while ($wout !~ /^\0*$/) {
916 if (vec($wout, $fd, 1)) {
917 # Wipe it from future scanning.
918 vec($wout, $fd, 1) = 0;
919 if (my $entry = $self->{"syn"}->{$fd}) {
920 if ($self->{"bad"}->{ $entry->[0] }) {
921 $winner_fd = $fd;
922 last;
923 }
924 }
925 }
926 $fd++;
927 }
928
929 if (defined($winner_fd) or my $nfound = select(undef, ($wout=$wbits), undef, $timeout)) {
930 if (defined $winner_fd) {
931 $fd = $winner_fd;
932 } else {
933 # Done waiting for one of the ACKs
934 $fd = 0;
935 # Determine which one
936 while ($wout !~ /^\0*$/ &&
937 !vec($wout, $fd, 1)) {
938 $fd++;
939 }
f569508e
HS
940 }
941 if (my $entry = $self->{"syn"}->{$fd}) {
69c74a9c
HS
942 # Wipe it from future scanning.
943 delete $self->{"syn"}->{$fd};
944 vec($self->{"wbits"}, $fd, 1) = 0;
945 vec($wbits, $fd, 1) = 0;
946 if (!$self->{"tcp_econnrefused"} &&
947 $self->{"bad"}->{ $entry->[0] } &&
948 (($! = ECONNREFUSED)>0) &&
949 $self->{"bad"}->{ $entry->[0] } eq "$!") {
950 # "Connection refused" means reachable
951 # Good, continue
952 } elsif (getpeername($entry->[2])) {
f569508e 953 # Connection established to remote host
69c74a9c 954 # Good, continue
f569508e
HS
955 } else {
956 # TCP ACK will never come from this host
957 # because there was an error connecting.
958
f569508e
HS
959 # This should set $! to the correct error.
960 my $char;
961 read($entry->[2],$char,1);
962 # Store the excuse why the connection failed.
963 $self->{"bad"}->{$entry->[0]} = $!;
964 if (!$self->{"tcp_econnrefused"} &&
69c74a9c
HS
965 (($! == ECONNREFUSED) ||
966 ($! == EAGAIN && $^O =~ /cygwin/i))) {
f569508e 967 # "Connection refused" means reachable
69c74a9c
HS
968 # Good, continue
969 } else {
970 # No good, try the next socket...
971 next;
f569508e 972 }
f569508e 973 }
69c74a9c
HS
974 # Everything passed okay, return the answer
975 return wantarray ?
976 ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
977 : $entry->[0];
f569508e
HS
978 } else {
979 warn "Corrupted SYN entry: unknown fd [$fd] ready!";
980 vec($wbits, $fd, 1) = 0;
981 vec($self->{"wbits"}, $fd, 1) = 0;
982 }
983 } elsif (defined $nfound) {
984 # Timed out waiting for ACK
985 foreach my $fd (keys %{ $self->{"syn"} }) {
986 if (vec($wbits, $fd, 1)) {
987 my $entry = $self->{"syn"}->{$fd};
988 $self->{"bad"}->{$entry->[0]} = "Timed out";
989 vec($wbits, $fd, 1) = 0;
990 vec($self->{"wbits"}, $fd, 1) = 0;
991 delete $self->{"syn"}->{$fd};
992 }
993 }
994 } else {
995 # Weird error occurred with select()
996 warn("select: $!");
997 $self->{"syn"} = {};
998 $wbits = "";
999 }
1000 }
1001 }
1002 return ();
1003}
1004
1005sub ack_unfork {
69c74a9c 1006 my ($self,$host) = @_;
f569508e 1007 my $stop_time = $self->{"stop_time"};
69c74a9c 1008 if ($host) {
f569508e 1009 # Host passed as arg
69c74a9c
HS
1010 if (my $entry = $self->{"good"}->{$host}) {
1011 delete $self->{"good"}->{$host};
1012 return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
1013 }
f569508e
HS
1014 }
1015
1016 my $rbits = "";
1017 my $timeout;
69c74a9c 1018
f569508e
HS
1019 if (keys %{ $self->{"syn"} }) {
1020 # Scan all hosts that are left
1021 vec($rbits, fileno($self->{"fork_rd"}), 1) = 1;
1022 $timeout = $stop_time - &time();
69c74a9c
HS
1023 # Force a minimum of 10 ms timeout.
1024 $timeout = 0.01 if $timeout < 0.01;
f569508e
HS
1025 } else {
1026 # No hosts left to wait for
1027 $timeout = 0;
1028 }
1029
1030 if ($timeout > 0) {
69c74a9c
HS
1031 my $nfound;
1032 while ( keys %{ $self->{"syn"} } and
1033 $nfound = select((my $rout=$rbits), undef, undef, $timeout)) {
f569508e
HS
1034 # Done waiting for one of the ACKs
1035 if (!sysread($self->{"fork_rd"}, $_, 10)) {
1036 # Socket closed, which means all children are done.
1037 return ();
1038 }
1039 my ($pid, $how) = split;
1040 if ($pid) {
1041 # Flush the zombie
1042 waitpid($pid, 0);
1043 if (my $entry = $self->{"syn"}->{$pid}) {
1044 # Connection attempt to remote host is done
1045 delete $self->{"syn"}->{$pid};
1046 if (!$how || # If there was no error connecting
1047 (!$self->{"tcp_econnrefused"} &&
1048 $how == ECONNREFUSED)) { # "Connection refused" means reachable
69c74a9c
HS
1049 if ($host && $entry->[0] ne $host) {
1050 # A good connection, but not the host we need.
1051 # Move it from the "syn" hash to the "good" hash.
1052 $self->{"good"}->{$entry->[0]} = $entry;
1053 # And wait for the next winner
1054 next;
1055 }
f569508e
HS
1056 return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
1057 }
1058 } else {
1059 # Should never happen
1060 die "Unknown ping from pid [$pid]";
1061 }
1062 } else {
1063 die "Empty response from status socket?";
1064 }
69c74a9c
HS
1065 }
1066 if (defined $nfound) {
f569508e
HS
1067 # Timed out waiting for ACK status
1068 } else {
1069 # Weird error occurred with select()
1070 warn("select: $!");
1071 }
1072 }
1073 if (my @synners = keys %{ $self->{"syn"} }) {
1074 # Kill all the synners
1075 kill 9, @synners;
1076 foreach my $pid (@synners) {
1077 # Wait for the deaths to finish
1078 # Then flush off the zombie
1079 waitpid($pid, 0);
1080 }
1081 }
1082 $self->{"syn"} = {};
1083 return ();
1084}
1085
1086# Description: Tell why the ack() failed
1087sub nack {
1088 my $self = shift;
1089 my $host = shift || croak('Usage> nack($failed_ack_host)');
1090 return $self->{"bad"}->{$host} || undef;
1091}
1092
1093# Description: Close the connection.
a3b93737
RM
1094
1095sub close
1096{
e82f584b 1097 my ($self) = @_;
a3b93737 1098
f569508e
HS
1099 if ($self->{"proto"} eq "syn") {
1100 delete $self->{"syn"};
1101 } elsif ($self->{"proto"} eq "tcp") {
1102 # The connection will already be closed
1103 } else {
1104 $self->{"fh"}->close();
1105 }
a3b93737
RM
1106}
1107
1108
a0d0e21e 11091;
8e07c86e
AD
1110__END__
1111
8e07c86e
AD
1112=head1 NAME
1113
a3b93737 1114Net::Ping - check a remote host for reachability
8e07c86e 1115
69c74a9c 1116$Id: Ping.pm,v 1.46 2002/12/02 19:17:09 rob Exp $
b124990b 1117
8e07c86e
AD
1118=head1 SYNOPSIS
1119
1120 use Net::Ping;
8e07c86e 1121
a3b93737
RM
1122 $p = Net::Ping->new();
1123 print "$host is alive.\n" if $p->ping($host);
1124 $p->close();
1125
1126 $p = Net::Ping->new("icmp");
49afa5f6 1127 $p->bind($my_addr); # Specify source interface of pings
a3b93737
RM
1128 foreach $host (@host_array)
1129 {
1130 print "$host is ";
1131 print "NOT " unless $p->ping($host, 2);
1132 print "reachable.\n";
1133 sleep(1);
1134 }
1135 $p->close();
b124990b 1136
a3b93737 1137 $p = Net::Ping->new("tcp", 2);
b124990b
JH
1138 # Try connecting to the www port instead of the echo port
1139 $p->{port_num} = getservbyname("http", "tcp");
a3b93737
RM
1140 while ($stop_time > time())
1141 {
1142 print "$host not reachable ", scalar(localtime()), "\n"
1143 unless $p->ping($host);
1144 sleep(300);
1145 }
1146 undef($p);
b124990b 1147
f569508e
HS
1148 # Like tcp protocol, but with many hosts
1149 $p = Net::Ping->new("syn");
1150 $p->{port_num} = getservbyname("http", "tcp");
1151 foreach $host (@host_array) {
1152 $p->ping($host);
1153 }
1154 while (($host,$rtt,$ip) = $p->ack) {
1155 print "HOST: $host [$ip] ACKed in $rtt seconds.\n";
1156 }
1157
e82f584b
JH
1158 # High precision syntax (requires Time::HiRes)
1159 $p = Net::Ping->new();
1160 $p->hires();
1161 ($ret, $duration, $ip) = $p->ping($host, 5.5);
1162 printf("$host [ip: $ip] is alive (packet return time: %.2f ms)\n", 1000 * $duration)
1163 if $ret;
1164 $p->close();
1165
a3b93737
RM
1166 # For backward compatibility
1167 print "$host is alive.\n" if pingecho($host);
8e07c86e 1168
a3b93737 1169=head1 DESCRIPTION
8e07c86e 1170
a3b93737
RM
1171This module contains methods to test the reachability of remote
1172hosts on a network. A ping object is first created with optional
1173parameters, a variable number of hosts may be pinged multiple
1174times and then the connection is closed.
1175
f569508e
HS
1176You may choose one of six different protocols to use for the
1177ping. The "tcp" protocol is the default. Note that a live remote host
b124990b 1178may still fail to be pingable by one or more of these protocols. For
f569508e 1179example, www.microsoft.com is generally alive but not "icmp" pingable.
787ecdfa 1180
b124990b
JH
1181With the "tcp" protocol the ping() method attempts to establish a
1182connection to the remote host's echo port. If the connection is
1183successfully established, the remote host is considered reachable. No
1184data is actually echoed. This protocol does not require any special
1185privileges but has higher overhead than the other two protocols.
072620d9 1186
b124990b 1187Specifying the "udp" protocol causes the ping() method to send a udp
a3b93737
RM
1188packet to the remote host's echo port. If the echoed packet is
1189received from the remote host and the received packet contains the
1190same data as the packet that was sent, the remote host is considered
1191reachable. This protocol does not require any special privileges.
b124990b 1192It should be borne in mind that, for a udp ping, a host
787ecdfa 1193will be reported as unreachable if it is not running the
b124990b
JH
1194appropriate echo service. For Unix-like systems see L<inetd(8)>
1195for more information.
787ecdfa 1196
b124990b
JH
1197If the "icmp" protocol is specified, the ping() method sends an icmp
1198echo message to the remote host, which is what the UNIX ping program
1199does. If the echoed message is received from the remote host and
1200the echoed information is correct, the remote host is considered
1201reachable. Specifying the "icmp" protocol requires that the program
1202be run as root or that the program be setuid to root.
787ecdfa 1203
b124990b
JH
1204If the "external" protocol is specified, the ping() method attempts to
1205use the C<Net::Ping::External> module to ping the remote host.
1206C<Net::Ping::External> interfaces with your system's default C<ping>
1207utility to perform the ping, and generally produces relatively
787ecdfa
JH
1208accurate results. If C<Net::Ping::External> if not installed on your
1209system, specifying the "external" protocol will result in an error.
edc5bd88 1210
f569508e
HS
1211If the "syn" protocol is specified, the ping() method will only
1212send a TCP SYN packet to the remote host then immediately return.
1213If the syn packet was sent successfully, it will return a true value,
1214otherwise it will return false. NOTE: Unlike the other protocols,
1215the return value does NOT determine if the remote host is alive or
1216not since the full TCP three-way handshake may not have completed
1217yet. The remote host is only considered reachable if it receives
1218a TCP ACK within the timeout specifed. To begin waiting for the
1219ACK packets, use the ack() method as explained below. Use the
1220"syn" protocol instead the "tcp" protocol to determine reachability
1221of multiple destinations simultaneously by sending parallel TCP
1222SYN packets. It will not block while testing each remote host.
1223demo/fping is provided in this distribution to demonstrate the
1224"syn" protocol as an example.
1225This protocol does not require any special privileges.
1226
a3b93737
RM
1227=head2 Functions
1228
1229=over 4
1230
f569508e 1231=item Net::Ping->new([$proto [, $def_timeout [, $bytes [, $device ]]]]);
a3b93737
RM
1232
1233Create a new ping object. All of the parameters are optional. $proto
1234specifies the protocol to use when doing a ping. The current choices
f569508e
HS
1235are "tcp", "udp", "icmp", "stream", "syn", or "external".
1236The default is "tcp".
a3b93737
RM
1237
1238If a default timeout ($def_timeout) in seconds is provided, it is used
1239when a timeout is not given to the ping() method (below). The timeout
1240must be greater than 0 and the default, if not specified, is 5 seconds.
1241
1242If the number of data bytes ($bytes) is given, that many data bytes
1243are included in the ping packet sent to the remote host. The number of
1244data bytes is ignored if the protocol is "tcp". The minimum (and
1245default) number of data bytes is 1 if the protocol is "udp" and 0
1246otherwise. The maximum number of data bytes that can be specified is
12471024.
1248
f569508e
HS
1249If $device is given, this device is used to bind the source endpoint
1250before sending the ping packet. I beleive this only works with
1251superuser privileges and with udp and icmp protocols at this time.
1252
5d20095f
JH
1253=item $p->ping($host [, $timeout]);
1254
1255Ping the remote host and wait for a response. $host can be either the
1256hostname or the IP number of the remote host. The optional timeout
1257must be greater than 0 seconds and defaults to whatever was specified
1258when the ping object was created. Returns a success flag. If the
1259hostname cannot be found or there is a problem with the IP number, the
1260success flag returned will be undef. Otherwise, the success flag will
1261be 1 if the host is reachable and 0 if it is not. For most practical
1262purposes, undef and 0 and can be treated as the same case. In array
f569508e
HS
1263context, the elapsed time as well as the string form of the ip the
1264host resolved to are also returned. The elapsed time value will
5d20095f
JH
1265be a float, as retuned by the Time::HiRes::time() function, if hires()
1266has been previously called, otherwise it is returned as an integer.
1267
15d96390
JH
1268=item $p->source_verify( { 0 | 1 } );
1269
1270Allows source endpoint verification to be enabled or disabled.
1271This is useful for those remote destinations with multiples
1272interfaces where the response may not originate from the same
1273endpoint that the original destination endpoint was sent to.
5d20095f 1274This only affects udp and icmp protocol pings.
15d96390
JH
1275
1276This is enabled by default.
1277
f569508e
HS
1278=item $p->tcp_service_check( { 0 | 1 } );
1279
1280Set whether or not the tcp connect behavior should enforce
1281remote service availability as well as reachability. Normally,
1282if the remote server reported ECONNREFUSED, it must have been
1283reachable because of the status packet that it reported.
1284With this option enabled, the full three-way tcp handshake
1285must have been established successfully before it will
1286claim it is reachable. NOTE: It still does nothing more
1287than connect and disconnect. It does not speak any protocol
1288(i.e., HTTP or FTP) to ensure the remote server is sane in
1289any way. The remote server CPU could be grinding to a halt
1290and unresponsive to any clients connecting, but if the kernel
1291throws the ACK packet, it is considered alive anyway. To
1292really determine if the server is responding well would be
1293application specific and is beyond the scope of Net::Ping.
1294
1295This only affects "tcp" and "syn" protocols.
1296
1297This is disabled by default.
1298
e82f584b
JH
1299=item $p->hires( { 0 | 1 } );
1300
1301Causes this module to use Time::HiRes module, allowing milliseconds
1302to be returned by subsequent calls to ping().
1303
15d96390
JH
1304This is disabled by default.
1305
49afa5f6
JH
1306=item $p->bind($local_addr);
1307
1308Sets the source address from which pings will be sent. This must be
1309the address of one of the interfaces on the local host. $local_addr
1310may be specified as a hostname or as a text IP address such as
1311"192.168.1.1".
1312
1313If the protocol is set to "tcp", this method may be called any
1314number of times, and each call to the ping() method (below) will use
1315the most recent $local_addr. If the protocol is "icmp" or "udp",
1316then bind() must be called at most once per object, and (if it is
1317called at all) must be called before the first call to ping() for that
1318object.
1319
b124990b
JH
1320=item $p->open($host);
1321
f569508e 1322When you are using the "stream" protocol, this call pre-opens the
b124990b
JH
1323tcp socket. It's only necessary to do this if you want to
1324provide a different timeout when creating the connection, or
1325remove the overhead of establishing the connection from the
1326first ping. If you don't call C<open()>, the connection is
1327automatically opened the first time C<ping()> is called.
787ecdfa
JH
1328This call simply does nothing if you are using any protocol other
1329than stream.
1330
f569508e
HS
1331=item $p->ack( [ $host ] );
1332
1333When using the "syn" protocol, use this method to determine
1334the reachability of the remote host. This method is meant
1335to be called up to as many times as ping() was called. Each
1336call returns the host (as passed to ping()) that came back
1337with the TCP ACK. The order in which the hosts are returned
1338may not necessarily be the same order in which they were
1339SYN queued using the ping() method. If the timeout is
1340reached before the TCP ACK is received, or if the remote
1341host is not listening on the port attempted, then the TCP
1342connection will not be established and ack() will return
1343undef. In list context, the host, the ack time, and the
1344dotted ip string will be returned instead of just the host.
1345If the optional $host argument is specified, the return
1346value will be partaining to that host only.
1347This call simply does nothing if you are using any protocol
1348other than syn.
1349
1350=item $p->nack( $failed_ack_host );
1351
1352The reason that host $failed_ack_host did not receive a
1353valid ACK. Useful to find out why when ack( $fail_ack_host )
1354returns a false value.
1355
a3b93737
RM
1356=item $p->close();
1357
1358Close the network connection for this ping object. The network
1359connection is also closed by "undef $p". The network connection is
1360automatically closed if the ping object goes out of scope (e.g. $p is
1361local to a subroutine and you leave the subroutine).
1362
1363=item pingecho($host [, $timeout]);
1364
1365To provide backward compatibility with the previous version of
1366Net::Ping, a pingecho() subroutine is available with the same
1367functionality as before. pingecho() uses the tcp protocol. The
1368return values and parameters are the same as described for the ping()
1369method. This subroutine is obsolete and may be removed in a future
1370version of Net::Ping.
8e07c86e 1371
a3b93737 1372=back
8e07c86e 1373
b124990b
JH
1374=head1 WARNING
1375
1376pingecho() or a ping object with the tcp protocol use alarm() to
1377implement the timeout. So, don't use alarm() in your program while
1378you are using pingecho() or a ping object with the tcp protocol. The
1379udp and icmp protocols do not use alarm() to implement the timeout.
1380
a3b93737 1381=head1 NOTES
8e07c86e 1382
a3b93737
RM
1383There will be less network overhead (and some efficiency in your
1384program) if you specify either the udp or the icmp protocol. The tcp
1385protocol will generate 2.5 times or more traffic for each ping than
1386either udp or icmp. If many hosts are pinged frequently, you may wish
1387to implement a small wait (e.g. 25ms or more) between each ping to
1388avoid flooding your network with packets.
8e07c86e 1389
a3b93737 1390The icmp protocol requires that the program be run as root or that it
787ecdfa
JH
1391be setuid to root. The other protocols do not require special
1392privileges, but not all network devices implement tcp or udp echo.
8e07c86e 1393
a3b93737
RM
1394Local hosts should normally respond to pings within milliseconds.
1395However, on a very congested network it may take up to 3 seconds or
1396longer to receive an echo packet from the remote host. If the timeout
1397is set too low under these conditions, it will appear that the remote
1398host is not reachable (which is almost the truth).
8e07c86e 1399
a3b93737 1400Reachability doesn't necessarily mean that the remote host is actually
787ecdfa
JH
1401functioning beyond its ability to echo packets. tcp is slightly better
1402at indicating the health of a system than icmp because it uses more
1403of the networking stack to respond.
8e07c86e 1404
a3b93737
RM
1405Because of a lack of anything better, this module uses its own
1406routines to pack and unpack ICMP packets. It would be better for a
1407separate module to be written which understands all of the different
1408kinds of ICMP packets.
8e07c86e 1409
5d20095f
JH
1410=head1 INSTALL
1411
1412The latest source tree is available via cvs:
1413
f569508e 1414 cvs -z3 -q -d :pserver:anonymous@cvs.roobik.com.:/usr/local/cvsroot/freeware checkout Net-Ping
5d20095f
JH
1415 cd Net-Ping
1416
1417The tarball can be created as follows:
1418
1419 perl Makefile.PL ; make ; make dist
1420
1421The latest Net::Ping release can be found at CPAN:
1422
1423 $CPAN/modules/by-module/Net/
1424
14251) Extract the tarball
1426
1427 gtar -zxvf Net-Ping-xxxx.tar.gz
1428 cd Net-Ping-xxxx
1429
14302) Build:
1431
1432 make realclean
1433 perl Makefile.PL
1434 make
1435 make test
1436
14373) Install
1438
1439 make install
1440
1441Or install it RPM Style:
1442
1443 rpm -ta SOURCES/Net-Ping-xxxx.tar.gz
1444
1445 rpm -ih RPMS/noarch/perl-Net-Ping-xxxx.rpm
1446
49afa5f6 1447=head1 AUTHORS
b124990b 1448
e82f584b 1449 Current maintainer:
49afa5f6 1450 bbb@cpan.org (Rob Brown)
b124990b 1451
e82f584b
JH
1452 External protocol:
1453 colinm@cpan.org (Colin McMillen)
1454
b124990b
JH
1455 Stream protocol:
1456 bronson@trestle.com (Scott Bronson)
1457
1458 Original pingecho():
1459 karrer@bernina.ethz.ch (Andreas Karrer)
1460 pmarquess@bfsec.bt.co.uk (Paul Marquess)
1461
1462 Original Net::Ping author:
1463 mose@ns.ccsn.edu (Russell Mosemann)
1464
b124990b
JH
1465=head1 COPYRIGHT
1466
e82f584b 1467Copyright (c) 2002, Rob Brown. All rights reserved.
49afa5f6 1468
e82f584b 1469Copyright (c) 2001, Colin McMillen. All rights reserved.
b124990b
JH
1470
1471This program is free software; you may redistribute it and/or
1472modify it under the same terms as Perl itself.
1473
a3b93737 1474=cut