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