# | (__| |_| | _ <| |___
# \___|\___/|_| \_\_____|
#
-# Copyright (C) 1998 - 2016, Daniel Stenberg, <daniel@haxx.se>, et al.
+# Copyright (C) 1998 - 2018, 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
my $HTTPPIPEPORT; # HTTP pipelining port
my $HTTPUNIXPATH; # HTTP server Unix domain socket path
my $HTTP2PORT; # HTTP/2 server port
+my $DICTPORT; # DICT server port
+my $SMBPORT; # SMB server port
+my $SMBSPORT; # SMBS server port
+my $NEGTELNETPORT; # TELNET server port with negotiation
my $srcdir = $ENV{'srcdir'} || '.';
my $CURL="../src/curl".exe_ext(); # what curl executable to run on the tests
my $start;
my $ftpchecktime=1; # time it took to verify our test FTP server
-
+my $scrambleorder;
my $stunnel = checkcmd("stunnel4") || checkcmd("tstunnel") || checkcmd("stunnel");
my $valgrind = checktestcmd("valgrind");
my $valgrind_logfile="--logfile";
my $has_ipv6; # set if libcurl is built with IPv6 support
my $has_unix; # set if libcurl is built with Unix sockets support
my $has_libz; # set if libcurl is built with libz support
+my $has_brotli; # set if libcurl is built with brotli support
my $has_getrlimit; # set if system has getrlimit()
my $has_ntlm; # set if libcurl is built with NTLM support
my $has_ntlm_wb; # set if libcurl is built with NTLM delegation to winbind
my $has_cares; # set if built with c-ares
my $has_threadedres;# set if built with threaded resolver
my $has_psl; # set if libcurl is built with PSL support
+my $has_ldpreload; # set if curl is built for systems supporting LD_PRELOAD
+my $has_multissl; # set if curl is build with MultiSSL support
# this version is decided by the particular nghttp2 library that is being used
my $h2cver = "h2c";
$ENV{'CURL_ENTROPY'}="12345678";
$ENV{'CURL_FORCETIME'}=1; # for debug NTLM magic
$ENV{'HOME'}=$pwd;
+$ENV{'COLUMNS'}=79; # screen width!
sub catch_zap {
my $signame = shift;
}
}
}
- for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'gopher', 'httptls')) {
+ for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'gopher', 'httptls',
+ 'dict', 'smb', 'smbs', 'telnet')) {
for my $ipvnum ((4, 6)) {
for my $idnum ((1, 2)) {
my $serv = servername_id($proto, $ipvnum, $idnum);
# Memory allocation test and failure torture testing.
#
sub torture {
- my $testcmd = shift;
- my $gdbline = shift;
+ my ($testcmd, $testnum, $gdbline) = @_;
# remove memdump first to be sure we get a new nice and clean one
unlink($memdump);
my $count=0;
my @out = `$memanalyze -v $memdump`;
for(@out) {
- if(/^Allocations: (\d+)/) {
+ if(/^Operations: (\d+)/) {
$count = $1;
last;
}
}
if(!$count) {
- logmsg " found no allocs to make fail\n";
+ logmsg " found no functions to make fail\n";
return 0;
}
- logmsg " $count allocations to make fail\n";
+ logmsg " $count functions to make fail\n";
for ( 1 .. $count ) {
my $limit = $_;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time());
my $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
- logmsg "Fail alloc no: $limit at $now\r";
+ logmsg "Fail function no: $limit at $now\r";
}
# make the memory allocation function number $limit return failure
# remove memdump first to be sure we get a new nice and clean one
unlink($memdump);
- logmsg "*** Alloc number $limit is now set to fail ***\n" if($gdbthis);
+ 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($testcmd);
+ $ret = runclient($cmd);
}
#logmsg "$_ Returned " . ($ret >> 8) . "\n";
$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) {
}
}
if($fail) {
- logmsg " Failed on alloc number $limit in test.\n",
+ logmsg " Failed on function number $limit in test.\n",
" invoke with \"-t$limit\" to repeat this single case.\n";
stopservers($verbose);
return 1;
}
#######################################################################
+# Verify that the server that runs on $ip, $port is our server. This also
+# implies that we can speak with it, as there might be occasions when the
+# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
+# assign requested address")
+#
+sub verifysmb {
+ my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
+ my $server = servername_id($proto, $ipvnum, $idnum);
+ my $pid = 0;
+ my $time=time();
+ my $extra="";
+
+ my $verifylog = "$LOGDIR/".
+ servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
+ unlink($verifylog) if(-f $verifylog);
+
+ my $flags = "--max-time $server_response_maxtime ";
+ $flags .= "--silent ";
+ $flags .= "--verbose ";
+ $flags .= "--globoff ";
+ $flags .= "-u 'curltest:curltest' ";
+ $flags .= $extra;
+ $flags .= "\"$proto://$ip:$port/SERVER/verifiedserver\"";
+
+ my $cmd = "$VCURL $flags 2>$verifylog";
+
+ # check if this is our server running on this port:
+ logmsg "RUN: $cmd\n" if($verbose);
+ my @data = runclientoutput($cmd);
+
+ my $res = $? >> 8; # rotate the result
+ if($res & 128) {
+ logmsg "RUN: curl command died with a coredump\n";
+ return -1;
+ }
+
+ foreach my $line (@data) {
+ if($line =~ /WE ROOLZ: (\d+)/) {
+ # this is our test server with a known pid!
+ $pid = 0+$1;
+ last;
+ }
+ }
+ if($pid <= 0 && @data && $data[0]) {
+ # this is not a known server
+ logmsg "RUN: Unknown server on our $server port: $port\n";
+ return 0;
+ }
+ # we can/should use the time it took to verify the server as a measure
+ # on how fast/slow this host is.
+ my $took = int(0.5+time()-$time);
+
+ if($verbose) {
+ logmsg "RUN: Verifying our test $server server took $took seconds\n";
+ }
+ $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
+
+ return $pid;
+}
+
+#######################################################################
+# Verify that the server that runs on $ip, $port is our server. This also
+# implies that we can speak with it, as there might be occasions when the
+# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
+# assign requested address")
+#
+sub verifytelnet {
+ my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
+ my $server = servername_id($proto, $ipvnum, $idnum);
+ my $pid = 0;
+ my $time=time();
+ my $extra="";
+
+ my $verifylog = "$LOGDIR/".
+ servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
+ unlink($verifylog) if(-f $verifylog);
+
+ my $flags = "--max-time $server_response_maxtime ";
+ $flags .= "--silent ";
+ $flags .= "--verbose ";
+ $flags .= "--globoff ";
+ $flags .= "--upload-file - ";
+ $flags .= $extra;
+ $flags .= "\"$proto://$ip:$port\"";
+
+ my $cmd = "echo 'verifiedserver' | $VCURL $flags 2>$verifylog";
+
+ # check if this is our server running on this port:
+ logmsg "RUN: $cmd\n" if($verbose);
+ my @data = runclientoutput($cmd);
+
+ my $res = $? >> 8; # rotate the result
+ if($res & 128) {
+ logmsg "RUN: curl command died with a coredump\n";
+ return -1;
+ }
+
+ foreach my $line (@data) {
+ if($line =~ /WE ROOLZ: (\d+)/) {
+ # this is our test server with a known pid!
+ $pid = 0+$1;
+ last;
+ }
+ }
+ if($pid <= 0 && @data && $data[0]) {
+ # this is not a known server
+ logmsg "RUN: Unknown server on our $server port: $port\n";
+ return 0;
+ }
+ # we can/should use the time it took to verify the server as a measure
+ # on how fast/slow this host is.
+ my $took = int(0.5+time()-$time);
+
+ if($verbose) {
+ logmsg "RUN: Verifying our test $server server took $took seconds\n";
+ }
+
+ return $pid;
+}
+
+
+#######################################################################
# Verify that the server that runs on $ip, $port is our server.
# Retry over several seconds before giving up. The ssh server in
# particular can take a long time to start if it needs to generate
'ssh' => \&verifyssh,
'socks' => \&verifysocks,
'gopher' => \&verifyhttp,
- 'httptls' => \&verifyhttptls);
+ 'httptls' => \&verifyhttptls,
+ 'dict' => \&verifyftp,
+ 'smb' => \&verifysmb,
+ 'telnet' => \&verifytelnet);
sub verifyserver {
my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
$flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
$flags .= "--port $HTTP2PORT ";
+ $flags .= "--connect $HOSTIP:$HTTPPORT ";
$flags .= $verbose_flag if($debugprotocol);
my $cmd = "$exe $flags";
}
#######################################################################
+# start the dict server
+#
+sub rundictserver {
+ my ($verbose, $alt, $port) = @_;
+ my $proto = "dict";
+ my $ip = $HOSTIP;
+ my $ipvnum = 4;
+ my $idnum = 1;
+ my $server;
+ my $srvrname;
+ my $pidfile;
+ my $logfile;
+ my $flags = "";
+
+ if($alt eq "ipv6") {
+ # No IPv6
+ }
+
+ $server = servername_id($proto, $ipvnum, $idnum);
+
+ $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0,0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ $srvrname = servername_str($proto, $ipvnum, $idnum);
+
+ $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ $flags .= "--verbose 1 " if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ $flags .= "--port $port --srcdir \"$srcdir\"";
+
+ my $cmd = "$srcdir/dictserver.py $flags";
+ my ($dictpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($dictpid <= 0 || !pidexists($dictpid)) {
+ # it is NOT alive
+ logmsg "RUN: failed to start the $srvrname server\n";
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0,0);
+ }
+
+ # Server is up. Verify that we can speak to it.
+ my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
+ if(!$pid3) {
+ logmsg "RUN: $srvrname server failed verification\n";
+ # failed to talk to it properly. Kill the server and return failure
+ stopserver($server, "$dictpid $pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0,0);
+ }
+ $pid2 = $pid3;
+
+ if($verbose) {
+ logmsg "RUN: $srvrname server is now running PID $dictpid\n";
+ }
+
+ sleep(1);
+
+ return ($dictpid, $pid2);
+}
+
+#######################################################################
+# start the SMB server
+#
+sub runsmbserver {
+ my ($verbose, $alt, $port) = @_;
+ my $proto = "smb";
+ my $ip = $HOSTIP;
+ my $ipvnum = 4;
+ my $idnum = 1;
+ my $server;
+ my $srvrname;
+ my $pidfile;
+ my $logfile;
+ my $flags = "";
+
+ if($alt eq "ipv6") {
+ # No IPv6
+ }
+
+ $server = servername_id($proto, $ipvnum, $idnum);
+
+ $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0,0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ $srvrname = servername_str($proto, $ipvnum, $idnum);
+
+ $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ $flags .= "--verbose 1 " if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ $flags .= "--port $port --srcdir \"$srcdir\"";
+
+ my $cmd = "$srcdir/smbserver.py $flags";
+ my ($smbpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($smbpid <= 0 || !pidexists($smbpid)) {
+ # it is NOT alive
+ logmsg "RUN: failed to start the $srvrname server\n";
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0,0);
+ }
+
+ # Server is up. Verify that we can speak to it.
+ my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
+ if(!$pid3) {
+ logmsg "RUN: $srvrname server failed verification\n";
+ # failed to talk to it properly. Kill the server and return failure
+ stopserver($server, "$smbpid $pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0,0);
+ }
+ $pid2 = $pid3;
+
+ if($verbose) {
+ logmsg "RUN: $srvrname server is now running PID $smbpid\n";
+ }
+
+ sleep(1);
+
+ return ($smbpid, $pid2);
+}
+
+#######################################################################
+# start the telnet server
+#
+sub runnegtelnetserver {
+ my ($verbose, $alt, $port) = @_;
+ my $proto = "telnet";
+ my $ip = $HOSTIP;
+ my $ipvnum = 4;
+ my $idnum = 1;
+ my $server;
+ my $srvrname;
+ my $pidfile;
+ my $logfile;
+ my $flags = "";
+
+ if($alt eq "ipv6") {
+ # No IPv6
+ }
+
+ $server = servername_id($proto, $ipvnum, $idnum);
+
+ $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0,0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ $srvrname = servername_str($proto, $ipvnum, $idnum);
+
+ $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ $flags .= "--verbose 1 " if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ $flags .= "--port $port --srcdir \"$srcdir\"";
+
+ my $cmd = "$srcdir/negtelnetserver.py $flags";
+ my ($ntelpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($ntelpid <= 0 || !pidexists($ntelpid)) {
+ # it is NOT alive
+ logmsg "RUN: failed to start the $srvrname server\n";
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0,0);
+ }
+
+ # Server is up. Verify that we can speak to it.
+ my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
+ if(!$pid3) {
+ logmsg "RUN: $srvrname server failed verification\n";
+ # failed to talk to it properly. Kill the server and return failure
+ stopserver($server, "$ntelpid $pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0,0);
+ }
+ $pid2 = $pid3;
+
+ if($verbose) {
+ logmsg "RUN: $srvrname server is now running PID $ntelpid\n";
+ }
+
+ sleep(1);
+
+ return ($ntelpid, $pid2);
+}
+
+
+#######################################################################
# Single shot http and gopher server responsiveness test. This should only
# be used to verify that a server present in %run hash is still functional
#
$curl =~ s/^(.*)(libcurl.*)/$1/g;
$libcurl = $2;
+ if($curl =~ /linux|bsd|solaris|darwin/) {
+ $has_ldpreload = 1;
+ }
if($curl =~ /win32|mingw(32|64)/) {
# This is a Windows MinGW build or native build, we need to use
# Win32-style path.
}
if ($libcurl =~ /winssl/i) {
$has_winssl=1;
+ $has_sslpinning=1;
$ssllib="WinSSL";
}
elsif ($libcurl =~ /openssl/i) {
}
elsif ($libcurl =~ /securetransport/i) {
$has_darwinssl=1;
+ $has_sslpinning=1;
$ssllib="DarwinSSL";
}
elsif ($libcurl =~ /BoringSSL/i) {
# ssl enabled
$has_ssl=1;
}
+ if($feat =~ /MultiSSL/i) {
+ # multiple ssl backends available.
+ $has_multissl=1;
+ }
if($feat =~ /Largefile/i) {
# large file support
$has_largefile=1;
if($feat =~ /libz/i) {
$has_libz = 1;
}
+ if($feat =~ /brotli/i) {
+ $has_brotli = 1;
+ }
if($feat =~ /NTLM/i) {
# NTLM enabled
$has_ntlm=1;
}
logmsg sprintf("\n* GOPHER/%d ", $GOPHERPORT);
if($gopher_ipv6) {
- logmsg sprintf("GOPHER-IPv6/%d", $GOPHERPORT);
+ logmsg sprintf("GOPHER-IPv6/%d", $GOPHER6PORT);
}
logmsg sprintf("\n* SSH/%d ", $SSHPORT);
logmsg sprintf("SOCKS/%d ", $SOCKSPORT);
$$thing =~ s/%TFTP6PORT/$TFTP6PORT/g;
$$thing =~ s/%TFTPPORT/$TFTPPORT/g;
+ $$thing =~ s/%DICTPORT/$DICTPORT/g;
+
+ $$thing =~ s/%SMBPORT/$SMBPORT/g;
+ $$thing =~ s/%SMBSPORT/$SMBSPORT/g;
+
+ $$thing =~ s/%NEGTELNETPORT/$NEGTELNETPORT/g;
+
# server Unix domain socket paths
$$thing =~ s/%HTTPUNIXPATH/$HTTPUNIXPATH/g;
# HTTP2
- $$thing =~ s/%H2CVER/$h2cver/g;
+ $$thing =~ s/%H2CVER/$h2cver/g;
}
sub fixarray {
my @in = @_;
for(@in) {
- subVariables \$_;
+ subVariables(\$_);
}
return @in;
}
next;
}
}
+ elsif($1 eq "MultiSSL") {
+ if($has_multissl) {
+ next;
+ }
+ }
elsif($1 eq "SSLpinning") {
if($has_sslpinning) {
next;
next;
}
}
+ elsif($1 eq "ld_preload") {
+ if($has_ldpreload && !$debug_build) {
+ next;
+ }
+ }
elsif($1 eq "unittest") {
if($debug_build) {
next;
next;
}
}
+ elsif($1 eq "brotli") {
+ if($has_brotli) {
+ next;
+ }
+ }
elsif($1 eq "NTLM") {
if($has_ntlm) {
next;
next;
}
}
+ elsif($1 eq "threaded-resolver") {
+ if($has_threadedres) {
+ next;
+ }
+ }
elsif($1 eq "PSL") {
if($has_psl) {
next;
next;
}
}
+ elsif($1 eq "MultiSSL") {
+ if(!$has_multissl) {
+ next;
+ }
+ }
elsif($1 eq "OpenSSL") {
if(!$has_openssl) {
next;
next;
}
}
+ elsif($1 eq "brotli") {
+ if(!$has_brotli) {
+ next;
+ }
+ }
elsif($1 eq "NTLM") {
if(!$has_ntlm) {
next;
next;
}
}
+ elsif($1 eq "threaded-resolver") {
+ if(!$has_threadedres) {
+ next;
+ }
+ }
else {
next;
}
for $k (@keywords) {
chomp $k;
- if ($disabled_keywords{$k}) {
+ if ($disabled_keywords{lc($k)}) {
$why = "disabled by keyword";
- } elsif ($enabled_keywords{$k}) {
+ } elsif ($enabled_keywords{lc($k)}) {
$match = 1;
}
}
if(@setenv) {
foreach my $s (@setenv) {
chomp $s;
- subVariables \$s;
+ subVariables(\$s);
if($s =~ /([^=]*)=(.*)/) {
my ($var, $content) = ($1, $2);
# remember current setting, to restore it once test runs
}
if(!$why) {
- # TODO:
- # Add a precheck cache. If a precheck command was already invoked
- # exactly like this, then use the previous result to speed up
- # successive test invokes!
-
my @precheck = getpart("client", "precheck");
if(@precheck) {
$cmd = $precheck[0];
}
logmsg sprintf("test %04d...", $testnum) if(!$automakestyle);
- # extract the reply data
- my @reply = getpart("reply", "data");
- my @replycheck = getpart("reply", "datacheck");
-
my %replyattr = getpartattr("reply", "data");
- my %replycheckattr = getpartattr("reply", "datacheck");
-
- if (@replycheck) {
- # we use this file instead to check the final output against
- # get the mode attribute
- my $filemode=$replycheckattr{'mode'};
- if($filemode && ($filemode eq "text") && $has_textaware) {
- # text mode when running on windows: fix line endings
- map s/\r\n/\n/g, @replycheck;
- map s/\n/\r\n/g, @replycheck;
- }
- if($replycheckattr{'nonewline'}) {
- # Yes, we must cut off the final newline from the final line
- # of the datacheck
- chomp($replycheck[$#replycheck]);
- }
-
- for my $partsuffix (('1', '2', '3', '4')) {
+ my @reply;
+ if (partexists("reply", "datacheck")) {
+ for my $partsuffix (('', '1', '2', '3', '4')) {
my @replycheckpart = getpart("reply", "datacheck".$partsuffix);
- if(@replycheckpart || partexists("reply", "datacheck".$partsuffix) ) {
+ if(@replycheckpart) {
my %replycheckpartattr = getpartattr("reply", "datacheck".$partsuffix);
# get the mode attribute
my $filemode=$replycheckpartattr{'mode'};
# of the datacheck
chomp($replycheckpart[$#replycheckpart]);
}
- push(@replycheck, @replycheckpart);
+ push(@reply, @replycheckpart);
}
}
-
- @reply=@replycheck;
}
else {
+ # check against the data section
+ @reply = getpart("reply", "data");
# get the mode attribute
my $filemode=$replyattr{'mode'};
if($filemode && ($filemode eq "text") && $has_textaware) {
# if this section exists, we verify upload
my @upload = getpart("verify", "upload");
+ if(@upload) {
+ my %hash = getpartattr("verify", "upload");
+ if($hash{'nonewline'}) {
+ # cut off the final newline from the final line of the upload data
+ chomp($upload[$#upload]);
+ }
+ }
# if this section exists, it might be FTP server instructions:
my @ftpservercmd = getpart("reply", "servercmd");
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) {
- if(!$filename) {
- logmsg "ERROR: section client=>file has no name attribute\n";
- timestampskippedevents($testnum);
- return -1;
+ # 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";
+ timestampskippedevents($testnum);
+ return -1;
+ }
+ 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 $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");
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: $@";
- stopservers($verbose);
- timestampskippedevents($testnum);
- return -1;
- }
- }
-
if($gdbthis) {
my $gdbinit = "$TESTDIR/gdbinit$testnum";
open(GDBCMD, ">$LOGDIR/gdbcmd");
# run the command line we built
if ($torture) {
$cmdres = torture($CMDLINE,
- "$gdb --directory libtest $DBGCURL -x $LOGDIR/gdbcmd");
+ $testnum,
+ "$gdb --directory libtest $DBGCURL -x $LOGDIR/gdbcmd");
}
elsif($gdbthis) {
my $GDBW = ($gdbxwin) ? "-w" : "";
# run the postcheck command
my @postcheck= getpart("client", "postcheck");
if(@postcheck) {
- $cmd = $postcheck[0];
+ $cmd = join("", @postcheck);
chomp $cmd;
subVariables \$cmd;
if($cmd) {
if(@upload) {
# verify uploaded data
my @out = loadarray("$LOGDIR/upload.$testnum");
+
+ # what parts to cut off from the upload
+ my @strippart = getpart("verify", "strippart");
+ my $strip;
+ for $strip (@strippart) {
+ chomp $strip;
+ for(@out) {
+ eval $strip;
+ }
+ }
+
$res = compare($testnum, $testname, "upload", \@out, \@upload);
if ($res) {
return 1;
$timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
return 1;
}
- my @e = valgrindparse($srcdir, $feature{'SSL'}, "$LOGDIR/$vgfile");
+ my @e = valgrindparse("$LOGDIR/$vgfile");
if(@e && $e[0]) {
if($automakestyle) {
logmsg "FAIL: $testnum - $testname - valgrind\n";
return "failed starting socks5 server";
}
elsif(($sshdid =~ /OpenSSH/) && ($sshdvernum < 370)) {
- # Need OpenSSH 3.7 for socks5 - http://www.openssh.com/txt/release-3.7
+ # Need OpenSSH 3.7 for socks5 - https://www.openssh.com/txt/release-3.7
logmsg "$sshdverstr insufficient; socks5 tests need at least OpenSSH 3.7\n";
return "failed starting socks5 server";
}
$run{'http-unix'}="$pid $pid2";
}
}
+ elsif($what eq "dict") {
+ if(!$run{'dict'}) {
+ ($pid, $pid2) = rundictserver($verbose, "", $DICTPORT);
+ if($pid <= 0) {
+ return "failed starting DICT server";
+ }
+ logmsg sprintf ("* pid DICT => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'dict'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "smb") {
+ if(!$run{'smb'}) {
+ ($pid, $pid2) = runsmbserver($verbose, "", $SMBPORT);
+ if($pid <= 0) {
+ return "failed starting SMB server";
+ }
+ logmsg sprintf ("* pid SMB => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'dict'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "telnet") {
+ if(!$run{'telnet'}) {
+ ($pid, $pid2) = runnegtelnetserver($verbose,
+ "",
+ $NEGTELNETPORT);
+ if($pid <= 0) {
+ return "failed starting neg TELNET server";
+ }
+ logmsg sprintf ("* pid neg TELNET => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'dict'}="$pid $pid2";
+ }
+ }
elsif($what eq "none") {
logmsg "* starts no server\n" if ($verbose);
}
# have the servers display protocol output
$debugprotocol=1;
}
+ elsif($ARGV[0] eq "-e") {
+ # run the tests cases event based if possible
+ $run_event_based=1;
+ }
elsif ($ARGV[0] eq "-g") {
# run this test with gdb
$gdbthis=1;
# no valgrind
undef $valgrind;
}
+ elsif ($ARGV[0] eq "-R") {
+ # execute in scrambled order
+ $scrambleorder=1;
+ }
elsif($ARGV[0] =~ /^-t(.*)/) {
# torture
$torture=1;
if($xtra =~ s/(\d+)$//) {
$tortalloc = $1;
}
- # we undef valgrind to make this fly in comparison
- undef $valgrind;
}
elsif($ARGV[0] eq "-a") {
# continue anyway, even if a test fail
$anyway=1;
}
- elsif($ARGV[0] eq "-e") {
- # run the tests cases event based if possible
- $run_event_based=1;
- }
elsif($ARGV[0] eq "-p") {
$postmortem=1;
}
-bN use base port number N for test servers (default $base)
-c path use this curl executable
-d display server debug info
+ -e event-based execution
-g run the test case with gdb
-gw run the test case with gdb as a windowed application
-h this help text
-l list all test case names/descriptions
-n no valgrind
-p print log file contents when a test fails
+ -R scrambled order
-r run time statistics
-rf full run time statistics
-s short output
-am automake style output PASS/FAIL: [number] [name]
- -t[N] torture (simulate memory alloc failures); N means fail Nth alloc
+ -t[N] torture (simulate function failures); N means fail Nth function
-v verbose output
-vc path use this curl only to verify the existing servers
[num] like "5 6 9" or " 5 to 22 " to run those tests only
$disabled{$1}=$1;
}
elsif($ARGV[0] =~ /^!(.+)/) {
- $disabled_keywords{$1}=$1;
+ $disabled_keywords{lc($1)}=$1;
}
elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) {
- $enabled_keywords{$1}=$1;
+ $enabled_keywords{lc($1)}=$1;
}
else {
print "Unknown option: $ARGV[0]\n";
$HTTPPROXYPORT = $base++; # HTTP proxy port, when using CONNECT
$HTTPPIPEPORT = $base++; # HTTP pipelining port
$HTTP2PORT = $base++; # HTTP/2 port
+$DICTPORT = $base++; # DICT port
+$SMBPORT = $base++; # SMB port
+$SMBSPORT = $base++; # SMBS port
+$NEGTELNETPORT = $base++; # TELNET port with negotiation
$HTTPUNIXPATH = 'http.sock'; # HTTP server Unix domain socket path
#######################################################################
$TESTCASES = $verified;
}
+if($scrambleorder) {
+ # scramble the order of the test cases
+ my @rand;
+ while($TESTCASES) {
+ my @all = split(/ +/, $TESTCASES);
+ if(!$all[0]) {
+ # if the first is blank, shift away it
+ shift @all;
+ }
+ my $r = rand @all;
+ push @rand, $all[$r];
+ $all[$r]="";
+ $TESTCASES = join(" ", @all);
+ }
+ $TESTCASES = join(" ", @rand);
+}
+
#######################################################################
# Start the command line log
#
projects / platform / upstream / curl.git / blobdiff