tests/runtests.pl

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