This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
XML::Parser 2.31 should be out shortly.
[perl5.git] / lib / Net / Ping.pm
CommitLineData
a0d0e21e
LW
1package Net::Ping;
2
b757f218 3# $Id: Ping.pm,v 1.17 2002/02/18 01:25:11 rob Exp $
b124990b
JH
4
5require 5.002;
a0d0e21e
LW
6require Exporter;
7
a3b93737 8use strict;
b124990b
JH
9use vars qw(@ISA @EXPORT $VERSION
10 $def_timeout $def_proto $max_datasize $pingstring);
a3b93737
RM
11use FileHandle;
12use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET
b124990b 13 inet_aton sockaddr_in );
a3b93737 14use Carp;
b757f218 15use Errno qw(ECONNREFUSED);
a79c1648 16
a0d0e21e 17@ISA = qw(Exporter);
a3b93737 18@EXPORT = qw(pingecho);
b757f218 19$VERSION = "2.12";
a0d0e21e 20
a3b93737 21# Constants
a0d0e21e 22
a3b93737
RM
23$def_timeout = 5; # Default timeout to wait for a reply
24$def_proto = "udp"; # Default protocol to use for pinging
25$max_datasize = 1024; # Maximum data bytes in a packet
b124990b
JH
26# The data we exchange with the server for the stream protocol
27$pingstring = "pingschwingping!\n";
a0d0e21e 28
a3b93737
RM
29# Description: The pingecho() subroutine is provided for backward
30# compatibility with the original Net::Ping. It accepts a host
31# name/IP and an optional timeout in seconds. Create a tcp ping
32# object and try pinging the host. The result of the ping is returned.
a0d0e21e 33
a3b93737
RM
34sub pingecho
35{
36 my ($host, # Name or IP number of host to ping
37 $timeout # Optional timeout in seconds
38 ) = @_;
39 my ($p); # A ping object
a0d0e21e 40
a3b93737
RM
41 $p = Net::Ping->new("tcp", $timeout);
42 $p->ping($host); # Going out of scope closes the connection
43}
a0d0e21e 44
a3b93737
RM
45# Description: The new() method creates a new ping object. Optional
46# parameters may be specified for the protocol to use, the timeout in
47# seconds and the size in bytes of additional data which should be
48# included in the packet.
49# After the optional parameters are checked, the data is constructed
50# and a socket is opened if appropriate. The object is returned.
51
52sub new
53{
54 my ($this,
55 $proto, # Optional protocol to use for pinging
56 $timeout, # Optional timeout in seconds
57 $data_size # Optional additional bytes of data
58 ) = @_;
59 my $class = ref($this) || $this;
60 my $self = {};
61 my ($cnt, # Count through data bytes
62 $min_datasize # Minimum data bytes required
63 );
64
65 bless($self, $class);
66
67 $proto = $def_proto unless $proto; # Determine the protocol
787ecdfa
JH
68 croak('Protocol for ping must be "icmp", "udp", "tcp", "stream", or "external"')
69 unless $proto =~ m/^(icmp|udp|tcp|stream|external)$/;
a3b93737
RM
70 $self->{"proto"} = $proto;
71
72 $timeout = $def_timeout unless $timeout; # Determine the timeout
73 croak("Default timeout for ping must be greater than 0 seconds")
74 if $timeout <= 0;
75 $self->{"timeout"} = $timeout;
76
77 $min_datasize = ($proto eq "udp") ? 1 : 0; # Determine data size
78 $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp";
79 croak("Data for ping must be from $min_datasize to $max_datasize bytes")
80 if ($data_size < $min_datasize) || ($data_size > $max_datasize);
81 $data_size-- if $self->{"proto"} eq "udp"; # We provide the first byte
82 $self->{"data_size"} = $data_size;
83
84 $self->{"data"} = ""; # Construct data bytes
85 for ($cnt = 0; $cnt < $self->{"data_size"}; $cnt++)
86 {
87 $self->{"data"} .= chr($cnt % 256);
88 }
89
49afa5f6
JH
90 $self->{"local_addr"} = undef; # Don't bind by default
91
a3b93737
RM
92 $self->{"seq"} = 0; # For counting packets
93 if ($self->{"proto"} eq "udp") # Open a socket
94 {
95 $self->{"proto_num"} = (getprotobyname('udp'))[2] ||
96 croak("Can't udp protocol by name");
97 $self->{"port_num"} = (getservbyname('echo', 'udp'))[2] ||
98 croak("Can't get udp echo port by name");
99 $self->{"fh"} = FileHandle->new();
49afa5f6 100 socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
a3b93737
RM
101 $self->{"proto_num"}) ||
102 croak("udp socket error - $!");
103 }
104 elsif ($self->{"proto"} eq "icmp")
105 {
787ecdfa 106 croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS');
a3b93737
RM
107 $self->{"proto_num"} = (getprotobyname('icmp'))[2] ||
108 croak("Can't get icmp protocol by name");
109 $self->{"pid"} = $$ & 0xffff; # Save lower 16 bits of pid
110 $self->{"fh"} = FileHandle->new();
49afa5f6 111 socket($self->{"fh"}, PF_INET, SOCK_RAW, $self->{"proto_num"}) ||
a3b93737
RM
112 croak("icmp socket error - $!");
113 }
787ecdfa 114 elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream")
a3b93737
RM
115 {
116 $self->{"proto_num"} = (getprotobyname('tcp'))[2] ||
117 croak("Can't get tcp protocol by name");
118 $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] ||
119 croak("Can't get tcp echo port by name");
120 $self->{"fh"} = FileHandle->new();
121 }
122
a3b93737
RM
123 return($self);
124}
a0d0e21e 125
49afa5f6
JH
126# Description: Set the local IP address from which pings will be sent.
127# For ICMP and UDP pings, this calls bind() on the already-opened socket;
128# for TCP pings, just saves the address to be used when the socket is
129# opened. Returns non-zero if successful; croaks on error.
130sub bind
131{
132 my ($self,
133 $local_addr # Name or IP number of local interface
134 ) = @_;
135 my ($ip # Packed IP number of $local_addr
136 );
137
138 croak("Usage: \$p->bind(\$local_addr)") unless @_ == 2;
139 croak("already bound") if defined($self->{"local_addr"}) &&
140 ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp");
141
142 $ip = inet_aton($local_addr);
143 croak("nonexistent local address $local_addr") unless defined($ip);
144 $self->{"local_addr"} = $ip; # Only used if proto is tcp
145
146 if ($self->{"proto"} eq "udp" || $self->{"proto"} eq "icmp")
147 {
148 CORE::bind($self->{"fh"}, sockaddr_in(0, $ip)) ||
149 croak("$self->{'proto'} bind error - $!");
150 }
151 elsif ($self->{"proto"} ne "tcp")
152 {
153 croak("Unknown protocol \"$self->{proto}\" in bind()");
154 }
155
156 return 1;
157}
158
159
a3b93737
RM
160# Description: Ping a host name or IP number with an optional timeout.
161# First lookup the host, and return undef if it is not found. Otherwise
b124990b 162# perform the specific ping method based on the protocol. Return the
a3b93737
RM
163# result of the ping.
164
165sub ping
166{
167 my ($self,
168 $host, # Name or IP number of host to ping
169 $timeout # Seconds after which ping times out
170 ) = @_;
171 my ($ip, # Packed IP number of $host
172 $ret # The return value
173 );
174
175 croak("Usage: \$p->ping(\$host [, \$timeout])") unless @_ == 2 || @_ == 3;
176 $timeout = $self->{"timeout"} unless $timeout;
177 croak("Timeout must be greater than 0 seconds") if $timeout <= 0;
178
179 $ip = inet_aton($host);
180 return(undef) unless defined($ip); # Does host exist?
181
787ecdfa
JH
182 # Dispatch to the appropriate routine.
183 return $self->ping_external($ip, $timeout) if $self->{"proto"} eq "external";
184 return $self->ping_udp($ip, $timeout) if $self->{"proto"} eq "udp";
185 return $self->ping_icmp($ip, $timeout) if $self->{"proto"} eq "icmp";
186 return $self->ping_tcp($ip, $timeout) if $self->{"proto"} eq "tcp";
187 return $self->ping_stream($ip, $timeout) if $self->{"proto"} eq "stream";
188
189 croak("Unknown protocol \"$self->{proto}\" in ping()");
190}
191
192# Uses Net::Ping::External to do an external ping.
193sub ping_external {
194 my ($self,
195 $ip, # Packed IP number of the host
196 $timeout # Seconds after which ping times out
197 ) = @_;
198
b124990b
JH
199 eval { require Net::Ping::External; }
200 or croak('Protocol "external" not supported on your system: Net::Ping::External not found');
787ecdfa 201 return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
a3b93737 202}
a0d0e21e 203
49afa5f6
JH
204use constant ICMP_ECHOREPLY => 0; # ICMP packet types
205use constant ICMP_ECHO => 8;
206use constant ICMP_STRUCT => "C2 S3 A"; # Structure of a minimal ICMP packet
207use constant SUBCODE => 0; # No ICMP subcode for ECHO and ECHOREPLY
208use constant ICMP_FLAGS => 0; # No special flags for send or recv
209use constant ICMP_PORT => 0; # No port with ICMP
210
a3b93737
RM
211sub ping_icmp
212{
213 my ($self,
214 $ip, # Packed IP number of the host
215 $timeout # Seconds after which ping times out
216 ) = @_;
217
a3b93737
RM
218 my ($saddr, # sockaddr_in with port and ip
219 $checksum, # Checksum of ICMP packet
220 $msg, # ICMP packet to send
221 $len_msg, # Length of $msg
222 $rbits, # Read bits, filehandles for reading
223 $nfound, # Number of ready filehandles found
224 $finish_time, # Time ping should be finished
225 $done, # set to 1 when we are done
226 $ret, # Return value
227 $recv_msg, # Received message including IP header
228 $from_saddr, # sockaddr_in of sender
229 $from_port, # Port packet was sent from
230 $from_ip, # Packed IP of sender
231 $from_type, # ICMP type
232 $from_subcode, # ICMP subcode
233 $from_chk, # ICMP packet checksum
234 $from_pid, # ICMP packet id
235 $from_seq, # ICMP packet sequence
236 $from_msg # ICMP message
237 );
238
239 $self->{"seq"} = ($self->{"seq"} + 1) % 65536; # Increment sequence
240 $checksum = 0; # No checksum for starters
49afa5f6 241 $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
a3b93737
RM
242 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
243 $checksum = Net::Ping->checksum($msg);
49afa5f6 244 $msg = pack(ICMP_STRUCT . $self->{"data_size"}, ICMP_ECHO, SUBCODE,
a3b93737
RM
245 $checksum, $self->{"pid"}, $self->{"seq"}, $self->{"data"});
246 $len_msg = length($msg);
49afa5f6
JH
247 $saddr = sockaddr_in(ICMP_PORT, $ip);
248 send($self->{"fh"}, $msg, ICMP_FLAGS, $saddr); # Send the message
a3b93737
RM
249
250 $rbits = "";
251 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
8e07c86e 252 $ret = 0;
a3b93737
RM
253 $done = 0;
254 $finish_time = time() + $timeout; # Must be done by this time
255 while (!$done && $timeout > 0) # Keep trying if we have time
256 {
257 $nfound = select($rbits, undef, undef, $timeout); # Wait for packet
258 $timeout = $finish_time - time(); # Get remaining time
259 if (!defined($nfound)) # Hmm, a strange error
260 {
261 $ret = undef;
262 $done = 1;
263 }
264 elsif ($nfound) # Got a packet from somewhere
265 {
266 $recv_msg = "";
49afa5f6 267 $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, ICMP_FLAGS);
a3b93737
RM
268 ($from_port, $from_ip) = sockaddr_in($from_saddr);
269 ($from_type, $from_subcode, $from_chk,
270 $from_pid, $from_seq, $from_msg) =
49afa5f6 271 unpack(ICMP_STRUCT . $self->{"data_size"},
a3b93737
RM
272 substr($recv_msg, length($recv_msg) - $len_msg,
273 $len_msg));
49afa5f6 274 if (($from_type == ICMP_ECHOREPLY) &&
a3b93737
RM
275 ($from_ip eq $ip) &&
276 ($from_pid == $self->{"pid"}) && # Does the packet check out?
277 ($from_seq == $self->{"seq"}))
278 {
279 $ret = 1; # It's a winner
280 $done = 1;
281 }
282 }
283 else # Oops, timed out
284 {
285 $done = 1;
286 }
287 }
288 return($ret)
289}
290
291# Description: Do a checksum on the message. Basically sum all of
292# the short words and fold the high order bits into the low order bits.
293
294sub checksum
295{
296 my ($class,
297 $msg # The message to checksum
298 ) = @_;
299 my ($len_msg, # Length of the message
300 $num_short, # The number of short words in the message
301 $short, # One short word
302 $chk # The checksum
303 );
304
305 $len_msg = length($msg);
787ecdfa 306 $num_short = int($len_msg / 2);
a3b93737
RM
307 $chk = 0;
308 foreach $short (unpack("S$num_short", $msg))
309 {
310 $chk += $short;
311 } # Add the odd byte in
787ecdfa 312 $chk += (unpack("C", substr($msg, $len_msg - 1, 1)) << 8) if $len_msg % 2;
a3b93737
RM
313 $chk = ($chk >> 16) + ($chk & 0xffff); # Fold high into low
314 return(~(($chk >> 16) + $chk) & 0xffff); # Again and complement
315}
316
787ecdfa 317
b124990b
JH
318# Description: Perform a tcp echo ping. Since a tcp connection is
319# host specific, we have to open and close each connection here. We
320# can't just leave a socket open. Because of the robust nature of
321# tcp, it will take a while before it gives up trying to establish a
322# connection. Therefore, we use select() on a non-blocking socket to
323# check against our timeout. No data bytes are actually
324# sent since the successful establishment of a connection is proof
325# enough of the reachability of the remote host. Also, tcp is
326# expensive and doesn't need our help to add to the overhead.
327
328sub ping_tcp
787ecdfa
JH
329{
330 my ($self,
331 $ip, # Packed IP number of the host
b124990b 332 $timeout # Seconds after which ping times out
787ecdfa 333 ) = @_;
b124990b 334 my ($ret # The return value
787ecdfa
JH
335 );
336
b757f218 337 $@ = ""; $! = 0;
b124990b 338 $ret = $self -> tcp_connect( $ip, $timeout);
b757f218
JH
339 $ret = 1 if $! == ECONNREFUSED # Connection refused
340 || $@ =~ /Unknown Error/i; # Special Win32 response?
787ecdfa 341 $self->{"fh"}->close();
b124990b 342 return($ret);
787ecdfa
JH
343}
344
b124990b 345sub tcp_connect
787ecdfa
JH
346{
347 my ($self,
348 $ip, # Packed IP number of the host
b124990b 349 $timeout # Seconds after which connect times out
787ecdfa 350 ) = @_;
b124990b 351 my ($saddr); # Packed IP and Port
787ecdfa 352
b124990b 353 $saddr = sockaddr_in($self->{"port_num"}, $ip);
787ecdfa 354
b124990b 355 my $ret = 0; # Default to unreachable
787ecdfa 356
b124990b 357 my $do_socket = sub {
49afa5f6 358 socket($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"}) ||
b124990b 359 croak("tcp socket error - $!");
49afa5f6
JH
360 if (defined $self->{"local_addr"} &&
361 !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
362 croak("tcp bind error - $!");
363 }
b124990b
JH
364 };
365 my $do_connect = sub {
366 eval {
367 die $! unless connect($self->{"fh"}, $saddr);
368 $self->{"ip"} = $ip;
369 $ret = 1;
370 };
371 $ret;
372 };
373
374 if ($^O =~ /Win32/i) {
375
376 # Buggy Winsock API doesn't allow us to use alarm() calls.
377 # Hence, if our OS is Windows, we need to create a separate
378 # process to do the blocking connect attempt.
379
380 $| = 1; # Clear buffer prior to fork to prevent duplicate flushing.
381 my $pid = fork;
382 if (!$pid) {
383 if (!defined $pid) {
384 # Fork did not work
385 warn "Win32 Fork error: $!";
386 return 0;
387 }
388 &{ $do_socket }();
389
390 # Try a slow blocking connect() call
391 # and report the status to the pipe.
392 if ( &{ $do_connect }() ) {
393 $self->{"fh"}->close();
394 # No error
395 exit 0;
396 } else {
397 # Pass the error status to the parent
398 exit $!;
399 }
400 }
401
402 &{ $do_socket }();
403
404 my $patience = time + $timeout;
405
406 require POSIX;
407 my ($child);
408 $? = 0;
409 # Wait up to the timeout
410 # And clean off the zombie
411 do {
412 $child = waitpid($pid, &POSIX::WNOHANG);
413 $! = $? >> 8;
414 $@ = $!;
505f3f16 415 select(undef, undef, undef, 0.1);
b124990b
JH
416 } while time < $patience && $child != $pid;
417
418 if ($child == $pid) {
419 # Since she finished within the timeout,
420 # it is probably safe for me to try it too
421 &{ $do_connect }();
422 } else {
423 # Time must have run out.
424 $@ = "Timed out!";
425 # Put that choking client out of its misery
426 kill "KILL", $pid;
427 # Clean off the zombie
428 waitpid($pid, 0);
429 $ret = 0;
430 }
431 } else { # Win32
432 # Otherwise don't waste the resources to fork
433
434 &{ $do_socket }();
435
436 $SIG{'ALRM'} = sub { die "Timed out!"; };
437 alarm($timeout); # Interrupt connect() if we have to
438
439 &{ $do_connect }();
440 alarm(0);
441 }
787ecdfa 442
b124990b 443 return $ret;
787ecdfa
JH
444}
445
446# This writes the given string to the socket and then reads it
447# back. It returns 1 on success, 0 on failure.
448sub tcp_echo
449{
b124990b
JH
450 my $self = shift;
451 my $timeout = shift;
452 my $pingstring = shift;
787ecdfa 453
b124990b
JH
454 my $ret = undef;
455 my $time = time;
456 my $wrstr = $pingstring;
457 my $rdstr = "";
787ecdfa
JH
458
459 eval <<'EOM';
b124990b
JH
460 do {
461 my $rin = "";
462 vec($rin, $self->{"fh"}->fileno(), 1) = 1;
463
464 my $rout = undef;
465 if($wrstr) {
466 $rout = "";
467 vec($rout, $self->{"fh"}->fileno(), 1) = 1;
468 }
469
470 if(select($rin, $rout, undef, ($time + $timeout) - time())) {
471
472 if($rout && vec($rout,$self->{"fh"}->fileno(),1)) {
473 my $num = syswrite($self->{"fh"}, $wrstr);
474 if($num) {
475 # If it was a partial write, update and try again.
476 $wrstr = substr($wrstr,$num);
477 } else {
478 # There was an error.
479 $ret = 0;
480 }
481 }
482
483 if(vec($rin,$self->{"fh"}->fileno(),1)) {
484 my $reply;
485 if(sysread($self->{"fh"},$reply,length($pingstring)-length($rdstr))) {
486 $rdstr .= $reply;
487 $ret = 1 if $rdstr eq $pingstring;
488 } else {
489 # There was an error.
490 $ret = 0;
491 }
492 }
493
494 }
495 } until time() > ($time + $timeout) || defined($ret);
787ecdfa
JH
496EOM
497
b124990b 498 return $ret;
787ecdfa
JH
499}
500
787ecdfa 501
787ecdfa 502
787ecdfa
JH
503
504# Description: Perform a stream ping. If the tcp connection isn't
505# already open, it opens it. It then sends some data and waits for
506# a reply. It leaves the stream open on exit.
507
508sub ping_stream
509{
510 my ($self,
511 $ip, # Packed IP number of the host
512 $timeout # Seconds after which ping times out
072620d9
SB
513 ) = @_;
514
787ecdfa
JH
515 # Open the stream if it's not already open
516 if(!defined $self->{"fh"}->fileno()) {
517 $self->tcp_connect($ip, $timeout) or return 0;
518 }
072620d9 519
787ecdfa
JH
520 croak "tried to switch servers while stream pinging"
521 if $self->{"ip"} ne $ip;
522
b124990b 523 return $self->tcp_echo($timeout, $pingstring);
787ecdfa
JH
524}
525
526# Description: opens the stream. You would do this if you want to
527# separate the overhead of opening the stream from the first ping.
528
529sub open
530{
b124990b
JH
531 my ($self,
532 $host, # Host or IP address
787ecdfa 533 $timeout # Seconds after which open times out
b124990b 534 ) = @_;
787ecdfa 535
b124990b
JH
536 my ($ip); # Packed IP number of the host
537 $ip = inet_aton($host);
538 $timeout = $self->{"timeout"} unless $timeout;
787ecdfa 539
b124990b
JH
540 if($self->{"proto"} eq "stream") {
541 if(defined($self->{"fh"}->fileno())) {
542 croak("socket is already open");
543 } else {
544 $self->tcp_connect($ip, $timeout);
545 }
546 }
072620d9
SB
547}
548
b124990b 549
a3b93737
RM
550# Description: Perform a udp echo ping. Construct a message of
551# at least the one-byte sequence number and any additional data bytes.
552# Send the message out and wait for a message to come back. If we
553# get a message, make sure all of its parts match. If they do, we are
554# done. Otherwise go back and wait for the message until we run out
555# of time. Return the result of our efforts.
556
49afa5f6
JH
557use constant UDP_FLAGS => 0; # Nothing special on send or recv
558
a3b93737
RM
559sub ping_udp
560{
561 my ($self,
562 $ip, # Packed IP number of the host
563 $timeout # Seconds after which ping times out
564 ) = @_;
565
a3b93737
RM
566 my ($saddr, # sockaddr_in with port and ip
567 $ret, # The return value
568 $msg, # Message to be echoed
569 $finish_time, # Time ping should be finished
570 $done, # Set to 1 when we are done pinging
571 $rbits, # Read bits, filehandles for reading
572 $nfound, # Number of ready filehandles found
573 $from_saddr, # sockaddr_in of sender
574 $from_msg, # Characters echoed by $host
575 $from_port, # Port message was echoed from
576 $from_ip # Packed IP number of sender
577 );
578
579 $saddr = sockaddr_in($self->{"port_num"}, $ip);
580 $self->{"seq"} = ($self->{"seq"} + 1) % 256; # Increment sequence
581 $msg = chr($self->{"seq"}) . $self->{"data"}; # Add data if any
49afa5f6 582 send($self->{"fh"}, $msg, UDP_FLAGS, $saddr); # Send it
a3b93737
RM
583
584 $rbits = "";
585 vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
586 $ret = 0; # Default to unreachable
587 $done = 0;
588 $finish_time = time() + $timeout; # Ping needs to be done by then
589 while (!$done && $timeout > 0)
590 {
591 $nfound = select($rbits, undef, undef, $timeout); # Wait for response
592 $timeout = $finish_time - time(); # Get remaining time
593
594 if (!defined($nfound)) # Hmm, a strange error
595 {
596 $ret = undef;
597 $done = 1;
598 }
599 elsif ($nfound) # A packet is waiting
600 {
601 $from_msg = "";
49afa5f6 602 $from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS)
787ecdfa
JH
603 or last; # For example an unreachable host will make recv() fail.
604 ($from_port, $from_ip) = sockaddr_in($from_saddr);
605 if (($from_ip eq $ip) && # Does the packet check out?
606 ($from_port == $self->{"port_num"}) &&
607 ($from_msg eq $msg))
608 {
609 $ret = 1; # It's a winner
610 $done = 1;
611 }
612 }
a3b93737
RM
613 else # Oops, timed out
614 {
615 $done = 1;
616 }
617 }
618 return($ret);
b124990b 619}
a0d0e21e 620
a3b93737
RM
621# Description: Close the connection unless we are using the tcp
622# protocol, since it will already be closed.
623
624sub close
625{
626 my ($self) = @_;
627
628 $self->{"fh"}->close() unless $self->{"proto"} eq "tcp";
629}
630
631
a0d0e21e 6321;
8e07c86e
AD
633__END__
634
8e07c86e
AD
635=head1 NAME
636
a3b93737 637Net::Ping - check a remote host for reachability
8e07c86e 638
b757f218 639$Id: Ping.pm,v 1.17 2002/02/18 01:25:11 rob Exp $
b124990b 640
8e07c86e
AD
641=head1 SYNOPSIS
642
643 use Net::Ping;
8e07c86e 644
a3b93737
RM
645 $p = Net::Ping->new();
646 print "$host is alive.\n" if $p->ping($host);
647 $p->close();
648
649 $p = Net::Ping->new("icmp");
49afa5f6 650 $p->bind($my_addr); # Specify source interface of pings
a3b93737
RM
651 foreach $host (@host_array)
652 {
653 print "$host is ";
654 print "NOT " unless $p->ping($host, 2);
655 print "reachable.\n";
656 sleep(1);
657 }
658 $p->close();
b124990b 659
a3b93737 660 $p = Net::Ping->new("tcp", 2);
b124990b
JH
661 # Try connecting to the www port instead of the echo port
662 $p->{port_num} = getservbyname("http", "tcp");
a3b93737
RM
663 while ($stop_time > time())
664 {
665 print "$host not reachable ", scalar(localtime()), "\n"
666 unless $p->ping($host);
667 sleep(300);
668 }
669 undef($p);
b124990b 670
a3b93737
RM
671 # For backward compatibility
672 print "$host is alive.\n" if pingecho($host);
8e07c86e 673
a3b93737 674=head1 DESCRIPTION
8e07c86e 675
a3b93737
RM
676This module contains methods to test the reachability of remote
677hosts on a network. A ping object is first created with optional
678parameters, a variable number of hosts may be pinged multiple
679times and then the connection is closed.
680
b124990b
JH
681You may choose one of four different protocols to use for the
682ping. The "udp" protocol is the default. Note that a live remote host
683may still fail to be pingable by one or more of these protocols. For
684example, www.microsoft.com is generally alive but not pingable.
787ecdfa 685
b124990b
JH
686With the "tcp" protocol the ping() method attempts to establish a
687connection to the remote host's echo port. If the connection is
688successfully established, the remote host is considered reachable. No
689data is actually echoed. This protocol does not require any special
690privileges but has higher overhead than the other two protocols.
072620d9 691
b124990b 692Specifying the "udp" protocol causes the ping() method to send a udp
a3b93737
RM
693packet to the remote host's echo port. If the echoed packet is
694received from the remote host and the received packet contains the
695same data as the packet that was sent, the remote host is considered
696reachable. This protocol does not require any special privileges.
b124990b 697It should be borne in mind that, for a udp ping, a host
787ecdfa 698will be reported as unreachable if it is not running the
b124990b
JH
699appropriate echo service. For Unix-like systems see L<inetd(8)>
700for more information.
787ecdfa 701
b124990b
JH
702If the "icmp" protocol is specified, the ping() method sends an icmp
703echo message to the remote host, which is what the UNIX ping program
704does. If the echoed message is received from the remote host and
705the echoed information is correct, the remote host is considered
706reachable. Specifying the "icmp" protocol requires that the program
707be run as root or that the program be setuid to root.
787ecdfa 708
b124990b
JH
709If the "external" protocol is specified, the ping() method attempts to
710use the C<Net::Ping::External> module to ping the remote host.
711C<Net::Ping::External> interfaces with your system's default C<ping>
712utility to perform the ping, and generally produces relatively
787ecdfa
JH
713accurate results. If C<Net::Ping::External> if not installed on your
714system, specifying the "external" protocol will result in an error.
edc5bd88 715
a3b93737
RM
716=head2 Functions
717
718=over 4
719
720=item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]);
721
722Create a new ping object. All of the parameters are optional. $proto
723specifies the protocol to use when doing a ping. The current choices
724are "tcp", "udp" or "icmp". The default is "udp".
725
726If a default timeout ($def_timeout) in seconds is provided, it is used
727when a timeout is not given to the ping() method (below). The timeout
728must be greater than 0 and the default, if not specified, is 5 seconds.
729
730If the number of data bytes ($bytes) is given, that many data bytes
731are included in the ping packet sent to the remote host. The number of
732data bytes is ignored if the protocol is "tcp". The minimum (and
733default) number of data bytes is 1 if the protocol is "udp" and 0
734otherwise. The maximum number of data bytes that can be specified is
7351024.
736
49afa5f6
JH
737=item $p->bind($local_addr);
738
739Sets the source address from which pings will be sent. This must be
740the address of one of the interfaces on the local host. $local_addr
741may be specified as a hostname or as a text IP address such as
742"192.168.1.1".
743
744If the protocol is set to "tcp", this method may be called any
745number of times, and each call to the ping() method (below) will use
746the most recent $local_addr. If the protocol is "icmp" or "udp",
747then bind() must be called at most once per object, and (if it is
748called at all) must be called before the first call to ping() for that
749object.
750
a3b93737
RM
751=item $p->ping($host [, $timeout]);
752
753Ping the remote host and wait for a response. $host can be either the
754hostname or the IP number of the remote host. The optional timeout
755must be greater than 0 seconds and defaults to whatever was specified
756when the ping object was created. If the hostname cannot be found or
757there is a problem with the IP number, undef is returned. Otherwise,
7581 is returned if the host is reachable and 0 if it is not. For all
759practical purposes, undef and 0 and can be treated as the same case.
760
787ecdfa
JH
761=item $p->open($host);
762
763When you are using the stream protocol, this call pre-opens the
764tcp socket. It's only necessary to do this if you want to
765provide a different timeout when creating the connection, or
766remove the overhead of establishing the connection from the
767first ping. If you don't call C<open()>, the connection is
b124990b
JH
768automatically opened the first time C<ping()> is called.
769This call simply does nothing if you are using any protocol other
770than stream.
771
772=item $p->open($host);
773
774When you are using the stream protocol, this call pre-opens the
775tcp socket. It's only necessary to do this if you want to
776provide a different timeout when creating the connection, or
777remove the overhead of establishing the connection from the
778first ping. If you don't call C<open()>, the connection is
779automatically opened the first time C<ping()> is called.
787ecdfa
JH
780This call simply does nothing if you are using any protocol other
781than stream.
782
a3b93737
RM
783=item $p->close();
784
785Close the network connection for this ping object. The network
786connection is also closed by "undef $p". The network connection is
787automatically closed if the ping object goes out of scope (e.g. $p is
788local to a subroutine and you leave the subroutine).
789
790=item pingecho($host [, $timeout]);
791
792To provide backward compatibility with the previous version of
793Net::Ping, a pingecho() subroutine is available with the same
794functionality as before. pingecho() uses the tcp protocol. The
795return values and parameters are the same as described for the ping()
796method. This subroutine is obsolete and may be removed in a future
797version of Net::Ping.
8e07c86e 798
a3b93737 799=back
8e07c86e 800
b124990b
JH
801=head1 WARNING
802
803pingecho() or a ping object with the tcp protocol use alarm() to
804implement the timeout. So, don't use alarm() in your program while
805you are using pingecho() or a ping object with the tcp protocol. The
806udp and icmp protocols do not use alarm() to implement the timeout.
807
a3b93737 808=head1 NOTES
8e07c86e 809
a3b93737
RM
810There will be less network overhead (and some efficiency in your
811program) if you specify either the udp or the icmp protocol. The tcp
812protocol will generate 2.5 times or more traffic for each ping than
813either udp or icmp. If many hosts are pinged frequently, you may wish
814to implement a small wait (e.g. 25ms or more) between each ping to
815avoid flooding your network with packets.
8e07c86e 816
a3b93737 817The icmp protocol requires that the program be run as root or that it
787ecdfa
JH
818be setuid to root. The other protocols do not require special
819privileges, but not all network devices implement tcp or udp echo.
8e07c86e 820
a3b93737
RM
821Local hosts should normally respond to pings within milliseconds.
822However, on a very congested network it may take up to 3 seconds or
823longer to receive an echo packet from the remote host. If the timeout
824is set too low under these conditions, it will appear that the remote
825host is not reachable (which is almost the truth).
8e07c86e 826
a3b93737 827Reachability doesn't necessarily mean that the remote host is actually
787ecdfa
JH
828functioning beyond its ability to echo packets. tcp is slightly better
829at indicating the health of a system than icmp because it uses more
830of the networking stack to respond.
8e07c86e 831
a3b93737
RM
832Because of a lack of anything better, this module uses its own
833routines to pack and unpack ICMP packets. It would be better for a
834separate module to be written which understands all of the different
835kinds of ICMP packets.
8e07c86e 836
49afa5f6 837=head1 AUTHORS
b124990b 838
49afa5f6 839 Current maintainers:
b124990b 840 colinm@cpan.org (Colin McMillen)
49afa5f6 841 bbb@cpan.org (Rob Brown)
b124990b
JH
842
843 Stream protocol:
844 bronson@trestle.com (Scott Bronson)
845
846 Original pingecho():
847 karrer@bernina.ethz.ch (Andreas Karrer)
848 pmarquess@bfsec.bt.co.uk (Paul Marquess)
849
850 Original Net::Ping author:
851 mose@ns.ccsn.edu (Russell Mosemann)
852
b124990b
JH
853=head1 COPYRIGHT
854
855Copyright (c) 2001, Colin McMillen. All rights reserved.
49afa5f6 856
b124990b
JH
857Copyright (c) 2001, Rob Brown. All rights reserved.
858
859This program is free software; you may redistribute it and/or
860modify it under the same terms as Perl itself.
861
a3b93737 862=cut