package Net::Ping;
-# $Id: Ping.pm,v 1.33 2002/10/19 05:02:43 rob Exp $
+# $Id: Ping.pm,v 1.46 2002/12/02 19:17:09 rob Exp $
require 5.002;
require Exporter;
use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK );
use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET SOL_SOCKET
inet_aton inet_ntoa sockaddr_in );
-use POSIX qw( ECONNREFUSED EINPROGRESS WNOHANG );
+use POSIX qw( ECONNREFUSED EINPROGRESS EAGAIN WNOHANG );
use FileHandle;
use Carp;
@ISA = qw(Exporter);
@EXPORT = qw(pingecho);
-$VERSION = "2.23";
+$VERSION = "2.26";
# Constants
$self->{"fork_wr"} = FileHandle->new();
pipe($self->{"fork_rd"}, $self->{"fork_wr"});
$self->{"fh"} = FileHandle->new();
+ $self->{"good"} = {};
+ $self->{"bad"} = {};
} else {
$self->{"wbits"} = "";
$self->{"bad"} = {};
# of time. Return the result of our efforts.
use constant UDP_FLAGS => 0; # Nothing special on send or recv
-
+# XXX - Use concept by rdw @ perlmonks
+# http://perlmonks.thepen.com/42898.html
sub ping_udp
{
my ($self,
}
# Set O_NONBLOCK property on filehandle
- if (my $flags = fcntl($fh, F_GETFL, 0)) {
- fcntl($fh, F_SETFL, $flags | O_NONBLOCK);
+ my $flags = 0;
+ if (fcntl($fh, F_GETFL, $flags)) {
+ if (!fcntl($fh, F_SETFL, $flags | O_NONBLOCK)) {
+ croak("fcntl F_SETFL: $!");
+ }
} else {
croak("fcntl F_GETFL: $!");
}
# by just sending the TCP SYN packet
if (connect($fh, $saddr)) {
# Non-blocking, yet still connected?
- # Must have connected very quickly.
- # Can this ever really happen?
- }
- else {
+ # Must have connected very quickly,
+ # or else it wasn't very non-blocking.
+ #warn "WARNING: Nonblocking connect connected anyway? ($^O)";
+ } else {
# Error occurred connecting.
- # Hopefully the connection is just still in progress.
- if ($! != EINPROGRESS) {
- # If not, then it really is something bad.
+ if ($! == EINPROGRESS) {
+ # The connection is just still in progress.
+ # This is the expected condition.
+ } else {
+ # Just save the error and continue on.
+ # The ack() can check the status later.
$self->{"bad"}->{$host} = $!;
- return undef;
}
}
if (my $host = shift) {
# Host passed as arg
if (exists $self->{"bad"}->{$host}) {
- return ();
+ if (!$self->{"tcp_econnrefused"} &&
+ $self->{"bad"}->{ $host } &&
+ (($! = ECONNREFUSED)>0) &&
+ $self->{"bad"}->{ $host } eq "$!") {
+ # "Connection refused" means reachable
+ # Good, continue
+ } else {
+ # ECONNREFUSED means no good
+ return ();
+ }
}
my $host_fd = undef;
foreach my $fd (keys %{ $self->{"syn"} }) {
while ($wbits !~ /^\0*$/) {
my $timeout = $stop_time - &time();
# Force a minimum of 10 ms timeout.
- $timeout = 0.01 if $timeout <= .01;
- if (my $nfound = select(undef, (my $wout=$wbits), undef, $timeout)) {
- # Done waiting for one of the ACKs
- my $fd = 0;
- # Determine which one
- while (length $wout &&
- !vec($wout, $fd, 1)) {
- $fd++;
+ $timeout = 0.01 if $timeout <= 0.01;
+
+ my $winner_fd = undef;
+ my $wout = $wbits;
+ my $fd = 0;
+ # Do "bad" fds from $wbits first
+ while ($wout !~ /^\0*$/) {
+ if (vec($wout, $fd, 1)) {
+ # Wipe it from future scanning.
+ vec($wout, $fd, 1) = 0;
+ if (my $entry = $self->{"syn"}->{$fd}) {
+ if ($self->{"bad"}->{ $entry->[0] }) {
+ $winner_fd = $fd;
+ last;
+ }
+ }
+ }
+ $fd++;
+ }
+
+ if (defined($winner_fd) or my $nfound = select(undef, ($wout=$wbits), undef, $timeout)) {
+ if (defined $winner_fd) {
+ $fd = $winner_fd;
+ } else {
+ # Done waiting for one of the ACKs
+ $fd = 0;
+ # Determine which one
+ while ($wout !~ /^\0*$/ &&
+ !vec($wout, $fd, 1)) {
+ $fd++;
+ }
}
if (my $entry = $self->{"syn"}->{$fd}) {
- if (getpeername($entry->[2])) {
+ # Wipe it from future scanning.
+ delete $self->{"syn"}->{$fd};
+ vec($self->{"wbits"}, $fd, 1) = 0;
+ vec($wbits, $fd, 1) = 0;
+ if (!$self->{"tcp_econnrefused"} &&
+ $self->{"bad"}->{ $entry->[0] } &&
+ (($! = ECONNREFUSED)>0) &&
+ $self->{"bad"}->{ $entry->[0] } eq "$!") {
+ # "Connection refused" means reachable
+ # Good, continue
+ } elsif (getpeername($entry->[2])) {
# Connection established to remote host
- delete $self->{"syn"}->{$fd};
- vec($self->{"wbits"}, $fd, 1) = 0;
- return wantarray ?
- ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
- : $entry->[0];
+ # Good, continue
} else {
# TCP ACK will never come from this host
# because there was an error connecting.
- # Wipe it from future scanning.
- delete $self->{"syn"}->{$fd};
- vec($self->{"wbits"}, $fd, 1) = 0;
- vec($wbits, $fd, 1) = 0;
-
# This should set $! to the correct error.
my $char;
read($entry->[2],$char,1);
# Store the excuse why the connection failed.
$self->{"bad"}->{$entry->[0]} = $!;
if (!$self->{"tcp_econnrefused"} &&
- $! == ECONNREFUSED) {
+ (($! == ECONNREFUSED) ||
+ ($! == EAGAIN && $^O =~ /cygwin/i))) {
# "Connection refused" means reachable
- return wantarray ?
- ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
- : $entry->[0];
+ # Good, continue
+ } else {
+ # No good, try the next socket...
+ next;
}
- # Try another socket...
}
+ # Everything passed okay, return the answer
+ return wantarray ?
+ ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
+ : $entry->[0];
} else {
warn "Corrupted SYN entry: unknown fd [$fd] ready!";
vec($wbits, $fd, 1) = 0;
}
sub ack_unfork {
- my $self = shift;
+ my ($self,$host) = @_;
my $stop_time = $self->{"stop_time"};
- if (my $host = shift) {
+ if ($host) {
# Host passed as arg
- warn "Cannot specify host for ack on win32\n";
+ if (my $entry = $self->{"good"}->{$host}) {
+ delete $self->{"good"}->{$host};
+ return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
+ }
}
my $rbits = "";
my $timeout;
+
if (keys %{ $self->{"syn"} }) {
# Scan all hosts that are left
vec($rbits, fileno($self->{"fork_rd"}), 1) = 1;
$timeout = $stop_time - &time();
+ # Force a minimum of 10 ms timeout.
+ $timeout = 0.01 if $timeout < 0.01;
} else {
# No hosts left to wait for
$timeout = 0;
}
if ($timeout > 0) {
- if (my $nfound = select((my $rout=$rbits), undef, undef, $timeout)) {
+ my $nfound;
+ while ( keys %{ $self->{"syn"} } and
+ $nfound = select((my $rout=$rbits), undef, undef, $timeout)) {
# Done waiting for one of the ACKs
if (!sysread($self->{"fork_rd"}, $_, 10)) {
# Socket closed, which means all children are done.
if (!$how || # If there was no error connecting
(!$self->{"tcp_econnrefused"} &&
$how == ECONNREFUSED)) { # "Connection refused" means reachable
+ if ($host && $entry->[0] ne $host) {
+ # A good connection, but not the host we need.
+ # Move it from the "syn" hash to the "good" hash.
+ $self->{"good"}->{$entry->[0]} = $entry;
+ # And wait for the next winner
+ next;
+ }
return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
}
} else {
} else {
die "Empty response from status socket?";
}
- } elsif (defined $nfound) {
+ }
+ if (defined $nfound) {
# Timed out waiting for ACK status
} else {
# Weird error occurred with select()
Net::Ping - check a remote host for reachability
-$Id: Ping.pm,v 1.33 2002/10/19 05:02:43 rob Exp $
+$Id: Ping.pm,v 1.46 2002/12/02 19:17:09 rob Exp $
=head1 SYNOPSIS
projects / p5sagit/p5-mst-13.2.git / blobdiff