tests/runtests.pl

   1 #!/usr/bin/env perl
   2 #***************************************************************************
   3 #                                  _   _ ____  _
   4 #  Project                     ___| | | |  _ \| |
   5 #                             / __| | | | |_) | |
   6 #                            | (__| |_| |  _ <| |___
   7 #                             \___|\___/|_| \_\_____|
   8 #
   9 # Copyright (C) 1998 - 2016, Daniel Stenberg, <daniel@haxx.se>, et al.
  10 #
  11 # This software is licensed as described in the file COPYING, which
  12 # you should have received as part of this distribution. The terms
  13 # are also available at https://curl.haxx.se/docs/copyright.html.
  14 #
  15 # You may opt to use, copy, modify, merge, publish, distribute and/or sell
  16 # copies of the Software, and permit persons to whom the Software is
  17 # furnished to do so, under the terms of the COPYING file.
  18 #
  19 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
  20 # KIND, either express or implied.
  21 #
  22 ###########################################################################
  23
  24 # Experimental hooks are available to run tests remotely on machines that
  25 # are able to run curl but are unable to run the test harness.
  26 # The following sections need to be modified:
  27 #
  28 #  $HOSTIP, $HOST6IP - Set to the address of the host running the test suite
  29 #  $CLIENTIP, $CLIENT6IP - Set to the address of the host running curl
  30 #  runclient, runclientoutput - Modify to copy all the files in the log/
  31 #    directory to the system running curl, run the given command remotely
  32 #    and save the return code or returned stdout (respectively), then
  33 #    copy all the files from the remote system's log/ directory back to
  34 #    the host running the test suite.  This can be done a few ways, such
  35 #    as using scp & ssh, rsync & telnet, or using a NFS shared directory
  36 #    and ssh.
  37 #
  38 # 'make && make test' needs to be done on both machines before making the
  39 # above changes and running runtests.pl manually.  In the shared NFS case,
  40 # the contents of the tests/server/ directory must be from the host
  41 # running the test suite, while the rest must be from the host running curl.
  42 #
  43 # Note that even with these changes a number of tests will still fail (mainly
  44 # to do with cookies, those that set environment variables, or those that
  45 # do more than touch the file system in a <precheck> or <postcheck>
  46 # section). These can be added to the $TESTCASES line below,
  47 # e.g. $TESTCASES="!8 !31 !63 !cookies..."
  48 #
  49 # Finally, to properly support -g and -n, checktestcmd needs to change
  50 # to check the remote system's PATH, and the places in the code where
  51 # the curl binary is read directly to determine its type also need to be
  52 # fixed. As long as the -g option is never given, and the -n is always
  53 # given, this won't be a problem.
  54
  55
  56 # These should be the only variables that might be needed to get edited:
  57
  58 BEGIN {
  59     push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'});
  60     push(@INC, ".");
  61     # run time statistics needs Time::HiRes
  62     eval {
  63         no warnings "all";
  64         require Time::HiRes;
  65         import  Time::HiRes qw( time );
  66     }
  67 }
  68
  69 use strict;
  70 use warnings;
  71 use Cwd;
  72
  73 # Subs imported from serverhelp module
  74 use serverhelp qw(
  75     serverfactors
  76     servername_id
  77     servername_str
  78     servername_canon
  79     server_pidfilename
  80     server_logfilename
  81     );
  82
  83 # Variables and subs imported from sshhelp module
  84 use sshhelp qw(
  85     $sshdexe
  86     $sshexe
  87     $sftpexe
  88     $sshconfig
  89     $sftpconfig
  90     $sshdlog
  91     $sshlog
  92     $sftplog
  93     $sftpcmds
  94     display_sshdconfig
  95     display_sshconfig
  96     display_sftpconfig
  97     display_sshdlog
  98     display_sshlog
  99     display_sftplog
 100     exe_ext
 101     find_sshd
 102     find_ssh
 103     find_sftp
 104     find_httptlssrv
 105     sshversioninfo
 106     );
 107
 108 use pathhelp;
 109
 110 require "getpart.pm"; # array functions
 111 require "valgrind.pm"; # valgrind report parser
 112 require "ftp.pm";
 113
 114 my $HOSTIP="127.0.0.1";   # address on which the test server listens
 115 my $HOST6IP="[::1]";      # address on which the test server listens
 116 my $CLIENTIP="127.0.0.1"; # address which curl uses for incoming connections
 117 my $CLIENT6IP="[::1]";    # address which curl uses for incoming connections
 118
 119 my $base = 8990; # base port number
 120
 121 my $HTTPPORT;            # HTTP server port
 122 my $HTTP6PORT;           # HTTP IPv6 server port
 123 my $HTTPSPORT;           # HTTPS (stunnel) server port
 124 my $FTPPORT;             # FTP server port
 125 my $FTP2PORT;            # FTP server 2 port
 126 my $FTPSPORT;            # FTPS (stunnel) server port
 127 my $FTP6PORT;            # FTP IPv6 server port
 128 my $TFTPPORT;            # TFTP
 129 my $TFTP6PORT;           # TFTP
 130 my $SSHPORT;             # SCP/SFTP
 131 my $SOCKSPORT;           # SOCKS4/5 port
 132 my $POP3PORT;            # POP3
 133 my $POP36PORT;           # POP3 IPv6 server port
 134 my $IMAPPORT;            # IMAP
 135 my $IMAP6PORT;           # IMAP IPv6 server port
 136 my $SMTPPORT;            # SMTP
 137 my $SMTP6PORT;           # SMTP IPv6 server port
 138 my $RTSPPORT;            # RTSP
 139 my $RTSP6PORT;           # RTSP IPv6 server port
 140 my $GOPHERPORT;          # Gopher
 141 my $GOPHER6PORT;         # Gopher IPv6 server port
 142 my $HTTPTLSPORT;         # HTTP TLS (non-stunnel) server port
 143 my $HTTPTLS6PORT;        # HTTP TLS (non-stunnel) IPv6 server port
 144 my $HTTPPROXYPORT;       # HTTP proxy port, when using CONNECT
 145 my $HTTPPIPEPORT;        # HTTP pipelining port
 146 my $HTTPUNIXPATH;        # HTTP server Unix domain socket path
 147 my $HTTP2PORT;           # HTTP/2 server port
 148
 149 my $srcdir = $ENV{'srcdir'} || '.';
 150 my $CURL="../src/curl".exe_ext(); # what curl executable to run on the tests
 151 my $VCURL=$CURL;   # what curl binary to use to verify the servers with
 152                    # VCURL is handy to set to the system one when the one you
 153                    # just built hangs or crashes and thus prevent verification
 154 my $DBGCURL=$CURL; #"../src/.libs/curl";  # alternative for debugging
 155 my $LOGDIR="log";
 156 my $TESTDIR="$srcdir/data";
 157 my $LIBDIR="./libtest";
 158 my $UNITDIR="./unit";
 159 # TODO: change this to use server_inputfilename()
 160 my $SERVERIN="$LOGDIR/server.input"; # what curl sent the server
 161 my $SERVER2IN="$LOGDIR/server2.input"; # what curl sent the second server
 162 my $PROXYIN="$LOGDIR/proxy.input"; # what curl sent the proxy
 163 my $CURLLOG="$LOGDIR/curl.log"; # all command lines run
 164 my $FTPDCMD="$LOGDIR/ftpserver.cmd"; # copy ftp server instructions here
 165 my $SERVERLOGS_LOCK="$LOGDIR/serverlogs.lock"; # server logs advisor read lock
 166 my $CURLCONFIG="../curl-config"; # curl-config from current build
 167
 168 # Normally, all test cases should be run, but at times it is handy to
 169 # simply run a particular one:
 170 my $TESTCASES="all";
 171
 172 # To run specific test cases, set them like:
 173 # $TESTCASES="1 2 3 7 8";
 174
 175 #######################################################################
 176 # No variables below this point should need to be modified
 177 #
 178
 179 # invoke perl like this:
 180 my $perl="perl -I$srcdir";
 181 my $server_response_maxtime=13;
 182
 183 my $debug_build=0;          # built debug enabled (--enable-debug)
 184 my $has_memory_tracking=0;  # built with memory tracking (--enable-curldebug)
 185 my $libtool;
 186
 187 # name of the file that the memory debugging creates:
 188 my $memdump="$LOGDIR/memdump";
 189
 190 # the path to the script that analyzes the memory debug output file:
 191 my $memanalyze="$perl $srcdir/memanalyze.pl";
 192
 193 my $pwd = getcwd();          # current working directory
 194
 195 my $start;
 196 my $ftpchecktime=1; # time it took to verify our test FTP server
 197
 198 my $stunnel = checkcmd("stunnel4") || checkcmd("tstunnel") || checkcmd("stunnel");
 199 my $valgrind = checktestcmd("valgrind");
 200 my $valgrind_logfile="--logfile";
 201 my $valgrind_tool;
 202 my $gdb = checktestcmd("gdb");
 203 my $httptlssrv = find_httptlssrv();
 204
 205 my $has_ssl;        # set if libcurl is built with SSL support
 206 my $has_largefile;  # set if libcurl is built with large file support
 207 my $has_idn;        # set if libcurl is built with IDN support
 208 my $http_ipv6;      # set if HTTP server has IPv6 support
 209 my $http_unix;      # set if HTTP server has Unix sockets support
 210 my $ftp_ipv6;       # set if FTP server has IPv6 support
 211 my $tftp_ipv6;      # set if TFTP server has IPv6 support
 212 my $gopher_ipv6;    # set if Gopher server has IPv6 support
 213 my $has_ipv6;       # set if libcurl is built with IPv6 support
 214 my $has_unix;       # set if libcurl is built with Unix sockets support
 215 my $has_libz;       # set if libcurl is built with libz support
 216 my $has_getrlimit;  # set if system has getrlimit()
 217 my $has_ntlm;       # set if libcurl is built with NTLM support
 218 my $has_ntlm_wb;    # set if libcurl is built with NTLM delegation to winbind
 219 my $has_sspi;       # set if libcurl is built with Windows SSPI
 220 my $has_gssapi;     # set if libcurl is built with a GSS-API library
 221 my $has_kerberos;   # set if libcurl is built with Kerberos support
 222 my $has_spnego;     # set if libcurl is built with SPNEGO support
 223 my $has_charconv;   # set if libcurl is built with CharConv support
 224 my $has_tls_srp;    # set if libcurl is built with TLS-SRP support
 225 my $has_metalink;   # set if curl is built with Metalink support
 226 my $has_http2;      # set if libcurl is built with HTTP2 support
 227 my $has_crypto;     # set if libcurl is built with cryptographic support
 228 my $has_cares;      # set if built with c-ares
 229 my $has_threadedres;# set if built with threaded resolver
 230 my $has_psl;        # set if libcurl is built with PSL support
 231
 232 # this version is decided by the particular nghttp2 library that is being used
 233 my $h2cver = "h2c";
 234
 235 my $has_openssl;    # built with a lib using an OpenSSL-like API
 236 my $has_gnutls;     # built with GnuTLS
 237 my $has_nss;        # built with NSS
 238 my $has_yassl;      # built with yassl
 239 my $has_polarssl;   # built with polarssl
 240 my $has_axtls;      # built with axTLS
 241 my $has_winssl;     # built with WinSSL    (Secure Channel aka Schannel)
 242 my $has_darwinssl;  # built with DarwinSSL (Secure Transport)
 243 my $has_boringssl;  # built with BoringSSL
 244 my $has_libressl;   # built with libressl
 245 my $has_mbedtls;    # built with mbedTLS
 246
 247 my $has_sslpinning; # built with a TLS backend that supports pinning
 248
 249 my $has_shared = "unknown";  # built shared
 250
 251 my $resolver;       # name of the resolver backend (for human presentation)
 252 my $ssllib;         # name of the SSL library we use (for human presentation)
 253
 254 my $has_textaware;  # set if running on a system that has a text mode concept
 255                     # on files. Windows for example
 256
 257 my @protocols;   # array of lowercase supported protocol servers
 258
 259 my $skipped=0;  # number of tests skipped; reported in main loop
 260 my %skipped;    # skipped{reason}=counter, reasons for skip
 261 my @teststat;   # teststat[testnum]=reason, reasons for skip
 262 my %disabled_keywords;  # key words of tests to skip
 263 my %enabled_keywords;   # key words of tests to run
 264 my %disabled;           # disabled test cases
 265
 266 my $sshdid;      # for socks server, ssh daemon version id
 267 my $sshdvernum;  # for socks server, ssh daemon version number
 268 my $sshdverstr;  # for socks server, ssh daemon version string
 269 my $sshderror;   # for socks server, ssh daemon version error
 270
 271 my $defserverlogslocktimeout = 20; # timeout to await server logs lock removal
 272 my $defpostcommanddelay = 0; # delay between command and postcheck sections
 273
 274 my $timestats;   # time stamping and stats generation
 275 my $fullstats;   # show time stats for every single test
 276 my %timeprepini; # timestamp for each test preparation start
 277 my %timesrvrini; # timestamp for each test required servers verification start
 278 my %timesrvrend; # timestamp for each test required servers verification end
 279 my %timetoolini; # timestamp for each test command run starting
 280 my %timetoolend; # timestamp for each test command run stopping
 281 my %timesrvrlog; # timestamp for each test server logs lock removal
 282 my %timevrfyend; # timestamp for each test result verification end
 283
 284 my $testnumcheck; # test number, set in singletest sub.
 285 my %oldenv;
 286
 287 #######################################################################
 288 # variables that command line options may set
 289 #
 290
 291 my $short;
 292 my $automakestyle;
 293 my $verbose;
 294 my $debugprotocol;
 295 my $anyway;
 296 my $gdbthis;      # run test case with gdb debugger
 297 my $gdbxwin;      # use windowed gdb when using gdb
 298 my $keepoutfiles; # keep stdout and stderr files after tests
 299 my $listonly;     # only list the tests
 300 my $postmortem;   # display detailed info about failed tests
 301 my $run_event_based; # run curl with --test-event to test the event API
 302
 303 my %run;          # running server
 304 my %doesntrun;    # servers that don't work, identified by pidfile
 305 my %serverpidfile;# all server pid file names, identified by server id
 306 my %runcert;      # cert file currently in use by an ssl running server
 307
 308 # torture test variables
 309 my $torture;
 310 my $tortnum;
 311 my $tortalloc;
 312
 313 #######################################################################
 314 # logmsg is our general message logging subroutine.
 315 #
 316 sub logmsg {
 317     for(@_) {
 318         print "$_";
 319     }
 320 }
 321
 322 # get the name of the current user
 323 my $USER = $ENV{USER};          # Linux
 324 if (!$USER) {
 325     $USER = $ENV{USERNAME};     # Windows
 326     if (!$USER) {
 327         $USER = $ENV{LOGNAME};  # Some Unix (I think)
 328     }
 329 }
 330
 331 # enable memory debugging if curl is compiled with it
 332 $ENV{'CURL_MEMDEBUG'} = $memdump;
 333 $ENV{'CURL_ENTROPY'}="12345678";
 334 $ENV{'CURL_FORCETIME'}=1; # for debug NTLM magic
 335 $ENV{'HOME'}=$pwd;
 336
 337 sub catch_zap {
 338     my $signame = shift;
 339     logmsg "runtests.pl received SIG$signame, exiting\n";
 340     stopservers($verbose);
 341     die "Somebody sent me a SIG$signame";
 342 }
 343 $SIG{INT} = \&catch_zap;
 344 $SIG{TERM} = \&catch_zap;
 345
 346 ##########################################################################
 347 # Clear all possible '*_proxy' environment variables for various protocols
 348 # to prevent them to interfere with our testing!
 349
 350 my $protocol;
 351 foreach $protocol (('ftp', 'http', 'ftps', 'https', 'no', 'all')) {
 352     my $proxy = "${protocol}_proxy";
 353     # clear lowercase version
 354     delete $ENV{$proxy} if($ENV{$proxy});
 355     # clear uppercase version
 356     delete $ENV{uc($proxy)} if($ENV{uc($proxy)});
 357 }
 358
 359 # make sure we don't get affected by other variables that control our
 360 # behaviour
 361
 362 delete $ENV{'SSL_CERT_DIR'} if($ENV{'SSL_CERT_DIR'});
 363 delete $ENV{'SSL_CERT_PATH'} if($ENV{'SSL_CERT_PATH'});
 364 delete $ENV{'CURL_CA_BUNDLE'} if($ENV{'CURL_CA_BUNDLE'});
 365
 366 #######################################################################
 367 # Load serverpidfile hash with pidfile names for all possible servers.
 368 #
 369 sub init_serverpidfile_hash {
 370   for my $proto (('ftp', 'http', 'imap', 'pop3', 'smtp', 'http/2')) {
 371     for my $ssl (('', 's')) {
 372       for my $ipvnum ((4, 6)) {
 373         for my $idnum ((1, 2, 3)) {
 374           my $serv = servername_id("$proto$ssl", $ipvnum, $idnum);
 375           my $pidf = server_pidfilename("$proto$ssl", $ipvnum, $idnum);
 376           $serverpidfile{$serv} = $pidf;
 377         }
 378       }
 379     }
 380   }
 381   for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'gopher', 'httptls')) {
 382     for my $ipvnum ((4, 6)) {
 383       for my $idnum ((1, 2)) {
 384         my $serv = servername_id($proto, $ipvnum, $idnum);
 385         my $pidf = server_pidfilename($proto, $ipvnum, $idnum);
 386         $serverpidfile{$serv} = $pidf;
 387       }
 388     }
 389   }
 390   for my $proto (('http', 'imap', 'pop3', 'smtp', 'http/2')) {
 391     for my $ssl (('', 's')) {
 392       my $serv = servername_id("$proto$ssl", "unix", 1);
 393       my $pidf = server_pidfilename("$proto$ssl", "unix", 1);
 394       $serverpidfile{$serv} = $pidf;
 395     }
 396   }
 397 }
 398
 399 #######################################################################
 400 # Check if a given child process has just died. Reaps it if so.
 401 #
 402 sub checkdied {
 403     use POSIX ":sys_wait_h";
 404     my $pid = $_[0];
 405     if((not defined $pid) || $pid <= 0) {
 406         return 0;
 407     }
 408     my $rc = waitpid($pid, &WNOHANG);
 409     return ($rc == $pid)?1:0;
 410 }
 411
 412 #######################################################################
 413 # Start a new thread/process and run the given command line in there.
 414 # Return the pids (yes plural) of the new child process to the parent.
 415 #
 416 sub startnew {
 417     my ($cmd, $pidfile, $timeout, $fake)=@_;
 418
 419     logmsg "startnew: $cmd\n" if ($verbose);
 420
 421     my $child = fork();
 422     my $pid2 = 0;
 423
 424     if(not defined $child) {
 425         logmsg "startnew: fork() failure detected\n";
 426         return (-1,-1);
 427     }
 428
 429     if(0 == $child) {
 430         # Here we are the child. Run the given command.
 431
 432         # Put an "exec" in front of the command so that the child process
 433         # keeps this child's process ID.
 434         exec("exec $cmd") || die "Can't exec() $cmd: $!";
 435
 436         # exec() should never return back here to this process. We protect
 437         # ourselves by calling die() just in case something goes really bad.
 438         die "error: exec() has returned";
 439     }
 440
 441     # Ugly hack but ssh client and gnutls-serv don't support pid files
 442     if ($fake) {
 443         if(open(OUT, ">$pidfile")) {
 444             print OUT $child . "\n";
 445             close(OUT);
 446             logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose);
 447         }
 448         else {
 449             logmsg "startnew: failed to write fake $pidfile with pid=$child\n";
 450         }
 451         # could/should do a while connect fails sleep a bit and loop
 452         sleep $timeout;
 453         if (checkdied($child)) {
 454             logmsg "startnew: child process has failed to start\n" if($verbose);
 455             return (-1,-1);
 456         }
 457     }
 458
 459     my $count = $timeout;
 460     while($count--) {
 461         if(-f $pidfile && -s $pidfile && open(PID, "<$pidfile")) {
 462             $pid2 = 0 + <PID>;
 463             close(PID);
 464             if(($pid2 > 0) && pidexists($pid2)) {
 465                 # if $pid2 is valid, then make sure this pid is alive, as
 466                 # otherwise it is just likely to be the _previous_ pidfile or
 467                 # similar!
 468                 last;
 469             }
 470             # invalidate $pid2 if not actually alive
 471             $pid2 = 0;
 472         }
 473         if (checkdied($child)) {
 474             logmsg "startnew: child process has died, server might start up\n"
 475                 if($verbose);
 476             # We can't just abort waiting for the server with a
 477             # return (-1,-1);
 478             # because the server might have forked and could still start
 479             # up normally. Instead, just reduce the amount of time we remain
 480             # waiting.
 481             $count >>= 2;
 482         }
 483         sleep(1);
 484     }
 485
 486     # Return two PIDs, the one for the child process we spawned and the one
 487     # reported by the server itself (in case it forked again on its own).
 488     # Both (potentially) need to be killed at the end of the test.
 489     return ($child, $pid2);
 490 }
 491
 492
 493 #######################################################################
 494 # Check for a command in the PATH of the test server.
 495 #
 496 sub checkcmd {
 497     my ($cmd)=@_;
 498     my @paths=(split(":", $ENV{'PATH'}), "/usr/sbin", "/usr/local/sbin",
 499                "/sbin", "/usr/bin", "/usr/local/bin",
 500                "./libtest/.libs", "./libtest");
 501     for(@paths) {
 502         if( -x "$_/$cmd" && ! -d "$_/$cmd") {
 503             # executable bit but not a directory!
 504             return "$_/$cmd";
 505         }
 506     }
 507 }
 508
 509 #######################################################################
 510 # Get the list of tests that the tests/data/Makefile.am knows about!
 511 #
 512 my $disttests;
 513 sub get_disttests {
 514     my @dist = `cd data && make show`;
 515     $disttests = join("", @dist);
 516 }
 517
 518 #######################################################################
 519 # Check for a command in the PATH of the machine running curl.
 520 #
 521 sub checktestcmd {
 522     my ($cmd)=@_;
 523     return checkcmd($cmd);
 524 }
 525
 526 #######################################################################
 527 # Run the application under test and return its return code
 528 #
 529 sub runclient {
 530     my ($cmd)=@_;
 531     my $ret = system($cmd);
 532     print "CMD ($ret): $cmd\n" if($verbose && !$torture);
 533     return $ret;
 534
 535 # This is one way to test curl on a remote machine
 536 #    my $out = system("ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'");
 537 #    sleep 2;    # time to allow the NFS server to be updated
 538 #    return $out;
 539 }
 540
 541 #######################################################################
 542 # Run the application under test and return its stdout
 543 #
 544 sub runclientoutput {
 545     my ($cmd)=@_;
 546     return `$cmd`;
 547
 548 # This is one way to test curl on a remote machine
 549 #    my @out = `ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'`;
 550 #    sleep 2;    # time to allow the NFS server to be updated
 551 #    return @out;
 552  }
 553
 554 #######################################################################
 555 # Memory allocation test and failure torture testing.
 556 #
 557 sub torture {
 558     my $testcmd = shift;
 559     my $gdbline = shift;
 560
 561     # remove memdump first to be sure we get a new nice and clean one
 562     unlink($memdump);
 563
 564     # First get URL from test server, ignore the output/result
 565     runclient($testcmd);
 566
 567     logmsg " CMD: $testcmd\n" if($verbose);
 568
 569     # memanalyze -v is our friend, get the number of allocations made
 570     my $count=0;
 571     my @out = `$memanalyze -v $memdump`;
 572     for(@out) {
 573         if(/^Allocations: (\d+)/) {
 574             $count = $1;
 575             last;
 576         }
 577     }
 578     if(!$count) {
 579         logmsg " found no allocs to make fail\n";
 580         return 0;
 581     }
 582
 583     logmsg " $count allocations to make fail\n";
 584
 585     for ( 1 .. $count ) {
 586         my $limit = $_;
 587         my $fail;
 588         my $dumped_core;
 589
 590         if($tortalloc && ($tortalloc != $limit)) {
 591             next;
 592         }
 593
 594         if($verbose) {
 595             my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
 596                 localtime(time());
 597             my $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
 598             logmsg "Fail alloc no: $limit at $now\r";
 599         }
 600
 601         # make the memory allocation function number $limit return failure
 602         $ENV{'CURL_MEMLIMIT'} = $limit;
 603
 604         # remove memdump first to be sure we get a new nice and clean one
 605         unlink($memdump);
 606
 607         logmsg "*** Alloc number $limit is now set to fail ***\n" if($gdbthis);
 608
 609         my $ret = 0;
 610         if($gdbthis) {
 611             runclient($gdbline);
 612         }
 613         else {
 614             $ret = runclient($testcmd);
 615         }
 616         #logmsg "$_ Returned " . ($ret >> 8) . "\n";
 617
 618         # Now clear the variable again
 619         delete $ENV{'CURL_MEMLIMIT'} if($ENV{'CURL_MEMLIMIT'});
 620
 621         if(-r "core") {
 622             # there's core file present now!
 623             logmsg " core dumped\n";
 624             $dumped_core = 1;
 625             $fail = 2;
 626         }
 627
 628         # verify that it returns a proper error code, doesn't leak memory
 629         # and doesn't core dump
 630         if(($ret & 255) || ($ret >> 8) >= 128) {
 631             logmsg " system() returned $ret\n";
 632             $fail=1;
 633         }
 634         else {
 635             my @memdata=`$memanalyze $memdump`;
 636             my $leak=0;
 637             for(@memdata) {
 638                 if($_ ne "") {
 639                     # well it could be other memory problems as well, but
 640                     # we call it leak for short here
 641                     $leak=1;
 642                 }
 643             }
 644             if($leak) {
 645                 logmsg "** MEMORY FAILURE\n";
 646                 logmsg @memdata;
 647                 logmsg `$memanalyze -l $memdump`;
 648                 $fail = 1;
 649             }
 650         }
 651         if($fail) {
 652             logmsg " Failed on alloc number $limit in test.\n",
 653             " invoke with \"-t$limit\" to repeat this single case.\n";
 654             stopservers($verbose);
 655             return 1;
 656         }
 657     }
 658
 659     logmsg "torture OK\n";
 660     return 0;
 661 }
 662
 663 #######################################################################
 664 # Stop a test server along with pids which aren't in the %run hash yet.
 665 # This also stops all servers which are relative to the given one.
 666 #
 667 sub stopserver {
 668     my ($server, $pidlist) = @_;
 669     #
 670     # kill sockfilter processes for pingpong relative server
 671     #
 672     if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
 673         my $proto  = $1;
 674         my $idnum  = ($2 && ($2 > 1)) ? $2 : 1;
 675         my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
 676         killsockfilters($proto, $ipvnum, $idnum, $verbose);
 677     }
 678     #
 679     # All servers relative to the given one must be stopped also
 680     #
 681     my @killservers;
 682     if($server =~ /^(ftp|http|imap|pop3|smtp|httppipe)s((\d*)(-ipv6|-unix|))$/) {
 683         # given a stunnel based ssl server, also kill non-ssl underlying one
 684         push @killservers, "${1}${2}";
 685     }
 686     elsif($server =~ /^(ftp|http|imap|pop3|smtp|httppipe)((\d*)(-ipv6|-unix|))$/) {
 687         # given a non-ssl server, also kill stunnel based ssl piggybacking one
 688         push @killservers, "${1}s${2}";
 689     }
 690     elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
 691         # given a socks server, also kill ssh underlying one
 692         push @killservers, "ssh${2}";
 693     }
 694     elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
 695         # given a ssh server, also kill socks piggybacking one
 696         push @killservers, "socks${2}";
 697     }
 698     push @killservers, $server;
 699     #
 700     # kill given pids and server relative ones clearing them in %run hash
 701     #
 702     foreach my $server (@killservers) {
 703         if($run{$server}) {
 704             # we must prepend a space since $pidlist may already contain a pid
 705             $pidlist .= " $run{$server}";
 706             $run{$server} = 0;
 707         }
 708         $runcert{$server} = 0 if($runcert{$server});
 709     }
 710     killpid($verbose, $pidlist);
 711     #
 712     # cleanup server pid files
 713     #
 714     foreach my $server (@killservers) {
 715         my $pidfile = $serverpidfile{$server};
 716         my $pid = processexists($pidfile);
 717         if($pid > 0) {
 718             logmsg "Warning: $server server unexpectedly alive\n";
 719             killpid($verbose, $pid);
 720         }
 721         unlink($pidfile) if(-f $pidfile);
 722     }
 723 }
 724
 725 #######################################################################
 726 # Verify that the server that runs on $ip, $port is our server.  This also
 727 # implies that we can speak with it, as there might be occasions when the
 728 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
 729 # assign requested address")
 730 #
 731 sub verifyhttp {
 732     my ($proto, $ipvnum, $idnum, $ip, $port_or_path) = @_;
 733     my $server = servername_id($proto, $ipvnum, $idnum);
 734     my $pid = 0;
 735     my $bonus="";
 736     # $port_or_path contains a path for Unix sockets, sws ignores the port
 737     my $port = ($ipvnum eq "unix") ? 80 : $port_or_path;
 738
 739     my $verifyout = "$LOGDIR/".
 740         servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
 741     unlink($verifyout) if(-f $verifyout);
 742
 743     my $verifylog = "$LOGDIR/".
 744         servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
 745     unlink($verifylog) if(-f $verifylog);
 746
 747     if($proto eq "gopher") {
 748         # gopher is funny
 749         $bonus="1/";
 750     }
 751
 752     my $flags = "--max-time $server_response_maxtime ";
 753     $flags .= "--output $verifyout ";
 754     $flags .= "--silent ";
 755     $flags .= "--verbose ";
 756     $flags .= "--globoff ";
 757     $flags .= "--unix-socket '$port_or_path' " if $ipvnum eq "unix";
 758     $flags .= "-1 "         if($has_axtls);
 759     $flags .= "--insecure " if($proto eq 'https');
 760     $flags .= "\"$proto://$ip:$port/${bonus}verifiedserver\"";
 761
 762     my $cmd = "$VCURL $flags 2>$verifylog";
 763
 764     # verify if our/any server is running on this port
 765     logmsg "RUN: $cmd\n" if($verbose);
 766     my $res = runclient($cmd);
 767
 768     $res >>= 8; # rotate the result
 769     if($res & 128) {
 770         logmsg "RUN: curl command died with a coredump\n";
 771         return -1;
 772     }
 773
 774     if($res && $verbose) {
 775         logmsg "RUN: curl command returned $res\n";
 776         if(open(FILE, "<$verifylog")) {
 777             while(my $string = <FILE>) {
 778                 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
 779             }
 780             close(FILE);
 781         }
 782     }
 783
 784     my $data;
 785     if(open(FILE, "<$verifyout")) {
 786         while(my $string = <FILE>) {
 787             $data = $string;
 788             last; # only want first line
 789         }
 790         close(FILE);
 791     }
 792
 793     if($data && ($data =~ /WE ROOLZ: (\d+)/)) {
 794         $pid = 0+$1;
 795     }
 796     elsif($res == 6) {
 797         # curl: (6) Couldn't resolve host '::1'
 798         logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
 799         return -1;
 800     }
 801     elsif($data || ($res && ($res != 7))) {
 802         logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
 803         return -1;
 804     }
 805     return $pid;
 806 }
 807
 808 #######################################################################
 809 # Verify that the server that runs on $ip, $port is our server.  This also
 810 # implies that we can speak with it, as there might be occasions when the
 811 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
 812 # assign requested address")
 813 #
 814 sub verifyftp {
 815     my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
 816     my $server = servername_id($proto, $ipvnum, $idnum);
 817     my $pid = 0;
 818     my $time=time();
 819     my $extra="";
 820
 821     my $verifylog = "$LOGDIR/".
 822         servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
 823     unlink($verifylog) if(-f $verifylog);
 824
 825     if($proto eq "ftps") {
 826         $extra .= "--insecure --ftp-ssl-control ";
 827     }
 828
 829     my $flags = "--max-time $server_response_maxtime ";
 830     $flags .= "--silent ";
 831     $flags .= "--verbose ";
 832     $flags .= "--globoff ";
 833     $flags .= $extra;
 834     $flags .= "\"$proto://$ip:$port/verifiedserver\"";
 835
 836     my $cmd = "$VCURL $flags 2>$verifylog";
 837
 838     # check if this is our server running on this port:
 839     logmsg "RUN: $cmd\n" if($verbose);
 840     my @data = runclientoutput($cmd);
 841
 842     my $res = $? >> 8; # rotate the result
 843     if($res & 128) {
 844         logmsg "RUN: curl command died with a coredump\n";
 845         return -1;
 846     }
 847
 848     foreach my $line (@data) {
 849         if($line =~ /WE ROOLZ: (\d+)/) {
 850             # this is our test server with a known pid!
 851             $pid = 0+$1;
 852             last;
 853         }
 854     }
 855     if($pid <= 0 && @data && $data[0]) {
 856         # this is not a known server
 857         logmsg "RUN: Unknown server on our $server port: $port\n";
 858         return 0;
 859     }
 860     # we can/should use the time it took to verify the FTP server as a measure
 861     # on how fast/slow this host/FTP is.
 862     my $took = int(0.5+time()-$time);
 863
 864     if($verbose) {
 865         logmsg "RUN: Verifying our test $server server took $took seconds\n";
 866     }
 867     $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
 868
 869     return $pid;
 870 }
 871
 872 #######################################################################
 873 # Verify that the server that runs on $ip, $port is our server.  This also
 874 # implies that we can speak with it, as there might be occasions when the
 875 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
 876 # assign requested address")
 877 #
 878 sub verifyrtsp {
 879     my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
 880     my $server = servername_id($proto, $ipvnum, $idnum);
 881     my $pid = 0;
 882
 883     my $verifyout = "$LOGDIR/".
 884         servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
 885     unlink($verifyout) if(-f $verifyout);
 886
 887     my $verifylog = "$LOGDIR/".
 888         servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
 889     unlink($verifylog) if(-f $verifylog);
 890
 891     my $flags = "--max-time $server_response_maxtime ";
 892     $flags .= "--output $verifyout ";
 893     $flags .= "--silent ";
 894     $flags .= "--verbose ";
 895     $flags .= "--globoff ";
 896     # currently verification is done using http
 897     $flags .= "\"http://$ip:$port/verifiedserver\"";
 898
 899     my $cmd = "$VCURL $flags 2>$verifylog";
 900
 901     # verify if our/any server is running on this port
 902     logmsg "RUN: $cmd\n" if($verbose);
 903     my $res = runclient($cmd);
 904
 905     $res >>= 8; # rotate the result
 906     if($res & 128) {
 907         logmsg "RUN: curl command died with a coredump\n";
 908         return -1;
 909     }
 910
 911     if($res && $verbose) {
 912         logmsg "RUN: curl command returned $res\n";
 913         if(open(FILE, "<$verifylog")) {
 914             while(my $string = <FILE>) {
 915                 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
 916             }
 917             close(FILE);
 918         }
 919     }
 920
 921     my $data;
 922     if(open(FILE, "<$verifyout")) {
 923         while(my $string = <FILE>) {
 924             $data = $string;
 925             last; # only want first line
 926         }
 927         close(FILE);
 928     }
 929
 930     if($data && ($data =~ /RTSP_SERVER WE ROOLZ: (\d+)/)) {
 931         $pid = 0+$1;
 932     }
 933     elsif($res == 6) {
 934         # curl: (6) Couldn't resolve host '::1'
 935         logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
 936         return -1;
 937     }
 938     elsif($data || ($res != 7)) {
 939         logmsg "RUN: Unknown server on our $server port: $port\n";
 940         return -1;
 941     }
 942     return $pid;
 943 }
 944
 945 #######################################################################
 946 # Verify that the ssh server has written out its pidfile, recovering
 947 # the pid from the file and returning it if a process with that pid is
 948 # actually alive.
 949 #
 950 sub verifyssh {
 951     my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
 952     my $server = servername_id($proto, $ipvnum, $idnum);
 953     my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
 954     my $pid = 0;
 955     if(open(FILE, "<$pidfile")) {
 956         $pid=0+<FILE>;
 957         close(FILE);
 958     }
 959     if($pid > 0) {
 960         # if we have a pid it is actually our ssh server,
 961         # since runsshserver() unlinks previous pidfile
 962         if(!pidexists($pid)) {
 963             logmsg "RUN: SSH server has died after starting up\n";
 964             checkdied($pid);
 965             unlink($pidfile);
 966             $pid = -1;
 967         }
 968     }
 969     return $pid;
 970 }
 971
 972 #######################################################################
 973 # Verify that we can connect to the sftp server, properly authenticate
 974 # with generated config and key files and run a simple remote pwd.
 975 #
 976 sub verifysftp {
 977     my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
 978     my $server = servername_id($proto, $ipvnum, $idnum);
 979     my $verified = 0;
 980     # Find out sftp client canonical file name
 981     my $sftp = find_sftp();
 982     if(!$sftp) {
 983         logmsg "RUN: SFTP server cannot find $sftpexe\n";
 984         return -1;
 985     }
 986     # Find out ssh client canonical file name
 987     my $ssh = find_ssh();
 988     if(!$ssh) {
 989         logmsg "RUN: SFTP server cannot find $sshexe\n";
 990         return -1;
 991     }
 992     # Connect to sftp server, authenticate and run a remote pwd
 993     # command using our generated configuration and key files
 994     my $cmd = "\"$sftp\" -b $sftpcmds -F $sftpconfig -S \"$ssh\" $ip > $sftplog 2>&1";
 995     my $res = runclient($cmd);
 996     # Search for pwd command response in log file
 997     if(open(SFTPLOGFILE, "<$sftplog")) {
 998         while(<SFTPLOGFILE>) {
 999             if(/^Remote working directory: /) {
1000                 $verified = 1;
1001                 last;
1002             }
1003         }
1004         close(SFTPLOGFILE);
1005     }
1006     return $verified;
1007 }
1008
1009 #######################################################################
1010 # Verify that the non-stunnel HTTP TLS extensions capable server that runs
1011 # on $ip, $port is our server.  This also implies that we can speak with it,
1012 # as there might be occasions when the server runs fine but we cannot talk
1013 # to it ("Failed to connect to ::1: Can't assign requested address")
1014 #
1015 sub verifyhttptls {
1016     my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1017     my $server = servername_id($proto, $ipvnum, $idnum);
1018     my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
1019     my $pid = 0;
1020
1021     my $verifyout = "$LOGDIR/".
1022         servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
1023     unlink($verifyout) if(-f $verifyout);
1024
1025     my $verifylog = "$LOGDIR/".
1026         servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
1027     unlink($verifylog) if(-f $verifylog);
1028
1029     my $flags = "--max-time $server_response_maxtime ";
1030     $flags .= "--output $verifyout ";
1031     $flags .= "--verbose ";
1032     $flags .= "--globoff ";
1033     $flags .= "--insecure ";
1034     $flags .= "--tlsauthtype SRP ";
1035     $flags .= "--tlsuser jsmith ";
1036     $flags .= "--tlspassword abc ";
1037     $flags .= "\"https://$ip:$port/verifiedserver\"";
1038
1039     my $cmd = "$VCURL $flags 2>$verifylog";
1040
1041     # verify if our/any server is running on this port
1042     logmsg "RUN: $cmd\n" if($verbose);
1043     my $res = runclient($cmd);
1044
1045     $res >>= 8; # rotate the result
1046     if($res & 128) {
1047         logmsg "RUN: curl command died with a coredump\n";
1048         return -1;
1049     }
1050
1051     if($res && $verbose) {
1052         logmsg "RUN: curl command returned $res\n";
1053         if(open(FILE, "<$verifylog")) {
1054             while(my $string = <FILE>) {
1055                 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
1056             }
1057             close(FILE);
1058         }
1059     }
1060
1061     my $data;
1062     if(open(FILE, "<$verifyout")) {
1063         while(my $string = <FILE>) {
1064             $data .= $string;
1065         }
1066         close(FILE);
1067     }
1068
1069     if($data && ($data =~ /(GNUTLS|GnuTLS)/) && open(FILE, "<$pidfile")) {
1070         $pid=0+<FILE>;
1071         close(FILE);
1072         if($pid > 0) {
1073             # if we have a pid it is actually our httptls server,
1074             # since runhttptlsserver() unlinks previous pidfile
1075             if(!pidexists($pid)) {
1076                 logmsg "RUN: $server server has died after starting up\n";
1077                 checkdied($pid);
1078                 unlink($pidfile);
1079                 $pid = -1;
1080             }
1081         }
1082         return $pid;
1083     }
1084     elsif($res == 6) {
1085         # curl: (6) Couldn't resolve host '::1'
1086         logmsg "RUN: failed to resolve host (https://$ip:$port/verifiedserver)\n";
1087         return -1;
1088     }
1089     elsif($data || ($res && ($res != 7))) {
1090         logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
1091         return -1;
1092     }
1093     return $pid;
1094 }
1095
1096 #######################################################################
1097 # STUB for verifying socks
1098 #
1099 sub verifysocks {
1100     my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1101     my $server = servername_id($proto, $ipvnum, $idnum);
1102     my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
1103     my $pid = 0;
1104     if(open(FILE, "<$pidfile")) {
1105         $pid=0+<FILE>;
1106         close(FILE);
1107     }
1108     if($pid > 0) {
1109         # if we have a pid it is actually our socks server,
1110         # since runsocksserver() unlinks previous pidfile
1111         if(!pidexists($pid)) {
1112             logmsg "RUN: SOCKS server has died after starting up\n";
1113             checkdied($pid);
1114             unlink($pidfile);
1115             $pid = -1;
1116         }
1117     }
1118     return $pid;
1119 }
1120
1121 #######################################################################
1122 # Verify that the server that runs on $ip, $port is our server.
1123 # Retry over several seconds before giving up.  The ssh server in
1124 # particular can take a long time to start if it needs to generate
1125 # keys on a slow or loaded host.
1126 #
1127 # Just for convenience, test harness uses 'https' and 'httptls' literals
1128 # as values for 'proto' variable in order to differentiate different
1129 # servers. 'https' literal is used for stunnel based https test servers,
1130 # and 'httptls' is used for non-stunnel https test servers.
1131 #
1132
1133 my %protofunc = ('http' => \&verifyhttp,
1134                  'https' => \&verifyhttp,
1135                  'rtsp' => \&verifyrtsp,
1136                  'ftp' => \&verifyftp,
1137                  'pop3' => \&verifyftp,
1138                  'imap' => \&verifyftp,
1139                  'smtp' => \&verifyftp,
1140                  'httppipe' => \&verifyhttp,
1141                  'ftps' => \&verifyftp,
1142                  'tftp' => \&verifyftp,
1143                  'ssh' => \&verifyssh,
1144                  'socks' => \&verifysocks,
1145                  'gopher' => \&verifyhttp,
1146                  'httptls' => \&verifyhttptls);
1147
1148 sub verifyserver {
1149     my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1150
1151     my $count = 30; # try for this many seconds
1152     my $pid;
1153
1154     while($count--) {
1155         my $fun = $protofunc{$proto};
1156
1157         $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
1158
1159         if($pid > 0) {
1160             last;
1161         }
1162         elsif($pid < 0) {
1163             # a real failure, stop trying and bail out
1164             return 0;
1165         }
1166         sleep(1);
1167     }
1168     return $pid;
1169 }
1170
1171 #######################################################################
1172 # Single shot server responsiveness test. This should only be used
1173 # to verify that a server present in %run hash is still functional
1174 #
1175 sub responsiveserver {
1176     my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1177     my $prev_verbose = $verbose;
1178
1179     $verbose = 0;
1180     my $fun = $protofunc{$proto};
1181     my $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
1182     $verbose = $prev_verbose;
1183
1184     if($pid > 0) {
1185         return 1; # responsive
1186     }
1187
1188     my $srvrname = servername_str($proto, $ipvnum, $idnum);
1189     logmsg " server precheck FAILED (unresponsive $srvrname server)\n";
1190     return 0;
1191 }
1192
1193 #######################################################################
1194 # start the http2 server
1195 #
1196 sub runhttp2server {
1197     my ($verbose, $port) = @_;
1198     my $server;
1199     my $srvrname;
1200     my $pidfile;
1201     my $logfile;
1202     my $flags = "";
1203     my $proto="http/2";
1204     my $ipvnum = 4;
1205     my $idnum = 0;
1206     my $exe = "$perl $srcdir/http2-server.pl";
1207     my $verbose_flag = "--verbose ";
1208
1209     $server = servername_id($proto, $ipvnum, $idnum);
1210
1211     $pidfile = $serverpidfile{$server};
1212
1213     # don't retry if the server doesn't work
1214     if ($doesntrun{$pidfile}) {
1215         return (0,0);
1216     }
1217
1218     my $pid = processexists($pidfile);
1219     if($pid > 0) {
1220         stopserver($server, "$pid");
1221     }
1222     unlink($pidfile) if(-f $pidfile);
1223
1224     $srvrname = servername_str($proto, $ipvnum, $idnum);
1225
1226     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1227
1228     $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1229     $flags .= "--port $HTTP2PORT ";
1230     $flags .= $verbose_flag if($debugprotocol);
1231
1232     my $cmd = "$exe $flags";
1233     my ($http2pid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1234
1235     if($http2pid <= 0 || !pidexists($http2pid)) {
1236         # it is NOT alive
1237         logmsg "RUN: failed to start the $srvrname server\n";
1238         stopserver($server, "$pid2");
1239         $doesntrun{$pidfile} = 1;
1240         return (0,0);
1241     }
1242
1243     if($verbose) {
1244         logmsg "RUN: $srvrname server is now running PID $http2pid\n";
1245     }
1246
1247     return ($http2pid, $pid2);
1248 }
1249
1250 #######################################################################
1251 # start the http server
1252 #
1253 sub runhttpserver {
1254     my ($proto, $verbose, $alt, $port_or_path) = @_;
1255     my $ip = $HOSTIP;
1256     my $ipvnum = 4;
1257     my $idnum = 1;
1258     my $server;
1259     my $srvrname;
1260     my $pidfile;
1261     my $logfile;
1262     my $flags = "";
1263     my $exe = "$perl $srcdir/httpserver.pl";
1264     my $verbose_flag = "--verbose ";
1265
1266     if($alt eq "ipv6") {
1267         # if IPv6, use a different setup
1268         $ipvnum = 6;
1269         $ip = $HOST6IP;
1270     }
1271     elsif($alt eq "proxy") {
1272         # basically the same, but another ID
1273         $idnum = 2;
1274     }
1275     elsif($alt eq "pipe") {
1276         # basically the same, but another ID
1277         $idnum = 3;
1278         $exe = "python $srcdir/http_pipe.py";
1279         $verbose_flag .= "1 ";
1280     }
1281     elsif($alt eq "unix") {
1282         # IP (protocol) is mutually exclusive with Unix sockets
1283         $ipvnum = "unix";
1284     }
1285
1286     $server = servername_id($proto, $ipvnum, $idnum);
1287
1288     $pidfile = $serverpidfile{$server};
1289
1290     # don't retry if the server doesn't work
1291     if ($doesntrun{$pidfile}) {
1292         return (0,0);
1293     }
1294
1295     my $pid = processexists($pidfile);
1296     if($pid > 0) {
1297         stopserver($server, "$pid");
1298     }
1299     unlink($pidfile) if(-f $pidfile);
1300
1301     $srvrname = servername_str($proto, $ipvnum, $idnum);
1302
1303     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1304
1305     $flags .= "--gopher " if($proto eq "gopher");
1306     $flags .= "--connect $HOSTIP " if($alt eq "proxy");
1307     $flags .= $verbose_flag if($debugprotocol);
1308     $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1309     $flags .= "--id $idnum " if($idnum > 1);
1310     if($ipvnum eq "unix") {
1311         $flags .= "--unix-socket '$port_or_path' ";
1312     } else {
1313         $flags .= "--ipv$ipvnum --port $port_or_path ";
1314     }
1315     $flags .= "--srcdir \"$srcdir\"";
1316
1317     my $cmd = "$exe $flags";
1318     my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1319
1320     if($httppid <= 0 || !pidexists($httppid)) {
1321         # it is NOT alive
1322         logmsg "RUN: failed to start the $srvrname server\n";
1323         stopserver($server, "$pid2");
1324         displaylogs($testnumcheck);
1325         $doesntrun{$pidfile} = 1;
1326         return (0,0);
1327     }
1328
1329     # Server is up. Verify that we can speak to it.
1330     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
1331     if(!$pid3) {
1332         logmsg "RUN: $srvrname server failed verification\n";
1333         # failed to talk to it properly. Kill the server and return failure
1334         stopserver($server, "$httppid $pid2");
1335         displaylogs($testnumcheck);
1336         $doesntrun{$pidfile} = 1;
1337         return (0,0);
1338     }
1339     $pid2 = $pid3;
1340
1341     if($verbose) {
1342         logmsg "RUN: $srvrname server is now running PID $httppid\n";
1343     }
1344
1345     sleep(1);
1346
1347     return ($httppid, $pid2);
1348 }
1349
1350 #######################################################################
1351 # start the http server
1352 #
1353 sub runhttp_pipeserver {
1354     my ($proto, $verbose, $alt, $port) = @_;
1355     my $ip = $HOSTIP;
1356     my $ipvnum = 4;
1357     my $idnum = 1;
1358     my $server;
1359     my $srvrname;
1360     my $pidfile;
1361     my $logfile;
1362     my $flags = "";
1363
1364     if($alt eq "ipv6") {
1365         # No IPv6
1366     }
1367
1368     $server = servername_id($proto, $ipvnum, $idnum);
1369
1370     $pidfile = $serverpidfile{$server};
1371
1372     # don't retry if the server doesn't work
1373     if ($doesntrun{$pidfile}) {
1374         return (0,0);
1375     }
1376
1377     my $pid = processexists($pidfile);
1378     if($pid > 0) {
1379         stopserver($server, "$pid");
1380     }
1381     unlink($pidfile) if(-f $pidfile);
1382
1383     $srvrname = servername_str($proto, $ipvnum, $idnum);
1384
1385     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1386
1387     $flags .= "--verbose 1 " if($debugprotocol);
1388     $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1389     $flags .= "--id $idnum " if($idnum > 1);
1390     $flags .= "--port $port --srcdir \"$srcdir\"";
1391
1392     my $cmd = "$srcdir/http_pipe.py $flags";
1393     my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1394
1395     if($httppid <= 0 || !pidexists($httppid)) {
1396         # it is NOT alive
1397         logmsg "RUN: failed to start the $srvrname server\n";
1398         stopserver($server, "$pid2");
1399         displaylogs($testnumcheck);
1400         $doesntrun{$pidfile} = 1;
1401         return (0,0);
1402     }
1403
1404     # Server is up. Verify that we can speak to it.
1405     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1406     if(!$pid3) {
1407         logmsg "RUN: $srvrname server failed verification\n";
1408         # failed to talk to it properly. Kill the server and return failure
1409         stopserver($server, "$httppid $pid2");
1410         displaylogs($testnumcheck);
1411         $doesntrun{$pidfile} = 1;
1412         return (0,0);
1413     }
1414     $pid2 = $pid3;
1415
1416     if($verbose) {
1417         logmsg "RUN: $srvrname server is now running PID $httppid\n";
1418     }
1419
1420     sleep(1);
1421
1422     return ($httppid, $pid2);
1423 }
1424
1425 #######################################################################
1426 # start the https stunnel based server
1427 #
1428 sub runhttpsserver {
1429     my ($verbose, $ipv6, $certfile) = @_;
1430     my $proto = 'https';
1431     my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1432     my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1433     my $idnum = 1;
1434     my $server;
1435     my $srvrname;
1436     my $pidfile;
1437     my $logfile;
1438     my $flags = "";
1439
1440     if(!$stunnel) {
1441         return (0,0);
1442     }
1443
1444     $server = servername_id($proto, $ipvnum, $idnum);
1445
1446     $pidfile = $serverpidfile{$server};
1447
1448     # don't retry if the server doesn't work
1449     if ($doesntrun{$pidfile}) {
1450         return (0,0);
1451     }
1452
1453     my $pid = processexists($pidfile);
1454     if($pid > 0) {
1455         stopserver($server, "$pid");
1456     }
1457     unlink($pidfile) if(-f $pidfile);
1458
1459     $srvrname = servername_str($proto, $ipvnum, $idnum);
1460
1461     $certfile = 'stunnel.pem' unless($certfile);
1462
1463     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1464
1465     $flags .= "--verbose " if($debugprotocol);
1466     $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1467     $flags .= "--id $idnum " if($idnum > 1);
1468     $flags .= "--ipv$ipvnum --proto $proto ";
1469     $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
1470     $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
1471     $flags .= "--connect $HTTPPORT --accept $HTTPSPORT";
1472
1473     my $cmd = "$perl $srcdir/secureserver.pl $flags";
1474     my ($httpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1475
1476     if($httpspid <= 0 || !pidexists($httpspid)) {
1477         # it is NOT alive
1478         logmsg "RUN: failed to start the $srvrname server\n";
1479         stopserver($server, "$pid2");
1480         displaylogs($testnumcheck);
1481         $doesntrun{$pidfile} = 1;
1482         return(0,0);
1483     }
1484
1485     # Server is up. Verify that we can speak to it.
1486     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $HTTPSPORT);
1487     if(!$pid3) {
1488         logmsg "RUN: $srvrname server failed verification\n";
1489         # failed to talk to it properly. Kill the server and return failure
1490         stopserver($server, "$httpspid $pid2");
1491         displaylogs($testnumcheck);
1492         $doesntrun{$pidfile} = 1;
1493         return (0,0);
1494     }
1495     # Here pid3 is actually the pid returned by the unsecure-http server.
1496
1497     $runcert{$server} = $certfile;
1498
1499     if($verbose) {
1500         logmsg "RUN: $srvrname server is now running PID $httpspid\n";
1501     }
1502
1503     sleep(1);
1504
1505     return ($httpspid, $pid2);
1506 }
1507
1508 #######################################################################
1509 # start the non-stunnel HTTP TLS extensions capable server
1510 #
1511 sub runhttptlsserver {
1512     my ($verbose, $ipv6) = @_;
1513     my $proto = "httptls";
1514     my $port = ($ipv6 && ($ipv6 =~ /6$/)) ? $HTTPTLS6PORT : $HTTPTLSPORT;
1515     my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1516     my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1517     my $idnum = 1;
1518     my $server;
1519     my $srvrname;
1520     my $pidfile;
1521     my $logfile;
1522     my $flags = "";
1523
1524     if(!$httptlssrv) {
1525         return (0,0);
1526     }
1527
1528     $server = servername_id($proto, $ipvnum, $idnum);
1529
1530     $pidfile = $serverpidfile{$server};
1531
1532     # don't retry if the server doesn't work
1533     if ($doesntrun{$pidfile}) {
1534         return (0,0);
1535     }
1536
1537     my $pid = processexists($pidfile);
1538     if($pid > 0) {
1539         stopserver($server, "$pid");
1540     }
1541     unlink($pidfile) if(-f $pidfile);
1542
1543     $srvrname = servername_str($proto, $ipvnum, $idnum);
1544
1545     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1546
1547     $flags .= "--http ";
1548     $flags .= "--debug 1 " if($debugprotocol);
1549     $flags .= "--port $port ";
1550     $flags .= "--priority NORMAL:+SRP ";
1551     $flags .= "--srppasswd $srcdir/certs/srp-verifier-db ";
1552     $flags .= "--srppasswdconf $srcdir/certs/srp-verifier-conf";
1553
1554     my $cmd = "$httptlssrv $flags > $logfile 2>&1";
1555     my ($httptlspid, $pid2) = startnew($cmd, $pidfile, 10, 1); # fake pidfile
1556
1557     if($httptlspid <= 0 || !pidexists($httptlspid)) {
1558         # it is NOT alive
1559         logmsg "RUN: failed to start the $srvrname server\n";
1560         stopserver($server, "$pid2");
1561         displaylogs($testnumcheck);
1562         $doesntrun{$pidfile} = 1;
1563         return (0,0);
1564     }
1565
1566     # Server is up. Verify that we can speak to it. PID is from fake pidfile
1567     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1568     if(!$pid3) {
1569         logmsg "RUN: $srvrname server failed verification\n";
1570         # failed to talk to it properly. Kill the server and return failure
1571         stopserver($server, "$httptlspid $pid2");
1572         displaylogs($testnumcheck);
1573         $doesntrun{$pidfile} = 1;
1574         return (0,0);
1575     }
1576     $pid2 = $pid3;
1577
1578     if($verbose) {
1579         logmsg "RUN: $srvrname server is now running PID $httptlspid\n";
1580     }
1581
1582     sleep(1);
1583
1584     return ($httptlspid, $pid2);
1585 }
1586
1587 #######################################################################
1588 # start the pingpong server (FTP, POP3, IMAP, SMTP)
1589 #
1590 sub runpingpongserver {
1591     my ($proto, $id, $verbose, $ipv6) = @_;
1592     my $port;
1593     my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1594     my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1595     my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1596     my $server;
1597     my $srvrname;
1598     my $pidfile;
1599     my $logfile;
1600     my $flags = "";
1601
1602     if($proto eq "ftp") {
1603         $port = ($idnum>1)?$FTP2PORT:$FTPPORT;
1604
1605         if($ipvnum==6) {
1606             # if IPv6, use a different setup
1607             $port = $FTP6PORT;
1608         }
1609     }
1610     elsif($proto eq "pop3") {
1611         $port = ($ipvnum==6) ? $POP36PORT : $POP3PORT;
1612     }
1613     elsif($proto eq "imap") {
1614         $port = ($ipvnum==6) ? $IMAP6PORT : $IMAPPORT;
1615     }
1616     elsif($proto eq "smtp") {
1617         $port = ($ipvnum==6) ? $SMTP6PORT : $SMTPPORT;
1618     }
1619     else {
1620         print STDERR "Unsupported protocol $proto!!\n";
1621         return 0;
1622     }
1623
1624     $server = servername_id($proto, $ipvnum, $idnum);
1625
1626     $pidfile = $serverpidfile{$server};
1627
1628     # don't retry if the server doesn't work
1629     if ($doesntrun{$pidfile}) {
1630         return (0,0);
1631     }
1632
1633     my $pid = processexists($pidfile);
1634     if($pid > 0) {
1635         stopserver($server, "$pid");
1636     }
1637     unlink($pidfile) if(-f $pidfile);
1638
1639     $srvrname = servername_str($proto, $ipvnum, $idnum);
1640
1641     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1642
1643     $flags .= "--verbose " if($debugprotocol);
1644     $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1645     $flags .= "--srcdir \"$srcdir\" --proto $proto ";
1646     $flags .= "--id $idnum " if($idnum > 1);
1647     $flags .= "--ipv$ipvnum --port $port --addr \"$ip\"";
1648
1649     my $cmd = "$perl $srcdir/ftpserver.pl $flags";
1650     my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1651
1652     if($ftppid <= 0 || !pidexists($ftppid)) {
1653         # it is NOT alive
1654         logmsg "RUN: failed to start the $srvrname server\n";
1655         stopserver($server, "$pid2");
1656         displaylogs($testnumcheck);
1657         $doesntrun{$pidfile} = 1;
1658         return (0,0);
1659     }
1660
1661     # Server is up. Verify that we can speak to it.
1662     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1663     if(!$pid3) {
1664         logmsg "RUN: $srvrname server failed verification\n";
1665         # failed to talk to it properly. Kill the server and return failure
1666         stopserver($server, "$ftppid $pid2");
1667         displaylogs($testnumcheck);
1668         $doesntrun{$pidfile} = 1;
1669         return (0,0);
1670     }
1671
1672     $pid2 = $pid3;
1673
1674     if($verbose) {
1675         logmsg "RUN: $srvrname server is now running PID $ftppid\n";
1676     }
1677
1678     sleep(1);
1679
1680     return ($pid2, $ftppid);
1681 }
1682
1683 #######################################################################
1684 # start the ftps server (or rather, tunnel)
1685 #
1686 sub runftpsserver {
1687     my ($verbose, $ipv6, $certfile) = @_;
1688     my $proto = 'ftps';
1689     my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1690     my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1691     my $idnum = 1;
1692     my $server;
1693     my $srvrname;
1694     my $pidfile;
1695     my $logfile;
1696     my $flags = "";
1697
1698     if(!$stunnel) {
1699         return (0,0);
1700     }
1701
1702     $server = servername_id($proto, $ipvnum, $idnum);
1703
1704     $pidfile = $serverpidfile{$server};
1705
1706     # don't retry if the server doesn't work
1707     if ($doesntrun{$pidfile}) {
1708         return (0,0);
1709     }
1710
1711     my $pid = processexists($pidfile);
1712     if($pid > 0) {
1713         stopserver($server, "$pid");
1714     }
1715     unlink($pidfile) if(-f $pidfile);
1716
1717     $srvrname = servername_str($proto, $ipvnum, $idnum);
1718
1719     $certfile = 'stunnel.pem' unless($certfile);
1720
1721     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1722
1723     $flags .= "--verbose " if($debugprotocol);
1724     $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1725     $flags .= "--id $idnum " if($idnum > 1);
1726     $flags .= "--ipv$ipvnum --proto $proto ";
1727     $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
1728     $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
1729     $flags .= "--connect $FTPPORT --accept $FTPSPORT";
1730
1731     my $cmd = "$perl $srcdir/secureserver.pl $flags";
1732     my ($ftpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1733
1734     if($ftpspid <= 0 || !pidexists($ftpspid)) {
1735         # it is NOT alive
1736         logmsg "RUN: failed to start the $srvrname server\n";
1737         stopserver($server, "$pid2");
1738         displaylogs($testnumcheck);
1739         $doesntrun{$pidfile} = 1;
1740         return(0,0);
1741     }
1742
1743     # Server is up. Verify that we can speak to it.
1744     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $FTPSPORT);
1745     if(!$pid3) {
1746         logmsg "RUN: $srvrname server failed verification\n";
1747         # failed to talk to it properly. Kill the server and return failure
1748         stopserver($server, "$ftpspid $pid2");
1749         displaylogs($testnumcheck);
1750         $doesntrun{$pidfile} = 1;
1751         return (0,0);
1752     }
1753     # Here pid3 is actually the pid returned by the unsecure-ftp server.
1754
1755     $runcert{$server} = $certfile;
1756
1757     if($verbose) {
1758         logmsg "RUN: $srvrname server is now running PID $ftpspid\n";
1759     }
1760
1761     sleep(1);
1762
1763     return ($ftpspid, $pid2);
1764 }
1765
1766 #######################################################################
1767 # start the tftp server
1768 #
1769 sub runtftpserver {
1770     my ($id, $verbose, $ipv6) = @_;
1771     my $port = $TFTPPORT;
1772     my $ip = $HOSTIP;
1773     my $proto = 'tftp';
1774     my $ipvnum = 4;
1775     my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1776     my $server;
1777     my $srvrname;
1778     my $pidfile;
1779     my $logfile;
1780     my $flags = "";
1781
1782     if($ipv6) {
1783         # if IPv6, use a different setup
1784         $ipvnum = 6;
1785         $port = $TFTP6PORT;
1786         $ip = $HOST6IP;
1787     }
1788
1789     $server = servername_id($proto, $ipvnum, $idnum);
1790
1791     $pidfile = $serverpidfile{$server};
1792
1793     # don't retry if the server doesn't work
1794     if ($doesntrun{$pidfile}) {
1795         return (0,0);
1796     }
1797
1798     my $pid = processexists($pidfile);
1799     if($pid > 0) {
1800         stopserver($server, "$pid");
1801     }
1802     unlink($pidfile) if(-f $pidfile);
1803
1804     $srvrname = servername_str($proto, $ipvnum, $idnum);
1805
1806     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1807
1808     $flags .= "--verbose " if($debugprotocol);
1809     $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1810     $flags .= "--id $idnum " if($idnum > 1);
1811     $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\"";
1812
1813     my $cmd = "$perl $srcdir/tftpserver.pl $flags";
1814     my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1815
1816     if($tftppid <= 0 || !pidexists($tftppid)) {
1817         # it is NOT alive
1818         logmsg "RUN: failed to start the $srvrname server\n";
1819         stopserver($server, "$pid2");
1820         displaylogs($testnumcheck);
1821         $doesntrun{$pidfile} = 1;
1822         return (0,0);
1823     }
1824
1825     # Server is up. Verify that we can speak to it.
1826     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1827     if(!$pid3) {
1828         logmsg "RUN: $srvrname server failed verification\n";
1829         # failed to talk to it properly. Kill the server and return failure
1830         stopserver($server, "$tftppid $pid2");
1831         displaylogs($testnumcheck);
1832         $doesntrun{$pidfile} = 1;
1833         return (0,0);
1834     }
1835     $pid2 = $pid3;
1836
1837     if($verbose) {
1838         logmsg "RUN: $srvrname server is now running PID $tftppid\n";
1839     }
1840
1841     sleep(1);
1842
1843     return ($pid2, $tftppid);
1844 }
1845
1846
1847 #######################################################################
1848 # start the rtsp server
1849 #
1850 sub runrtspserver {
1851     my ($verbose, $ipv6) = @_;
1852     my $port = $RTSPPORT;
1853     my $ip = $HOSTIP;
1854     my $proto = 'rtsp';
1855     my $ipvnum = 4;
1856     my $idnum = 1;
1857     my $server;
1858     my $srvrname;
1859     my $pidfile;
1860     my $logfile;
1861     my $flags = "";
1862
1863     if($ipv6) {
1864         # if IPv6, use a different setup
1865         $ipvnum = 6;
1866         $port = $RTSP6PORT;
1867         $ip = $HOST6IP;
1868     }
1869
1870     $server = servername_id($proto, $ipvnum, $idnum);
1871
1872     $pidfile = $serverpidfile{$server};
1873
1874     # don't retry if the server doesn't work
1875     if ($doesntrun{$pidfile}) {
1876         return (0,0);
1877     }
1878
1879     my $pid = processexists($pidfile);
1880     if($pid > 0) {
1881         stopserver($server, "$pid");
1882     }
1883     unlink($pidfile) if(-f $pidfile);
1884
1885     $srvrname = servername_str($proto, $ipvnum, $idnum);
1886
1887     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1888
1889     $flags .= "--verbose " if($debugprotocol);
1890     $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1891     $flags .= "--id $idnum " if($idnum > 1);
1892     $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\"";
1893
1894     my $cmd = "$perl $srcdir/rtspserver.pl $flags";
1895     my ($rtsppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1896
1897     if($rtsppid <= 0 || !pidexists($rtsppid)) {
1898         # it is NOT alive
1899         logmsg "RUN: failed to start the $srvrname server\n";
1900         stopserver($server, "$pid2");
1901         displaylogs($testnumcheck);
1902         $doesntrun{$pidfile} = 1;
1903         return (0,0);
1904     }
1905
1906     # Server is up. Verify that we can speak to it.
1907     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1908     if(!$pid3) {
1909         logmsg "RUN: $srvrname server failed verification\n";
1910         # failed to talk to it properly. Kill the server and return failure
1911         stopserver($server, "$rtsppid $pid2");
1912         displaylogs($testnumcheck);
1913         $doesntrun{$pidfile} = 1;
1914         return (0,0);
1915     }
1916     $pid2 = $pid3;
1917
1918     if($verbose) {
1919         logmsg "RUN: $srvrname server is now running PID $rtsppid\n";
1920     }
1921
1922     sleep(1);
1923
1924     return ($rtsppid, $pid2);
1925 }
1926
1927
1928 #######################################################################
1929 # Start the ssh (scp/sftp) server
1930 #
1931 sub runsshserver {
1932     my ($id, $verbose, $ipv6) = @_;
1933     my $ip=$HOSTIP;
1934     my $port = $SSHPORT;
1935     my $socksport = $SOCKSPORT;
1936     my $proto = 'ssh';
1937     my $ipvnum = 4;
1938     my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1939     my $server;
1940     my $srvrname;
1941     my $pidfile;
1942     my $logfile;
1943     my $flags = "";
1944
1945     $server = servername_id($proto, $ipvnum, $idnum);
1946
1947     $pidfile = $serverpidfile{$server};
1948
1949     # don't retry if the server doesn't work
1950     if ($doesntrun{$pidfile}) {
1951         return (0,0);
1952     }
1953
1954     my $pid = processexists($pidfile);
1955     if($pid > 0) {
1956         stopserver($server, "$pid");
1957     }
1958     unlink($pidfile) if(-f $pidfile);
1959
1960     $srvrname = servername_str($proto, $ipvnum, $idnum);
1961
1962     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1963
1964     $flags .= "--verbose " if($verbose);
1965     $flags .= "--debugprotocol " if($debugprotocol);
1966     $flags .= "--pidfile \"$pidfile\" ";
1967     $flags .= "--id $idnum " if($idnum > 1);
1968     $flags .= "--ipv$ipvnum --addr \"$ip\" ";
1969     $flags .= "--sshport $port --socksport $socksport ";
1970     $flags .= "--user \"$USER\"";
1971
1972     my $cmd = "$perl $srcdir/sshserver.pl $flags";
1973     my ($sshpid, $pid2) = startnew($cmd, $pidfile, 60, 0);
1974
1975     # on loaded systems sshserver start up can take longer than the timeout
1976     # passed to startnew, when this happens startnew completes without being
1977     # able to read the pidfile and consequently returns a zero pid2 above.
1978
1979     if($sshpid <= 0 || !pidexists($sshpid)) {
1980         # it is NOT alive
1981         logmsg "RUN: failed to start the $srvrname server\n";
1982         stopserver($server, "$pid2");
1983         $doesntrun{$pidfile} = 1;
1984         return (0,0);
1985     }
1986
1987     # ssh server verification allows some extra time for the server to start up
1988     # and gives us the opportunity of recovering the pid from the pidfile, when
1989     # this verification succeeds the recovered pid is assigned to pid2.
1990
1991     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1992     if(!$pid3) {
1993         logmsg "RUN: $srvrname server failed verification\n";
1994         # failed to fetch server pid. Kill the server and return failure
1995         stopserver($server, "$sshpid $pid2");
1996         $doesntrun{$pidfile} = 1;
1997         return (0,0);
1998     }
1999     $pid2 = $pid3;
2000
2001     # once it is known that the ssh server is alive, sftp server verification
2002     # is performed actually connecting to it, authenticating and performing a
2003     # very simple remote command.  This verification is tried only one time.
2004
2005     $sshdlog = server_logfilename($LOGDIR, 'ssh', $ipvnum, $idnum);
2006     $sftplog = server_logfilename($LOGDIR, 'sftp', $ipvnum, $idnum);
2007
2008     if(verifysftp('sftp', $ipvnum, $idnum, $ip, $port) < 1) {
2009         logmsg "RUN: SFTP server failed verification\n";
2010         # failed to talk to it properly. Kill the server and return failure
2011         display_sftplog();
2012         display_sftpconfig();
2013         display_sshdlog();
2014         display_sshdconfig();
2015         stopserver($server, "$sshpid $pid2");
2016         $doesntrun{$pidfile} = 1;
2017         return (0,0);
2018     }
2019
2020     if($verbose) {
2021         logmsg "RUN: $srvrname server is now running PID $pid2\n";
2022     }
2023
2024     return ($pid2, $sshpid);
2025 }
2026
2027 #######################################################################
2028 # Start the socks server
2029 #
2030 sub runsocksserver {
2031     my ($id, $verbose, $ipv6) = @_;
2032     my $ip=$HOSTIP;
2033     my $port = $SOCKSPORT;
2034     my $proto = 'socks';
2035     my $ipvnum = 4;
2036     my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2037     my $server;
2038     my $srvrname;
2039     my $pidfile;
2040     my $logfile;
2041     my $flags = "";
2042
2043     $server = servername_id($proto, $ipvnum, $idnum);
2044
2045     $pidfile = $serverpidfile{$server};
2046
2047     # don't retry if the server doesn't work
2048     if ($doesntrun{$pidfile}) {
2049         return (0,0);
2050     }
2051
2052     my $pid = processexists($pidfile);
2053     if($pid > 0) {
2054         stopserver($server, "$pid");
2055     }
2056     unlink($pidfile) if(-f $pidfile);
2057
2058     $srvrname = servername_str($proto, $ipvnum, $idnum);
2059
2060     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
2061
2062     # The ssh server must be already running
2063     if(!$run{'ssh'}) {
2064         logmsg "RUN: SOCKS server cannot find running SSH server\n";
2065         $doesntrun{$pidfile} = 1;
2066         return (0,0);
2067     }
2068
2069     # Find out ssh daemon canonical file name
2070     my $sshd = find_sshd();
2071     if(!$sshd) {
2072         logmsg "RUN: SOCKS server cannot find $sshdexe\n";
2073         $doesntrun{$pidfile} = 1;
2074         return (0,0);
2075     }
2076
2077     # Find out ssh daemon version info
2078     ($sshdid, $sshdvernum, $sshdverstr, $sshderror) = sshversioninfo($sshd);
2079     if(!$sshdid) {
2080         # Not an OpenSSH or SunSSH ssh daemon
2081         logmsg "$sshderror\n" if($verbose);
2082         logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2083         $doesntrun{$pidfile} = 1;
2084         return (0,0);
2085     }
2086     logmsg "ssh server found $sshd is $sshdverstr\n" if($verbose);
2087
2088     # Find out ssh client canonical file name
2089     my $ssh = find_ssh();
2090     if(!$ssh) {
2091         logmsg "RUN: SOCKS server cannot find $sshexe\n";
2092         $doesntrun{$pidfile} = 1;
2093         return (0,0);
2094     }
2095
2096     # Find out ssh client version info
2097     my ($sshid, $sshvernum, $sshverstr, $ssherror) = sshversioninfo($ssh);
2098     if(!$sshid) {
2099         # Not an OpenSSH or SunSSH ssh client
2100         logmsg "$ssherror\n" if($verbose);
2101         logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2102         $doesntrun{$pidfile} = 1;
2103         return (0,0);
2104     }
2105
2106     # Verify minimum ssh client version
2107     if((($sshid =~ /OpenSSH/) && ($sshvernum < 299)) ||
2108        (($sshid =~ /SunSSH/)  && ($sshvernum < 100))) {
2109         logmsg "ssh client found $ssh is $sshverstr\n";
2110         logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2111         $doesntrun{$pidfile} = 1;
2112         return (0,0);
2113     }
2114     logmsg "ssh client found $ssh is $sshverstr\n" if($verbose);
2115
2116     # Verify if ssh client and ssh daemon versions match
2117     if(($sshdid ne $sshid) || ($sshdvernum != $sshvernum)) {
2118         # Our test harness might work with slightly mismatched versions
2119         logmsg "Warning: version mismatch: sshd $sshdverstr - ssh $sshverstr\n"
2120             if($verbose);
2121     }
2122
2123     # Config file options for ssh client are previously set from sshserver.pl
2124     if(! -e $sshconfig) {
2125         logmsg "RUN: SOCKS server cannot find $sshconfig\n";
2126         $doesntrun{$pidfile} = 1;
2127         return (0,0);
2128     }
2129
2130     $sshlog  = server_logfilename($LOGDIR, 'socks', $ipvnum, $idnum);
2131
2132     # start our socks server
2133     my $cmd="\"$ssh\" -N -F $sshconfig $ip > $sshlog 2>&1";
2134     my ($sshpid, $pid2) = startnew($cmd, $pidfile, 30, 1); # fake pidfile
2135
2136     if($sshpid <= 0 || !pidexists($sshpid)) {
2137         # it is NOT alive
2138         logmsg "RUN: failed to start the $srvrname server\n";
2139         display_sshlog();
2140         display_sshconfig();
2141         display_sshdlog();
2142         display_sshdconfig();
2143         stopserver($server, "$pid2");
2144         $doesntrun{$pidfile} = 1;
2145         return (0,0);
2146     }
2147
2148     # Ugly hack but ssh doesn't support pid files. PID is from fake pidfile.
2149     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
2150     if(!$pid3) {
2151         logmsg "RUN: $srvrname server failed verification\n";
2152         # failed to talk to it properly. Kill the server and return failure
2153         stopserver($server, "$sshpid $pid2");
2154         $doesntrun{$pidfile} = 1;
2155         return (0,0);
2156     }
2157     $pid2 = $pid3;
2158
2159     if($verbose) {
2160         logmsg "RUN: $srvrname server is now running PID $pid2\n";
2161     }
2162
2163     return ($pid2, $sshpid);
2164 }
2165
2166 #######################################################################
2167 # Single shot http and gopher server responsiveness test. This should only
2168 # be used to verify that a server present in %run hash is still functional
2169 #
2170 sub responsive_http_server {
2171     my ($proto, $verbose, $alt, $port_or_path) = @_;
2172     my $ip = $HOSTIP;
2173     my $ipvnum = 4;
2174     my $idnum = 1;
2175
2176     if($alt eq "ipv6") {
2177         # if IPv6, use a different setup
2178         $ipvnum = 6;
2179         $ip = $HOST6IP;
2180     }
2181     elsif($alt eq "proxy") {
2182         $idnum = 2;
2183     }
2184     elsif($alt eq "unix") {
2185         # IP (protocol) is mutually exclusive with Unix sockets
2186         $ipvnum = "unix";
2187     }
2188
2189     return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
2190 }
2191
2192 #######################################################################
2193 # Single shot pingpong server responsiveness test. This should only be
2194 # used to verify that a server present in %run hash is still functional
2195 #
2196 sub responsive_pingpong_server {
2197     my ($proto, $id, $verbose, $ipv6) = @_;
2198     my $port;
2199     my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
2200     my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
2201     my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2202
2203     if($proto eq "ftp") {
2204         $port = ($idnum>1)?$FTP2PORT:$FTPPORT;
2205
2206         if($ipvnum==6) {
2207             # if IPv6, use a different setup
2208             $port = $FTP6PORT;
2209         }
2210     }
2211     elsif($proto eq "pop3") {
2212         $port = ($ipvnum==6) ? $POP36PORT : $POP3PORT;
2213     }
2214     elsif($proto eq "imap") {
2215         $port = ($ipvnum==6) ? $IMAP6PORT : $IMAPPORT;
2216     }
2217     elsif($proto eq "smtp") {
2218         $port = ($ipvnum==6) ? $SMTP6PORT : $SMTPPORT;
2219     }
2220     else {
2221         print STDERR "Unsupported protocol $proto!!\n";
2222         return 0;
2223     }
2224
2225     return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2226 }
2227
2228 #######################################################################
2229 # Single shot rtsp server responsiveness test. This should only be
2230 # used to verify that a server present in %run hash is still functional
2231 #
2232 sub responsive_rtsp_server {
2233     my ($verbose, $ipv6) = @_;
2234     my $port = $RTSPPORT;
2235     my $ip = $HOSTIP;
2236     my $proto = 'rtsp';
2237     my $ipvnum = 4;
2238     my $idnum = 1;
2239
2240     if($ipv6) {
2241         # if IPv6, use a different setup
2242         $ipvnum = 6;
2243         $port = $RTSP6PORT;
2244         $ip = $HOST6IP;
2245     }
2246
2247     return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2248 }
2249
2250 #######################################################################
2251 # Single shot tftp server responsiveness test. This should only be
2252 # used to verify that a server present in %run hash is still functional
2253 #
2254 sub responsive_tftp_server {
2255     my ($id, $verbose, $ipv6) = @_;
2256     my $port = $TFTPPORT;
2257     my $ip = $HOSTIP;
2258     my $proto = 'tftp';
2259     my $ipvnum = 4;
2260     my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2261
2262     if($ipv6) {
2263         # if IPv6, use a different setup
2264         $ipvnum = 6;
2265         $port = $TFTP6PORT;
2266         $ip = $HOST6IP;
2267     }
2268
2269     return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2270 }
2271
2272 #######################################################################
2273 # Single shot non-stunnel HTTP TLS extensions capable server
2274 # responsiveness test. This should only be used to verify that a
2275 # server present in %run hash is still functional
2276 #
2277 sub responsive_httptls_server {
2278     my ($verbose, $ipv6) = @_;
2279     my $proto = "httptls";
2280     my $port = ($ipv6 && ($ipv6 =~ /6$/)) ? $HTTPTLS6PORT : $HTTPTLSPORT;
2281     my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
2282     my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
2283     my $idnum = 1;
2284
2285     return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2286 }
2287
2288 #######################################################################
2289 # Remove all files in the specified directory
2290 #
2291 sub cleardir {
2292     my $dir = $_[0];
2293     my $count;
2294     my $file;
2295
2296     # Get all files
2297     opendir(DIR, $dir) ||
2298         return 0; # can't open dir
2299     while($file = readdir(DIR)) {
2300         if($file !~ /^\./) {
2301             unlink("$dir/$file");
2302             $count++;
2303         }
2304     }
2305     closedir DIR;
2306     return $count;
2307 }
2308
2309 #######################################################################
2310 # compare test results with the expected output, we might filter off
2311 # some pattern that is allowed to differ, output test results
2312 #
2313 sub compare {
2314     my ($testnum, $testname, $subject, $firstref, $secondref)=@_;
2315
2316     my $result = compareparts($firstref, $secondref);
2317
2318     if($result) {
2319         # timestamp test result verification end
2320         $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
2321
2322         if(!$short) {
2323             logmsg "\n $testnum: $subject FAILED:\n";
2324             logmsg showdiff($LOGDIR, $firstref, $secondref);
2325         }
2326         elsif(!$automakestyle) {
2327             logmsg "FAILED\n";
2328         }
2329         else {
2330             # automakestyle
2331             logmsg "FAIL: $testnum - $testname - $subject\n";
2332         }
2333     }
2334     return $result;
2335 }
2336
2337 #######################################################################
2338 # display information about curl and the host the test suite runs on
2339 #
2340 sub checksystem {
2341
2342     unlink($memdump); # remove this if there was one left
2343
2344     my $feat;
2345     my $curl;
2346     my $libcurl;
2347     my $versretval;
2348     my $versnoexec;
2349     my @version=();
2350
2351     my $curlverout="$LOGDIR/curlverout.log";
2352     my $curlvererr="$LOGDIR/curlvererr.log";
2353     my $versioncmd="$CURL --version 1>$curlverout 2>$curlvererr";
2354
2355     unlink($curlverout);
2356     unlink($curlvererr);
2357
2358     $versretval = runclient($versioncmd);
2359     $versnoexec = $!;
2360
2361     open(VERSOUT, "<$curlverout");
2362     @version = <VERSOUT>;
2363     close(VERSOUT);
2364
2365     $resolver="stock";
2366     for(@version) {
2367         chomp;
2368
2369         if($_ =~ /^curl/) {
2370             $curl = $_;
2371             $curl =~ s/^(.*)(libcurl.*)/$1/g;
2372
2373             $libcurl = $2;
2374             if($curl =~ /win32|mingw(32|64)/) {
2375                 # This is a Windows MinGW build or native build, we need to use
2376                 # Win32-style path.
2377                 $pwd = pathhelp::sys_native_current_path();
2378             }
2379            if ($libcurl =~ /winssl/i) {
2380                $has_winssl=1;
2381                $ssllib="WinSSL";
2382            }
2383            elsif ($libcurl =~ /openssl/i) {
2384                $has_openssl=1;
2385                $has_sslpinning=1;
2386                $ssllib="OpenSSL";
2387            }
2388            elsif ($libcurl =~ /gnutls/i) {
2389                $has_gnutls=1;
2390                $has_sslpinning=1;
2391                $ssllib="GnuTLS";
2392            }
2393            elsif ($libcurl =~ /nss/i) {
2394                $has_nss=1;
2395                $has_sslpinning=1;
2396                $ssllib="NSS";
2397            }
2398            elsif ($libcurl =~ /(yassl|wolfssl)/i) {
2399                $has_yassl=1;
2400                $has_sslpinning=1;
2401                $ssllib="yassl";
2402            }
2403            elsif ($libcurl =~ /polarssl/i) {
2404                $has_polarssl=1;
2405                $has_sslpinning=1;
2406                $ssllib="polarssl";
2407            }
2408            elsif ($libcurl =~ /axtls/i) {
2409                $has_axtls=1;
2410                $ssllib="axTLS";
2411            }
2412            elsif ($libcurl =~ /securetransport/i) {
2413                $has_darwinssl=1;
2414                $ssllib="DarwinSSL";
2415            }
2416            elsif ($libcurl =~ /BoringSSL/i) {
2417                $has_boringssl=1;
2418                $has_sslpinning=1;
2419                $ssllib="BoringSSL";
2420            }
2421            elsif ($libcurl =~ /libressl/i) {
2422                $has_libressl=1;
2423                $has_sslpinning=1;
2424                $ssllib="libressl";
2425            }
2426            elsif ($libcurl =~ /mbedTLS/i) {
2427                $has_mbedtls=1;
2428                $has_sslpinning=1;
2429                $ssllib="mbedTLS";
2430            }
2431            if ($libcurl =~ /ares/i) {
2432                $has_cares=1;
2433                $resolver="c-ares";
2434            }
2435         }
2436         elsif($_ =~ /^Protocols: (.*)/i) {
2437             # these are the protocols compiled in to this libcurl
2438             @protocols = split(' ', lc($1));
2439
2440             # Generate a "proto-ipv6" version of each protocol to match the
2441             # IPv6 <server> name and a "proto-unix" to match the variant which
2442             # uses Unix domain sockets. This works even if support isn't
2443             # compiled in because the <features> test will fail.
2444             push @protocols, map(("$_-ipv6", "$_-unix"), @protocols);
2445
2446             # 'http-proxy' is used in test cases to do CONNECT through
2447             push @protocols, 'http-proxy';
2448
2449             # 'http-pipe' is the special server for testing pipelining
2450             push @protocols, 'http-pipe';
2451
2452             # 'none' is used in test cases to mean no server
2453             push @protocols, 'none';
2454         }
2455         elsif($_ =~ /^Features: (.*)/i) {
2456             $feat = $1;
2457             if($feat =~ /TrackMemory/i) {
2458                 # built with memory tracking support (--enable-curldebug)
2459                 $has_memory_tracking = 1;
2460             }
2461             if($feat =~ /debug/i) {
2462                 # curl was built with --enable-debug
2463                 $debug_build = 1;
2464             }
2465             if($feat =~ /SSL/i) {
2466                 # ssl enabled
2467                 $has_ssl=1;
2468             }
2469             if($feat =~ /Largefile/i) {
2470                 # large file support
2471                 $has_largefile=1;
2472             }
2473             if($feat =~ /IDN/i) {
2474                 # IDN support
2475                 $has_idn=1;
2476             }
2477             if($feat =~ /IPv6/i) {
2478                 $has_ipv6 = 1;
2479             }
2480             if($feat =~ /UnixSockets/i) {
2481                 $has_unix = 1;
2482             }
2483             if($feat =~ /libz/i) {
2484                 $has_libz = 1;
2485             }
2486             if($feat =~ /NTLM/i) {
2487                 # NTLM enabled
2488                 $has_ntlm=1;
2489
2490                 # Use this as a proxy for any cryptographic authentication
2491                 $has_crypto=1;
2492             }
2493             if($feat =~ /NTLM_WB/i) {
2494                 # NTLM delegation to winbind daemon ntlm_auth helper enabled
2495                 $has_ntlm_wb=1;
2496             }
2497             if($feat =~ /SSPI/i) {
2498                 # SSPI enabled
2499                 $has_sspi=1;
2500             }
2501             if($feat =~ /GSS-API/i) {
2502                 # GSS-API enabled
2503                 $has_gssapi=1;
2504             }
2505             if($feat =~ /Kerberos/i) {
2506                 # Kerberos enabled
2507                 $has_kerberos=1;
2508
2509                 # Use this as a proxy for any cryptographic authentication
2510                 $has_crypto=1;
2511             }
2512             if($feat =~ /SPNEGO/i) {
2513                 # SPNEGO enabled
2514                 $has_spnego=1;
2515
2516                 # Use this as a proxy for any cryptographic authentication
2517                 $has_crypto=1;
2518             }
2519             if($feat =~ /CharConv/i) {
2520                 # CharConv enabled
2521                 $has_charconv=1;
2522             }
2523             if($feat =~ /TLS-SRP/i) {
2524                 # TLS-SRP enabled
2525                 $has_tls_srp=1;
2526             }
2527             if($feat =~ /Metalink/i) {
2528                 # Metalink enabled
2529                 $has_metalink=1;
2530             }
2531             if($feat =~ /PSL/i) {
2532                 # PSL enabled
2533                 $has_psl=1;
2534             }
2535             if($feat =~ /AsynchDNS/i) {
2536                 if(!$has_cares) {
2537                     # this means threaded resolver
2538                     $has_threadedres=1;
2539                     $resolver="threaded";
2540                 }
2541             }
2542             if($feat =~ /HTTP2/) {
2543                 # http2 enabled
2544                 $has_http2=1;
2545
2546                 push @protocols, 'http/2';
2547             }
2548         }
2549         #
2550         # Test harness currently uses a non-stunnel server in order to
2551         # run HTTP TLS-SRP tests required when curl is built with https
2552         # protocol support and TLS-SRP feature enabled. For convenience
2553         # 'httptls' may be included in the test harness protocols array
2554         # to differentiate this from classic stunnel based 'https' test
2555         # harness server.
2556         #
2557         if($has_tls_srp) {
2558             my $add_httptls;
2559             for(@protocols) {
2560                 if($_ =~ /^https(-ipv6|)$/) {
2561                     $add_httptls=1;
2562                     last;
2563                 }
2564             }
2565             if($add_httptls && (! grep /^httptls$/, @protocols)) {
2566                 push @protocols, 'httptls';
2567                 push @protocols, 'httptls-ipv6';
2568             }
2569         }
2570     }
2571     if(!$curl) {
2572         logmsg "unable to get curl's version, further details are:\n";
2573         logmsg "issued command: \n";
2574         logmsg "$versioncmd \n";
2575         if ($versretval == -1) {
2576             logmsg "command failed with: \n";
2577             logmsg "$versnoexec \n";
2578         }
2579         elsif ($versretval & 127) {
2580             logmsg sprintf("command died with signal %d, and %s coredump.\n",
2581                            ($versretval & 127), ($versretval & 128)?"a":"no");
2582         }
2583         else {
2584             logmsg sprintf("command exited with value %d \n", $versretval >> 8);
2585         }
2586         logmsg "contents of $curlverout: \n";
2587         displaylogcontent("$curlverout");
2588         logmsg "contents of $curlvererr: \n";
2589         displaylogcontent("$curlvererr");
2590         die "couldn't get curl's version";
2591     }
2592
2593     if(-r "../lib/curl_config.h") {
2594         open(CONF, "<../lib/curl_config.h");
2595         while(<CONF>) {
2596             if($_ =~ /^\#define HAVE_GETRLIMIT/) {
2597                 $has_getrlimit = 1;
2598             }
2599         }
2600         close(CONF);
2601     }
2602
2603     if($has_ipv6) {
2604         # client has IPv6 support
2605
2606         # check if the HTTP server has it!
2607         my @sws = `server/sws --version`;
2608         if($sws[0] =~ /IPv6/) {
2609             # HTTP server has IPv6 support!
2610             $http_ipv6 = 1;
2611             $gopher_ipv6 = 1;
2612         }
2613
2614         # check if the FTP server has it!
2615         @sws = `server/sockfilt --version`;
2616         if($sws[0] =~ /IPv6/) {
2617             # FTP server has IPv6 support!
2618             $ftp_ipv6 = 1;
2619         }
2620     }
2621
2622     if($has_unix) {
2623         # client has Unix sockets support, check whether the HTTP server has it
2624         my @sws = `server/sws --version`;
2625         $http_unix = 1 if($sws[0] =~ /unix/);
2626     }
2627
2628     if(!$has_memory_tracking && $torture) {
2629         die "can't run torture tests since curl was built without ".
2630             "TrackMemory feature (--enable-curldebug)";
2631     }
2632
2633     $has_shared = `sh $CURLCONFIG --built-shared`;
2634     chomp $has_shared;
2635
2636     my $hostname=join(' ', runclientoutput("hostname"));
2637     my $hosttype=join(' ', runclientoutput("uname -a"));
2638
2639     logmsg ("********* System characteristics ******** \n",
2640     "* $curl\n",
2641     "* $libcurl\n",
2642     "* Features: $feat\n",
2643     "* Host: $hostname",
2644     "* System: $hosttype");
2645
2646     if($has_memory_tracking && $has_threadedres) {
2647         $has_memory_tracking = 0;
2648         logmsg("*\n",
2649                "*** DISABLES memory tracking when using threaded resolver\n",
2650                "*\n");
2651     }
2652
2653     logmsg sprintf("* Servers: %s", $stunnel?"SSL ":"");
2654     logmsg sprintf("%s", $http_ipv6?"HTTP-IPv6 ":"");
2655     logmsg sprintf("%s", $http_unix?"HTTP-unix ":"");
2656     logmsg sprintf("%s\n", $ftp_ipv6?"FTP-IPv6 ":"");
2657
2658     logmsg sprintf("* Env: %s%s", $valgrind?"Valgrind ":"",
2659                    $run_event_based?"event-based ":"");
2660     logmsg sprintf("%s\n", $libtool?"Libtool ":"");
2661
2662     if($verbose) {
2663         logmsg "* Ports:\n";
2664
2665         logmsg sprintf("*   HTTP/%d ", $HTTPPORT);
2666         logmsg sprintf("FTP/%d ", $FTPPORT);
2667         logmsg sprintf("FTP2/%d ", $FTP2PORT);
2668         logmsg sprintf("RTSP/%d ", $RTSPPORT);
2669         if($stunnel) {
2670             logmsg sprintf("FTPS/%d ", $FTPSPORT);
2671             logmsg sprintf("HTTPS/%d ", $HTTPSPORT);
2672         }
2673         logmsg sprintf("\n*   TFTP/%d ", $TFTPPORT);
2674         if($http_ipv6) {
2675             logmsg sprintf("HTTP-IPv6/%d ", $HTTP6PORT);
2676             logmsg sprintf("RTSP-IPv6/%d ", $RTSP6PORT);
2677         }
2678         if($ftp_ipv6) {
2679             logmsg sprintf("FTP-IPv6/%d ", $FTP6PORT);
2680         }
2681         if($tftp_ipv6) {
2682             logmsg sprintf("TFTP-IPv6/%d ", $TFTP6PORT);
2683         }
2684         logmsg sprintf("\n*   GOPHER/%d ", $GOPHERPORT);
2685         if($gopher_ipv6) {
2686             logmsg sprintf("GOPHER-IPv6/%d", $GOPHERPORT);
2687         }
2688         logmsg sprintf("\n*   SSH/%d ", $SSHPORT);
2689         logmsg sprintf("SOCKS/%d ", $SOCKSPORT);
2690         logmsg sprintf("POP3/%d ", $POP3PORT);
2691         logmsg sprintf("IMAP/%d ", $IMAPPORT);
2692         logmsg sprintf("SMTP/%d\n", $SMTPPORT);
2693         if($ftp_ipv6) {
2694             logmsg sprintf("*   POP3-IPv6/%d ", $POP36PORT);
2695             logmsg sprintf("IMAP-IPv6/%d ", $IMAP6PORT);
2696             logmsg sprintf("SMTP-IPv6/%d\n", $SMTP6PORT);
2697         }
2698         if($httptlssrv) {
2699             logmsg sprintf("*   HTTPTLS/%d ", $HTTPTLSPORT);
2700             if($has_ipv6) {
2701                 logmsg sprintf("HTTPTLS-IPv6/%d ", $HTTPTLS6PORT);
2702             }
2703             logmsg "\n";
2704         }
2705         logmsg sprintf("*   HTTP-PIPE/%d \n", $HTTPPIPEPORT);
2706
2707         if($has_unix) {
2708             logmsg "* Unix socket paths:\n";
2709             if($http_unix) {
2710                 logmsg sprintf("*   HTTP-Unix:%s\n", $HTTPUNIXPATH);
2711             }
2712         }
2713     }
2714     $has_textaware = ($^O eq 'MSWin32') || ($^O eq 'msys');
2715
2716     logmsg "***************************************** \n";
2717 }
2718
2719 #######################################################################
2720 # substitute the variable stuff into either a joined up file or
2721 # a command, in either case passed by reference
2722 #
2723 sub subVariables {
2724   my ($thing) = @_;
2725
2726   # ports
2727
2728   $$thing =~ s/%FTP6PORT/$FTP6PORT/g;
2729   $$thing =~ s/%FTP2PORT/$FTP2PORT/g;
2730   $$thing =~ s/%FTPSPORT/$FTPSPORT/g;
2731   $$thing =~ s/%FTPPORT/$FTPPORT/g;
2732
2733   $$thing =~ s/%GOPHER6PORT/$GOPHER6PORT/g;
2734   $$thing =~ s/%GOPHERPORT/$GOPHERPORT/g;
2735
2736   $$thing =~ s/%HTTPTLS6PORT/$HTTPTLS6PORT/g;
2737   $$thing =~ s/%HTTPTLSPORT/$HTTPTLSPORT/g;
2738   $$thing =~ s/%HTTP6PORT/$HTTP6PORT/g;
2739   $$thing =~ s/%HTTPSPORT/$HTTPSPORT/g;
2740   $$thing =~ s/%HTTP2PORT/$HTTP2PORT/g;
2741   $$thing =~ s/%HTTPPORT/$HTTPPORT/g;
2742   $$thing =~ s/%HTTPPIPEPORT/$HTTPPIPEPORT/g;
2743   $$thing =~ s/%PROXYPORT/$HTTPPROXYPORT/g;
2744
2745   $$thing =~ s/%IMAP6PORT/$IMAP6PORT/g;
2746   $$thing =~ s/%IMAPPORT/$IMAPPORT/g;
2747
2748   $$thing =~ s/%POP36PORT/$POP36PORT/g;
2749   $$thing =~ s/%POP3PORT/$POP3PORT/g;
2750
2751   $$thing =~ s/%RTSP6PORT/$RTSP6PORT/g;
2752   $$thing =~ s/%RTSPPORT/$RTSPPORT/g;
2753
2754   $$thing =~ s/%SMTP6PORT/$SMTP6PORT/g;
2755   $$thing =~ s/%SMTPPORT/$SMTPPORT/g;
2756
2757   $$thing =~ s/%SOCKSPORT/$SOCKSPORT/g;
2758   $$thing =~ s/%SSHPORT/$SSHPORT/g;
2759
2760   $$thing =~ s/%TFTP6PORT/$TFTP6PORT/g;
2761   $$thing =~ s/%TFTPPORT/$TFTPPORT/g;
2762
2763   # server Unix domain socket paths
2764
2765   $$thing =~ s/%HTTPUNIXPATH/$HTTPUNIXPATH/g;
2766
2767   # client IP addresses
2768
2769   $$thing =~ s/%CLIENT6IP/$CLIENT6IP/g;
2770   $$thing =~ s/%CLIENTIP/$CLIENTIP/g;
2771
2772   # server IP addresses
2773
2774   $$thing =~ s/%HOST6IP/$HOST6IP/g;
2775   $$thing =~ s/%HOSTIP/$HOSTIP/g;
2776
2777   # misc
2778
2779   $$thing =~ s/%CURL/$CURL/g;
2780   $$thing =~ s/%PWD/$pwd/g;
2781   $$thing =~ s/%SRCDIR/$srcdir/g;
2782   $$thing =~ s/%USER/$USER/g;
2783
2784   # The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be
2785   # used for time-out tests and that whould work on most hosts as these
2786   # adjust for the startup/check time for this particular host. We needed
2787   # to do this to make the test suite run better on very slow hosts.
2788
2789   my $ftp2 = $ftpchecktime * 2;
2790   my $ftp3 = $ftpchecktime * 3;
2791
2792   $$thing =~ s/%FTPTIME2/$ftp2/g;
2793   $$thing =~ s/%FTPTIME3/$ftp3/g;
2794
2795   # HTTP2
2796
2797   $$thing =~ s/%H2CVER/$h2cver/g;
2798 }
2799
2800 sub fixarray {
2801     my @in = @_;
2802
2803     for(@in) {
2804         subVariables \$_;
2805     }
2806     return @in;
2807 }
2808
2809 #######################################################################
2810 # Provide time stamps for single test skipped events
2811 #
2812 sub timestampskippedevents {
2813     my $testnum = $_[0];
2814
2815     return if((not defined($testnum)) || ($testnum < 1));
2816
2817     if($timestats) {
2818
2819         if($timevrfyend{$testnum}) {
2820             return;
2821         }
2822         elsif($timesrvrlog{$testnum}) {
2823             $timevrfyend{$testnum} = $timesrvrlog{$testnum};
2824             return;
2825         }
2826         elsif($timetoolend{$testnum}) {
2827             $timevrfyend{$testnum} = $timetoolend{$testnum};
2828             $timesrvrlog{$testnum} = $timetoolend{$testnum};
2829         }
2830         elsif($timetoolini{$testnum}) {
2831             $timevrfyend{$testnum} = $timetoolini{$testnum};
2832             $timesrvrlog{$testnum} = $timetoolini{$testnum};
2833             $timetoolend{$testnum} = $timetoolini{$testnum};
2834         }
2835         elsif($timesrvrend{$testnum}) {
2836             $timevrfyend{$testnum} = $timesrvrend{$testnum};
2837             $timesrvrlog{$testnum} = $timesrvrend{$testnum};
2838             $timetoolend{$testnum} = $timesrvrend{$testnum};
2839             $timetoolini{$testnum} = $timesrvrend{$testnum};
2840         }
2841         elsif($timesrvrini{$testnum}) {
2842             $timevrfyend{$testnum} = $timesrvrini{$testnum};
2843             $timesrvrlog{$testnum} = $timesrvrini{$testnum};
2844             $timetoolend{$testnum} = $timesrvrini{$testnum};
2845             $timetoolini{$testnum} = $timesrvrini{$testnum};
2846             $timesrvrend{$testnum} = $timesrvrini{$testnum};
2847         }
2848         elsif($timeprepini{$testnum}) {
2849             $timevrfyend{$testnum} = $timeprepini{$testnum};
2850             $timesrvrlog{$testnum} = $timeprepini{$testnum};
2851             $timetoolend{$testnum} = $timeprepini{$testnum};
2852             $timetoolini{$testnum} = $timeprepini{$testnum};
2853             $timesrvrend{$testnum} = $timeprepini{$testnum};
2854             $timesrvrini{$testnum} = $timeprepini{$testnum};
2855         }
2856     }
2857 }
2858
2859 #######################################################################
2860 # Run a single specified test case
2861 #
2862 sub singletest {
2863     my ($evbased, # 1 means switch on if possible (and "curl" is tested)
2864                   # returns "not a test" if it can't be used for this test
2865         $testnum,
2866         $count,
2867         $total)=@_;
2868
2869     my @what;
2870     my $why;
2871     my %feature;
2872     my $cmd;
2873     my $disablevalgrind;
2874
2875     # copy test number to a global scope var, this allows
2876     # testnum checking when starting test harness servers.
2877     $testnumcheck = $testnum;
2878
2879     # timestamp test preparation start
2880     $timeprepini{$testnum} = Time::HiRes::time() if($timestats);
2881
2882     if($disttests !~ /test$testnum\W/ ) {
2883         logmsg "Warning: test$testnum not present in tests/data/Makefile.inc\n";
2884     }
2885     if($disabled{$testnum}) {
2886         logmsg "Warning: test$testnum is explicitly disabled\n";
2887     }
2888
2889     # load the test case file definition
2890     if(loadtest("${TESTDIR}/test${testnum}")) {
2891         if($verbose) {
2892             # this is not a test
2893             logmsg "RUN: $testnum doesn't look like a test case\n";
2894         }
2895         $why = "no test";
2896     }
2897     else {
2898         @what = getpart("client", "features");
2899     }
2900
2901     # We require a feature to be present
2902     for(@what) {
2903         my $f = $_;
2904         $f =~ s/\s//g;
2905
2906         if($f =~ /^([^!].*)$/) {
2907             # Store the feature for later
2908             $feature{$1} = $1;
2909
2910             if($1 eq "SSL") {
2911                 if($has_ssl) {
2912                     next;
2913                 }
2914             }
2915             elsif($1 eq "SSLpinning") {
2916                 if($has_sslpinning) {
2917                     next;
2918                 }
2919             }
2920             elsif($1 eq "OpenSSL") {
2921                 if($has_openssl) {
2922                     next;
2923                 }
2924             }
2925             elsif($1 eq "GnuTLS") {
2926                 if($has_gnutls) {
2927                     next;
2928                 }
2929             }
2930             elsif($1 eq "NSS") {
2931                 if($has_nss) {
2932                     next;
2933                 }
2934             }
2935             elsif($1 eq "axTLS") {
2936                 if($has_axtls) {
2937                     next;
2938                 }
2939             }
2940             elsif($1 eq "WinSSL") {
2941                 if($has_winssl) {
2942                     next;
2943                 }
2944             }
2945             elsif($1 eq "DarwinSSL") {
2946                 if($has_darwinssl) {
2947                     next;
2948                 }
2949             }
2950             elsif($1 eq "unittest") {
2951                 if($debug_build) {
2952                     next;
2953                 }
2954             }
2955             elsif($1 eq "debug") {
2956                 if($debug_build) {
2957                     next;
2958                 }
2959             }
2960             elsif($1 eq "TrackMemory") {
2961                 if($has_memory_tracking) {
2962                     next;
2963                 }
2964             }
2965             elsif($1 eq "large_file") {
2966                 if($has_largefile) {
2967                     next;
2968                 }
2969             }
2970             elsif($1 eq "idn") {
2971                 if($has_idn) {
2972                     next;
2973                 }
2974             }
2975             elsif($1 eq "ipv6") {
2976                 if($has_ipv6) {
2977                     next;
2978                 }
2979             }
2980             elsif($1 eq "libz") {
2981                 if($has_libz) {
2982                     next;
2983                 }
2984             }
2985             elsif($1 eq "NTLM") {
2986                 if($has_ntlm) {
2987                     next;
2988                 }
2989             }
2990             elsif($1 eq "NTLM_WB") {
2991                 if($has_ntlm_wb) {
2992                     next;
2993                 }
2994             }
2995             elsif($1 eq "SSPI") {
2996                 if($has_sspi) {
2997                     next;
2998                 }
2999             }
3000             elsif($1 eq "GSS-API") {
3001                 if($has_gssapi) {
3002                     next;
3003                 }
3004             }
3005             elsif($1 eq "Kerberos") {
3006                 if($has_kerberos) {
3007                     next;
3008                 }
3009             }
3010             elsif($1 eq "SPNEGO") {
3011                 if($has_spnego) {
3012                     next;
3013                 }
3014             }
3015             elsif($1 eq "getrlimit") {
3016                 if($has_getrlimit) {
3017                     next;
3018                 }
3019             }
3020             elsif($1 eq "crypto") {
3021                 if($has_crypto) {
3022                     next;
3023                 }
3024             }
3025             elsif($1 eq "TLS-SRP") {
3026                 if($has_tls_srp) {
3027                     next;
3028                 }
3029             }
3030             elsif($1 eq "Metalink") {
3031                 if($has_metalink) {
3032                     next;
3033                 }
3034             }
3035             elsif($1 eq "http/2") {
3036                 if($has_http2) {
3037                     next;
3038                 }
3039             }
3040             elsif($1 eq "PSL") {
3041                 if($has_psl) {
3042                     next;
3043                 }
3044             }
3045             elsif($1 eq "socks") {
3046                 next;
3047             }
3048             elsif($1 eq "unix-sockets") {
3049                 next if $has_unix;
3050             }
3051             # See if this "feature" is in the list of supported protocols
3052             elsif (grep /^\Q$1\E$/i, @protocols) {
3053                 next;
3054             }
3055
3056             $why = "curl lacks $1 support";
3057             last;
3058         }
3059     }
3060
3061     # We require a feature to not be present
3062     if(!$why) {
3063         for(@what) {
3064             my $f = $_;
3065             $f =~ s/\s//g;
3066
3067             if($f =~ /^!(.*)$/) {
3068                 if($1 eq "SSL") {
3069                     if(!$has_ssl) {
3070                         next;
3071                     }
3072                 }
3073                 elsif($1 eq "OpenSSL") {
3074                     if(!$has_openssl) {
3075                         next;
3076                     }
3077                 }
3078                 elsif($1 eq "GnuTLS") {
3079                     if(!$has_gnutls) {
3080                         next;
3081                     }
3082                 }
3083                 elsif($1 eq "NSS") {
3084                     if(!$has_nss) {
3085                         next;
3086                     }
3087                 }
3088                 elsif($1 eq "axTLS") {
3089                     if(!$has_axtls) {
3090                         next;
3091                     }
3092                 }
3093                 elsif($1 eq "WinSSL") {
3094                     if(!$has_winssl) {
3095                         next;
3096                     }
3097                 }
3098                 elsif($1 eq "DarwinSSL") {
3099                     if(!$has_darwinssl) {
3100                         next;
3101                     }
3102                 }
3103                 elsif($1 eq "TrackMemory") {
3104                     if(!$has_memory_tracking) {
3105                         next;
3106                     }
3107                 }
3108                 elsif($1 eq "large_file") {
3109                     if(!$has_largefile) {
3110                         next;
3111                     }
3112                 }
3113                 elsif($1 eq "idn") {
3114                     if(!$has_idn) {
3115                         next;
3116                     }
3117                 }
3118                 elsif($1 eq "ipv6") {
3119                     if(!$has_ipv6) {
3120                         next;
3121                     }
3122                 }
3123                 elsif($1 eq "unix-sockets") {
3124                     next if !$has_unix;
3125                 }
3126                 elsif($1 eq "libz") {
3127                     if(!$has_libz) {
3128                         next;
3129                     }
3130                 }
3131                 elsif($1 eq "NTLM") {
3132                     if(!$has_ntlm) {
3133                         next;
3134                     }
3135                 }
3136                 elsif($1 eq "NTLM_WB") {
3137                     if(!$has_ntlm_wb) {
3138                         next;
3139                     }
3140                 }
3141                 elsif($1 eq "SSPI") {
3142                     if(!$has_sspi) {
3143                         next;
3144                     }
3145                 }
3146                 elsif($1 eq "GSS-API") {
3147                     if(!$has_gssapi) {
3148                         next;
3149                     }
3150                 }
3151                 elsif($1 eq "Kerberos") {
3152                     if(!$has_kerberos) {
3153                         next;
3154                     }
3155                 }
3156                 elsif($1 eq "SPNEGO") {
3157                     if(!$has_spnego) {
3158                         next;
3159                     }
3160                 }
3161                 elsif($1 eq "getrlimit") {
3162                     if(!$has_getrlimit) {
3163                         next;
3164                     }
3165                 }
3166                 elsif($1 eq "crypto") {
3167                     if(!$has_crypto) {
3168                         next;
3169                     }
3170                 }
3171                 elsif($1 eq "TLS-SRP") {
3172                     if(!$has_tls_srp) {
3173                         next;
3174                     }
3175                 }
3176                 elsif($1 eq "Metalink") {
3177                     if(!$has_metalink) {
3178                         next;
3179                     }
3180                 }
3181                 elsif($1 eq "PSL") {
3182                     if(!$has_psl) {
3183                         next;
3184                     }
3185                 }
3186                 else {
3187                     next;
3188                 }
3189             }
3190             else {
3191                 next;
3192             }
3193
3194             $why = "curl has $1 support";
3195             last;
3196         }
3197     }
3198
3199     if(!$why) {
3200         my @keywords = getpart("info", "keywords");
3201         my $match;
3202         my $k;
3203
3204         if(!$keywords[0]) {
3205             $why = "missing the <keywords> section!";
3206         }
3207
3208         for $k (@keywords) {
3209             chomp $k;
3210             if ($disabled_keywords{$k}) {
3211                 $why = "disabled by keyword";
3212             } elsif ($enabled_keywords{$k}) {
3213                 $match = 1;
3214             }
3215         }
3216
3217         if(!$why && !$match && %enabled_keywords) {
3218             $why = "disabled by missing keyword";
3219         }
3220     }
3221
3222     # test definition may instruct to (un)set environment vars
3223     # this is done this early, so that the precheck can use environment
3224     # variables and still bail out fine on errors
3225
3226     # restore environment variables that were modified in a previous run
3227     foreach my $var (keys %oldenv) {
3228         if($oldenv{$var} eq 'notset') {
3229             delete $ENV{$var} if($ENV{$var});
3230         }
3231         else {
3232             $ENV{$var} = $oldenv{$var};
3233         }
3234         delete $oldenv{$var};
3235     }
3236
3237     # remove test server commands file before servers are started/verified
3238     unlink($FTPDCMD) if(-f $FTPDCMD);
3239
3240     # timestamp required servers verification start
3241     $timesrvrini{$testnum} = Time::HiRes::time() if($timestats);
3242
3243     if(!$why) {
3244         $why = serverfortest($testnum);
3245     }
3246
3247     # timestamp required servers verification end
3248     $timesrvrend{$testnum} = Time::HiRes::time() if($timestats);
3249
3250     my @setenv = getpart("client", "setenv");
3251     if(@setenv) {
3252         foreach my $s (@setenv) {
3253             chomp $s;
3254             subVariables \$s;
3255             if($s =~ /([^=]*)=(.*)/) {
3256                 my ($var, $content) = ($1, $2);
3257                 # remember current setting, to restore it once test runs
3258                 $oldenv{$var} = ($ENV{$var})?"$ENV{$var}":'notset';
3259                 # set new value
3260                 if(!$content) {
3261                     delete $ENV{$var} if($ENV{$var});
3262                 }
3263                 else {
3264                     if($var =~ /^LD_PRELOAD/) {
3265                         if(exe_ext() && (exe_ext() eq '.exe')) {
3266                             # print "Skipping LD_PRELOAD due to lack of OS support\n";
3267                             next;
3268                         }
3269                         if($debug_build || ($has_shared ne "yes")) {
3270                             # print "Skipping LD_PRELOAD due to no release shared build\n";
3271                             next;
3272                         }
3273                     }
3274                     $ENV{$var} = "$content";
3275                 }
3276             }
3277         }
3278     }
3279
3280     if(!$why) {
3281         # TODO:
3282         # Add a precheck cache. If a precheck command was already invoked
3283         # exactly like this, then use the previous result to speed up
3284         # successive test invokes!
3285
3286         my @precheck = getpart("client", "precheck");
3287         if(@precheck) {
3288             $cmd = $precheck[0];
3289             chomp $cmd;
3290             subVariables \$cmd;
3291             if($cmd) {
3292                 my @p = split(/ /, $cmd);
3293                 if($p[0] !~ /\//) {
3294                     # the first word, the command, does not contain a slash so
3295                     # we will scan the "improved" PATH to find the command to
3296                     # be able to run it
3297                     my $fullp = checktestcmd($p[0]);
3298
3299                     if($fullp) {
3300                         $p[0] = $fullp;
3301                     }
3302                     $cmd = join(" ", @p);
3303                 }
3304
3305                 my @o = `$cmd 2>/dev/null`;
3306                 if($o[0]) {
3307                     $why = $o[0];
3308                     chomp $why;
3309                 } elsif($?) {
3310                     $why = "precheck command error";
3311                 }
3312                 logmsg "prechecked $cmd\n" if($verbose);
3313             }
3314         }
3315     }
3316
3317     if($why && !$listonly) {
3318         # there's a problem, count it as "skipped"
3319         $skipped++;
3320         $skipped{$why}++;
3321         $teststat[$testnum]=$why; # store reason for this test case
3322
3323         if(!$short) {
3324             if($skipped{$why} <= 3) {
3325                 # show only the first three skips for each reason
3326                 logmsg sprintf("test %04d SKIPPED: $why\n", $testnum);
3327             }
3328         }
3329
3330         timestampskippedevents($testnum);
3331         return -1;
3332     }
3333     logmsg sprintf("test %04d...", $testnum) if(!$automakestyle);
3334
3335     # extract the reply data
3336     my @reply = getpart("reply", "data");
3337     my @replycheck = getpart("reply", "datacheck");
3338
3339     my %replyattr = getpartattr("reply", "data");
3340     my %replycheckattr = getpartattr("reply", "datacheck");
3341
3342     if (@replycheck) {
3343         # we use this file instead to check the final output against
3344         # get the mode attribute
3345         my $filemode=$replycheckattr{'mode'};
3346         if($filemode && ($filemode eq "text") && $has_textaware) {
3347             # text mode when running on windows: fix line endings
3348             map s/\r\n/\n/g, @replycheck;
3349             map s/\n/\r\n/g, @replycheck;
3350         }
3351         if($replycheckattr{'nonewline'}) {
3352             # Yes, we must cut off the final newline from the final line
3353             # of the datacheck
3354             chomp($replycheck[$#replycheck]);
3355         }
3356
3357         for my $partsuffix (('1', '2', '3', '4')) {
3358             my @replycheckpart = getpart("reply", "datacheck".$partsuffix);
3359             if(@replycheckpart || partexists("reply", "datacheck".$partsuffix) ) {
3360                 my %replycheckpartattr = getpartattr("reply", "datacheck".$partsuffix);
3361                 # get the mode attribute
3362                 my $filemode=$replycheckpartattr{'mode'};
3363                 if($filemode && ($filemode eq "text") && $has_textaware) {
3364                     # text mode when running on windows: fix line endings
3365                     map s/\r\n/\n/g, @replycheckpart;
3366                     map s/\n/\r\n/g, @replycheckpart;
3367                 }
3368                 if($replycheckpartattr{'nonewline'}) {
3369                     # Yes, we must cut off the final newline from the final line
3370                     # of the datacheck
3371                     chomp($replycheckpart[$#replycheckpart]);
3372                 }
3373                 push(@replycheck, @replycheckpart);
3374             }
3375         }
3376
3377         @reply=@replycheck;
3378     }
3379     else {
3380         # get the mode attribute
3381         my $filemode=$replyattr{'mode'};
3382         if($filemode && ($filemode eq "text") && $has_textaware) {
3383             # text mode when running on windows: fix line endings
3384             map s/\r\n/\n/g, @reply;
3385             map s/\n/\r\n/g, @reply;
3386         }
3387     }
3388
3389     # this is the valid protocol blurb curl should generate
3390     my @protocol= fixarray ( getpart("verify", "protocol") );
3391
3392     # this is the valid protocol blurb curl should generate to a proxy
3393     my @proxyprot = fixarray ( getpart("verify", "proxy") );
3394
3395     # redirected stdout/stderr to these files
3396     $STDOUT="$LOGDIR/stdout$testnum";
3397     $STDERR="$LOGDIR/stderr$testnum";
3398
3399     # if this section exists, we verify that the stdout contained this:
3400     my @validstdout = fixarray ( getpart("verify", "stdout") );
3401
3402     # if this section exists, we verify upload
3403     my @upload = getpart("verify", "upload");
3404
3405     # if this section exists, it might be FTP server instructions:
3406     my @ftpservercmd = getpart("reply", "servercmd");
3407
3408     my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout
3409
3410     # name of the test
3411     my @testname= getpart("client", "name");
3412     my $testname = $testname[0];
3413     $testname =~ s/\n//g;
3414     logmsg "[$testname]\n" if(!$short);
3415
3416     if($listonly) {
3417         timestampskippedevents($testnum);
3418         return 0; # look successful
3419     }
3420
3421     my @codepieces = getpart("client", "tool");
3422
3423     my $tool="";
3424     if(@codepieces) {
3425         $tool = $codepieces[0];
3426         chomp $tool;
3427     }
3428
3429     # remove server output logfile
3430     unlink($SERVERIN);
3431     unlink($SERVER2IN);
3432     unlink($PROXYIN);
3433
3434     if(@ftpservercmd) {
3435         # write the instructions to file
3436         writearray($FTPDCMD, \@ftpservercmd);
3437     }
3438
3439     # get the command line options to use
3440     my @blaha;
3441     ($cmd, @blaha)= getpart("client", "command");
3442
3443     if($cmd) {
3444         # make some nice replace operations
3445         $cmd =~ s/\n//g; # no newlines please
3446         # substitute variables in the command line
3447         subVariables \$cmd;
3448     }
3449     else {
3450         # there was no command given, use something silly
3451         $cmd="-";
3452     }
3453     if($has_memory_tracking) {
3454         unlink($memdump);
3455     }
3456
3457     # create a (possibly-empty) file before starting the test
3458     my @inputfile=getpart("client", "file");
3459     my %fileattr = getpartattr("client", "file");
3460     my $filename=$fileattr{'name'};
3461     if(@inputfile || $filename) {
3462         if(!$filename) {
3463             logmsg "ERROR: section client=>file has no name attribute\n";
3464             timestampskippedevents($testnum);
3465             return -1;
3466         }
3467         my $fileContent = join('', @inputfile);
3468         subVariables \$fileContent;
3469 #        logmsg "DEBUG: writing file " . $filename . "\n";
3470         open(OUTFILE, ">$filename");
3471         binmode OUTFILE; # for crapage systems, use binary
3472         print OUTFILE $fileContent;
3473         close(OUTFILE);
3474     }
3475
3476     my %cmdhash = getpartattr("client", "command");
3477
3478     my $out="";
3479
3480     if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-output/)) {
3481         #We may slap on --output!
3482         if (!@validstdout) {
3483             $out=" --output $CURLOUT ";
3484         }
3485     }
3486
3487     my $serverlogslocktimeout = $defserverlogslocktimeout;
3488     if($cmdhash{'timeout'}) {
3489         # test is allowed to override default server logs lock timeout
3490         if($cmdhash{'timeout'} =~ /(\d+)/) {
3491             $serverlogslocktimeout = $1 if($1 >= 0);
3492         }
3493     }
3494
3495     my $postcommanddelay = $defpostcommanddelay;
3496     if($cmdhash{'delay'}) {
3497         # test is allowed to specify a delay after command is executed
3498         if($cmdhash{'delay'} =~ /(\d+)/) {
3499             $postcommanddelay = $1 if($1 > 0);
3500         }
3501     }
3502
3503     my $CMDLINE;
3504     my $cmdargs;
3505     my $cmdtype = $cmdhash{'type'} || "default";
3506     my $fail_due_event_based = $evbased;
3507     if($cmdtype eq "perl") {
3508         # run the command line prepended with "perl"
3509         $cmdargs ="$cmd";
3510         $CMDLINE = "perl ";
3511         $tool=$CMDLINE;
3512         $disablevalgrind=1;
3513     }
3514     elsif($cmdtype eq "shell") {
3515         # run the command line prepended with "/bin/sh"
3516         $cmdargs ="$cmd";
3517         $CMDLINE = "/bin/sh ";
3518         $tool=$CMDLINE;
3519         $disablevalgrind=1;
3520     }
3521     elsif(!$tool) {
3522         # run curl, add suitable command line options
3523         $cmd = "-1 ".$cmd if(exists $feature{"SSL"} && ($has_axtls));
3524
3525         my $inc="";
3526         if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-include/)) {
3527             $inc = " --include";
3528         }
3529
3530         $cmdargs = "$out$inc ";
3531         $cmdargs .= "--trace-ascii log/trace$testnum ";
3532         $cmdargs .= "--trace-time ";
3533         if($evbased) {
3534             $cmdargs .= "--test-event ";
3535             $fail_due_event_based--;
3536         }
3537         $cmdargs .= $cmd;
3538     }
3539     else {
3540         $cmdargs = " $cmd"; # $cmd is the command line for the test file
3541         $CURLOUT = $STDOUT; # sends received data to stdout
3542
3543         if($tool =~ /^lib/) {
3544             $CMDLINE="$LIBDIR/$tool";
3545         }
3546         elsif($tool =~ /^unit/) {
3547             $CMDLINE="$UNITDIR/$tool";
3548         }
3549
3550         if(! -f $CMDLINE) {
3551             logmsg "The tool set in the test case for this: '$tool' does not exist\n";
3552             timestampskippedevents($testnum);
3553             return -1;
3554         }
3555         $DBGCURL=$CMDLINE;
3556     }
3557
3558     if($gdbthis) {
3559         # gdb is incompatible with valgrind, so disable it when debugging
3560         # Perhaps a better approach would be to run it under valgrind anyway
3561         # with --db-attach=yes or --vgdb=yes.
3562         $disablevalgrind=1;
3563     }
3564
3565     if($fail_due_event_based) {
3566         logmsg "This test cannot run event based\n";
3567         return -1;
3568     }
3569
3570     my @stdintest = getpart("client", "stdin");
3571
3572     if(@stdintest) {
3573         my $stdinfile="$LOGDIR/stdin-for-$testnum";
3574
3575         my %hash = getpartattr("client", "stdin");
3576         if($hash{'nonewline'}) {
3577             # cut off the final newline from the final line of the stdin data
3578             chomp($stdintest[$#stdintest]);
3579         }
3580
3581         writearray($stdinfile, \@stdintest);
3582
3583         $cmdargs .= " <$stdinfile";
3584     }
3585
3586     if(!$tool) {
3587         $CMDLINE="$CURL";
3588     }
3589
3590     my $usevalgrind;
3591     if($valgrind && !$disablevalgrind) {
3592         my @valgrindoption = getpart("verify", "valgrind");
3593         if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) {
3594             $usevalgrind = 1;
3595             my $valgrindcmd = "$valgrind ";
3596             $valgrindcmd .= "$valgrind_tool " if($valgrind_tool);
3597             $valgrindcmd .= "--quiet --leak-check=yes ";
3598             $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp ";
3599            # $valgrindcmd .= "--gen-suppressions=all ";
3600             $valgrindcmd .= "--num-callers=16 ";
3601             $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum";
3602             $CMDLINE = "$valgrindcmd $CMDLINE";
3603         }
3604     }
3605
3606     $CMDLINE .= "$cmdargs >$STDOUT 2>$STDERR";
3607
3608     if($verbose) {
3609         logmsg "$CMDLINE\n";
3610     }
3611
3612     print CMDLOG "$CMDLINE\n";
3613
3614     unlink("core");
3615
3616     my $dumped_core;
3617     my $cmdres;
3618
3619     # Apr 2007: precommand isn't being used and could be removed
3620     my @precommand= getpart("client", "precommand");
3621     if($precommand[0]) {
3622         # this is pure perl to eval!
3623         my $code = join("", @precommand);
3624         eval $code;
3625         if($@) {
3626             logmsg "perl: $code\n";
3627             logmsg "precommand: $@";
3628             stopservers($verbose);
3629             timestampskippedevents($testnum);
3630             return -1;
3631         }
3632     }
3633
3634     if($gdbthis) {
3635         my $gdbinit = "$TESTDIR/gdbinit$testnum";
3636         open(GDBCMD, ">$LOGDIR/gdbcmd");
3637         print GDBCMD "set args $cmdargs\n";
3638         print GDBCMD "show args\n";
3639         print GDBCMD "source $gdbinit\n" if -e $gdbinit;
3640         close(GDBCMD);
3641     }
3642
3643     # timestamp starting of test command
3644     $timetoolini{$testnum} = Time::HiRes::time() if($timestats);
3645
3646     # run the command line we built
3647     if ($torture) {
3648         $cmdres = torture($CMDLINE,
3649                        "$gdb --directory libtest $DBGCURL -x $LOGDIR/gdbcmd");
3650     }
3651     elsif($gdbthis) {
3652         my $GDBW = ($gdbxwin) ? "-w" : "";
3653         runclient("$gdb --directory libtest $DBGCURL $GDBW -x $LOGDIR/gdbcmd");
3654         $cmdres=0; # makes it always continue after a debugged run
3655     }
3656     else {
3657         $cmdres = runclient("$CMDLINE");
3658         my $signal_num  = $cmdres & 127;
3659         $dumped_core = $cmdres & 128;
3660
3661         if(!$anyway && ($signal_num || $dumped_core)) {
3662             $cmdres = 1000;
3663         }
3664         else {
3665             $cmdres >>= 8;
3666             $cmdres = (2000 + $signal_num) if($signal_num && !$cmdres);
3667         }
3668     }
3669
3670     # timestamp finishing of test command
3671     $timetoolend{$testnum} = Time::HiRes::time() if($timestats);
3672
3673     if(!$dumped_core) {
3674         if(-r "core") {
3675             # there's core file present now!
3676             $dumped_core = 1;
3677         }
3678     }
3679
3680     if($dumped_core) {
3681         logmsg "core dumped\n";
3682         if(0 && $gdb) {
3683             logmsg "running gdb for post-mortem analysis:\n";
3684             open(GDBCMD, ">$LOGDIR/gdbcmd2");
3685             print GDBCMD "bt\n";
3686             close(GDBCMD);
3687             runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch $DBGCURL core ");
3688      #       unlink("$LOGDIR/gdbcmd2");
3689         }
3690     }
3691
3692     # If a server logs advisor read lock file exists, it is an indication
3693     # that the server has not yet finished writing out all its log files,
3694     # including server request log files used for protocol verification.
3695     # So, if the lock file exists the script waits here a certain amount
3696     # of time until the server removes it, or the given time expires.
3697
3698     if($serverlogslocktimeout) {
3699         my $lockretry = $serverlogslocktimeout * 20;
3700         while((-f $SERVERLOGS_LOCK) && $lockretry--) {
3701             select(undef, undef, undef, 0.05);
3702         }
3703         if(($lockretry < 0) &&
3704            ($serverlogslocktimeout >= $defserverlogslocktimeout)) {
3705             logmsg "Warning: server logs lock timeout ",
3706                    "($serverlogslocktimeout seconds) expired\n";
3707         }
3708     }
3709
3710     # Test harness ssh server does not have this synchronization mechanism,
3711     # this implies that some ssh server based tests might need a small delay
3712     # once that the client command has run to avoid false test failures.
3713     #
3714     # gnutls-serv also lacks this synchronization mechanism, so gnutls-serv
3715     # based tests might need a small delay once that the client command has
3716     # run to avoid false test failures.
3717
3718     sleep($postcommanddelay) if($postcommanddelay);
3719
3720     # timestamp removal of server logs advisor read lock
3721     $timesrvrlog{$testnum} = Time::HiRes::time() if($timestats);
3722
3723     # test definition might instruct to stop some servers
3724     # stop also all servers relative to the given one
3725
3726     my @killtestservers = getpart("client", "killserver");
3727     if(@killtestservers) {
3728         #
3729         # All servers relative to the given one must be stopped also
3730         #
3731         my @killservers;
3732         foreach my $server (@killtestservers) {
3733             chomp $server;
3734             if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
3735                 # given a stunnel ssl server, also kill non-ssl underlying one
3736                 push @killservers, "${1}${2}";
3737             }
3738             elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|-unix|))$/) {
3739                 # given a non-ssl server, also kill stunnel piggybacking one
3740                 push @killservers, "${1}s${2}";
3741             }
3742             elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
3743                 # given a socks server, also kill ssh underlying one
3744                 push @killservers, "ssh${2}";
3745             }
3746             elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
3747                 # given a ssh server, also kill socks piggybacking one
3748                 push @killservers, "socks${2}";
3749             }
3750             push @killservers, $server;
3751         }
3752         #
3753         # kill sockfilter processes for pingpong relative servers
3754         #
3755         foreach my $server (@killservers) {
3756             if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
3757                 my $proto  = $1;
3758                 my $idnum  = ($2 && ($2 > 1)) ? $2 : 1;
3759                 my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
3760                 killsockfilters($proto, $ipvnum, $idnum, $verbose);
3761             }
3762         }
3763         #
3764         # kill server relative pids clearing them in %run hash
3765         #
3766         my $pidlist;
3767         foreach my $server (@killservers) {
3768             if($run{$server}) {
3769                 $pidlist .= "$run{$server} ";
3770                 $run{$server} = 0;
3771             }
3772             $runcert{$server} = 0 if($runcert{$server});
3773         }
3774         killpid($verbose, $pidlist);
3775         #
3776         # cleanup server pid files
3777         #
3778         foreach my $server (@killservers) {
3779             my $pidfile = $serverpidfile{$server};
3780             my $pid = processexists($pidfile);
3781             if($pid > 0) {
3782                 logmsg "Warning: $server server unexpectedly alive\n";
3783                 killpid($verbose, $pid);
3784             }
3785             unlink($pidfile) if(-f $pidfile);
3786         }
3787     }
3788
3789     # remove the test server commands file after each test
3790     unlink($FTPDCMD) if(-f $FTPDCMD);
3791
3792     # run the postcheck command
3793     my @postcheck= getpart("client", "postcheck");
3794     if(@postcheck) {
3795         $cmd = $postcheck[0];
3796         chomp $cmd;
3797         subVariables \$cmd;
3798         if($cmd) {
3799             logmsg "postcheck $cmd\n" if($verbose);
3800             my $rc = runclient("$cmd");
3801             # Must run the postcheck command in torture mode in order
3802             # to clean up, but the result can't be relied upon.
3803             if($rc != 0 && !$torture) {
3804                 logmsg " postcheck FAILED\n";
3805                 # timestamp test result verification end
3806                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3807                 return 1;
3808             }
3809         }
3810     }
3811
3812     # restore environment variables that were modified
3813     if(%oldenv) {
3814         foreach my $var (keys %oldenv) {
3815             if($oldenv{$var} eq 'notset') {
3816                 delete $ENV{$var} if($ENV{$var});
3817             }
3818             else {
3819                 $ENV{$var} = "$oldenv{$var}";
3820             }
3821         }
3822     }
3823
3824     # Skip all the verification on torture tests
3825     if ($torture) {
3826         if(!$cmdres && !$keepoutfiles) {
3827             cleardir($LOGDIR);
3828         }
3829         # timestamp test result verification end
3830         $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3831         return $cmdres;
3832     }
3833
3834     my @err = getpart("verify", "errorcode");
3835     my $errorcode = $err[0] || "0";
3836     my $ok="";
3837     my $res;
3838     chomp $errorcode;
3839     if (@validstdout) {
3840         # verify redirected stdout
3841         my @actual = loadarray($STDOUT);
3842
3843         # what parts to cut off from stdout
3844         my @stripfile = getpart("verify", "stripfile");
3845
3846         foreach my $strip (@stripfile) {
3847             chomp $strip;
3848             my @newgen;
3849             for(@actual) {
3850                 eval $strip;
3851                 if($_) {
3852                     push @newgen, $_;
3853                 }
3854             }
3855             # this is to get rid of array entries that vanished (zero
3856             # length) because of replacements
3857             @actual = @newgen;
3858         }
3859
3860         # variable-replace in the stdout we have from the test case file
3861         @validstdout = fixarray(@validstdout);
3862
3863         # get all attributes
3864         my %hash = getpartattr("verify", "stdout");
3865
3866         # get the mode attribute
3867         my $filemode=$hash{'mode'};
3868         if($filemode && ($filemode eq "text") && $has_textaware) {
3869             # text mode when running on windows: fix line endings
3870             map s/\r\n/\n/g, @validstdout;
3871             map s/\n/\r\n/g, @validstdout;
3872         }
3873
3874         if($hash{'nonewline'}) {
3875             # Yes, we must cut off the final newline from the final line
3876             # of the protocol data
3877             chomp($validstdout[$#validstdout]);
3878         }
3879
3880         $res = compare($testnum, $testname, "stdout", \@actual, \@validstdout);
3881         if($res) {
3882             return 1;
3883         }
3884         $ok .= "s";
3885     }
3886     else {
3887         $ok .= "-"; # stdout not checked
3888     }
3889
3890     if(@protocol) {
3891         # Verify the sent request
3892         my @out = loadarray($SERVERIN);
3893
3894         # what to cut off from the live protocol sent by curl
3895         my @strip = getpart("verify", "strip");
3896
3897         my @protstrip=@protocol;
3898
3899         # check if there's any attributes on the verify/protocol section
3900         my %hash = getpartattr("verify", "protocol");
3901
3902         if($hash{'nonewline'}) {
3903             # Yes, we must cut off the final newline from the final line
3904             # of the protocol data
3905             chomp($protstrip[$#protstrip]);
3906         }
3907
3908         for(@strip) {
3909             # strip off all lines that match the patterns from both arrays
3910             chomp $_;
3911             @out = striparray( $_, \@out);
3912             @protstrip= striparray( $_, \@protstrip);
3913         }
3914
3915         # what parts to cut off from the protocol
3916         my @strippart = getpart("verify", "strippart");
3917         my $strip;
3918         for $strip (@strippart) {
3919             chomp $strip;
3920             for(@out) {
3921                 eval $strip;
3922             }
3923         }
3924
3925         $res = compare($testnum, $testname, "protocol", \@out, \@protstrip);
3926         if($res) {
3927             return 1;
3928         }
3929
3930         $ok .= "p";
3931
3932     }
3933     else {
3934         $ok .= "-"; # protocol not checked
3935     }
3936
3937     if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
3938         # verify the received data
3939         my @out = loadarray($CURLOUT);
3940         $res = compare($testnum, $testname, "data", \@out, \@reply);
3941         if ($res) {
3942             return 1;
3943         }
3944         $ok .= "d";
3945     }
3946     else {
3947         $ok .= "-"; # data not checked
3948     }
3949
3950     if(@upload) {
3951         # verify uploaded data
3952         my @out = loadarray("$LOGDIR/upload.$testnum");
3953         $res = compare($testnum, $testname, "upload", \@out, \@upload);
3954         if ($res) {
3955             return 1;
3956         }
3957         $ok .= "u";
3958     }
3959     else {
3960         $ok .= "-"; # upload not checked
3961     }
3962
3963     if(@proxyprot) {
3964         # Verify the sent proxy request
3965         my @out = loadarray($PROXYIN);
3966
3967         # what to cut off from the live protocol sent by curl, we use the
3968         # same rules as for <protocol>
3969         my @strip = getpart("verify", "strip");
3970
3971         my @protstrip=@proxyprot;
3972
3973         # check if there's any attributes on the verify/protocol section
3974         my %hash = getpartattr("verify", "proxy");
3975
3976         if($hash{'nonewline'}) {
3977             # Yes, we must cut off the final newline from the final line
3978             # of the protocol data
3979             chomp($protstrip[$#protstrip]);
3980         }
3981
3982         for(@strip) {
3983             # strip off all lines that match the patterns from both arrays
3984             chomp $_;
3985             @out = striparray( $_, \@out);
3986             @protstrip= striparray( $_, \@protstrip);
3987         }
3988
3989         # what parts to cut off from the protocol
3990         my @strippart = getpart("verify", "strippart");
3991         my $strip;
3992         for $strip (@strippart) {
3993             chomp $strip;
3994             for(@out) {
3995                 eval $strip;
3996             }
3997         }
3998
3999         $res = compare($testnum, $testname, "proxy", \@out, \@protstrip);
4000         if($res) {
4001             return 1;
4002         }
4003
4004         $ok .= "P";
4005
4006     }
4007     else {
4008         $ok .= "-"; # protocol not checked
4009     }
4010
4011     my $outputok;
4012     for my $partsuffix (('', '1', '2', '3', '4')) {
4013         my @outfile=getpart("verify", "file".$partsuffix);
4014         if(@outfile || partexists("verify", "file".$partsuffix) ) {
4015             # we're supposed to verify a dynamically generated file!
4016             my %hash = getpartattr("verify", "file".$partsuffix);
4017
4018             my $filename=$hash{'name'};
4019             if(!$filename) {
4020                 logmsg "ERROR: section verify=>file$partsuffix ".
4021                        "has no name attribute\n";
4022                 stopservers($verbose);
4023                 # timestamp test result verification end
4024                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4025                 return -1;
4026             }
4027             my @generated=loadarray($filename);
4028
4029             # what parts to cut off from the file
4030             my @stripfile = getpart("verify", "stripfile".$partsuffix);
4031
4032             my $filemode=$hash{'mode'};
4033             if($filemode && ($filemode eq "text") && $has_textaware) {
4034                 # text mode when running on windows: fix line endings
4035                 map s/\r\n/\n/g, @outfile;
4036                 map s/\n/\r\n/g, @outfile;
4037             }
4038
4039             my $strip;
4040             for $strip (@stripfile) {
4041                 chomp $strip;
4042                 my @newgen;
4043                 for(@generated) {
4044                     eval $strip;
4045                     if($_) {
4046                         push @newgen, $_;
4047                     }
4048                 }
4049                 # this is to get rid of array entries that vanished (zero
4050                 # length) because of replacements
4051                 @generated = @newgen;
4052             }
4053
4054             @outfile = fixarray(@outfile);
4055
4056             $res = compare($testnum, $testname, "output ($filename)",
4057                            \@generated, \@outfile);
4058             if($res) {
4059                 return 1;
4060             }
4061
4062             $outputok = 1; # output checked
4063         }
4064     }
4065     $ok .= ($outputok) ? "o" : "-"; # output checked or not
4066
4067     # accept multiple comma-separated error codes
4068     my @splerr = split(/ *, */, $errorcode);
4069     my $errok;
4070     foreach my $e (@splerr) {
4071         if($e == $cmdres) {
4072             # a fine error code
4073             $errok = 1;
4074             last;
4075         }
4076     }
4077
4078     if($errok) {
4079         $ok .= "e";
4080     }
4081     else {
4082         if(!$short) {
4083             logmsg sprintf("\n%s returned $cmdres, when expecting %s\n",
4084                            (!$tool)?"curl":$tool, $errorcode);
4085         }
4086         logmsg " exit FAILED\n";
4087         # timestamp test result verification end
4088         $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4089         return 1;
4090     }
4091
4092     if($has_memory_tracking) {
4093         if(! -f $memdump) {
4094             logmsg "\n** ALERT! memory tracking with no output file?\n"
4095                 if(!$cmdtype eq "perl");
4096         }
4097         else {
4098             my @memdata=`$memanalyze $memdump`;
4099             my $leak=0;
4100             for(@memdata) {
4101                 if($_ ne "") {
4102                     # well it could be other memory problems as well, but
4103                     # we call it leak for short here
4104                     $leak=1;
4105                 }
4106             }
4107             if($leak) {
4108                 logmsg "\n** MEMORY FAILURE\n";
4109                 logmsg @memdata;
4110                 # timestamp test result verification end
4111                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4112                 return 1;
4113             }
4114             else {
4115                 $ok .= "m";
4116             }
4117         }
4118     }
4119     else {
4120         $ok .= "-"; # memory not checked
4121     }
4122
4123     if($valgrind) {
4124         if($usevalgrind) {
4125             unless(opendir(DIR, "$LOGDIR")) {
4126                 logmsg "ERROR: unable to read $LOGDIR\n";
4127                 # timestamp test result verification end
4128                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4129                 return 1;
4130             }
4131             my @files = readdir(DIR);
4132             closedir(DIR);
4133             my $vgfile;
4134             foreach my $file (@files) {
4135                 if($file =~ /^valgrind$testnum(\..*|)$/) {
4136                     $vgfile = $file;
4137                     last;
4138                 }
4139             }
4140             if(!$vgfile) {
4141                 logmsg "ERROR: valgrind log file missing for test $testnum\n";
4142                 # timestamp test result verification end
4143                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4144                 return 1;
4145             }
4146             my @e = valgrindparse($srcdir, $feature{'SSL'}, "$LOGDIR/$vgfile");
4147             if(@e && $e[0]) {
4148                 if($automakestyle) {
4149                     logmsg "FAIL: $testnum - $testname - valgrind\n";
4150                 }
4151                 else {
4152                     logmsg " valgrind ERROR ";
4153                     logmsg @e;
4154                 }
4155                 # timestamp test result verification end
4156                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4157                 return 1;
4158             }
4159             $ok .= "v";
4160         }
4161         else {
4162             if(!$short && !$disablevalgrind) {
4163                 logmsg " valgrind SKIPPED\n";
4164             }
4165             $ok .= "-"; # skipped
4166         }
4167     }
4168     else {
4169         $ok .= "-"; # valgrind not checked
4170     }
4171     # add 'E' for event-based
4172     $ok .= $evbased ? "E" : "-";
4173
4174     logmsg "$ok " if(!$short);
4175
4176     my $sofar= time()-$start;
4177     my $esttotal = $sofar/$count * $total;
4178     my $estleft = $esttotal - $sofar;
4179     my $left=sprintf("remaining: %02d:%02d",
4180                      $estleft/60,
4181                      $estleft%60);
4182
4183     if(!$automakestyle) {
4184         logmsg sprintf("OK (%-3d out of %-3d, %s)\n", $count, $total, $left);
4185     }
4186     else {
4187         logmsg "PASS: $testnum - $testname\n";
4188     }
4189
4190     # the test succeeded, remove all log files
4191     if(!$keepoutfiles) {
4192         cleardir($LOGDIR);
4193     }
4194
4195     # timestamp test result verification end
4196     $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4197
4198     return 0;
4199 }
4200
4201 #######################################################################
4202 # Stop all running test servers
4203 #
4204 sub stopservers {
4205     my $verbose = $_[0];
4206     #
4207     # kill sockfilter processes for all pingpong servers
4208     #
4209     killallsockfilters($verbose);
4210     #
4211     # kill all server pids from %run hash clearing them
4212     #
4213     my $pidlist;
4214     foreach my $server (keys %run) {
4215         if($run{$server}) {
4216             if($verbose) {
4217                 my $prev = 0;
4218                 my $pids = $run{$server};
4219                 foreach my $pid (split(' ', $pids)) {
4220                     if($pid != $prev) {
4221                         logmsg sprintf("* kill pid for %s => %d\n",
4222                             $server, $pid);
4223                         $prev = $pid;
4224                     }
4225                 }
4226             }
4227             $pidlist .= "$run{$server} ";
4228             $run{$server} = 0;
4229         }
4230         $runcert{$server} = 0 if($runcert{$server});
4231     }
4232     killpid($verbose, $pidlist);
4233     #
4234     # cleanup all server pid files
4235     #
4236     foreach my $server (keys %serverpidfile) {
4237         my $pidfile = $serverpidfile{$server};
4238         my $pid = processexists($pidfile);
4239         if($pid > 0) {
4240             logmsg "Warning: $server server unexpectedly alive\n";
4241             killpid($verbose, $pid);
4242         }
4243         unlink($pidfile) if(-f $pidfile);
4244     }
4245 }
4246
4247 #######################################################################
4248 # startservers() starts all the named servers
4249 #
4250 # Returns: string with error reason or blank for success
4251 #
4252 sub startservers {
4253     my @what = @_;
4254     my ($pid, $pid2);
4255     for(@what) {
4256         my (@whatlist) = split(/\s+/,$_);
4257         my $what = lc($whatlist[0]);
4258         $what =~ s/[^a-z0-9\/-]//g;
4259
4260         my $certfile;
4261         if($what =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
4262             $certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem';
4263         }
4264
4265         if(($what eq "pop3") ||
4266            ($what eq "ftp") ||
4267            ($what eq "imap") ||
4268            ($what eq "smtp")) {
4269             if($torture && $run{$what} &&
4270                !responsive_pingpong_server($what, "", $verbose)) {
4271                 stopserver($what);
4272             }
4273             if(!$run{$what}) {
4274                 ($pid, $pid2) = runpingpongserver($what, "", $verbose);
4275                 if($pid <= 0) {
4276                     return "failed starting ". uc($what) ." server";
4277                 }
4278                 printf ("* pid $what => %d %d\n", $pid, $pid2) if($verbose);
4279                 $run{$what}="$pid $pid2";
4280             }
4281         }
4282         elsif($what eq "ftp2") {
4283             if($torture && $run{'ftp2'} &&
4284                !responsive_pingpong_server("ftp", "2", $verbose)) {
4285                 stopserver('ftp2');
4286             }
4287             if(!$run{'ftp2'}) {
4288                 ($pid, $pid2) = runpingpongserver("ftp", "2", $verbose);
4289                 if($pid <= 0) {
4290                     return "failed starting FTP2 server";
4291                 }
4292                 printf ("* pid ftp2 => %d %d\n", $pid, $pid2) if($verbose);
4293                 $run{'ftp2'}="$pid $pid2";
4294             }
4295         }
4296         elsif($what eq "ftp-ipv6") {
4297             if($torture && $run{'ftp-ipv6'} &&
4298                !responsive_pingpong_server("ftp", "", $verbose, "ipv6")) {
4299                 stopserver('ftp-ipv6');
4300             }
4301             if(!$run{'ftp-ipv6'}) {
4302                 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose, "ipv6");
4303                 if($pid <= 0) {
4304                     return "failed starting FTP-IPv6 server";
4305                 }
4306                 logmsg sprintf("* pid ftp-ipv6 => %d %d\n", $pid,
4307                        $pid2) if($verbose);
4308                 $run{'ftp-ipv6'}="$pid $pid2";
4309             }
4310         }
4311         elsif($what eq "gopher") {
4312             if($torture && $run{'gopher'} &&
4313                !responsive_http_server("gopher", $verbose, 0, $GOPHERPORT)) {
4314                 stopserver('gopher');
4315             }
4316             if(!$run{'gopher'}) {
4317                 ($pid, $pid2) = runhttpserver("gopher", $verbose, 0,
4318                                               $GOPHERPORT);
4319                 if($pid <= 0) {
4320                     return "failed starting GOPHER server";
4321                 }
4322                 logmsg sprintf ("* pid gopher => %d %d\n", $pid, $pid2)
4323                     if($verbose);
4324                 $run{'gopher'}="$pid $pid2";
4325             }
4326         }
4327         elsif($what eq "gopher-ipv6") {
4328             if($torture && $run{'gopher-ipv6'} &&
4329                !responsive_http_server("gopher", $verbose, "ipv6",
4330                                        $GOPHER6PORT)) {
4331                 stopserver('gopher-ipv6');
4332             }
4333             if(!$run{'gopher-ipv6'}) {
4334                 ($pid, $pid2) = runhttpserver("gopher", $verbose, "ipv6",
4335                                               $GOPHER6PORT);
4336                 if($pid <= 0) {
4337                     return "failed starting GOPHER-IPv6 server";
4338                 }
4339                 logmsg sprintf("* pid gopher-ipv6 => %d %d\n", $pid,
4340                                $pid2) if($verbose);
4341                 $run{'gopher-ipv6'}="$pid $pid2";
4342             }
4343         }
4344         elsif($what eq "http/2") {
4345             if(!$run{'http/2'}) {
4346                 ($pid, $pid2) = runhttp2server($verbose, $HTTP2PORT);
4347                 if($pid <= 0) {
4348                     return "failed starting HTTP/2 server";
4349                 }
4350                 logmsg sprintf ("* pid http/2 => %d %d\n", $pid, $pid2)
4351                     if($verbose);
4352                 $run{'http/2'}="$pid $pid2";
4353             }
4354         }
4355         elsif($what eq "http") {
4356             if($torture && $run{'http'} &&
4357                !responsive_http_server("http", $verbose, 0, $HTTPPORT)) {
4358                 stopserver('http');
4359             }
4360             if(!$run{'http'}) {
4361                 ($pid, $pid2) = runhttpserver("http", $verbose, 0,
4362                                               $HTTPPORT);
4363                 if($pid <= 0) {
4364                     return "failed starting HTTP server";
4365                 }
4366                 logmsg sprintf ("* pid http => %d %d\n", $pid, $pid2)
4367                     if($verbose);
4368                 $run{'http'}="$pid $pid2";
4369             }
4370         }
4371         elsif($what eq "http-proxy") {
4372             if($torture && $run{'http-proxy'} &&
4373                !responsive_http_server("http", $verbose, "proxy",
4374                                        $HTTPPROXYPORT)) {
4375                 stopserver('http-proxy');
4376             }
4377             if(!$run{'http-proxy'}) {
4378                 ($pid, $pid2) = runhttpserver("http", $verbose, "proxy",
4379                                               $HTTPPROXYPORT);
4380                 if($pid <= 0) {
4381                     return "failed starting HTTP-proxy server";
4382                 }
4383                 logmsg sprintf ("* pid http-proxy => %d %d\n", $pid, $pid2)
4384                     if($verbose);
4385                 $run{'http-proxy'}="$pid $pid2";
4386             }
4387         }
4388         elsif($what eq "http-ipv6") {
4389             if($torture && $run{'http-ipv6'} &&
4390                !responsive_http_server("http", $verbose, "ipv6", $HTTP6PORT)) {
4391                 stopserver('http-ipv6');
4392             }
4393             if(!$run{'http-ipv6'}) {
4394                 ($pid, $pid2) = runhttpserver("http", $verbose, "ipv6",
4395                                               $HTTP6PORT);
4396                 if($pid <= 0) {
4397                     return "failed starting HTTP-IPv6 server";
4398                 }
4399                 logmsg sprintf("* pid http-ipv6 => %d %d\n", $pid, $pid2)
4400                     if($verbose);
4401                 $run{'http-ipv6'}="$pid $pid2";
4402             }
4403         }
4404         elsif($what eq "http-pipe") {
4405             if($torture && $run{'http-pipe'} &&
4406                !responsive_http_server("http", $verbose, "pipe",
4407                                        $HTTPPIPEPORT)) {
4408                 stopserver('http-pipe');
4409             }
4410             if(!$run{'http-pipe'}) {
4411                 ($pid, $pid2) = runhttpserver("http", $verbose, "pipe",
4412                                               $HTTPPIPEPORT);
4413                 if($pid <= 0) {
4414                     return "failed starting HTTP-pipe server";
4415                 }
4416                 logmsg sprintf ("* pid http-pipe => %d %d\n", $pid, $pid2)
4417                     if($verbose);
4418                 $run{'http-pipe'}="$pid $pid2";
4419             }
4420         }
4421         elsif($what eq "rtsp") {
4422             if($torture && $run{'rtsp'} &&
4423                !responsive_rtsp_server($verbose)) {
4424                 stopserver('rtsp');
4425             }
4426             if(!$run{'rtsp'}) {
4427                 ($pid, $pid2) = runrtspserver($verbose);
4428                 if($pid <= 0) {
4429                     return "failed starting RTSP server";
4430                 }
4431                 printf ("* pid rtsp => %d %d\n", $pid, $pid2) if($verbose);
4432                 $run{'rtsp'}="$pid $pid2";
4433             }
4434         }
4435         elsif($what eq "rtsp-ipv6") {
4436             if($torture && $run{'rtsp-ipv6'} &&
4437                !responsive_rtsp_server($verbose, "ipv6")) {
4438                 stopserver('rtsp-ipv6');
4439             }
4440             if(!$run{'rtsp-ipv6'}) {
4441                 ($pid, $pid2) = runrtspserver($verbose, "ipv6");
4442                 if($pid <= 0) {
4443                     return "failed starting RTSP-IPv6 server";
4444                 }
4445                 logmsg sprintf("* pid rtsp-ipv6 => %d %d\n", $pid, $pid2)
4446                     if($verbose);
4447                 $run{'rtsp-ipv6'}="$pid $pid2";
4448             }
4449         }
4450         elsif($what eq "ftps") {
4451             if(!$stunnel) {
4452                 # we can't run ftps tests without stunnel
4453                 return "no stunnel";
4454             }
4455             if(!$has_ssl) {
4456                 # we can't run ftps tests if libcurl is SSL-less
4457                 return "curl lacks SSL support";
4458             }
4459             if($runcert{'ftps'} && ($runcert{'ftps'} ne $certfile)) {
4460                 # stop server when running and using a different cert
4461                 stopserver('ftps');
4462             }
4463             if($torture && $run{'ftp'} &&
4464                !responsive_pingpong_server("ftp", "", $verbose)) {
4465                 stopserver('ftp');
4466             }
4467             if(!$run{'ftp'}) {
4468                 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose);
4469                 if($pid <= 0) {
4470                     return "failed starting FTP server";
4471                 }
4472                 printf ("* pid ftp => %d %d\n", $pid, $pid2) if($verbose);
4473                 $run{'ftp'}="$pid $pid2";
4474             }
4475             if(!$run{'ftps'}) {
4476                 ($pid, $pid2) = runftpsserver($verbose, "", $certfile);
4477                 if($pid <= 0) {
4478                     return "failed starting FTPS server (stunnel)";
4479                 }
4480                 logmsg sprintf("* pid ftps => %d %d\n", $pid, $pid2)
4481                     if($verbose);
4482                 $run{'ftps'}="$pid $pid2";
4483             }
4484         }
4485         elsif($what eq "file") {
4486             # we support it but have no server!
4487         }
4488         elsif($what eq "https") {
4489             if(!$stunnel) {
4490                 # we can't run https tests without stunnel
4491                 return "no stunnel";
4492             }
4493             if(!$has_ssl) {
4494                 # we can't run https tests if libcurl is SSL-less
4495                 return "curl lacks SSL support";
4496             }
4497             if($runcert{'https'} && ($runcert{'https'} ne $certfile)) {
4498                 # stop server when running and using a different cert
4499                 stopserver('https');
4500             }
4501             if($torture && $run{'http'} &&
4502                !responsive_http_server("http", $verbose, 0, $HTTPPORT)) {
4503                 stopserver('http');
4504             }
4505             if(!$run{'http'}) {
4506                 ($pid, $pid2) = runhttpserver("http", $verbose, 0,
4507                                               $HTTPPORT);
4508                 if($pid <= 0) {
4509                     return "failed starting HTTP server";
4510                 }
4511                 printf ("* pid http => %d %d\n", $pid, $pid2) if($verbose);
4512                 $run{'http'}="$pid $pid2";
4513             }
4514             if(!$run{'https'}) {
4515                 ($pid, $pid2) = runhttpsserver($verbose, "", $certfile);
4516                 if($pid <= 0) {
4517                     return "failed starting HTTPS server (stunnel)";
4518                 }
4519                 logmsg sprintf("* pid https => %d %d\n", $pid, $pid2)
4520                     if($verbose);
4521                 $run{'https'}="$pid $pid2";
4522             }
4523         }
4524         elsif($what eq "httptls") {
4525             if(!$httptlssrv) {
4526                 # for now, we can't run http TLS-EXT tests without gnutls-serv
4527                 return "no gnutls-serv";
4528             }
4529             if($torture && $run{'httptls'} &&
4530                !responsive_httptls_server($verbose, "IPv4")) {
4531                 stopserver('httptls');
4532             }
4533             if(!$run{'httptls'}) {
4534                 ($pid, $pid2) = runhttptlsserver($verbose, "IPv4");
4535                 if($pid <= 0) {
4536                     return "failed starting HTTPTLS server (gnutls-serv)";
4537                 }
4538                 logmsg sprintf("* pid httptls => %d %d\n", $pid, $pid2)
4539                     if($verbose);
4540                 $run{'httptls'}="$pid $pid2";
4541             }
4542         }
4543         elsif($what eq "httptls-ipv6") {
4544             if(!$httptlssrv) {
4545                 # for now, we can't run http TLS-EXT tests without gnutls-serv
4546                 return "no gnutls-serv";
4547             }
4548             if($torture && $run{'httptls-ipv6'} &&
4549                !responsive_httptls_server($verbose, "ipv6")) {
4550                 stopserver('httptls-ipv6');
4551             }
4552             if(!$run{'httptls-ipv6'}) {
4553                 ($pid, $pid2) = runhttptlsserver($verbose, "ipv6");
4554                 if($pid <= 0) {
4555                     return "failed starting HTTPTLS-IPv6 server (gnutls-serv)";
4556                 }
4557                 logmsg sprintf("* pid httptls-ipv6 => %d %d\n", $pid, $pid2)
4558                     if($verbose);
4559                 $run{'httptls-ipv6'}="$pid $pid2";
4560             }
4561         }
4562         elsif($what eq "tftp") {
4563             if($torture && $run{'tftp'} &&
4564                !responsive_tftp_server("", $verbose)) {
4565                 stopserver('tftp');
4566             }
4567             if(!$run{'tftp'}) {
4568                 ($pid, $pid2) = runtftpserver("", $verbose);
4569                 if($pid <= 0) {
4570                     return "failed starting TFTP server";
4571                 }
4572                 printf ("* pid tftp => %d %d\n", $pid, $pid2) if($verbose);
4573                 $run{'tftp'}="$pid $pid2";
4574             }
4575         }
4576         elsif($what eq "tftp-ipv6") {
4577             if($torture && $run{'tftp-ipv6'} &&
4578                !responsive_tftp_server("", $verbose, "ipv6")) {
4579                 stopserver('tftp-ipv6');
4580             }
4581             if(!$run{'tftp-ipv6'}) {
4582                 ($pid, $pid2) = runtftpserver("", $verbose, "ipv6");
4583                 if($pid <= 0) {
4584                     return "failed starting TFTP-IPv6 server";
4585                 }
4586                 printf("* pid tftp-ipv6 => %d %d\n", $pid, $pid2) if($verbose);
4587                 $run{'tftp-ipv6'}="$pid $pid2";
4588             }
4589         }
4590         elsif($what eq "sftp" || $what eq "scp" || $what eq "socks4" || $what eq "socks5" ) {
4591             if(!$run{'ssh'}) {
4592                 ($pid, $pid2) = runsshserver("", $verbose);
4593                 if($pid <= 0) {
4594                     return "failed starting SSH server";
4595                 }
4596                 printf ("* pid ssh => %d %d\n", $pid, $pid2) if($verbose);
4597                 $run{'ssh'}="$pid $pid2";
4598             }
4599             if($what eq "socks4" || $what eq "socks5") {
4600                 if(!$run{'socks'}) {
4601                     ($pid, $pid2) = runsocksserver("", $verbose);
4602                     if($pid <= 0) {
4603                         return "failed starting socks server";
4604                     }
4605                     printf ("* pid socks => %d %d\n", $pid, $pid2) if($verbose);
4606                     $run{'socks'}="$pid $pid2";
4607                 }
4608             }
4609             if($what eq "socks5") {
4610                 if(!$sshdid) {
4611                     # Not an OpenSSH or SunSSH ssh daemon
4612                     logmsg "Not OpenSSH or SunSSH; socks5 tests need at least OpenSSH 3.7\n";
4613                     return "failed starting socks5 server";
4614                 }
4615                 elsif(($sshdid =~ /OpenSSH/) && ($sshdvernum < 370)) {
4616                     # Need OpenSSH 3.7 for socks5 - http://www.openssh.com/txt/release-3.7
4617                     logmsg "$sshdverstr insufficient; socks5 tests need at least OpenSSH 3.7\n";
4618                     return "failed starting socks5 server";
4619                 }
4620                 elsif(($sshdid =~ /SunSSH/)  && ($sshdvernum < 100)) {
4621                     # Need SunSSH 1.0 for socks5
4622                     logmsg "$sshdverstr insufficient; socks5 tests need at least SunSSH 1.0\n";
4623                     return "failed starting socks5 server";
4624                 }
4625             }
4626         }
4627         elsif($what eq "http-unix") {
4628             if($torture && $run{'http-unix'} &&
4629                !responsive_http_server("http", $verbose, "unix", $HTTPUNIXPATH)) {
4630                 stopserver('http-unix');
4631             }
4632             if(!$run{'http-unix'}) {
4633                 ($pid, $pid2) = runhttpserver("http", $verbose, "unix",
4634                                               $HTTPUNIXPATH);
4635                 if($pid <= 0) {
4636                     return "failed starting HTTP-unix server";
4637                 }
4638                 logmsg sprintf("* pid http-unix => %d %d\n", $pid, $pid2)
4639                     if($verbose);
4640                 $run{'http-unix'}="$pid $pid2";
4641             }
4642         }
4643         elsif($what eq "none") {
4644             logmsg "* starts no server\n" if ($verbose);
4645         }
4646         else {
4647             warn "we don't support a server for $what";
4648             return "no server for $what";
4649         }
4650     }
4651     return 0;
4652 }
4653
4654 ##############################################################################
4655 # This function makes sure the right set of server is running for the
4656 # specified test case. This is a useful design when we run single tests as not
4657 # all servers need to run then!
4658 #
4659 # Returns: a string, blank if everything is fine or a reason why it failed
4660 #
4661 sub serverfortest {
4662     my ($testnum)=@_;
4663
4664     my @what = getpart("client", "server");
4665
4666     if(!$what[0]) {
4667         warn "Test case $testnum has no server(s) specified";
4668         return "no server specified";
4669     }
4670
4671     for(my $i = scalar(@what) - 1; $i >= 0; $i--) {
4672         my $srvrline = $what[$i];
4673         chomp $srvrline if($srvrline);
4674         if($srvrline =~ /^(\S+)((\s*)(.*))/) {
4675             my $server = "${1}";
4676             my $lnrest = "${2}";
4677             my $tlsext;
4678             if($server =~ /^(httptls)(\+)(ext|srp)(\d*)(-ipv6|)$/) {
4679                 $server = "${1}${4}${5}";
4680                 $tlsext = uc("TLS-${3}");
4681             }
4682             if(! grep /^\Q$server\E$/, @protocols) {
4683                 if(substr($server,0,5) ne "socks") {
4684                     if($tlsext) {
4685                         return "curl lacks $tlsext support";
4686                     }
4687                     else {
4688                         return "curl lacks $server server support";
4689                     }
4690                 }
4691             }
4692             $what[$i] = "$server$lnrest" if($tlsext);
4693         }
4694     }
4695
4696     return &startservers(@what);
4697 }
4698
4699 #######################################################################
4700 # runtimestats displays test-suite run time statistics
4701 #
4702 sub runtimestats {
4703     my $lasttest = $_[0];
4704
4705     return if(not $timestats);
4706
4707     logmsg "\nTest suite total running time breakdown per task...\n\n";
4708
4709     my @timesrvr;
4710     my @timeprep;
4711     my @timetool;
4712     my @timelock;
4713     my @timevrfy;
4714     my @timetest;
4715     my $timesrvrtot = 0.0;
4716     my $timepreptot = 0.0;
4717     my $timetooltot = 0.0;
4718     my $timelocktot = 0.0;
4719     my $timevrfytot = 0.0;
4720     my $timetesttot = 0.0;
4721     my $counter;
4722
4723     for my $testnum (1 .. $lasttest) {
4724         if($timesrvrini{$testnum}) {
4725             $timesrvrtot += $timesrvrend{$testnum} - $timesrvrini{$testnum};
4726             $timepreptot +=
4727                 (($timetoolini{$testnum} - $timeprepini{$testnum}) -
4728                  ($timesrvrend{$testnum} - $timesrvrini{$testnum}));
4729             $timetooltot += $timetoolend{$testnum} - $timetoolini{$testnum};
4730             $timelocktot += $timesrvrlog{$testnum} - $timetoolend{$testnum};
4731             $timevrfytot += $timevrfyend{$testnum} - $timesrvrlog{$testnum};
4732             $timetesttot += $timevrfyend{$testnum} - $timeprepini{$testnum};
4733             push @timesrvr, sprintf("%06.3f  %04d",
4734                 $timesrvrend{$testnum} - $timesrvrini{$testnum}, $testnum);
4735             push @timeprep, sprintf("%06.3f  %04d",
4736                 ($timetoolini{$testnum} - $timeprepini{$testnum}) -
4737                 ($timesrvrend{$testnum} - $timesrvrini{$testnum}), $testnum);
4738             push @timetool, sprintf("%06.3f  %04d",
4739                 $timetoolend{$testnum} - $timetoolini{$testnum}, $testnum);
4740             push @timelock, sprintf("%06.3f  %04d",
4741                 $timesrvrlog{$testnum} - $timetoolend{$testnum}, $testnum);
4742             push @timevrfy, sprintf("%06.3f  %04d",
4743                 $timevrfyend{$testnum} - $timesrvrlog{$testnum}, $testnum);
4744             push @timetest, sprintf("%06.3f  %04d",
4745                 $timevrfyend{$testnum} - $timeprepini{$testnum}, $testnum);
4746         }
4747     }
4748
4749     {
4750         no warnings 'numeric';
4751         @timesrvr = sort { $b <=> $a } @timesrvr;
4752         @timeprep = sort { $b <=> $a } @timeprep;
4753         @timetool = sort { $b <=> $a } @timetool;
4754         @timelock = sort { $b <=> $a } @timelock;
4755         @timevrfy = sort { $b <=> $a } @timevrfy;
4756         @timetest = sort { $b <=> $a } @timetest;
4757     }
4758
4759     logmsg "Spent ". sprintf("%08.3f ", $timesrvrtot) .
4760            "seconds starting and verifying test harness servers.\n";
4761     logmsg "Spent ". sprintf("%08.3f ", $timepreptot) .
4762            "seconds reading definitions and doing test preparations.\n";
4763     logmsg "Spent ". sprintf("%08.3f ", $timetooltot) .
4764            "seconds actually running test tools.\n";
4765     logmsg "Spent ". sprintf("%08.3f ", $timelocktot) .
4766            "seconds awaiting server logs lock removal.\n";
4767     logmsg "Spent ". sprintf("%08.3f ", $timevrfytot) .
4768            "seconds verifying test results.\n";
4769     logmsg "Spent ". sprintf("%08.3f ", $timetesttot) .
4770            "seconds doing all of the above.\n";
4771
4772     $counter = 25;
4773     logmsg "\nTest server starting and verification time per test ".
4774         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4775     logmsg "-time-  test\n";
4776     logmsg "------  ----\n";
4777     foreach my $txt (@timesrvr) {
4778         last if((not $fullstats) && (not $counter--));
4779         logmsg "$txt\n";
4780     }
4781
4782     $counter = 10;
4783     logmsg "\nTest definition reading and preparation time per test ".
4784         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4785     logmsg "-time-  test\n";
4786     logmsg "------  ----\n";
4787     foreach my $txt (@timeprep) {
4788         last if((not $fullstats) && (not $counter--));
4789         logmsg "$txt\n";
4790     }
4791
4792     $counter = 25;
4793     logmsg "\nTest tool execution time per test ".
4794         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4795     logmsg "-time-  test\n";
4796     logmsg "------  ----\n";
4797     foreach my $txt (@timetool) {
4798         last if((not $fullstats) && (not $counter--));
4799         logmsg "$txt\n";
4800     }
4801
4802     $counter = 15;
4803     logmsg "\nTest server logs lock removal time per test ".
4804         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4805     logmsg "-time-  test\n";
4806     logmsg "------  ----\n";
4807     foreach my $txt (@timelock) {
4808         last if((not $fullstats) && (not $counter--));
4809         logmsg "$txt\n";
4810     }
4811
4812     $counter = 10;
4813     logmsg "\nTest results verification time per test ".
4814         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4815     logmsg "-time-  test\n";
4816     logmsg "------  ----\n";
4817     foreach my $txt (@timevrfy) {
4818         last if((not $fullstats) && (not $counter--));
4819         logmsg "$txt\n";
4820     }
4821
4822     $counter = 50;
4823     logmsg "\nTotal time per test ".
4824         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4825     logmsg "-time-  test\n";
4826     logmsg "------  ----\n";
4827     foreach my $txt (@timetest) {
4828         last if((not $fullstats) && (not $counter--));
4829         logmsg "$txt\n";
4830     }
4831
4832     logmsg "\n";
4833 }
4834
4835 #######################################################################
4836 # Check options to this test program
4837 #
4838
4839 my $number=0;
4840 my $fromnum=-1;
4841 my @testthis;
4842 while(@ARGV) {
4843     if ($ARGV[0] eq "-v") {
4844         # verbose output
4845         $verbose=1;
4846     }
4847     elsif($ARGV[0] =~ /^-b(.*)/) {
4848         my $portno=$1;
4849         if($portno =~ s/(\d+)$//) {
4850             $base = int $1;
4851         }
4852     }
4853     elsif ($ARGV[0] eq "-c") {
4854         # use this path to curl instead of default
4855         $DBGCURL=$CURL="\"$ARGV[1]\"";
4856         shift @ARGV;
4857     }
4858     elsif ($ARGV[0] eq "-vc") {
4859         # use this path to a curl used to verify servers
4860
4861         # Particularly useful when you introduce a crashing bug somewhere in
4862         # the development version as then it won't be able to run any tests
4863         # since it can't verify the servers!
4864
4865         $VCURL="\"$ARGV[1]\"";
4866         shift @ARGV;
4867     }
4868     elsif ($ARGV[0] eq "-d") {
4869         # have the servers display protocol output
4870         $debugprotocol=1;
4871     }
4872     elsif ($ARGV[0] eq "-g") {
4873         # run this test with gdb
4874         $gdbthis=1;
4875     }
4876     elsif ($ARGV[0] eq "-gw") {
4877         # run this test with windowed gdb
4878         $gdbthis=1;
4879         $gdbxwin=1;
4880     }
4881     elsif($ARGV[0] eq "-s") {
4882         # short output
4883         $short=1;
4884     }
4885     elsif($ARGV[0] eq "-am") {
4886         # automake-style output
4887         $short=1;
4888         $automakestyle=1;
4889     }
4890     elsif($ARGV[0] eq "-n") {
4891         # no valgrind
4892         undef $valgrind;
4893     }
4894     elsif($ARGV[0] =~ /^-t(.*)/) {
4895         # torture
4896         $torture=1;
4897         my $xtra = $1;
4898
4899         if($xtra =~ s/(\d+)$//) {
4900             $tortalloc = $1;
4901         }
4902         # we undef valgrind to make this fly in comparison
4903         undef $valgrind;
4904     }
4905     elsif($ARGV[0] eq "-a") {
4906         # continue anyway, even if a test fail
4907         $anyway=1;
4908     }
4909     elsif($ARGV[0] eq "-e") {
4910         # run the tests cases event based if possible
4911         $run_event_based=1;
4912     }
4913     elsif($ARGV[0] eq "-p") {
4914         $postmortem=1;
4915     }
4916     elsif($ARGV[0] eq "-l") {
4917         # lists the test case names only
4918         $listonly=1;
4919     }
4920     elsif($ARGV[0] eq "-k") {
4921         # keep stdout and stderr files after tests
4922         $keepoutfiles=1;
4923     }
4924     elsif($ARGV[0] eq "-r") {
4925         # run time statistics needs Time::HiRes
4926         if($Time::HiRes::VERSION) {
4927             keys(%timeprepini) = 1000;
4928             keys(%timesrvrini) = 1000;
4929             keys(%timesrvrend) = 1000;
4930             keys(%timetoolini) = 1000;
4931             keys(%timetoolend) = 1000;
4932             keys(%timesrvrlog) = 1000;
4933             keys(%timevrfyend) = 1000;
4934             $timestats=1;
4935             $fullstats=0;
4936         }
4937     }
4938     elsif($ARGV[0] eq "-rf") {
4939         # run time statistics needs Time::HiRes
4940         if($Time::HiRes::VERSION) {
4941             keys(%timeprepini) = 1000;
4942             keys(%timesrvrini) = 1000;
4943             keys(%timesrvrend) = 1000;
4944             keys(%timetoolini) = 1000;
4945             keys(%timetoolend) = 1000;
4946             keys(%timesrvrlog) = 1000;
4947             keys(%timevrfyend) = 1000;
4948             $timestats=1;
4949             $fullstats=1;
4950         }
4951     }
4952     elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
4953         # show help text
4954         print <<EOHELP
4955 Usage: runtests.pl [options] [test selection(s)]
4956   -a       continue even if a test fails
4957   -bN      use base port number N for test servers (default $base)
4958   -c path  use this curl executable
4959   -d       display server debug info
4960   -g       run the test case with gdb
4961   -gw      run the test case with gdb as a windowed application
4962   -h       this help text
4963   -k       keep stdout and stderr files present after tests
4964   -l       list all test case names/descriptions
4965   -n       no valgrind
4966   -p       print log file contents when a test fails
4967   -r       run time statistics
4968   -rf      full run time statistics
4969   -s       short output
4970   -am      automake style output PASS/FAIL: [number] [name]
4971   -t[N]    torture (simulate memory alloc failures); N means fail Nth alloc
4972   -v       verbose output
4973   -vc path use this curl only to verify the existing servers
4974   [num]    like "5 6 9" or " 5 to 22 " to run those tests only
4975   [!num]   like "!5 !6 !9" to disable those tests
4976   [keyword] like "IPv6" to select only tests containing the key word
4977   [!keyword] like "!cookies" to disable any tests containing the key word
4978 EOHELP
4979     ;
4980         exit;
4981     }
4982     elsif($ARGV[0] =~ /^(\d+)/) {
4983         $number = $1;
4984         if($fromnum >= 0) {
4985             for($fromnum .. $number) {
4986                 push @testthis, $_;
4987             }
4988             $fromnum = -1;
4989         }
4990         else {
4991             push @testthis, $1;
4992         }
4993     }
4994     elsif($ARGV[0] =~ /^to$/i) {
4995         $fromnum = $number+1;
4996     }
4997     elsif($ARGV[0] =~ /^!(\d+)/) {
4998         $fromnum = -1;
4999         $disabled{$1}=$1;
5000     }
5001     elsif($ARGV[0] =~ /^!(.+)/) {
5002         $disabled_keywords{$1}=$1;
5003     }
5004     elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) {
5005         $enabled_keywords{$1}=$1;
5006     }
5007     else {
5008         print "Unknown option: $ARGV[0]\n";
5009         exit;
5010     }
5011     shift @ARGV;
5012 }
5013
5014 if(@testthis && ($testthis[0] ne "")) {
5015     $TESTCASES=join(" ", @testthis);
5016 }
5017
5018 if($valgrind) {
5019     # we have found valgrind on the host, use it
5020
5021     # verify that we can invoke it fine
5022     my $code = runclient("valgrind >/dev/null 2>&1");
5023
5024     if(($code>>8) != 1) {
5025         #logmsg "Valgrind failure, disable it\n";
5026         undef $valgrind;
5027     } else {
5028
5029         # since valgrind 2.1.x, '--tool' option is mandatory
5030         # use it, if it is supported by the version installed on the system
5031         runclient("valgrind --help 2>&1 | grep -- --tool > /dev/null 2>&1");
5032         if (($? >> 8)==0) {
5033             $valgrind_tool="--tool=memcheck";
5034         }
5035         open(C, "<$CURL");
5036         my $l = <C>;
5037         if($l =~ /^\#\!/) {
5038             # A shell script. This is typically when built with libtool,
5039             $valgrind="../libtool --mode=execute $valgrind";
5040         }
5041         close(C);
5042
5043         # valgrind 3 renamed the --logfile option to --log-file!!!
5044         my $ver=join(' ', runclientoutput("valgrind --version"));
5045         # cut off all but digits and dots
5046         $ver =~ s/[^0-9.]//g;
5047
5048         if($ver =~ /^(\d+)/) {
5049             $ver = $1;
5050             if($ver >= 3) {
5051                 $valgrind_logfile="--log-file";
5052             }
5053         }
5054     }
5055 }
5056
5057 if ($gdbthis) {
5058     # open the executable curl and read the first 4 bytes of it
5059     open(CHECK, "<$CURL");
5060     my $c;
5061     sysread CHECK, $c, 4;
5062     close(CHECK);
5063     if($c eq "#! /") {
5064         # A shell script. This is typically when built with libtool,
5065         $libtool = 1;
5066         $gdb = "../libtool --mode=execute gdb";
5067     }
5068 }
5069
5070 $HTTPPORT        = $base++; # HTTP server port
5071 $HTTPSPORT       = $base++; # HTTPS (stunnel) server port
5072 $FTPPORT         = $base++; # FTP server port
5073 $FTPSPORT        = $base++; # FTPS (stunnel) server port
5074 $HTTP6PORT       = $base++; # HTTP IPv6 server port
5075 $FTP2PORT        = $base++; # FTP server 2 port
5076 $FTP6PORT        = $base++; # FTP IPv6 port
5077 $TFTPPORT        = $base++; # TFTP (UDP) port
5078 $TFTP6PORT       = $base++; # TFTP IPv6 (UDP) port
5079 $SSHPORT         = $base++; # SSH (SCP/SFTP) port
5080 $SOCKSPORT       = $base++; # SOCKS port
5081 $POP3PORT        = $base++; # POP3 server port
5082 $POP36PORT       = $base++; # POP3 IPv6 server port
5083 $IMAPPORT        = $base++; # IMAP server port
5084 $IMAP6PORT       = $base++; # IMAP IPv6 server port
5085 $SMTPPORT        = $base++; # SMTP server port
5086 $SMTP6PORT       = $base++; # SMTP IPv6 server port
5087 $RTSPPORT        = $base++; # RTSP server port
5088 $RTSP6PORT       = $base++; # RTSP IPv6 server port
5089 $GOPHERPORT      = $base++; # Gopher IPv4 server port
5090 $GOPHER6PORT     = $base++; # Gopher IPv6 server port
5091 $HTTPTLSPORT     = $base++; # HTTP TLS (non-stunnel) server port
5092 $HTTPTLS6PORT    = $base++; # HTTP TLS (non-stunnel) IPv6 server port
5093 $HTTPPROXYPORT   = $base++; # HTTP proxy port, when using CONNECT
5094 $HTTPPIPEPORT    = $base++; # HTTP pipelining port
5095 $HTTP2PORT       = $base++; # HTTP/2 port
5096 $HTTPUNIXPATH    = 'http.sock'; # HTTP server Unix domain socket path
5097
5098 #######################################################################
5099 # clear and create logging directory:
5100 #
5101
5102 cleardir($LOGDIR);
5103 mkdir($LOGDIR, 0777);
5104
5105 #######################################################################
5106 # initialize some variables
5107 #
5108
5109 get_disttests();
5110 init_serverpidfile_hash();
5111
5112 #######################################################################
5113 # Output curl version and host info being tested
5114 #
5115
5116 if(!$listonly) {
5117     checksystem();
5118 }
5119
5120 #######################################################################
5121 # Fetch all disabled tests, if there are any
5122 #
5123
5124 sub disabledtests {
5125     my ($file) = @_;
5126
5127     if(open(D, "<$file")) {
5128         while(<D>) {
5129             if(/^ *\#/) {
5130                 # allow comments
5131                 next;
5132             }
5133             if($_ =~ /(\d+)/) {
5134                 $disabled{$1}=$1; # disable this test number
5135             }
5136         }
5137         close(D);
5138     }
5139 }
5140
5141 # globally disabled tests
5142 disabledtests("$TESTDIR/DISABLED");
5143
5144 # locally disabled tests, ignored by git etc
5145 disabledtests("$TESTDIR/DISABLED.local");
5146
5147 #######################################################################
5148 # If 'all' tests are requested, find out all test numbers
5149 #
5150
5151 if ( $TESTCASES eq "all") {
5152     # Get all commands and find out their test numbers
5153     opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
5154     my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
5155     closedir(DIR);
5156
5157     $TESTCASES=""; # start with no test cases
5158
5159     # cut off everything but the digits
5160     for(@cmds) {
5161         $_ =~ s/[a-z\/\.]*//g;
5162     }
5163     # sort the numbers from low to high
5164     foreach my $n (sort { $a <=> $b } @cmds) {
5165         if($disabled{$n}) {
5166             # skip disabled test cases
5167             my $why = "configured as DISABLED";
5168             $skipped++;
5169             $skipped{$why}++;
5170             $teststat[$n]=$why; # store reason for this test case
5171             next;
5172         }
5173         $TESTCASES .= " $n";
5174     }
5175 }
5176 else {
5177     my $verified="";
5178     map {
5179         if (-e "$TESTDIR/test$_") {
5180             $verified.="$_ ";
5181         }
5182     } split(" ", $TESTCASES);
5183     if($verified eq "") {
5184         print "No existing test cases were specified\n";
5185         exit;
5186     }
5187     $TESTCASES = $verified;
5188 }
5189
5190 #######################################################################
5191 # Start the command line log
5192 #
5193 open(CMDLOG, ">$CURLLOG") ||
5194     logmsg "can't log command lines to $CURLLOG\n";
5195
5196 #######################################################################
5197
5198 # Display the contents of the given file.  Line endings are canonicalized
5199 # and excessively long files are elided
5200 sub displaylogcontent {
5201     my ($file)=@_;
5202     if(open(SINGLE, "<$file")) {
5203         my $linecount = 0;
5204         my $truncate;
5205         my @tail;
5206         while(my $string = <SINGLE>) {
5207             $string =~ s/\r\n/\n/g;
5208             $string =~ s/[\r\f\032]/\n/g;
5209             $string .= "\n" unless ($string =~ /\n$/);
5210             $string =~ tr/\n//;
5211             for my $line (split("\n", $string)) {
5212                 $line =~ s/\s*\!$//;
5213                 if ($truncate) {
5214                     push @tail, " $line\n";
5215                 } else {
5216                     logmsg " $line\n";
5217                 }
5218                 $linecount++;
5219                 $truncate = $linecount > 1000;
5220             }
5221         }
5222         if(@tail) {
5223             my $tailshow = 200;
5224             my $tailskip = 0;
5225             my $tailtotal = scalar @tail;
5226             if($tailtotal > $tailshow) {
5227                 $tailskip = $tailtotal - $tailshow;
5228                 logmsg "=== File too long: $tailskip lines omitted here\n";
5229             }
5230             for($tailskip .. $tailtotal-1) {
5231                 logmsg "$tail[$_]";
5232             }
5233         }
5234         close(SINGLE);
5235     }
5236 }
5237
5238 sub displaylogs {
5239     my ($testnum)=@_;
5240     opendir(DIR, "$LOGDIR") ||
5241         die "can't open dir: $!";
5242     my @logs = readdir(DIR);
5243     closedir(DIR);
5244
5245     logmsg "== Contents of files in the $LOGDIR/ dir after test $testnum\n";
5246     foreach my $log (sort @logs) {
5247         if($log =~ /\.(\.|)$/) {
5248             next; # skip "." and ".."
5249         }
5250         if($log =~ /^\.nfs/) {
5251             next; # skip ".nfs"
5252         }
5253         if(($log eq "memdump") || ($log eq "core")) {
5254             next; # skip "memdump" and  "core"
5255         }
5256         if((-d "$LOGDIR/$log") || (! -s "$LOGDIR/$log")) {
5257             next; # skip directory and empty files
5258         }
5259         if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) {
5260             next; # skip stdoutNnn of other tests
5261         }
5262         if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) {
5263             next; # skip stderrNnn of other tests
5264         }
5265         if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) {
5266             next; # skip uploadNnn of other tests
5267         }
5268         if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) {
5269             next; # skip curlNnn.out of other tests
5270         }
5271         if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) {
5272             next; # skip testNnn.txt of other tests
5273         }
5274         if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) {
5275             next; # skip fileNnn.txt of other tests
5276         }
5277         if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) {
5278             next; # skip netrcNnn of other tests
5279         }
5280         if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) {
5281             next; # skip traceNnn of other tests
5282         }
5283         if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(\..*|)$/)) {
5284             next; # skip valgrindNnn of other tests
5285         }
5286         logmsg "=== Start of file $log\n";
5287         displaylogcontent("$LOGDIR/$log");
5288         logmsg "=== End of file $log\n";
5289     }
5290 }
5291
5292 #######################################################################
5293 # The main test-loop
5294 #
5295
5296 my $failed;
5297 my $testnum;
5298 my $ok=0;
5299 my $total=0;
5300 my $lasttest=0;
5301 my @at = split(" ", $TESTCASES);
5302 my $count=0;
5303
5304 $start = time();
5305
5306 foreach $testnum (@at) {
5307
5308     $lasttest = $testnum if($testnum > $lasttest);
5309     $count++;
5310
5311     my $error = singletest($run_event_based, $testnum, $count, scalar(@at));
5312     if($error < 0) {
5313         # not a test we can run
5314         next;
5315     }
5316
5317     $total++; # number of tests we've run
5318
5319     if($error>0) {
5320         $failed.= "$testnum ";
5321         if($postmortem) {
5322             # display all files in log/ in a nice way
5323             displaylogs($testnum);
5324         }
5325         if(!$anyway) {
5326             # a test failed, abort
5327             logmsg "\n - abort tests\n";
5328             last;
5329         }
5330     }
5331     elsif(!$error) {
5332         $ok++; # successful test counter
5333     }
5334
5335     # loop for next test
5336 }
5337
5338 my $sofar = time() - $start;
5339
5340 #######################################################################
5341 # Close command log
5342 #
5343 close(CMDLOG);
5344
5345 # Tests done, stop the servers
5346 stopservers($verbose);
5347
5348 my $all = $total + $skipped;
5349
5350 runtimestats($lasttest);
5351
5352 if($total) {
5353     logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
5354                    $ok/$total*100);
5355
5356     if($ok != $total) {
5357         logmsg "TESTFAIL: These test cases failed: $failed\n";
5358     }
5359 }
5360 else {
5361     logmsg "TESTFAIL: No tests were performed\n";
5362 }
5363
5364 if($all) {
5365     logmsg "TESTDONE: $all tests were considered during ".
5366         sprintf("%.0f", $sofar) ." seconds.\n";
5367 }
5368
5369 if($skipped && !$short) {
5370     my $s=0;
5371     logmsg "TESTINFO: $skipped tests were skipped due to these restraints:\n";
5372
5373     for(keys %skipped) {
5374         my $r = $_;
5375         printf "TESTINFO: \"%s\" %d times (", $r, $skipped{$_};
5376
5377         # now show all test case numbers that had this reason for being
5378         # skipped
5379         my $c=0;
5380         my $max = 9;
5381         for(0 .. scalar @teststat) {
5382             my $t = $_;
5383             if($teststat[$_] && ($teststat[$_] eq $r)) {
5384                 if($c < $max) {
5385                     logmsg ", " if($c);
5386                     logmsg $_;
5387                 }
5388                 $c++;
5389             }
5390         }
5391         if($c > $max) {
5392             logmsg " and ".($c-$max)." more";
5393         }
5394         logmsg ")\n";
5395     }
5396 }
5397
5398 if($total && ($ok != $total)) {
5399     exit 1;
5400 }