Newer
Older
$flag .="--id $id ";
}
if($ipv6) {
$flag .="--ipv6 ";
}
$cmd="./server/tftpd --pidfile $pidfile $flag $port";
my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
if($tftppid <= 0 || !kill(0, $tftppid)) {
logmsg "RUN: failed to start the TFTP$id$nameext server\n";
$doesntrun{$pidfile} = 1;
return (0,0);
}
# Server is up. Verify that we can speak to it.
if(!verifyserver("tftp", $ip, $port)) {
logmsg "RUN: TFTP$id$nameext server failed verification\n";
# failed to talk to it properly. Kill the server and return failure
stopserver("$tftppid $pid2");
$doesntrun{$pidfile} = 1;
logmsg "RUN: TFTP$id$nameext server is now running PID $tftppid\n";
#######################################################################
# Start the scp/sftp server
#
sub runsshserver {
my ($id, $verbose, $ipv6) = @_;
my $ip=$HOSTIP;
my $port = $SSHPORT;
my $pidfile = $SSHPIDFILE;
# don't retry if the server doesn't work
if ($doesntrun{$pidfile}) {
logmsg "TRACESSH:runsshserver: ssh server previously failed to start with pidfile: $pidfile\n";
return (0,0);
}
my $pid = checkserver($pidfile);
logmsg "TRACESSH:runsshserver: checkserver on pidfile: $pidfile returns pid: $pid\n";
if($pid > 0) {
stopserver($pid);
}
my $flag=$debugprotocol?"-v ":"";
my $cmd="$perl $srcdir/sshserver.pl $flag-u $USER -l $HOSTIP -d $srcdir $port";
logmsg "TRACESSH:runsshserver: calling startnew with cmd: $cmd\n";
my ($sshpid, $pid2) =
startnew($cmd, $pidfile, 60, 0); # start the server in a new process
logmsg "TRACESSH:runsshserver: startnew returns sshpid: $sshpid pid2: $pid2\n";
if($sshpid <= 0 || !kill(0, $sshpid)) {
# it is NOT alive
logmsg "RUN: failed to start the SSH server\n";
# failed to talk to it properly. Kill the server and return failure
logmsg "TRACESSH:runsshserver: calling stopserver with sshpid: $sshpid pid2: $pid2\n";
stopserver("$sshpid $pid2");
$doesntrun{$pidfile} = 1;
logmsg "TRACESSH:runsshserver: later dont try to start a server with pidfile: $pidfile\n";
return (0,0);
}
if (!verifyserver('ssh',$ip,$port)) {
logmsg "RUN: SSH server failed verification\n";
logmsg "TRACESSH:runsshserver: BUT It seems that we are letting sshpid: $sshpid pid2: $pid2 alive\n";
$doesntrun{$pidfile} = 1;
logmsg "TRACESSH:runsshserver: later dont try to start a server with pidfile: $pidfile\n";
return (0,0);
}
if($verbose) {
logmsg "RUN: SSH server is now running PID $sshpid\n";
}
return ($pid2, $sshpid);
}
#######################################################################
# Start the socks server
#
sub runsocksserver {
my ($id, $verbose, $ipv6) = @_;
my $ip=$HOSTIP;
my $port = $SOCKSPORT;
my $pidfile = $SOCKSPIDFILE;
# don't retry if the server doesn't work
if ($doesntrun{$pidfile}) {
logmsg "TRACESSH:runsocksserver: socks server previously failed to start with pidfile: $pidfile\n";
return (0,0);
}
my $flag=$debugprotocol?"-v ":"";
Yang Tse
committed
my $cmd="ssh -D $SOCKSPORT -N -F curl_ssh_config ${USER}\@${HOSTIP} -p ${SSHPORT} -vv >log/ssh.log 2>&1";
logmsg "TRACESSH:runsocksserver: calling startnew with cmd: $cmd\n";
my ($sshpid, $pid2) =
startnew($cmd, $pidfile, 15, 1); # start the server in a new process
logmsg "TRACESSH:runsocksserver: startnew returns sshpid: $sshpid pid2: $pid2\n";
if($sshpid <= 0 || !kill(0, $sshpid)) {
# it is NOT alive
logmsg "RUN: failed to start the SOCKS server\n";
# failed to talk to it properly. Kill the server and return failure
logmsg "=== Start of file log/ssh.log\n";
displaylogcontent("log/ssh.log");
logmsg "=== End of file log/ssh.log\n";
logmsg "TRACESSH:runsocksserver: calling stopserver with sshpid: $sshpid pid2: $pid2\n";
stopserver("$sshpid $pid2");
$doesntrun{$pidfile} = 1;
logmsg "TRACESSH:runsocksserver: later dont try to start a server with pidfile: $pidfile\n";
return (0,0);
}
# Ugly hack but ssh doesn't support pid files
if (!verifyserver('socks',$ip,$port)) {
logmsg "RUN: SOCKS server failed verification\n";
$doesntrun{$pidfile} = 1;
logmsg "TRACESSH:runsocksserver: later dont try to start a server with pidfile: $pidfile\n";
return (0,0);
}
if($verbose) {
logmsg "RUN: SOCKS server is now running PID $sshpid\n";
}
return ($pid2, $sshpid);
}
#######################################################################
# Remove all files in the specified directory
#
sub cleardir {
my $dir = $_[0];
my $count;
# Get all files
opendir(DIR, $dir) ||
return 0; # can't open dir
while($file = readdir(DIR)) {
if($file !~ /^\./) {
unlink("$dir/$file");
$count++;
}
}
closedir DIR;
return $count;
}
#######################################################################
# filter out the specified pattern from the given input file and store the
# results in the given output file
#
sub filteroff {
my $infile=$_[0];
my $filter=$_[1];
my $ofile=$_[2];
open(IN, "<$infile")
open(OUT, ">$ofile")
# logmsg "FILTER: off $filter from $infile to $ofile\n";
close(IN);
close(OUT);
#######################################################################
# compare test results with the expected output, we might filter off
# some pattern that is allowed to differ, output test results
#
# filter off patterns _before_ this comparison!
my ($subject, $firstref, $secondref)=@_;
my $result = compareparts($firstref, $secondref);
if($result) {
if(!$short) {
logmsg "\n $subject FAILED:\n";
logmsg showdiff($LOGDIR, $firstref, $secondref);
}
else {
logmsg "FAILED\n";
#######################################################################
# display information about curl and the host the test suite runs on
#
sub checksystem {
unlink($memdump); # remove this if there was one left
my $curl;
my $libcurl;
my $versretval;
my $versnoexec;
my @version=();
my $curlverout="$LOGDIR/curlverout.log";
my $curlvererr="$LOGDIR/curlvererr.log";
my $versioncmd="$CURL --version 1>$curlverout 2>$curlvererr";
unlink($curlverout);
unlink($curlvererr);
$versretval = runclient($versioncmd);
$versnoexec = $!;
open(VERSOUT, "<$curlverout");
@version = <VERSOUT>;
close(VERSOUT);
for(@version) {
chomp;
if($_ =~ /^curl/) {
$curl = $_;
$curl =~ s/^(.*)(libcurl.*)/$1/g;
$libcurl = $2;
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
if($curl =~ /mingw32/) {
# This is a windows minw32 build, we need to translate the
# given path to the "actual" windows path.
my @m = `mount`;
my $matchlen;
my $bestmatch;
my $mount;
# example mount output:
# C:\DOCUME~1\Temp on /tmp type user (binmode,noumount)
# c:\ActiveState\perl on /perl type user (binmode)
# C:\msys\1.0\bin on /usr/bin type user (binmode,cygexec,noumount)
# C:\msys\1.0\bin on /bin type user (binmode,cygexec,noumount)
foreach $mount (@m) {
if( $mount =~ /(.*) on ([^ ]*) type /) {
my ($mingw, $real)=($2, $1);
if($pwd =~ /^$mingw/) {
# the path we got from pwd starts with the path
# we found on this line in the mount output
my $len = length($real);
if($len > $matchlen) {
# we remember the match that is the longest
$matchlen = $len;
$bestmatch = $real;
}
}
}
}
if(!$matchlen) {
logmsg "Serious error, can't find our \"real\" path\n";
}
else {
# now prepend the prefix from the mount command to build
# our "actual path"
$pwd = "$bestmatch$pwd";
}
$pwd =~ s#\\#/#g;
}
elsif ($curl =~ /win32/) {
Daniel Stenberg
committed
# Native Windows builds don't understand the
# output of cygwin's pwd. It will be
# something like /cygdrive/c/<some path>.
#
# Use the cygpath utility to convert the
# working directory to a Windows friendly
# path. The -m option converts to use drive
# letter:, but it uses / instead \. Forward
# slashes (/) are easier for us. We don't
# have to escape them to get them to curl
# through a shell.
chomp($pwd = `cygpath -m $pwd`);
}
elsif ($libcurl =~ /openssl/i) {
Daniel Stenberg
committed
$ssllib="OpenSSL";
elsif ($libcurl =~ /gnutls/i) {
Daniel Stenberg
committed
$ssllib="GnuTLS";
elsif ($libcurl =~ /nss/i) {
$has_nss=1;
Daniel Stenberg
committed
$ssllib="NSS";
}
elsif ($libcurl =~ /yassl/i) {
$has_yassl=1;
$has_openssl=1;
$ssllib="yassl";
}
}
elsif($_ =~ /^Protocols: (.*)/i) {
# these are the protocols compiled in to this libcurl
@protocols = split(' ', $1);
# Generate a "proto-ipv6" version of each protocol to match the
# IPv6 <server> name. This works even if IPv6 support isn't
# compiled in because the <features> test will fail.
push @protocols, map($_ . "-ipv6", @protocols);
# 'none' is used in test cases to mean no server
push @protocols, ('none');
}
elsif($_ =~ /^Features: (.*)/i) {
if($feat =~ /debug/i) {
# debug is a listed "feature", use that knowledge
$curl_debug = 1;
# set the NETRC debug env
$ENV{'CURL_DEBUG_NETRC'} = 'log/netrc';
}
if($feat =~ /SSL/i) {
# ssl enabled
$ssl_version=1;
}
if($feat =~ /Largefile/i) {
# large file support
$large_file=1;
}
Daniel Stenberg
committed
if($feat =~ /IDN/i) {
# IDN support
$has_idn=1;
}
if($feat =~ /libz/i) {
$has_libz = 1;
}
Daniel Stenberg
committed
if($feat =~ /NTLM/i) {
# NTLM enabled
$has_ntlm=1;
}
}
}
if(!$curl) {
logmsg "unable to get curl's version, further details are:\n";
logmsg "issued command: \n";
logmsg "$versioncmd \n";
if ($versretval == -1) {
logmsg "command failed with: \n";
logmsg "$versnoexec \n";
}
elsif ($versretval & 127) {
logmsg sprintf("command died with signal %d, and %s coredump.\n",
($versretval & 127), ($versretval & 128)?"a":"no");
}
else {
logmsg sprintf("command exited with value %d \n", $versretval >> 8);
}
logmsg "contents of $curlverout: \n";
displaylogcontent("$curlverout");
logmsg "contents of $curlvererr: \n";
displaylogcontent("$curlvererr");
die "couldn't get curl's version";
}
if(-r "../lib/config.h") {
open(CONF, "<../lib/config.h");
if($_ =~ /^\#define HAVE_GETRLIMIT/) {
$has_getrlimit = 1;
}
}
}
Daniel Stenberg
committed
# client has ipv6 support
# check if the HTTP server has it!
my @sws = `server/sws --version`;
if($sws[0] =~ /IPv6/) {
# HTTP server has ipv6 support!
$http_ipv6 = 1;
}
Daniel Stenberg
committed
# check if the FTP server has it!
@sws = `server/sockfilt --version`;
Daniel Stenberg
committed
if($sws[0] =~ /IPv6/) {
# FTP server has ipv6 support!
$ftp_ipv6 = 1;
}
if(!$curl_debug && $torture) {
die "can't run torture tests since curl was not build with debug";
}
# curl doesn't list cryptographic support separately, so assume it's
# always available
$has_crypto=1;
my $hostname=join(' ', runclientoutput("hostname"));
my $hosttype=join(' ', runclientoutput("uname -a"));
logmsg ("********* System characteristics ******** \n",
"* $curl\n",
"* $libcurl\n",
"* System: $hosttype");
logmsg sprintf("* Server SSL: %s\n", $stunnel?"ON":"OFF");
logmsg sprintf("* libcurl SSL: %s\n", $ssl_version?"ON":"OFF");
logmsg sprintf("* libcurl debug: %s\n", $curl_debug?"ON":"OFF");
logmsg sprintf("* valgrind: %s\n", $valgrind?"ON":"OFF");
logmsg sprintf("* HTTP IPv6 %s\n", $http_ipv6?"ON":"OFF");
logmsg sprintf("* FTP IPv6 %s\n", $ftp_ipv6?"ON":"OFF");
logmsg sprintf("* HTTP port: %d\n", $HTTPPORT);
logmsg sprintf("* FTP port: %d\n", $FTPPORT);
logmsg sprintf("* FTP port 2: %d\n", $FTP2PORT);
Daniel Stenberg
committed
if($stunnel) {
logmsg sprintf("* FTPS port: %d\n", $FTPSPORT);
logmsg sprintf("* HTTPS port: %d\n", $HTTPSPORT);
logmsg sprintf("* HTTP IPv6 port: %d\n", $HTTP6PORT);
Daniel Stenberg
committed
}
Daniel Stenberg
committed
if($ftp_ipv6) {
logmsg sprintf("* FTP IPv6 port: %d\n", $FTP6PORT);
Daniel Stenberg
committed
}
logmsg sprintf("* TFTP port: %d\n", $TFTPPORT);
if($tftp_ipv6) {
logmsg sprintf("* TFTP IPv6 port: %d\n", $TFTP6PORT);
}
logmsg sprintf("* SCP/SFTP port: %d\n", $SSHPORT);
logmsg sprintf("* SOCKS port: %d\n", $SOCKSPORT);
if($ssl_version) {
logmsg sprintf("* SSL library: %s\n", $ssllib);
$has_textaware = ($^O eq 'MSWin32') || ($^O eq 'msys');
logmsg sprintf("* Libtool lib: %s\n", $libtool?"ON":"OFF");
logmsg "***************************************** \n";
#######################################################################
# substitute the variable stuff into either a joined up file or
# a command, in either case passed by reference
#
sub subVariables {
my ($thing) = @_;
$$thing =~ s/%HOSTIP/$HOSTIP/g;
Daniel Stenberg
committed
$$thing =~ s/%HTTPPORT/$HTTPPORT/g;
$$thing =~ s/%HOST6IP/$HOST6IP/g;
$$thing =~ s/%HTTP6PORT/$HTTP6PORT/g;
$$thing =~ s/%HTTPSPORT/$HTTPSPORT/g;
$$thing =~ s/%FTPPORT/$FTPPORT/g;
Daniel Stenberg
committed
$$thing =~ s/%FTP6PORT/$FTP6PORT/g;
Daniel Stenberg
committed
$$thing =~ s/%FTP2PORT/$FTP2PORT/g;
$$thing =~ s/%FTPSPORT/$FTPSPORT/g;
$$thing =~ s/%SRCDIR/$srcdir/g;
$$thing =~ s/%PWD/$pwd/g;
$$thing =~ s/%TFTPPORT/$TFTPPORT/g;
$$thing =~ s/%TFTP6PORT/$TFTP6PORT/g;
$$thing =~ s/%SSHPORT/$SSHPORT/g;
$$thing =~ s/%SOCKSPORT/$SOCKSPORT/g;
$$thing =~ s/%CURL/$CURL/g;
$$thing =~ s/%USER/$USER/g;
$$thing =~ s/%CLIENTIP/$CLIENTIP/g;
$$thing =~ s/%CLIENT6IP/$CLIENT6IP/g;
Daniel Stenberg
committed
# The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be
# used for time-out tests and that whould work on most hosts as these
# adjust for the startup/check time for this particular host. We needed
# to do this to make the test suite run better on very slow hosts.
my $ftp2 = $ftpchecktime * 2;
my $ftp3 = $ftpchecktime * 3;
$$thing =~ s/%FTPTIME2/$ftp2/g;
$$thing =~ s/%FTPTIME3/$ftp3/g;
Daniel Stenberg
committed
sub fixarray {
my @in = @_;
for(@in) {
subVariables \$_;
}
return @in;
}
#######################################################################
# Run a single specified test case
#
my ($testnum, $count, $total)=@_;
my @what;
my $why;
Daniel Stenberg
committed
my %feature;
Daniel Stenberg
committed
my $cmd;
# load the test case file definition
if(loadtest("${TESTDIR}/test${testnum}")) {
if($verbose) {
# this is not a test
logmsg "RUN: $testnum doesn't look like a test case\n";
Daniel Stenberg
committed
$why = "no test";
}
else {
@what = getpart("client", "features");
for(@what) {
my $f = $_;
$f =~ s/\s//g;
Daniel Stenberg
committed
$feature{$f}=$f; # we require this feature
if($f eq "SSL") {
if($ssl_version) {
next;
}
}
elsif($f eq "OpenSSL") {
if($has_openssl) {
next;
}
}
elsif($f eq "GnuTLS") {
if($has_gnutls) {
next;
}
}
elsif($f eq "NSS") {
if($has_nss) {
next;
}
}
elsif($f eq "netrc_debug") {
if($curl_debug) {
next;
}
}
elsif($f eq "large_file") {
if($large_file) {
next;
}
}
Daniel Stenberg
committed
elsif($f eq "idn") {
if($has_idn) {
next;
}
}
elsif($f eq "ipv6") {
if($has_ipv6) {
next;
}
}
elsif($f eq "libz") {
if($has_libz) {
next;
}
}
Daniel Stenberg
committed
elsif($f eq "NTLM") {
if($has_ntlm) {
next;
}
}
elsif($f eq "getrlimit") {
if($has_getrlimit) {
next;
}
}
elsif($f eq "crypto") {
if($has_crypto) {
next;
}
}
elsif($f eq "socks") {
next;
}
# See if this "feature" is in the list of supported protocols
elsif (grep /^$f$/, @protocols) {
next;
}
Daniel Stenberg
committed
$why = "curl lacks $f support";
last;
}
Daniel Stenberg
committed
if(!$why) {
$why = serverfortest($testnum);
}
if(!$why) {
my @keywords = getpart("info", "keywords");
my $k;
for $k (@keywords) {
chomp $k;
if ($disabled_keywords{$k}) {
$why = "disabled by keyword";
}
}
}
Daniel Stenberg
committed
if(!$why) {
Daniel Stenberg
committed
my @precheck = getpart("client", "precheck");
Daniel Stenberg
committed
$cmd = $precheck[0];
Daniel Stenberg
committed
chomp $cmd;
subVariables \$cmd;
Daniel Stenberg
committed
if($cmd) {
my @o = `$cmd 2>/dev/null`;
Daniel Stenberg
committed
if($o[0]) {
$why = $o[0];
chomp $why;
}
logmsg "prechecked $cmd\n" if($verbose);
Daniel Stenberg
committed
}
}
Daniel Stenberg
committed
# there's a problem, count it as "skipped"
$skipped++;
$skipped{$why}++;
$teststat[$testnum]=$why; # store reason for this test case
if(!$short) {
Daniel Stenberg
committed
printf "test %03d SKIPPED: $why\n", $testnum;
}
return -1;
}
logmsg sprintf("test %03d...", $testnum);
# extract the reply data
my @reply = getpart("reply", "data");
my @replycheck = getpart("reply", "datacheck");
if (@replycheck) {
# we use this file instead to check the final output against
my %hash = getpartattr("reply", "datacheck");
if($hash{'nonewline'}) {
# Yes, we must cut off the final newline from the final line
# of the datacheck
chomp($replycheck[$#replycheck]);
}
Daniel Stenberg
committed
my @curlcmd= fixarray ( getpart("client", "command") );
# this is the valid protocol blurb curl should generate
Daniel Stenberg
committed
my @protocol= fixarray ( getpart("verify", "protocol") );
# redirected stdout/stderr to these files
$STDOUT="$LOGDIR/stdout$testnum";
$STDERR="$LOGDIR/stderr$testnum";
# if this section exists, we verify that the stdout contained this:
Daniel Stenberg
committed
my @validstdout = fixarray ( getpart("verify", "stdout") );
# if this section exists, we verify upload
my @upload = getpart("verify", "upload");
# if this section exists, it might be FTP server instructions:
my @ftpservercmd = getpart("reply", "servercmd");
my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout
my @testname= getpart("client", "name");
if(!$short) {
my $name = $testname[0];
$name =~ s/\n//g;
logmsg "[$name]\n";
}
if($listonly) {
return 0; # look successful
}
my @codepieces = getpart("client", "tool");
my $tool="";
if(@codepieces) {
$tool = $codepieces[0];
chomp $tool;
}
Daniel Stenberg
committed
# remove server output logfiles
Daniel Stenberg
committed
unlink($SERVER2IN);
if(@ftpservercmd) {
# write the instructions to file
writearray($FTPDCMD, \@ftpservercmd);
}
my (@setenv)= getpart("client", "setenv");
my @envs;
my $s;
for $s (@setenv) {
chomp $s; # cut off the newline
subVariables \$s;
if($s =~ /([^=]*)=(.*)/) {
my ($var, $content)=($1, $2);
$ENV{$var}=$content;
# remember which, so that we can clear them afterwards!
push @envs, $var;
}
}
Daniel Stenberg
committed
my @blaha;
($cmd, @blaha)= getpart("client", "command");
# make some nice replace operations
$cmd =~ s/\n//g; # no newlines please
if($curl_debug) {
unlink($memdump);
}
my @inputfile=getpart("client", "file");
if(@inputfile) {
# we need to generate a file before this test is invoked
Daniel Stenberg
committed
my %fileattr = getpartattr("client", "file");
Daniel Stenberg
committed
my $filename=$fileattr{'name'};
logmsg "ERROR: section client=>file has no name attribute\n";
my $fileContent = join('', @inputfile);
subVariables \$fileContent;
# logmsg "DEBUG: writing file " . $filename . "\n";
open(OUTFILE, ">$filename");
binmode OUTFILE; # for crapage systems, use binary
print OUTFILE $fileContent;
close(OUTFILE);
my %cmdhash = getpartattr("client", "command");
if($cmdhash{'option'} !~ /no-output/) {
#We may slap on --output!
$out=" --output $CURLOUT ";
my $cmdargs;
if(!$tool) {
# run curl, add -v for debug information output
$cmdargs ="$out --include -v --trace-time $cmd";
}
else {
$cmdargs = " $cmd"; # $cmd is the command line for the test file
$CURLOUT = $STDOUT; # sends received data to stdout
}
my @stdintest = getpart("client", "stdin");
if(@stdintest) {
my $stdinfile="$LOGDIR/stdin-for-$testnum";
writearray($stdinfile, \@stdintest);
$cmdargs .= " <$stdinfile";
if(!$tool) {
$CMDLINE="$CURL";
else {
$CMDLINE="$LIBDIR/$tool";
if(! -f $CMDLINE) {
print "The tool set in the test case for this: '$tool' does not exist\n";
return -1;
}
my $usevalgrind = $valgrind && ((getpart("verify", "valgrind"))[0] !~ /disable/);
if($usevalgrind) {
Daniel Stenberg
committed
$CMDLINE = "$valgrind ".$valgrind_tool."--leak-check=yes --num-callers=16 ${valgrind_logfile}=log/valgrind$testnum $CMDLINE";
}
logmsg "$CMDLINE\n";
Daniel Stenberg
committed
}
print CMDLOG "$CMDLINE\n";
Daniel Stenberg
committed
unlink("core");
my $dumped_core;
my $cmdres;
# Apr 2007: precommand isn't being used and could be removed
my @precommand= getpart("client", "precommand");
if($precommand[0]) {
# this is pure perl to eval!
my $code = join("", @precommand);
eval $code;
if($@) {
logmsg "perl: $code\n";
logmsg "precommand: $@";
open(GDBCMD, ">log/gdbcmd");
print GDBCMD "set args $cmdargs\n";
print GDBCMD "show args\n";
close(GDBCMD);
}
# run the command line we built
if ($torture) {
$cmdres = torture($CMDLINE,
"$gdb --directory libtest $DBGCURL -x log/gdbcmd");
}
elsif($gdbthis) {
runclient("$gdb --directory libtest $DBGCURL -x log/gdbcmd");
$cmdres=0; # makes it always continue after a debugged run
$cmdres = runclient("$CMDLINE");
my $signal_num = $cmdres & 127;
Daniel Stenberg
committed
$dumped_core = $cmdres & 128;
if(!$anyway && ($signal_num || $dumped_core)) {
$cmdres = 1000;
}
else {
$cmdres /= 256;
}
Daniel Stenberg
committed
if(!$dumped_core) {
if(-r "core") {
# there's core file present now!
$dumped_core = 1;
}
}
if($dumped_core) {
logmsg "core dumped\n";
logmsg "running gdb for post-mortem analysis:\n";
open(GDBCMD, ">log/gdbcmd2");
print GDBCMD "bt\n";
close(GDBCMD);
runclient("$gdb --directory libtest -x log/gdbcmd2 -batch $DBGCURL core ");
Daniel Stenberg
committed
# unlink("log/gdbcmd2");
}
}
# run the postcheck command
my @postcheck= getpart("client", "postcheck");
$cmd = $postcheck[0];
chomp $cmd;
subVariables \$cmd;
if($cmd) {
my $rc = runclient("$cmd");
logmsg " postcheck FAILED\n";
return 1;
}
logmsg "postchecked $cmd\n" if($verbose);
}
# remove the special FTP command file after each test!
unlink($FTPDCMD);
my $e;
for $e (@envs) {
$ENV{$e}=""; # clean up
}
# Skip all the verification on torture tests
if(!$cmdres && !$keepoutfiles) {
cleardir($LOGDIR);
}
return $cmdres;
}
my @err = getpart("verify", "errorcode");
my $errorcode = $err[0] || "0";
my $ok="";
my $res;
if (@validstdout) {
# verify redirected stdout
my @actual = loadarray($STDOUT);
# get all attributes
my %hash = getpartattr("verify", "stdout");
# get the mode attribute
my $filemode=$hash{'mode'};
if(($filemode eq "text") && $has_textaware) {
# text mode when running on windows: fix line endings
map s/\r\n/\n/g, @actual;
}
$res = compare("stdout", \@actual, \@validstdout);
return 1;
}
$ok .= "s";
}
else {
$ok .= "-"; # stdout not checked
my %replyattr = getpartattr("reply", "data");
Daniel Stenberg
committed
if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
# verify the received data
my @out = loadarray($CURLOUT);
my %hash = getpartattr("reply", "data");
# get the mode attribute
my $filemode=$hash{'mode'};
if(($filemode eq "text") && $has_textaware) {
# text mode when running on windows: fix line endings
map s/\r\n/\n/g, @out;
}
$res = compare("data", \@out, \@reply);
return 1;
}
$ok .= "d";
}
else {
$ok .= "-"; # data not checked
if(@upload) {
# verify uploaded data
my @out = loadarray("$LOGDIR/upload.$testnum");
$res = compare("upload", \@out, \@upload);
}
$ok .= "u";
}
else {
$ok .= "-"; # upload not checked
Daniel Stenberg
committed
my @out;
my $retry = 5;