#! /bin/perl# Driver for CallScript.# To get WNOHANG for waitpid.use POSIX ":sys_wait_h";# Initialize configuration.# Number of seconds to run before no longer starting any jobs.$time_limit = 24 * 60 * 60;     # 24 hours# Number of jobs to attempt to run.$job_limit = 1;# Assign SIP listening ports.$port_base = 10117;$port_increment = 10;# Assign RTP send/receive ports.$rtp_base = 29110;$rtp_increment = 10;# Name of subjob program.$CallScript_program = 'CallScript';# Do an effective 'pause random $randomize_time' at the start of each job.$randomize_time = 0;# Minimum time a subjob must wait to execute, so as to ensure that the parent# process has recorded it before its SIGCHLD comes in.$fork_sleep = 2;# Maximum times to try to select a script that is not already running.$script_select_tries = 1000;# 1 if a script should not be selected for a subjob if another subjob# is already running it.$no_duplicates = 0;# 1 if subjob N should always run script N.$nonrandom = 0;if ($ARGV[0] eq '-d') {    $debug = 1;    shift @ARGV;}# Process the arguments, which are either file names, commands, or# variable assignments..$errors_found = 0;%variables = ();for ($i = 0; $i <= $#ARGV; $i++) {    $arg = $ARGV[$i];    # We distinguish files from commands via a hueristic:  All    # commands start with a verb which does not contain "/" and contain    # a space.  All files can be put into a form which violates this    # rule:  relative file names can have "./" prepended, and absolute    # file names start with "/".  Few file names contain a space.    # Similarly, we distinguish variable assignments by having an "=" before    # a "/" or space.    if ($arg =~ m%^([^/ =]+)=(.*)$%) {        # Argument looks like a variable assignment        $variables{$1} = $2;    } elsif ($arg =~ m%^[^/ ]+ %) {        # Argument looks like a command.        # The user's argument 1 is $ARGV[0].        &process_command($arg, "argument ".($i+1));    } else {        # Read the contents of the control file.        open(C, $arg) ||            die "Error opening file '$arg' for input: $!\n";        while (<C>) {            &process_command($_, "$arg line $.");        }        close C;    }}die "$errors_found errors found in commands.\n" if $errors_found > 0;# Set up the list of scripts depending on whether 'nonrandom' was specified.if (!$nonrandom) {    # Set up "cut points" on a scale of 0 to 1, so that a uniform random number    # in that range will fall into interval $i with the probability that we    # should select script $i to run.    $total_weight = 0;    for ($i = 0; $i <= $#script_weights; $i++) {        $total_weight += $script_weights[$i];    }    die "Total weight is not positive: $total_weight\n" if $total_weight <= 0;    $cut_point = 0;    for ($i = 0; $i < $#script_weights; $i++) {        $cut_point += $script_weights[$i] / $total_weight;        push(@script_cuts, $cut_point);    }    # Set last cut point to exactly 1.    push(@script_cuts, 1.0);    if ($debug) {        print "\@script_files = \n";        for ($i = 0; $i <= $#script_files; $i++) {            print "\t$script_files[$i] ", join(' ', @{$script_args[$i]}),            "\n";        }        print "\@script_weights = ", join(' ', @script_weights), "\n";        print "\@script_cuts = ", join(' ', @script_cuts), "\n";    }} else {    # Duplicate each script according to its weight value.    my(@script_files_old, @script_args_old);    @script_files_old = @script_files;    @script_files = ();    @script_args_old = @script_args;    @script_args = ();    for ($i = 0; $i <= $#script_files_old; $i++) {        push(@script_files, ($script_files_old[$i]) x $script_weights[$i]);        push(@script_args, ($script_args_old[$i]) x $script_weights[$i]);    }    if ($debug) {        print "\@script_files = \n";        for ($i = 0; $i <= $#script_files; $i++) {            print "\t$script_files[$i] ", join(' ', @{$script_args[$i]}),            "\n";        }    }    # Ensure there are enough scripts for the number of jobs.    die "Number of jobs is $job_limit but total script weights is only ",        $#script_files + 1, ".\n"            if $job_limit > $#script_files + 1;}# Print the PID so the user can easily kill us.print STDERR "Process ID is $$\n";print STDERR "Started at ", `date`;# Run the subordinate scripts.$start_time = time;$end_time = $start_time + $time_limit;print "\$start_time = $start_time, \$end_time = $end_time\n" if $debug;# Initialize $jobs_running, which is maintained by &start_job and# &signal_handler_CHLD.$jobs_running = 0;# Initialize the array of which scripts each job is running.for ($i = 0; $i < $job_limit; $i++) {    $job_script_no[$i] = -1;}# Set up interrupt handler for SIGCHLD, which reaps the terminated# script and possibly starts another.$SIG{'CHLD'} = \&signal_handler_CHLD;# Set up interrupt handler for SIGHUP, which shuts down the run gracefully.$SIG{'HUP'} = \&signal_handler_HUP;# Set up interrupt handler for SIGQUIT, which shuts down the run# immediately, since it does not wait for the jobs to finish.$SIG{'QUIT'} = \&signal_handler_QUIT;$restart_jobs = 1;# Start a job for each slot.for ($i = 0; $i < $job_limit; $i++) {    &start_job($i);}# Wait until time is up.until (time >= $end_time) {    select(undef, undef, undef, $end_time - time);    print "time = ", time, ", \$end_time = $end_time, \$jobs_running = $jobs_running, remaining = ",          $end_time - time, "\n" if $debug;}print "Ending run after ", time - $start_time, " seconds at ", `date`;# Stop restarting jobs.$restart_jobs = 0;# Wait until all running jobs have exited.until ($jobs_running <= 0) {    select(undef, undef, undef, 1_000_000);    print "time = ", time, ", \$end_time = $end_time, \$jobs_running = $jobs_running\n" if $debug;}print "Done after ", time - $start_time, " seconds at ", `date`;# Print the summary.print "\n";print "No  Count  Script\n";$total = 0;for ($i = 0; $i <= $#script_counts; $i++) {    printf "%2d  %5d  %s\n", $i, $script_counts[$i], $script_files[$i];    $total += $script_counts[$i];}printf "    %5d  TOTAL\n", $total;exit 0;# Signal handler for SIGCHLD.sub signal_handler_CHLD {    my($child_pid, $i);    # Call wait() to get the PID of the child that died.    # Loop as sometimes the kernel does not deliver exactly as many    # SIGCHLDs as there are child processes.    while (($child_pid = waitpid(-1, WNOHANG)) > 0) {        print "\$child_pid = $child_pid\n" if $debug;        # Decrement count of jobs currently running.        $jobs_running--;        # Remove the job from the table.        $i = &reap_job($child_pid);        # Start a job to replace it if we should.        if ($restart_jobs) {            &start_job($i);        }    }}# Start a job in slot $slot.sub start_job {    my($slot) = @_;    my($r, $script_no, $x, $sip_port, $rtp_port, $random_time, $i, @command);    print "\&start_job($slot)\n" if $debug;    # Choose the randomization time in the parent process, so the    # children don't all choose the same time.    if ($randomize_time > 0) {        $random_time = int(rand() * $randomize_time / 1000);    }    # Determine which script to use.    # Record in $job_script_no[$slot] which script file number.    if (!$nonrandom) {        # Select a script randomly.      find_script: for ($tries = 0; $tries < $script_select_tries; $tries++) {          # Select a random number.          $r = rand();          # Look it up in the list of cut points.          for ($script_no = 0; $script_no <= $#script_weights; $script_no++) {              if ($r <= $script_cuts[$script_no]) {                  # $script_no is the script selected by the random number.