tests/runtests.pl

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