mirror of
https://github.com/curl/curl.git
synced 2024-12-15 06:40:09 +08:00
7d62f0d9b8
Logs are written by several servers and all of them must be finished writing before the test results can be determined. This means each server must have its own lock file rather than sharing a single one, which is how it was done up to now. Previously, the first server to complete a test would clear the lock before the other server was done, which caused flaky tests. Lock files are now all found in their own directory, so counting locks equals counting the files in that directory. The result is that the proxy logs are now reliably written which actually changes the expected output for two tests. Fixes #11231 Closes #11259
1375 lines
42 KiB
Perl
1375 lines
42 KiB
Perl
#***************************************************************************
|
|
# _ _ ____ _
|
|
# Project ___| | | | _ \| |
|
|
# / __| | | | |_) | |
|
|
# | (__| |_| | _ <| |___
|
|
# \___|\___/|_| \_\_____|
|
|
#
|
|
# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
|
|
#
|
|
# This software is licensed as described in the file COPYING, which
|
|
# you should have received as part of this distribution. The terms
|
|
# are also available at https://curl.se/docs/copyright.html.
|
|
#
|
|
# You may opt to use, copy, modify, merge, publish, distribute and/or sell
|
|
# copies of the Software, and permit persons to whom the Software is
|
|
# furnished to do so, under the terms of the COPYING file.
|
|
#
|
|
# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
|
|
# KIND, either express or implied.
|
|
#
|
|
# SPDX-License-Identifier: curl
|
|
#
|
|
###########################################################################
|
|
|
|
# This module contains entry points to run a single test. runner_init
|
|
# determines whether they will run in a separate process or in the process of
|
|
# the caller. The relevant interface is asynchronous so it will work in either
|
|
# case. Program arguments are marshalled and then written to the end of a pipe
|
|
# (in controlleripccall) which is later read from and the arguments
|
|
# unmarshalled (in ipcrecv) before the desired function is called normally.
|
|
# The function return values are then marshalled and written into another pipe
|
|
# (again in ipcrecv) when is later read from and unmarshalled (in runnerar)
|
|
# before being returned to the caller.
|
|
|
|
package runner;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use 5.006;
|
|
|
|
BEGIN {
|
|
use base qw(Exporter);
|
|
|
|
our @EXPORT = qw(
|
|
checktestcmd
|
|
prepro
|
|
readtestkeywords
|
|
restore_test_env
|
|
runner_init
|
|
runnerac_clearlocks
|
|
runnerac_shutdown
|
|
runnerac_stopservers
|
|
runnerac_test_preprocess
|
|
runnerac_test_run
|
|
runnerar
|
|
runnerar_ready
|
|
stderrfilename
|
|
stdoutfilename
|
|
$DBGCURL
|
|
$gdb
|
|
$gdbthis
|
|
$gdbxwin
|
|
$shallow
|
|
$tortalloc
|
|
$valgrind_logfile
|
|
$valgrind_tool
|
|
);
|
|
|
|
# these are for debugging only
|
|
our @EXPORT_OK = qw(
|
|
singletest_preprocess
|
|
);
|
|
}
|
|
|
|
use B qw(
|
|
svref_2object
|
|
);
|
|
use Storable qw(
|
|
freeze
|
|
thaw
|
|
);
|
|
|
|
use pathhelp qw(
|
|
exe_ext
|
|
);
|
|
use processhelp qw(
|
|
portable_sleep
|
|
);
|
|
use servers qw(
|
|
checkcmd
|
|
clearlocks
|
|
initserverconfig
|
|
serverfortest
|
|
stopserver
|
|
stopservers
|
|
subvariables
|
|
);
|
|
use getpart;
|
|
use globalconfig;
|
|
use testutil qw(
|
|
clearlogs
|
|
logmsg
|
|
runclient
|
|
shell_quote
|
|
subbase64
|
|
subnewlines
|
|
);
|
|
|
|
|
|
#######################################################################
|
|
# Global variables set elsewhere but used only by this package
|
|
# These may only be set *before* runner_init is called
|
|
our $DBGCURL=$CURL; #"../src/.libs/curl"; # alternative for debugging
|
|
our $valgrind_logfile="--log-file"; # the option name for valgrind >=3
|
|
our $valgrind_tool="--tool=memcheck";
|
|
our $gdb = checktestcmd("gdb");
|
|
our $gdbthis; # run test case with gdb debugger
|
|
our $gdbxwin; # use windowed gdb when using gdb
|
|
|
|
# torture test variables
|
|
our $shallow;
|
|
our $tortalloc;
|
|
|
|
# local variables
|
|
my %oldenv; # environment variables before test is started
|
|
my $UNITDIR="./unit";
|
|
my $CURLLOG="$LOGDIR/commands.log"; # all command lines run
|
|
my $defserverlogslocktimeout = 2; # timeout to await server logs lock removal
|
|
my $defpostcommanddelay = 0; # delay between command and postcheck sections
|
|
my $multiprocess; # nonzero with a separate test runner process
|
|
|
|
# pipes
|
|
my $runnerr; # pipe that runner reads from
|
|
my $runnerw; # pipe that runner writes to
|
|
|
|
# per-runner variables, indexed by runner ID; these are used by controller only
|
|
my %controllerr; # pipe that controller reads from
|
|
my %controllerw; # pipe that controller writes to
|
|
|
|
# redirected stdout/stderr to these files
|
|
sub stdoutfilename {
|
|
my ($logdir, $testnum)=@_;
|
|
return "$logdir/stdout$testnum";
|
|
}
|
|
|
|
sub stderrfilename {
|
|
my ($logdir, $testnum)=@_;
|
|
return "$logdir/stderr$testnum";
|
|
}
|
|
|
|
#######################################################################
|
|
# Initialize the runner and prepare it to run tests
|
|
# The runner ID returned by this function must be passed into the other
|
|
# runnerac_* functions
|
|
# Called by controller
|
|
sub runner_init {
|
|
my ($logdir, $jobs)=@_;
|
|
|
|
$multiprocess = !!$jobs;
|
|
|
|
# enable memory debugging if curl is compiled with it
|
|
$ENV{'CURL_MEMDEBUG'} = "$logdir/$MEMDUMP";
|
|
$ENV{'CURL_ENTROPY'}="12345678";
|
|
$ENV{'CURL_FORCETIME'}=1; # for debug NTLM magic
|
|
$ENV{'CURL_GLOBAL_INIT'}=1; # debug curl_global_init/cleanup use
|
|
$ENV{'HOME'}=$pwd;
|
|
$ENV{'CURL_HOME'}=$ENV{'HOME'};
|
|
$ENV{'XDG_CONFIG_HOME'}=$ENV{'HOME'};
|
|
$ENV{'COLUMNS'}=79; # screen width!
|
|
|
|
# Incorporate the $logdir into the random seed and re-seed the PRNG.
|
|
# This gives each runner a unique yet consistent seed which provides
|
|
# more unique port number selection in each runner, yet is deterministic
|
|
# across runs.
|
|
$randseed += unpack('%16C*', $logdir);
|
|
srand $randseed;
|
|
|
|
# create pipes for communication with runner
|
|
my ($thisrunnerr, $thiscontrollerw, $thiscontrollerr, $thisrunnerw);
|
|
pipe $thisrunnerr, $thiscontrollerw;
|
|
pipe $thiscontrollerr, $thisrunnerw;
|
|
|
|
my $thisrunnerid;
|
|
if($multiprocess) {
|
|
# Create a separate process in multiprocess mode
|
|
my $child = fork();
|
|
if(0 == $child) {
|
|
# TODO: set up a better signal handler
|
|
$SIG{INT} = 'IGNORE';
|
|
$SIG{TERM} = 'IGNORE';
|
|
|
|
$thisrunnerid = $$;
|
|
print "Runner $thisrunnerid starting\n" if($verbose);
|
|
|
|
# Here we are the child (runner).
|
|
close($thiscontrollerw);
|
|
close($thiscontrollerr);
|
|
$runnerr = $thisrunnerr;
|
|
$runnerw = $thisrunnerw;
|
|
|
|
# Set this directory as ours
|
|
$LOGDIR = $logdir;
|
|
mkdir("$LOGDIR/$PIDDIR", 0777);
|
|
mkdir("$LOGDIR/$LOCKDIR", 0777);
|
|
|
|
# Initialize various server variables
|
|
initserverconfig();
|
|
|
|
# handle IPC calls
|
|
event_loop();
|
|
|
|
# Can't rely on logmsg here in case it's buffered
|
|
print "Runner $thisrunnerid exiting\n" if($verbose);
|
|
exit 0;
|
|
}
|
|
|
|
# Here we are the parent (controller).
|
|
close($thisrunnerw);
|
|
close($thisrunnerr);
|
|
|
|
$thisrunnerid = $child;
|
|
|
|
} else {
|
|
# Create our pid directory
|
|
mkdir("$LOGDIR/$PIDDIR", 0777);
|
|
|
|
# Don't create a separate process
|
|
$thisrunnerid = "integrated";
|
|
}
|
|
|
|
$controllerw{$thisrunnerid} = $thiscontrollerw;
|
|
$runnerr = $thisrunnerr;
|
|
$runnerw = $thisrunnerw;
|
|
$controllerr{$thisrunnerid} = $thiscontrollerr;
|
|
|
|
return $thisrunnerid;
|
|
}
|
|
|
|
#######################################################################
|
|
# Loop to execute incoming IPC calls until the shutdown call
|
|
sub event_loop {
|
|
while () {
|
|
if(ipcrecv()) {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
|
|
#######################################################################
|
|
# Check for a command in the PATH of the machine running curl.
|
|
#
|
|
sub checktestcmd {
|
|
my ($cmd)=@_;
|
|
my @testpaths=("$LIBDIR/.libs", "$LIBDIR");
|
|
return checkcmd($cmd, @testpaths);
|
|
}
|
|
|
|
# See if Valgrind should actually be used
|
|
sub use_valgrind {
|
|
if($valgrind) {
|
|
my @valgrindoption = getpart("verify", "valgrind");
|
|
if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) {
|
|
return 1;
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
# Massage the command result code into a useful form
|
|
sub normalize_cmdres {
|
|
my $cmdres = $_[0];
|
|
my $signal_num = $cmdres & 127;
|
|
my $dumped_core = $cmdres & 128;
|
|
|
|
if(!$anyway && ($signal_num || $dumped_core)) {
|
|
$cmdres = 1000;
|
|
}
|
|
else {
|
|
$cmdres >>= 8;
|
|
$cmdres = (2000 + $signal_num) if($signal_num && !$cmdres);
|
|
}
|
|
return ($cmdres, $dumped_core);
|
|
}
|
|
|
|
# 'prepro' processes the input array and replaces %-variables in the array
|
|
# etc. Returns the processed version of the array
|
|
sub prepro {
|
|
my $testnum = shift;
|
|
my (@entiretest) = @_;
|
|
my $show = 1;
|
|
my @out;
|
|
my $data_crlf;
|
|
for my $s (@entiretest) {
|
|
my $f = $s;
|
|
if($s =~ /^ *%if (.*)/) {
|
|
my $cond = $1;
|
|
my $rev = 0;
|
|
|
|
if($cond =~ /^!(.*)/) {
|
|
$cond = $1;
|
|
$rev = 1;
|
|
}
|
|
$rev ^= $feature{$cond} ? 1 : 0;
|
|
$show = $rev;
|
|
next;
|
|
}
|
|
elsif($s =~ /^ *%else/) {
|
|
$show ^= 1;
|
|
next;
|
|
}
|
|
elsif($s =~ /^ *%endif/) {
|
|
$show = 1;
|
|
next;
|
|
}
|
|
if($show) {
|
|
# The processor does CRLF replacements in the <data*> sections if
|
|
# necessary since those parts might be read by separate servers.
|
|
if($s =~ /^ *<data(.*)\>/) {
|
|
if($1 =~ /crlf="yes"/ ||
|
|
($feature{"hyper"} && ($keywords{"HTTP"} || $keywords{"HTTPS"}))) {
|
|
$data_crlf = 1;
|
|
}
|
|
}
|
|
elsif(($s =~ /^ *<\/data/) && $data_crlf) {
|
|
$data_crlf = 0;
|
|
}
|
|
subvariables(\$s, $testnum, "%");
|
|
subbase64(\$s);
|
|
subnewlines(0, \$s) if($data_crlf);
|
|
push @out, $s;
|
|
}
|
|
}
|
|
return @out;
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Load test keywords into %keywords hash
|
|
#
|
|
sub readtestkeywords {
|
|
my @info_keywords = getpart("info", "keywords");
|
|
|
|
# Clear the list of keywords from the last test
|
|
%keywords = ();
|
|
for my $k (@info_keywords) {
|
|
chomp $k;
|
|
$keywords{$k} = 1;
|
|
}
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Return a list of log locks that still exist
|
|
#
|
|
sub logslocked {
|
|
opendir(my $lockdir, "$LOGDIR/$LOCKDIR");
|
|
my @locks;
|
|
foreach (readdir $lockdir) {
|
|
if(/^(.*)\.lock$/) {
|
|
push @locks, $1;
|
|
}
|
|
}
|
|
return @locks;
|
|
}
|
|
|
|
#######################################################################
|
|
# Memory allocation test and failure torture testing.
|
|
#
|
|
sub torture {
|
|
my ($testcmd, $testnum, $gdbline) = @_;
|
|
|
|
# remove memdump first to be sure we get a new nice and clean one
|
|
unlink("$LOGDIR/$MEMDUMP");
|
|
|
|
# First get URL from test server, ignore the output/result
|
|
runclient($testcmd);
|
|
|
|
logmsg " CMD: $testcmd\n" if($verbose);
|
|
|
|
# memanalyze -v is our friend, get the number of allocations made
|
|
my $count=0;
|
|
my @out = `$memanalyze -v "$LOGDIR/$MEMDUMP"`;
|
|
for(@out) {
|
|
if(/^Operations: (\d+)/) {
|
|
$count = $1;
|
|
last;
|
|
}
|
|
}
|
|
if(!$count) {
|
|
logmsg " found no functions to make fail\n";
|
|
return 0;
|
|
}
|
|
|
|
my @ttests = (1 .. $count);
|
|
if($shallow && ($shallow < $count)) {
|
|
my $discard = scalar(@ttests) - $shallow;
|
|
my $percent = sprintf("%.2f%%", $shallow * 100 / scalar(@ttests));
|
|
logmsg " $count functions found, but only fail $shallow ($percent)\n";
|
|
while($discard) {
|
|
my $rm;
|
|
do {
|
|
# find a test to discard
|
|
$rm = rand(scalar(@ttests));
|
|
} while(!$ttests[$rm]);
|
|
$ttests[$rm] = undef;
|
|
$discard--;
|
|
}
|
|
}
|
|
else {
|
|
logmsg " $count functions to make fail\n";
|
|
}
|
|
|
|
for (@ttests) {
|
|
my $limit = $_;
|
|
my $fail;
|
|
my $dumped_core;
|
|
|
|
if(!defined($limit)) {
|
|
# --shallow can undefine them
|
|
next;
|
|
}
|
|
if($tortalloc && ($tortalloc != $limit)) {
|
|
next;
|
|
}
|
|
|
|
if($verbose) {
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
|
|
localtime(time());
|
|
my $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
|
|
logmsg "Fail function no: $limit at $now\r";
|
|
}
|
|
|
|
# make the memory allocation function number $limit return failure
|
|
$ENV{'CURL_MEMLIMIT'} = $limit;
|
|
|
|
# remove memdump first to be sure we get a new nice and clean one
|
|
unlink("$LOGDIR/$MEMDUMP");
|
|
|
|
my $cmd = $testcmd;
|
|
if($valgrind && !$gdbthis) {
|
|
my @valgrindoption = getpart("verify", "valgrind");
|
|
if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) {
|
|
my $valgrindcmd = "$valgrind ";
|
|
$valgrindcmd .= "$valgrind_tool " if($valgrind_tool);
|
|
$valgrindcmd .= "--quiet --leak-check=yes ";
|
|
$valgrindcmd .= "--suppressions=$srcdir/valgrind.supp ";
|
|
# $valgrindcmd .= "--gen-suppressions=all ";
|
|
$valgrindcmd .= "--num-callers=16 ";
|
|
$valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum";
|
|
$cmd = "$valgrindcmd $testcmd";
|
|
}
|
|
}
|
|
logmsg "*** Function number $limit is now set to fail ***\n" if($gdbthis);
|
|
|
|
my $ret = 0;
|
|
if($gdbthis) {
|
|
runclient($gdbline);
|
|
}
|
|
else {
|
|
$ret = runclient($cmd);
|
|
}
|
|
#logmsg "$_ Returned " . ($ret >> 8) . "\n";
|
|
|
|
# Now clear the variable again
|
|
delete $ENV{'CURL_MEMLIMIT'} if($ENV{'CURL_MEMLIMIT'});
|
|
|
|
if(-r "core") {
|
|
# there's core file present now!
|
|
logmsg " core dumped\n";
|
|
$dumped_core = 1;
|
|
$fail = 2;
|
|
}
|
|
|
|
if($valgrind) {
|
|
my @e = valgrindparse("$LOGDIR/valgrind$testnum");
|
|
if(@e && $e[0]) {
|
|
if($automakestyle) {
|
|
logmsg "FAIL: torture $testnum - valgrind\n";
|
|
}
|
|
else {
|
|
logmsg " valgrind ERROR ";
|
|
logmsg @e;
|
|
}
|
|
$fail = 1;
|
|
}
|
|
}
|
|
|
|
# verify that it returns a proper error code, doesn't leak memory
|
|
# and doesn't core dump
|
|
if(($ret & 255) || ($ret >> 8) >= 128) {
|
|
logmsg " system() returned $ret\n";
|
|
$fail=1;
|
|
}
|
|
else {
|
|
my @memdata=`$memanalyze "$LOGDIR/$MEMDUMP"`;
|
|
my $leak=0;
|
|
for(@memdata) {
|
|
if($_ ne "") {
|
|
# well it could be other memory problems as well, but
|
|
# we call it leak for short here
|
|
$leak=1;
|
|
}
|
|
}
|
|
if($leak) {
|
|
logmsg "** MEMORY FAILURE\n";
|
|
logmsg @memdata;
|
|
logmsg `$memanalyze -l "$LOGDIR/$MEMDUMP"`;
|
|
$fail = 1;
|
|
}
|
|
}
|
|
if($fail) {
|
|
logmsg " Failed on function number $limit in test.\n",
|
|
" invoke with \"-t$limit\" to repeat this single case.\n";
|
|
stopservers($verbose);
|
|
return 1;
|
|
}
|
|
}
|
|
|
|
logmsg "\n" if($verbose);
|
|
logmsg "torture OK\n";
|
|
return 0;
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# restore environment variables that were modified in test
|
|
sub restore_test_env {
|
|
my $deleteoldenv = $_[0]; # 1 to delete the saved contents after restore
|
|
foreach my $var (keys %oldenv) {
|
|
if($oldenv{$var} eq 'notset') {
|
|
delete $ENV{$var} if($ENV{$var});
|
|
}
|
|
else {
|
|
$ENV{$var} = $oldenv{$var};
|
|
}
|
|
if($deleteoldenv) {
|
|
delete $oldenv{$var};
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Start the servers needed to run this test case
|
|
sub singletest_startservers {
|
|
my ($testnum, $testtimings) = @_;
|
|
|
|
# remove old test server files before servers are started/verified
|
|
unlink("$LOGDIR/$FTPDCMD");
|
|
unlink("$LOGDIR/$SERVERIN");
|
|
unlink("$LOGDIR/$PROXYIN");
|
|
|
|
# timestamp required servers verification start
|
|
$$testtimings{"timesrvrini"} = Time::HiRes::time();
|
|
|
|
my $why;
|
|
my $error;
|
|
if (!$listonly) {
|
|
my @what = getpart("client", "server");
|
|
if(!$what[0]) {
|
|
warn "Test case $testnum has no server(s) specified";
|
|
$why = "no server specified";
|
|
$error = -1;
|
|
} else {
|
|
my $err;
|
|
($why, $err) = serverfortest(@what);
|
|
if($err == 1) {
|
|
# Error indicates an actual problem starting the server
|
|
$error = -2;
|
|
} else {
|
|
$error = -1;
|
|
}
|
|
}
|
|
}
|
|
|
|
# timestamp required servers verification end
|
|
$$testtimings{"timesrvrend"} = Time::HiRes::time();
|
|
|
|
return ($why, $error);
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Generate preprocessed test file
|
|
sub singletest_preprocess {
|
|
my $testnum = $_[0];
|
|
|
|
# Save a preprocessed version of the entire test file. This allows more
|
|
# "basic" test case readers to enjoy variable replacements.
|
|
my @entiretest = fulltest();
|
|
my $otest = "$LOGDIR/test$testnum";
|
|
|
|
@entiretest = prepro($testnum, @entiretest);
|
|
|
|
# save the new version
|
|
open(my $fulltesth, ">", "$otest") || die "Failure writing test file";
|
|
foreach my $bytes (@entiretest) {
|
|
print $fulltesth pack('a*', $bytes) or die "Failed to print '$bytes': $!";
|
|
}
|
|
close($fulltesth) || die "Failure writing test file";
|
|
|
|
# in case the process changed the file, reload it
|
|
loadtest("$LOGDIR/test${testnum}");
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Set up the test environment to run this test case
|
|
sub singletest_setenv {
|
|
my @setenv = getpart("client", "setenv");
|
|
foreach my $s (@setenv) {
|
|
chomp $s;
|
|
if($s =~ /([^=]*)=(.*)/) {
|
|
my ($var, $content) = ($1, $2);
|
|
# remember current setting, to restore it once test runs
|
|
$oldenv{$var} = ($ENV{$var})?"$ENV{$var}":'notset';
|
|
# set new value
|
|
if(!$content) {
|
|
delete $ENV{$var} if($ENV{$var});
|
|
}
|
|
else {
|
|
if($var =~ /^LD_PRELOAD/) {
|
|
if(exe_ext('TOOL') && (exe_ext('TOOL') eq '.exe')) {
|
|
logmsg "Skipping LD_PRELOAD due to lack of OS support\n" if($verbose);
|
|
next;
|
|
}
|
|
if($feature{"debug"} || !$has_shared) {
|
|
logmsg "Skipping LD_PRELOAD due to no release shared build\n" if($verbose);
|
|
next;
|
|
}
|
|
}
|
|
$ENV{$var} = "$content";
|
|
logmsg "setenv $var = $content\n" if($verbose);
|
|
}
|
|
}
|
|
}
|
|
if($proxy_address) {
|
|
$ENV{http_proxy} = $proxy_address;
|
|
$ENV{HTTPS_PROXY} = $proxy_address;
|
|
}
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Check that test environment is fine to run this test case
|
|
sub singletest_precheck {
|
|
my $testnum = $_[0];
|
|
my $why;
|
|
my @precheck = getpart("client", "precheck");
|
|
if(@precheck) {
|
|
my $cmd = $precheck[0];
|
|
chomp $cmd;
|
|
if($cmd) {
|
|
my @p = split(/ /, $cmd);
|
|
if($p[0] !~ /\//) {
|
|
# the first word, the command, does not contain a slash so
|
|
# we will scan the "improved" PATH to find the command to
|
|
# be able to run it
|
|
my $fullp = checktestcmd($p[0]);
|
|
|
|
if($fullp) {
|
|
$p[0] = $fullp;
|
|
}
|
|
$cmd = join(" ", @p);
|
|
}
|
|
|
|
my @o = `$cmd 2> $LOGDIR/precheck-$testnum`;
|
|
if($o[0]) {
|
|
$why = $o[0];
|
|
$why =~ s/[\r\n]//g;
|
|
}
|
|
elsif($?) {
|
|
$why = "precheck command error";
|
|
}
|
|
logmsg "prechecked $cmd\n" if($verbose);
|
|
}
|
|
}
|
|
return $why;
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Prepare the test environment to run this test case
|
|
sub singletest_prepare {
|
|
my ($testnum) = @_;
|
|
|
|
if($feature{"TrackMemory"}) {
|
|
unlink("$LOGDIR/$MEMDUMP");
|
|
}
|
|
unlink("core");
|
|
|
|
# remove server output logfiles after servers are started/verified
|
|
unlink("$LOGDIR/$SERVERIN");
|
|
unlink("$LOGDIR/$PROXYIN");
|
|
|
|
# if this section exists, it might be FTP server instructions:
|
|
my @ftpservercmd = getpart("reply", "servercmd");
|
|
push @ftpservercmd, "Testnum $testnum\n";
|
|
# write the instructions to file
|
|
writearray("$LOGDIR/$FTPDCMD", \@ftpservercmd);
|
|
|
|
# create (possibly-empty) files before starting the test
|
|
for my $partsuffix (('', '1', '2', '3', '4')) {
|
|
my @inputfile=getpart("client", "file".$partsuffix);
|
|
my %fileattr = getpartattr("client", "file".$partsuffix);
|
|
my $filename=$fileattr{'name'};
|
|
if(@inputfile || $filename) {
|
|
if(!$filename) {
|
|
logmsg "ERROR: section client=>file has no name attribute\n";
|
|
return -1;
|
|
}
|
|
my $fileContent = join('', @inputfile);
|
|
|
|
# make directories if needed
|
|
my $path = $filename;
|
|
# cut off the file name part
|
|
$path =~ s/^(.*)\/[^\/]*/$1/;
|
|
my $nparts = scalar(split(/\//, $LOGDIR));
|
|
my @parts = split(/\//, $path);
|
|
if(join("/", @parts[0..$nparts-1]) eq $LOGDIR) {
|
|
# the file is in $LOGDIR/
|
|
my $d = shift @parts;
|
|
for(@parts) {
|
|
$d .= "/$_";
|
|
mkdir $d; # 0777
|
|
}
|
|
}
|
|
if (open(my $outfile, ">", "$filename")) {
|
|
binmode $outfile; # for crapage systems, use binary
|
|
if($fileattr{'nonewline'}) {
|
|
# cut off the final newline
|
|
chomp($fileContent);
|
|
}
|
|
print $outfile $fileContent;
|
|
close($outfile);
|
|
} else {
|
|
logmsg "ERROR: cannot write $filename\n";
|
|
}
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Run the test command
|
|
sub singletest_run {
|
|
my ($testnum, $testtimings) = @_;
|
|
|
|
# get the command line options to use
|
|
my ($cmd, @blaha)= getpart("client", "command");
|
|
if($cmd) {
|
|
# make some nice replace operations
|
|
$cmd =~ s/\n//g; # no newlines please
|
|
# substitute variables in the command line
|
|
}
|
|
else {
|
|
# there was no command given, use something silly
|
|
$cmd="-";
|
|
}
|
|
|
|
my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout
|
|
|
|
# if stdout section exists, we verify that the stdout contained this:
|
|
my $out="";
|
|
my %cmdhash = getpartattr("client", "command");
|
|
if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-output/)) {
|
|
#We may slap on --output!
|
|
if (!partexists("verify", "stdout") ||
|
|
($cmdhash{'option'} && $cmdhash{'option'} =~ /force-output/)) {
|
|
$out=" --output $CURLOUT ";
|
|
}
|
|
}
|
|
|
|
my @codepieces = getpart("client", "tool");
|
|
my $tool="";
|
|
if(@codepieces) {
|
|
$tool = $codepieces[0];
|
|
chomp $tool;
|
|
$tool .= exe_ext('TOOL');
|
|
}
|
|
|
|
my $disablevalgrind;
|
|
my $CMDLINE="";
|
|
my $cmdargs;
|
|
my $cmdtype = $cmdhash{'type'} || "default";
|
|
my $fail_due_event_based = $run_event_based;
|
|
if($cmdtype eq "perl") {
|
|
# run the command line prepended with "perl"
|
|
$cmdargs ="$cmd";
|
|
$CMDLINE = "$perl ";
|
|
$tool=$CMDLINE;
|
|
$disablevalgrind=1;
|
|
}
|
|
elsif($cmdtype eq "shell") {
|
|
# run the command line prepended with "/bin/sh"
|
|
$cmdargs ="$cmd";
|
|
$CMDLINE = "/bin/sh ";
|
|
$tool=$CMDLINE;
|
|
$disablevalgrind=1;
|
|
}
|
|
elsif(!$tool && !$keywords{"unittest"}) {
|
|
# run curl, add suitable command line options
|
|
my $inc="";
|
|
if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-include/)) {
|
|
$inc = " --include";
|
|
}
|
|
$cmdargs = "$out$inc ";
|
|
|
|
if($cmdhash{'option'} && ($cmdhash{'option'} =~ /binary-trace/)) {
|
|
$cmdargs .= "--trace $LOGDIR/trace$testnum ";
|
|
}
|
|
else {
|
|
$cmdargs .= "--trace-ascii $LOGDIR/trace$testnum ";
|
|
}
|
|
$cmdargs .= "--trace-time ";
|
|
if($run_event_based) {
|
|
$cmdargs .= "--test-event ";
|
|
$fail_due_event_based--;
|
|
}
|
|
$cmdargs .= $cmd;
|
|
if ($proxy_address) {
|
|
$cmdargs .= " --proxy $proxy_address ";
|
|
}
|
|
}
|
|
else {
|
|
$cmdargs = " $cmd"; # $cmd is the command line for the test file
|
|
$CURLOUT = stdoutfilename($LOGDIR, $testnum); # sends received data to stdout
|
|
|
|
# Default the tool to a unit test with the same name as the test spec
|
|
if($keywords{"unittest"} && !$tool) {
|
|
$tool="unit$testnum";
|
|
}
|
|
|
|
if($tool =~ /^lib/) {
|
|
$CMDLINE="$LIBDIR/$tool";
|
|
}
|
|
elsif($tool =~ /^unit/) {
|
|
$CMDLINE="$UNITDIR/$tool";
|
|
}
|
|
|
|
if(! -f $CMDLINE) {
|
|
logmsg "The tool set in the test case for this: '$tool' does not exist\n";
|
|
return (-1, 0, 0, "", "", 0);
|
|
}
|
|
$DBGCURL=$CMDLINE;
|
|
}
|
|
|
|
if($fail_due_event_based) {
|
|
logmsg "This test cannot run event based\n";
|
|
return (-1, 0, 0, "", "", 0);
|
|
}
|
|
|
|
if($gdbthis) {
|
|
# gdb is incompatible with valgrind, so disable it when debugging
|
|
# Perhaps a better approach would be to run it under valgrind anyway
|
|
# with --db-attach=yes or --vgdb=yes.
|
|
$disablevalgrind=1;
|
|
}
|
|
|
|
my @stdintest = getpart("client", "stdin");
|
|
|
|
if(@stdintest) {
|
|
my $stdinfile="$LOGDIR/stdin-for-$testnum";
|
|
|
|
my %hash = getpartattr("client", "stdin");
|
|
if($hash{'nonewline'}) {
|
|
# cut off the final newline from the final line of the stdin data
|
|
chomp($stdintest[-1]);
|
|
}
|
|
|
|
writearray($stdinfile, \@stdintest);
|
|
|
|
$cmdargs .= " <$stdinfile";
|
|
}
|
|
|
|
if(!$tool) {
|
|
$CMDLINE=shell_quote($CURL);
|
|
}
|
|
|
|
if(use_valgrind() && !$disablevalgrind) {
|
|
my $valgrindcmd = "$valgrind ";
|
|
$valgrindcmd .= "$valgrind_tool " if($valgrind_tool);
|
|
$valgrindcmd .= "--quiet --leak-check=yes ";
|
|
$valgrindcmd .= "--suppressions=$srcdir/valgrind.supp ";
|
|
# $valgrindcmd .= "--gen-suppressions=all ";
|
|
$valgrindcmd .= "--num-callers=16 ";
|
|
$valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum";
|
|
$CMDLINE = "$valgrindcmd $CMDLINE";
|
|
}
|
|
|
|
$CMDLINE .= "$cmdargs > " . stdoutfilename($LOGDIR, $testnum) .
|
|
" 2> " . stderrfilename($LOGDIR, $testnum);
|
|
|
|
if($verbose) {
|
|
logmsg "$CMDLINE\n";
|
|
}
|
|
|
|
open(my $cmdlog, ">", $CURLLOG) || die "Failure writing log file";
|
|
print $cmdlog "$CMDLINE\n";
|
|
close($cmdlog) || die "Failure writing log file";
|
|
|
|
my $dumped_core;
|
|
my $cmdres;
|
|
|
|
if($gdbthis) {
|
|
my $gdbinit = "$TESTDIR/gdbinit$testnum";
|
|
open(my $gdbcmd, ">", "$LOGDIR/gdbcmd") || die "Failure writing gdb file";
|
|
print $gdbcmd "set args $cmdargs\n";
|
|
print $gdbcmd "show args\n";
|
|
print $gdbcmd "source $gdbinit\n" if -e $gdbinit;
|
|
close($gdbcmd) || die "Failure writing gdb file";
|
|
}
|
|
|
|
# Flush output.
|
|
$| = 1;
|
|
|
|
# timestamp starting of test command
|
|
$$testtimings{"timetoolini"} = Time::HiRes::time();
|
|
|
|
# run the command line we built
|
|
if ($torture) {
|
|
$cmdres = torture($CMDLINE,
|
|
$testnum,
|
|
"$gdb --directory $LIBDIR " . shell_quote($DBGCURL) . " -x $LOGDIR/gdbcmd");
|
|
}
|
|
elsif($gdbthis) {
|
|
my $GDBW = ($gdbxwin) ? "-w" : "";
|
|
runclient("$gdb --directory $LIBDIR " . shell_quote($DBGCURL) . " $GDBW -x $LOGDIR/gdbcmd");
|
|
$cmdres=0; # makes it always continue after a debugged run
|
|
}
|
|
else {
|
|
# Convert the raw result code into a more useful one
|
|
($cmdres, $dumped_core) = normalize_cmdres(runclient("$CMDLINE"));
|
|
}
|
|
|
|
# timestamp finishing of test command
|
|
$$testtimings{"timetoolend"} = Time::HiRes::time();
|
|
|
|
return (0, $cmdres, $dumped_core, $CURLOUT, $tool, use_valgrind() && !$disablevalgrind);
|
|
}
|
|
|
|
|
|
#######################################################################
|
|
# Clean up after test command
|
|
sub singletest_clean {
|
|
my ($testnum, $dumped_core, $testtimings)=@_;
|
|
|
|
if(!$dumped_core) {
|
|
if(-r "core") {
|
|
# there's core file present now!
|
|
$dumped_core = 1;
|
|
}
|
|
}
|
|
|
|
if($dumped_core) {
|
|
logmsg "core dumped\n";
|
|
if(0 && $gdb) {
|
|
logmsg "running gdb for post-mortem analysis:\n";
|
|
open(my $gdbcmd, ">", "$LOGDIR/gdbcmd2") || die "Failure writing gdb file";
|
|
print $gdbcmd "bt\n";
|
|
close($gdbcmd) || die "Failure writing gdb file";
|
|
runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch " . shell_quote($DBGCURL) . " core ");
|
|
# unlink("$LOGDIR/gdbcmd2");
|
|
}
|
|
}
|
|
|
|
# If a server logs advisor read lock file exists, it is an indication
|
|
# that the server has not yet finished writing out all its log files,
|
|
# including server request log files used for protocol verification.
|
|
# So, if the lock file exists the script waits here a certain amount
|
|
# of time until the server removes it, or the given time expires.
|
|
my $serverlogslocktimeout = $defserverlogslocktimeout;
|
|
my %cmdhash = getpartattr("client", "command");
|
|
if($cmdhash{'timeout'}) {
|
|
# test is allowed to override default server logs lock timeout
|
|
if($cmdhash{'timeout'} =~ /(\d+)/) {
|
|
$serverlogslocktimeout = $1 if($1 >= 0);
|
|
}
|
|
}
|
|
if($serverlogslocktimeout) {
|
|
my $lockretry = $serverlogslocktimeout * 20;
|
|
my @locks;
|
|
while((@locks = logslocked()) && $lockretry--) {
|
|
portable_sleep(0.05);
|
|
}
|
|
if(($lockretry < 0) &&
|
|
($serverlogslocktimeout >= $defserverlogslocktimeout)) {
|
|
logmsg "Warning: server logs lock timeout ",
|
|
"($serverlogslocktimeout seconds) expired (locks: " .
|
|
join(", ", @locks) . ")\n";
|
|
}
|
|
}
|
|
|
|
# Test harness ssh server does not have this synchronization mechanism,
|
|
# this implies that some ssh server based tests might need a small delay
|
|
# once that the client command has run to avoid false test failures.
|
|
#
|
|
# gnutls-serv also lacks this synchronization mechanism, so gnutls-serv
|
|
# based tests might need a small delay once that the client command has
|
|
# run to avoid false test failures.
|
|
my $postcommanddelay = $defpostcommanddelay;
|
|
if($cmdhash{'delay'}) {
|
|
# test is allowed to specify a delay after command is executed
|
|
if($cmdhash{'delay'} =~ /(\d+)/) {
|
|
$postcommanddelay = $1 if($1 > 0);
|
|
}
|
|
}
|
|
|
|
portable_sleep($postcommanddelay) if($postcommanddelay);
|
|
|
|
# timestamp removal of server logs advisor read lock
|
|
$$testtimings{"timesrvrlog"} = Time::HiRes::time();
|
|
|
|
# test definition might instruct to stop some servers
|
|
# stop also all servers relative to the given one
|
|
|
|
my @killtestservers = getpart("client", "killserver");
|
|
if(@killtestservers) {
|
|
foreach my $server (@killtestservers) {
|
|
chomp $server;
|
|
if(stopserver($server)) {
|
|
logmsg " killserver FAILED\n";
|
|
return 1; # normal error if asked to fail on unexpected alive
|
|
}
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
#######################################################################
|
|
# Verify that the postcheck succeeded
|
|
sub singletest_postcheck {
|
|
my ($testnum)=@_;
|
|
|
|
# run the postcheck command
|
|
my @postcheck= getpart("client", "postcheck");
|
|
if(@postcheck) {
|
|
my $cmd = join("", @postcheck);
|
|
chomp $cmd;
|
|
if($cmd) {
|
|
logmsg "postcheck $cmd\n" if($verbose);
|
|
my $rc = runclient("$cmd");
|
|
# Must run the postcheck command in torture mode in order
|
|
# to clean up, but the result can't be relied upon.
|
|
if($rc != 0 && !$torture) {
|
|
logmsg " postcheck FAILED\n";
|
|
return -1;
|
|
}
|
|
}
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
|
|
|
|
###################################################################
|
|
# Get ready to run a single test case
|
|
sub runner_test_preprocess {
|
|
my ($testnum)=@_;
|
|
my %testtimings;
|
|
|
|
if(clearlogs()) {
|
|
logmsg "Warning: log messages were lost\n";
|
|
}
|
|
|
|
# timestamp test preparation start
|
|
# TODO: this metric now shows only a portion of the prep time; better would
|
|
# be to time singletest_preprocess below instead
|
|
$testtimings{"timeprepini"} = Time::HiRes::time();
|
|
|
|
###################################################################
|
|
# Load test metadata
|
|
# ignore any error here--if there were one, it would have been
|
|
# caught during the selection phase and this test would not be
|
|
# running now
|
|
loadtest("${TESTDIR}/test${testnum}");
|
|
readtestkeywords();
|
|
|
|
###################################################################
|
|
# Restore environment variables that were modified in a previous run.
|
|
# Test definition may instruct to (un)set environment vars.
|
|
restore_test_env(1);
|
|
|
|
###################################################################
|
|
# Start the servers needed to run this test case
|
|
my ($why, $error) = singletest_startservers($testnum, \%testtimings);
|
|
|
|
if(!$why) {
|
|
|
|
###############################################################
|
|
# Generate preprocessed test file
|
|
# This must be done after the servers are started so server
|
|
# variables are available for substitution.
|
|
singletest_preprocess($testnum);
|
|
|
|
###############################################################
|
|
# Set up the test environment to run this test case
|
|
singletest_setenv();
|
|
|
|
###############################################################
|
|
# Check that the test environment is fine to run this test case
|
|
if (!$listonly) {
|
|
$why = singletest_precheck($testnum);
|
|
$error = -1;
|
|
}
|
|
}
|
|
return ($why, $error, clearlogs(), \%testtimings);
|
|
}
|
|
|
|
|
|
###################################################################
|
|
# Run a single test case with an environment that already been prepared
|
|
# Returns 0=success, -1=skippable failure, -2=permanent error,
|
|
# 1=unskippable test failure, as first integer, plus any log messages,
|
|
# plus more return values when error is 0
|
|
sub runner_test_run {
|
|
my ($testnum)=@_;
|
|
|
|
if(clearlogs()) {
|
|
logmsg "Warning: log messages were lost\n";
|
|
}
|
|
|
|
#######################################################################
|
|
# Prepare the test environment to run this test case
|
|
my $error = singletest_prepare($testnum);
|
|
if($error) {
|
|
return (-2, clearlogs());
|
|
}
|
|
|
|
#######################################################################
|
|
# Run the test command
|
|
my %testtimings;
|
|
my $cmdres;
|
|
my $dumped_core;
|
|
my $CURLOUT;
|
|
my $tool;
|
|
my $usedvalgrind;
|
|
($error, $cmdres, $dumped_core, $CURLOUT, $tool, $usedvalgrind) = singletest_run($testnum, \%testtimings);
|
|
if($error) {
|
|
return (-2, clearlogs(), \%testtimings);
|
|
}
|
|
|
|
#######################################################################
|
|
# Clean up after test command
|
|
$error = singletest_clean($testnum, $dumped_core, \%testtimings);
|
|
if($error) {
|
|
return ($error, clearlogs(), \%testtimings);
|
|
}
|
|
|
|
#######################################################################
|
|
# Verify that the postcheck succeeded
|
|
$error = singletest_postcheck($testnum);
|
|
if($error) {
|
|
return ($error, clearlogs(), \%testtimings);
|
|
}
|
|
|
|
#######################################################################
|
|
# restore environment variables that were modified
|
|
restore_test_env(0);
|
|
|
|
return (0, clearlogs(), \%testtimings, $cmdres, $CURLOUT, $tool, $usedvalgrind);
|
|
}
|
|
|
|
# Async call runner_clearlocks
|
|
# Called by controller
|
|
sub runnerac_clearlocks {
|
|
controlleripccall(\&runner_clearlocks, @_);
|
|
}
|
|
|
|
# Async call runner_shutdown
|
|
# This call does NOT generate an IPC response and must be the last IPC call
|
|
# received.
|
|
# Called by controller
|
|
sub runnerac_shutdown {
|
|
my ($runnerid)=$_[0];
|
|
controlleripccall(\&runner_shutdown, @_);
|
|
|
|
# These have no more use
|
|
close($controllerw{$runnerid});
|
|
undef $controllerw{$runnerid};
|
|
close($controllerr{$runnerid});
|
|
undef $controllerr{$runnerid};
|
|
}
|
|
|
|
# Async call of runner_stopservers
|
|
# Called by controller
|
|
sub runnerac_stopservers {
|
|
controlleripccall(\&runner_stopservers, @_);
|
|
}
|
|
|
|
# Async call of runner_test_preprocess
|
|
# Called by controller
|
|
sub runnerac_test_preprocess {
|
|
controlleripccall(\&runner_test_preprocess, @_);
|
|
}
|
|
|
|
# Async call of runner_test_run
|
|
# Called by controller
|
|
sub runnerac_test_run {
|
|
controlleripccall(\&runner_test_run, @_);
|
|
}
|
|
|
|
###################################################################
|
|
# Call an arbitrary function via IPC
|
|
# The first argument is the function reference, the second is the runner ID
|
|
# Called by controller (indirectly, via a more specific function)
|
|
sub controlleripccall {
|
|
my $funcref = shift @_;
|
|
my $runnerid = shift @_;
|
|
# Get the name of the function from the reference
|
|
my $cv = svref_2object($funcref);
|
|
my $gv = $cv->GV;
|
|
# Prepend the name to the function arguments so it's marshalled along with them
|
|
unshift @_, $gv->NAME;
|
|
# Marshall the arguments into a flat string
|
|
my $margs = freeze \@_;
|
|
|
|
# Send IPC call via pipe
|
|
syswrite($controllerw{$runnerid}, (pack "L", length($margs)) . $margs);
|
|
|
|
if(!$multiprocess) {
|
|
# Call the remote function here in single process mode
|
|
ipcrecv();
|
|
}
|
|
}
|
|
|
|
###################################################################
|
|
# Receive async response of a previous call via IPC
|
|
# The first return value is the runner ID
|
|
# Called by controller
|
|
sub runnerar {
|
|
my ($runnerid) = @_;
|
|
my $err;
|
|
my $datalen;
|
|
while(! defined ($err = sysread($controllerr{$runnerid}, $datalen, 4)) || $err <= 0) {
|
|
$!{EINTR} || die "error in runnerar: $!\n";
|
|
# system call was interrupted, probably by ^C; restart it so we stay in sync
|
|
}
|
|
my $len=unpack("L", $datalen);
|
|
my $buf;
|
|
while(! defined ($err = sysread($controllerr{$runnerid}, $buf, $len)) || $err <= 0) {
|
|
$!{EINTR} || die "error in runnerar: $!\n";
|
|
# system call was interrupted, probably by ^C; restart it so we stay in sync
|
|
}
|
|
|
|
# Decode response values
|
|
my $resarrayref = thaw $buf;
|
|
|
|
# First argument is runner ID
|
|
# TODO: remove this; it's unneeded since it's passed in
|
|
unshift @$resarrayref, $runnerid;
|
|
return @$resarrayref;
|
|
}
|
|
|
|
###################################################################
|
|
# Returns runner ID if a response from an async call is ready
|
|
# argument is 0 for nonblocking, undef for blocking, anything else for timeout
|
|
# Called by controller
|
|
sub runnerar_ready {
|
|
my ($blocking) = @_;
|
|
my $rin = "";
|
|
my %idbyfileno;
|
|
my $maxfileno=0;
|
|
foreach my $p (keys(%controllerr)) {
|
|
my $fd = fileno($controllerr{$p});
|
|
vec($rin, $fd, 1) = 1;
|
|
$idbyfileno{$fd} = $p; # save the runner ID for each pipe fd
|
|
if($fd > $maxfileno) {
|
|
$maxfileno = $fd;
|
|
}
|
|
}
|
|
|
|
# Wait for any pipe from any runner to be ready
|
|
# TODO: this is relatively slow with hundreds of fds
|
|
# TODO: handle errors
|
|
if(select(my $rout=$rin, undef, undef, $blocking)) {
|
|
for my $fd (0..$maxfileno) {
|
|
if(vec($rout, $fd, 1)) {
|
|
return $idbyfileno{$fd};
|
|
}
|
|
}
|
|
die "Internal pipe readiness inconsistency\n";
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
###################################################################
|
|
# Receive an IPC call in the runner and execute it
|
|
# The IPC is read from the $runnerr pipe and the response is
|
|
# written to the $runnerw pipe
|
|
sub ipcrecv {
|
|
my $err;
|
|
my $datalen;
|
|
while(! defined ($err = sysread($runnerr, $datalen, 4)) || $err <= 0) {
|
|
$!{EINTR} || die "error in ipcrecv: $!\n";
|
|
# system call was interrupted, probably by ^C; restart it so we stay in sync
|
|
}
|
|
my $len=unpack("L", $datalen);
|
|
my $buf;
|
|
while(! defined ($err = sysread($runnerr, $buf, $len)) || $err <= 0) {
|
|
$!{EINTR} || die "error in ipcrecv: $!\n";
|
|
# system call was interrupted, probably by ^C; restart it so we stay in sync
|
|
}
|
|
|
|
# Decode the function name and arguments
|
|
my $argsarrayref = thaw $buf;
|
|
|
|
# The name of the function to call is the frist argument
|
|
my $funcname = shift @$argsarrayref;
|
|
|
|
# print "ipcrecv $funcname\n";
|
|
# Synchronously call the desired function
|
|
my @res;
|
|
if($funcname eq "runner_clearlocks") {
|
|
@res = runner_clearlocks(@$argsarrayref);
|
|
}
|
|
elsif($funcname eq "runner_shutdown") {
|
|
runner_shutdown(@$argsarrayref);
|
|
# Special case: no response
|
|
return 1;
|
|
}
|
|
elsif($funcname eq "runner_stopservers") {
|
|
@res = runner_stopservers(@$argsarrayref);
|
|
}
|
|
elsif($funcname eq "runner_test_preprocess") {
|
|
@res = runner_test_preprocess(@$argsarrayref);
|
|
}
|
|
elsif($funcname eq "runner_test_run") {
|
|
@res = runner_test_run(@$argsarrayref);
|
|
} else {
|
|
die "Unknown IPC function $funcname\n";
|
|
}
|
|
# print "ipcrecv results\n";
|
|
|
|
# Marshall the results to return
|
|
$buf = freeze \@res;
|
|
|
|
syswrite($runnerw, (pack "L", length($buf)) . $buf);
|
|
|
|
return 0;
|
|
}
|
|
|
|
###################################################################
|
|
# Kill the server processes that still have lock files in a directory
|
|
sub runner_clearlocks {
|
|
my ($lockdir)=@_;
|
|
if(clearlogs()) {
|
|
logmsg "Warning: log messages were lost\n";
|
|
}
|
|
clearlocks($lockdir);
|
|
return clearlogs();
|
|
}
|
|
|
|
|
|
###################################################################
|
|
# Kill all server processes
|
|
sub runner_stopservers {
|
|
my $error = stopservers($verbose);
|
|
my $logs = clearlogs();
|
|
return ($error, $logs);
|
|
}
|
|
|
|
###################################################################
|
|
# Shut down this runner
|
|
sub runner_shutdown {
|
|
close($runnerr);
|
|
undef $runnerr;
|
|
close($runnerw);
|
|
undef $runnerw;
|
|
}
|
|
|
|
|
|
1;
|