QRScanner/mobile/jni/thirdparty/curl/tests/runtests.pl

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