#!/usr/bin/perl
#################################################
#                                               #
# DnPing Pro 1.00                               #
# Copyright 2001 by Dominik Strnad              #
# litinoveweedle@cmail.cz                       #
# http://www.cgi-wizards.com                    #
#                                               #
# Last modified on February. 6, 2002            #
#                                               #
#################################################
#
# Copyright Notice:
# Copyright 2001 Dominik Strnad, Czech Republic. All Rights Reserved.
# This product is offered under GNU license
# Check GNU.txt or http://www.gnu.org/licenses/licenses.html#GPL for details
#
#
#
#
#use strict;
use File::Cache;
use vars qw( $input_path $log_path $logging $file_lock $timeout $command $parameter $max_proc $min_proc $def_proc
             $safety $act_proc @names @address $run_time $start_time $avg_time $i %proc $pid $sleep $finish_time );

# -------------------------------------------------------------------------
# Config part here

$input_path = "/home/bilbo/address.txt";                 #path to address file, one address per line
$log_path = "/home/bilbo/log.txt";                       #path to log file
$logging = 1;                                            #logging enabled (1) or disabled (0)
$file_lock = 0;                                          #locking log and input files - not supported on Win9X
$timeout = 5;                                            #timeout for each child proccess
$command = "dnping";
$parameter = "-t";
$max_proc = 20;                                          # Maximum number of procceses which can't be exceeded
$min_proc = 5;                                           # Minimum number of procceses
$def_proc = 10;                                          # Start up number of procceses
$safety = 0.25;                                          # Safety coeficient for calculating number of procceses
$run_time = 60;                                          # Time in sec to finish all pings
@names = ( "dec", "ava", "min", "avg", "max" );



# -------------------------------------------------------------------------
# Program body under this line. Do NOTHING change here if you don't understand what you are doing

$|++;
sub REAPER {
  my ( $proc, @temp );
  $proc = wait;
  @temp = @{$proc{$proc}};                     #if proccess is death remove null its procces table value
  if ( defined $temp[0] ) {
    $proc{$proc} = [ 0, 0 ];
    &count_proc( time - $temp[0] );
  }
  $SIG{CHLD} = \&REAPER;                                  # loathe sysV: it makes us not only reinstate the handler, but place it after the wait
}
$SIG{CHLD} = \&REAPER;                                    # now do something that forks...



# -------------------------------------------------------------------------
# Main loop body


@address = &read_file( $input_path, $file_lock );
&logging( "Address file read" );
&initialize_cache;
&logging( "Cache file structure initialized and cleared" );

while ( 1 ) {                                              #do forever
  undef %proc;
  $i = 0;                                                  #set address index to null
  $start_time = time;                                      #write start time
  &logging( "Start Time is $start_time") ;
  while($i < @address) {                                   #is there address to ping?
    if ( values(%proc) < $def_proc ) {                     #is maximum procceses running now?
      $pid = fork();                                       #if not fork
      if ( not defined $pid ) { die "cannot fork"; }       #if fork wasn't succesfull warn and die;
      elsif ( $pid == 0 ) {                                #I am child
        &write_output( &do_measure( $address[$i], $i ) );      #Do ping and write output
        exit;                                              #exit child procces
      }
      else {                                               #I am parent
        $proc{$pid} = [ time, $i ];                        #create record for procces
        $i++;                                              #next address
        &kill_timeout;                                     #terminate any procces running longer then timeout
      }
    }
    else {
      do {                                                 #do
        &kill_timeout;                                     #terminate any procces running longer then timeout
      } while ( values(%proc) >= $def_proc );              #while there is less processes running then maximum
    }
  }
                                                           #all address have to be pinged now
  while ( values(%proc) ) {                                #is there stil procceses running?
    &kill_timeout;                                         #if so kill them
  }

  $finish_time = time - $start_time;
  &logging("Finished in: $finish_time sec, Average time of 1 procces: $avg_time, Last number of procceses: $def_proc");
  $sleep = $run_time - $finish_time;
  if ( $sleep > 0 ) {
    &logging(" Sleeping for $sleep, proc " . values(%proc));                                       #Did I finihed in time?
    sleep $sleep;                                          #Sleep for rest of the time
  }
}


# -------------------------------------------------------------------------
# Check if there is proccess running longer then timeout and if so, kill them
sub kill_timeout {
  my ( $proc, @temp );

  foreach $proc ( keys %proc ) {
    @temp = @{$proc{$proc}};
    if ( $temp[0] == 0 ) {
      delete( $proc{$proc} );
    }
    elsif ( time - $temp[0] > $timeout ) {
      &logging( "Killed $temp[1]: ping to $address[$temp[1]] exceeded timeout" );
      &count_proc( time - $temp[0] );
      &write_output( $temp[1], $address[$temp[1]], 0, 0, 0, 0 );
      kill 15, $proc;
      delete( $proc{$proc} );
    }
  }
}


# -------------------------------------------------------------------------
# Do command and parse its output
sub do_measure {
  my ( $address, $index ) = @_;
  my ( @list );
  my ( @temp ) = ( $index, $address, 0, 0, 0, 0 );

  $command .= " $address $parameter";
  @list = qx/$command/;
  if ( $list[0] =~ /^Sent (\d+) packets, Received (\d+) packets$/ ) {
    $temp[2] = int(100 * ($2/$1));
    if ( $list[1] =~ /\= ([^\/]+)\/([^\/]+)\/([^\s]+) ms$/ ) {
      @temp[3..5] = ( $1, $2, $3 );
    }
    else {
      @temp[3..5] = ( 0, 0, 0 );
    }
  }
  else {
    @temp[2..5] = ( 0, 0, 0, 0 );
  }
  return @temp;
}


# -------------------------------------------------------------------------
# Initialize File::Cache and delete old values
sub initialize_cache {
  my ( $name );
  foreach $name ( @names ) {
    $$name = new File::Cache( { namespace  => $name,
                               expires_in => 3600,
                               filemode   => 0600 } );
    $$name->clear();
  }
}


# -------------------------------------------------------------------------
# write values into File::Cache
sub write_output {
  my ( @temp ) = @_;
  my ( $i, $name );

  $i = 1;
  foreach $name ( @names ) {
    $$name->set($temp[0], $temp[$i]);
    $i++;
  }
}


# -------------------------------------------------------------------------
# read data from file to array
sub read_file {
  my ( $path, $flock ) = @_;
  my ( $line, @file );

  if ( not open(FILE, $path) ) {
    &logging( "Can't open CSV database file. Please check that you have provided the correct path to your CSV database file in config file." );
    die;
  }
  if ( $flock ) { flock(FILE, 1); }
  @file = ();
  while ( $line = <FILE> ) {
    chomp($line);
    push(@file, $line);
  }
  close(FILE);
  return @file;
}


# -------------------------------------------------------------------------
# logging
sub logging {
  my ( $time, $i );
  if ( $logging ) {
    if ( not open(LOG, ">>".$log_path) ) {
      die "Can't open log file";
    }
    $time = localtime(time);
    if ( $file_lock ) { flock(LOG, 2); }
    print LOG "$time  \t @_ \r\n";
    close(LOG);
  }
}


# -------------------------------------------------------------------------
# Count how many procces have to run to finish all pings at time
sub count_proc {
  my ( $temp );
  my ( $time ) = @_;
  $avg_time = sprintf( "%0.3f", ( ($avg_time * $i) + $time ) / ( $i + 1 ) );
  $temp = ( $run_time - ( time - $start_time ) );
  if ( $temp > 0 ) {
    $temp = int( ( ( scalar( @address ) - $i ) * $avg_time * $safety ) / $temp );
    if    ( $temp >= $max_proc ) { $def_proc = $max_proc; }
    elsif ( $temp <= $min_proc ) { $def_proc = $min_proc; }
    else { $def_proc = $temp; }
  }
}