Newer
Older
Daniel Stenberg
committed
#######################################################################
# start the ftps server (or rather, tunnel)
#
sub runftpsserver {
my ($verbose, $ipv6) = @_;
my $STATUS;
my $RUNNING;
my $ip = $HOSTIP;
my $pidfile = $FTPSPIDFILE;
if(!$stunnel) {
return 0;
}
if($ipv6) {
# not complete yet
$ip = $HOST6IP;
}
# don't retry if the server doesn't work
if ($doesntrun{$pidfile}) {
return (0,0);
}
my $pid = checkserver($pidfile);
if($pid > 0) {
# kill previous stunnel!
stopserver($pid);
}
unlink($pidfile);
my $flag=$debugprotocol?"-v ":"";
my $cmd="$perl $srcdir/httpsserver.pl $flag -p ftps -s \"$stunnel\" -d $srcdir -r $FTPPORT $FTPSPORT";
my ($ftpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
if($ftpspid <= 0 || !kill(0, $ftpspid)) {
# it is NOT alive
logmsg "RUN: failed to start the FTPS server\n";
stopservers($verbose);
$doesntrun{$pidfile} = 1;
return(0,0);
}
# Server is up. Verify that we can speak to it.
my $pid3 = verifyserver("ftps", $ip, $FTPSPORT);
if(!$pid3) {
logmsg "RUN: FTPS server failed verification\n";
# failed to talk to it properly. Kill the server and return failure
stopserver("$ftpspid $pid2");
$doesntrun{$pidfile} = 1;
return (0,0);
}
# Here pid3 is actually the pid returned by the unsecure-ftp server.
if($verbose) {
logmsg "RUN: FTPS server is now running PID $ftpspid\n";
}
sleep(1);
return ($ftpspid, $pid2);
}
#######################################################################
# start the tftp server
#
sub runtftpserver {
my ($id, $verbose, $ipv6) = @_;
my $port = $TFTPPORT;
# check for pidfile
my $pidfile = $TFTPPIDFILE;
my $ip=$HOSTIP;
my $nameext;
my $cmd;
if($ipv6) {
# if IPv6, use a different setup
$pidfile = $TFTP6PIDFILE;
$port = $TFTP6PORT;
$ip = $HOST6IP;
$nameext="-ipv6";
}
# don't retry if the server doesn't work
if ($doesntrun{$pidfile}) {
return (0,0);
}
if($pid > 0) {
unlink($pidfile);
# start our server:
my $flag=$debugprotocol?"-v ":"";
$flag .= "-s \"$srcdir\" ";
if($id) {
$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";
stopserver("$pid2");
$doesntrun{$pidfile} = 1;
return (0,0);
}
# Server is up. Verify that we can speak to it.
my $pid3 = verifyserver("tftp", $ip, $port);
if(!$pid3) {
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;
$pid2 = $pid3;
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 $socksport = $SOCKSPORT;
my $pidfile = $SSHPIDFILE;
# don't retry if the server doesn't work
if ($doesntrun{$pidfile}) {
return (0,0);
}
my $pid = checkserver($pidfile);
if($pid > 0) {
stopserver($pid);
}
unlink($pidfile);
my $flag=$verbose?'-v ':'';
$flag .= '-d ' if($debugprotocol);
my $cmd="$perl $srcdir/sshserver.pl ${flag}-u $USER -l $ip -p $port -s $socksport";
my ($sshpid, $pid2) = startnew($cmd, $pidfile, 60, 0);
# on loaded systems sshserver start up can take longer than the timeout
# passed to startnew, when this happens startnew completes without being
# able to read the pidfile and consequently returns a zero pid2 above.
if($sshpid <= 0 || !kill(0, $sshpid)) {
# it is NOT alive
logmsg "RUN: failed to start the SSH server\n";
$doesntrun{$pidfile} = 1;
return (0,0);
}
# ssh server verification allows some extra time for the server to start up
# and gives us the opportunity of recovering the pid from the pidfile, when
# this verification succeeds the recovered pid is assigned to pid2.
my $pid3 = verifyserver("ssh",$ip,$port);
if(!$pid3) {
logmsg "RUN: SSH server failed verification\n";
# failed to fetch server pid. Kill the server and return failure
stopserver("$sshpid $pid2");
$doesntrun{$pidfile} = 1;
return (0,0);
}
$pid2 = $pid3;
# once it is known that the ssh server is alive, sftp server verification
# is performed actually connecting to it, authenticating and performing a
# very simple remote command. This verification is tried only one time.
if(verifysftp("sftp",$ip,$port) < 1) {
logmsg "RUN: SFTP server failed verification\n";
# failed to talk to it properly. Kill the server and return failure
display_sftplog();
display_sftpconfig();
display_sshdlog();
display_sshdconfig();
stopserver("$sshpid $pid2");
$doesntrun{$pidfile} = 1;
return (0,0);
}
if($verbose) {
logmsg "RUN: SSH server is now running PID $pid2\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}) {
return (0,0);
}
my $pid = checkserver($pidfile);
if($pid > 0) {
stopserver($pid);
}
unlink($pidfile);
# The ssh server must be already running
if(!$run{'ssh'}) {
logmsg "RUN: SOCKS server cannot find running SSH server\n";
$doesntrun{$pidfile} = 1;
return (0,0);
}
# Find out ssh daemon canonical file name
my $sshd = find_sshd();
if(!$sshd) {
logmsg "RUN: SOCKS server cannot find $sshdexe\n";
$doesntrun{$pidfile} = 1;
return (0,0);
}
# Find out ssh daemon version info
($sshdid, $sshdvernum, $sshdverstr, $sshderror) = sshversioninfo($sshd);
if(!$sshdid) {
# Not an OpenSSH or SunSSH ssh daemon
logmsg "$sshderror\n" if($verbose);
logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
$doesntrun{$pidfile} = 1;
return (0,0);
}
logmsg "ssh server found $sshd is $sshdverstr\n" if($verbose);
# Find out ssh client canonical file name
my $ssh = find_ssh();
if(!$ssh) {
logmsg "RUN: SOCKS server cannot find $sshexe\n";
$doesntrun{$pidfile} = 1;
return (0,0);
}
# Find out ssh client version info
my ($sshid, $sshvernum, $sshverstr, $ssherror) = sshversioninfo($ssh);
if(!$sshid) {
# Not an OpenSSH or SunSSH ssh client
logmsg "$ssherror\n" if($verbose);
logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
$doesntrun{$pidfile} = 1;
return (0,0);
}
# Verify minimum ssh client version
if((($sshid =~ /OpenSSH/) && ($sshvernum < 299)) ||
(($sshid =~ /SunSSH/) && ($sshvernum < 100))) {
logmsg "ssh client found $ssh is $sshverstr\n";
logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
$doesntrun{$pidfile} = 1;
return (0,0);
}
logmsg "ssh client found $ssh is $sshverstr\n" if($verbose);
# Verify if ssh client and ssh daemon versions match
if(($sshdid ne $sshid) || ($sshdvernum != $sshvernum)) {
# Our test harness might work with slightly mismatched versions
logmsg "Warning: version mismatch: sshd $sshdverstr - ssh $sshverstr\n"
if($verbose);
}
# Config file options for ssh client are previously set from sshserver.pl
if(! -e $sshconfig) {
logmsg "RUN: SOCKS server cannot find $sshconfig\n";
$doesntrun{$pidfile} = 1;
return (0,0);
}
# start our socks server
my $cmd="$ssh -N -F $sshconfig $ip > $sshlog 2>&1";
my ($sshpid, $pid2) = startnew($cmd, $pidfile, 30, 1);
if($sshpid <= 0 || !kill(0, $sshpid)) {
# it is NOT alive
logmsg "RUN: failed to start the SOCKS server\n";
display_sshlog();
display_sshconfig();
display_sshdlog();
display_sshdconfig();
$doesntrun{$pidfile} = 1;
return (0,0);
}
# Ugly hack but ssh doesn't support pid files
my $pid3 = verifyserver("socks",$ip,$port);
if(!$pid3) {
logmsg "RUN: SOCKS server failed verification\n";
# failed to talk to it properly. Kill the server and return failure
stopserver("$sshpid $pid2");
$doesntrun{$pidfile} = 1;
return (0,0);
}
$pid2 = $pid3;
if($verbose) {
logmsg "RUN: SOCKS server is now running PID $pid2\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;
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
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'} = "$LOGDIR/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;
}
if(!$why) {
my @keywords = getpart("info", "keywords");
my $k;
for $k (@keywords) {
chomp $k;
if ($disabled_keywords{$k}) {
$why = "disabled by keyword";
}
}
}
if(!$why) {
$why = serverfortest($testnum);
}
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);
}
# create a (possibly-empty) file before starting the test
my @inputfile=getpart("client", "file");
my %fileattr = getpartattr("client", "file");
my $filename=$fileattr{'name'};
if(@inputfile || $filename) {
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 ";
Yang Tse
committed
my $serverlogslocktimeout = $defserverlogslocktimeout;
if($cmdhash{'timeout'}) {
# test is allowed to override default server logs lock timeout
if($cmdhash{'timeout'} =~ /(\d+)/) {
$serverlogslocktimeout = $1 if($1 >= 0);
}
}