Browse files

Apply Andrew Hoying's (blm.gov) patch to return the response packet's

time to live (TTL).  Update t/01_* to use Test::More.  Update t/02_*
to skip all tests (rather than die) if not run with root privilege.
  • Loading branch information...
1 parent f0db3c5 commit 511bde840e3b6c84604aeb3344581acd4cce6f51 @rcaputo committed Aug 3, 2006
Showing with 79 additions and 49 deletions.
  1. +20 −9 Ping.pm
  2. +50 −40 t/01_ping.t
  3. +9 −0 t/02_arbitrary_data.t
View
29 Ping.pm
@@ -12,19 +12,19 @@ use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);
@EXPORT_OK = qw(
REQ_ADDRESS REQ_TIMEOUT REQ_TIME REQ_USER_ARGS RES_ADDRESS
- RES_ROUNDTRIP RES_TIME
+ RES_ROUNDTRIP RES_TIME RES_TTL
);
%EXPORT_TAGS = (
const => [
qw(
REQ_ADDRESS REQ_TIMEOUT REQ_TIME REQ_USER_ARGS RES_ADDRESS
- RES_ROUNDTRIP RES_TIME
+ RES_ROUNDTRIP RES_TIME RES_TTL
)
]
);
use vars qw($VERSION $PKTSIZE);
-$VERSION = '1.12';
+$VERSION = '1.13';
$PKTSIZE = $^O eq 'linux' ? 3_000 : 100;
use Carp qw(croak);
@@ -105,6 +105,7 @@ sub REQ_USER_ARGS () { 3 };
sub RES_ADDRESS () { 0 };
sub RES_ROUNDTRIP () { 1 };
sub RES_TIME () { 2 };
+sub RES_TTL () { 3 };
# "Static" variables which will be shared across multiple instances.
@@ -286,6 +287,7 @@ sub poco_ping_ping {
[ undef, # RES_ADDRESS
undef, # RES_ROUNDTRIP
time(), # RES_TIME
+ undef, # RES_TTL
],
);
_check_for_close($kernel, $heap);
@@ -364,6 +366,7 @@ sub _send_packet {
[ undef, # RES_ADDRESS
undef, # RES_ROUNDTRIP
time(), # RES_TIME
+ undef, # RES_TTL
],
);
_check_for_close($kernel, $heap);
@@ -403,7 +406,7 @@ sub _send_packet {
my $now = time();
my $old_seq = delete $heap->{addr_to_seq}->{$sender}->{$address};
my $old_info = delete $heap->{ping_by_seq}->{$old_seq};
- $old_info->[PBS_POSTBACK]->( undef, undef, $now );
+ $old_info->[PBS_POSTBACK]->( undef, undef, $now, undef );
}
$heap->{addr_to_seq}->{$sender}->{$address} = $seq;
@@ -519,6 +522,9 @@ sub poco_ping_pong {
# Unpack the packet's sender address.
my ($from_port, $from_ip) = unpack_sockaddr_in($from_saddr);
+ # Get the response packet's time to live.
+ my ($from_ttl) = unpack('C', substr($recv_message, 8, 1));
+
# Unpack the packet itself.
my (
$from_type, $from_subcode,
@@ -555,7 +561,7 @@ sub poco_ping_pong {
# time, and map it to a postback.
my $trip_time = $now - $heap->{ping_by_seq}->{$from_seq}->[PBS_REQUEST_TIME];
$heap->{ping_by_seq}->{$from_seq}->[PBS_POSTBACK]->(
- inet_ntoa($from_ip), $trip_time, $now
+ inet_ntoa($from_ip), $trip_time, $now, $from_ttl
);
# It's a single-reply ping. Clean up after it.
@@ -592,7 +598,7 @@ sub poco_ping_default {
# Post a timer tick back to the session. This marks the end of
# the request/response transaction.
my $ping_info = _end_ping($kernel, $heap, $seq);
- $ping_info->[PBS_POSTBACK]->( undef, undef, $now );
+ $ping_info->[PBS_POSTBACK]->( undef, undef, $now, undef );
_send_packet($kernel, $heap);
_check_for_close($kernel, $heap);
@@ -646,7 +652,7 @@ POE::Component::Client::Ping - a non-blocking ICMP ping client
my ($request, $response) = @_[ARG0, ARG1];
my ($req_address, $req_timeout, $req_time) = @$request;
- my ($resp_address, $roundtrip_time, $resp_time) = @$response;
+ my ($resp_address, $roundtrip_time, $resp_time, $resp_ttl) = @$response;
# The response address is defined if this is a response.
if (defined $resp_address) {
@@ -842,7 +848,8 @@ needs back. See the SYNOPSIS for an example.
C<$response> contains information about the ICMP ping response. There
may be multiple responses for a single request.
- my ($response_address, $roundtrip_time, $reply_time) = @$response;
+ my ($response_address, $roundtrip_time, $reply_time, $reply_ttl) =
+ @$response;
=over 2
@@ -871,13 +878,17 @@ transmission to be delayed.
This is the time when the ICMP echo response was received. It is a
real number based on the current system's time() epoch.
+=item C<$reply_ttl>
+
+This is the ttl for the echo response packet we received.
+
=back
If the ":const" tagset is imported the following constants will be
exported:
REQ_ADDRESS, REQ_TIMEOUT, REQ_TIME
-REQ_USER_ARGS, RES_ADDRESS, RES_ROUNDTRIP, RES_TIME
+REQ_USER_ARGS, RES_ADDRESS, RES_ROUNDTRIP, RES_TIME, RES_TTL
=head1 SEE ALSO
View
90 t/01_ping.t
@@ -1,10 +1,9 @@
#!/usr/bin/perl -w
# $Id$
+# vim: filetype=perl
use strict;
-use lib '/home/troc/perl/poe';
-
BEGIN {
$| = 1;
if ($> and ($^O ne 'VMS')) {
@@ -15,8 +14,7 @@ BEGIN {
sub POE::Kernel::ASSERT_DEFAULT () { 1 }
use POE qw(Component::Client::Ping);
-
-print "1..4\n";
+use Test::More tests => 2;
sub PING_TIMEOUT () { 5 }; # seconds between pings
sub PING_COUNT () { 1 }; # ping repetitions
@@ -59,36 +57,48 @@ sub client_send_ping {
$heap->{requests}++;
$heap->{ping_counts}->{$address}++;
- $kernel->post( 'pinger', # Post the request to the 'pinger'.
- 'ping', # Ask it to 'ping' an address.
- 'pong', # Have it post an answer to my 'pong' state.
- $address, # This is the address we want it to ping.
- PING_TIMEOUT # This is the optional time to wait.
- );
+ $kernel->post(
+ 'pinger', # Post the request to the 'pinger'.
+ 'ping', # Ask it to 'ping' an address.
+ 'pong', # Have it post an answer to my 'pong' state.
+ $address, # This is the address we want it to ping.
+ PING_TIMEOUT # This is the optional time to wait.
+ );
}
sub client_got_pong {
my ($kernel, $session, $heap, $request_packet, $response_packet) =
@_[KERNEL, SESSION, HEAP, ARG0, ARG1];
my ($request_address, $request_timeout, $request_time) = @{$request_packet};
- my ($response_address, $roundtrip_time, $reply_time) = @{$response_packet};
+ my (
+ $response_address, $roundtrip_time, $reply_time, $reply_ttl
+ ) = @{$response_packet};
if (defined $response_address) {
- DEBUG and warn
- sprintf( "%d: ping to %-15.15s at %10d. pong from %-15.15s in %6.3f s\n",
- $session->ID,
- $request_address, $request_time,
- $response_address, $roundtrip_time
- );
+ DEBUG and warn(
+ sprintf(
+ "%d: ping to %-15.15s at %10d. " .
+ "pong from %-15.15s in %6.3f s (ttl %3d)\n",
+ $session->ID,
+ $request_address, $request_time,
+ $response_address, $roundtrip_time, $reply_ttl,
+ )
+ );
$heap->{answers}++ if $roundtrip_time <= $request_timeout;
+ $heap->{bad_ttl}++ if (
+ $reply_ttl !~ /^\d+$/ or
+ $reply_ttl < 0 or
+ $reply_ttl > 255
+ );
}
else {
DEBUG and warn( $session->ID, ": time's up for $request_address...\n" );
- $kernel->yield(ping => $request_address)
- if $heap->{ping_counts}->{$request_address} < PING_COUNT;
+ $kernel->yield(ping => $request_address) if (
+ $heap->{ping_counts}->{$request_address} < PING_COUNT
+ );
$heap->{dones}++;
}
@@ -98,38 +108,38 @@ sub client_stop {
my ($session, $heap) = @_[SESSION, HEAP];
DEBUG and warn( $session->ID, ": pinger client session stopped...\n" );
- print 'not ' unless ( $heap->{requests} == $heap->{dones} and
- $heap->{answers}
- );
- print 'ok ', ($session->ID() - 1), "\n";
+ ok(
+ (
+ $heap->{requests} == $heap->{dones}
+ && $heap->{answers}
+ && !$heap->{bad_ttl}
+ ),
+ "pinger client session got responses"
+ );
}
#------------------------------------------------------------------------------
# Create a pinger component.
-POE::Component::Client::Ping->spawn
- ( Alias => 'pinger', # This is the name it'll be known by.
- Timeout => PING_TIMEOUT, # This is how long it waits for echo replies.
- );
+POE::Component::Client::Ping->spawn(
+ Alias => 'pinger', # This is the name it'll be known by.
+ Timeout => PING_TIMEOUT, # This is how long it waits for echo replies.
+);
# Create two sessions that will use the pinger. This tests
# concurrency against the same addresses.
for (my $session_index = 0; $session_index < 2; $session_index++) {
- POE::Session->create
- ( inline_states =>
- { _start => \&client_start,
- _stop => \&client_stop,
- pong => \&client_got_pong,
- ping => \&client_send_ping,
- }
- );
+ POE::Session->create(
+ inline_states => {
+ _start => \&client_start,
+ _stop => \&client_stop,
+ pong => \&client_got_pong,
+ ping => \&client_send_ping,
+ }
+ );
}
-print "ok 1\n";
-
# Run it all until done.
-$poe_kernel->run();
-
-print "ok 4\n";
+POE::Kernel->run();
exit;
View
9 t/02_arbitrary_data.t
@@ -5,6 +5,15 @@
use strict;
use warnings;
+BEGIN {
+ $| = 1;
+ if ($> and ($^O ne 'VMS')) {
+ print "1..0 # skipped: ICMP ping requires root privilege\n";
+ exit 0;
+ }
+};
+
+sub POE::Kernel::ASSERT_DEFAULT () { 1 }
use POE qw(Component::Client::Ping);
use Test::More tests => 1;

0 comments on commit 511bde8

Please sign in to comment.