tests/runtests.pl

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