tests/runtests.pl

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