Script read text file (one decnet address per line) initialize and clear File::Cache which is used to store parsed dnping output. Then script enter neverending loop. In each loop script have to fork for as many child proccesses as possible. Child proccesses are pinging and storing output values in File::Cache. Parent take care about timeout function. There is also small sub which guess number of proccesses which are needed to finish all pings at time. And this sub can increase or decrease number of procceses to fork.
Problem are that sleep() at line 107 don't work... Script don't sleep here. And I don't know why :-( and when this script is started it do few loops and then is terminated with Segmantation Fault error. Please can anybody help me to tell me where is this ugly bug?
Many thanks Litin
Li Tin O've Weedle#!/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 d +etails # # # # #use strict; use File::Cache; use vars qw( $input_path $log_path $logging $file_lock $timeout $comma +nd $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 addr +ess file, one address per line $log_path = "/home/bilbo/log.txt"; #path to log +file $logging = 1; #logging enab +led (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 num +ber of procceses which can't be exceeded $min_proc = 5; # Minimum num +ber of procceses $def_proc = 10; # Start up nu +mber of procceses $safety = 0.25; # Safety coef +icient 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 un +derstand what you are doing $|++; sub REAPER { my ( $proc, @temp ); $proc = wait; @temp = @{$proc{$proc}}; #if proccess is death r +emove null its procces table value if ( defined $temp[0] ) { $proc{$proc} = [ 0, 0 ]; &count_proc( time - $temp[0] ); } $SIG{CHLD} = \&REAPER; # loathe sys +V: it makes us not only reinstate the handler, but place it after the + wait } $SIG{CHLD} = \&REAPER; # now do som +ething 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 addres +s index to null $start_time = time; #write star +t time &logging( "Start Time is $start_time") ; while($i < @address) { #is there a +ddress to ping? if ( values(%proc) < $def_proc ) { #is maximum + procceses running now? $pid = fork(); #if not for +k if ( not defined $pid ) { die "cannot fork"; } #if fork wa +sn't succesfull warn and die; elsif ( $pid == 0 ) { #I am child &write_output( &do_measure( $address[$i], $i ) ); #Do pin +g and write output exit; #exit child + procces } else { #I am paren +t $proc{$pid} = [ time, $i ]; #create rec +ord for procces $i++; #next addre +ss &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 ther +e is less processes running then maximum } } #all addres +s have to be pinged now while ( values(%proc) ) { #is there s +til 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, ki +ll 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 hav +e 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; } } }
In reply to Segmentation Fault by LiTinOveWeedle
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |