view release on metacpan or  search on metacpan

lib/AsyncPing.pm  view on Meta::CPAN

package AsyncPing;

use 5.006;
use IO::Socket;

=head1 NAME

AsyncPing - ping a huge number of servers in several seconds

=head1 VERSION

Version 2016.1207

=cut

our $VERSION = '2016.1207';


=head1 SYNOPSIS

  use AsyncPing;
  use Data::Dumper;

  my $asyncping=new AsyncPing(timeout=>3,try=>2);
  my @servers=("host1","host2","host3");
  my $result=$asyncping->ping(\@servers);
  print Dumper $result;

=head1 DESCRIPTION

  First of all, I tried some of the Async Ping modules on cpan, none of them really worked when I tried to ping 10,000 servers.
  This AsyncPing is designed to ping a huge number of servers. As I tested, it can send out ICMP request to 25,000 servers per second on a very common server.
  Also I tested if I fork a seperate process handling the recieving work, it can be improved to about 45,000 ping per second.
  The timeout value start to work after this module sends out all the requests. 
  The retry will only work on the failed ones.

  Please notice that ICMP is not TCP connection, there is no guarantee that if you send a request to a server, you'll get a response. So you may want to set the try to 2.
  So if you have a million servers to ping(10% of them are down) and you set the timeout to 3 and retry to 2, I can estimate the time to be about (1M/25k+3)+(100k/25k+3)=50 seconds.

  Please also notice that since ICMP can only be sent by root, if you want to use this library, you'll have to run your program as root.
  If the ping requests are going through firewall, your ping requests could possibly be discarded by firewall, don't blame the library.

  since every process share same network interface and usually there is only 1 network interface on a server, I think it doens't really help if you make it parallel 
  or multi-threaded to increase speed. Just like you don't get much benefit if you make more threads while you have only 1 CPU. But you can test on your own, good luck!
  
=cut

my $ICMP_PING = 'ccnnna*';
my $identifier = 1;
my $sequence   = 2;
my $data       = 'abcdefghijklmn';

sub new{
        my ($class,%arg)=@_;
        my $timeout=3;
        my $try=1;
        my $socket = IO::Socket::INET->new(
                Proto    => 'icmp',
                Type     => SOCK_RAW,
                Blocking => 0
        ) or Carp::croak "Unable to create icmp socket : $!";
        if($arg{timeout}){
                $timeout=$arg{timeout};
        }
        if($arg{try}>0){
                $try=$arg{try};
        }
        return bless {socket=>$socket, timeout=>$timeout, try=>$try}, $class;
}

sub _ping{
        my ($self,$list)=@_;
        my $expected;
        my %resultmap;
        my $revlistmap;
        my @nlist;
        my $got=0;
        my $sent=0;
	my %tmp;
        foreach my $h(@$list){
                chomp($h);
		my $n;
		my $ip;
		eval{
                 $n=inet_aton($h);
                 $ip=inet_ntoa($n);
		};
		if($@){
			$resultmap{$h}=0;
		}
		if($n && $ip){
			$expected->{$ip}=0;
			$revlistmap->{$ip}=$h;
			push @nlist,$n;
			$tmp{$n}=$ip;
		}else{
			$resultmap{$h}=0;
		}
        }
        my $count=@nlist;
        my $start=time();
        my $endtime;
        while(! $endtime || (time()<$endtime+$self->{timeout}) ){
                my $bytesread=$self->{socket}->sysread(my $chunk, 4096, 0);