callscriptdriver.pl

基于sipfoundy 公司开发的sipx协议API

                  # Check if we should not run duplicates, and if so, check if
                  # this is a duplicate of a script now running.
                  if ($no_duplicates) {
                      for ($i = 0; $i < $job_limit; $i++) {
                          if ($job_script_no[$i] == $script_no) {
                              # $script_no is the script job $i is running, so
                              # try again.
                              next find_script;
                          }
                      }
                  }
                  # We are allowed to run this script.
                  last find_script;
              }
          }
      }
      # Check to see if we exited due to not being able to find a script too
      # many times.
      if ($tries == $script_select_tries) {
          print STDERR "Unable to find a script to execute for job $slot.\n";
          return;
      }
    } else {
        # Select a script deterministically.
        $script_no = $slot;
    }
    # Record that this job is using this script.
    $job_script_no[$slot] = $script_no;

    # Increment the count of jobs running first, to avoid a race condition
    # if it dies between the fork and the time we would increment it.
    $jobs_running++;

    # Fork a subprocess.
    $x = fork();
    if (!defined($x)) {
        print "fork() failed: $!\n";
        # Decrement the count, since we failed to start the job.
        $jobs_running--;
    } elsif ($x == 0) {
        # This is the child process.

        # Select ports to use.
        $sip_port = $port_base + $port_increment * $slot;
        $rtp_port = $rtp_base + $rtp_increment * $slot;

        # Assemble the command to be executed.
        @command = ($CallScript_program, '-p', $sip_port, '-r', $rtp_port,
                    '-l', "Job $slot: ",
                    @{$script_args[$job_script_no[$slot]]});
        # Print the command we will execute now, so the print isn't affected
        # by output redirection.
        print "exec(", join(' ', map { "'$_'" } @command), ")\n"
            if $debug;

        # Sleep the appropriate time.
        sleep $fork_sleep;
        if ($randomize_time > 0) {
            print "Job $slot: pause random $randomize_time (pause ",
                  $random_time*1000, ")*\n";
            sleep $random_time;
        }

        # Set up stdin and stdout.
        open(STDOUT, ">/dev/null") ||
            die "Error opening /dev/null for output: $!\n";
        open(STDIN, "<$script_files[$job_script_no[$slot]]") ||
            die "Error opening '$script_files[$job_script_no[$slot]]' for input: $!\n";
        # Route stderr from subjobs to stderr here (as opposed to routing it
        # to stdout as we used to), so errors from the subjobs are easy to
        # see.

        exec(@command);
        die "Error from exec(" . join(' ', map { "'$_'" } @command) .
            "): $!\n";
    }
    # This is the parent process.
    $subjob_pid[$slot] = $x;
    print "Job $slot: Starting '$script_files[$job_script_no[$slot]]'\n";
    $script_counts[$script_no]++;
    print "\$subjob_pid[$slot] = $x\n" if $debug;
}

# Remove from the table the subjob with the pid $pid.
# Return the slot number.
sub reap_job {
    my($pid) = @_;
    my($i);
    print "\&reap_job($pid)\n" if $debug;

    for ($i = 0; $i <= $job_limit; $i++) {
        if ($pid == $subjob_pid[$i]) {
            print "Job $i: Ending\n";
            $subjob_pid[$i] = 0;
            $job_script_no[$i] = -1;
            print "\$subjob_pid[$i] = 0\n" if $debug;
            print "return $i\n" if $debug;
            return $i;
        }
    }
    die "Cannot find slot of subjob PID $pid.\n";
}

# Set up interrupt handler for SIGHUP, which shuts down the run gracefully.
sub signal_handler_HUP {
    # Set the ending time to now, so the main loop exits.
    print "HUP received.\n";
    $end_time = time;
}

# Set up interrupt handler for SIGQUIT, which shuts down the run
# immediately, since it does not wait for the jobs to finish.
sub signal_handler_QUIT {
    my($i, $pid);

    print "QUIT received.\n";
    # Set the ending time to now, so the main loop exits.
    $end_time = time;
    # Kill all the jobs.
    for ($i = 0; $i <= $job_limit; $i++) {
        if ($subjob_pid[$i] != 0) {
            print "Job $i: Killing\n";
            print "kill -KILL $subjob_pid[$i]\n" if $debug;
            kill('KILL', $subjob_pid[$i]);
        }
    }
    # Set the number of jobs to 0, so the finishing-up loop exits.
    $jobs_running = 0;
}

# Process a single command line.
# $command is the command line/string.
# $id is the identification for error messages.  E.g., "...file... line ..." or
# "argument ...".
sub process_command {
    my($command, $id) = @_;
    my(@tokens, $weight, $file, @args);

    # Substitute for variables.
    chomp $command;
    $command =~
        s/\${([^}]*)}/defined($variables{$1}) ?
                   $variables{$1} :
                   die "No value given for variable '$1' in $id\n"/ge;
    print "\$command = '$command'\n" if $debug;

    # Ignore blank lines.
    return if $command =~ m/^\s*$/;
    # Ignore comments.
    return if $command =~ m/^\s*#/;
    # Get the words of the command.
    @tokens = split(' ', $command);
    print "\@tokens = '", join("' '", @tokens), "'\n" if $debug;
    if ($tokens[0] eq 'time') {
        # time NNN
        $time_limit = $tokens[1];
        # Check its syntax.
        unless ($time_limit =~ /^(\d+)([smhd]?)$/) {
            print STDERR "Invalid time value '$time_limit' in $id\n";
            $errors_found++;
            return;
        }
        # Convert the digit string into a number.
        $time_limit = $1 + 0;
        # Multiply by the right factor.
        # Do nothing for 's' and ''.
        if ($2 eq 'm') {
            $time_limit *= 60;
        } elsif ($2 eq 'h') {
            $time_limit *= 60 * 60;
        } elsif ($2 eq 'd') {
            $time_limit *= 24 * 60 * 60;
        }
        print "\$time_limit = $time_limit\n" if $debug;
    } elsif ($tokens[0] eq 'jobs') {
        # jobs NNN
        $job_limit = $tokens[1] + 0;
        unless ($job_limit > 0) {
            print STDERR "Invalid job limit '$tokens[1]' in $id\n";
            $errors_found++;
            return;
        }
        print "\$job_limit = $job_limit\n" if $debug;
    } elsif ($tokens[0] eq 'program') {
        # program NAME
        $CallScript_program = $tokens[1];
        unless ($CallScript_program ne '' && -x $CallScript_program) {
            print STDERR "Empty or non-executable program name '$CallScript_program' in $id\n";
            $errors_found++;
            return;
        }
        print "\$job_limit = $job_limit\n" if $debug;
    } elsif ($tokens[0] eq 'script') {
        # script NNN FFF
        $weight = $tokens[1] + 0;
        $file = $tokens[2];
        # The following slice appears to work even if $#tokens == 2.
        @args = @tokens[3..$#tokens];
        unless ($weight > 0) {
            print STDERR "Invalid weight '$tokens[1]' in $id\n";
            $errors_found++;
            return;
        }
        unless ($file ne '') {
            print STDERR "Must specify script file in $id\n";
            $errors_found++;
            return;
        }
        unless (-r $file) {
            print STDERR "Cannot read script file '$file' in $id\n";
            $errors_found++;
            return;
        }
        push(@script_weights, $weight);
        push(@script_files, $file);
        push(@script_args, \@args);
        push(@script_counts, 0);
    } elsif ($tokens[0] eq 'randomize') {
        # randomize NNN
        $randomize_time = $tokens[1] + 0;
        unless ($randomize_time >= 0) {
            print STDERR "Invalid randomization time '$tokens[1]' in $id\n";
            $errors_found++;
            return;
        }
        print "\$randomize_time = $randomize_time\n" if $debug;
    } elsif ($tokens[0] eq 'noduplicates') {
        # noduplicates
        $no_duplicates = 1;
        print "\$no_duplicates = $no_duplicates\n" if $debug;
    } elsif ($tokens[0] eq 'nonrandom') {
        # nonrandom
        $nonrandom = 1;
        print "\$nonrandom = $nonrandom\n" if $debug;
    } else {
        printf STDERR "Unrecognized command '$tokens[0]' in $id\n";
        $errors_found++;
        return;
    }
}