tests/runtests.pl

   1 #!/usr/bin/env perl
   2 #***************************************************************************
   3 #                                  _   _ ____  _
   4 #  Project                     ___| | | |  _ \| |
   5 #                             / __| | | | |_) | |
   6 #                            | (__| |_| |  _ <| |___
   7 #                             \___|\___/|_| \_\_____|
   8 #
   9 # Copyright (C) 1998 - 2014, 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("tstunnel") || 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_sspi;    # set if libcurl is built with SSPI support
 214 my $has_charconv;# set if libcurl is built with CharConv support
 215 my $has_tls_srp; # set if libcurl is built with TLS-SRP support
 216 my $has_metalink;# set if curl is built with Metalink support
 217
 218 my $has_openssl;  # built with a lib using an OpenSSL-like API
 219 my $has_gnutls;   # built with GnuTLS
 220 my $has_nss;      # built with NSS
 221 my $has_yassl;    # built with yassl
 222 my $has_polarssl; # built with polarssl
 223 my $has_axtls;    # built with axTLS
 224 my $has_winssl;   # built with WinSSL    (Secure Channel aka Schannel)
 225 my $has_darwinssl;# build with DarwinSSL (Secure Transport)
 226
 227 my $has_shared = "unknown";  # built shared
 228
 229 my $resolver;     # string to hold the resolver backend
 230 my $has_cares;    # if built with c-ares
 231 my $has_threadedres; # if built with threaded resolver
 232
 233 my $ssllib;      # name of the lib we use (for human presentation)
 234 my $has_crypto;  # set if libcurl is built with cryptographic support
 235 my $has_textaware; # set if running on a system that has a text mode concept
 236   # on files. Windows for example
 237
 238 my @protocols;   # array of lowercase supported protocol servers
 239
 240 my $skipped=0;  # number of tests skipped; reported in main loop
 241 my %skipped;    # skipped{reason}=counter, reasons for skip
 242 my @teststat;   # teststat[testnum]=reason, reasons for skip
 243 my %disabled_keywords;  # key words of tests to skip
 244 my %enabled_keywords;   # key words of tests to run
 245 my %disabled;           # disabled test cases
 246
 247 my $sshdid;      # for socks server, ssh daemon version id
 248 my $sshdvernum;  # for socks server, ssh daemon version number
 249 my $sshdverstr;  # for socks server, ssh daemon version string
 250 my $sshderror;   # for socks server, ssh daemon version error
 251
 252 my $defserverlogslocktimeout = 20; # timeout to await server logs lock removal
 253 my $defpostcommanddelay = 0; # delay between command and postcheck sections
 254
 255 my $timestats;   # time stamping and stats generation
 256 my $fullstats;   # show time stats for every single test
 257 my %timeprepini; # timestamp for each test preparation start
 258 my %timesrvrini; # timestamp for each test required servers verification start
 259 my %timesrvrend; # timestamp for each test required servers verification end
 260 my %timetoolini; # timestamp for each test command run starting
 261 my %timetoolend; # timestamp for each test command run stopping
 262 my %timesrvrlog; # timestamp for each test server logs lock removal
 263 my %timevrfyend; # timestamp for each test result verification end
 264
 265 my $testnumcheck; # test number, set in singletest sub.
 266 my %oldenv;
 267
 268 #######################################################################
 269 # variables that command line options may set
 270 #
 271
 272 my $short;
 273 my $automakestyle;
 274 my $verbose;
 275 my $debugprotocol;
 276 my $anyway;
 277 my $gdbthis;      # run test case with gdb debugger
 278 my $gdbxwin;      # use windowed gdb when using gdb
 279 my $keepoutfiles; # keep stdout and stderr files after tests
 280 my $listonly;     # only list the tests
 281 my $postmortem;   # display detailed info about failed tests
 282 my $run_event_based; # run curl with --test-event to test the event API
 283
 284 my %run;          # running server
 285 my %doesntrun;    # servers that don't work, identified by pidfile
 286 my %serverpidfile;# all server pid file names, identified by server id
 287 my %runcert;      # cert file currently in use by an ssl running server
 288
 289 # torture test variables
 290 my $torture;
 291 my $tortnum;
 292 my $tortalloc;
 293
 294 #######################################################################
 295 # logmsg is our general message logging subroutine.
 296 #
 297 sub logmsg {
 298     for(@_) {
 299         print "$_";
 300     }
 301 }
 302
 303 # get the name of the current user
 304 my $USER = $ENV{USER};          # Linux
 305 if (!$USER) {
 306     $USER = $ENV{USERNAME};     # Windows
 307     if (!$USER) {
 308         $USER = $ENV{LOGNAME};  # Some UNIX (I think)
 309     }
 310 }
 311
 312 # enable memory debugging if curl is compiled with it
 313 $ENV{'CURL_MEMDEBUG'} = $memdump;
 314 $ENV{'CURL_ENTROPY'}="12345678";
 315 $ENV{'CURL_FORCETIME'}=1; # for debug NTLM magic
 316 $ENV{'HOME'}=$pwd;
 317
 318 sub catch_zap {
 319     my $signame = shift;
 320     logmsg "runtests.pl received SIG$signame, exiting\n";
 321     stopservers($verbose);
 322     die "Somebody sent me a SIG$signame";
 323 }
 324 $SIG{INT} = \&catch_zap;
 325 $SIG{TERM} = \&catch_zap;
 326
 327 ##########################################################################
 328 # Clear all possible '*_proxy' environment variables for various protocols
 329 # to prevent them to interfere with our testing!
 330
 331 my $protocol;
 332 foreach $protocol (('ftp', 'http', 'ftps', 'https', 'no', 'all')) {
 333     my $proxy = "${protocol}_proxy";
 334     # clear lowercase version
 335     delete $ENV{$proxy} if($ENV{$proxy});
 336     # clear uppercase version
 337     delete $ENV{uc($proxy)} if($ENV{uc($proxy)});
 338 }
 339
 340 # make sure we don't get affected by other variables that control our
 341 # behaviour
 342
 343 delete $ENV{'SSL_CERT_DIR'} if($ENV{'SSL_CERT_DIR'});
 344 delete $ENV{'SSL_CERT_PATH'} if($ENV{'SSL_CERT_PATH'});
 345 delete $ENV{'CURL_CA_BUNDLE'} if($ENV{'CURL_CA_BUNDLE'});
 346
 347 #######################################################################
 348 # Load serverpidfile hash with pidfile names for all possible servers.
 349 #
 350 sub init_serverpidfile_hash {
 351   for my $proto (('ftp', 'http', 'imap', 'pop3', 'smtp', 'http')) {
 352     for my $ssl (('', 's')) {
 353       for my $ipvnum ((4, 6)) {
 354         for my $idnum ((1, 2, 3)) {
 355           my $serv = servername_id("$proto$ssl", $ipvnum, $idnum);
 356           my $pidf = server_pidfilename("$proto$ssl", $ipvnum, $idnum);
 357           $serverpidfile{$serv} = $pidf;
 358         }
 359       }
 360     }
 361   }
 362   for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'gopher', 'httptls')) {
 363     for my $ipvnum ((4, 6)) {
 364       for my $idnum ((1, 2)) {
 365         my $serv = servername_id($proto, $ipvnum, $idnum);
 366         my $pidf = server_pidfilename($proto, $ipvnum, $idnum);
 367         $serverpidfile{$serv} = $pidf;
 368       }
 369     }
 370   }
 371 }
 372
 373 #######################################################################
 374 # Check if a given child process has just died. Reaps it if so.
 375 #
 376 sub checkdied {
 377     use POSIX ":sys_wait_h";
 378     my $pid = $_[0];
 379     if(not defined $pid || $pid <= 0) {
 380         return 0;
 381     }
 382     my $rc = waitpid($pid, &WNOHANG);
 383     return ($rc == $pid)?1:0;
 384 }
 385
 386 #######################################################################
 387 # Start a new thread/process and run the given command line in there.
 388 # Return the pids (yes plural) of the new child process to the parent.
 389 #
 390 sub startnew {
 391     my ($cmd, $pidfile, $timeout, $fake)=@_;
 392
 393     logmsg "startnew: $cmd\n" if ($verbose);
 394
 395     my $child = fork();
 396     my $pid2 = 0;
 397
 398     if(not defined $child) {
 399         logmsg "startnew: fork() failure detected\n";
 400         return (-1,-1);
 401     }
 402
 403     if(0 == $child) {
 404         # Here we are the child. Run the given command.
 405
 406         # Put an "exec" in front of the command so that the child process
 407         # keeps this child's process ID.
 408         exec("exec $cmd") || die "Can't exec() $cmd: $!";
 409
 410         # exec() should never return back here to this process. We protect
 411         # ourselves by calling die() just in case something goes really bad.
 412         die "error: exec() has returned";
 413     }
 414
 415     # Ugly hack but ssh client and gnutls-serv don't support pid files
 416     if ($fake) {
 417         if(open(OUT, ">$pidfile")) {
 418             print OUT $child . "\n";
 419             close(OUT);
 420             logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose);
 421         }
 422         else {
 423             logmsg "startnew: failed to write fake $pidfile with pid=$child\n";
 424         }
 425         # could/should do a while connect fails sleep a bit and loop
 426         sleep $timeout;
 427         if (checkdied($child)) {
 428             logmsg "startnew: child process has failed to start\n" if($verbose);
 429             return (-1,-1);
 430         }
 431     }
 432
 433     my $count = $timeout;
 434     while($count--) {
 435         if(-f $pidfile && -s $pidfile && open(PID, "<$pidfile")) {
 436             $pid2 = 0 + <PID>;
 437             close(PID);
 438             if(($pid2 > 0) && pidexists($pid2)) {
 439                 # if $pid2 is valid, then make sure this pid is alive, as
 440                 # otherwise it is just likely to be the _previous_ pidfile or
 441                 # similar!
 442                 last;
 443             }
 444             # invalidate $pid2 if not actually alive
 445             $pid2 = 0;
 446         }
 447         if (checkdied($child)) {
 448             logmsg "startnew: child process has died, server might start up\n"
 449                 if($verbose);
 450             # We can't just abort waiting for the server with a
 451             # return (-1,-1);
 452             # because the server might have forked and could still start
 453             # up normally. Instead, just reduce the amount of time we remain
 454             # waiting.
 455             $count >>= 2;
 456         }
 457         sleep(1);
 458     }
 459
 460     # Return two PIDs, the one for the child process we spawned and the one
 461     # reported by the server itself (in case it forked again on its own).
 462     # Both (potentially) need to be killed at the end of the test.
 463     return ($child, $pid2);
 464 }
 465
 466
 467 #######################################################################
 468 # Check for a command in the PATH of the test server.
 469 #
 470 sub checkcmd {
 471     my ($cmd)=@_;
 472     my @paths=(split(":", $ENV{'PATH'}), "/usr/sbin", "/usr/local/sbin",
 473                "/sbin", "/usr/bin", "/usr/local/bin",
 474                "./libtest/.libs", "./libtest");
 475     for(@paths) {
 476         if( -x "$_/$cmd" && ! -d "$_/$cmd") {
 477             # executable bit but not a directory!
 478             return "$_/$cmd";
 479         }
 480     }
 481 }
 482
 483 #######################################################################
 484 # Get the list of tests that the tests/data/Makefile.am knows about!
 485 #
 486 my $disttests;
 487 sub get_disttests {
 488     my @dist = `cd data && make show`;
 489     $disttests = join("", @dist);
 490 }
 491
 492 #######################################################################
 493 # Check for a command in the PATH of the machine running curl.
 494 #
 495 sub checktestcmd {
 496     my ($cmd)=@_;
 497     return checkcmd($cmd);
 498 }
 499
 500 #######################################################################
 501 # Run the application under test and return its return code
 502 #
 503 sub runclient {
 504     my ($cmd)=@_;
 505     my $ret = system($cmd);
 506     print "CMD ($ret): $cmd\n" if($verbose && !$torture);
 507     return $ret;
 508
 509 # This is one way to test curl on a remote machine
 510 #    my $out = system("ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'");
 511 #    sleep 2;    # time to allow the NFS server to be updated
 512 #    return $out;
 513 }
 514
 515 #######################################################################
 516 # Run the application under test and return its stdout
 517 #
 518 sub runclientoutput {
 519     my ($cmd)=@_;
 520     return `$cmd`;
 521
 522 # This is one way to test curl on a remote machine
 523 #    my @out = `ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'`;
 524 #    sleep 2;    # time to allow the NFS server to be updated
 525 #    return @out;
 526  }
 527
 528 #######################################################################
 529 # Memory allocation test and failure torture testing.
 530 #
 531 sub torture {
 532     my $testcmd = shift;
 533     my $gdbline = shift;
 534
 535     # remove memdump first to be sure we get a new nice and clean one
 536     unlink($memdump);
 537
 538     # First get URL from test server, ignore the output/result
 539     runclient($testcmd);
 540
 541     logmsg " CMD: $testcmd\n" if($verbose);
 542
 543     # memanalyze -v is our friend, get the number of allocations made
 544     my $count=0;
 545     my @out = `$memanalyze -v $memdump`;
 546     for(@out) {
 547         if(/^Allocations: (\d+)/) {
 548             $count = $1;
 549             last;
 550         }
 551     }
 552     if(!$count) {
 553         logmsg " found no allocs to make fail\n";
 554         return 0;
 555     }
 556
 557     logmsg " $count allocations to make fail\n";
 558
 559     for ( 1 .. $count ) {
 560         my $limit = $_;
 561         my $fail;
 562         my $dumped_core;
 563
 564         if($tortalloc && ($tortalloc != $limit)) {
 565             next;
 566         }
 567
 568         if($verbose) {
 569             my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
 570                 localtime(time());
 571             my $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
 572             logmsg "Fail alloc no: $limit at $now\r";
 573         }
 574
 575         # make the memory allocation function number $limit return failure
 576         $ENV{'CURL_MEMLIMIT'} = $limit;
 577
 578         # remove memdump first to be sure we get a new nice and clean one
 579         unlink($memdump);
 580
 581         logmsg "*** Alloc number $limit is now set to fail ***\n" if($gdbthis);
 582
 583         my $ret = 0;
 584         if($gdbthis) {
 585             runclient($gdbline)
 586         }
 587         else {
 588             $ret = runclient($testcmd);
 589         }
 590         #logmsg "$_ Returned " . ($ret >> 8) . "\n";
 591
 592         # Now clear the variable again
 593         delete $ENV{'CURL_MEMLIMIT'} if($ENV{'CURL_MEMLIMIT'});
 594
 595         if(-r "core") {
 596             # there's core file present now!
 597             logmsg " core dumped\n";
 598             $dumped_core = 1;
 599             $fail = 2;
 600         }
 601
 602         # verify that it returns a proper error code, doesn't leak memory
 603         # and doesn't core dump
 604         if(($ret & 255) || ($ret >> 8) >= 128) {
 605             logmsg " system() returned $ret\n";
 606             $fail=1;
 607         }
 608         else {
 609             my @memdata=`$memanalyze $memdump`;
 610             my $leak=0;
 611             for(@memdata) {
 612                 if($_ ne "") {
 613                     # well it could be other memory problems as well, but
 614                     # we call it leak for short here
 615                     $leak=1;
 616                 }
 617             }
 618             if($leak) {
 619                 logmsg "** MEMORY FAILURE\n";
 620                 logmsg @memdata;
 621                 logmsg `$memanalyze -l $memdump`;
 622                 $fail = 1;
 623             }
 624         }
 625         if($fail) {
 626             logmsg " Failed on alloc number $limit in test.\n",
 627             " invoke with \"-t$limit\" to repeat this single case.\n";
 628             stopservers($verbose);
 629             return 1;
 630         }
 631     }
 632
 633     logmsg "torture OK\n";
 634     return 0;
 635 }
 636
 637 #######################################################################
 638 # Stop a test server along with pids which aren't in the %run hash yet.
 639 # This also stops all servers which are relative to the given one.
 640 #
 641 sub stopserver {
 642     my ($server, $pidlist) = @_;
 643     #
 644     # kill sockfilter processes for pingpong relative server
 645     #
 646     if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
 647         my $proto  = $1;
 648         my $idnum  = ($2 && ($2 > 1)) ? $2 : 1;
 649         my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
 650         killsockfilters($proto, $ipvnum, $idnum, $verbose);
 651     }
 652     #
 653     # All servers relative to the given one must be stopped also
 654     #
 655     my @killservers;
 656     if($server =~ /^(ftp|http|imap|pop3|smtp|httppipe)s((\d*)(-ipv6|))$/) {
 657         # given a stunnel based ssl server, also kill non-ssl underlying one
 658         push @killservers, "${1}${2}";
 659     }
 660     elsif($server =~ /^(ftp|http|imap|pop3|smtp|httppipe)((\d*)(-ipv6|))$/) {
 661         # given a non-ssl server, also kill stunnel based ssl piggybacking one
 662         push @killservers, "${1}s${2}";
 663     }
 664     elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
 665         # given a socks server, also kill ssh underlying one
 666         push @killservers, "ssh${2}";
 667     }
 668     elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
 669         # given a ssh server, also kill socks piggybacking one
 670         push @killservers, "socks${2}";
 671     }
 672     push @killservers, $server;
 673     #
 674     # kill given pids and server relative ones clearing them in %run hash
 675     #
 676     foreach my $server (@killservers) {
 677         if($run{$server}) {
 678             # we must prepend a space since $pidlist may already contain a pid
 679             $pidlist .= " $run{$server}";
 680             $run{$server} = 0;
 681         }
 682         $runcert{$server} = 0 if($runcert{$server});
 683     }
 684     killpid($verbose, $pidlist);
 685     #
 686     # cleanup server pid files
 687     #
 688     foreach my $server (@killservers) {
 689         my $pidfile = $serverpidfile{$server};
 690         my $pid = processexists($pidfile);
 691         if($pid > 0) {
 692             logmsg "Warning: $server server unexpectedly alive\n";
 693             killpid($verbose, $pid);
 694         }
 695         unlink($pidfile) if(-f $pidfile);
 696     }
 697 }
 698
 699 #######################################################################
 700 # Verify that the server that runs on $ip, $port is our server.  This also
 701 # implies that we can speak with it, as there might be occasions when the
 702 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
 703 # assign requested address")
 704 #
 705 sub verifyhttp {
 706     my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
 707     my $server = servername_id($proto, $ipvnum, $idnum);
 708     my $pid = 0;
 709     my $bonus="";
 710
 711     my $verifyout = "$LOGDIR/".
 712         servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
 713     unlink($verifyout) if(-f $verifyout);
 714
 715     my $verifylog = "$LOGDIR/".
 716         servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
 717     unlink($verifylog) if(-f $verifylog);
 718
 719     if($proto eq "gopher") {
 720         # gopher is funny
 721         $bonus="1/";
 722     }
 723
 724     my $flags = "--max-time $server_response_maxtime ";
 725     $flags .= "--output $verifyout ";
 726     $flags .= "--silent ";
 727     $flags .= "--verbose ";
 728     $flags .= "--globoff ";
 729     $flags .= "-1 "         if($has_axtls);
 730     $flags .= "--insecure " if($proto eq 'https');
 731     $flags .= "\"$proto://$ip:$port/${bonus}verifiedserver\"";
 732
 733     my $cmd = "$VCURL $flags 2>$verifylog";
 734
 735     # verify if our/any server is running on this port
 736     logmsg "RUN: $cmd\n" if($verbose);
 737     my $res = runclient($cmd);
 738
 739     $res >>= 8; # rotate the result
 740     if($res & 128) {
 741         logmsg "RUN: curl command died with a coredump\n";
 742         return -1;
 743     }
 744
 745     if($res && $verbose) {
 746         logmsg "RUN: curl command returned $res\n";
 747         if(open(FILE, "<$verifylog")) {
 748             while(my $string = <FILE>) {
 749                 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
 750             }
 751             close(FILE);
 752         }
 753     }
 754
 755     my $data;
 756     if(open(FILE, "<$verifyout")) {
 757         while(my $string = <FILE>) {
 758             $data = $string;
 759             last; # only want first line
 760         }
 761         close(FILE);
 762     }
 763
 764     if($data && ($data =~ /WE ROOLZ: (\d+)/)) {
 765         $pid = 0+$1;
 766     }
 767     elsif($res == 6) {
 768         # curl: (6) Couldn't resolve host '::1'
 769         logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
 770         return -1;
 771     }
 772     elsif($data || ($res && ($res != 7))) {
 773         logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
 774         return -1;
 775     }
 776     return $pid;
 777 }
 778
 779 #######################################################################
 780 # Verify that the server that runs on $ip, $port is our server.  This also
 781 # implies that we can speak with it, as there might be occasions when the
 782 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
 783 # assign requested address")
 784 #
 785 sub verifyftp {
 786     my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
 787     my $server = servername_id($proto, $ipvnum, $idnum);
 788     my $pid = 0;
 789     my $time=time();
 790     my $extra="";
 791
 792     my $verifylog = "$LOGDIR/".
 793         servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
 794     unlink($verifylog) if(-f $verifylog);
 795
 796     if($proto eq "ftps") {
 797         $extra .= "--insecure --ftp-ssl-control ";
 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|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     $resolver="stock";
2293     for(@version) {
2294         chomp;
2295
2296         if($_ =~ /^curl/) {
2297             $curl = $_;
2298             $curl =~ s/^(.*)(libcurl.*)/$1/g;
2299
2300             $libcurl = $2;
2301             if($curl =~ /mingw32/) {
2302                 # This is a windows minw32 build, we need to translate the
2303                 # given path to the "actual" windows path. The MSYS shell
2304                 # has a builtin 'pwd -W' command which converts the path.
2305                 $pwd = `sh -c "echo \$(pwd -W)"`;
2306                 chomp($pwd);
2307             }
2308             elsif ($curl =~ /win32/) {
2309                # Native Windows builds don't understand the
2310                # output of cygwin's pwd.  It will be
2311                # something like /cygdrive/c/<some path>.
2312                #
2313                # Use the cygpath utility to convert the
2314                # working directory to a Windows friendly
2315                # path.  The -m option converts to use drive
2316                # letter:, but it uses / instead \.  Forward
2317                # slashes (/) are easier for us.  We don't
2318                # have to escape them to get them to curl
2319                # through a shell.
2320                chomp($pwd = `cygpath -m $pwd`);
2321            }
2322            if ($libcurl =~ /winssl/i) {
2323                $has_winssl=1;
2324                $ssllib="WinSSL";
2325            }
2326            elsif ($libcurl =~ /openssl/i) {
2327                $has_openssl=1;
2328                $ssllib="OpenSSL";
2329            }
2330            elsif ($libcurl =~ /gnutls/i) {
2331                $has_gnutls=1;
2332                $ssllib="GnuTLS";
2333            }
2334            elsif ($libcurl =~ /nss/i) {
2335                $has_nss=1;
2336                $ssllib="NSS";
2337            }
2338            elsif ($libcurl =~ /yassl/i) {
2339                $has_yassl=1;
2340                $ssllib="yassl";
2341            }
2342            elsif ($libcurl =~ /polarssl/i) {
2343                $has_polarssl=1;
2344                $ssllib="polarssl";
2345            }
2346            elsif ($libcurl =~ /axtls/i) {
2347                $has_axtls=1;
2348                $ssllib="axTLS";
2349            }
2350            elsif ($libcurl =~ /securetransport/i) {
2351                $has_darwinssl=1;
2352                $ssllib="DarwinSSL";
2353            }
2354            if ($libcurl =~ /ares/i) {
2355                $has_cares=1;
2356                $resolver="c-ares";
2357            }
2358         }
2359         elsif($_ =~ /^Protocols: (.*)/i) {
2360             # these are the protocols compiled in to this libcurl
2361             @protocols = split(' ', lc($1));
2362
2363             # Generate a "proto-ipv6" version of each protocol to match the
2364             # IPv6 <server> name. This works even if IPv6 support isn't
2365             # compiled in because the <features> test will fail.
2366             push @protocols, map($_ . '-ipv6', @protocols);
2367
2368             # 'http-proxy' is used in test cases to do CONNECT through
2369             push @protocols, 'http-proxy';
2370
2371             # 'http-pipe' is the special server for testing pipelining
2372             push @protocols, 'http-pipe';
2373
2374             # 'none' is used in test cases to mean no server
2375             push @protocols, 'none';
2376         }
2377         elsif($_ =~ /^Features: (.*)/i) {
2378             $feat = $1;
2379             if($feat =~ /TrackMemory/i) {
2380                 # built with memory tracking support (--enable-curldebug)
2381                 $has_memory_tracking = 1;
2382             }
2383             if($feat =~ /debug/i) {
2384                 # curl was built with --enable-debug
2385                 $debug_build = 1;
2386             }
2387             if($feat =~ /SSL/i) {
2388                 # ssl enabled
2389                 $ssl_version=1;
2390             }
2391             if($feat =~ /Largefile/i) {
2392                 # large file support
2393                 $large_file=1;
2394             }
2395             if($feat =~ /IDN/i) {
2396                 # IDN support
2397                 $has_idn=1;
2398             }
2399             if($feat =~ /IPv6/i) {
2400                 $has_ipv6 = 1;
2401             }
2402             if($feat =~ /libz/i) {
2403                 $has_libz = 1;
2404             }
2405             if($feat =~ /NTLM/i) {
2406                 # NTLM enabled
2407                 $has_ntlm=1;
2408                 # Use this as a proxy for any cryptographic authentication
2409                 $has_crypto=1;
2410             }
2411             if($feat =~ /NTLM_WB/i) {
2412                 # NTLM delegation to winbind daemon ntlm_auth helper enabled
2413                 $has_ntlm_wb=1;
2414             }
2415             if($feat =~ /SSPI/i) {
2416                 # SSPI enabled
2417                 $has_sspi=1;
2418             }
2419             if($feat =~ /CharConv/i) {
2420                 # CharConv enabled
2421                 $has_charconv=1;
2422             }
2423             if($feat =~ /TLS-SRP/i) {
2424                 # TLS-SRP enabled
2425                 $has_tls_srp=1;
2426             }
2427             if($feat =~ /Metalink/i) {
2428                 # Metalink enabled
2429                 $has_metalink=1;
2430             }
2431             if($feat =~ /AsynchDNS/i) {
2432                 if(!$has_cares) {
2433                     # this means threaded resolver
2434                     $has_threadedres=1;
2435                     $resolver="threaded";
2436                 }
2437             }
2438         }
2439         #
2440         # Test harness currently uses a non-stunnel server in order to
2441         # run HTTP TLS-SRP tests required when curl is built with https
2442         # protocol support and TLS-SRP feature enabled. For convenience
2443         # 'httptls' may be included in the test harness protocols array
2444         # to differentiate this from classic stunnel based 'https' test
2445         # harness server.
2446         #
2447         if($has_tls_srp) {
2448             my $add_httptls;
2449             for(@protocols) {
2450                 if($_ =~ /^https(-ipv6|)$/) {
2451                     $add_httptls=1;
2452                     last;
2453                 }
2454             }
2455             if($add_httptls && (! grep /^httptls$/, @protocols)) {
2456                 push @protocols, 'httptls';
2457                 push @protocols, 'httptls-ipv6';
2458             }
2459         }
2460     }
2461     if(!$curl) {
2462         logmsg "unable to get curl's version, further details are:\n";
2463         logmsg "issued command: \n";
2464         logmsg "$versioncmd \n";
2465         if ($versretval == -1) {
2466             logmsg "command failed with: \n";
2467             logmsg "$versnoexec \n";
2468         }
2469         elsif ($versretval & 127) {
2470             logmsg sprintf("command died with signal %d, and %s coredump.\n",
2471                            ($versretval & 127), ($versretval & 128)?"a":"no");
2472         }
2473         else {
2474             logmsg sprintf("command exited with value %d \n", $versretval >> 8);
2475         }
2476         logmsg "contents of $curlverout: \n";
2477         displaylogcontent("$curlverout");
2478         logmsg "contents of $curlvererr: \n";
2479         displaylogcontent("$curlvererr");
2480         die "couldn't get curl's version";
2481     }
2482
2483     if(-r "../lib/curl_config.h") {
2484         open(CONF, "<../lib/curl_config.h");
2485         while(<CONF>) {
2486             if($_ =~ /^\#define HAVE_GETRLIMIT/) {
2487                 $has_getrlimit = 1;
2488             }
2489         }
2490         close(CONF);
2491     }
2492
2493     if($has_ipv6) {
2494         # client has ipv6 support
2495
2496         # check if the HTTP server has it!
2497         my @sws = `server/sws --version`;
2498         if($sws[0] =~ /IPv6/) {
2499             # HTTP server has ipv6 support!
2500             $http_ipv6 = 1;
2501             $gopher_ipv6 = 1;
2502         }
2503
2504         # check if the FTP server has it!
2505         @sws = `server/sockfilt --version`;
2506         if($sws[0] =~ /IPv6/) {
2507             # FTP server has ipv6 support!
2508             $ftp_ipv6 = 1;
2509         }
2510     }
2511
2512     if(!$has_memory_tracking && $torture) {
2513         die "can't run torture tests since curl was built without ".
2514             "TrackMemory feature (--enable-curldebug)";
2515     }
2516
2517     $has_shared = `sh $CURLCONFIG --built-shared`;
2518     chomp $has_shared;
2519
2520     my $hostname=join(' ', runclientoutput("hostname"));
2521     my $hosttype=join(' ', runclientoutput("uname -a"));
2522
2523     logmsg ("********* System characteristics ******** \n",
2524     "* $curl\n",
2525     "* $libcurl\n",
2526     "* Features: $feat\n",
2527     "* Host: $hostname",
2528     "* System: $hosttype");
2529
2530     if($has_memory_tracking && $has_threadedres) {
2531         $has_memory_tracking = 0;
2532         logmsg("*\n",
2533                "*** DISABLES memory tracking when using threaded resolver\n",
2534                "*\n");
2535     }
2536
2537     logmsg sprintf("* Server SSL:   %8s", $stunnel?"ON ":"OFF");
2538     logmsg sprintf("  libcurl SSL:  %s\n", $ssl_version?"ON ":"OFF");
2539     logmsg sprintf("* debug build:  %8s", $debug_build?"ON ":"OFF");
2540     logmsg sprintf("  track memory: %s\n", $has_memory_tracking?"ON ":"OFF");
2541     logmsg sprintf("* valgrind:     %8s", $valgrind?"ON ":"OFF");
2542     logmsg sprintf("  HTTP IPv6     %s\n", $http_ipv6?"ON ":"OFF");
2543     logmsg sprintf("* FTP IPv6      %8s", $ftp_ipv6?"ON ":"OFF");
2544     logmsg sprintf("  Libtool lib:  %s\n", $libtool?"ON ":"OFF");
2545     logmsg sprintf("* Shared build:      %-3s", $has_shared);
2546     logmsg sprintf("  Resolver:     %s\n", $resolver);
2547     if($ssl_version) {
2548         logmsg sprintf("* SSL library: %13s\n", $ssllib);
2549     }
2550
2551     logmsg "* Ports:\n";
2552
2553     logmsg sprintf("*   HTTP/%d ", $HTTPPORT);
2554     logmsg sprintf("FTP/%d ", $FTPPORT);
2555     logmsg sprintf("FTP2/%d ", $FTP2PORT);
2556     logmsg sprintf("RTSP/%d ", $RTSPPORT);
2557     if($stunnel) {
2558         logmsg sprintf("FTPS/%d ", $FTPSPORT);
2559         logmsg sprintf("HTTPS/%d ", $HTTPSPORT);
2560     }
2561     logmsg sprintf("\n*   TFTP/%d ", $TFTPPORT);
2562     if($http_ipv6) {
2563         logmsg sprintf("HTTP-IPv6/%d ", $HTTP6PORT);
2564         logmsg sprintf("RTSP-IPv6/%d ", $RTSP6PORT);
2565     }
2566     if($ftp_ipv6) {
2567         logmsg sprintf("FTP-IPv6/%d ", $FTP6PORT);
2568     }
2569     if($tftp_ipv6) {
2570         logmsg sprintf("TFTP-IPv6/%d ", $TFTP6PORT);
2571     }
2572     logmsg sprintf("\n*   GOPHER/%d ", $GOPHERPORT);
2573     if($gopher_ipv6) {
2574         logmsg sprintf("GOPHER-IPv6/%d", $GOPHERPORT);
2575     }
2576     logmsg sprintf("\n*   SSH/%d ", $SSHPORT);
2577     logmsg sprintf("SOCKS/%d ", $SOCKSPORT);
2578     logmsg sprintf("POP3/%d ", $POP3PORT);
2579     logmsg sprintf("IMAP/%d ", $IMAPPORT);
2580     logmsg sprintf("SMTP/%d\n", $SMTPPORT);
2581     if($ftp_ipv6) {
2582         logmsg sprintf("*   POP3-IPv6/%d ", $POP36PORT);
2583         logmsg sprintf("IMAP-IPv6/%d ", $IMAP6PORT);
2584         logmsg sprintf("SMTP-IPv6/%d\n", $SMTP6PORT);
2585     }
2586     if($httptlssrv) {
2587         logmsg sprintf("*   HTTPTLS/%d ", $HTTPTLSPORT);
2588         if($has_ipv6) {
2589             logmsg sprintf("HTTPTLS-IPv6/%d ", $HTTPTLS6PORT);
2590         }
2591         logmsg "\n";
2592     }
2593     logmsg sprintf("*   HTTP-PIPE/%d \n", $HTTPPIPEPORT);
2594
2595     $has_textaware = ($^O eq 'MSWin32') || ($^O eq 'msys');
2596
2597     logmsg "***************************************** \n";
2598 }
2599
2600 #######################################################################
2601 # substitute the variable stuff into either a joined up file or
2602 # a command, in either case passed by reference
2603 #
2604 sub subVariables {
2605   my ($thing) = @_;
2606
2607   # ports
2608
2609   $$thing =~ s/%FTP6PORT/$FTP6PORT/g;
2610   $$thing =~ s/%FTP2PORT/$FTP2PORT/g;
2611   $$thing =~ s/%FTPSPORT/$FTPSPORT/g;
2612   $$thing =~ s/%FTPPORT/$FTPPORT/g;
2613
2614   $$thing =~ s/%GOPHER6PORT/$GOPHER6PORT/g;
2615   $$thing =~ s/%GOPHERPORT/$GOPHERPORT/g;
2616
2617   $$thing =~ s/%HTTPTLS6PORT/$HTTPTLS6PORT/g;
2618   $$thing =~ s/%HTTPTLSPORT/$HTTPTLSPORT/g;
2619   $$thing =~ s/%HTTP6PORT/$HTTP6PORT/g;
2620   $$thing =~ s/%HTTPSPORT/$HTTPSPORT/g;
2621   $$thing =~ s/%HTTPPORT/$HTTPPORT/g;
2622   $$thing =~ s/%HTTPPIPEPORT/$HTTPPIPEPORT/g;
2623   $$thing =~ s/%PROXYPORT/$HTTPPROXYPORT/g;
2624
2625   $$thing =~ s/%IMAP6PORT/$IMAP6PORT/g;
2626   $$thing =~ s/%IMAPPORT/$IMAPPORT/g;
2627
2628   $$thing =~ s/%POP36PORT/$POP36PORT/g;
2629   $$thing =~ s/%POP3PORT/$POP3PORT/g;
2630
2631   $$thing =~ s/%RTSP6PORT/$RTSP6PORT/g;
2632   $$thing =~ s/%RTSPPORT/$RTSPPORT/g;
2633
2634   $$thing =~ s/%SMTP6PORT/$SMTP6PORT/g;
2635   $$thing =~ s/%SMTPPORT/$SMTPPORT/g;
2636
2637   $$thing =~ s/%SOCKSPORT/$SOCKSPORT/g;
2638   $$thing =~ s/%SSHPORT/$SSHPORT/g;
2639
2640   $$thing =~ s/%TFTP6PORT/$TFTP6PORT/g;
2641   $$thing =~ s/%TFTPPORT/$TFTPPORT/g;
2642
2643   # client IP addresses
2644
2645   $$thing =~ s/%CLIENT6IP/$CLIENT6IP/g;
2646   $$thing =~ s/%CLIENTIP/$CLIENTIP/g;
2647
2648   # server IP addresses
2649
2650   $$thing =~ s/%HOST6IP/$HOST6IP/g;
2651   $$thing =~ s/%HOSTIP/$HOSTIP/g;
2652
2653   # misc
2654
2655   $$thing =~ s/%CURL/$CURL/g;
2656   $$thing =~ s/%PWD/$pwd/g;
2657   $$thing =~ s/%SRCDIR/$srcdir/g;
2658   $$thing =~ s/%USER/$USER/g;
2659
2660   # The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be
2661   # used for time-out tests and that whould work on most hosts as these
2662   # adjust for the startup/check time for this particular host. We needed
2663   # to do this to make the test suite run better on very slow hosts.
2664
2665   my $ftp2 = $ftpchecktime * 2;
2666   my $ftp3 = $ftpchecktime * 3;
2667
2668   $$thing =~ s/%FTPTIME2/$ftp2/g;
2669   $$thing =~ s/%FTPTIME3/$ftp3/g;
2670 }
2671
2672 sub fixarray {
2673     my @in = @_;
2674
2675     for(@in) {
2676         subVariables \$_;
2677     }
2678     return @in;
2679 }
2680
2681 #######################################################################
2682 # Provide time stamps for single test skipped events
2683 #
2684 sub timestampskippedevents {
2685     my $testnum = $_[0];
2686
2687     return if((not defined($testnum)) || ($testnum < 1));
2688
2689     if($timestats) {
2690
2691         if($timevrfyend{$testnum}) {
2692             return;
2693         }
2694         elsif($timesrvrlog{$testnum}) {
2695             $timevrfyend{$testnum} = $timesrvrlog{$testnum};
2696             return;
2697         }
2698         elsif($timetoolend{$testnum}) {
2699             $timevrfyend{$testnum} = $timetoolend{$testnum};
2700             $timesrvrlog{$testnum} = $timetoolend{$testnum};
2701         }
2702         elsif($timetoolini{$testnum}) {
2703             $timevrfyend{$testnum} = $timetoolini{$testnum};
2704             $timesrvrlog{$testnum} = $timetoolini{$testnum};
2705             $timetoolend{$testnum} = $timetoolini{$testnum};
2706         }
2707         elsif($timesrvrend{$testnum}) {
2708             $timevrfyend{$testnum} = $timesrvrend{$testnum};
2709             $timesrvrlog{$testnum} = $timesrvrend{$testnum};
2710             $timetoolend{$testnum} = $timesrvrend{$testnum};
2711             $timetoolini{$testnum} = $timesrvrend{$testnum};
2712         }
2713         elsif($timesrvrini{$testnum}) {
2714             $timevrfyend{$testnum} = $timesrvrini{$testnum};
2715             $timesrvrlog{$testnum} = $timesrvrini{$testnum};
2716             $timetoolend{$testnum} = $timesrvrini{$testnum};
2717             $timetoolini{$testnum} = $timesrvrini{$testnum};
2718             $timesrvrend{$testnum} = $timesrvrini{$testnum};
2719         }
2720         elsif($timeprepini{$testnum}) {
2721             $timevrfyend{$testnum} = $timeprepini{$testnum};
2722             $timesrvrlog{$testnum} = $timeprepini{$testnum};
2723             $timetoolend{$testnum} = $timeprepini{$testnum};
2724             $timetoolini{$testnum} = $timeprepini{$testnum};
2725             $timesrvrend{$testnum} = $timeprepini{$testnum};
2726             $timesrvrini{$testnum} = $timeprepini{$testnum};
2727         }
2728     }
2729 }
2730
2731 #######################################################################
2732 # Run a single specified test case
2733 #
2734 sub singletest {
2735     my ($evbased, # 1 means switch on if possible (and "curl" is tested)
2736                   # returns "not a test" if it can't be used for this test
2737         $testnum,
2738         $count,
2739         $total)=@_;
2740
2741     my @what;
2742     my $why;
2743     my %feature;
2744     my $cmd;
2745     my $disablevalgrind;
2746
2747     # copy test number to a global scope var, this allows
2748     # testnum checking when starting test harness servers.
2749     $testnumcheck = $testnum;
2750
2751     # timestamp test preparation start
2752     $timeprepini{$testnum} = Time::HiRes::time() if($timestats);
2753
2754     if($disttests !~ /test$testnum\W/ ) {
2755         logmsg "Warning: test$testnum not present in tests/data/Makefile.am\n";
2756     }
2757     if($disabled{$testnum}) {
2758         logmsg "Warning: test$testnum is explicitly disabled\n";
2759     }
2760
2761     # load the test case file definition
2762     if(loadtest("${TESTDIR}/test${testnum}")) {
2763         if($verbose) {
2764             # this is not a test
2765             logmsg "RUN: $testnum doesn't look like a test case\n";
2766         }
2767         $why = "no test";
2768     }
2769     else {
2770         @what = getpart("client", "features");
2771     }
2772
2773     # We require a feature to be present
2774     for(@what) {
2775         my $f = $_;
2776         $f =~ s/\s//g;
2777
2778         if($f =~ /^([^!].*)$/) {
2779             # Store the feature for later
2780             $feature{$1} = $1;
2781
2782             if($1 eq "SSL") {
2783                 if($ssl_version) {
2784                     next;
2785                 }
2786             }
2787             elsif($1 eq "OpenSSL") {
2788                 if($has_openssl) {
2789                     next;
2790                 }
2791             }
2792             elsif($1 eq "GnuTLS") {
2793                 if($has_gnutls) {
2794                     next;
2795                 }
2796             }
2797             elsif($1 eq "NSS") {
2798                 if($has_nss) {
2799                     next;
2800                 }
2801             }
2802             elsif($1 eq "axTLS") {
2803                 if($has_axtls) {
2804                     next;
2805                 }
2806             }
2807             elsif($1 eq "WinSSL") {
2808                 if($has_winssl) {
2809                     next;
2810                 }
2811             }
2812             elsif($1 eq "DarwinSSL") {
2813                 if($has_darwinssl) {
2814                     next;
2815                 }
2816             }
2817             elsif($1 eq "unittest") {
2818                 if($debug_build) {
2819                     next;
2820                 }
2821             }
2822             elsif($1 eq "debug") {
2823                 if($debug_build) {
2824                     next;
2825                 }
2826             }
2827             elsif($1 eq "TrackMemory") {
2828                 if($has_memory_tracking) {
2829                     next;
2830                 }
2831             }
2832             elsif($1 eq "large_file") {
2833                 if($large_file) {
2834                     next;
2835                 }
2836             }
2837             elsif($1 eq "idn") {
2838                 if($has_idn) {
2839                     next;
2840                 }
2841             }
2842             elsif($1 eq "ipv6") {
2843                 if($has_ipv6) {
2844                     next;
2845                 }
2846             }
2847             elsif($1 eq "libz") {
2848                 if($has_libz) {
2849                     next;
2850                 }
2851             }
2852             elsif($1 eq "NTLM") {
2853                 if($has_ntlm) {
2854                     next;
2855                 }
2856             }
2857             elsif($1 eq "NTLM_WB") {
2858                 if($has_ntlm_wb) {
2859                     next;
2860                 }
2861             }
2862             elsif($1 eq "SSPI") {
2863                 if($has_sspi) {
2864                     next;
2865                 }
2866             }
2867             elsif($1 eq "getrlimit") {
2868                 if($has_getrlimit) {
2869                     next;
2870                 }
2871             }
2872             elsif($1 eq "crypto") {
2873                 if($has_crypto) {
2874                     next;
2875                 }
2876             }
2877             elsif($1 eq "TLS-SRP") {
2878                 if($has_tls_srp) {
2879                     next;
2880                 }
2881             }
2882             elsif($1 eq "Metalink") {
2883                 if($has_metalink) {
2884                     next;
2885                 }
2886             }
2887             elsif($1 eq "socks") {
2888                 next;
2889             }
2890             # See if this "feature" is in the list of supported protocols
2891             elsif (grep /^\Q$1\E$/i, @protocols) {
2892                 next;
2893             }
2894
2895             $why = "curl lacks $1 support";
2896             last;
2897         }
2898     }
2899
2900     # We require a feature to not be present
2901     if(!$why) {
2902         for(@what) {
2903             my $f = $_;
2904             $f =~ s/\s//g;
2905
2906             if($f =~ /^!(.*)$/) {
2907                 if($1 eq "SSL") {
2908                     if(!$ssl_version) {
2909                         next;
2910                     }
2911                 }
2912                 elsif($1 eq "OpenSSL") {
2913                     if(!$has_openssl) {
2914                         next;
2915                     }
2916                 }
2917                 elsif($1 eq "GnuTLS") {
2918                     if(!$has_gnutls) {
2919                         next;
2920                     }
2921                 }
2922                 elsif($1 eq "NSS") {
2923                     if(!$has_nss) {
2924                         next;
2925                     }
2926                 }
2927                 elsif($1 eq "axTLS") {
2928                     if(!$has_axtls) {
2929                         next;
2930                     }
2931                 }
2932                 elsif($1 eq "WinSSL") {
2933                     if(!$has_winssl) {
2934                         next;
2935                     }
2936                 }
2937                 elsif($1 eq "DarwinSSL") {
2938                     if(!$has_darwinssl) {
2939                         next;
2940                     }
2941                 }
2942                 elsif($1 eq "TrackMemory") {
2943                     if(!$has_memory_tracking) {
2944                         next;
2945                     }
2946                 }
2947                 elsif($1 eq "large_file") {
2948                     if(!$large_file) {
2949                         next;
2950                     }
2951                 }
2952                 elsif($1 eq "idn") {
2953                     if(!$has_idn) {
2954                         next;
2955                     }
2956                 }
2957                 elsif($1 eq "ipv6") {
2958                     if(!$has_ipv6) {
2959                         next;
2960                     }
2961                 }
2962                 elsif($1 eq "libz") {
2963                     if(!$has_libz) {
2964                         next;
2965                     }
2966                 }
2967                 elsif($1 eq "NTLM") {
2968                     if(!$has_ntlm) {
2969                         next;
2970                     }
2971                 }
2972                 elsif($1 eq "NTLM_WB") {
2973                     if(!$has_ntlm_wb) {
2974                         next;
2975                     }
2976                 }
2977                 elsif($1 eq "SSPI") {
2978                     if(!$has_sspi) {
2979                         next;
2980                     }
2981                 }
2982                 elsif($1 eq "getrlimit") {
2983                     if(!$has_getrlimit) {
2984                         next;
2985                     }
2986                 }
2987                 elsif($1 eq "crypto") {
2988                     if(!$has_crypto) {
2989                         next;
2990                     }
2991                 }
2992                 elsif($1 eq "TLS-SRP") {
2993                     if(!$has_tls_srp) {
2994                         next;
2995                     }
2996                 }
2997                 elsif($1 eq "Metalink") {
2998                     if(!$has_metalink) {
2999                         next;
3000                     }
3001                 }
3002                 else {
3003                     next;
3004                 }
3005             }
3006             else {
3007                 next;
3008             }
3009
3010             $why = "curl has $1 support";
3011             last;
3012         }
3013     }
3014
3015     if(!$why) {
3016         my @keywords = getpart("info", "keywords");
3017         my $match;
3018         my $k;
3019
3020         if(!$keywords[0]) {
3021             $why = "missing the <keywords> section!";
3022         }
3023
3024         for $k (@keywords) {
3025             chomp $k;
3026             if ($disabled_keywords{$k}) {
3027                 $why = "disabled by keyword";
3028             } elsif ($enabled_keywords{$k}) {
3029                 $match = 1;
3030             }
3031         }
3032
3033         if(!$why && !$match && %enabled_keywords) {
3034             $why = "disabled by missing keyword";
3035         }
3036     }
3037
3038     # test definition may instruct to (un)set environment vars
3039     # this is done this early, so that the precheck can use environment
3040     # variables and still bail out fine on errors
3041
3042     # restore environment variables that were modified in a previous run
3043     foreach my $var (keys %oldenv) {
3044         if($oldenv{$var} eq 'notset') {
3045             delete $ENV{$var} if($ENV{$var});
3046         }
3047         else {
3048             $ENV{$var} = $oldenv{$var};
3049         }
3050         delete $oldenv{$var};
3051     }
3052
3053     # remove test server commands file before servers are started/verified
3054     unlink($FTPDCMD) if(-f $FTPDCMD);
3055
3056     # timestamp required servers verification start
3057     $timesrvrini{$testnum} = Time::HiRes::time() if($timestats);
3058
3059     if(!$why) {
3060         $why = serverfortest($testnum);
3061     }
3062
3063     # timestamp required servers verification end
3064     $timesrvrend{$testnum} = Time::HiRes::time() if($timestats);
3065
3066     my @setenv = getpart("client", "setenv");
3067     if(@setenv) {
3068         foreach my $s (@setenv) {
3069             chomp $s;
3070             subVariables \$s;
3071             if($s =~ /([^=]*)=(.*)/) {
3072                 my ($var, $content) = ($1, $2);
3073                 # remember current setting, to restore it once test runs
3074                 $oldenv{$var} = ($ENV{$var})?"$ENV{$var}":'notset';
3075                 # set new value
3076                 if(!$content) {
3077                     delete $ENV{$var} if($ENV{$var});
3078                 }
3079                 else {
3080                     if($var =~ /^LD_PRELOAD/) {
3081                         if(exe_ext() && (exe_ext() eq '.exe')) {
3082                             # print "Skipping LD_PRELOAD due to lack of OS support\n";
3083                             next;
3084                         }
3085                         if($debug_build || ($has_shared ne "yes")) {
3086                             # print "Skipping LD_PRELOAD due to no release shared build\n";
3087                             next;
3088                         }
3089                     }
3090                     $ENV{$var} = "$content";
3091                 }
3092             }
3093         }
3094     }
3095
3096     if(!$why) {
3097         # TODO:
3098         # Add a precheck cache. If a precheck command was already invoked
3099         # exactly like this, then use the previous result to speed up
3100         # successive test invokes!
3101
3102         my @precheck = getpart("client", "precheck");
3103         if(@precheck) {
3104             $cmd = $precheck[0];
3105             chomp $cmd;
3106             subVariables \$cmd;
3107             if($cmd) {
3108                 my @p = split(/ /, $cmd);
3109                 if($p[0] !~ /\//) {
3110                     # the first word, the command, does not contain a slash so
3111                     # we will scan the "improved" PATH to find the command to
3112                     # be able to run it
3113                     my $fullp = checktestcmd($p[0]);
3114
3115                     if($fullp) {
3116                         $p[0] = $fullp;
3117                     }
3118                     $cmd = join(" ", @p);
3119                 }
3120
3121                 my @o = `$cmd 2>/dev/null`;
3122                 if($o[0]) {
3123                     $why = $o[0];
3124                     chomp $why;
3125                 } elsif($?) {
3126                     $why = "precheck command error";
3127                 }
3128                 logmsg "prechecked $cmd\n" if($verbose);
3129             }
3130         }
3131     }
3132
3133     if($why && !$listonly) {
3134         # there's a problem, count it as "skipped"
3135         $skipped++;
3136         $skipped{$why}++;
3137         $teststat[$testnum]=$why; # store reason for this test case
3138
3139         if(!$short) {
3140             if($skipped{$why} <= 3) {
3141                 # show only the first three skips for each reason
3142                 logmsg sprintf("test %03d SKIPPED: $why\n", $testnum);
3143             }
3144         }
3145
3146         timestampskippedevents($testnum);
3147         return -1;
3148     }
3149     logmsg sprintf("test %03d...", $testnum) if(!$automakestyle);
3150
3151     # extract the reply data
3152     my @reply = getpart("reply", "data");
3153     my @replycheck = getpart("reply", "datacheck");
3154
3155     my %replyattr = getpartattr("reply", "data");
3156     my %replycheckattr = getpartattr("reply", "datacheck");
3157
3158     if (@replycheck) {
3159         # we use this file instead to check the final output against
3160
3161         if($replycheckattr{'nonewline'}) {
3162             # Yes, we must cut off the final newline from the final line
3163             # of the datacheck
3164             chomp($replycheck[$#replycheck]);
3165         }
3166         if($replycheckattr{'mode'}) {
3167             $replyattr{'mode'} = $replycheckattr{'mode'};
3168         }
3169
3170         @reply=@replycheck;
3171     }
3172
3173     # this is the valid protocol blurb curl should generate
3174     my @protocol= fixarray ( getpart("verify", "protocol") );
3175
3176     # this is the valid protocol blurb curl should generate to a proxy
3177     my @proxyprot = fixarray ( getpart("verify", "proxy") );
3178
3179     # redirected stdout/stderr to these files
3180     $STDOUT="$LOGDIR/stdout$testnum";
3181     $STDERR="$LOGDIR/stderr$testnum";
3182
3183     # if this section exists, we verify that the stdout contained this:
3184     my @validstdout = fixarray ( getpart("verify", "stdout") );
3185
3186     # if this section exists, we verify upload
3187     my @upload = getpart("verify", "upload");
3188
3189     # if this section exists, it might be FTP server instructions:
3190     my @ftpservercmd = getpart("reply", "servercmd");
3191
3192     my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout
3193
3194     # name of the test
3195     my @testname= getpart("client", "name");
3196     my $testname = $testname[0];
3197     $testname =~ s/\n//g;
3198     logmsg "[$testname]\n" if(!$short);
3199
3200     if($listonly) {
3201         timestampskippedevents($testnum);
3202         return 0; # look successful
3203     }
3204
3205     my @codepieces = getpart("client", "tool");
3206
3207     my $tool="";
3208     if(@codepieces) {
3209         $tool = $codepieces[0];
3210         chomp $tool;
3211     }
3212
3213     # remove server output logfile
3214     unlink($SERVERIN);
3215     unlink($SERVER2IN);
3216     unlink($PROXYIN);
3217
3218     if(@ftpservercmd) {
3219         # write the instructions to file
3220         writearray($FTPDCMD, \@ftpservercmd);
3221     }
3222
3223     # get the command line options to use
3224     my @blaha;
3225     ($cmd, @blaha)= getpart("client", "command");
3226
3227     if($cmd) {
3228         # make some nice replace operations
3229         $cmd =~ s/\n//g; # no newlines please
3230         # substitute variables in the command line
3231         subVariables \$cmd;
3232     }
3233     else {
3234         # there was no command given, use something silly
3235         $cmd="-";
3236     }
3237     if($has_memory_tracking) {
3238         unlink($memdump);
3239     }
3240
3241     # create a (possibly-empty) file before starting the test
3242     my @inputfile=getpart("client", "file");
3243     my %fileattr = getpartattr("client", "file");
3244     my $filename=$fileattr{'name'};
3245     if(@inputfile || $filename) {
3246         if(!$filename) {
3247             logmsg "ERROR: section client=>file has no name attribute\n";
3248             timestampskippedevents($testnum);
3249             return -1;
3250         }
3251         my $fileContent = join('', @inputfile);
3252         subVariables \$fileContent;
3253 #        logmsg "DEBUG: writing file " . $filename . "\n";
3254         open(OUTFILE, ">$filename");
3255         binmode OUTFILE; # for crapage systems, use binary
3256         print OUTFILE $fileContent;
3257         close(OUTFILE);
3258     }
3259
3260     my %cmdhash = getpartattr("client", "command");
3261
3262     my $out="";
3263
3264     if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-output/)) {
3265         #We may slap on --output!
3266         if (!@validstdout) {
3267             $out=" --output $CURLOUT ";
3268         }
3269     }
3270
3271     my $serverlogslocktimeout = $defserverlogslocktimeout;
3272     if($cmdhash{'timeout'}) {
3273         # test is allowed to override default server logs lock timeout
3274         if($cmdhash{'timeout'} =~ /(\d+)/) {
3275             $serverlogslocktimeout = $1 if($1 >= 0);
3276         }
3277     }
3278
3279     my $postcommanddelay = $defpostcommanddelay;
3280     if($cmdhash{'delay'}) {
3281         # test is allowed to specify a delay after command is executed
3282         if($cmdhash{'delay'} =~ /(\d+)/) {
3283             $postcommanddelay = $1 if($1 > 0);
3284         }
3285     }
3286
3287     my $CMDLINE;
3288     my $cmdargs;
3289     my $cmdtype = $cmdhash{'type'} || "default";
3290     my $fail_due_event_based = $evbased;
3291     if($cmdtype eq "perl") {
3292         # run the command line prepended with "perl"
3293         $cmdargs ="$cmd";
3294         $CMDLINE = "perl ";
3295         $tool=$CMDLINE;
3296         $disablevalgrind=1;
3297     }
3298     elsif($cmdtype eq "shell") {
3299         # run the command line prepended with "/bin/sh"
3300         $cmdargs ="$cmd";
3301         $CMDLINE = "/bin/sh ";
3302         $tool=$CMDLINE;
3303         $disablevalgrind=1;
3304     }
3305     elsif(!$tool) {
3306         # run curl, add suitable command line options
3307         $cmd = "-1 ".$cmd if(exists $feature{"SSL"} && ($has_axtls));
3308
3309         my $inc="";
3310         if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-include/)) {
3311             $inc = " --include";
3312         }
3313
3314         $cmdargs = "$out$inc ";
3315         $cmdargs .= "--trace-ascii log/trace$testnum ";
3316         $cmdargs .= "--trace-time ";
3317         if($evbased) {
3318             $cmdargs .= "--test-event ";
3319             $fail_due_event_based--;
3320         }
3321         $cmdargs .= $cmd;
3322     }
3323     else {
3324         $cmdargs = " $cmd"; # $cmd is the command line for the test file
3325         $CURLOUT = $STDOUT; # sends received data to stdout
3326
3327         if($tool =~ /^lib/) {
3328             $CMDLINE="$LIBDIR/$tool";
3329         }
3330         elsif($tool =~ /^unit/) {
3331             $CMDLINE="$UNITDIR/$tool";
3332         }
3333
3334         if(! -f $CMDLINE) {
3335             logmsg "The tool set in the test case for this: '$tool' does not exist\n";
3336             timestampskippedevents($testnum);
3337             return -1;
3338         }
3339         $DBGCURL=$CMDLINE;
3340     }
3341
3342     if($gdbthis) {
3343         # gdb is incompatible with valgrind, so disable it when debugging
3344         # Perhaps a better approach would be to run it under valgrind anyway
3345         # with --db-attach=yes or --vgdb=yes.
3346         $disablevalgrind=1;
3347     }
3348
3349     if($fail_due_event_based) {
3350         logmsg "This test cannot run event based\n";
3351         return -1;
3352     }
3353
3354     my @stdintest = getpart("client", "stdin");
3355
3356     if(@stdintest) {
3357         my $stdinfile="$LOGDIR/stdin-for-$testnum";
3358
3359         my %hash = getpartattr("client", "stdin");
3360         if($hash{'nonewline'}) {
3361             # cut off the final newline from the final line of the stdin data
3362             chomp($stdintest[$#stdintest]);
3363         }
3364
3365         writearray($stdinfile, \@stdintest);
3366
3367         $cmdargs .= " <$stdinfile";
3368     }
3369
3370     if(!$tool) {
3371         $CMDLINE="$CURL";
3372     }
3373
3374     my $usevalgrind;
3375     if($valgrind && !$disablevalgrind) {
3376         my @valgrindoption = getpart("verify", "valgrind");
3377         if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) {
3378             $usevalgrind = 1;
3379             my $valgrindcmd = "$valgrind ";
3380             $valgrindcmd .= "$valgrind_tool " if($valgrind_tool);
3381             $valgrindcmd .= "--leak-check=yes ";
3382             $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp ";
3383            # $valgrindcmd .= "--gen-suppressions=all ";
3384             $valgrindcmd .= "--num-callers=16 ";
3385             $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum";
3386             $CMDLINE = "$valgrindcmd $CMDLINE";
3387         }
3388     }
3389
3390     $CMDLINE .= "$cmdargs >$STDOUT 2>$STDERR";
3391
3392     if($verbose) {
3393         logmsg "$CMDLINE\n";
3394     }
3395
3396     print CMDLOG "$CMDLINE\n";
3397
3398     unlink("core");
3399
3400     my $dumped_core;
3401     my $cmdres;
3402
3403     # Apr 2007: precommand isn't being used and could be removed
3404     my @precommand= getpart("client", "precommand");
3405     if($precommand[0]) {
3406         # this is pure perl to eval!
3407         my $code = join("", @precommand);
3408         eval $code;
3409         if($@) {
3410             logmsg "perl: $code\n";
3411             logmsg "precommand: $@";
3412             stopservers($verbose);
3413             timestampskippedevents($testnum);
3414             return -1;
3415         }
3416     }
3417
3418     if($gdbthis) {
3419         my $gdbinit = "$TESTDIR/gdbinit$testnum";
3420         open(GDBCMD, ">$LOGDIR/gdbcmd");
3421         print GDBCMD "set args $cmdargs\n";
3422         print GDBCMD "show args\n";
3423         print GDBCMD "source $gdbinit\n" if -e $gdbinit;
3424         close(GDBCMD);
3425     }
3426
3427     # timestamp starting of test command
3428     $timetoolini{$testnum} = Time::HiRes::time() if($timestats);
3429
3430     # run the command line we built
3431     if ($torture) {
3432         $cmdres = torture($CMDLINE,
3433                        "$gdb --directory libtest $DBGCURL -x $LOGDIR/gdbcmd");
3434     }
3435     elsif($gdbthis) {
3436         my $GDBW = ($gdbxwin) ? "-w" : "";
3437         runclient("$gdb --directory libtest $DBGCURL $GDBW -x $LOGDIR/gdbcmd");
3438         $cmdres=0; # makes it always continue after a debugged run
3439     }
3440     else {
3441         $cmdres = runclient("$CMDLINE");
3442         my $signal_num  = $cmdres & 127;
3443         $dumped_core = $cmdres & 128;
3444
3445         if(!$anyway && ($signal_num || $dumped_core)) {
3446             $cmdres = 1000;
3447         }
3448         else {
3449             $cmdres >>= 8;
3450             $cmdres = (2000 + $signal_num) if($signal_num && !$cmdres);
3451         }
3452     }
3453
3454     # timestamp finishing of test command
3455     $timetoolend{$testnum} = Time::HiRes::time() if($timestats);
3456
3457     if(!$dumped_core) {
3458         if(-r "core") {
3459             # there's core file present now!
3460             $dumped_core = 1;
3461         }
3462     }
3463
3464     if($dumped_core) {
3465         logmsg "core dumped\n";
3466         if(0 && $gdb) {
3467             logmsg "running gdb for post-mortem analysis:\n";
3468             open(GDBCMD, ">$LOGDIR/gdbcmd2");
3469             print GDBCMD "bt\n";
3470             close(GDBCMD);
3471             runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch $DBGCURL core ");
3472      #       unlink("$LOGDIR/gdbcmd2");
3473         }
3474     }
3475
3476     # If a server logs advisor read lock file exists, it is an indication
3477     # that the server has not yet finished writing out all its log files,
3478     # including server request log files used for protocol verification.
3479     # So, if the lock file exists the script waits here a certain amount
3480     # of time until the server removes it, or the given time expires.
3481
3482     if($serverlogslocktimeout) {
3483         my $lockretry = $serverlogslocktimeout * 20;
3484         while((-f $SERVERLOGS_LOCK) && $lockretry--) {
3485             select(undef, undef, undef, 0.05);
3486         }
3487         if(($lockretry < 0) &&
3488            ($serverlogslocktimeout >= $defserverlogslocktimeout)) {
3489             logmsg "Warning: server logs lock timeout ",
3490                    "($serverlogslocktimeout seconds) expired\n";
3491         }
3492     }
3493
3494     # Test harness ssh server does not have this synchronization mechanism,
3495     # this implies that some ssh server based tests might need a small delay
3496     # once that the client command has run to avoid false test failures.
3497     #
3498     # gnutls-serv also lacks this synchronization mechanism, so gnutls-serv
3499     # based tests might need a small delay once that the client command has
3500     # run to avoid false test failures.
3501
3502     sleep($postcommanddelay) if($postcommanddelay);
3503
3504     # timestamp removal of server logs advisor read lock
3505     $timesrvrlog{$testnum} = Time::HiRes::time() if($timestats);
3506
3507     # test definition might instruct to stop some servers
3508     # stop also all servers relative to the given one
3509
3510     my @killtestservers = getpart("client", "killserver");
3511     if(@killtestservers) {
3512         #
3513         # All servers relative to the given one must be stopped also
3514         #
3515         my @killservers;
3516         foreach my $server (@killtestservers) {
3517             chomp $server;
3518             if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|))$/) {
3519                 # given a stunnel ssl server, also kill non-ssl underlying one
3520                 push @killservers, "${1}${2}";
3521             }
3522             elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|))$/) {
3523                 # given a non-ssl server, also kill stunnel piggybacking one
3524                 push @killservers, "${1}s${2}";
3525             }
3526             elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
3527                 # given a socks server, also kill ssh underlying one
3528                 push @killservers, "ssh${2}";
3529             }
3530             elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
3531                 # given a ssh server, also kill socks piggybacking one
3532                 push @killservers, "socks${2}";
3533             }
3534             push @killservers, $server;
3535         }
3536         #
3537         # kill sockfilter processes for pingpong relative servers
3538         #
3539         foreach my $server (@killservers) {
3540             if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
3541                 my $proto  = $1;
3542                 my $idnum  = ($2 && ($2 > 1)) ? $2 : 1;
3543                 my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
3544                 killsockfilters($proto, $ipvnum, $idnum, $verbose);
3545             }
3546         }
3547         #
3548         # kill server relative pids clearing them in %run hash
3549         #
3550         my $pidlist;
3551         foreach my $server (@killservers) {
3552             if($run{$server}) {
3553                 $pidlist .= "$run{$server} ";
3554                 $run{$server} = 0;
3555             }
3556             $runcert{$server} = 0 if($runcert{$server});
3557         }
3558         killpid($verbose, $pidlist);
3559         #
3560         # cleanup server pid files
3561         #
3562         foreach my $server (@killservers) {
3563             my $pidfile = $serverpidfile{$server};
3564             my $pid = processexists($pidfile);
3565             if($pid > 0) {
3566                 logmsg "Warning: $server server unexpectedly alive\n";
3567                 killpid($verbose, $pid);
3568             }
3569             unlink($pidfile) if(-f $pidfile);
3570         }
3571     }
3572
3573     # remove the test server commands file after each test
3574     unlink($FTPDCMD) if(-f $FTPDCMD);
3575
3576     # run the postcheck command
3577     my @postcheck= getpart("client", "postcheck");
3578     if(@postcheck) {
3579         $cmd = $postcheck[0];
3580         chomp $cmd;
3581         subVariables \$cmd;
3582         if($cmd) {
3583             logmsg "postcheck $cmd\n" if($verbose);
3584             my $rc = runclient("$cmd");
3585             # Must run the postcheck command in torture mode in order
3586             # to clean up, but the result can't be relied upon.
3587             if($rc != 0 && !$torture) {
3588                 logmsg " postcheck FAILED\n";
3589                 # timestamp test result verification end
3590                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3591                 return 1;
3592             }
3593         }
3594     }
3595
3596     # restore environment variables that were modified
3597     if(%oldenv) {
3598         foreach my $var (keys %oldenv) {
3599             if($oldenv{$var} eq 'notset') {
3600                 delete $ENV{$var} if($ENV{$var});
3601             }
3602             else {
3603                 $ENV{$var} = "$oldenv{$var}";
3604             }
3605         }
3606     }
3607
3608     # Skip all the verification on torture tests
3609     if ($torture) {
3610         if(!$cmdres && !$keepoutfiles) {
3611             cleardir($LOGDIR);
3612         }
3613         # timestamp test result verification end
3614         $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3615         return $cmdres;
3616     }
3617
3618     my @err = getpart("verify", "errorcode");
3619     my $errorcode = $err[0] || "0";
3620     my $ok="";
3621     my $res;
3622     chomp $errorcode;
3623     if (@validstdout) {
3624         # verify redirected stdout
3625         my @actual = loadarray($STDOUT);
3626
3627         # variable-replace in the stdout we have from the test case file
3628         @validstdout = fixarray(@validstdout);
3629
3630         # get all attributes
3631         my %hash = getpartattr("verify", "stdout");
3632
3633         # get the mode attribute
3634         my $filemode=$hash{'mode'};
3635         if($filemode && ($filemode eq "text") && $has_textaware) {
3636             # text mode when running on windows: fix line endings
3637             map s/\r\n/\n/g, @validstdout;
3638             map s/\n/\r\n/g, @validstdout;
3639         }
3640
3641         if($hash{'nonewline'}) {
3642             # Yes, we must cut off the final newline from the final line
3643             # of the protocol data
3644             chomp($validstdout[$#validstdout]);
3645         }
3646
3647         $res = compare($testnum, $testname, "stdout", \@actual, \@validstdout);
3648         if($res) {
3649             return 1;
3650         }
3651         $ok .= "s";
3652     }
3653     else {
3654         $ok .= "-"; # stdout not checked
3655     }
3656
3657     if(@protocol) {
3658         # Verify the sent request
3659         my @out = loadarray($SERVERIN);
3660
3661         # what to cut off from the live protocol sent by curl
3662         my @strip = getpart("verify", "strip");
3663
3664         my @protstrip=@protocol;
3665
3666         # check if there's any attributes on the verify/protocol section
3667         my %hash = getpartattr("verify", "protocol");
3668
3669         if($hash{'nonewline'}) {
3670             # Yes, we must cut off the final newline from the final line
3671             # of the protocol data
3672             chomp($protstrip[$#protstrip]);
3673         }
3674
3675         for(@strip) {
3676             # strip off all lines that match the patterns from both arrays
3677             chomp $_;
3678             @out = striparray( $_, \@out);
3679             @protstrip= striparray( $_, \@protstrip);
3680         }
3681
3682         # what parts to cut off from the protocol
3683         my @strippart = getpart("verify", "strippart");
3684         my $strip;
3685         for $strip (@strippart) {
3686             chomp $strip;
3687             for(@out) {
3688                 eval $strip;
3689             }
3690         }
3691
3692         $res = compare($testnum, $testname, "protocol", \@out, \@protstrip);
3693         if($res) {
3694             return 1;
3695         }
3696
3697         $ok .= "p";
3698
3699     }
3700     else {
3701         $ok .= "-"; # protocol not checked
3702     }
3703
3704     if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
3705         # verify the received data
3706         my @out = loadarray($CURLOUT);
3707         # get the mode attribute
3708         my $filemode=$replyattr{'mode'};
3709         if($filemode && ($filemode eq "text") && $has_textaware) {
3710             # text mode when running on windows: fix line endings
3711             map s/\r\n/\n/g, @reply;
3712             map s/\n/\r\n/g, @reply;
3713         }
3714
3715         $res = compare($testnum, $testname, "data", \@out, \@reply);
3716         if ($res) {
3717             return 1;
3718         }
3719         $ok .= "d";
3720     }
3721     else {
3722         $ok .= "-"; # data not checked
3723     }
3724
3725     if(@upload) {
3726         # verify uploaded data
3727         my @out = loadarray("$LOGDIR/upload.$testnum");
3728         $res = compare($testnum, $testname, "upload", \@out, \@upload);
3729         if ($res) {
3730             return 1;
3731         }
3732         $ok .= "u";
3733     }
3734     else {
3735         $ok .= "-"; # upload not checked
3736     }
3737
3738     if(@proxyprot) {
3739         # Verify the sent proxy request
3740         my @out = loadarray($PROXYIN);
3741
3742         # what to cut off from the live protocol sent by curl, we use the
3743         # same rules as for <protocol>
3744         my @strip = getpart("verify", "strip");
3745
3746         my @protstrip=@proxyprot;
3747
3748         # check if there's any attributes on the verify/protocol section
3749         my %hash = getpartattr("verify", "proxy");
3750
3751         if($hash{'nonewline'}) {
3752             # Yes, we must cut off the final newline from the final line
3753             # of the protocol data
3754             chomp($protstrip[$#protstrip]);
3755         }
3756
3757         for(@strip) {
3758             # strip off all lines that match the patterns from both arrays
3759             chomp $_;
3760             @out = striparray( $_, \@out);
3761             @protstrip= striparray( $_, \@protstrip);
3762         }
3763
3764         # what parts to cut off from the protocol
3765         my @strippart = getpart("verify", "strippart");
3766         my $strip;
3767         for $strip (@strippart) {
3768             chomp $strip;
3769             for(@out) {
3770                 eval $strip;
3771             }
3772         }
3773
3774         $res = compare($testnum, $testname, "proxy", \@out, \@protstrip);
3775         if($res) {
3776             return 1;
3777         }
3778
3779         $ok .= "P";
3780
3781     }
3782     else {
3783         $ok .= "-"; # protocol not checked
3784     }
3785
3786     my $outputok;
3787     for my $partsuffix (('', '1', '2', '3', '4')) {
3788         my @outfile=getpart("verify", "file".$partsuffix);
3789         if(@outfile || partexists("verify", "file".$partsuffix) ) {
3790             # we're supposed to verify a dynamically generated file!
3791             my %hash = getpartattr("verify", "file".$partsuffix);
3792
3793             my $filename=$hash{'name'};
3794             if(!$filename) {
3795                 logmsg "ERROR: section verify=>file$partsuffix ".
3796                        "has no name attribute\n";
3797                 stopservers($verbose);
3798                 # timestamp test result verification end
3799                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3800                 return -1;
3801             }
3802             my @generated=loadarray($filename);
3803
3804             # what parts to cut off from the file
3805             my @stripfile = getpart("verify", "stripfile".$partsuffix);
3806
3807             my $filemode=$hash{'mode'};
3808             if($filemode && ($filemode eq "text") && $has_textaware) {
3809                 # text mode when running on windows: fix line endings
3810                 map s/\r\n/\n/g, @outfile;
3811                 map s/\n/\r\n/g, @outfile;
3812             }
3813
3814             my $strip;
3815             for $strip (@stripfile) {
3816                 chomp $strip;
3817                 my @newgen;
3818                 for(@generated) {
3819                     eval $strip;
3820                     if($_) {
3821                         push @newgen, $_;
3822                     }
3823                 }
3824                 # this is to get rid of array entries that vanished (zero
3825                 # length) because of replacements
3826                 @generated = @newgen;
3827             }
3828
3829             @outfile = fixarray(@outfile);
3830
3831             $res = compare($testnum, $testname, "output ($filename)",
3832                            \@generated, \@outfile);
3833             if($res) {
3834                 return 1;
3835             }
3836
3837             $outputok = 1; # output checked
3838         }
3839     }
3840     $ok .= ($outputok) ? "o" : "-"; # output checked or not
3841
3842     # accept multiple comma-separated error codes
3843     my @splerr = split(/ *, */, $errorcode);
3844     my $errok;
3845     foreach my $e (@splerr) {
3846         if($e == $cmdres) {
3847             # a fine error code
3848             $errok = 1;
3849             last;
3850         }
3851     }
3852
3853     if($errok) {
3854         $ok .= "e";
3855     }
3856     else {
3857         if(!$short) {
3858             logmsg sprintf("\n%s returned $cmdres, when expecting %s\n",
3859                            (!$tool)?"curl":$tool, $errorcode);
3860         }
3861         logmsg " exit FAILED\n";
3862         # timestamp test result verification end
3863         $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3864         return 1;
3865     }
3866
3867     if($has_memory_tracking) {
3868         if(! -f $memdump) {
3869             logmsg "\n** ALERT! memory tracking with no output file?\n"
3870                 if(!$cmdtype eq "perl");
3871         }
3872         else {
3873             my @memdata=`$memanalyze $memdump`;
3874             my $leak=0;
3875             for(@memdata) {
3876                 if($_ ne "") {
3877                     # well it could be other memory problems as well, but
3878                     # we call it leak for short here
3879                     $leak=1;
3880                 }
3881             }
3882             if($leak) {
3883                 logmsg "\n** MEMORY FAILURE\n";
3884                 logmsg @memdata;
3885                 # timestamp test result verification end
3886                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3887                 return 1;
3888             }
3889             else {
3890                 $ok .= "m";
3891             }
3892         }
3893     }
3894     else {
3895         $ok .= "-"; # memory not checked
3896     }
3897
3898     if($valgrind) {
3899         if($usevalgrind) {
3900             unless(opendir(DIR, "$LOGDIR")) {
3901                 logmsg "ERROR: unable to read $LOGDIR\n";
3902                 # timestamp test result verification end
3903                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3904                 return 1;
3905             }
3906             my @files = readdir(DIR);
3907             closedir(DIR);
3908             my $vgfile;
3909             foreach my $file (@files) {
3910                 if($file =~ /^valgrind$testnum(\..*|)$/) {
3911                     $vgfile = $file;
3912                     last;
3913                 }
3914             }
3915             if(!$vgfile) {
3916                 logmsg "ERROR: valgrind log file missing for test $testnum\n";
3917                 # timestamp test result verification end
3918                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3919                 return 1;
3920             }
3921             my @e = valgrindparse($srcdir, $feature{'SSL'}, "$LOGDIR/$vgfile");
3922             if(@e && $e[0]) {
3923                 if($automakestyle) {
3924                     logmsg "FAIL: $testnum - $testname - valgrind\n";
3925                 }
3926                 else {
3927                     logmsg " valgrind ERROR ";
3928                     logmsg @e;
3929                 }
3930                 # timestamp test result verification end
3931                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3932                 return 1;
3933             }
3934             $ok .= "v";
3935         }
3936         else {
3937             if(!$short && !$disablevalgrind) {
3938                 logmsg " valgrind SKIPPED\n";
3939             }
3940             $ok .= "-"; # skipped
3941         }
3942     }
3943     else {
3944         $ok .= "-"; # valgrind not checked
3945     }
3946     # add 'E' for event-based
3947     $ok .= $evbased ? "E" : "-";
3948
3949     logmsg "$ok " if(!$short);
3950
3951     my $sofar= time()-$start;
3952     my $esttotal = $sofar/$count * $total;
3953     my $estleft = $esttotal - $sofar;
3954     my $left=sprintf("remaining: %02d:%02d",
3955                      $estleft/60,
3956                      $estleft%60);
3957
3958     if(!$automakestyle) {
3959         logmsg sprintf("OK (%-3d out of %-3d, %s)\n", $count, $total, $left);
3960     }
3961     else {
3962         logmsg "PASS: $testnum - $testname\n";
3963     }
3964
3965     # the test succeeded, remove all log files
3966     if(!$keepoutfiles) {
3967         cleardir($LOGDIR);
3968     }
3969
3970     # timestamp test result verification end
3971     $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3972
3973     return 0;
3974 }
3975
3976 #######################################################################
3977 # Stop all running test servers
3978 #
3979 sub stopservers {
3980     my $verbose = $_[0];
3981     #
3982     # kill sockfilter processes for all pingpong servers
3983     #
3984     killallsockfilters($verbose);
3985     #
3986     # kill all server pids from %run hash clearing them
3987     #
3988     my $pidlist;
3989     foreach my $server (keys %run) {
3990         if($run{$server}) {
3991             if($verbose) {
3992                 my $prev = 0;
3993                 my $pids = $run{$server};
3994                 foreach my $pid (split(' ', $pids)) {
3995                     if($pid != $prev) {
3996                         logmsg sprintf("* kill pid for %s => %d\n",
3997                             $server, $pid);
3998                         $prev = $pid;
3999                     }
4000                 }
4001             }
4002             $pidlist .= "$run{$server} ";
4003             $run{$server} = 0;
4004         }
4005         $runcert{$server} = 0 if($runcert{$server});
4006     }
4007     killpid($verbose, $pidlist);
4008     #
4009     # cleanup all server pid files
4010     #
4011     foreach my $server (keys %serverpidfile) {
4012         my $pidfile = $serverpidfile{$server};
4013         my $pid = processexists($pidfile);
4014         if($pid > 0) {
4015             logmsg "Warning: $server server unexpectedly alive\n";
4016             killpid($verbose, $pid);
4017         }
4018         unlink($pidfile) if(-f $pidfile);
4019     }
4020 }
4021
4022 #######################################################################
4023 # startservers() starts all the named servers
4024 #
4025 # Returns: string with error reason or blank for success
4026 #
4027 sub startservers {
4028     my @what = @_;
4029     my ($pid, $pid2);
4030     for(@what) {
4031         my (@whatlist) = split(/\s+/,$_);
4032         my $what = lc($whatlist[0]);
4033         $what =~ s/[^a-z0-9-]//g;
4034
4035         my $certfile;
4036         if($what =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|))$/) {
4037             $certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem';
4038         }
4039
4040         if(($what eq "pop3") ||
4041            ($what eq "ftp") ||
4042            ($what eq "imap") ||
4043            ($what eq "smtp")) {
4044             if($torture && $run{$what} &&
4045                !responsive_pingpong_server($what, "", $verbose)) {
4046                 stopserver($what);
4047             }
4048             if(!$run{$what}) {
4049                 ($pid, $pid2) = runpingpongserver($what, "", $verbose);
4050                 if($pid <= 0) {
4051                     return "failed starting ". uc($what) ." server";
4052                 }
4053                 printf ("* pid $what => %d %d\n", $pid, $pid2) if($verbose);
4054                 $run{$what}="$pid $pid2";
4055             }
4056         }
4057         elsif($what eq "ftp2") {
4058             if($torture && $run{'ftp2'} &&
4059                !responsive_pingpong_server("ftp", "2", $verbose)) {
4060                 stopserver('ftp2');
4061             }
4062             if(!$run{'ftp2'}) {
4063                 ($pid, $pid2) = runpingpongserver("ftp", "2", $verbose);
4064                 if($pid <= 0) {
4065                     return "failed starting FTP2 server";
4066                 }
4067                 printf ("* pid ftp2 => %d %d\n", $pid, $pid2) if($verbose);
4068                 $run{'ftp2'}="$pid $pid2";
4069             }
4070         }
4071         elsif($what eq "ftp-ipv6") {
4072             if($torture && $run{'ftp-ipv6'} &&
4073                !responsive_pingpong_server("ftp", "", $verbose, "ipv6")) {
4074                 stopserver('ftp-ipv6');
4075             }
4076             if(!$run{'ftp-ipv6'}) {
4077                 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose, "ipv6");
4078                 if($pid <= 0) {
4079                     return "failed starting FTP-IPv6 server";
4080                 }
4081                 logmsg sprintf("* pid ftp-ipv6 => %d %d\n", $pid,
4082                        $pid2) if($verbose);
4083                 $run{'ftp-ipv6'}="$pid $pid2";
4084             }
4085         }
4086         elsif($what eq "gopher") {
4087             if($torture && $run{'gopher'} &&
4088                !responsive_http_server("gopher", $verbose, 0, $GOPHERPORT)) {
4089                 stopserver('gopher');
4090             }
4091             if(!$run{'gopher'}) {
4092                 ($pid, $pid2) = runhttpserver("gopher", $verbose, 0,
4093                                               $GOPHERPORT);
4094                 if($pid <= 0) {
4095                     return "failed starting GOPHER server";
4096                 }
4097                 logmsg sprintf ("* pid gopher => %d %d\n", $pid, $pid2)
4098                     if($verbose);
4099                 $run{'gopher'}="$pid $pid2";
4100             }
4101         }
4102         elsif($what eq "gopher-ipv6") {
4103             if($torture && $run{'gopher-ipv6'} &&
4104                !responsive_http_server("gopher", $verbose, "ipv6",
4105                                        $GOPHER6PORT)) {
4106                 stopserver('gopher-ipv6');
4107             }
4108             if(!$run{'gopher-ipv6'}) {
4109                 ($pid, $pid2) = runhttpserver("gopher", $verbose, "ipv6",
4110                                               $GOPHER6PORT);
4111                 if($pid <= 0) {
4112                     return "failed starting GOPHER-IPv6 server";
4113                 }
4114                 logmsg sprintf("* pid gopher-ipv6 => %d %d\n", $pid,
4115                                $pid2) if($verbose);
4116                 $run{'gopher-ipv6'}="$pid $pid2";
4117             }
4118         }
4119         elsif($what eq "http") {
4120             if($torture && $run{'http'} &&
4121                !responsive_http_server("http", $verbose, 0, $HTTPPORT)) {
4122                 stopserver('http');
4123             }
4124             if(!$run{'http'}) {
4125                 ($pid, $pid2) = runhttpserver("http", $verbose, 0,
4126                                               $HTTPPORT);
4127                 if($pid <= 0) {
4128                     return "failed starting HTTP server";
4129                 }
4130                 logmsg sprintf ("* pid http => %d %d\n", $pid, $pid2)
4131                     if($verbose);
4132                 $run{'http'}="$pid $pid2";
4133             }
4134         }
4135         elsif($what eq "http-proxy") {
4136             if($torture && $run{'http-proxy'} &&
4137                !responsive_http_server("http", $verbose, "proxy",
4138                                        $HTTPPROXYPORT)) {
4139                 stopserver('http-proxy');
4140             }
4141             if(!$run{'http-proxy'}) {
4142                 ($pid, $pid2) = runhttpserver("http", $verbose, "proxy",
4143                                               $HTTPPROXYPORT);
4144                 if($pid <= 0) {
4145                     return "failed starting HTTP-proxy server";
4146                 }
4147                 logmsg sprintf ("* pid http-proxy => %d %d\n", $pid, $pid2)
4148                     if($verbose);
4149                 $run{'http-proxy'}="$pid $pid2";
4150             }
4151         }
4152         elsif($what eq "http-ipv6") {
4153             if($torture && $run{'http-ipv6'} &&
4154                !responsive_http_server("http", $verbose, "IPv6", $HTTP6PORT)) {
4155                 stopserver('http-ipv6');
4156             }
4157             if(!$run{'http-ipv6'}) {
4158                 ($pid, $pid2) = runhttpserver("http", $verbose, "ipv6",
4159                                               $HTTP6PORT);
4160                 if($pid <= 0) {
4161                     return "failed starting HTTP-IPv6 server";
4162                 }
4163                 logmsg sprintf("* pid http-ipv6 => %d %d\n", $pid, $pid2)
4164                     if($verbose);
4165                 $run{'http-ipv6'}="$pid $pid2";
4166             }
4167         }
4168         elsif($what eq "http-pipe") {
4169             if($torture && $run{'http-pipe'} &&
4170                !responsive_http_server("http", $verbose, "pipe",
4171                                        $HTTPPIPEPORT)) {
4172                 stopserver('http-pipe');
4173             }
4174             if(!$run{'http-pipe'}) {
4175                 ($pid, $pid2) = runhttpserver("http", $verbose, "pipe",
4176                                               $HTTPPIPEPORT);
4177                 if($pid <= 0) {
4178                     return "failed starting HTTP-pipe server";
4179                 }
4180                 logmsg sprintf ("* pid http-pipe => %d %d\n", $pid, $pid2)
4181                     if($verbose);
4182                 $run{'http-pipe'}="$pid $pid2";
4183             }
4184         }
4185         elsif($what eq "rtsp") {
4186             if($torture && $run{'rtsp'} &&
4187                !responsive_rtsp_server($verbose)) {
4188                 stopserver('rtsp');
4189             }
4190             if(!$run{'rtsp'}) {
4191                 ($pid, $pid2) = runrtspserver($verbose);
4192                 if($pid <= 0) {
4193                     return "failed starting RTSP server";
4194                 }
4195                 printf ("* pid rtsp => %d %d\n", $pid, $pid2) if($verbose);
4196                 $run{'rtsp'}="$pid $pid2";
4197             }
4198         }
4199         elsif($what eq "rtsp-ipv6") {
4200             if($torture && $run{'rtsp-ipv6'} &&
4201                !responsive_rtsp_server($verbose, "IPv6")) {
4202                 stopserver('rtsp-ipv6');
4203             }
4204             if(!$run{'rtsp-ipv6'}) {
4205                 ($pid, $pid2) = runrtspserver($verbose, "IPv6");
4206                 if($pid <= 0) {
4207                     return "failed starting RTSP-IPv6 server";
4208                 }
4209                 logmsg sprintf("* pid rtsp-ipv6 => %d %d\n", $pid, $pid2)
4210                     if($verbose);
4211                 $run{'rtsp-ipv6'}="$pid $pid2";
4212             }
4213         }
4214         elsif($what eq "ftps") {
4215             if(!$stunnel) {
4216                 # we can't run ftps tests without stunnel
4217                 return "no stunnel";
4218             }
4219             if(!$ssl_version) {
4220                 # we can't run ftps tests if libcurl is SSL-less
4221                 return "curl lacks SSL support";
4222             }
4223             if($runcert{'ftps'} && ($runcert{'ftps'} ne $certfile)) {
4224                 # stop server when running and using a different cert
4225                 stopserver('ftps');
4226             }
4227             if($torture && $run{'ftp'} &&
4228                !responsive_pingpong_server("ftp", "", $verbose)) {
4229                 stopserver('ftp');
4230             }
4231             if(!$run{'ftp'}) {
4232                 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose);
4233                 if($pid <= 0) {
4234                     return "failed starting FTP server";
4235                 }
4236                 printf ("* pid ftp => %d %d\n", $pid, $pid2) if($verbose);
4237                 $run{'ftp'}="$pid $pid2";
4238             }
4239             if(!$run{'ftps'}) {
4240                 ($pid, $pid2) = runftpsserver($verbose, "", $certfile);
4241                 if($pid <= 0) {
4242                     return "failed starting FTPS server (stunnel)";
4243                 }
4244                 logmsg sprintf("* pid ftps => %d %d\n", $pid, $pid2)
4245                     if($verbose);
4246                 $run{'ftps'}="$pid $pid2";
4247             }
4248         }
4249         elsif($what eq "file") {
4250             # we support it but have no server!
4251         }
4252         elsif($what eq "https") {
4253             if(!$stunnel) {
4254                 # we can't run https tests without stunnel
4255                 return "no stunnel";
4256             }
4257             if(!$ssl_version) {
4258                 # we can't run https tests if libcurl is SSL-less
4259                 return "curl lacks SSL support";
4260             }
4261             if($runcert{'https'} && ($runcert{'https'} ne $certfile)) {
4262                 # stop server when running and using a different cert
4263                 stopserver('https');
4264             }
4265             if($torture && $run{'http'} &&
4266                !responsive_http_server("http", $verbose, 0, $HTTPPORT)) {
4267                 stopserver('http');
4268             }
4269             if(!$run{'http'}) {
4270                 ($pid, $pid2) = runhttpserver("http", $verbose, 0,
4271                                               $HTTPPORT);
4272                 if($pid <= 0) {
4273                     return "failed starting HTTP server";
4274                 }
4275                 printf ("* pid http => %d %d\n", $pid, $pid2) if($verbose);
4276                 $run{'http'}="$pid $pid2";
4277             }
4278             if(!$run{'https'}) {
4279                 ($pid, $pid2) = runhttpsserver($verbose, "", $certfile);
4280                 if($pid <= 0) {
4281                     return "failed starting HTTPS server (stunnel)";
4282                 }
4283                 logmsg sprintf("* pid https => %d %d\n", $pid, $pid2)
4284                     if($verbose);
4285                 $run{'https'}="$pid $pid2";
4286             }
4287         }
4288         elsif($what eq "httptls") {
4289             if(!$httptlssrv) {
4290                 # for now, we can't run http TLS-EXT tests without gnutls-serv
4291                 return "no gnutls-serv";
4292             }
4293             if($torture && $run{'httptls'} &&
4294                !responsive_httptls_server($verbose, "IPv4")) {
4295                 stopserver('httptls');
4296             }
4297             if(!$run{'httptls'}) {
4298                 ($pid, $pid2) = runhttptlsserver($verbose, "IPv4");
4299                 if($pid <= 0) {
4300                     return "failed starting HTTPTLS server (gnutls-serv)";
4301                 }
4302                 logmsg sprintf("* pid httptls => %d %d\n", $pid, $pid2)
4303                     if($verbose);
4304                 $run{'httptls'}="$pid $pid2";
4305             }
4306         }
4307         elsif($what eq "httptls-ipv6") {
4308             if(!$httptlssrv) {
4309                 # for now, we can't run http TLS-EXT tests without gnutls-serv
4310                 return "no gnutls-serv";
4311             }
4312             if($torture && $run{'httptls-ipv6'} &&
4313                !responsive_httptls_server($verbose, "IPv6")) {
4314                 stopserver('httptls-ipv6');
4315             }
4316             if(!$run{'httptls-ipv6'}) {
4317                 ($pid, $pid2) = runhttptlsserver($verbose, "IPv6");
4318                 if($pid <= 0) {
4319                     return "failed starting HTTPTLS-IPv6 server (gnutls-serv)";
4320                 }
4321                 logmsg sprintf("* pid httptls-ipv6 => %d %d\n", $pid, $pid2)
4322                     if($verbose);
4323                 $run{'httptls-ipv6'}="$pid $pid2";
4324             }
4325         }
4326         elsif($what eq "tftp") {
4327             if($torture && $run{'tftp'} &&
4328                !responsive_tftp_server("", $verbose)) {
4329                 stopserver('tftp');
4330             }
4331             if(!$run{'tftp'}) {
4332                 ($pid, $pid2) = runtftpserver("", $verbose);
4333                 if($pid <= 0) {
4334                     return "failed starting TFTP server";
4335                 }
4336                 printf ("* pid tftp => %d %d\n", $pid, $pid2) if($verbose);
4337                 $run{'tftp'}="$pid $pid2";
4338             }
4339         }
4340         elsif($what eq "tftp-ipv6") {
4341             if($torture && $run{'tftp-ipv6'} &&
4342                !responsive_tftp_server("", $verbose, "IPv6")) {
4343                 stopserver('tftp-ipv6');
4344             }
4345             if(!$run{'tftp-ipv6'}) {
4346                 ($pid, $pid2) = runtftpserver("", $verbose, "IPv6");
4347                 if($pid <= 0) {
4348                     return "failed starting TFTP-IPv6 server";
4349                 }
4350                 printf("* pid tftp-ipv6 => %d %d\n", $pid, $pid2) if($verbose);
4351                 $run{'tftp-ipv6'}="$pid $pid2";
4352             }
4353         }
4354         elsif($what eq "sftp" || $what eq "scp" || $what eq "socks4" || $what eq "socks5" ) {
4355             if(!$run{'ssh'}) {
4356                 ($pid, $pid2) = runsshserver("", $verbose);
4357                 if($pid <= 0) {
4358                     return "failed starting SSH server";
4359                 }
4360                 printf ("* pid ssh => %d %d\n", $pid, $pid2) if($verbose);
4361                 $run{'ssh'}="$pid $pid2";
4362             }
4363             if($what eq "socks4" || $what eq "socks5") {
4364                 if(!$run{'socks'}) {
4365                     ($pid, $pid2) = runsocksserver("", $verbose);
4366                     if($pid <= 0) {
4367                         return "failed starting socks server";
4368                     }
4369                     printf ("* pid socks => %d %d\n", $pid, $pid2) if($verbose);
4370                     $run{'socks'}="$pid $pid2";
4371                 }
4372             }
4373             if($what eq "socks5") {
4374                 if(!$sshdid) {
4375                     # Not an OpenSSH or SunSSH ssh daemon
4376                     logmsg "Not OpenSSH or SunSSH; socks5 tests need at least OpenSSH 3.7\n";
4377                     return "failed starting socks5 server";
4378                 }
4379                 elsif(($sshdid =~ /OpenSSH/) && ($sshdvernum < 370)) {
4380                     # Need OpenSSH 3.7 for socks5 - http://www.openssh.com/txt/release-3.7
4381                     logmsg "$sshdverstr insufficient; socks5 tests need at least OpenSSH 3.7\n";
4382                     return "failed starting socks5 server";
4383                 }
4384                 elsif(($sshdid =~ /SunSSH/)  && ($sshdvernum < 100)) {
4385                     # Need SunSSH 1.0 for socks5
4386                     logmsg "$sshdverstr insufficient; socks5 tests need at least SunSSH 1.0\n";
4387                     return "failed starting socks5 server";
4388                 }
4389             }
4390         }
4391         elsif($what eq "none") {
4392             logmsg "* starts no server\n" if ($verbose);
4393         }
4394         else {
4395             warn "we don't support a server for $what";
4396             return "no server for $what";
4397         }
4398     }
4399     return 0;
4400 }
4401
4402 ##############################################################################
4403 # This function makes sure the right set of server is running for the
4404 # specified test case. This is a useful design when we run single tests as not
4405 # all servers need to run then!
4406 #
4407 # Returns: a string, blank if everything is fine or a reason why it failed
4408 #
4409 sub serverfortest {
4410     my ($testnum)=@_;
4411
4412     my @what = getpart("client", "server");
4413
4414     if(!$what[0]) {
4415         warn "Test case $testnum has no server(s) specified";
4416         return "no server specified";
4417     }
4418
4419     for(my $i = scalar(@what) - 1; $i >= 0; $i--) {
4420         my $srvrline = $what[$i];
4421         chomp $srvrline if($srvrline);
4422         if($srvrline =~ /^(\S+)((\s*)(.*))/) {
4423             my $server = "${1}";
4424             my $lnrest = "${2}";
4425             my $tlsext;
4426             if($server =~ /^(httptls)(\+)(ext|srp)(\d*)(-ipv6|)$/) {
4427                 $server = "${1}${4}${5}";
4428                 $tlsext = uc("TLS-${3}");
4429             }
4430             if(! grep /^\Q$server\E$/, @protocols) {
4431                 if(substr($server,0,5) ne "socks") {
4432                     if($tlsext) {
4433                         return "curl lacks $tlsext support";
4434                     }
4435                     else {
4436                         return "curl lacks $server server support";
4437                     }
4438                 }
4439             }
4440             $what[$i] = "$server$lnrest" if($tlsext);
4441         }
4442     }
4443
4444     return &startservers(@what);
4445 }
4446
4447 #######################################################################
4448 # runtimestats displays test-suite run time statistics
4449 #
4450 sub runtimestats {
4451     my $lasttest = $_[0];
4452
4453     return if(not $timestats);
4454
4455     logmsg "\nTest suite total running time breakdown per task...\n\n";
4456
4457     my @timesrvr;
4458     my @timeprep;
4459     my @timetool;
4460     my @timelock;
4461     my @timevrfy;
4462     my @timetest;
4463     my $timesrvrtot = 0.0;
4464     my $timepreptot = 0.0;
4465     my $timetooltot = 0.0;
4466     my $timelocktot = 0.0;
4467     my $timevrfytot = 0.0;
4468     my $timetesttot = 0.0;
4469     my $counter;
4470
4471     for my $testnum (1 .. $lasttest) {
4472         if($timesrvrini{$testnum}) {
4473             $timesrvrtot += $timesrvrend{$testnum} - $timesrvrini{$testnum};
4474             $timepreptot +=
4475                 (($timetoolini{$testnum} - $timeprepini{$testnum}) -
4476                  ($timesrvrend{$testnum} - $timesrvrini{$testnum}));
4477             $timetooltot += $timetoolend{$testnum} - $timetoolini{$testnum};
4478             $timelocktot += $timesrvrlog{$testnum} - $timetoolend{$testnum};
4479             $timevrfytot += $timevrfyend{$testnum} - $timesrvrlog{$testnum};
4480             $timetesttot += $timevrfyend{$testnum} - $timeprepini{$testnum};
4481             push @timesrvr, sprintf("%06.3f  %04d",
4482                 $timesrvrend{$testnum} - $timesrvrini{$testnum}, $testnum);
4483             push @timeprep, sprintf("%06.3f  %04d",
4484                 ($timetoolini{$testnum} - $timeprepini{$testnum}) -
4485                 ($timesrvrend{$testnum} - $timesrvrini{$testnum}), $testnum);
4486             push @timetool, sprintf("%06.3f  %04d",
4487                 $timetoolend{$testnum} - $timetoolini{$testnum}, $testnum);
4488             push @timelock, sprintf("%06.3f  %04d",
4489                 $timesrvrlog{$testnum} - $timetoolend{$testnum}, $testnum);
4490             push @timevrfy, sprintf("%06.3f  %04d",
4491                 $timevrfyend{$testnum} - $timesrvrlog{$testnum}, $testnum);
4492             push @timetest, sprintf("%06.3f  %04d",
4493                 $timevrfyend{$testnum} - $timeprepini{$testnum}, $testnum);
4494         }
4495     }
4496
4497     {
4498         no warnings 'numeric';
4499         @timesrvr = sort { $b <=> $a } @timesrvr;
4500         @timeprep = sort { $b <=> $a } @timeprep;
4501         @timetool = sort { $b <=> $a } @timetool;
4502         @timelock = sort { $b <=> $a } @timelock;
4503         @timevrfy = sort { $b <=> $a } @timevrfy;
4504         @timetest = sort { $b <=> $a } @timetest;
4505     }
4506
4507     logmsg "Spent ". sprintf("%08.3f ", $timesrvrtot) .
4508            "seconds starting and verifying test harness servers.\n";
4509     logmsg "Spent ". sprintf("%08.3f ", $timepreptot) .
4510            "seconds reading definitions and doing test preparations.\n";
4511     logmsg "Spent ". sprintf("%08.3f ", $timetooltot) .
4512            "seconds actually running test tools.\n";
4513     logmsg "Spent ". sprintf("%08.3f ", $timelocktot) .
4514            "seconds awaiting server logs lock removal.\n";
4515     logmsg "Spent ". sprintf("%08.3f ", $timevrfytot) .
4516            "seconds verifying test results.\n";
4517     logmsg "Spent ". sprintf("%08.3f ", $timetesttot) .
4518            "seconds doing all of the above.\n";
4519
4520     $counter = 25;
4521     logmsg "\nTest server starting and verification time per test ".
4522         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4523     logmsg "-time-  test\n";
4524     logmsg "------  ----\n";
4525     foreach my $txt (@timesrvr) {
4526         last if((not $fullstats) && (not $counter--));
4527         logmsg "$txt\n";
4528     }
4529
4530     $counter = 10;
4531     logmsg "\nTest definition reading and preparation time per test ".
4532         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4533     logmsg "-time-  test\n";
4534     logmsg "------  ----\n";
4535     foreach my $txt (@timeprep) {
4536         last if((not $fullstats) && (not $counter--));
4537         logmsg "$txt\n";
4538     }
4539
4540     $counter = 25;
4541     logmsg "\nTest tool execution time per test ".
4542         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4543     logmsg "-time-  test\n";
4544     logmsg "------  ----\n";
4545     foreach my $txt (@timetool) {
4546         last if((not $fullstats) && (not $counter--));
4547         logmsg "$txt\n";
4548     }
4549
4550     $counter = 15;
4551     logmsg "\nTest server logs lock removal time per test ".
4552         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4553     logmsg "-time-  test\n";
4554     logmsg "------  ----\n";
4555     foreach my $txt (@timelock) {
4556         last if((not $fullstats) && (not $counter--));
4557         logmsg "$txt\n";
4558     }
4559
4560     $counter = 10;
4561     logmsg "\nTest results verification time per test ".
4562         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4563     logmsg "-time-  test\n";
4564     logmsg "------  ----\n";
4565     foreach my $txt (@timevrfy) {
4566         last if((not $fullstats) && (not $counter--));
4567         logmsg "$txt\n";
4568     }
4569
4570     $counter = 50;
4571     logmsg "\nTotal time per test ".
4572         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4573     logmsg "-time-  test\n";
4574     logmsg "------  ----\n";
4575     foreach my $txt (@timetest) {
4576         last if((not $fullstats) && (not $counter--));
4577         logmsg "$txt\n";
4578     }
4579
4580     logmsg "\n";
4581 }
4582
4583 #######################################################################
4584 # Check options to this test program
4585 #
4586
4587 my $number=0;
4588 my $fromnum=-1;
4589 my @testthis;
4590 while(@ARGV) {
4591     if ($ARGV[0] eq "-v") {
4592         # verbose output
4593         $verbose=1;
4594     }
4595     elsif($ARGV[0] =~ /^-b(.*)/) {
4596         my $portno=$1;
4597         if($portno =~ s/(\d+)$//) {
4598             $base = int $1;
4599         }
4600     }
4601     elsif ($ARGV[0] eq "-c") {
4602         # use this path to curl instead of default
4603         $DBGCURL=$CURL=$ARGV[1];
4604         shift @ARGV;
4605     }
4606     elsif ($ARGV[0] eq "-vc") {
4607         # use this path to a curl used to verify servers
4608
4609         # Particularly useful when you introduce a crashing bug somewhere in
4610         # the development version as then it won't be able to run any tests
4611         # since it can't verify the servers!
4612
4613         $VCURL=$ARGV[1];
4614         shift @ARGV;
4615     }
4616     elsif ($ARGV[0] eq "-d") {
4617         # have the servers display protocol output
4618         $debugprotocol=1;
4619     }
4620     elsif ($ARGV[0] eq "-g") {
4621         # run this test with gdb
4622         $gdbthis=1;
4623     }
4624     elsif ($ARGV[0] eq "-gw") {
4625         # run this test with windowed gdb
4626         $gdbthis=1;
4627         $gdbxwin=1;
4628     }
4629     elsif($ARGV[0] eq "-s") {
4630         # short output
4631         $short=1;
4632     }
4633     elsif($ARGV[0] eq "-am") {
4634         # automake-style output
4635         $short=1;
4636         $automakestyle=1;
4637     }
4638     elsif($ARGV[0] eq "-n") {
4639         # no valgrind
4640         undef $valgrind;
4641     }
4642     elsif($ARGV[0] =~ /^-t(.*)/) {
4643         # torture
4644         $torture=1;
4645         my $xtra = $1;
4646
4647         if($xtra =~ s/(\d+)$//) {
4648             $tortalloc = $1;
4649         }
4650         # we undef valgrind to make this fly in comparison
4651         undef $valgrind;
4652     }
4653     elsif($ARGV[0] eq "-a") {
4654         # continue anyway, even if a test fail
4655         $anyway=1;
4656     }
4657     elsif($ARGV[0] eq "-e") {
4658         # run the tests cases event based if possible
4659         $run_event_based=1;
4660     }
4661     elsif($ARGV[0] eq "-p") {
4662         $postmortem=1;
4663     }
4664     elsif($ARGV[0] eq "-l") {
4665         # lists the test case names only
4666         $listonly=1;
4667     }
4668     elsif($ARGV[0] eq "-k") {
4669         # keep stdout and stderr files after tests
4670         $keepoutfiles=1;
4671     }
4672     elsif($ARGV[0] eq "-r") {
4673         # run time statistics needs Time::HiRes
4674         if($Time::HiRes::VERSION) {
4675             keys(%timeprepini) = 1000;
4676             keys(%timesrvrini) = 1000;
4677             keys(%timesrvrend) = 1000;
4678             keys(%timetoolini) = 1000;
4679             keys(%timetoolend) = 1000;
4680             keys(%timesrvrlog) = 1000;
4681             keys(%timevrfyend) = 1000;
4682             $timestats=1;
4683             $fullstats=0;
4684         }
4685     }
4686     elsif($ARGV[0] eq "-rf") {
4687         # run time statistics needs Time::HiRes
4688         if($Time::HiRes::VERSION) {
4689             keys(%timeprepini) = 1000;
4690             keys(%timesrvrini) = 1000;
4691             keys(%timesrvrend) = 1000;
4692             keys(%timetoolini) = 1000;
4693             keys(%timetoolend) = 1000;
4694             keys(%timesrvrlog) = 1000;
4695             keys(%timevrfyend) = 1000;
4696             $timestats=1;
4697             $fullstats=1;
4698         }
4699     }
4700     elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
4701         # show help text
4702         print <<EOHELP
4703 Usage: runtests.pl [options] [test selection(s)]
4704   -a       continue even if a test fails
4705   -bN      use base port number N for test servers (default $base)
4706   -c path  use this curl executable
4707   -d       display server debug info
4708   -g       run the test case with gdb
4709   -gw      run the test case with gdb as a windowed application
4710   -h       this help text
4711   -k       keep stdout and stderr files present after tests
4712   -l       list all test case names/descriptions
4713   -n       no valgrind
4714   -p       print log file contents when a test fails
4715   -r       run time statistics
4716   -rf      full run time statistics
4717   -s       short output
4718   -am      automake style output PASS/FAIL: [number] [name]
4719   -t[N]    torture (simulate memory alloc failures); N means fail Nth alloc
4720   -v       verbose output
4721   -vc path use this curl only to verify the existing servers
4722   [num]    like "5 6 9" or " 5 to 22 " to run those tests only
4723   [!num]   like "!5 !6 !9" to disable those tests
4724   [keyword] like "IPv6" to select only tests containing the key word
4725   [!keyword] like "!cookies" to disable any tests containing the key word
4726 EOHELP
4727     ;
4728         exit;
4729     }
4730     elsif($ARGV[0] =~ /^(\d+)/) {
4731         $number = $1;
4732         if($fromnum >= 0) {
4733             for($fromnum .. $number) {
4734                 push @testthis, $_;
4735             }
4736             $fromnum = -1;
4737         }
4738         else {
4739             push @testthis, $1;
4740         }
4741     }
4742     elsif($ARGV[0] =~ /^to$/i) {
4743         $fromnum = $number+1;
4744     }
4745     elsif($ARGV[0] =~ /^!(\d+)/) {
4746         $fromnum = -1;
4747         $disabled{$1}=$1;
4748     }
4749     elsif($ARGV[0] =~ /^!(.+)/) {
4750         $disabled_keywords{$1}=$1;
4751     }
4752     elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) {
4753         $enabled_keywords{$1}=$1;
4754     }
4755     else {
4756         print "Unknown option: $ARGV[0]\n";
4757         exit;
4758     }
4759     shift @ARGV;
4760 }
4761
4762 if(@testthis && ($testthis[0] ne "")) {
4763     $TESTCASES=join(" ", @testthis);
4764 }
4765
4766 if($valgrind) {
4767     # we have found valgrind on the host, use it
4768
4769     # verify that we can invoke it fine
4770     my $code = runclient("valgrind >/dev/null 2>&1");
4771
4772     if(($code>>8) != 1) {
4773         #logmsg "Valgrind failure, disable it\n";
4774         undef $valgrind;
4775     } else {
4776
4777         # since valgrind 2.1.x, '--tool' option is mandatory
4778         # use it, if it is supported by the version installed on the system
4779         runclient("valgrind --help 2>&1 | grep -- --tool > /dev/null 2>&1");
4780         if (($? >> 8)==0) {
4781             $valgrind_tool="--tool=memcheck";
4782         }
4783         open(C, "<$CURL");
4784         my $l = <C>;
4785         if($l =~ /^\#\!/) {
4786             # A shell script. This is typically when built with libtool,
4787             $valgrind="../libtool --mode=execute $valgrind";
4788         }
4789         close(C);
4790
4791         # valgrind 3 renamed the --logfile option to --log-file!!!
4792         my $ver=join(' ', runclientoutput("valgrind --version"));
4793         # cut off all but digits and dots
4794         $ver =~ s/[^0-9.]//g;
4795
4796         if($ver =~ /^(\d+)/) {
4797             $ver = $1;
4798             if($ver >= 3) {
4799                 $valgrind_logfile="--log-file";
4800             }
4801         }
4802     }
4803 }
4804
4805 if ($gdbthis) {
4806     # open the executable curl and read the first 4 bytes of it
4807     open(CHECK, "<$CURL");
4808     my $c;
4809     sysread CHECK, $c, 4;
4810     close(CHECK);
4811     if($c eq "#! /") {
4812         # A shell script. This is typically when built with libtool,
4813         $libtool = 1;
4814         $gdb = "libtool --mode=execute gdb";
4815     }
4816 }
4817
4818 $HTTPPORT        = $base++; # HTTP server port
4819 $HTTPSPORT       = $base++; # HTTPS (stunnel) server port
4820 $FTPPORT         = $base++; # FTP server port
4821 $FTPSPORT        = $base++; # FTPS (stunnel) server port
4822 $HTTP6PORT       = $base++; # HTTP IPv6 server port
4823 $FTP2PORT        = $base++; # FTP server 2 port
4824 $FTP6PORT        = $base++; # FTP IPv6 port
4825 $TFTPPORT        = $base++; # TFTP (UDP) port
4826 $TFTP6PORT       = $base++; # TFTP IPv6 (UDP) port
4827 $SSHPORT         = $base++; # SSH (SCP/SFTP) port
4828 $SOCKSPORT       = $base++; # SOCKS port
4829 $POP3PORT        = $base++; # POP3 server port
4830 $POP36PORT       = $base++; # POP3 IPv6 server port
4831 $IMAPPORT        = $base++; # IMAP server port
4832 $IMAP6PORT       = $base++; # IMAP IPv6 server port
4833 $SMTPPORT        = $base++; # SMTP server port
4834 $SMTP6PORT       = $base++; # SMTP IPv6 server port
4835 $RTSPPORT        = $base++; # RTSP server port
4836 $RTSP6PORT       = $base++; # RTSP IPv6 server port
4837 $GOPHERPORT      = $base++; # Gopher IPv4 server port
4838 $GOPHER6PORT     = $base++; # Gopher IPv6 server port
4839 $HTTPTLSPORT     = $base++; # HTTP TLS (non-stunnel) server port
4840 $HTTPTLS6PORT    = $base++; # HTTP TLS (non-stunnel) IPv6 server port
4841 $HTTPPROXYPORT   = $base++; # HTTP proxy port, when using CONNECT
4842 $HTTPPIPEPORT    = $base++; # HTTP pipelining port
4843
4844 #######################################################################
4845 # clear and create logging directory:
4846 #
4847
4848 cleardir($LOGDIR);
4849 mkdir($LOGDIR, 0777);
4850
4851 #######################################################################
4852 # initialize some variables
4853 #
4854
4855 get_disttests();
4856 init_serverpidfile_hash();
4857
4858 #######################################################################
4859 # Output curl version and host info being tested
4860 #
4861
4862 if(!$listonly) {
4863     checksystem();
4864 }
4865
4866 #######################################################################
4867 # Fetch all disabled tests
4868 #
4869
4870 open(D, "<$TESTDIR/DISABLED");
4871 while(<D>) {
4872     if(/^ *\#/) {
4873         # allow comments
4874         next;
4875     }
4876     if($_ =~ /(\d+)/) {
4877         $disabled{$1}=$1; # disable this test number
4878     }
4879 }
4880 close(D);
4881
4882 #######################################################################
4883 # If 'all' tests are requested, find out all test numbers
4884 #
4885
4886 if ( $TESTCASES eq "all") {
4887     # Get all commands and find out their test numbers
4888     opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
4889     my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
4890     closedir(DIR);
4891
4892     $TESTCASES=""; # start with no test cases
4893
4894     # cut off everything but the digits
4895     for(@cmds) {
4896         $_ =~ s/[a-z\/\.]*//g;
4897     }
4898     # sort the numbers from low to high
4899     foreach my $n (sort { $a <=> $b } @cmds) {
4900         if($disabled{$n}) {
4901             # skip disabled test cases
4902             my $why = "configured as DISABLED";
4903             $skipped++;
4904             $skipped{$why}++;
4905             $teststat[$n]=$why; # store reason for this test case
4906             next;
4907         }
4908         $TESTCASES .= " $n";
4909     }
4910 }
4911 else {
4912     my $verified="";
4913     map {
4914         if (-e "$TESTDIR/test$_") {
4915             $verified.="$_ ";
4916         }
4917     } split(" ", $TESTCASES);
4918     if($verified eq "") {
4919         print "No existing test cases were specified\n";
4920         exit;
4921     }
4922     $TESTCASES = $verified;
4923 }
4924
4925 #######################################################################
4926 # Start the command line log
4927 #
4928 open(CMDLOG, ">$CURLLOG") ||
4929     logmsg "can't log command lines to $CURLLOG\n";
4930
4931 #######################################################################
4932
4933 # Display the contents of the given file.  Line endings are canonicalized
4934 # and excessively long files are elided
4935 sub displaylogcontent {
4936     my ($file)=@_;
4937     if(open(SINGLE, "<$file")) {
4938         my $linecount = 0;
4939         my $truncate;
4940         my @tail;
4941         while(my $string = <SINGLE>) {
4942             $string =~ s/\r\n/\n/g;
4943             $string =~ s/[\r\f\032]/\n/g;
4944             $string .= "\n" unless ($string =~ /\n$/);
4945             $string =~ tr/\n//;
4946             for my $line (split("\n", $string)) {
4947                 $line =~ s/\s*\!$//;
4948                 if ($truncate) {
4949                     push @tail, " $line\n";
4950                 } else {
4951                     logmsg " $line\n";
4952                 }
4953                 $linecount++;
4954                 $truncate = $linecount > 1000;
4955             }
4956         }
4957         if(@tail) {
4958             my $tailshow = 200;
4959             my $tailskip = 0;
4960             my $tailtotal = scalar @tail;
4961             if($tailtotal > $tailshow) {
4962                 $tailskip = $tailtotal - $tailshow;
4963                 logmsg "=== File too long: $tailskip lines omitted here\n";
4964             }
4965             for($tailskip .. $tailtotal-1) {
4966                 logmsg "$tail[$_]";
4967             }
4968         }
4969         close(SINGLE);
4970     }
4971 }
4972
4973 sub displaylogs {
4974     my ($testnum)=@_;
4975     opendir(DIR, "$LOGDIR") ||
4976         die "can't open dir: $!";
4977     my @logs = readdir(DIR);
4978     closedir(DIR);
4979
4980     logmsg "== Contents of files in the $LOGDIR/ dir after test $testnum\n";
4981     foreach my $log (sort @logs) {
4982         if($log =~ /\.(\.|)$/) {
4983             next; # skip "." and ".."
4984         }
4985         if($log =~ /^\.nfs/) {
4986             next; # skip ".nfs"
4987         }
4988         if(($log eq "memdump") || ($log eq "core")) {
4989             next; # skip "memdump" and  "core"
4990         }
4991         if((-d "$LOGDIR/$log") || (! -s "$LOGDIR/$log")) {
4992             next; # skip directory and empty files
4993         }
4994         if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) {
4995             next; # skip stdoutNnn of other tests
4996         }
4997         if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) {
4998             next; # skip stderrNnn of other tests
4999         }
5000         if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) {
5001             next; # skip uploadNnn of other tests
5002         }
5003         if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) {
5004             next; # skip curlNnn.out of other tests
5005         }
5006         if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) {
5007             next; # skip testNnn.txt of other tests
5008         }
5009         if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) {
5010             next; # skip fileNnn.txt of other tests
5011         }
5012         if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) {
5013             next; # skip netrcNnn of other tests
5014         }
5015         if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) {
5016             next; # skip traceNnn of other tests
5017         }
5018         if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(\..*|)$/)) {
5019             next; # skip valgrindNnn of other tests
5020         }
5021         logmsg "=== Start of file $log\n";
5022         displaylogcontent("$LOGDIR/$log");
5023         logmsg "=== End of file $log\n";
5024     }
5025 }
5026
5027 #######################################################################
5028 # The main test-loop
5029 #
5030
5031 my $failed;
5032 my $testnum;
5033 my $ok=0;
5034 my $total=0;
5035 my $lasttest=0;
5036 my @at = split(" ", $TESTCASES);
5037 my $count=0;
5038
5039 $start = time();
5040
5041 foreach $testnum (@at) {
5042
5043     $lasttest = $testnum if($testnum > $lasttest);
5044     $count++;
5045
5046     my $error = singletest($run_event_based, $testnum, $count, scalar(@at));
5047     if($error < 0) {
5048         # not a test we can run
5049         next;
5050     }
5051
5052     $total++; # number of tests we've run
5053
5054     if($error>0) {
5055         $failed.= "$testnum ";
5056         if($postmortem) {
5057             # display all files in log/ in a nice way
5058             displaylogs($testnum);
5059         }
5060         if(!$anyway) {
5061             # a test failed, abort
5062             logmsg "\n - abort tests\n";
5063             last;
5064         }
5065     }
5066     elsif(!$error) {
5067         $ok++; # successful test counter
5068     }
5069
5070     # loop for next test
5071 }
5072
5073 my $sofar = time() - $start;
5074
5075 #######################################################################
5076 # Close command log
5077 #
5078 close(CMDLOG);
5079
5080 # Tests done, stop the servers
5081 stopservers($verbose);
5082
5083 my $all = $total + $skipped;
5084
5085 runtimestats($lasttest);
5086
5087 if($total) {
5088     logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
5089                    $ok/$total*100);
5090
5091     if($ok != $total) {
5092         logmsg "TESTFAIL: These test cases failed: $failed\n";
5093     }
5094 }
5095 else {
5096     logmsg "TESTFAIL: No tests were performed\n";
5097 }
5098
5099 if($all) {
5100     logmsg "TESTDONE: $all tests were considered during ".
5101         sprintf("%.0f", $sofar) ." seconds.\n";
5102 }
5103
5104 if($skipped && !$short) {
5105     my $s=0;
5106     logmsg "TESTINFO: $skipped tests were skipped due to these restraints:\n";
5107
5108     for(keys %skipped) {
5109         my $r = $_;
5110         printf "TESTINFO: \"%s\" %d times (", $r, $skipped{$_};
5111
5112         # now show all test case numbers that had this reason for being
5113         # skipped
5114         my $c=0;
5115         my $max = 9;
5116         for(0 .. scalar @teststat) {
5117             my $t = $_;
5118             if($teststat[$_] && ($teststat[$_] eq $r)) {
5119                 if($c < $max) {
5120                     logmsg ", " if($c);
5121                     logmsg $_;
5122                 }
5123                 $c++;
5124             }
5125         }
5126         if($c > $max) {
5127             logmsg " and ".($c-$max)." more";
5128         }
5129         logmsg ")\n";
5130     }
5131 }
5132
5133 if($total && ($ok != $total)) {
5134     exit 1;
5135 }