From: Jarkko Hietaniemi Date: Sat, 19 Apr 2003 12:09:21 +0000 (+0000) Subject: Upgrade to Net::Ping 2.30. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9539e94f61e67aed6c5d58d5997561a4e9f135dd;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Net::Ping 2.30. p4raw-id: //depot/perl@19270 --- diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm index 5541c83..74c5cfc 100644 --- a/lib/Net/Ping.pm +++ b/lib/Net/Ping.pm @@ -5,22 +5,24 @@ require Exporter; use strict; use vars qw(@ISA @EXPORT $VERSION - $def_timeout $def_proto $max_datasize $pingstring $hires $source_verify $syn_forking); + $def_timeout $def_proto $def_factor + $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 EAGAIN WNOHANG ); +use POSIX qw( ECONNREFUSED ECONNRESET EINPROGRESS EAGAIN WNOHANG ); use FileHandle; use Carp; @ISA = qw(Exporter); @EXPORT = qw(pingecho); -$VERSION = "2.29"; +$VERSION = "2.30"; # Constants $def_timeout = 5; # Default timeout to wait for a reply $def_proto = "tcp"; # Default protocol to use for pinging +$def_factor = 1.2; # Default exponential backoff rate. $max_datasize = 1024; # Maximum data bytes in a packet # The data we exchange with the server for the stream protocol $pingstring = "pingschwingping!\n"; @@ -103,7 +105,7 @@ sub new } $self->{"local_addr"} = undef; # Don't bind by default - + $self->{"retrans"} = $def_factor; # Default exponential backoff rate $self->{"econnrefused"} = undef; # Default Connection refused behavior $self->{"seq"} = 0; # For counting packets @@ -233,6 +235,16 @@ sub tcp_service_check service_check(@_); } +# Description: Set exponential backoff for retransmission. +# Should be > 1 to retain exponential properties. +# If set to 0, retransmissions are disabled. + +sub retrans +{ + my $self = shift; + $self->{"retrans"} = shift; +} + # Description: allows the module to use milliseconds as returned by # the Time::HiRes module @@ -387,7 +399,7 @@ sub ping_icmp $finish_time = &time() + $timeout; # Must be done by this time while (!$done && $timeout > 0) # Keep trying if we have time { - $nfound = select($rbits, undef, undef, $timeout); # Wait for packet + $nfound = select((my $rout=$rbits), undef, undef, $timeout); # Wait for packet $timeout = $finish_time - &time(); # Get remaining time if (!defined($nfound)) # Hmm, a strange error { @@ -397,13 +409,17 @@ sub ping_icmp elsif ($nfound) # Got a packet from somewhere { $recv_msg = ""; + $from_pid = -1; + $from_seq = -1; $from_saddr = recv($self->{"fh"}, $recv_msg, 1500, ICMP_FLAGS); ($from_port, $from_ip) = sockaddr_in($from_saddr); ($from_type, $from_subcode) = unpack("C2", substr($recv_msg, 20, 2)); - if ($from_type == ICMP_ECHOREPLY){ - ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 24, 4)); + if ($from_type == ICMP_ECHOREPLY) { + ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 24, 4)) + if length $recv_msg >= 28; } else { - ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 52, 4)); + ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 52, 4)) + if length $recv_msg >= 56; } $self->{"from_ip"} = $from_ip; $self->{"from_type"} = $from_type; @@ -777,6 +793,8 @@ sub ping_udp $ret, # The return value $msg, # Message to be echoed $finish_time, # Time ping should be finished + $flush, # Whether socket needs to be disconnected + $connect, # Whether socket needs to be connected $done, # Set to 1 when we are done pinging $rbits, # Read bits, filehandles for reading $nfound, # Number of ready filehandles found @@ -789,12 +807,36 @@ sub ping_udp $saddr = sockaddr_in($self->{"port_num"}, $ip); $self->{"seq"} = ($self->{"seq"} + 1) % 256; # Increment sequence $msg = chr($self->{"seq"}) . $self->{"data"}; # Add data if any + + if ($self->{"connected"}) { + if ($self->{"connected"} ne $saddr) { + # Still connected to wrong destination. + # Need to flush out the old one. + $flush = 1; + } + } else { + # Not connected yet. + # Need to connect() before send() + $connect = 1; + } + # Have to connect() and send() instead of sendto() # in order to pick up on the ECONNREFUSED setting # from recv() or double send() errno as utilized in # the concept by rdw @ perlmonks. See: # http://perlmonks.thepen.com/42898.html - connect($self->{"fh"}, $saddr); # Tie destination to socket + if ($flush) { + # Need to socket() again to flush the descriptor + # This will disconnect from the old saddr. + socket($self->{"fh"}, PF_INET, SOCK_DGRAM, + $self->{"proto_num"}); + } + # Connect the socket if it isn't already connected + # to the right destination. + if ($flush || $connect) { + connect($self->{"fh"}, $saddr); # Tie destination to socket + $self->{"connected"} = $saddr; + } send($self->{"fh"}, $msg, UDP_FLAGS); # Send it $rbits = ""; @@ -802,12 +844,16 @@ sub ping_udp $ret = 0; # Default to unreachable $done = 0; my $retrans = 0.01; + my $factor = $self->{"retrans"}; $finish_time = &time() + $timeout; # Ping needs to be done by then while (!$done && $timeout > 0) { - $timeout = $retrans if $timeout > $retrans; - $retrans*= 1.2; # Exponential backoff - $nfound = select($rbits, undef, undef, $timeout); # Wait for response + if ($factor > 1) + { + $timeout = $retrans if $timeout > $retrans; + $retrans*= $factor; # Exponential backoff + } + $nfound = select((my $rout=$rbits), undef, undef, $timeout); # Wait for response my $why = $!; $timeout = $finish_time - &time(); # Get remaining time @@ -823,7 +869,8 @@ sub ping_udp if (!$from_saddr) { # For example an unreachable host will make recv() fail. if (!$self->{"econnrefused"} && - $! == ECONNREFUSED) { + ($! == ECONNREFUSED || + $! == ECONNRESET)) { # "Connection refused" means reachable # Good, continue $ret = 1; @@ -1606,6 +1653,6 @@ Copyright (c) 2001, Colin McMillen. All rights reserved. This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. -$Id: Ping.pm,v 1.75 2003/04/12 20:51:17 rob Exp $ +$Id: Ping.pm,v 1.81 2003/04/18 04:16:03 rob Exp $ =cut diff --git a/lib/Net/Ping/Changes b/lib/Net/Ping/Changes index 8e64075..bcfad43 100644 --- a/lib/Net/Ping/Changes +++ b/lib/Net/Ping/Changes @@ -1,6 +1,18 @@ CHANGES ------- +3.30 Apr 18 14:00 2003 + - Fix select() bug for UDP and ICMP protocols + in case packet comes from wrong source or seq. + - Allow UDP ping to different IP addresses + without instantiating a new object. + - Add retrans() method to customize or disable + backoff factor for udp pings. + Thanks Torgny.Hofstedt@sevenlevels.se + - Let ECONNRESET be considered reachable for + UDP pings. Now it works for cygwin. + Spot by jhi@iki.fi (Jarkko Hietaniemi). + 2.29 Apr 12 15:00 2003 - Implement "double send()" concept for udp pings. See: diff --git a/lib/Net/Ping/t/450_service.t b/lib/Net/Ping/t/450_service.t index 97d3caf..c41b84b 100644 --- a/lib/Net/Ping/t/450_service.t +++ b/lib/Net/Ping/t/450_service.t @@ -1,4 +1,4 @@ -# Testing tcp_service_check method using tcp and syn protocols. +# Testing service_check method using tcp and syn protocols. BEGIN { unless (eval "require IO::Socket") { @@ -68,7 +68,7 @@ my $p = new Net::Ping "tcp", 2; ok !!$p; # Disable service checking -$p->tcp_service_check(0); +$p->service_check(0); # Try on the first port $p->{port_num} = $port1; @@ -85,7 +85,7 @@ ok $p -> ping("127.0.0.1"); # Enable service checking -$p->tcp_service_check(1); +$p->service_check(1); # Try on the first port $p->{port_num} = $port1; @@ -109,7 +109,7 @@ $p = new Net::Ping "syn", 2; ok !!$p; # Disable service checking -$p->tcp_service_check(0); +$p->service_check(0); # Try on the first port $p->{port_num} = $port1; @@ -130,7 +130,7 @@ $p = new Net::Ping "syn", 2; ok !!$p; # Disable service checking -$p->tcp_service_check(0); +$p->service_check(0); # Try on the other port $p->{port_num} = $port2; @@ -152,7 +152,7 @@ $p = new Net::Ping "syn", 2; ok !!$p; # Enable service checking -$p->tcp_service_check(1); +$p->service_check(1); # Try on the first port $p->{port_num} = $port1; @@ -174,7 +174,7 @@ $p = new Net::Ping "syn", 2; ok !!$p; # Enable service checking -$p->tcp_service_check(1); +$p->service_check(1); # Try on the other port $p->{port_num} = $port2;