Newer
Older
if($pid > 0) {
unlink($pidfile);
Daniel Stenberg
committed
# start our server:
$flag.=$debugprotocol?"-v ":"";
Daniel Stenberg
committed
$flag .= "-s \"$srcdir\" ";
Daniel Stenberg
committed
if($id) {
$flag .="--id $id ";
}
Daniel Stenberg
committed
if($ipv6) {
$flag .="--ipv6 ";
$addr = $HOST6IP;
} else {
$addr = $HOSTIP;
Daniel Stenberg
committed
}
$cmd="$perl $srcdir/ftpserver.pl --pidfile $pidfile $flag --port $port --addr \"$addr\"";
my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
if($ftppid <= 0 || !kill(0, $ftppid)) {
logmsg "RUN: failed to start the $proto$id$nameext server\n";
stopserver("$pid2");
displaylogs($testnumcheck);
$doesntrun{$pidfile} = 1;
return (0,0);
}
Daniel Stenberg
committed
# Server is up. Verify that we can speak to it.
my $pid3 = verifyserver($proto, $ip, $port);
if(!$pid3) {
logmsg "RUN: $proto$id$nameext server failed verification\n";
# failed to talk to it properly. Kill the server and return failure
stopserver("$ftppid $pid2");
displaylogs($testnumcheck);
$doesntrun{$pidfile} = 1;
Daniel Stenberg
committed
}
$pid2 = $pid3;
Daniel Stenberg
committed
if($verbose) {
logmsg "RUN: $proto$id$nameext server is now running PID $ftppid\n";
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);
}
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);
displaylogs($testnumcheck);
$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");
displaylogs($testnumcheck);
$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");
displaylogs($testnumcheck);
$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");
displaylogs($testnumcheck);
$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);
}
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);
}
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;
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
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 =~ /TrackMemory/i) {
# curl was built with --enable-curldebug (memory tracking)
$curl_debug = 1;
}
if($feat =~ /debug/i) {
# curl was built with --enable-debug
$debug_build = 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($feat =~ /CharConv/i) {
# CharConv enabled
$has_charconv=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";
}
Guenter Knauf
committed
if(-r "../lib/curl_config.h") {
open(CONF, "<../lib/curl_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 built with curldebug";
# 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: %8s", $stunnel?"ON ":"OFF");
logmsg sprintf(" libcurl SSL: %s\n", $ssl_version?"ON ":"OFF");
logmsg sprintf("* debug build: %8s", $debug_build?"ON ":"OFF");
logmsg sprintf(" track memory: %s\n", $curl_debug?"ON ":"OFF");
logmsg sprintf("* valgrind: %8s", $valgrind?"ON ":"OFF");
logmsg sprintf(" HTTP IPv6 %s\n", $http_ipv6?"ON ":"OFF");
logmsg sprintf("* FTP IPv6 %8s", $ftp_ipv6?"ON ":"OFF");
logmsg sprintf(" Libtool lib: %s\n", $libtool?"ON ":"OFF");
if($ssl_version) {
logmsg sprintf("* SSL library: %s\n", $ssllib);
}
logmsg "* Ports:\n";
logmsg sprintf("* HTTP/%d ", $HTTPPORT);
logmsg sprintf("FTP/%d ", $FTPPORT);
logmsg sprintf("FTP2/%d ", $FTP2PORT);
Daniel Stenberg
committed
if($stunnel) {
logmsg sprintf("FTPS/%d ", $FTPSPORT);
logmsg sprintf("HTTPS/%d ", $HTTPSPORT);
logmsg sprintf("\n* TFTP/%d ", $TFTPPORT);
logmsg sprintf("HTTP-IPv6/%d ", $HTTP6PORT);
Daniel Stenberg
committed
}
Daniel Stenberg
committed
if($ftp_ipv6) {
logmsg sprintf("FTP-IPv6/%d ", $FTP6PORT);
Daniel Stenberg
committed
}
logmsg sprintf("TFTP-IPv6/%d ", $TFTP6PORT);
logmsg sprintf("\n* SSH/%d ", $SSHPORT);
logmsg sprintf("SOCKS/%d ", $SOCKSPORT);
logmsg sprintf("POP3/%d ", $POP3PORT);
logmsg sprintf("IMAP/%d ", $IMAPPORT);
logmsg sprintf("SMTP/%d\n", $SMTPPORT);
$has_textaware = ($^O eq 'MSWin32') || ($^O eq 'msys');
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/%POP3PORT/$POP3PORT/g;
$$thing =~ s/%IMAPPORT/$IMAPPORT/g;
$$thing =~ s/%SMTPPORT/$SMTPPORT/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;
Yang Tse
committed
# copy test number to a global scope var, this allows
# testnum checking when starting test harness servers.
$testnumcheck = $testnum;
# 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") {
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 $match;
my $k;
for $k (@keywords) {
chomp $k;
if ($disabled_keywords{$k}) {
$why = "disabled by keyword";
} elsif ($enabled_keywords{$k}) {
$match = 1;
if(!$why && !$match && %enabled_keywords) {
$why = "disabled by missing 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;
} elsif($?) {
$why = "precheck command error";
Daniel Stenberg
committed
}
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="";