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