tests/runtests.pl

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