tests/runtests.pl

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