diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Net/Ping.pm | 500 | ||||
| -rw-r--r-- | lib/Net/Ping/t/110_icmp_inst.t | 2 | ||||
| -rw-r--r-- | lib/Net/Ping/t/150_syn_inst.t | 22 | ||||
| -rw-r--r-- | lib/Net/Ping/t/200_ping_tcp.t | 4 | ||||
| -rw-r--r-- | lib/Net/Ping/t/400_ping_syn.t | 94 | ||||
| -rw-r--r-- | lib/Net/Ping/t/450_service.t | 213 |
6 files changed, 804 insertions, 31 deletions
diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm index 815bb75843..1192663238 100644 --- a/lib/Net/Ping.pm +++ b/lib/Net/Ping.pm @@ -1,22 +1,23 @@ package Net::Ping; -# $Id: Ping.pm,v 1.6 2002/06/19 15:23:48 rob Exp $ +# $Id: Ping.pm,v 1.33 2002/10/19 05:02:43 rob Exp $ require 5.002; require Exporter; use strict; use vars qw(@ISA @EXPORT $VERSION - $def_timeout $def_proto $max_datasize $pingstring $hires $source_verify); -use FileHandle; -use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW PF_INET + $def_timeout $def_proto $max_datasize $pingstring $hires $source_verify $syn_forking); +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 FileHandle; use Carp; -use POSIX qw(ECONNREFUSED); @ISA = qw(Exporter); @EXPORT = qw(pingecho); -$VERSION = "2.20"; +$VERSION = "2.23"; # Constants @@ -26,13 +27,19 @@ $max_datasize = 1024; # Maximum data bytes in a packet # The data we exchange with the server for the stream protocol $pingstring = "pingschwingping!\n"; $source_verify = 1; # Default is to verify source endpoint +$syn_forking = 0; if ($^O =~ /Win32/i) { # Hack to avoid this Win32 spewage: # Your vendor has not defined POSIX macro ECONNREFUSED *ECONNREFUSED = sub {10061;}; # "Unknown Error" Special Win32 Response? + $syn_forking = 1; }; +# h2ph "asm/socket.h" +# require "asm/socket.ph"; +sub SO_BINDTODEVICE {25;} + # Description: The pingecho() subroutine is provided for backward # compatibility with the original Net::Ping. It accepts a host # name/IP and an optional timeout in seconds. Create a tcp ping @@ -61,7 +68,8 @@ sub new my ($this, $proto, # Optional protocol to use for pinging $timeout, # Optional timeout in seconds - $data_size # Optional additional bytes of data + $data_size, # Optional additional bytes of data + $device, # Optional device to use ) = @_; my $class = ref($this) || $this; my $self = {}; @@ -72,8 +80,8 @@ sub new bless($self, $class); $proto = $def_proto unless $proto; # Determine the protocol - croak('Protocol for ping must be "icmp", "udp", "tcp", "stream", or "external"') - unless $proto =~ m/^(icmp|udp|tcp|stream|external)$/; + croak('Protocol for ping must be "icmp", "udp", "tcp", "syn", "stream", or "external"') + unless $proto =~ m/^(icmp|udp|tcp|syn|stream|external)$/; $self->{"proto"} = $proto; $timeout = $def_timeout unless $timeout; # Determine the timeout @@ -81,6 +89,8 @@ sub new if $timeout <= 0; $self->{"timeout"} = $timeout; + $self->{"device"} = $device; + $min_datasize = ($proto eq "udp") ? 1 : 0; # Determine data size $data_size = $min_datasize unless defined($data_size) && $proto ne "tcp"; croak("Data for ping must be from $min_datasize to $max_datasize bytes") @@ -96,6 +106,8 @@ sub new $self->{"local_addr"} = undef; # Don't bind by default + $self->{"tcp_econnrefused"} = undef; # Default Connection refused behavior + $self->{"seq"} = 0; # For counting packets if ($self->{"proto"} eq "udp") # Open a socket { @@ -107,16 +119,24 @@ sub new socket($self->{"fh"}, PF_INET, SOCK_DGRAM, $self->{"proto_num"}) || croak("udp socket error - $!"); + if ($self->{'device'}) { + setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'})) + or croak "error binding to device $self->{'device'} $!"; + } } elsif ($self->{"proto"} eq "icmp") { - croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS'); + croak("icmp ping requires root privilege") if ($> and $^O ne 'VMS' and $^O ne 'cygwin'); $self->{"proto_num"} = (getprotobyname('icmp'))[2] || croak("Can't get icmp protocol by name"); $self->{"pid"} = $$ & 0xffff; # Save lower 16 bits of pid $self->{"fh"} = FileHandle->new(); socket($self->{"fh"}, PF_INET, SOCK_RAW, $self->{"proto_num"}) || croak("icmp socket error - $!"); + if ($self->{'device'}) { + setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'})) + or croak "error binding to device $self->{'device'} $!"; + } } elsif ($self->{"proto"} eq "tcp" || $self->{"proto"} eq "stream") { @@ -126,6 +146,28 @@ sub new croak("Can't get tcp echo port by name"); $self->{"fh"} = FileHandle->new(); } + elsif ($self->{"proto"} eq "syn") + { + $self->{"proto_num"} = (getprotobyname('tcp'))[2] || + croak("Can't get tcp protocol by name"); + $self->{"port_num"} = (getservbyname('echo', 'tcp'))[2] || + croak("Can't get tcp echo port by name"); + if ($syn_forking) { + $self->{"fork_rd"} = FileHandle->new(); + $self->{"fork_wr"} = FileHandle->new(); + pipe($self->{"fork_rd"}, $self->{"fork_wr"}); + $self->{"fh"} = FileHandle->new(); + } else { + $self->{"wbits"} = ""; + $self->{"bad"} = {}; + } + $self->{"syn"} = {}; + $self->{"stop_time"} = 0; + } + elsif ($self->{"proto"} eq "external") + { + # No preliminary work needs to be done. + } return($self); } @@ -175,6 +217,17 @@ sub source_verify ($source_verify = ((defined $self) && (ref $self)) ? shift() : $self); } +# Description: Set whether or not the tcp connect +# behavior should enforce remote service availability +# as well as reachability. + +sub tcp_service_check +{ + my $self = shift; + $self->{"tcp_econnrefused"} = 1 unless defined + ($self->{"tcp_econnrefused"} = shift()); +} + # Description: allows the module to use milliseconds as returned by # the Time::HiRes module @@ -231,6 +284,9 @@ sub ping } elsif ($self->{"proto"} eq "stream") { $ret = $self->ping_stream($ip, $timeout); + } + elsif ($self->{"proto"} eq "syn") { + $ret = $self->ping_syn($host, $ip, $ping_time, $ping_time+$timeout); } else { croak("Unknown protocol \"$self->{proto}\" in ping()"); } @@ -385,7 +441,10 @@ sub ping_tcp $@ = ""; $! = 0; $ret = $self -> tcp_connect( $ip, $timeout); - $ret = 1 if $! == ECONNREFUSED; # Connection refused + if (!$self->{"tcp_econnrefused"} && + $! == ECONNREFUSED) { + $ret = 1; # "Connection refused" means reachable + } $self->{"fh"}->close(); return $ret; } @@ -409,6 +468,10 @@ sub tcp_connect !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) { croak("tcp bind error - $!"); } + if ($self->{'device'}) { + setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'})) + or croak("error binding to device $self->{'device'} $!"); + } }; my $do_connect = sub { eval { @@ -451,13 +514,12 @@ sub tcp_connect my $patience = &time() + $timeout; - require POSIX; my ($child); $? = 0; # Wait up to the timeout # And clean off the zombie do { - $child = waitpid($pid, &POSIX::WNOHANG); + $child = waitpid($pid, &WNOHANG()); $! = $? >> 8; $@ = $!; select(undef, undef, undef, 0.1); @@ -481,11 +543,11 @@ sub tcp_connect &{ $do_socket }(); - $SIG{'ALRM'} = sub { die "Timed out!"; }; - alarm($timeout); # Interrupt connect() if we have to + local $SIG{'ALRM'} = sub { die "Timed out!"; }; + my $old = alarm($timeout); # Interrupt connect() if we have to &{ $do_connect }(); - alarm(0); + alarm($old); } return $ret; @@ -667,14 +729,318 @@ sub ping_udp return $ret; } -# Description: Close the connection unless we are using the tcp -# protocol, since it will already be closed. +# Description: Send a TCP SYN packet to host specified. +sub ping_syn +{ + my $self = shift; + my $host = shift; + my $ip = shift; + my $start_time = shift; + my $stop_time = shift; + + if ($syn_forking) { + return $self->ping_syn_fork($host, $ip, $start_time, $stop_time); + } + + my $fh = FileHandle->new(); + my $saddr = sockaddr_in($self->{"port_num"}, $ip); + + # Create TCP socket + if (!socket ($fh, PF_INET, SOCK_STREAM, $self->{"proto_num"})) { + croak("tcp socket error - $!"); + } + + if (defined $self->{"local_addr"} && + !CORE::bind($fh, sockaddr_in(0, $self->{"local_addr"}))) { + croak("tcp bind error - $!"); + } + + if ($self->{'device'}) { + setsockopt($fh, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'})) + or croak("error binding to device $self->{'device'} $!"); + } + + # Set O_NONBLOCK property on filehandle + if (my $flags = fcntl($fh, F_GETFL, 0)) { + fcntl($fh, F_SETFL, $flags | O_NONBLOCK); + } else { + croak("fcntl F_GETFL: $!"); + } + + # Attempt the non-blocking connect + # 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 { + # Error occurred connecting. + # Hopefully the connection is just still in progress. + if ($! != EINPROGRESS) { + # If not, then it really is something bad. + $self->{"bad"}->{$host} = $!; + return undef; + } + } + + my $entry = [ $host, $ip, $fh, $start_time, $stop_time ]; + $self->{"syn"}->{$fh->fileno} = $entry; + if ($self->{"stop_time"} < $stop_time) { + $self->{"stop_time"} = $stop_time; + } + vec($self->{"wbits"}, $fh->fileno, 1) = 1; + + return 1; +} + +sub ping_syn_fork { + my ($self, $host, $ip, $start_time, $stop_time) = @_; + + # Buggy Winsock API doesn't allow nonblocking connect. + # Hence, if our OS is Windows, we need to create a separate + # process to do the blocking connect attempt. + my $pid = fork(); + if (defined $pid) { + if ($pid) { + # Parent process + my $entry = [ $host, $ip, $pid, $start_time, $stop_time ]; + $self->{"syn"}->{$pid} = $entry; + if ($self->{"stop_time"} < $stop_time) { + $self->{"stop_time"} = $stop_time; + } + } else { + # Child process + my $saddr = sockaddr_in($self->{"port_num"}, $ip); + + # Create TCP socket + if (!socket ($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"})) { + croak("tcp socket error - $!"); + } + + if (defined $self->{"local_addr"} && + !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) { + croak("tcp bind error - $!"); + } + + if ($self->{'device'}) { + setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'})) + or croak("error binding to device $self->{'device'} $!"); + } + + $!=0; + # Try to connect (could take a long time) + connect($self->{"fh"}, $saddr); + # Notify parent of connect error status + my $err = $!+0; + my $wrstr = "$$ $err"; + # Force to 10 chars including \n + $wrstr .= " "x(9 - length $wrstr). "\n"; + syswrite($self->{"fork_wr"}, $wrstr); + exit; + } + } else { + # fork() failed? + die "fork: $!"; + } + return 1; +} + +# Description: Wait for TCP ACK from host specified +# from ping_syn above. If no host is specified, wait +# for TCP ACK from any of the hosts in the SYN queue. +sub ack +{ + my $self = shift; + + if ($self->{"proto"} eq "syn") { + if ($syn_forking) { + my @answer = $self->ack_unfork(shift); + return wantarray ? @answer : $answer[0]; + } + my $wbits = ""; + my $stop_time = 0; + if (my $host = shift) { + # Host passed as arg + if (exists $self->{"bad"}->{$host}) { + return (); + } + my $host_fd = undef; + foreach my $fd (keys %{ $self->{"syn"} }) { + my $entry = $self->{"syn"}->{$fd}; + if ($entry->[0] eq $host) { + $host_fd = $fd; + $stop_time = $entry->[4] + || croak("Corrupted SYN entry for [$host]"); + last; + } + } + croak("ack called on [$host] without calling ping first!") + unless defined $host_fd; + vec($wbits, $host_fd, 1) = 1; + } else { + # No $host passed so scan all hosts + # Use the latest stop_time + $stop_time = $self->{"stop_time"}; + # Use all the bits + $wbits = $self->{"wbits"}; + } + + 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++; + } + if (my $entry = $self->{"syn"}->{$fd}) { + if (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]; + } 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) { + # "Connection refused" means reachable + return wantarray ? + ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1])) + : $entry->[0]; + } + # Try another socket... + } + } else { + warn "Corrupted SYN entry: unknown fd [$fd] ready!"; + vec($wbits, $fd, 1) = 0; + vec($self->{"wbits"}, $fd, 1) = 0; + } + } elsif (defined $nfound) { + # Timed out waiting for ACK + foreach my $fd (keys %{ $self->{"syn"} }) { + if (vec($wbits, $fd, 1)) { + my $entry = $self->{"syn"}->{$fd}; + $self->{"bad"}->{$entry->[0]} = "Timed out"; + vec($wbits, $fd, 1) = 0; + vec($self->{"wbits"}, $fd, 1) = 0; + delete $self->{"syn"}->{$fd}; + } + } + } else { + # Weird error occurred with select() + warn("select: $!"); + $self->{"syn"} = {}; + $wbits = ""; + } + } + } + return (); +} + +sub ack_unfork { + my $self = shift; + my $stop_time = $self->{"stop_time"}; + if (my $host = shift) { + # Host passed as arg + warn "Cannot specify host for ack on win32\n"; + } + + 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(); + } else { + # No hosts left to wait for + $timeout = 0; + } + + if ($timeout > 0) { + if (my $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. + return (); + } + my ($pid, $how) = split; + if ($pid) { + # Flush the zombie + waitpid($pid, 0); + if (my $entry = $self->{"syn"}->{$pid}) { + # Connection attempt to remote host is done + delete $self->{"syn"}->{$pid}; + if (!$how || # If there was no error connecting + (!$self->{"tcp_econnrefused"} && + $how == ECONNREFUSED)) { # "Connection refused" means reachable + return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1])); + } + } else { + # Should never happen + die "Unknown ping from pid [$pid]"; + } + } else { + die "Empty response from status socket?"; + } + } elsif (defined $nfound) { + # Timed out waiting for ACK status + } else { + # Weird error occurred with select() + warn("select: $!"); + } + } + if (my @synners = keys %{ $self->{"syn"} }) { + # Kill all the synners + kill 9, @synners; + foreach my $pid (@synners) { + # Wait for the deaths to finish + # Then flush off the zombie + waitpid($pid, 0); + } + } + $self->{"syn"} = {}; + return (); +} + +# Description: Tell why the ack() failed +sub nack { + my $self = shift; + my $host = shift || croak('Usage> nack($failed_ack_host)'); + return $self->{"bad"}->{$host} || undef; +} + +# Description: Close the connection. sub close { my ($self) = @_; - $self->{"fh"}->close() unless $self->{"proto"} eq "tcp"; + if ($self->{"proto"} eq "syn") { + delete $self->{"syn"}; + } elsif ($self->{"proto"} eq "tcp") { + # The connection will already be closed + } else { + $self->{"fh"}->close(); + } } @@ -685,7 +1051,7 @@ __END__ Net::Ping - check a remote host for reachability -$Id: Ping.pm,v 1.6 2002/06/19 15:23:48 rob Exp $ +$Id: Ping.pm,v 1.33 2002/10/19 05:02:43 rob Exp $ =head1 SYNOPSIS @@ -717,6 +1083,16 @@ $Id: Ping.pm,v 1.6 2002/06/19 15:23:48 rob Exp $ } undef($p); + # Like tcp protocol, but with many hosts + $p = Net::Ping->new("syn"); + $p->{port_num} = getservbyname("http", "tcp"); + foreach $host (@host_array) { + $p->ping($host); + } + while (($host,$rtt,$ip) = $p->ack) { + print "HOST: $host [$ip] ACKed in $rtt seconds.\n"; + } + # High precision syntax (requires Time::HiRes) $p = Net::Ping->new(); $p->hires(); @@ -735,10 +1111,10 @@ hosts on a network. A ping object is first created with optional parameters, a variable number of hosts may be pinged multiple times and then the connection is closed. -You may choose one of four different protocols to use for the -ping. The "udp" protocol is the default. Note that a live remote host +You may choose one of six different protocols to use for the +ping. The "tcp" protocol is the default. Note that a live remote host may still fail to be pingable by one or more of these protocols. For -example, www.microsoft.com is generally alive but not pingable. +example, www.microsoft.com is generally alive but not "icmp" pingable. With the "tcp" protocol the ping() method attempts to establish a connection to the remote host's echo port. If the connection is @@ -770,15 +1146,32 @@ utility to perform the ping, and generally produces relatively accurate results. If C<Net::Ping::External> if not installed on your system, specifying the "external" protocol will result in an error. +If the "syn" protocol is specified, the ping() method will only +send a TCP SYN packet to the remote host then immediately return. +If the syn packet was sent successfully, it will return a true value, +otherwise it will return false. NOTE: Unlike the other protocols, +the return value does NOT determine if the remote host is alive or +not since the full TCP three-way handshake may not have completed +yet. The remote host is only considered reachable if it receives +a TCP ACK within the timeout specifed. To begin waiting for the +ACK packets, use the ack() method as explained below. Use the +"syn" protocol instead the "tcp" protocol to determine reachability +of multiple destinations simultaneously by sending parallel TCP +SYN packets. It will not block while testing each remote host. +demo/fping is provided in this distribution to demonstrate the +"syn" protocol as an example. +This protocol does not require any special privileges. + =head2 Functions =over 4 -=item Net::Ping->new([$proto [, $def_timeout [, $bytes]]]); +=item Net::Ping->new([$proto [, $def_timeout [, $bytes [, $device ]]]]); Create a new ping object. All of the parameters are optional. $proto specifies the protocol to use when doing a ping. The current choices -are "tcp", "udp" or "icmp". The default is "udp". +are "tcp", "udp", "icmp", "stream", "syn", or "external". +The default is "tcp". If a default timeout ($def_timeout) in seconds is provided, it is used when a timeout is not given to the ping() method (below). The timeout @@ -791,6 +1184,10 @@ default) number of data bytes is 1 if the protocol is "udp" and 0 otherwise. The maximum number of data bytes that can be specified is 1024. +If $device is given, this device is used to bind the source endpoint +before sending the ping packet. I beleive this only works with +superuser privileges and with udp and icmp protocols at this time. + =item $p->ping($host [, $timeout]); Ping the remote host and wait for a response. $host can be either the @@ -801,7 +1198,8 @@ hostname cannot be found or there is a problem with the IP number, the success flag returned will be undef. Otherwise, the success flag will be 1 if the host is reachable and 0 if it is not. For most practical purposes, undef and 0 and can be treated as the same case. In array -context, the elapsed time is also returned. The elapsed time value will +context, the elapsed time as well as the string form of the ip the +host resolved to are also returned. The elapsed time value will be a float, as retuned by the Time::HiRes::time() function, if hires() has been previously called, otherwise it is returned as an integer. @@ -815,6 +1213,27 @@ This only affects udp and icmp protocol pings. This is enabled by default. +=item $p->tcp_service_check( { 0 | 1 } ); + +Set whether or not the tcp connect behavior should enforce +remote service availability as well as reachability. Normally, +if the remote server reported ECONNREFUSED, it must have been +reachable because of the status packet that it reported. +With this option enabled, the full three-way tcp handshake +must have been established successfully before it will +claim it is reachable. NOTE: It still does nothing more +than connect and disconnect. It does not speak any protocol +(i.e., HTTP or FTP) to ensure the remote server is sane in +any way. The remote server CPU could be grinding to a halt +and unresponsive to any clients connecting, but if the kernel +throws the ACK packet, it is considered alive anyway. To +really determine if the server is responding well would be +application specific and is beyond the scope of Net::Ping. + +This only affects "tcp" and "syn" protocols. + +This is disabled by default. + =item $p->hires( { 0 | 1 } ); Causes this module to use Time::HiRes module, allowing milliseconds @@ -838,7 +1257,7 @@ object. =item $p->open($host); -When you are using the stream protocol, this call pre-opens the +When you are using the "stream" protocol, this call pre-opens the tcp socket. It's only necessary to do this if you want to provide a different timeout when creating the connection, or remove the overhead of establishing the connection from the @@ -847,6 +1266,31 @@ automatically opened the first time C<ping()> is called. This call simply does nothing if you are using any protocol other than stream. +=item $p->ack( [ $host ] ); + +When using the "syn" protocol, use this method to determine +the reachability of the remote host. This method is meant +to be called up to as many times as ping() was called. Each +call returns the host (as passed to ping()) that came back +with the TCP ACK. The order in which the hosts are returned +may not necessarily be the same order in which they were +SYN queued using the ping() method. If the timeout is +reached before the TCP ACK is received, or if the remote +host is not listening on the port attempted, then the TCP +connection will not be established and ack() will return +undef. In list context, the host, the ack time, and the +dotted ip string will be returned instead of just the host. +If the optional $host argument is specified, the return +value will be partaining to that host only. +This call simply does nothing if you are using any protocol +other than syn. + +=item $p->nack( $failed_ack_host ); + +The reason that host $failed_ack_host did not receive a +valid ACK. Useful to find out why when ack( $fail_ack_host ) +returns a false value. + =item $p->close(); Close the network connection for this ping object. The network @@ -905,7 +1349,7 @@ kinds of ICMP packets. The latest source tree is available via cvs: - cvs -z3 -q -d :pserver:anonymous@cvs.roobik.com.:/usr/local/cvsroot/freeware co Net-Ping + cvs -z3 -q -d :pserver:anonymous@cvs.roobik.com.:/usr/local/cvsroot/freeware checkout Net-Ping cd Net-Ping The tarball can be created as follows: diff --git a/lib/Net/Ping/t/110_icmp_inst.t b/lib/Net/Ping/t/110_icmp_inst.t index b0ee1b74f3..cdb7219af9 100644 --- a/lib/Net/Ping/t/110_icmp_inst.t +++ b/lib/Net/Ping/t/110_icmp_inst.t @@ -15,7 +15,7 @@ plan tests => 2; # Everything loaded fine ok 1; -if (($> and $^O ne 'VMS') +if (($> and $^O ne 'VMS' and $^O ne 'cygwin') or ($^O eq 'MSWin32' and Win32::IsWinNT()) or ($^O eq 'VMS' diff --git a/lib/Net/Ping/t/150_syn_inst.t b/lib/Net/Ping/t/150_syn_inst.t new file mode 100644 index 0000000000..df85d460fe --- /dev/null +++ b/lib/Net/Ping/t/150_syn_inst.t @@ -0,0 +1,22 @@ +# Test to make sure object can be instantiated for syn protocol. + +BEGIN { + unless (eval "require Socket") { + print "1..0 \# Skip: no Socket\n"; + exit; + } + unless (getservbyname('echo', 'tcp')) { + print "1..0 \# Skip: no echo port\n"; + exit; + } +} + +use Test; +use Net::Ping; +plan tests => 2; + +# Everything loaded fine +ok 1; + +my $p = new Net::Ping "syn"; +ok !!$p; diff --git a/lib/Net/Ping/t/200_ping_tcp.t b/lib/Net/Ping/t/200_ping_tcp.t index 591c25166f..2ac2236acf 100644 --- a/lib/Net/Ping/t/200_ping_tcp.t +++ b/lib/Net/Ping/t/200_ping_tcp.t @@ -11,7 +11,7 @@ BEGIN { print "1..0 \# Skip: no Socket\n"; exit; } - unless (getservbyname('echo', 'udp')) { + unless (getservbyname('echo', 'tcp')) { print "1..0 \# Skip: no echo port\n"; exit; } @@ -35,7 +35,7 @@ plan tests => 13; # Everything loaded fine ok 1; -my $p = new Net::Ping "tcp"; +my $p = new Net::Ping "tcp",9; # new() worked? ok !!$p; diff --git a/lib/Net/Ping/t/400_ping_syn.t b/lib/Net/Ping/t/400_ping_syn.t new file mode 100644 index 0000000000..3b84af78b1 --- /dev/null +++ b/lib/Net/Ping/t/400_ping_syn.t @@ -0,0 +1,94 @@ +BEGIN { + if ($ENV{PERL_CORE}) { + unless ($ENV{PERL_TEST_Net_Ping}) { + print "1..0 # Skip: network dependent test\n"; + exit; + } + chdir 't' if -d 't'; + @INC = qw(../lib); + } + unless (eval "require Socket") { + print "1..0 \# Skip: no Socket\n"; + exit; + } + unless (getservbyname('echo', 'tcp')) { + print "1..0 \# Skip: no echo port\n"; + exit; + } + unless (getservbyname('http', 'tcp')) { + print "1..0 \# Skip: no http port\n"; + exit; + } +} + +# Remote network test using syn protocol. +# +# NOTE: +# Network connectivity will be required for all tests to pass. +# Firewalls may also cause some tests to fail, so test it +# on a clear network. If you know you do not have a direct +# connection to remote networks, but you still want the tests +# to pass, use the following: +# +# $ PERL_CORE=1 make test + +# Try a few remote servers +my $webs = { + # Hopefully this is never a routeable host + "172.29.249.249" => 0, + + # Hopefully all these web servers are on + "www.geocities.com." => 1, + "www.freeservers.com." => 1, + "yahoo.com." => 1, + "www.yahoo.com." => 1, + "www.about.com." => 1, + "www.microsoft.com." => 1, +}; + +use strict; +use Test; +use Net::Ping; +plan tests => ((keys %{ $webs }) * 2 + 3); + +# Everything loaded fine +ok 1; + +my $p = new Net::Ping "syn", 10; + +# new() worked? +ok !!$p; + +# Change to use the more common web port. +# (Make sure getservbyname works in scalar context.) +ok ($p -> {port_num} = getservbyname("http", "tcp")); + +foreach my $host (keys %{ $webs }) { + # ping() does dns resolution and + # only sends the SYN at this point + if ($p -> ping($host)) { + ok 1; + } else { + print STDERR "CANNOT RESOLVE $host\n"; + ok 0; + } +} + +while (my $host = $p->ack()) { + if ($webs->{$host}) { + ok 1; + } else { + print STDERR "SUPPOSED TO BE DOWN: http://$host/\n"; + ok 0; + } + delete $webs->{$host}; +} + +foreach my $host (keys %{ $webs }) { + if ($webs->{$host}) { + print STDERR "DOWN: http://$host/\n"; + ok 0; + } else { + ok 1; + } +} diff --git a/lib/Net/Ping/t/450_service.t b/lib/Net/Ping/t/450_service.t new file mode 100644 index 0000000000..7d19c76bb5 --- /dev/null +++ b/lib/Net/Ping/t/450_service.t @@ -0,0 +1,213 @@ +# Testing tcp_service_check method using tcp and syn protocols. + +BEGIN { + unless (eval "require IO::Socket") { + print "1..0 \# Skip: no IO::Socket\n"; + exit; + } + unless (getservbyname('echo', 'tcp')) { + print "1..0 \# Skip: no echo port\n"; + exit; + } +} + +use strict; +use Test; +use Net::Ping; +use IO::Socket; + +# I'm lazy so I'll just use IO::Socket +# for the TCP Server stuff instead of doing +# all that direct socket() junk manually. + +plan tests => 37; + +# Everything loaded fine +ok 1; + +"0" =~ /(0)/; # IO::Socket::INET ephemeral buttwag hack + +# Start a tcp listen server on ephemeral port +my $sock1 = new IO::Socket::INET + LocalAddr => "127.1.1.1", + Proto => "tcp", + Listen => 8, + Reuse => 1, + Type => SOCK_STREAM, + ; + +# Make sure it worked. +ok !!$sock1; + +"0" =~ /(0)/; # IO::Socket::INET ephemeral buttwag hack + +# Start listening on another ephemeral port +my $sock2 = new IO::Socket::INET + LocalAddr => "127.2.2.2", + Proto => "tcp", + Listen => 8, + Reuse => 1, + Type => SOCK_STREAM, + ; + +# Make sure it worked too. +ok !!$sock2; + +my $port1 = $sock1->sockport; +ok $port1; + +my $port2 = $sock2->sockport; +ok $port2; + +# Make sure the sockets are listening on different ports. +ok ($port1 != $port2); + +# This is how it should be: +# 127.1.1.1:$port1 - service ON +# 127.2.2.2:$port2 - service ON +# 127.1.1.1:$port2 - service OFF +# 127.2.2.2:$port1 - service OFF + +##### +# First, we test using the "tcp" protocol. +# (2 seconds should be long enough to connect to loopback.) +my $p = new Net::Ping "tcp", 2; + +# new() worked? +ok !!$p; + +# Disable service checking +$p->tcp_service_check(0); + +# Try on the first port +$p->{port_num} = $port1; + +# Make sure IP1 is reachable +ok $p -> ping("127.1.1.1"); + +# Make sure IP2 is reachable +ok $p -> ping("127.2.2.2"); + +# Try on the other port +$p->{port_num} = $port2; + +# Make sure IP1 is reachable +ok $p -> ping("127.1.1.1"); + +# Make sure IP2 is reachable +ok $p -> ping("127.2.2.2"); + + +# Enable service checking +$p->tcp_service_check(1); + +# Try on the first port +$p->{port_num} = $port1; + +# Make sure service on IP1 +ok $p -> ping("127.1.1.1"); + +# Make sure not service on IP2 +ok !$p -> ping("127.2.2.2"); + +# Try on the other port +$p->{port_num} = $port2; + +# Make sure not service on IP1 +ok !$p -> ping("127.1.1.1"); + +# Make sure service on IP2 +ok $p -> ping("127.2.2.2"); + + +##### +# Lastly, we test using the "syn" protocol. +$p = new Net::Ping "syn", 2; + +# new() worked? +ok !!$p; + +# Disable service checking +$p->tcp_service_check(0); + +# Try on the first port +$p->{port_num} = $port1; + +# Send SYN to both IPs +ok $p -> ping("127.1.1.1"); +ok $p -> ping("127.2.2.2"); + +# Both IPs should be reachable +ok $p -> ack(); +ok $p -> ack(); +# No more sockets? +ok !$p -> ack(); + +### +# Get a fresh object +$p = new Net::Ping "syn", 2; + +# new() worked? +ok !!$p; + +# Disable service checking +$p->tcp_service_check(0); + +# Try on the other port +$p->{port_num} = $port2; + +# Send SYN to both IPs +ok $p -> ping("127.1.1.1"); +ok $p -> ping("127.2.2.2"); + +# Both IPs should be reachable +ok $p -> ack(); +ok $p -> ack(); +# No more sockets? +ok !$p -> ack(); + + +### +# Get a fresh object +$p = new Net::Ping "syn", 2; + +# new() worked? +ok !!$p; + +# Enable service checking +$p->tcp_service_check(1); + +# Try on the first port +$p->{port_num} = $port1; + +# Send SYN to both IPs +ok $p -> ping("127.1.1.1"); +ok $p -> ping("127.2.2.2"); + +# Only IP1 should have service +ok "127.1.1.1",$p -> ack(); +# No more good sockets? +ok !$p -> ack(); + + +### +# Get a fresh object +$p = new Net::Ping "syn", 2; + +# new() worked? +ok !!$p; + +# Enable service checking +$p->tcp_service_check(1); + +# Try on the other port +$p->{port_num} = $port2; + +# Send SYN to both IPs +ok $p -> ping("127.1.1.1"); +ok $p -> ping("127.2.2.2"); + +# Only IP2 should have service +ok "127.2.2.2",$p -> ack(); +# No more good sockets? +ok !$p -> ack(); |