625 lines
19 KiB
Perl
625 lines
19 KiB
Perl
#!/usr/bin/perl
|
|
# -*- Mode: perl; indent-tabs-mode: nil -*-
|
|
# vim:sw=4:ts=8:et:ai:
|
|
#
|
|
# Requires: tinder-defaults.pl
|
|
#
|
|
# Intent: This is becoming a general-purpose tinderbox
|
|
# script, specific uses (mozilla, commercial, etc.) should
|
|
# set variables and then call into this script.
|
|
#
|
|
# Status: In the process of re-arranging things so a commercial
|
|
# version can re-use this script.
|
|
#
|
|
|
|
require 5.003;
|
|
|
|
use Sys::Hostname;
|
|
use strict;
|
|
use POSIX qw(sys_wait_h strftime);
|
|
use Cwd;
|
|
use Config; # for $Config{sig_name} and $Config{sig_num}
|
|
use File::Copy;
|
|
|
|
$::UtilsVersion = '$Revision: 1.2 $ ';
|
|
|
|
package TinderUtils;
|
|
|
|
#
|
|
# Test for Time::HiRes, for ms resolution from gettimeofday().
|
|
#
|
|
require "gettime.pl";
|
|
|
|
#
|
|
# For performance tests, we need the following perl modules installed:
|
|
# (MacOSX, Linux, Win2k):
|
|
#
|
|
# Time::HiRes for higher timer resolution
|
|
# Bundle::LWP for http (to report data to graph)
|
|
#
|
|
# The "CPAN" way of installing this is to start here:
|
|
# % sudo perl -MCPAN -e shell
|
|
# <take defaults..>
|
|
# cpan> install Time::HiRes
|
|
# [...]
|
|
# cpan> install Bundle::LWP
|
|
#
|
|
|
|
my $co_time_str = 0; # Global, let tests send cvs co time to graph server.
|
|
my $co_default_timeout = 300;
|
|
my $graph_time;
|
|
my $LOGFILE;
|
|
|
|
sub Setup {
|
|
InitVars();
|
|
my $args = ParseArgs();
|
|
LoadConfig();
|
|
ApplyArgs($args); # Apply command-line arguments after the config file.
|
|
GetSystemInfo();
|
|
SetupEnv();
|
|
ValidateSettings(); # Perform some basic validation on settings
|
|
}
|
|
|
|
sub OpenLOG {
|
|
my ($logfile) = @_;
|
|
print "Opening $logfile\n";
|
|
open LOGFILE, ">$logfile"
|
|
or die "Cannot open logfile, $logfile: $?\n";
|
|
|
|
# Make the log file flush on every write.
|
|
my $oldfh = select(LOGFILE);
|
|
$| = 1;
|
|
select($oldfh);
|
|
}
|
|
|
|
sub CloseLOG {
|
|
close LOGFILE;
|
|
}
|
|
|
|
sub PrintUsage {
|
|
die <<END_USAGE
|
|
usage: $0 [options]
|
|
Options:
|
|
--example-config Print an example 'tinder-config.pl'.
|
|
--once Do not loop.
|
|
--noreport Do not report status to tinderbox server.
|
|
--nofinalreport Do not report final status, only start status.
|
|
--notest Do not perform testing.
|
|
--testonly Do only testing (no checkout or build).
|
|
--skip-checkout Do not checkout CVS files.
|
|
--skip-build Do not build data.
|
|
--skip-nss Do not perform NSS tests.
|
|
--skip-jss Do not perform JSS tests.
|
|
--notimestamp Do not pull by date.
|
|
--norotate Do not rotate directories.
|
|
--config-cvsup-dir DIR Provide a directory of configuration files
|
|
(mozconfig, etc.) to run a "cvs update" in before
|
|
a build begins.
|
|
--version Print the version number (same as cvs revision).
|
|
--help
|
|
More details:
|
|
To get started, run '$0 --example-config'.
|
|
END_USAGE
|
|
}
|
|
|
|
sub ParseArgs {
|
|
#PrintUsage() if $#ARGV == -1;
|
|
|
|
my $args = {};
|
|
my $arg;
|
|
while ($arg = shift @ARGV) {
|
|
TinderUtils::PrintExampleConfig(), exit if $arg eq '--example-config';
|
|
PrintUsage(), exit if $arg eq '--help' or $arg eq '-h';
|
|
$args->{ReportStatus} = 0, next if $arg eq '--noreport';
|
|
$args->{ReportFinalStatus} = 0, next if $arg eq '--nofinalreport';
|
|
$args->{SkipTesting} = 1, next if $arg eq '--notest';
|
|
$args->{TestOnly} = 1, next if $arg eq '--testonly';
|
|
$args->{BuildOnce} = 1, next if $arg eq '--once';
|
|
$args->{UseTimeStamp} = 0, next if $arg eq '--notimestamp';
|
|
|
|
$args->{SkipCheckout} = 1, next if $arg eq '--skip-checkout';
|
|
$args->{SkipBuild} = 1, next if $arg eq '--skip-build';
|
|
$args->{SkipNSS} = 1, next if $arg eq '--skip-nss';
|
|
$args->{SkipJSS} = 1, next if $arg eq '--skip-jss';
|
|
$args->{NoRotate} = 1, next if $arg eq '--norotate';
|
|
|
|
if ($arg eq '--version' or $arg eq '-v') {
|
|
die "$0: version" . substr($::Version,9,6) . "\n";
|
|
} else {
|
|
warn "Error: Unknown option: $arg\n";
|
|
PrintUsage();
|
|
}
|
|
}
|
|
|
|
return $args;
|
|
}
|
|
|
|
sub ApplyArgs {
|
|
my ($args) = @_;
|
|
|
|
my ($variable_name, $value);
|
|
while (($variable_name, $value) = each %{$args}) {
|
|
eval "\$Settings::$variable_name = \"$value\";";
|
|
}
|
|
}
|
|
|
|
sub ValidateSettings {
|
|
# Lowercase the LogCompression and LogEncoding variables for convenience.
|
|
$Settings::LogCompression = lc $Settings::LogCompression;
|
|
$Settings::LogEncoding = lc $Settings::LogEncoding;
|
|
|
|
# Make sure LogCompression and LogEncoding are set to valid values.
|
|
if ($Settings::LogCompression !~ /^(bzip2|gzip)?$/) {
|
|
warn "Invalid value for LogCompression: $Settings::LogCompression.\n";
|
|
exit;
|
|
}
|
|
if ($Settings::LogEncoding !~ /^(base64|uuencode)?$/) {
|
|
warn "Invalid value for LogEncoding: $Settings::LogEncoding.\n";
|
|
exit;
|
|
}
|
|
|
|
# If LogEncoding is set to 'base64', ensure we have the MIME::Base64
|
|
# module before we go through the entire build.
|
|
if ($Settings::LogEncoding eq 'base64') {
|
|
eval "use MIME::Base64 ();";
|
|
if ($@) {
|
|
warn "LogEncoding set to base64 but the MIME::Base64 module could not be loaded.\n";
|
|
warn "The error message was:\n\n";
|
|
warn $@;
|
|
exit;
|
|
}
|
|
}
|
|
|
|
# If LogCompression is set, make sure LogEncoding is set or else the log
|
|
# will not be transferred properly.
|
|
if ($Settings::LogCompression ne '' && $Settings::LogEncoding eq '') {
|
|
warn "LogEncoding must be set if LogCompression is set.\n";
|
|
exit;
|
|
}
|
|
}
|
|
|
|
my $tinder_defaults = "tinder-defaults.pl";
|
|
|
|
sub InitVars {
|
|
local $_;
|
|
for (@ARGV) {
|
|
# Save DATA section for printing the example.
|
|
return if /^--example-config$/;
|
|
}
|
|
no strict 'vars';
|
|
|
|
open DEFAULTS, $tinder_defaults or print "can't open $tinder_defaults, $?\n";
|
|
|
|
while (<DEFAULTS>) {
|
|
package Settings;
|
|
#warn "config:$_";
|
|
eval;
|
|
}
|
|
|
|
close DEFAULTS;
|
|
}
|
|
|
|
sub PrintExampleConfig {
|
|
local $_;
|
|
print "#- tinder-config.pl - Tinderbox configuration file.\n";
|
|
print "#- Uncomment the variables you need to set.\n";
|
|
print "#- The default values are the same as the commented variables.\n";
|
|
print "\n";
|
|
|
|
open DEFAULTS, $tinder_defaults or print "can't open $tinder_defaults, $!\n";
|
|
while (<DEFAULTS>) {
|
|
s/^\$/\#\$/;
|
|
s/^\@/\#\@/;
|
|
print;
|
|
}
|
|
close DEFAULTS;
|
|
}
|
|
|
|
sub GetSystemInfo {
|
|
$Settings::OS = `uname -s`;
|
|
my $os_ver = `uname -r | sed "s/(.*//"`;
|
|
$Settings::CPU = `uname -m`;
|
|
#$Settings::ObjDir = '';
|
|
my $host = ::hostname();
|
|
$host = $1 if $host =~ /(.*?)\./;
|
|
chomp($Settings::OS, $os_ver, $Settings::CPU, $host);
|
|
|
|
# Redirecting stderr to stdout works on *nix, winnt, but not on win98.
|
|
$Settings::TieStderr = '2>&1';
|
|
|
|
if ($Settings::OS =~ /^CYGWIN_(.*?)-(.*)$/) {
|
|
# the newer cygwin apparently has different output for 'uname'
|
|
# e.g., CYGWIN_98-4.10 == win98SE, and CYGWIN_NT-5.0 == win2k
|
|
$Settings::OS = 'WIN' . $1;
|
|
$os_ver = $2;
|
|
$host =~ tr/A-Z/a-z/;
|
|
}
|
|
if ($Settings::OS =~ /^W/) {
|
|
$host =~ tr/A-Z/a-z/;
|
|
$Settings::TieStderr = "" if $Settings::OS eq 'WIN98';
|
|
}
|
|
|
|
$Settings::DirName = "${Settings::OS}_${os_ver}";
|
|
$Settings::BuildName = "$Settings::OS ${os_ver} $host";
|
|
|
|
$Settings::DistBin = "dist/bin";
|
|
|
|
# Make the build names reflect architecture/OS
|
|
|
|
if ($Settings::OS eq 'Linux') {
|
|
if (($Settings::CPU eq 'i686') or ($Settings::CPU eq 'i586')) {
|
|
$Settings::BuildName = "$Settings::OS $host";
|
|
} else {
|
|
# $Settings::BuildName set above
|
|
}
|
|
}
|
|
|
|
if ($Settings::OS eq 'SunOS') {
|
|
$Settings::OSVerMajor = substr($os_ver, 0, 1);
|
|
if ($Settings::CPU eq 'i86pc') {
|
|
$Settings::BuildName = "$Settings::OS/i386 $os_ver $host";
|
|
} else {
|
|
if ($Settings::OSVerMajor ne '4') {
|
|
$Settings::BuildName = "$Settings::OS/sparc $os_ver $host";
|
|
}
|
|
}
|
|
}
|
|
$Settings::BuildName .= " $Settings::BuildNameExtra";
|
|
}
|
|
|
|
sub LoadConfig {
|
|
my $hostname = ::hostname();
|
|
|
|
if (-r 'tinder-config.pl') {
|
|
no strict 'vars';
|
|
|
|
open CONFIG, 'tinder-config.pl' or
|
|
print "can't open tinder-config.pl, $?\n";
|
|
|
|
local $/ = undef;
|
|
my $config = <CONFIG>;
|
|
close CONFIG;
|
|
|
|
package Settings;
|
|
eval $config;
|
|
} else {
|
|
warn "Error: Need tinderbox config file, tinder-config.pl\n";
|
|
warn " To get started, run the following,\n";
|
|
warn " $0 --example-config > tinder-config.pl\n";
|
|
exit;
|
|
}
|
|
}
|
|
|
|
sub SetupEnv {
|
|
umask 0;
|
|
|
|
# Assume this file lives in the base dir, this will
|
|
# avoid human error from setting this manually.
|
|
$Settings::BaseDir = get_system_cwd();
|
|
|
|
my $topsrcdir = "$Settings::BaseDir/$Settings::DirName/mozilla";
|
|
my $objdir = "$topsrcdir/${Settings::ObjDir}";
|
|
|
|
if (not -e $objdir) {
|
|
# Not checking errors here, because it's too early to set $status and the
|
|
# build will fail anyway; failing loudly is better than failing silently.
|
|
run_shell_command("mkdir -p $objdir");
|
|
}
|
|
|
|
$Settings::TopsrcdirFull = $topsrcdir;
|
|
$Settings::TopsrcdirLast = $topsrcdir . ".last";
|
|
|
|
$Settings::env64 = "USE_64=1; export USE_64; JAVA_HOME=\"$Settings::JavaHome64\"; export JAVA_HOME; PATH=\"$Settings::JavaHome64/bin:$ENV{PATH}\"; LD_LIBRARY_PATH=\"$Settings::JavaHome64/lib\"; export LD_LIBRARY_PATH; ";
|
|
$Settings::env32 = "JAVA_HOME=\"$Settings::JavaHome32\"; export JAVA_HOME; PATH=\"$Settings::JavaHome32/bin:$ENV{PATH}\"; LD_LIBRARY_PATH=\"$Settings::JavaHome32/lib\"; export LD_LIBRARY_PATH; ";
|
|
|
|
if ($Settings::Branch eq 'securityjes5') {
|
|
$Settings::BuildTree = "$Settings::BuildTreeNSSStable\n";
|
|
} else {
|
|
$Settings::BuildTree = "$Settings::BuildTreeNSS\n";
|
|
}
|
|
}
|
|
|
|
sub print_log {
|
|
my ($text) = @_;
|
|
print LOGFILE $text;
|
|
print $text;
|
|
}
|
|
|
|
sub run_shell_command_with_timeout {
|
|
my ($shell_command, $timeout_secs) = @_;
|
|
my $now = localtime();
|
|
local $_;
|
|
|
|
chomp($shell_command);
|
|
print_log "Begin: $now\n";
|
|
print_log "$shell_command\n";
|
|
|
|
my $pid = fork; # Fork off a child process.
|
|
|
|
unless ($pid) { # child
|
|
my $status = 0;
|
|
open CMD, "$shell_command $Settings::TieStderr |" or die "open: $!";
|
|
print_log $_ while <CMD>;
|
|
close CMD or $status = 1;
|
|
exit($status);
|
|
}
|
|
my $result = wait_for_pid($pid, $timeout_secs);
|
|
|
|
$now = localtime();
|
|
print_log "End: $now\n";
|
|
|
|
return $result;
|
|
}
|
|
|
|
sub run_shell_command {
|
|
my ($shell_command) = @_;
|
|
local $_;
|
|
|
|
my $status = 0;
|
|
chomp($shell_command);
|
|
print_log "$shell_command\n";
|
|
open CMD, "$shell_command $Settings::TieStderr |" or die "open: $!";
|
|
print_log $_ while <CMD>;
|
|
close CMD or $status = 1;
|
|
return $status;
|
|
}
|
|
|
|
sub adjust_start_time {
|
|
# Allows the start time to match up with the update times of a mirror.
|
|
my ($start_time) = @_;
|
|
|
|
# Since we are not pulling for cvs-mirror anymore, just round times
|
|
# to 1 minute intervals to make them nice and even.
|
|
my $cycle = 1 * 60; # Updates every 1 minutes.
|
|
my $begin = 0 * 60; # Starts 0 minutes after the hour.
|
|
my $lag = 0 * 60; # Takes 0 minute to update.
|
|
return int(($start_time - $begin - $lag) / $cycle) * $cycle + $begin;
|
|
}
|
|
|
|
sub mail_build_started_message {
|
|
my ($start_time) = @_;
|
|
my $msg_log = "build_start_msg.tmp";
|
|
OpenLOG($msg_log);
|
|
|
|
my $platform = $Settings::OS =~ /^W/ ? 'windows' : 'unix';
|
|
|
|
print_log "\n";
|
|
|
|
print_log "tinderbox: tree: $Settings::BuildTree\n";
|
|
print_log "tinderbox: builddate: $start_time\n";
|
|
print_log "tinderbox: status: building\n";
|
|
print_log "tinderbox: build: $Settings::BuildName\n";
|
|
print_log "tinderbox: errorparser: $platform\n";
|
|
print_log "tinderbox: buildfamily: $platform\n";
|
|
print_log "tinderbox: version: $::Version\n";
|
|
print_log "tinderbox: END\n";
|
|
print_log "\n";
|
|
|
|
CloseLOG();
|
|
|
|
if ($Settings::blat ne "" && $Settings::use_blat) {
|
|
system("$Settings::blat $msg_log -to $Settings::Tinderbox_server");
|
|
} else {
|
|
system "$Settings::mail $Settings::Tinderbox_server "
|
|
." < $msg_log";
|
|
}
|
|
unlink "$msg_log";
|
|
}
|
|
|
|
sub encode_log {
|
|
my $input_file = shift;
|
|
my $output_file = shift;
|
|
my $buf;
|
|
if($Settings::LogEncoding eq 'base64') {
|
|
eval "use MIME::Base64 ();";
|
|
while(read($input_file, $buf, 60*57)) {
|
|
print $output_file &MIME::Base64::encode($buf);
|
|
}
|
|
}
|
|
elsif($Settings::LogEncoding eq 'uuencode') {
|
|
while(read($input_file, $buf, 45)) {
|
|
print $output_file pack("u*", $buf);
|
|
}
|
|
}
|
|
else {
|
|
# Make sendmail happy.
|
|
# Split lines longer than 1000 charaters into 1000 character lines.
|
|
# If any line is a dot on a line by itself, replace it with a blank
|
|
# line. This prevents cases where a <cr>.<cr> occurs in the log file.
|
|
# Sendmail interprets that as the end of the mail, and truncates the
|
|
# log before it gets to Tinderbox. (terry weismann, chris yeh)
|
|
|
|
while (<$input_file>) {
|
|
my $length = length($_);
|
|
my $offset;
|
|
for ($offset = 0; $offset < $length ; $offset += 1000) {
|
|
my $chars_left = $length - $offset;
|
|
my $output_length = $chars_left < 1000 ? $chars_left : 1000;
|
|
my $output = substr $_, $offset, $output_length;
|
|
$output =~ s/^\.$//g;
|
|
$output =~ s/\n//g;
|
|
print $output_file "$output\n";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub mail_build_finished_message {
|
|
my ($start_time, $build_status, $binary_url, $logfile) = @_;
|
|
|
|
# Rewrite LOG to OUTLOG, shortening lines.
|
|
open OUTLOG, ">$logfile.last" or die "Unable to open logfile, $logfile: $!";
|
|
|
|
my $platform = $Settings::OS =~ /^W/ ? 'windows' : 'unix';
|
|
|
|
# Put the status at the top of the log, so the server will not
|
|
# have to search through the entire log to find it.
|
|
print OUTLOG "\n";
|
|
print OUTLOG "tinderbox: tree: $Settings::BuildTree\n";
|
|
print OUTLOG "tinderbox: builddate: $start_time\n";
|
|
print OUTLOG "tinderbox: status: $build_status\n";
|
|
print OUTLOG "tinderbox: binaryurl: $binary_url\n" if ($binary_url ne "");
|
|
print OUTLOG "tinderbox: build: $Settings::BuildName\n";
|
|
print OUTLOG "tinderbox: errorparser: $platform\n";
|
|
print OUTLOG "tinderbox: buildfamily: $platform\n";
|
|
print OUTLOG "tinderbox: version: $::Version\n";
|
|
print OUTLOG "tinderbox: utilsversion: $::UtilsVersion\n";
|
|
print OUTLOG "tinderbox: logcompression: $Settings::LogCompression\n";
|
|
print OUTLOG "tinderbox: logencoding: $Settings::LogEncoding\n";
|
|
print OUTLOG "tinderbox: END\n";
|
|
|
|
if ($Settings::LogCompression eq 'gzip') {
|
|
open GZIPLOG, "gzip -c $logfile |" or die "Couldn't open gzip'd logfile: $!\n";
|
|
encode_log(\*GZIPLOG, \*OUTLOG);
|
|
close GZIPLOG;
|
|
}
|
|
elsif ($Settings::LogCompression eq 'bzip2') {
|
|
open BZ2LOG, "bzip2 -c $logfile |" or die "Couldn't open bzip2'd logfile: $!\n";
|
|
encode_log(\*BZ2LOG, \*OUTLOG);
|
|
close BZ2LOG;
|
|
}
|
|
else {
|
|
open LOG, "$logfile" or die "Couldn't open logfile, $logfile: $!";
|
|
encode_log(\*LOG, \*OUTLOG);
|
|
close LOG;
|
|
}
|
|
close OUTLOG;
|
|
unlink($logfile);
|
|
|
|
# If on Windows, make sure the log mail has unix lineendings, or
|
|
# we'll confuse the log scraper.
|
|
if ($platform eq 'windows') {
|
|
open(IN,"$logfile.last") || die ("$logfile.last: $!\n");
|
|
open(OUT,">$logfile.new") || die ("$logfile.new: $!\n");
|
|
while (<IN>) {
|
|
s/\r\n$/\n/;
|
|
print OUT "$_";
|
|
}
|
|
close(IN);
|
|
close(OUT);
|
|
File::Copy::move("$logfile.new", "$logfile.last") or die("move: $!\n");
|
|
}
|
|
|
|
if ($Settings::ReportStatus and $Settings::ReportFinalStatus) {
|
|
if ($Settings::blat ne "" && $Settings::use_blat) {
|
|
system("$Settings::blat $logfile.last -to $Settings::Tinderbox_server");
|
|
} else {
|
|
system "$Settings::mail $Settings::Tinderbox_server "
|
|
." < $logfile.last";
|
|
}
|
|
}
|
|
}
|
|
|
|
sub PrintEnv {
|
|
local $_;
|
|
|
|
# Print out environment settings.
|
|
my $key;
|
|
foreach $key (sort keys %ENV) {
|
|
print_log "$key=$ENV{$key}\n";
|
|
}
|
|
}
|
|
|
|
sub kill_process {
|
|
my ($target_pid) = @_;
|
|
my $start_time = time;
|
|
|
|
# Try to kill and wait 10 seconds, then try a kill -9
|
|
my $sig;
|
|
for $sig ('TERM', 'KILL') {
|
|
print "kill $sig $target_pid\n";
|
|
kill $sig => $target_pid;
|
|
my $interval_start = time;
|
|
while (time - $interval_start < 10) {
|
|
# the following will work with 'cygwin' perl on win32, but not
|
|
# with 'MSWin32' (ActiveState) perl
|
|
my $pid = waitpid($target_pid, POSIX::WNOHANG());
|
|
if (($pid == $target_pid and POSIX::WIFEXITED($?)) or $pid == -1) {
|
|
my $secs = time - $start_time;
|
|
$secs = $secs == 1 ? '1 second' : "$secs seconds";
|
|
print_log "Process killed. Took $secs to die.\n";
|
|
return;
|
|
}
|
|
sleep 1;
|
|
}
|
|
}
|
|
die "Unable to kill process: $target_pid";
|
|
}
|
|
|
|
BEGIN {
|
|
my %sig_num = ();
|
|
my @sig_name = ();
|
|
|
|
sub signal_name {
|
|
# Find the name of a signal number
|
|
my ($number) = @_;
|
|
|
|
unless (@sig_name) {
|
|
unless($Config::Config{sig_name} && $Config::Config{sig_num}) {
|
|
die "No sigs?";
|
|
} else {
|
|
my @names = split ' ', $Config::Config{sig_name};
|
|
@sig_num{@names} = split ' ', $Config::Config{sig_num};
|
|
foreach (@names) {
|
|
$sig_name[$sig_num{$_}] ||= $_;
|
|
}
|
|
}
|
|
}
|
|
return $sig_name[$number];
|
|
}
|
|
}
|
|
|
|
sub wait_for_pid {
|
|
# Wait for a process to exit or kill it if it takes too long.
|
|
my ($pid, $timeout_secs) = @_;
|
|
my ($exit_value, $signal_num, $dumped_core, $timed_out) = (0,0,0,0);
|
|
my $sig_name;
|
|
my $loop_count;
|
|
|
|
die ("Invalid timeout value passed to wait_for_pid()\n")
|
|
if ($timeout_secs <= 0);
|
|
|
|
eval {
|
|
$loop_count = 0;
|
|
while (++$loop_count < $timeout_secs) {
|
|
my $wait_pid = waitpid($pid, POSIX::WNOHANG());
|
|
# the following will work with 'cygwin' perl on win32, but not
|
|
# with 'MSWin32' (ActiveState) perl
|
|
last if ($wait_pid == $pid and POSIX::WIFEXITED($?)) or $wait_pid == -1;
|
|
sleep 1;
|
|
}
|
|
|
|
$exit_value = $? >> 8;
|
|
$signal_num = $? >> 127;
|
|
$dumped_core = $? & 128;
|
|
if ($loop_count >= $timeout_secs) {
|
|
die "timeout";
|
|
}
|
|
return "done";
|
|
};
|
|
|
|
if ($@) {
|
|
if ($@ =~ /timeout/) {
|
|
kill_process($pid);
|
|
$timed_out = 1;
|
|
} else { # Died for some other reason.
|
|
die; # Propagate the error up.
|
|
}
|
|
}
|
|
$sig_name = $signal_num ? signal_name($signal_num) : '';
|
|
|
|
return { timed_out=>$timed_out,
|
|
exit_value=>$exit_value,
|
|
sig_name=>$sig_name,
|
|
dumped_core=>$dumped_core };
|
|
}
|
|
|
|
sub get_system_cwd {
|
|
my $a = Cwd::getcwd()||`pwd`;
|
|
chomp($a);
|
|
return $a;
|
|
}
|
|
|
|
# Need to end with a true value, (since we're using "require").
|
|
1;
|