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