tests/runtests.pl

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