Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re: Time-Slice Concurrent Ping

by rob_au (Abbot)
on Nov 26, 2003 at 23:26 UTC ( #310414=note: print w/ replies, xml ) Need Help??


in reply to Time-Slice Concurrent Ping

The following is an updated version of this code which fixes a couple of small bugs in the code posted in the parent node and incorporates portions of the patch offered by isotope - One element of this patch which this code does not incorporate is the shift of the array @timeout into a hash-based structure. This is because this portion of the patch from isotope, although increasing the accuracy of timing associated with ping results, increases the number of empty processing cycles iterated through by the script, thereby impacting upon the load of the host machine. If accuracy is important for the timing of ping results, replace the line:

select(my $read_out = $read_in, undef, undef, $timeout);

With the following:

select(my $read_out = $read_in, undef, undef, MINIMUM_TIMEOUT);

The complete code follows:

#!/usr/bin/perl BEGIN { # This code is from the POE::Loop::Select module and is a work-a +round for a # bug on Linux platforms relating to select calls with zero-seco +nd timeouts. # If select is called with a zero-second timeout and a signal ma +nages # interrupt, the select function is restarted and will block ind +efinitely. my $timeout = ($^O eq 'linux') ? 0.001 : 0; eval "sub MINIMUM_TIMEOUT () { $timeout }"; # The Time::HiRes module is loaded if available as this provides + greater # resolution in time-slice calculations. eval "use Time::HiRes qw( time )"; } use Carp; use Socket; use Symbol; use strict; use vars qw( $VERSION ); $VERSION = sprintf("%d.%02d", q$Revision: 1.0 $ =~ /(\d+)\.(\d+)/); # The following subroutines return ICMP constants required for manua +lly # constructing the ICMP echo packet. sub ICMP_ECHO () { 8 } sub ICMP_ECHOREPLY () { 0 } sub ICMP_FLAGS () { 0 } sub ICMP_PORT () { 0 } sub ICMP_STRUCT () { 'C2S3A56' } sub ICMP_SUBCODE () { 0 } sub QUEUE_EPOCH () { 0 } sub QUEUE_SESSION () { 1 } sub MAX_CONNECTIONS () { 128 } sub TIMEOUT () { 2 } my @hosts = ( '192.168.0.1', '192.168.0.100', 'www.perlmonks.org' ); # Initialise variables utilised by the time-slice execution loop mec +hanism my @timeout = (); my %ping = (); my ($length, $sequence, $socket); # The main loop for execution centers around the list of scheduled e +vents # within the execution queue - As long as the execution queue is pop +ulated, # this loop will continue execution. while (scalar @hosts or scalar @timeout) { # If the number of concurrent ping sessions is less than the max +imum number # of sessions allowed for exection and there are hosts still pen +ding # connection tests, start a new ping session to test server conn +ectivity. while (scalar @hosts and scalar keys %ping < MAX_CONNECTIONS) { # If no valid ICMP socket exists for communication, create t +his socket. unless (defined $socket) { my $protocol; $protocol = (getprotobyname('icmp'))[2] or croak('Cannot get ICMP protocol number by name - ', $! +); $socket = Symbol::gensym; socket($socket, PF_INET, SOCK_RAW, $protocol) or croak('Cannot create IMCP socket - ', $!); } # Determine an unused sequence number for the new ICMP packe +t - In addition # to being used for the packet sequence, this value is also +used as the # unique name for the ping session. while (1) { $sequence = ($sequence + 1) & 0xFFFF; last unless exists $ping{$sequence}; } # Build the message packet without a checksum my $checksum = 0; my $msg = pack( ICMP_STRUCT, ICMP_ECHO, ICMP_SUBCODE, $checksum, $$ & 0xFFFF, $sequence, '0' x 56 ); # Calculate the message checksum and rebuild the packet with + the newly # calculated message checksum. my $short = int(length($msg) / 2); $checksum += $_ for unpack "S$short", $msg; $checksum += ord(substr($msg, -1)) if length($msg) % 2; $checksum = ($checksum >> 16) + ($checksum & 0xFFFF); $checksum = ~(($checksum >> 16) + $checksum) & 0xFFFF; $msg = pack( ICMP_STRUCT, ICMP_ECHO, ICMP_SUBCODE, $checksum, $$ & 0xFFFF, $sequence, '0' x 56 ); $length = length $msg; # Now that the ICMP echo packet has been built, grab an addr +ess from the list # of hosts of which test connectivity. my $address = shift @hosts; my $netaddr = inet_aton($address); next unless defined $netaddr; my $sockaddr = pack_sockaddr_in(ICMP_PORT, $netaddr); send($socket, $msg, ICMP_FLAGS, $sockaddr) or croak('Error sending ICMP packet - ', $!); # Set a delay for the timeout period - Within a real time-sh +aring environment, # this would be set by insertion into a priority queue. How +ever, it is not # felt that the size of this application warrants the implem +entation of such # a queue where a basic queue with all events are added in a + time sequential # fashion would suffice. push @timeout, [time + TIMEOUT, $sequence]; # Create a new ping session entry in the session hash - This + session entry # contains the host name being pinged and the time since epo +ch at which the # ping was sent. $ping{$sequence} = [$address, time]; } # Perform a select on the socket handle for the echo reply retur +ned by the # remote host - This has the added effect of performing a sleep +type function # until the next delay event is due, minimising wasted cycles. my $timeout = $timeout[0]->[QUEUE_EPOCH] - time; $timeout = MINIMUM_TIMEOUT if $timeout < MINIMUM_TIMEOUT; vec(my $read_in = '', fileno($socket), 1) = 1; select(my $read_out = $read_in, undef, undef, $timeout); if (vec($read_out, fileno($socket), 1 )) { my $now = time; # Data is waiting to be read on the socket - Read this data, + decode the # sequence number and process the echo reply. recv($socket, my $data = '', 1500, ICMP_FLAGS); my @reply = unpack(ICMP_STRUCT, substr($data, -$length)); my ($type, $reply_sequence) = @reply[0, 4]; if ($type == ICMP_ECHOREPLY) { # If the returned message is indeed an echo reply and th +e associated sequence # is one sent previously by this application, it is take +n that the host is # indeed reachable and as such, can be incorporated into + the fetchmail # configuration generated. if (exists $ping{$reply_sequence}) { # The next step is to remove the ping session so tha +t further sessions can be # created with the next iteration through this loop +and remove the pending # timeout event in the event queue. my ($address, $time) = @{delete $ping{$reply_sequence} +}; @timeout = grep { $_->[QUEUE_SESSION] ne $reply_sequen +ce } @timeout; # The ping attempt was successful and should now be +actioned - Remember # however, that this execution is taking place withi +n a time-slice sharing # environment and as such care should be taken to av +oid any long or blocking # processes. print STDOUT sprintf("Reply time for %s - %.3f seconds +\n", $address, $now - $time); } } } # The following test removes any sessions which have passed thei +r expiry # timeout and thus should be treated as failed connection checks +. my $now = time; while (scalar @timeout and $timeout[0]->[QUEUE_EPOCH] < $now) { my $item = shift @timeout; my ($address) = @{delete $ping{$item->[QUEUE_SESSION]}}; # The ping attempt did not return any echo reply and as such + considered to # have failed. print STDOUT sprintf("No reply for %s\n", $address); } } exit 0;

 

perl -le "print+unpack'N',pack'B32','00000000000000000000001010010100'"


Comment on Re: Time-Slice Concurrent Ping
Select or Download Code
Re^2: Time-Slice Concurrent Ping
by xbb1024 (Initiate) on May 20, 2011 at 05:00 UTC
    Hi, I'm new to socket level programming. How would I modify this script to send SNMP requests to poll multiple hosts? Is it all in the construction of the packet?

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://310414]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (2)
As of 2014-07-10 05:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (199 votes), past polls