Time-Slice Concurrent Ping

[rob_au]

Category:

Networking Code

Description:

Ping multiple hosts concurrently ... with no threads, no forks, no external binaries.

I have recently found myself in the position where I have needed to check the connection status of a large number of hosts concurrently within a Perl script - While this task could easily be implemented with external binaries such as fping, the requirement to check the connection status of each of these hosts was secondary to other requirements of the script.

While there have been a number of scripts posted on this site previously which implement this task, I found myself faced with a number of other requirements of the implementation environment which complicated this task. The environment in which this script was to run, did not have a threaded Perl interpreter, preventing the use of threads as proposed previously in this thread, and was a heavily loaded environment, countering the usefulness of forking multiple processes to ping hosts in unison. Additionally, while not an absolute, the installation of additional modules which would make this task immensely easier, such as POE and POE::Component::Client::Ping, was discouraged.

The solution to this problem revolved around the building of a script which incorporated a time-slicing execution method through the use of select.

The following script uses a loop centered around a timeout queue as the basis of execution - New ping connection attempts are created up to a maximum number of concurrent connection attempts, configurable by setting the constant, MAX_CONNECTIONS, within the script, and execution will continue as long as there are ping connection attempts pending timeout.

All ICMP echo requests are generated within this script, allowing the unique sequence number of the ICMP ECHO packet to be paired with an IP address. The determination of an ICMP ECHOREPLY packet waiting the be read on the network socket is carried out with select thereby not blocking indefinitely and allowing other code execution to take place.

Updated - As per zengargoyle's comments below.

#!/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 ()  { 5 }
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 = ();


#   This solitary goto provides an efficient means of entering the exe
+cution
#   loop and populating the session table using the existing mechanism
+ for
#   initiating new sessions within the loop.

my ( $length, $sequence, $socket );

goto START;


#   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 @timeout )
{
    START:

    #   If there are hosts still pending connection tests, check to se
+e if any new
    #   pings for testing server connectivity should be started.

    if ( scalar @hosts )
    {
        #   If the number of concurrent ping sessions is less than the
+ maximum number
        #   of sessions allowed for exection, start a new ping session
+ to test server
        #   connectivity.

        while ( scalar keys %ping < MAX_CONNECTIONS )
        {
            #   If no valid ICMP socket exists for communication, crea
+te this 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 p
+acket - In addition
            #   to being used for the packet sequence, this value is a
+lso 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 
+address 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 tim
+e-sharing environment,
            #   this would be set by insertion into a priority queue. 
+ However, it is not
            #   felt that the size of this application warrants the im
+plementation 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
+ epoch 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 = $queue[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_seque
+nce } };
                @timeout = grep
                {
                    $_->[QUEUE_SESSION] ne $reply_sequence
                }
                @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 second
+s\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 $queue[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;

[zengargoyle]

this is so cool. chock full of goodies. but you might want to touchup the hostname to netaddr conversion. i have plenty of local machines with 4-letter names.

[isotope]

Pretty spiffy. Here's a patch to run with warnings and strict, improve efficiency, and to catch replies received while processing other replies (run select in a loop):
Read more... (8 kB)

[rob_au]

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;

[xbb1024]

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?