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 .= "--priority NORMAL:+SRP ";
1456     $flags .= "--srppasswd $srcdir/certs/srp-verifier-db ";
1457     $flags .= "--srppasswdconf $srcdir/certs/srp-verifier-conf";
1458
1459     my $cmd = "$httptlssrv $flags > $logfile 2>&1";
1460     my ($httptlspid, $pid2) = startnew($cmd, $pidfile, 10, 1); # fake pidfile
1461
1462     if($httptlspid <= 0 || !pidexists($httptlspid)) {
1463         # it is NOT alive
1464         logmsg "RUN: failed to start the $srvrname server\n";
1465         stopserver($server, "$pid2");
1466         displaylogs($testnumcheck);
1467         $doesntrun{$pidfile} = 1;
1468         return (0,0);
1469     }
1470
1471     # Server is up. Verify that we can speak to it. PID is from fake pidfile
1472     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1473     if(!$pid3) {
1474         logmsg "RUN: $srvrname server failed verification\n";
1475         # failed to talk to it properly. Kill the server and return failure
1476         stopserver($server, "$httptlspid $pid2");
1477         displaylogs($testnumcheck);
1478         $doesntrun{$pidfile} = 1;
1479         return (0,0);
1480     }
1481     $pid2 = $pid3;
1482
1483     if($verbose) {
1484         logmsg "RUN: $srvrname server is now running PID $httptlspid\n";
1485     }
1486
1487     sleep(1);
1488
1489     return ($httptlspid, $pid2);
1490 }
1491
1492 #######################################################################
1493 # start the pingpong server (FTP, POP3, IMAP, SMTP)
1494 #
1495 sub runpingpongserver {
1496     my ($proto, $id, $verbose, $ipv6) = @_;
1497     my $port;
1498     my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1499     my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1500     my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1501     my $server;
1502     my $srvrname;
1503     my $pidfile;
1504     my $logfile;
1505     my $flags = "";
1506
1507     if($proto eq "ftp") {
1508         $port = ($idnum>1)?$FTP2PORT:$FTPPORT;
1509
1510         if($ipvnum==6) {
1511             # if IPv6, use a different setup
1512             $port = $FTP6PORT;
1513         }
1514     }
1515     elsif($proto eq "pop3") {
1516         $port = ($ipvnum==6) ? $POP36PORT : $POP3PORT;
1517     }
1518     elsif($proto eq "imap") {
1519         $port = ($ipvnum==6) ? $IMAP6PORT : $IMAPPORT;
1520     }
1521     elsif($proto eq "smtp") {
1522         $port = ($ipvnum==6) ? $SMTP6PORT : $SMTPPORT;
1523     }
1524     else {
1525         print STDERR "Unsupported protocol $proto!!\n";
1526         return 0;
1527     }
1528
1529     $server = servername_id($proto, $ipvnum, $idnum);
1530
1531     $pidfile = $serverpidfile{$server};
1532
1533     # don't retry if the server doesn't work
1534     if ($doesntrun{$pidfile}) {
1535         return (0,0);
1536     }
1537
1538     my $pid = processexists($pidfile);
1539     if($pid > 0) {
1540         stopserver($server, "$pid");
1541     }
1542     unlink($pidfile) if(-f $pidfile);
1543
1544     $srvrname = servername_str($proto, $ipvnum, $idnum);
1545
1546     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1547
1548     $flags .= "--verbose " if($debugprotocol);
1549     $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1550     $flags .= "--srcdir \"$srcdir\" --proto $proto ";
1551     $flags .= "--id $idnum " if($idnum > 1);
1552     $flags .= "--ipv$ipvnum --port $port --addr \"$ip\"";
1553
1554     my $cmd = "$perl $srcdir/ftpserver.pl $flags";
1555     my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1556
1557     if($ftppid <= 0 || !pidexists($ftppid)) {
1558         # it is NOT alive
1559         logmsg "RUN: failed to start the $srvrname server\n";
1560         stopserver($server, "$pid2");
1561         displaylogs($testnumcheck);
1562         $doesntrun{$pidfile} = 1;
1563         return (0,0);
1564     }
1565
1566     # Server is up. Verify that we can speak to it.
1567     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1568     if(!$pid3) {
1569         logmsg "RUN: $srvrname server failed verification\n";
1570         # failed to talk to it properly. Kill the server and return failure
1571         stopserver($server, "$ftppid $pid2");
1572         displaylogs($testnumcheck);
1573         $doesntrun{$pidfile} = 1;
1574         return (0,0);
1575     }
1576
1577     $pid2 = $pid3;
1578
1579     if($verbose) {
1580         logmsg "RUN: $srvrname server is now running PID $ftppid\n";
1581     }
1582
1583     sleep(1);
1584
1585     return ($pid2, $ftppid);
1586 }
1587
1588 #######################################################################
1589 # start the ftps server (or rather, tunnel)
1590 #
1591 sub runftpsserver {
1592     my ($verbose, $ipv6, $certfile) = @_;
1593     my $proto = 'ftps';
1594     my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1595     my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1596     my $idnum = 1;
1597     my $server;
1598     my $srvrname;
1599     my $pidfile;
1600     my $logfile;
1601     my $flags = "";
1602
1603     if(!$stunnel) {
1604         return (0,0);
1605     }
1606
1607     $server = servername_id($proto, $ipvnum, $idnum);
1608
1609     $pidfile = $serverpidfile{$server};
1610
1611     # don't retry if the server doesn't work
1612     if ($doesntrun{$pidfile}) {
1613         return (0,0);
1614     }
1615
1616     my $pid = processexists($pidfile);
1617     if($pid > 0) {
1618         stopserver($server, "$pid");
1619     }
1620     unlink($pidfile) if(-f $pidfile);
1621
1622     $srvrname = servername_str($proto, $ipvnum, $idnum);
1623
1624     $certfile = 'stunnel.pem' unless($certfile);
1625
1626     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1627
1628     $flags .= "--verbose " if($debugprotocol);
1629     $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1630     $flags .= "--id $idnum " if($idnum > 1);
1631     $flags .= "--ipv$ipvnum --proto $proto ";
1632     $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
1633     $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
1634     $flags .= "--connect $FTPPORT --accept $FTPSPORT";
1635
1636     my $cmd = "$perl $srcdir/secureserver.pl $flags";
1637     my ($ftpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1638
1639     if($ftpspid <= 0 || !pidexists($ftpspid)) {
1640         # it is NOT alive
1641         logmsg "RUN: failed to start the $srvrname server\n";
1642         stopserver($server, "$pid2");
1643         displaylogs($testnumcheck);
1644         $doesntrun{$pidfile} = 1;
1645         return(0,0);
1646     }
1647
1648     # Server is up. Verify that we can speak to it.
1649     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $FTPSPORT);
1650     if(!$pid3) {
1651         logmsg "RUN: $srvrname server failed verification\n";
1652         # failed to talk to it properly. Kill the server and return failure
1653         stopserver($server, "$ftpspid $pid2");
1654         displaylogs($testnumcheck);
1655         $doesntrun{$pidfile} = 1;
1656         return (0,0);
1657     }
1658     # Here pid3 is actually the pid returned by the unsecure-ftp server.
1659
1660     $runcert{$server} = $certfile;
1661
1662     if($verbose) {
1663         logmsg "RUN: $srvrname server is now running PID $ftpspid\n";
1664     }
1665
1666     sleep(1);
1667
1668     return ($ftpspid, $pid2);
1669 }
1670
1671 #######################################################################
1672 # start the tftp server
1673 #
1674 sub runtftpserver {
1675     my ($id, $verbose, $ipv6) = @_;
1676     my $port = $TFTPPORT;
1677     my $ip = $HOSTIP;
1678     my $proto = 'tftp';
1679     my $ipvnum = 4;
1680     my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1681     my $server;
1682     my $srvrname;
1683     my $pidfile;
1684     my $logfile;
1685     my $flags = "";
1686
1687     if($ipv6) {
1688         # if IPv6, use a different setup
1689         $ipvnum = 6;
1690         $port = $TFTP6PORT;
1691         $ip = $HOST6IP;
1692     }
1693
1694     $server = servername_id($proto, $ipvnum, $idnum);
1695
1696     $pidfile = $serverpidfile{$server};
1697
1698     # don't retry if the server doesn't work
1699     if ($doesntrun{$pidfile}) {
1700         return (0,0);
1701     }
1702
1703     my $pid = processexists($pidfile);
1704     if($pid > 0) {
1705         stopserver($server, "$pid");
1706     }
1707     unlink($pidfile) if(-f $pidfile);
1708
1709     $srvrname = servername_str($proto, $ipvnum, $idnum);
1710
1711     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1712
1713     $flags .= "--verbose " if($debugprotocol);
1714     $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1715     $flags .= "--id $idnum " if($idnum > 1);
1716     $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\"";
1717
1718     my $cmd = "$perl $srcdir/tftpserver.pl $flags";
1719     my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1720
1721     if($tftppid <= 0 || !pidexists($tftppid)) {
1722         # it is NOT alive
1723         logmsg "RUN: failed to start the $srvrname server\n";
1724         stopserver($server, "$pid2");
1725         displaylogs($testnumcheck);
1726         $doesntrun{$pidfile} = 1;
1727         return (0,0);
1728     }
1729
1730     # Server is up. Verify that we can speak to it.
1731     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1732     if(!$pid3) {
1733         logmsg "RUN: $srvrname server failed verification\n";
1734         # failed to talk to it properly. Kill the server and return failure
1735         stopserver($server, "$tftppid $pid2");
1736         displaylogs($testnumcheck);
1737         $doesntrun{$pidfile} = 1;
1738         return (0,0);
1739     }
1740     $pid2 = $pid3;
1741
1742     if($verbose) {
1743         logmsg "RUN: $srvrname server is now running PID $tftppid\n";
1744     }
1745
1746     sleep(1);
1747
1748     return ($pid2, $tftppid);
1749 }
1750
1751
1752 #######################################################################
1753 # start the rtsp server
1754 #
1755 sub runrtspserver {
1756     my ($verbose, $ipv6) = @_;
1757     my $port = $RTSPPORT;
1758     my $ip = $HOSTIP;
1759     my $proto = 'rtsp';
1760     my $ipvnum = 4;
1761     my $idnum = 1;
1762     my $server;
1763     my $srvrname;
1764     my $pidfile;
1765     my $logfile;
1766     my $flags = "";
1767
1768     if($ipv6) {
1769         # if IPv6, use a different setup
1770         $ipvnum = 6;
1771         $port = $RTSP6PORT;
1772         $ip = $HOST6IP;
1773     }
1774
1775     $server = servername_id($proto, $ipvnum, $idnum);
1776
1777     $pidfile = $serverpidfile{$server};
1778
1779     # don't retry if the server doesn't work
1780     if ($doesntrun{$pidfile}) {
1781         return (0,0);
1782     }
1783
1784     my $pid = processexists($pidfile);
1785     if($pid > 0) {
1786         stopserver($server, "$pid");
1787     }
1788     unlink($pidfile) if(-f $pidfile);
1789
1790     $srvrname = servername_str($proto, $ipvnum, $idnum);
1791
1792     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1793
1794     $flags .= "--verbose " if($debugprotocol);
1795     $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1796     $flags .= "--id $idnum " if($idnum > 1);
1797     $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\"";
1798
1799     my $cmd = "$perl $srcdir/rtspserver.pl $flags";
1800     my ($rtsppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1801
1802     if($rtsppid <= 0 || !pidexists($rtsppid)) {
1803         # it is NOT alive
1804         logmsg "RUN: failed to start the $srvrname server\n";
1805         stopserver($server, "$pid2");
1806         displaylogs($testnumcheck);
1807         $doesntrun{$pidfile} = 1;
1808         return (0,0);
1809     }
1810
1811     # Server is up. Verify that we can speak to it.
1812     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1813     if(!$pid3) {
1814         logmsg "RUN: $srvrname server failed verification\n";
1815         # failed to talk to it properly. Kill the server and return failure
1816         stopserver($server, "$rtsppid $pid2");
1817         displaylogs($testnumcheck);
1818         $doesntrun{$pidfile} = 1;
1819         return (0,0);
1820     }
1821     $pid2 = $pid3;
1822
1823     if($verbose) {
1824         logmsg "RUN: $srvrname server is now running PID $rtsppid\n";
1825     }
1826
1827     sleep(1);
1828
1829     return ($rtsppid, $pid2);
1830 }
1831
1832
1833 #######################################################################
1834 # Start the ssh (scp/sftp) server
1835 #
1836 sub runsshserver {
1837     my ($id, $verbose, $ipv6) = @_;
1838     my $ip=$HOSTIP;
1839     my $port = $SSHPORT;
1840     my $socksport = $SOCKSPORT;
1841     my $proto = 'ssh';
1842     my $ipvnum = 4;
1843     my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1844     my $server;
1845     my $srvrname;
1846     my $pidfile;
1847     my $logfile;
1848     my $flags = "";
1849
1850     $server = servername_id($proto, $ipvnum, $idnum);
1851
1852     $pidfile = $serverpidfile{$server};
1853
1854     # don't retry if the server doesn't work
1855     if ($doesntrun{$pidfile}) {
1856         return (0,0);
1857     }
1858
1859     my $pid = processexists($pidfile);
1860     if($pid > 0) {
1861         stopserver($server, "$pid");
1862     }
1863     unlink($pidfile) if(-f $pidfile);
1864
1865     $srvrname = servername_str($proto, $ipvnum, $idnum);
1866
1867     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1868
1869     $flags .= "--verbose " if($verbose);
1870     $flags .= "--debugprotocol " if($debugprotocol);
1871     $flags .= "--pidfile \"$pidfile\" ";
1872     $flags .= "--id $idnum " if($idnum > 1);
1873     $flags .= "--ipv$ipvnum --addr \"$ip\" ";
1874     $flags .= "--sshport $port --socksport $socksport ";
1875     $flags .= "--user \"$USER\"";
1876
1877     my $cmd = "$perl $srcdir/sshserver.pl $flags";
1878     my ($sshpid, $pid2) = startnew($cmd, $pidfile, 60, 0);
1879
1880     # on loaded systems sshserver start up can take longer than the timeout
1881     # passed to startnew, when this happens startnew completes without being
1882     # able to read the pidfile and consequently returns a zero pid2 above.
1883
1884     if($sshpid <= 0 || !pidexists($sshpid)) {
1885         # it is NOT alive
1886         logmsg "RUN: failed to start the $srvrname server\n";
1887         stopserver($server, "$pid2");
1888         $doesntrun{$pidfile} = 1;
1889         return (0,0);
1890     }
1891
1892     # ssh server verification allows some extra time for the server to start up
1893     # and gives us the opportunity of recovering the pid from the pidfile, when
1894     # this verification succeeds the recovered pid is assigned to pid2.
1895
1896     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1897     if(!$pid3) {
1898         logmsg "RUN: $srvrname server failed verification\n";
1899         # failed to fetch server pid. Kill the server and return failure
1900         stopserver($server, "$sshpid $pid2");
1901         $doesntrun{$pidfile} = 1;
1902         return (0,0);
1903     }
1904     $pid2 = $pid3;
1905
1906     # once it is known that the ssh server is alive, sftp server verification
1907     # is performed actually connecting to it, authenticating and performing a
1908     # very simple remote command.  This verification is tried only one time.
1909
1910     $sshdlog = server_logfilename($LOGDIR, 'ssh', $ipvnum, $idnum);
1911     $sftplog = server_logfilename($LOGDIR, 'sftp', $ipvnum, $idnum);
1912
1913     if(verifysftp('sftp', $ipvnum, $idnum, $ip, $port) < 1) {
1914         logmsg "RUN: SFTP server failed verification\n";
1915         # failed to talk to it properly. Kill the server and return failure
1916         display_sftplog();
1917         display_sftpconfig();
1918         display_sshdlog();
1919         display_sshdconfig();
1920         stopserver($server, "$sshpid $pid2");
1921         $doesntrun{$pidfile} = 1;
1922         return (0,0);
1923     }
1924
1925     if($verbose) {
1926         logmsg "RUN: $srvrname server is now running PID $pid2\n";
1927     }
1928
1929     return ($pid2, $sshpid);
1930 }
1931
1932 #######################################################################
1933 # Start the socks server
1934 #
1935 sub runsocksserver {
1936     my ($id, $verbose, $ipv6) = @_;
1937     my $ip=$HOSTIP;
1938     my $port = $SOCKSPORT;
1939     my $proto = 'socks';
1940     my $ipvnum = 4;
1941     my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1942     my $server;
1943     my $srvrname;
1944     my $pidfile;
1945     my $logfile;
1946     my $flags = "";
1947
1948     $server = servername_id($proto, $ipvnum, $idnum);
1949
1950     $pidfile = $serverpidfile{$server};
1951
1952     # don't retry if the server doesn't work
1953     if ($doesntrun{$pidfile}) {
1954         return (0,0);
1955     }
1956
1957     my $pid = processexists($pidfile);
1958     if($pid > 0) {
1959         stopserver($server, "$pid");
1960     }
1961     unlink($pidfile) if(-f $pidfile);
1962
1963     $srvrname = servername_str($proto, $ipvnum, $idnum);
1964
1965     $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1966
1967     # The ssh server must be already running
1968     if(!$run{'ssh'}) {
1969         logmsg "RUN: SOCKS server cannot find running SSH server\n";
1970         $doesntrun{$pidfile} = 1;
1971         return (0,0);
1972     }
1973
1974     # Find out ssh daemon canonical file name
1975     my $sshd = find_sshd();
1976     if(!$sshd) {
1977         logmsg "RUN: SOCKS server cannot find $sshdexe\n";
1978         $doesntrun{$pidfile} = 1;
1979         return (0,0);
1980     }
1981
1982     # Find out ssh daemon version info
1983     ($sshdid, $sshdvernum, $sshdverstr, $sshderror) = sshversioninfo($sshd);
1984     if(!$sshdid) {
1985         # Not an OpenSSH or SunSSH ssh daemon
1986         logmsg "$sshderror\n" if($verbose);
1987         logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
1988         $doesntrun{$pidfile} = 1;
1989         return (0,0);
1990     }
1991     logmsg "ssh server found $sshd is $sshdverstr\n" if($verbose);
1992
1993     # Find out ssh client canonical file name
1994     my $ssh = find_ssh();
1995     if(!$ssh) {
1996         logmsg "RUN: SOCKS server cannot find $sshexe\n";
1997         $doesntrun{$pidfile} = 1;
1998         return (0,0);
1999     }
2000
2001     # Find out ssh client version info
2002     my ($sshid, $sshvernum, $sshverstr, $ssherror) = sshversioninfo($ssh);
2003     if(!$sshid) {
2004         # Not an OpenSSH or SunSSH ssh client
2005         logmsg "$ssherror\n" if($verbose);
2006         logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2007         $doesntrun{$pidfile} = 1;
2008         return (0,0);
2009     }
2010
2011     # Verify minimum ssh client version
2012     if((($sshid =~ /OpenSSH/) && ($sshvernum < 299)) ||
2013        (($sshid =~ /SunSSH/)  && ($sshvernum < 100))) {
2014         logmsg "ssh client found $ssh is $sshverstr\n";
2015         logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2016         $doesntrun{$pidfile} = 1;
2017         return (0,0);
2018     }
2019     logmsg "ssh client found $ssh is $sshverstr\n" if($verbose);
2020
2021     # Verify if ssh client and ssh daemon versions match
2022     if(($sshdid ne $sshid) || ($sshdvernum != $sshvernum)) {
2023         # Our test harness might work with slightly mismatched versions
2024         logmsg "Warning: version mismatch: sshd $sshdverstr - ssh $sshverstr\n"
2025             if($verbose);
2026     }
2027
2028     # Config file options for ssh client are previously set from sshserver.pl
2029     if(! -e $sshconfig) {
2030         logmsg "RUN: SOCKS server cannot find $sshconfig\n";
2031         $doesntrun{$pidfile} = 1;
2032         return (0,0);
2033     }
2034
2035     $sshlog  = server_logfilename($LOGDIR, 'socks', $ipvnum, $idnum);
2036
2037     # start our socks server
2038     my $cmd="$ssh -N -F $sshconfig $ip > $sshlog 2>&1";
2039     my ($sshpid, $pid2) = startnew($cmd, $pidfile, 30, 1); # fake pidfile
2040
2041     if($sshpid <= 0 || !pidexists($sshpid)) {
2042         # it is NOT alive
2043         logmsg "RUN: failed to start the $srvrname server\n";
2044         display_sshlog();
2045         display_sshconfig();
2046         display_sshdlog();
2047         display_sshdconfig();
2048         stopserver($server, "$pid2");
2049         $doesntrun{$pidfile} = 1;
2050         return (0,0);
2051     }
2052
2053     # Ugly hack but ssh doesn't support pid files. PID is from fake pidfile.
2054     my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
2055     if(!$pid3) {
2056         logmsg "RUN: $srvrname server failed verification\n";
2057         # failed to talk to it properly. Kill the server and return failure
2058         stopserver($server, "$sshpid $pid2");
2059         $doesntrun{$pidfile} = 1;
2060         return (0,0);
2061     }
2062     $pid2 = $pid3;
2063
2064     if($verbose) {
2065         logmsg "RUN: $srvrname server is now running PID $pid2\n";
2066     }
2067
2068     return ($pid2, $sshpid);
2069 }
2070
2071 #######################################################################
2072 # Single shot http and gopher server responsiveness test. This should only
2073 # be used to verify that a server present in %run hash is still functional
2074 #
2075 sub responsive_http_server {
2076     my ($proto, $verbose, $alt, $port) = @_;
2077     my $ip = $HOSTIP;
2078     my $ipvnum = 4;
2079     my $idnum = 1;
2080
2081     if($alt eq "ipv6") {
2082         # if IPv6, use a different setup
2083         $ipvnum = 6;
2084         $ip = $HOST6IP;
2085     }
2086     elsif($alt eq "proxy") {
2087         $idnum = 2;
2088     }
2089
2090     return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2091 }
2092
2093 #######################################################################
2094 # Single shot pingpong server responsiveness test. This should only be
2095 # used to verify that a server present in %run hash is still functional
2096 #
2097 sub responsive_pingpong_server {
2098     my ($proto, $id, $verbose, $ipv6) = @_;
2099     my $port;
2100     my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
2101     my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
2102     my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2103
2104     if($proto eq "ftp") {
2105         $port = ($idnum>1)?$FTP2PORT:$FTPPORT;
2106
2107         if($ipvnum==6) {
2108             # if IPv6, use a different setup
2109             $port = $FTP6PORT;
2110         }
2111     }
2112     elsif($proto eq "pop3") {
2113         $port = ($ipvnum==6) ? $POP36PORT : $POP3PORT;
2114     }
2115     elsif($proto eq "imap") {
2116         $port = ($ipvnum==6) ? $IMAP6PORT : $IMAPPORT;
2117     }
2118     elsif($proto eq "smtp") {
2119         $port = ($ipvnum==6) ? $SMTP6PORT : $SMTPPORT;
2120     }
2121     else {
2122         print STDERR "Unsupported protocol $proto!!\n";
2123         return 0;
2124     }
2125
2126     return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2127 }
2128
2129 #######################################################################
2130 # Single shot rtsp server responsiveness test. This should only be
2131 # used to verify that a server present in %run hash is still functional
2132 #
2133 sub responsive_rtsp_server {
2134     my ($verbose, $ipv6) = @_;
2135     my $port = $RTSPPORT;
2136     my $ip = $HOSTIP;
2137     my $proto = 'rtsp';
2138     my $ipvnum = 4;
2139     my $idnum = 1;
2140
2141     if($ipv6) {
2142         # if IPv6, use a different setup
2143         $ipvnum = 6;
2144         $port = $RTSP6PORT;
2145         $ip = $HOST6IP;
2146     }
2147
2148     return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2149 }
2150
2151 #######################################################################
2152 # Single shot tftp server responsiveness test. This should only be
2153 # used to verify that a server present in %run hash is still functional
2154 #
2155 sub responsive_tftp_server {
2156     my ($id, $verbose, $ipv6) = @_;
2157     my $port = $TFTPPORT;
2158     my $ip = $HOSTIP;
2159     my $proto = 'tftp';
2160     my $ipvnum = 4;
2161     my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2162
2163     if($ipv6) {
2164         # if IPv6, use a different setup
2165         $ipvnum = 6;
2166         $port = $TFTP6PORT;
2167         $ip = $HOST6IP;
2168     }
2169
2170     return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2171 }
2172
2173 #######################################################################
2174 # Single shot non-stunnel HTTP TLS extensions capable server
2175 # responsiveness test. This should only be used to verify that a
2176 # server present in %run hash is still functional
2177 #
2178 sub responsive_httptls_server {
2179     my ($verbose, $ipv6) = @_;
2180     my $proto = "httptls";
2181     my $port = ($ipv6 && ($ipv6 =~ /6$/)) ? $HTTPTLS6PORT : $HTTPTLSPORT;
2182     my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
2183     my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
2184     my $idnum = 1;
2185
2186     return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2187 }
2188
2189 #######################################################################
2190 # Remove all files in the specified directory
2191 #
2192 sub cleardir {
2193     my $dir = $_[0];
2194     my $count;
2195     my $file;
2196
2197     # Get all files
2198     opendir(DIR, $dir) ||
2199         return 0; # can't open dir
2200     while($file = readdir(DIR)) {
2201         if($file !~ /^\./) {
2202             unlink("$dir/$file");
2203             $count++;
2204         }
2205     }
2206     closedir DIR;
2207     return $count;
2208 }
2209
2210 #######################################################################
2211 # filter out the specified pattern from the given input file and store the
2212 # results in the given output file
2213 #
2214 sub filteroff {
2215     my $infile=$_[0];
2216     my $filter=$_[1];
2217     my $ofile=$_[2];
2218
2219     open(IN, "<$infile")
2220         || return 1;
2221
2222     open(OUT, ">$ofile")
2223         || return 1;
2224
2225     # logmsg "FILTER: off $filter from $infile to $ofile\n";
2226
2227     while(<IN>) {
2228         $_ =~ s/$filter//;
2229         print OUT $_;
2230     }
2231     close(IN);
2232     close(OUT);
2233     return 0;
2234 }
2235
2236 #######################################################################
2237 # compare test results with the expected output, we might filter off
2238 # some pattern that is allowed to differ, output test results
2239 #
2240 sub compare {
2241     # filter off patterns _before_ this comparison!
2242     my ($testnum, $testname, $subject, $firstref, $secondref)=@_;
2243
2244     my $result = compareparts($firstref, $secondref);
2245
2246     if($result) {
2247         # timestamp test result verification end
2248         $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
2249
2250         if(!$short) {
2251             logmsg "\n $testnum: $subject FAILED:\n";
2252             logmsg showdiff($LOGDIR, $firstref, $secondref);
2253         }
2254         elsif(!$automakestyle) {
2255             logmsg "FAILED\n";
2256         }
2257         else {
2258             # automakestyle
2259             logmsg "FAIL: $testnum - $testname - $subject\n";
2260         }
2261     }
2262     return $result;
2263 }
2264
2265 #######################################################################
2266 # display information about curl and the host the test suite runs on
2267 #
2268 sub checksystem {
2269
2270     unlink($memdump); # remove this if there was one left
2271
2272     my $feat;
2273     my $curl;
2274     my $libcurl;
2275     my $versretval;
2276     my $versnoexec;
2277     my @version=();
2278
2279     my $curlverout="$LOGDIR/curlverout.log";
2280     my $curlvererr="$LOGDIR/curlvererr.log";
2281     my $versioncmd="$CURL --version 1>$curlverout 2>$curlvererr";
2282
2283     unlink($curlverout);
2284     unlink($curlvererr);
2285
2286     $versretval = runclient($versioncmd);
2287     $versnoexec = $!;
2288
2289     open(VERSOUT, "<$curlverout");
2290     @version = <VERSOUT>;
2291     close(VERSOUT);
2292
2293     $resolver="stock";
2294     for(@version) {
2295         chomp;
2296
2297         if($_ =~ /^curl/) {
2298             $curl = $_;
2299             $curl =~ s/^(.*)(libcurl.*)/$1/g;
2300
2301             $libcurl = $2;
2302             if($curl =~ /mingw32/) {
2303                 # This is a windows minw32 build, we need to translate the
2304                 # given path to the "actual" windows path. The MSYS shell
2305                 # has a builtin 'pwd -W' command which converts the path.
2306                 $pwd = `sh -c "echo \$(pwd -W)"`;
2307                 chomp($pwd);
2308             }
2309             elsif ($curl =~ /win32/) {
2310                # Native Windows builds don't understand the
2311                # output of cygwin's pwd.  It will be
2312                # something like /cygdrive/c/<some path>.
2313                #
2314                # Use the cygpath utility to convert the
2315                # working directory to a Windows friendly
2316                # path.  The -m option converts to use drive
2317                # letter:, but it uses / instead \.  Forward
2318                # slashes (/) are easier for us.  We don't
2319                # have to escape them to get them to curl
2320                # through a shell.
2321                chomp($pwd = `cygpath -m $pwd`);
2322            }
2323            if ($libcurl =~ /winssl/i) {
2324                $has_winssl=1;
2325                $ssllib="WinSSL";
2326            }
2327            elsif ($libcurl =~ /openssl/i) {
2328                $has_openssl=1;
2329                $ssllib="OpenSSL";
2330            }
2331            elsif ($libcurl =~ /gnutls/i) {
2332                $has_gnutls=1;
2333                $ssllib="GnuTLS";
2334            }
2335            elsif ($libcurl =~ /nss/i) {
2336                $has_nss=1;
2337                $ssllib="NSS";
2338            }
2339            elsif ($libcurl =~ /yassl/i) {
2340                $has_yassl=1;
2341                $ssllib="yassl";
2342            }
2343            elsif ($libcurl =~ /polarssl/i) {
2344                $has_polarssl=1;
2345                $ssllib="polarssl";
2346            }
2347            elsif ($libcurl =~ /axtls/i) {
2348                $has_axtls=1;
2349                $ssllib="axTLS";
2350            }
2351            elsif ($libcurl =~ /securetransport/i) {
2352                $has_darwinssl=1;
2353                $ssllib="DarwinSSL";
2354            }
2355            if ($libcurl =~ /ares/i) {
2356                $has_cares=1;
2357                $resolver="c-ares";
2358            }
2359         }
2360         elsif($_ =~ /^Protocols: (.*)/i) {
2361             # these are the protocols compiled in to this libcurl
2362             @protocols = split(' ', lc($1));
2363
2364             # Generate a "proto-ipv6" version of each protocol to match the
2365             # IPv6 <server> name. This works even if IPv6 support isn't
2366             # compiled in because the <features> test will fail.
2367             push @protocols, map($_ . '-ipv6', @protocols);
2368
2369             # 'http-proxy' is used in test cases to do CONNECT through
2370             push @protocols, 'http-proxy';
2371
2372             # 'http-pipe' is the special server for testing pipelining
2373             push @protocols, 'http-pipe';
2374
2375             # 'none' is used in test cases to mean no server
2376             push @protocols, 'none';
2377         }
2378         elsif($_ =~ /^Features: (.*)/i) {
2379             $feat = $1;
2380             if($feat =~ /TrackMemory/i) {
2381                 # built with memory tracking support (--enable-curldebug)
2382                 $has_memory_tracking = 1;
2383             }
2384             if($feat =~ /debug/i) {
2385                 # curl was built with --enable-debug
2386                 $debug_build = 1;
2387             }
2388             if($feat =~ /SSL/i) {
2389                 # ssl enabled
2390                 $ssl_version=1;
2391             }
2392             if($feat =~ /Largefile/i) {
2393                 # large file support
2394                 $large_file=1;
2395             }
2396             if($feat =~ /IDN/i) {
2397                 # IDN support
2398                 $has_idn=1;
2399             }
2400             if($feat =~ /IPv6/i) {
2401                 $has_ipv6 = 1;
2402             }
2403             if($feat =~ /libz/i) {
2404                 $has_libz = 1;
2405             }
2406             if($feat =~ /NTLM/i) {
2407                 # NTLM enabled
2408                 $has_ntlm=1;
2409                 # Use this as a proxy for any cryptographic authentication
2410                 $has_crypto=1;
2411             }
2412             if($feat =~ /NTLM_WB/i) {
2413                 # NTLM delegation to winbind daemon ntlm_auth helper enabled
2414                 $has_ntlm_wb=1;
2415             }
2416             if($feat =~ /SSPI/i) {
2417                 # SSPI enabled
2418                 $has_sspi=1;
2419             }
2420             if($feat =~ /CharConv/i) {
2421                 # CharConv enabled
2422                 $has_charconv=1;
2423             }
2424             if($feat =~ /TLS-SRP/i) {
2425                 # TLS-SRP enabled
2426                 $has_tls_srp=1;
2427             }
2428             if($feat =~ /Metalink/i) {
2429                 # Metalink enabled
2430                 $has_metalink=1;
2431             }
2432             if($feat =~ /AsynchDNS/i) {
2433                 if(!$has_cares) {
2434                     # this means threaded resolver
2435                     $has_threadedres=1;
2436                     $resolver="threaded";
2437                 }
2438             }
2439         }
2440         #
2441         # Test harness currently uses a non-stunnel server in order to
2442         # run HTTP TLS-SRP tests required when curl is built with https
2443         # protocol support and TLS-SRP feature enabled. For convenience
2444         # 'httptls' may be included in the test harness protocols array
2445         # to differentiate this from classic stunnel based 'https' test
2446         # harness server.
2447         #
2448         if($has_tls_srp) {
2449             my $add_httptls;
2450             for(@protocols) {
2451                 if($_ =~ /^https(-ipv6|)$/) {
2452                     $add_httptls=1;
2453                     last;
2454                 }
2455             }
2456             if($add_httptls && (! grep /^httptls$/, @protocols)) {
2457                 push @protocols, 'httptls';
2458                 push @protocols, 'httptls-ipv6';
2459             }
2460         }
2461     }
2462     if(!$curl) {
2463         logmsg "unable to get curl's version, further details are:\n";
2464         logmsg "issued command: \n";
2465         logmsg "$versioncmd \n";
2466         if ($versretval == -1) {
2467             logmsg "command failed with: \n";
2468             logmsg "$versnoexec \n";
2469         }
2470         elsif ($versretval & 127) {
2471             logmsg sprintf("command died with signal %d, and %s coredump.\n",
2472                            ($versretval & 127), ($versretval & 128)?"a":"no");
2473         }
2474         else {
2475             logmsg sprintf("command exited with value %d \n", $versretval >> 8);
2476         }
2477         logmsg "contents of $curlverout: \n";
2478         displaylogcontent("$curlverout");
2479         logmsg "contents of $curlvererr: \n";
2480         displaylogcontent("$curlvererr");
2481         die "couldn't get curl's version";
2482     }
2483
2484     if(-r "../lib/curl_config.h") {
2485         open(CONF, "<../lib/curl_config.h");
2486         while(<CONF>) {
2487             if($_ =~ /^\#define HAVE_GETRLIMIT/) {
2488                 $has_getrlimit = 1;
2489             }
2490         }
2491         close(CONF);
2492     }
2493
2494     if($has_ipv6) {
2495         # client has ipv6 support
2496
2497         # check if the HTTP server has it!
2498         my @sws = `server/sws --version`;
2499         if($sws[0] =~ /IPv6/) {
2500             # HTTP server has ipv6 support!
2501             $http_ipv6 = 1;
2502             $gopher_ipv6 = 1;
2503         }
2504
2505         # check if the FTP server has it!
2506         @sws = `server/sockfilt --version`;
2507         if($sws[0] =~ /IPv6/) {
2508             # FTP server has ipv6 support!
2509             $ftp_ipv6 = 1;
2510         }
2511     }
2512
2513     if(!$has_memory_tracking && $torture) {
2514         die "can't run torture tests since curl was built without ".
2515             "TrackMemory feature (--enable-curldebug)";
2516     }
2517
2518     $has_shared = `sh $CURLCONFIG --built-shared`;
2519     chomp $has_shared;
2520
2521     my $hostname=join(' ', runclientoutput("hostname"));
2522     my $hosttype=join(' ', runclientoutput("uname -a"));
2523
2524     logmsg ("********* System characteristics ******** \n",
2525     "* $curl\n",
2526     "* $libcurl\n",
2527     "* Features: $feat\n",
2528     "* Host: $hostname",
2529     "* System: $hosttype");
2530
2531     if($has_memory_tracking && $has_threadedres) {
2532         $has_memory_tracking = 0;
2533         logmsg("*\n",
2534                "*** DISABLES memory tracking when using threaded resolver\n",
2535                "*\n");
2536     }
2537
2538     logmsg sprintf("* Server SSL:   %8s", $stunnel?"ON ":"OFF");
2539     logmsg sprintf("  libcurl SSL:  %s\n", $ssl_version?"ON ":"OFF");
2540     logmsg sprintf("* debug build:  %8s", $debug_build?"ON ":"OFF");
2541     logmsg sprintf("  track memory: %s\n", $has_memory_tracking?"ON ":"OFF");
2542     logmsg sprintf("* valgrind:     %8s", $valgrind?"ON ":"OFF");
2543     logmsg sprintf("  HTTP IPv6     %s\n", $http_ipv6?"ON ":"OFF");
2544     logmsg sprintf("* FTP IPv6      %8s", $ftp_ipv6?"ON ":"OFF");
2545     logmsg sprintf("  Libtool lib:  %s\n", $libtool?"ON ":"OFF");
2546     logmsg sprintf("* Shared build:      %-3s", $has_shared);
2547     logmsg sprintf("  Resolver:     %s\n", $resolver);
2548     if($ssl_version) {
2549         logmsg sprintf("* SSL library: %13s\n", $ssllib);
2550     }
2551
2552     logmsg "* Ports:\n";
2553
2554     logmsg sprintf("*   HTTP/%d ", $HTTPPORT);
2555     logmsg sprintf("FTP/%d ", $FTPPORT);
2556     logmsg sprintf("FTP2/%d ", $FTP2PORT);
2557     logmsg sprintf("RTSP/%d ", $RTSPPORT);
2558     if($stunnel) {
2559         logmsg sprintf("FTPS/%d ", $FTPSPORT);
2560         logmsg sprintf("HTTPS/%d ", $HTTPSPORT);
2561     }
2562     logmsg sprintf("\n*   TFTP/%d ", $TFTPPORT);
2563     if($http_ipv6) {
2564         logmsg sprintf("HTTP-IPv6/%d ", $HTTP6PORT);
2565         logmsg sprintf("RTSP-IPv6/%d ", $RTSP6PORT);
2566     }
2567     if($ftp_ipv6) {
2568         logmsg sprintf("FTP-IPv6/%d ", $FTP6PORT);
2569     }
2570     if($tftp_ipv6) {
2571         logmsg sprintf("TFTP-IPv6/%d ", $TFTP6PORT);
2572     }
2573     logmsg sprintf("\n*   GOPHER/%d ", $GOPHERPORT);
2574     if($gopher_ipv6) {
2575         logmsg sprintf("GOPHER-IPv6/%d", $GOPHERPORT);
2576     }
2577     logmsg sprintf("\n*   SSH/%d ", $SSHPORT);
2578     logmsg sprintf("SOCKS/%d ", $SOCKSPORT);
2579     logmsg sprintf("POP3/%d ", $POP3PORT);
2580     logmsg sprintf("IMAP/%d ", $IMAPPORT);
2581     logmsg sprintf("SMTP/%d\n", $SMTPPORT);
2582     if($ftp_ipv6) {
2583         logmsg sprintf("*   POP3-IPv6/%d ", $POP36PORT);
2584         logmsg sprintf("IMAP-IPv6/%d ", $IMAP6PORT);
2585         logmsg sprintf("SMTP-IPv6/%d\n", $SMTP6PORT);
2586     }
2587     if($httptlssrv) {
2588         logmsg sprintf("*   HTTPTLS/%d ", $HTTPTLSPORT);
2589         if($has_ipv6) {
2590             logmsg sprintf("HTTPTLS-IPv6/%d ", $HTTPTLS6PORT);
2591         }
2592         logmsg "\n";
2593     }
2594     logmsg sprintf("*   HTTP-PIPE/%d \n", $HTTPPIPEPORT);
2595
2596     $has_textaware = ($^O eq 'MSWin32') || ($^O eq 'msys');
2597
2598     logmsg "***************************************** \n";
2599 }
2600
2601 #######################################################################
2602 # substitute the variable stuff into either a joined up file or
2603 # a command, in either case passed by reference
2604 #
2605 sub subVariables {
2606   my ($thing) = @_;
2607
2608   # ports
2609
2610   $$thing =~ s/%FTP6PORT/$FTP6PORT/g;
2611   $$thing =~ s/%FTP2PORT/$FTP2PORT/g;
2612   $$thing =~ s/%FTPSPORT/$FTPSPORT/g;
2613   $$thing =~ s/%FTPPORT/$FTPPORT/g;
2614
2615   $$thing =~ s/%GOPHER6PORT/$GOPHER6PORT/g;
2616   $$thing =~ s/%GOPHERPORT/$GOPHERPORT/g;
2617
2618   $$thing =~ s/%HTTPTLS6PORT/$HTTPTLS6PORT/g;
2619   $$thing =~ s/%HTTPTLSPORT/$HTTPTLSPORT/g;
2620   $$thing =~ s/%HTTP6PORT/$HTTP6PORT/g;
2621   $$thing =~ s/%HTTPSPORT/$HTTPSPORT/g;
2622   $$thing =~ s/%HTTPPORT/$HTTPPORT/g;
2623   $$thing =~ s/%HTTPPIPEPORT/$HTTPPIPEPORT/g;
2624   $$thing =~ s/%PROXYPORT/$HTTPPROXYPORT/g;
2625
2626   $$thing =~ s/%IMAP6PORT/$IMAP6PORT/g;
2627   $$thing =~ s/%IMAPPORT/$IMAPPORT/g;
2628
2629   $$thing =~ s/%POP36PORT/$POP36PORT/g;
2630   $$thing =~ s/%POP3PORT/$POP3PORT/g;
2631
2632   $$thing =~ s/%RTSP6PORT/$RTSP6PORT/g;
2633   $$thing =~ s/%RTSPPORT/$RTSPPORT/g;
2634
2635   $$thing =~ s/%SMTP6PORT/$SMTP6PORT/g;
2636   $$thing =~ s/%SMTPPORT/$SMTPPORT/g;
2637
2638   $$thing =~ s/%SOCKSPORT/$SOCKSPORT/g;
2639   $$thing =~ s/%SSHPORT/$SSHPORT/g;
2640
2641   $$thing =~ s/%TFTP6PORT/$TFTP6PORT/g;
2642   $$thing =~ s/%TFTPPORT/$TFTPPORT/g;
2643
2644   # client IP addresses
2645
2646   $$thing =~ s/%CLIENT6IP/$CLIENT6IP/g;
2647   $$thing =~ s/%CLIENTIP/$CLIENTIP/g;
2648
2649   # server IP addresses
2650
2651   $$thing =~ s/%HOST6IP/$HOST6IP/g;
2652   $$thing =~ s/%HOSTIP/$HOSTIP/g;
2653
2654   # misc
2655
2656   $$thing =~ s/%CURL/$CURL/g;
2657   $$thing =~ s/%PWD/$pwd/g;
2658   $$thing =~ s/%SRCDIR/$srcdir/g;
2659   $$thing =~ s/%USER/$USER/g;
2660
2661   # The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be
2662   # used for time-out tests and that whould work on most hosts as these
2663   # adjust for the startup/check time for this particular host. We needed
2664   # to do this to make the test suite run better on very slow hosts.
2665
2666   my $ftp2 = $ftpchecktime * 2;
2667   my $ftp3 = $ftpchecktime * 3;
2668
2669   $$thing =~ s/%FTPTIME2/$ftp2/g;
2670   $$thing =~ s/%FTPTIME3/$ftp3/g;
2671 }
2672
2673 sub fixarray {
2674     my @in = @_;
2675
2676     for(@in) {
2677         subVariables \$_;
2678     }
2679     return @in;
2680 }
2681
2682 #######################################################################
2683 # Provide time stamps for single test skipped events
2684 #
2685 sub timestampskippedevents {
2686     my $testnum = $_[0];
2687
2688     return if((not defined($testnum)) || ($testnum < 1));
2689
2690     if($timestats) {
2691
2692         if($timevrfyend{$testnum}) {
2693             return;
2694         }
2695         elsif($timesrvrlog{$testnum}) {
2696             $timevrfyend{$testnum} = $timesrvrlog{$testnum};
2697             return;
2698         }
2699         elsif($timetoolend{$testnum}) {
2700             $timevrfyend{$testnum} = $timetoolend{$testnum};
2701             $timesrvrlog{$testnum} = $timetoolend{$testnum};
2702         }
2703         elsif($timetoolini{$testnum}) {
2704             $timevrfyend{$testnum} = $timetoolini{$testnum};
2705             $timesrvrlog{$testnum} = $timetoolini{$testnum};
2706             $timetoolend{$testnum} = $timetoolini{$testnum};
2707         }
2708         elsif($timesrvrend{$testnum}) {
2709             $timevrfyend{$testnum} = $timesrvrend{$testnum};
2710             $timesrvrlog{$testnum} = $timesrvrend{$testnum};
2711             $timetoolend{$testnum} = $timesrvrend{$testnum};
2712             $timetoolini{$testnum} = $timesrvrend{$testnum};
2713         }
2714         elsif($timesrvrini{$testnum}) {
2715             $timevrfyend{$testnum} = $timesrvrini{$testnum};
2716             $timesrvrlog{$testnum} = $timesrvrini{$testnum};
2717             $timetoolend{$testnum} = $timesrvrini{$testnum};
2718             $timetoolini{$testnum} = $timesrvrini{$testnum};
2719             $timesrvrend{$testnum} = $timesrvrini{$testnum};
2720         }
2721         elsif($timeprepini{$testnum}) {
2722             $timevrfyend{$testnum} = $timeprepini{$testnum};
2723             $timesrvrlog{$testnum} = $timeprepini{$testnum};
2724             $timetoolend{$testnum} = $timeprepini{$testnum};
2725             $timetoolini{$testnum} = $timeprepini{$testnum};
2726             $timesrvrend{$testnum} = $timeprepini{$testnum};
2727             $timesrvrini{$testnum} = $timeprepini{$testnum};
2728         }
2729     }
2730 }
2731
2732 #######################################################################
2733 # Run a single specified test case
2734 #
2735 sub singletest {
2736     my ($evbased, # 1 means switch on if possible (and "curl" is tested)
2737                   # returns "not a test" if it can't be used for this test
2738         $testnum,
2739         $count,
2740         $total)=@_;
2741
2742     my @what;
2743     my $why;
2744     my %feature;
2745     my $cmd;
2746     my $disablevalgrind;
2747
2748     # copy test number to a global scope var, this allows
2749     # testnum checking when starting test harness servers.
2750     $testnumcheck = $testnum;
2751
2752     # timestamp test preparation start
2753     $timeprepini{$testnum} = Time::HiRes::time() if($timestats);
2754
2755     if($disttests !~ /test$testnum\W/ ) {
2756         logmsg "Warning: test$testnum not present in tests/data/Makefile.am\n";
2757     }
2758     if($disabled{$testnum}) {
2759         logmsg "Warning: test$testnum is explicitly disabled\n";
2760     }
2761
2762     # load the test case file definition
2763     if(loadtest("${TESTDIR}/test${testnum}")) {
2764         if($verbose) {
2765             # this is not a test
2766             logmsg "RUN: $testnum doesn't look like a test case\n";
2767         }
2768         $why = "no test";
2769     }
2770     else {
2771         @what = getpart("client", "features");
2772     }
2773
2774     # We require a feature to be present
2775     for(@what) {
2776         my $f = $_;
2777         $f =~ s/\s//g;
2778
2779         if($f =~ /^([^!].*)$/) {
2780             # Store the feature for later
2781             $feature{$1} = $1;
2782
2783             if($1 eq "SSL") {
2784                 if($ssl_version) {
2785                     next;
2786                 }
2787             }
2788             elsif($1 eq "OpenSSL") {
2789                 if($has_openssl) {
2790                     next;
2791                 }
2792             }
2793             elsif($1 eq "GnuTLS") {
2794                 if($has_gnutls) {
2795                     next;
2796                 }
2797             }
2798             elsif($1 eq "NSS") {
2799                 if($has_nss) {
2800                     next;
2801                 }
2802             }
2803             elsif($1 eq "axTLS") {
2804                 if($has_axtls) {
2805                     next;
2806                 }
2807             }
2808             elsif($1 eq "WinSSL") {
2809                 if($has_winssl) {
2810                     next;
2811                 }
2812             }
2813             elsif($1 eq "DarwinSSL") {
2814                 if($has_darwinssl) {
2815                     next;
2816                 }
2817             }
2818             elsif($1 eq "unittest") {
2819                 if($debug_build) {
2820                     next;
2821                 }
2822             }
2823             elsif($1 eq "debug") {
2824                 if($debug_build) {
2825                     next;
2826                 }
2827             }
2828             elsif($1 eq "TrackMemory") {
2829                 if($has_memory_tracking) {
2830                     next;
2831                 }
2832             }
2833             elsif($1 eq "large_file") {
2834                 if($large_file) {
2835                     next;
2836                 }
2837             }
2838             elsif($1 eq "idn") {
2839                 if($has_idn) {
2840                     next;
2841                 }
2842             }
2843             elsif($1 eq "ipv6") {
2844                 if($has_ipv6) {
2845                     next;
2846                 }
2847             }
2848             elsif($1 eq "libz") {
2849                 if($has_libz) {
2850                     next;
2851                 }
2852             }
2853             elsif($1 eq "NTLM") {
2854                 if($has_ntlm) {
2855                     next;
2856                 }
2857             }
2858             elsif($1 eq "NTLM_WB") {
2859                 if($has_ntlm_wb) {
2860                     next;
2861                 }
2862             }
2863             elsif($1 eq "SSPI") {
2864                 if($has_sspi) {
2865                     next;
2866                 }
2867             }
2868             elsif($1 eq "getrlimit") {
2869                 if($has_getrlimit) {
2870                     next;
2871                 }
2872             }
2873             elsif($1 eq "crypto") {
2874                 if($has_crypto) {
2875                     next;
2876                 }
2877             }
2878             elsif($1 eq "TLS-SRP") {
2879                 if($has_tls_srp) {
2880                     next;
2881                 }
2882             }
2883             elsif($1 eq "Metalink") {
2884                 if($has_metalink) {
2885                     next;
2886                 }
2887             }
2888             elsif($1 eq "socks") {
2889                 next;
2890             }
2891             # See if this "feature" is in the list of supported protocols
2892             elsif (grep /^\Q$1\E$/i, @protocols) {
2893                 next;
2894             }
2895
2896             $why = "curl lacks $1 support";
2897             last;
2898         }
2899     }
2900
2901     # We require a feature to not be present
2902     if(!$why) {
2903         for(@what) {
2904             my $f = $_;
2905             $f =~ s/\s//g;
2906
2907             if($f =~ /^!(.*)$/) {
2908                 if($1 eq "SSL") {
2909                     if(!$ssl_version) {
2910                         next;
2911                     }
2912                 }
2913                 elsif($1 eq "OpenSSL") {
2914                     if(!$has_openssl) {
2915                         next;
2916                     }
2917                 }
2918                 elsif($1 eq "GnuTLS") {
2919                     if(!$has_gnutls) {
2920                         next;
2921                     }
2922                 }
2923                 elsif($1 eq "NSS") {
2924                     if(!$has_nss) {
2925                         next;
2926                     }
2927                 }
2928                 elsif($1 eq "axTLS") {
2929                     if(!$has_axtls) {
2930                         next;
2931                     }
2932                 }
2933                 elsif($1 eq "WinSSL") {
2934                     if(!$has_winssl) {
2935                         next;
2936                     }
2937                 }
2938                 elsif($1 eq "DarwinSSL") {
2939                     if(!$has_darwinssl) {
2940                         next;
2941                     }
2942                 }
2943                 elsif($1 eq "TrackMemory") {
2944                     if(!$has_memory_tracking) {
2945                         next;
2946                     }
2947                 }
2948                 elsif($1 eq "large_file") {
2949                     if(!$large_file) {
2950                         next;
2951                     }
2952                 }
2953                 elsif($1 eq "idn") {
2954                     if(!$has_idn) {
2955                         next;
2956                     }
2957                 }
2958                 elsif($1 eq "ipv6") {
2959                     if(!$has_ipv6) {
2960                         next;
2961                     }
2962                 }
2963                 elsif($1 eq "libz") {
2964                     if(!$has_libz) {
2965                         next;
2966                     }
2967                 }
2968                 elsif($1 eq "NTLM") {
2969                     if(!$has_ntlm) {
2970                         next;
2971                     }
2972                 }
2973                 elsif($1 eq "NTLM_WB") {
2974                     if(!$has_ntlm_wb) {
2975                         next;
2976                     }
2977                 }
2978                 elsif($1 eq "SSPI") {
2979                     if(!$has_sspi) {
2980                         next;
2981                     }
2982                 }
2983                 elsif($1 eq "getrlimit") {
2984                     if(!$has_getrlimit) {
2985                         next;
2986                     }
2987                 }
2988                 elsif($1 eq "crypto") {
2989                     if(!$has_crypto) {
2990                         next;
2991                     }
2992                 }
2993                 elsif($1 eq "TLS-SRP") {
2994                     if(!$has_tls_srp) {
2995                         next;
2996                     }
2997                 }
2998                 elsif($1 eq "Metalink") {
2999                     if(!$has_metalink) {
3000                         next;
3001                     }
3002                 }
3003                 else {
3004                     next;
3005                 }
3006             }
3007             else {
3008                 next;
3009             }
3010
3011             $why = "curl has $1 support";
3012             last;
3013         }
3014     }
3015
3016     if(!$why) {
3017         my @keywords = getpart("info", "keywords");
3018         my $match;
3019         my $k;
3020
3021         if(!$keywords[0]) {
3022             $why = "missing the <keywords> section!";
3023         }
3024
3025         for $k (@keywords) {
3026             chomp $k;
3027             if ($disabled_keywords{$k}) {
3028                 $why = "disabled by keyword";
3029             } elsif ($enabled_keywords{$k}) {
3030                 $match = 1;
3031             }
3032         }
3033
3034         if(!$why && !$match && %enabled_keywords) {
3035             $why = "disabled by missing keyword";
3036         }
3037     }
3038
3039     # test definition may instruct to (un)set environment vars
3040     # this is done this early, so that the precheck can use environment
3041     # variables and still bail out fine on errors
3042
3043     # restore environment variables that were modified in a previous run
3044     foreach my $var (keys %oldenv) {
3045         if($oldenv{$var} eq 'notset') {
3046             delete $ENV{$var} if($ENV{$var});
3047         }
3048         else {
3049             $ENV{$var} = $oldenv{$var};
3050         }
3051         delete $oldenv{$var};
3052     }
3053
3054     # remove test server commands file before servers are started/verified
3055     unlink($FTPDCMD) if(-f $FTPDCMD);
3056
3057     # timestamp required servers verification start
3058     $timesrvrini{$testnum} = Time::HiRes::time() if($timestats);
3059
3060     if(!$why) {
3061         $why = serverfortest($testnum);
3062     }
3063
3064     # timestamp required servers verification end
3065     $timesrvrend{$testnum} = Time::HiRes::time() if($timestats);
3066
3067     my @setenv = getpart("client", "setenv");
3068     if(@setenv) {
3069         foreach my $s (@setenv) {
3070             chomp $s;
3071             subVariables \$s;
3072             if($s =~ /([^=]*)=(.*)/) {
3073                 my ($var, $content) = ($1, $2);
3074                 # remember current setting, to restore it once test runs
3075                 $oldenv{$var} = ($ENV{$var})?"$ENV{$var}":'notset';
3076                 # set new value
3077                 if(!$content) {
3078                     delete $ENV{$var} if($ENV{$var});
3079                 }
3080                 else {
3081                     if($var =~ /^LD_PRELOAD/) {
3082                         if(exe_ext() && (exe_ext() eq '.exe')) {
3083                             # print "Skipping LD_PRELOAD due to lack of OS support\n";
3084                             next;
3085                         }
3086                         if($debug_build || ($has_shared ne "yes")) {
3087                             # print "Skipping LD_PRELOAD due to no release shared build\n";
3088                             next;
3089                         }
3090                     }
3091                     $ENV{$var} = "$content";
3092                 }
3093             }
3094         }
3095     }
3096
3097     if(!$why) {
3098         # TODO:
3099         # Add a precheck cache. If a precheck command was already invoked
3100         # exactly like this, then use the previous result to speed up
3101         # successive test invokes!
3102
3103         my @precheck = getpart("client", "precheck");
3104         if(@precheck) {
3105             $cmd = $precheck[0];
3106             chomp $cmd;
3107             subVariables \$cmd;
3108             if($cmd) {
3109                 my @p = split(/ /, $cmd);
3110                 if($p[0] !~ /\//) {
3111                     # the first word, the command, does not contain a slash so
3112                     # we will scan the "improved" PATH to find the command to
3113                     # be able to run it
3114                     my $fullp = checktestcmd($p[0]);
3115
3116                     if($fullp) {
3117                         $p[0] = $fullp;
3118                     }
3119                     $cmd = join(" ", @p);
3120                 }
3121
3122                 my @o = `$cmd 2>/dev/null`;
3123                 if($o[0]) {
3124                     $why = $o[0];
3125                     chomp $why;
3126                 } elsif($?) {
3127                     $why = "precheck command error";
3128                 }
3129                 logmsg "prechecked $cmd\n" if($verbose);
3130             }
3131         }
3132     }
3133
3134     if($why && !$listonly) {
3135         # there's a problem, count it as "skipped"
3136         $skipped++;
3137         $skipped{$why}++;
3138         $teststat[$testnum]=$why; # store reason for this test case
3139
3140         if(!$short) {
3141             if($skipped{$why} <= 3) {
3142                 # show only the first three skips for each reason
3143                 logmsg sprintf("test %03d SKIPPED: $why\n", $testnum);
3144             }
3145         }
3146
3147         timestampskippedevents($testnum);
3148         return -1;
3149     }
3150     logmsg sprintf("test %03d...", $testnum) if(!$automakestyle);
3151
3152     # extract the reply data
3153     my @reply = getpart("reply", "data");
3154     my @replycheck = getpart("reply", "datacheck");
3155
3156     my %replyattr = getpartattr("reply", "data");
3157     my %replycheckattr = getpartattr("reply", "datacheck");
3158
3159     if (@replycheck) {
3160         # we use this file instead to check the final output against
3161
3162         if($replycheckattr{'nonewline'}) {
3163             # Yes, we must cut off the final newline from the final line
3164             # of the datacheck
3165             chomp($replycheck[$#replycheck]);
3166         }
3167         if($replycheckattr{'mode'}) {
3168             $replyattr{'mode'} = $replycheckattr{'mode'};
3169         }
3170
3171         @reply=@replycheck;
3172     }
3173
3174     # this is the valid protocol blurb curl should generate
3175     my @protocol= fixarray ( getpart("verify", "protocol") );
3176
3177     # this is the valid protocol blurb curl should generate to a proxy
3178     my @proxyprot = fixarray ( getpart("verify", "proxy") );
3179
3180     # redirected stdout/stderr to these files
3181     $STDOUT="$LOGDIR/stdout$testnum";
3182     $STDERR="$LOGDIR/stderr$testnum";
3183
3184     # if this section exists, we verify that the stdout contained this:
3185     my @validstdout = fixarray ( getpart("verify", "stdout") );
3186
3187     # if this section exists, we verify upload
3188     my @upload = getpart("verify", "upload");
3189
3190     # if this section exists, it might be FTP server instructions:
3191     my @ftpservercmd = getpart("reply", "servercmd");
3192
3193     my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout
3194
3195     # name of the test
3196     my @testname= getpart("client", "name");
3197     my $testname = $testname[0];
3198     $testname =~ s/\n//g;
3199     logmsg "[$testname]\n" if(!$short);
3200
3201     if($listonly) {
3202         timestampskippedevents($testnum);
3203         return 0; # look successful
3204     }
3205
3206     my @codepieces = getpart("client", "tool");
3207
3208     my $tool="";
3209     if(@codepieces) {
3210         $tool = $codepieces[0];
3211         chomp $tool;
3212     }
3213
3214     # remove server output logfile
3215     unlink($SERVERIN);
3216     unlink($SERVER2IN);
3217     unlink($PROXYIN);
3218
3219     if(@ftpservercmd) {
3220         # write the instructions to file
3221         writearray($FTPDCMD, \@ftpservercmd);
3222     }
3223
3224     # get the command line options to use
3225     my @blaha;
3226     ($cmd, @blaha)= getpart("client", "command");
3227
3228     if($cmd) {
3229         # make some nice replace operations
3230         $cmd =~ s/\n//g; # no newlines please
3231         # substitute variables in the command line
3232         subVariables \$cmd;
3233     }
3234     else {
3235         # there was no command given, use something silly
3236         $cmd="-";
3237     }
3238     if($has_memory_tracking) {
3239         unlink($memdump);
3240     }
3241
3242     # create a (possibly-empty) file before starting the test
3243     my @inputfile=getpart("client", "file");
3244     my %fileattr = getpartattr("client", "file");
3245     my $filename=$fileattr{'name'};
3246     if(@inputfile || $filename) {
3247         if(!$filename) {
3248             logmsg "ERROR: section client=>file has no name attribute\n";
3249             timestampskippedevents($testnum);
3250             return -1;
3251         }
3252         my $fileContent = join('', @inputfile);
3253         subVariables \$fileContent;
3254 #        logmsg "DEBUG: writing file " . $filename . "\n";
3255         open(OUTFILE, ">$filename");
3256         binmode OUTFILE; # for crapage systems, use binary
3257         print OUTFILE $fileContent;
3258         close(OUTFILE);
3259     }
3260
3261     my %cmdhash = getpartattr("client", "command");
3262
3263     my $out="";
3264
3265     if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-output/)) {
3266         #We may slap on --output!
3267         if (!@validstdout) {
3268             $out=" --output $CURLOUT ";
3269         }
3270     }
3271
3272     my $serverlogslocktimeout = $defserverlogslocktimeout;
3273     if($cmdhash{'timeout'}) {
3274         # test is allowed to override default server logs lock timeout
3275         if($cmdhash{'timeout'} =~ /(\d+)/) {
3276             $serverlogslocktimeout = $1 if($1 >= 0);
3277         }
3278     }
3279
3280     my $postcommanddelay = $defpostcommanddelay;
3281     if($cmdhash{'delay'}) {
3282         # test is allowed to specify a delay after command is executed
3283         if($cmdhash{'delay'} =~ /(\d+)/) {
3284             $postcommanddelay = $1 if($1 > 0);
3285         }
3286     }
3287
3288     my $CMDLINE;
3289     my $cmdargs;
3290     my $cmdtype = $cmdhash{'type'} || "default";
3291     my $fail_due_event_based = $evbased;
3292     if($cmdtype eq "perl") {
3293         # run the command line prepended with "perl"
3294         $cmdargs ="$cmd";
3295         $CMDLINE = "perl ";
3296         $tool=$CMDLINE;
3297         $disablevalgrind=1;
3298     }
3299     elsif($cmdtype eq "shell") {
3300         # run the command line prepended with "/bin/sh"
3301         $cmdargs ="$cmd";
3302         $CMDLINE = "/bin/sh ";
3303         $tool=$CMDLINE;
3304         $disablevalgrind=1;
3305     }
3306     elsif(!$tool) {
3307         # run curl, add suitable command line options
3308         $cmd = "-1 ".$cmd if(exists $feature{"SSL"} && ($has_axtls));
3309
3310         my $inc="";
3311         if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-include/)) {
3312             $inc = " --include";
3313         }
3314
3315         $cmdargs = "$out$inc ";
3316         $cmdargs .= "--trace-ascii log/trace$testnum ";
3317         $cmdargs .= "--trace-time ";
3318         if($evbased) {
3319             $cmdargs .= "--test-event ";
3320             $fail_due_event_based--;
3321         }
3322         $cmdargs .= $cmd;
3323     }
3324     else {
3325         $cmdargs = " $cmd"; # $cmd is the command line for the test file
3326         $CURLOUT = $STDOUT; # sends received data to stdout
3327
3328         if($tool =~ /^lib/) {
3329             $CMDLINE="$LIBDIR/$tool";
3330         }
3331         elsif($tool =~ /^unit/) {
3332             $CMDLINE="$UNITDIR/$tool";
3333         }
3334
3335         if(! -f $CMDLINE) {
3336             logmsg "The tool set in the test case for this: '$tool' does not exist\n";
3337             timestampskippedevents($testnum);
3338             return -1;
3339         }
3340         $DBGCURL=$CMDLINE;
3341     }
3342
3343     if($gdbthis) {
3344         # gdb is incompatible with valgrind, so disable it when debugging
3345         # Perhaps a better approach would be to run it under valgrind anyway
3346         # with --db-attach=yes or --vgdb=yes.
3347         $disablevalgrind=1;
3348     }
3349
3350     if($fail_due_event_based) {
3351         logmsg "This test cannot run event based\n";
3352         return -1;
3353     }
3354
3355     my @stdintest = getpart("client", "stdin");
3356
3357     if(@stdintest) {
3358         my $stdinfile="$LOGDIR/stdin-for-$testnum";
3359
3360         my %hash = getpartattr("client", "stdin");
3361         if($hash{'nonewline'}) {
3362             # cut off the final newline from the final line of the stdin data
3363             chomp($stdintest[$#stdintest]);
3364         }
3365
3366         writearray($stdinfile, \@stdintest);
3367
3368         $cmdargs .= " <$stdinfile";
3369     }
3370
3371     if(!$tool) {
3372         $CMDLINE="$CURL";
3373     }
3374
3375     my $usevalgrind;
3376     if($valgrind && !$disablevalgrind) {
3377         my @valgrindoption = getpart("verify", "valgrind");
3378         if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) {
3379             $usevalgrind = 1;
3380             my $valgrindcmd = "$valgrind ";
3381             $valgrindcmd .= "$valgrind_tool " if($valgrind_tool);
3382             $valgrindcmd .= "--leak-check=yes ";
3383             $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp ";
3384            # $valgrindcmd .= "--gen-suppressions=all ";
3385             $valgrindcmd .= "--num-callers=16 ";
3386             $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum";
3387             $CMDLINE = "$valgrindcmd $CMDLINE";
3388         }
3389     }
3390
3391     $CMDLINE .= "$cmdargs >$STDOUT 2>$STDERR";
3392
3393     if($verbose) {
3394         logmsg "$CMDLINE\n";
3395     }
3396
3397     print CMDLOG "$CMDLINE\n";
3398
3399     unlink("core");
3400
3401     my $dumped_core;
3402     my $cmdres;
3403
3404     # Apr 2007: precommand isn't being used and could be removed
3405     my @precommand= getpart("client", "precommand");
3406     if($precommand[0]) {
3407         # this is pure perl to eval!
3408         my $code = join("", @precommand);
3409         eval $code;
3410         if($@) {
3411             logmsg "perl: $code\n";
3412             logmsg "precommand: $@";
3413             stopservers($verbose);
3414             timestampskippedevents($testnum);
3415             return -1;
3416         }
3417     }
3418
3419     if($gdbthis) {
3420         my $gdbinit = "$TESTDIR/gdbinit$testnum";
3421         open(GDBCMD, ">$LOGDIR/gdbcmd");
3422         print GDBCMD "set args $cmdargs\n";
3423         print GDBCMD "show args\n";
3424         print GDBCMD "source $gdbinit\n" if -e $gdbinit;
3425         close(GDBCMD);
3426     }
3427
3428     # timestamp starting of test command
3429     $timetoolini{$testnum} = Time::HiRes::time() if($timestats);
3430
3431     # run the command line we built
3432     if ($torture) {
3433         $cmdres = torture($CMDLINE,
3434                        "$gdb --directory libtest $DBGCURL -x $LOGDIR/gdbcmd");
3435     }
3436     elsif($gdbthis) {
3437         my $GDBW = ($gdbxwin) ? "-w" : "";
3438         runclient("$gdb --directory libtest $DBGCURL $GDBW -x $LOGDIR/gdbcmd");
3439         $cmdres=0; # makes it always continue after a debugged run
3440     }
3441     else {
3442         $cmdres = runclient("$CMDLINE");
3443         my $signal_num  = $cmdres & 127;
3444         $dumped_core = $cmdres & 128;
3445
3446         if(!$anyway && ($signal_num || $dumped_core)) {
3447             $cmdres = 1000;
3448         }
3449         else {
3450             $cmdres >>= 8;
3451             $cmdres = (2000 + $signal_num) if($signal_num && !$cmdres);
3452         }
3453     }
3454
3455     # timestamp finishing of test command
3456     $timetoolend{$testnum} = Time::HiRes::time() if($timestats);
3457
3458     if(!$dumped_core) {
3459         if(-r "core") {
3460             # there's core file present now!
3461             $dumped_core = 1;
3462         }
3463     }
3464
3465     if($dumped_core) {
3466         logmsg "core dumped\n";
3467         if(0 && $gdb) {
3468             logmsg "running gdb for post-mortem analysis:\n";
3469             open(GDBCMD, ">$LOGDIR/gdbcmd2");
3470             print GDBCMD "bt\n";
3471             close(GDBCMD);
3472             runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch $DBGCURL core ");
3473      #       unlink("$LOGDIR/gdbcmd2");
3474         }
3475     }
3476
3477     # If a server logs advisor read lock file exists, it is an indication
3478     # that the server has not yet finished writing out all its log files,
3479     # including server request log files used for protocol verification.
3480     # So, if the lock file exists the script waits here a certain amount
3481     # of time until the server removes it, or the given time expires.
3482
3483     if($serverlogslocktimeout) {
3484         my $lockretry = $serverlogslocktimeout * 20;
3485         while((-f $SERVERLOGS_LOCK) && $lockretry--) {
3486             select(undef, undef, undef, 0.05);
3487         }
3488         if(($lockretry < 0) &&
3489            ($serverlogslocktimeout >= $defserverlogslocktimeout)) {
3490             logmsg "Warning: server logs lock timeout ",
3491                    "($serverlogslocktimeout seconds) expired\n";
3492         }
3493     }
3494
3495     # Test harness ssh server does not have this synchronization mechanism,
3496     # this implies that some ssh server based tests might need a small delay
3497     # once that the client command has run to avoid false test failures.
3498     #
3499     # gnutls-serv also lacks this synchronization mechanism, so gnutls-serv
3500     # based tests might need a small delay once that the client command has
3501     # run to avoid false test failures.
3502
3503     sleep($postcommanddelay) if($postcommanddelay);
3504
3505     # timestamp removal of server logs advisor read lock
3506     $timesrvrlog{$testnum} = Time::HiRes::time() if($timestats);
3507
3508     # test definition might instruct to stop some servers
3509     # stop also all servers relative to the given one
3510
3511     my @killtestservers = getpart("client", "killserver");
3512     if(@killtestservers) {
3513         #
3514         # All servers relative to the given one must be stopped also
3515         #
3516         my @killservers;
3517         foreach my $server (@killtestservers) {
3518             chomp $server;
3519             if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|))$/) {
3520                 # given a stunnel ssl server, also kill non-ssl underlying one
3521                 push @killservers, "${1}${2}";
3522             }
3523             elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|))$/) {
3524                 # given a non-ssl server, also kill stunnel piggybacking one
3525                 push @killservers, "${1}s${2}";
3526             }
3527             elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
3528                 # given a socks server, also kill ssh underlying one
3529                 push @killservers, "ssh${2}";
3530             }
3531             elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
3532                 # given a ssh server, also kill socks piggybacking one
3533                 push @killservers, "socks${2}";
3534             }
3535             push @killservers, $server;
3536         }
3537         #
3538         # kill sockfilter processes for pingpong relative servers
3539         #
3540         foreach my $server (@killservers) {
3541             if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
3542                 my $proto  = $1;
3543                 my $idnum  = ($2 && ($2 > 1)) ? $2 : 1;
3544                 my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
3545                 killsockfilters($proto, $ipvnum, $idnum, $verbose);
3546             }
3547         }
3548         #
3549         # kill server relative pids clearing them in %run hash
3550         #
3551         my $pidlist;
3552         foreach my $server (@killservers) {
3553             if($run{$server}) {
3554                 $pidlist .= "$run{$server} ";
3555                 $run{$server} = 0;
3556             }
3557             $runcert{$server} = 0 if($runcert{$server});
3558         }
3559         killpid($verbose, $pidlist);
3560         #
3561         # cleanup server pid files
3562         #
3563         foreach my $server (@killservers) {
3564             my $pidfile = $serverpidfile{$server};
3565             my $pid = processexists($pidfile);
3566             if($pid > 0) {
3567                 logmsg "Warning: $server server unexpectedly alive\n";
3568                 killpid($verbose, $pid);
3569             }
3570             unlink($pidfile) if(-f $pidfile);
3571         }
3572     }
3573
3574     # remove the test server commands file after each test
3575     unlink($FTPDCMD) if(-f $FTPDCMD);
3576
3577     # run the postcheck command
3578     my @postcheck= getpart("client", "postcheck");
3579     if(@postcheck) {
3580         $cmd = $postcheck[0];
3581         chomp $cmd;
3582         subVariables \$cmd;
3583         if($cmd) {
3584             logmsg "postcheck $cmd\n" if($verbose);
3585             my $rc = runclient("$cmd");
3586             # Must run the postcheck command in torture mode in order
3587             # to clean up, but the result can't be relied upon.
3588             if($rc != 0 && !$torture) {
3589                 logmsg " postcheck FAILED\n";
3590                 # timestamp test result verification end
3591                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3592                 return 1;
3593             }
3594         }
3595     }
3596
3597     # restore environment variables that were modified
3598     if(%oldenv) {
3599         foreach my $var (keys %oldenv) {
3600             if($oldenv{$var} eq 'notset') {
3601                 delete $ENV{$var} if($ENV{$var});
3602             }
3603             else {
3604                 $ENV{$var} = "$oldenv{$var}";
3605             }
3606         }
3607     }
3608
3609     # Skip all the verification on torture tests
3610     if ($torture) {
3611         if(!$cmdres && !$keepoutfiles) {
3612             cleardir($LOGDIR);
3613         }
3614         # timestamp test result verification end
3615         $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3616         return $cmdres;
3617     }
3618
3619     my @err = getpart("verify", "errorcode");
3620     my $errorcode = $err[0] || "0";
3621     my $ok="";
3622     my $res;
3623     chomp $errorcode;
3624     if (@validstdout) {
3625         # verify redirected stdout
3626         my @actual = loadarray($STDOUT);
3627
3628         # variable-replace in the stdout we have from the test case file
3629         @validstdout = fixarray(@validstdout);
3630
3631         # get all attributes
3632         my %hash = getpartattr("verify", "stdout");
3633
3634         # get the mode attribute
3635         my $filemode=$hash{'mode'};
3636         if($filemode && ($filemode eq "text") && $has_textaware) {
3637             # text mode when running on windows: fix line endings
3638             map s/\r\n/\n/g, @validstdout;
3639             map s/\n/\r\n/g, @validstdout;
3640         }
3641
3642         if($hash{'nonewline'}) {
3643             # Yes, we must cut off the final newline from the final line
3644             # of the protocol data
3645             chomp($validstdout[$#validstdout]);
3646         }
3647
3648         $res = compare($testnum, $testname, "stdout", \@actual, \@validstdout);
3649         if($res) {
3650             return 1;
3651         }
3652         $ok .= "s";
3653     }
3654     else {
3655         $ok .= "-"; # stdout not checked
3656     }
3657
3658     if(@protocol) {
3659         # Verify the sent request
3660         my @out = loadarray($SERVERIN);
3661
3662         # what to cut off from the live protocol sent by curl
3663         my @strip = getpart("verify", "strip");
3664
3665         my @protstrip=@protocol;
3666
3667         # check if there's any attributes on the verify/protocol section
3668         my %hash = getpartattr("verify", "protocol");
3669
3670         if($hash{'nonewline'}) {
3671             # Yes, we must cut off the final newline from the final line
3672             # of the protocol data
3673             chomp($protstrip[$#protstrip]);
3674         }
3675
3676         for(@strip) {
3677             # strip off all lines that match the patterns from both arrays
3678             chomp $_;
3679             @out = striparray( $_, \@out);
3680             @protstrip= striparray( $_, \@protstrip);
3681         }
3682
3683         # what parts to cut off from the protocol
3684         my @strippart = getpart("verify", "strippart");
3685         my $strip;
3686         for $strip (@strippart) {
3687             chomp $strip;
3688             for(@out) {
3689                 eval $strip;
3690             }
3691         }
3692
3693         $res = compare($testnum, $testname, "protocol", \@out, \@protstrip);
3694         if($res) {
3695             return 1;
3696         }
3697
3698         $ok .= "p";
3699
3700     }
3701     else {
3702         $ok .= "-"; # protocol not checked
3703     }
3704
3705     if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
3706         # verify the received data
3707         my @out = loadarray($CURLOUT);
3708         # get the mode attribute
3709         my $filemode=$replyattr{'mode'};
3710         if($filemode && ($filemode eq "text") && $has_textaware) {
3711             # text mode when running on windows: fix line endings
3712             map s/\r\n/\n/g, @reply;
3713             map s/\n/\r\n/g, @reply;
3714         }
3715
3716         $res = compare($testnum, $testname, "data", \@out, \@reply);
3717         if ($res) {
3718             return 1;
3719         }
3720         $ok .= "d";
3721     }
3722     else {
3723         $ok .= "-"; # data not checked
3724     }
3725
3726     if(@upload) {
3727         # verify uploaded data
3728         my @out = loadarray("$LOGDIR/upload.$testnum");
3729         $res = compare($testnum, $testname, "upload", \@out, \@upload);
3730         if ($res) {
3731             return 1;
3732         }
3733         $ok .= "u";
3734     }
3735     else {
3736         $ok .= "-"; # upload not checked
3737     }
3738
3739     if(@proxyprot) {
3740         # Verify the sent proxy request
3741         my @out = loadarray($PROXYIN);
3742
3743         # what to cut off from the live protocol sent by curl, we use the
3744         # same rules as for <protocol>
3745         my @strip = getpart("verify", "strip");
3746
3747         my @protstrip=@proxyprot;
3748
3749         # check if there's any attributes on the verify/protocol section
3750         my %hash = getpartattr("verify", "proxy");
3751
3752         if($hash{'nonewline'}) {
3753             # Yes, we must cut off the final newline from the final line
3754             # of the protocol data
3755             chomp($protstrip[$#protstrip]);
3756         }
3757
3758         for(@strip) {
3759             # strip off all lines that match the patterns from both arrays
3760             chomp $_;
3761             @out = striparray( $_, \@out);
3762             @protstrip= striparray( $_, \@protstrip);
3763         }
3764
3765         # what parts to cut off from the protocol
3766         my @strippart = getpart("verify", "strippart");
3767         my $strip;
3768         for $strip (@strippart) {
3769             chomp $strip;
3770             for(@out) {
3771                 eval $strip;
3772             }
3773         }
3774
3775         $res = compare($testnum, $testname, "proxy", \@out, \@protstrip);
3776         if($res) {
3777             return 1;
3778         }
3779
3780         $ok .= "P";
3781
3782     }
3783     else {
3784         $ok .= "-"; # protocol not checked
3785     }
3786
3787     my $outputok;
3788     for my $partsuffix (('', '1', '2', '3', '4')) {
3789         my @outfile=getpart("verify", "file".$partsuffix);
3790         if(@outfile || partexists("verify", "file".$partsuffix) ) {
3791             # we're supposed to verify a dynamically generated file!
3792             my %hash = getpartattr("verify", "file".$partsuffix);
3793
3794             my $filename=$hash{'name'};
3795             if(!$filename) {
3796                 logmsg "ERROR: section verify=>file$partsuffix ".
3797                        "has no name attribute\n";
3798                 stopservers($verbose);
3799                 # timestamp test result verification end
3800                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3801                 return -1;
3802             }
3803             my @generated=loadarray($filename);
3804
3805             # what parts to cut off from the file
3806             my @stripfile = getpart("verify", "stripfile".$partsuffix);
3807
3808             my $filemode=$hash{'mode'};
3809             if($filemode && ($filemode eq "text") && $has_textaware) {
3810                 # text mode when running on windows: fix line endings
3811                 map s/\r\n/\n/g, @outfile;
3812                 map s/\n/\r\n/g, @outfile;
3813             }
3814
3815             my $strip;
3816             for $strip (@stripfile) {
3817                 chomp $strip;
3818                 my @newgen;
3819                 for(@generated) {
3820                     eval $strip;
3821                     if($_) {
3822                         push @newgen, $_;
3823                     }
3824                 }
3825                 # this is to get rid of array entries that vanished (zero
3826                 # length) because of replacements
3827                 @generated = @newgen;
3828             }
3829
3830             @outfile = fixarray(@outfile);
3831
3832             $res = compare($testnum, $testname, "output ($filename)",
3833                            \@generated, \@outfile);
3834             if($res) {
3835                 return 1;
3836             }
3837
3838             $outputok = 1; # output checked
3839         }
3840     }
3841     $ok .= ($outputok) ? "o" : "-"; # output checked or not
3842
3843     # accept multiple comma-separated error codes
3844     my @splerr = split(/ *, */, $errorcode);
3845     my $errok;
3846     foreach my $e (@splerr) {
3847         if($e == $cmdres) {
3848             # a fine error code
3849             $errok = 1;
3850             last;
3851         }
3852     }
3853
3854     if($errok) {
3855         $ok .= "e";
3856     }
3857     else {
3858         if(!$short) {
3859             logmsg sprintf("\n%s returned $cmdres, when expecting %s\n",
3860                            (!$tool)?"curl":$tool, $errorcode);
3861         }
3862         logmsg " exit FAILED\n";
3863         # timestamp test result verification end
3864         $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3865         return 1;
3866     }
3867
3868     if($has_memory_tracking) {
3869         if(! -f $memdump) {
3870             logmsg "\n** ALERT! memory tracking with no output file?\n"
3871                 if(!$cmdtype eq "perl");
3872         }
3873         else {
3874             my @memdata=`$memanalyze $memdump`;
3875             my $leak=0;
3876             for(@memdata) {
3877                 if($_ ne "") {
3878                     # well it could be other memory problems as well, but
3879                     # we call it leak for short here
3880                     $leak=1;
3881                 }
3882             }
3883             if($leak) {
3884                 logmsg "\n** MEMORY FAILURE\n";
3885                 logmsg @memdata;
3886                 # timestamp test result verification end
3887                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3888                 return 1;
3889             }
3890             else {
3891                 $ok .= "m";
3892             }
3893         }
3894     }
3895     else {
3896         $ok .= "-"; # memory not checked
3897     }
3898
3899     if($valgrind) {
3900         if($usevalgrind) {
3901             unless(opendir(DIR, "$LOGDIR")) {
3902                 logmsg "ERROR: unable to read $LOGDIR\n";
3903                 # timestamp test result verification end
3904                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3905                 return 1;
3906             }
3907             my @files = readdir(DIR);
3908             closedir(DIR);
3909             my $vgfile;
3910             foreach my $file (@files) {
3911                 if($file =~ /^valgrind$testnum(\..*|)$/) {
3912                     $vgfile = $file;
3913                     last;
3914                 }
3915             }
3916             if(!$vgfile) {
3917                 logmsg "ERROR: valgrind log file missing for test $testnum\n";
3918                 # timestamp test result verification end
3919                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3920                 return 1;
3921             }
3922             my @e = valgrindparse($srcdir, $feature{'SSL'}, "$LOGDIR/$vgfile");
3923             if(@e && $e[0]) {
3924                 if($automakestyle) {
3925                     logmsg "FAIL: $testnum - $testname - valgrind\n";
3926                 }
3927                 else {
3928                     logmsg " valgrind ERROR ";
3929                     logmsg @e;
3930                 }
3931                 # timestamp test result verification end
3932                 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3933                 return 1;
3934             }
3935             $ok .= "v";
3936         }
3937         else {
3938             if(!$short && !$disablevalgrind) {
3939                 logmsg " valgrind SKIPPED\n";
3940             }
3941             $ok .= "-"; # skipped
3942         }
3943     }
3944     else {
3945         $ok .= "-"; # valgrind not checked
3946     }
3947     # add 'E' for event-based
3948     $ok .= $evbased ? "E" : "-";
3949
3950     logmsg "$ok " if(!$short);
3951
3952     my $sofar= time()-$start;
3953     my $esttotal = $sofar/$count * $total;
3954     my $estleft = $esttotal - $sofar;
3955     my $left=sprintf("remaining: %02d:%02d",
3956                      $estleft/60,
3957                      $estleft%60);
3958
3959     if(!$automakestyle) {
3960         logmsg sprintf("OK (%-3d out of %-3d, %s)\n", $count, $total, $left);
3961     }
3962     else {
3963         logmsg "PASS: $testnum - $testname\n";
3964     }
3965
3966     # the test succeeded, remove all log files
3967     if(!$keepoutfiles) {
3968         cleardir($LOGDIR);
3969     }
3970
3971     # timestamp test result verification end
3972     $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3973
3974     return 0;
3975 }
3976
3977 #######################################################################
3978 # Stop all running test servers
3979 #
3980 sub stopservers {
3981     my $verbose = $_[0];
3982     #
3983     # kill sockfilter processes for all pingpong servers
3984     #
3985     killallsockfilters($verbose);
3986     #
3987     # kill all server pids from %run hash clearing them
3988     #
3989     my $pidlist;
3990     foreach my $server (keys %run) {
3991         if($run{$server}) {
3992             if($verbose) {
3993                 my $prev = 0;
3994                 my $pids = $run{$server};
3995                 foreach my $pid (split(' ', $pids)) {
3996                     if($pid != $prev) {
3997                         logmsg sprintf("* kill pid for %s => %d\n",
3998                             $server, $pid);
3999                         $prev = $pid;
4000                     }
4001                 }
4002             }
4003             $pidlist .= "$run{$server} ";
4004             $run{$server} = 0;
4005         }
4006         $runcert{$server} = 0 if($runcert{$server});
4007     }
4008     killpid($verbose, $pidlist);
4009     #
4010     # cleanup all server pid files
4011     #
4012     foreach my $server (keys %serverpidfile) {
4013         my $pidfile = $serverpidfile{$server};
4014         my $pid = processexists($pidfile);
4015         if($pid > 0) {
4016             logmsg "Warning: $server server unexpectedly alive\n";
4017             killpid($verbose, $pid);
4018         }
4019         unlink($pidfile) if(-f $pidfile);
4020     }
4021 }
4022
4023 #######################################################################
4024 # startservers() starts all the named servers
4025 #
4026 # Returns: string with error reason or blank for success
4027 #
4028 sub startservers {
4029     my @what = @_;
4030     my ($pid, $pid2);
4031     for(@what) {
4032         my (@whatlist) = split(/\s+/,$_);
4033         my $what = lc($whatlist[0]);
4034         $what =~ s/[^a-z0-9-]//g;
4035
4036         my $certfile;
4037         if($what =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|))$/) {
4038             $certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem';
4039         }
4040
4041         if(($what eq "pop3") ||
4042            ($what eq "ftp") ||
4043            ($what eq "imap") ||
4044            ($what eq "smtp")) {
4045             if($torture && $run{$what} &&
4046                !responsive_pingpong_server($what, "", $verbose)) {
4047                 stopserver($what);
4048             }
4049             if(!$run{$what}) {
4050                 ($pid, $pid2) = runpingpongserver($what, "", $verbose);
4051                 if($pid <= 0) {
4052                     return "failed starting ". uc($what) ." server";
4053                 }
4054                 printf ("* pid $what => %d %d\n", $pid, $pid2) if($verbose);
4055                 $run{$what}="$pid $pid2";
4056             }
4057         }
4058         elsif($what eq "ftp2") {
4059             if($torture && $run{'ftp2'} &&
4060                !responsive_pingpong_server("ftp", "2", $verbose)) {
4061                 stopserver('ftp2');
4062             }
4063             if(!$run{'ftp2'}) {
4064                 ($pid, $pid2) = runpingpongserver("ftp", "2", $verbose);
4065                 if($pid <= 0) {
4066                     return "failed starting FTP2 server";
4067                 }
4068                 printf ("* pid ftp2 => %d %d\n", $pid, $pid2) if($verbose);
4069                 $run{'ftp2'}="$pid $pid2";
4070             }
4071         }
4072         elsif($what eq "ftp-ipv6") {
4073             if($torture && $run{'ftp-ipv6'} &&
4074                !responsive_pingpong_server("ftp", "", $verbose, "ipv6")) {
4075                 stopserver('ftp-ipv6');
4076             }
4077             if(!$run{'ftp-ipv6'}) {
4078                 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose, "ipv6");
4079                 if($pid <= 0) {
4080                     return "failed starting FTP-IPv6 server";
4081                 }
4082                 logmsg sprintf("* pid ftp-ipv6 => %d %d\n", $pid,
4083                        $pid2) if($verbose);
4084                 $run{'ftp-ipv6'}="$pid $pid2";
4085             }
4086         }
4087         elsif($what eq "gopher") {
4088             if($torture && $run{'gopher'} &&
4089                !responsive_http_server("gopher", $verbose, 0, $GOPHERPORT)) {
4090                 stopserver('gopher');
4091             }
4092             if(!$run{'gopher'}) {
4093                 ($pid, $pid2) = runhttpserver("gopher", $verbose, 0,
4094                                               $GOPHERPORT);
4095                 if($pid <= 0) {
4096                     return "failed starting GOPHER server";
4097                 }
4098                 logmsg sprintf ("* pid gopher => %d %d\n", $pid, $pid2)
4099                     if($verbose);
4100                 $run{'gopher'}="$pid $pid2";
4101             }
4102         }
4103         elsif($what eq "gopher-ipv6") {
4104             if($torture && $run{'gopher-ipv6'} &&
4105                !responsive_http_server("gopher", $verbose, "ipv6",
4106                                        $GOPHER6PORT)) {
4107                 stopserver('gopher-ipv6');
4108             }
4109             if(!$run{'gopher-ipv6'}) {
4110                 ($pid, $pid2) = runhttpserver("gopher", $verbose, "ipv6",
4111                                               $GOPHER6PORT);
4112                 if($pid <= 0) {
4113                     return "failed starting GOPHER-IPv6 server";
4114                 }
4115                 logmsg sprintf("* pid gopher-ipv6 => %d %d\n", $pid,
4116                                $pid2) if($verbose);
4117                 $run{'gopher-ipv6'}="$pid $pid2";
4118             }
4119         }
4120         elsif($what eq "http") {
4121             if($torture && $run{'http'} &&
4122                !responsive_http_server("http", $verbose, 0, $HTTPPORT)) {
4123                 stopserver('http');
4124             }
4125             if(!$run{'http'}) {
4126                 ($pid, $pid2) = runhttpserver("http", $verbose, 0,
4127                                               $HTTPPORT);
4128                 if($pid <= 0) {
4129                     return "failed starting HTTP server";
4130                 }
4131                 logmsg sprintf ("* pid http => %d %d\n", $pid, $pid2)
4132                     if($verbose);
4133                 $run{'http'}="$pid $pid2";
4134             }
4135         }
4136         elsif($what eq "http-proxy") {
4137             if($torture && $run{'http-proxy'} &&
4138                !responsive_http_server("http", $verbose, "proxy",
4139                                        $HTTPPROXYPORT)) {
4140                 stopserver('http-proxy');
4141             }
4142             if(!$run{'http-proxy'}) {
4143                 ($pid, $pid2) = runhttpserver("http", $verbose, "proxy",
4144                                               $HTTPPROXYPORT);
4145                 if($pid <= 0) {
4146                     return "failed starting HTTP-proxy server";
4147                 }
4148                 logmsg sprintf ("* pid http-proxy => %d %d\n", $pid, $pid2)
4149                     if($verbose);
4150                 $run{'http-proxy'}="$pid $pid2";
4151             }
4152         }
4153         elsif($what eq "http-ipv6") {
4154             if($torture && $run{'http-ipv6'} &&
4155                !responsive_http_server("http", $verbose, "IPv6", $HTTP6PORT)) {
4156                 stopserver('http-ipv6');
4157             }
4158             if(!$run{'http-ipv6'}) {
4159                 ($pid, $pid2) = runhttpserver("http", $verbose, "ipv6",
4160                                               $HTTP6PORT);
4161                 if($pid <= 0) {
4162                     return "failed starting HTTP-IPv6 server";
4163                 }
4164                 logmsg sprintf("* pid http-ipv6 => %d %d\n", $pid, $pid2)
4165                     if($verbose);
4166                 $run{'http-ipv6'}="$pid $pid2";
4167             }
4168         }
4169         elsif($what eq "http-pipe") {
4170             if($torture && $run{'http-pipe'} &&
4171                !responsive_http_server("http", $verbose, "pipe",
4172                                        $HTTPPIPEPORT)) {
4173                 stopserver('http-pipe');
4174             }
4175             if(!$run{'http-pipe'}) {
4176                 ($pid, $pid2) = runhttpserver("http", $verbose, "pipe",
4177                                               $HTTPPIPEPORT);
4178                 if($pid <= 0) {
4179                     return "failed starting HTTP-pipe server";
4180                 }
4181                 logmsg sprintf ("* pid http-pipe => %d %d\n", $pid, $pid2)
4182                     if($verbose);
4183                 $run{'http-pipe'}="$pid $pid2";
4184             }
4185         }
4186         elsif($what eq "rtsp") {
4187             if($torture && $run{'rtsp'} &&
4188                !responsive_rtsp_server($verbose)) {
4189                 stopserver('rtsp');
4190             }
4191             if(!$run{'rtsp'}) {
4192                 ($pid, $pid2) = runrtspserver($verbose);
4193                 if($pid <= 0) {
4194                     return "failed starting RTSP server";
4195                 }
4196                 printf ("* pid rtsp => %d %d\n", $pid, $pid2) if($verbose);
4197                 $run{'rtsp'}="$pid $pid2";
4198             }
4199         }
4200         elsif($what eq "rtsp-ipv6") {
4201             if($torture && $run{'rtsp-ipv6'} &&
4202                !responsive_rtsp_server($verbose, "IPv6")) {
4203                 stopserver('rtsp-ipv6');
4204             }
4205             if(!$run{'rtsp-ipv6'}) {
4206                 ($pid, $pid2) = runrtspserver($verbose, "IPv6");
4207                 if($pid <= 0) {
4208                     return "failed starting RTSP-IPv6 server";
4209                 }
4210                 logmsg sprintf("* pid rtsp-ipv6 => %d %d\n", $pid, $pid2)
4211                     if($verbose);
4212                 $run{'rtsp-ipv6'}="$pid $pid2";
4213             }
4214         }
4215         elsif($what eq "ftps") {
4216             if(!$stunnel) {
4217                 # we can't run ftps tests without stunnel
4218                 return "no stunnel";
4219             }
4220             if(!$ssl_version) {
4221                 # we can't run ftps tests if libcurl is SSL-less
4222                 return "curl lacks SSL support";
4223             }
4224             if($runcert{'ftps'} && ($runcert{'ftps'} ne $certfile)) {
4225                 # stop server when running and using a different cert
4226                 stopserver('ftps');
4227             }
4228             if($torture && $run{'ftp'} &&
4229                !responsive_pingpong_server("ftp", "", $verbose)) {
4230                 stopserver('ftp');
4231             }
4232             if(!$run{'ftp'}) {
4233                 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose);
4234                 if($pid <= 0) {
4235                     return "failed starting FTP server";
4236                 }
4237                 printf ("* pid ftp => %d %d\n", $pid, $pid2) if($verbose);
4238                 $run{'ftp'}="$pid $pid2";
4239             }
4240             if(!$run{'ftps'}) {
4241                 ($pid, $pid2) = runftpsserver($verbose, "", $certfile);
4242                 if($pid <= 0) {
4243                     return "failed starting FTPS server (stunnel)";
4244                 }
4245                 logmsg sprintf("* pid ftps => %d %d\n", $pid, $pid2)
4246                     if($verbose);
4247                 $run{'ftps'}="$pid $pid2";
4248             }
4249         }
4250         elsif($what eq "file") {
4251             # we support it but have no server!
4252         }
4253         elsif($what eq "https") {
4254             if(!$stunnel) {
4255                 # we can't run https tests without stunnel
4256                 return "no stunnel";
4257             }
4258             if(!$ssl_version) {
4259                 # we can't run https tests if libcurl is SSL-less
4260                 return "curl lacks SSL support";
4261             }
4262             if($runcert{'https'} && ($runcert{'https'} ne $certfile)) {
4263                 # stop server when running and using a different cert
4264                 stopserver('https');
4265             }
4266             if($torture && $run{'http'} &&
4267                !responsive_http_server("http", $verbose, 0, $HTTPPORT)) {
4268                 stopserver('http');
4269             }
4270             if(!$run{'http'}) {
4271                 ($pid, $pid2) = runhttpserver("http", $verbose, 0,
4272                                               $HTTPPORT);
4273                 if($pid <= 0) {
4274                     return "failed starting HTTP server";
4275                 }
4276                 printf ("* pid http => %d %d\n", $pid, $pid2) if($verbose);
4277                 $run{'http'}="$pid $pid2";
4278             }
4279             if(!$run{'https'}) {
4280                 ($pid, $pid2) = runhttpsserver($verbose, "", $certfile);
4281                 if($pid <= 0) {
4282                     return "failed starting HTTPS server (stunnel)";
4283                 }
4284                 logmsg sprintf("* pid https => %d %d\n", $pid, $pid2)
4285                     if($verbose);
4286                 $run{'https'}="$pid $pid2";
4287             }
4288         }
4289         elsif($what eq "httptls") {
4290             if(!$httptlssrv) {
4291                 # for now, we can't run http TLS-EXT tests without gnutls-serv
4292                 return "no gnutls-serv";
4293             }
4294             if($torture && $run{'httptls'} &&
4295                !responsive_httptls_server($verbose, "IPv4")) {
4296                 stopserver('httptls');
4297             }
4298             if(!$run{'httptls'}) {
4299                 ($pid, $pid2) = runhttptlsserver($verbose, "IPv4");
4300                 if($pid <= 0) {
4301                     return "failed starting HTTPTLS server (gnutls-serv)";
4302                 }
4303                 logmsg sprintf("* pid httptls => %d %d\n", $pid, $pid2)
4304                     if($verbose);
4305                 $run{'httptls'}="$pid $pid2";
4306             }
4307         }
4308         elsif($what eq "httptls-ipv6") {
4309             if(!$httptlssrv) {
4310                 # for now, we can't run http TLS-EXT tests without gnutls-serv
4311                 return "no gnutls-serv";
4312             }
4313             if($torture && $run{'httptls-ipv6'} &&
4314                !responsive_httptls_server($verbose, "IPv6")) {
4315                 stopserver('httptls-ipv6');
4316             }
4317             if(!$run{'httptls-ipv6'}) {
4318                 ($pid, $pid2) = runhttptlsserver($verbose, "IPv6");
4319                 if($pid <= 0) {
4320                     return "failed starting HTTPTLS-IPv6 server (gnutls-serv)";
4321                 }
4322                 logmsg sprintf("* pid httptls-ipv6 => %d %d\n", $pid, $pid2)
4323                     if($verbose);
4324                 $run{'httptls-ipv6'}="$pid $pid2";
4325             }
4326         }
4327         elsif($what eq "tftp") {
4328             if($torture && $run{'tftp'} &&
4329                !responsive_tftp_server("", $verbose)) {
4330                 stopserver('tftp');
4331             }
4332             if(!$run{'tftp'}) {
4333                 ($pid, $pid2) = runtftpserver("", $verbose);
4334                 if($pid <= 0) {
4335                     return "failed starting TFTP server";
4336                 }
4337                 printf ("* pid tftp => %d %d\n", $pid, $pid2) if($verbose);
4338                 $run{'tftp'}="$pid $pid2";
4339             }
4340         }
4341         elsif($what eq "tftp-ipv6") {
4342             if($torture && $run{'tftp-ipv6'} &&
4343                !responsive_tftp_server("", $verbose, "IPv6")) {
4344                 stopserver('tftp-ipv6');
4345             }
4346             if(!$run{'tftp-ipv6'}) {
4347                 ($pid, $pid2) = runtftpserver("", $verbose, "IPv6");
4348                 if($pid <= 0) {
4349                     return "failed starting TFTP-IPv6 server";
4350                 }
4351                 printf("* pid tftp-ipv6 => %d %d\n", $pid, $pid2) if($verbose);
4352                 $run{'tftp-ipv6'}="$pid $pid2";
4353             }
4354         }
4355         elsif($what eq "sftp" || $what eq "scp" || $what eq "socks4" || $what eq "socks5" ) {
4356             if(!$run{'ssh'}) {
4357                 ($pid, $pid2) = runsshserver("", $verbose);
4358                 if($pid <= 0) {
4359                     return "failed starting SSH server";
4360                 }
4361                 printf ("* pid ssh => %d %d\n", $pid, $pid2) if($verbose);
4362                 $run{'ssh'}="$pid $pid2";
4363             }
4364             if($what eq "socks4" || $what eq "socks5") {
4365                 if(!$run{'socks'}) {
4366                     ($pid, $pid2) = runsocksserver("", $verbose);
4367                     if($pid <= 0) {
4368                         return "failed starting socks server";
4369                     }
4370                     printf ("* pid socks => %d %d\n", $pid, $pid2) if($verbose);
4371                     $run{'socks'}="$pid $pid2";
4372                 }
4373             }
4374             if($what eq "socks5") {
4375                 if(!$sshdid) {
4376                     # Not an OpenSSH or SunSSH ssh daemon
4377                     logmsg "Not OpenSSH or SunSSH; socks5 tests need at least OpenSSH 3.7\n";
4378                     return "failed starting socks5 server";
4379                 }
4380                 elsif(($sshdid =~ /OpenSSH/) && ($sshdvernum < 370)) {
4381                     # Need OpenSSH 3.7 for socks5 - http://www.openssh.com/txt/release-3.7
4382                     logmsg "$sshdverstr insufficient; socks5 tests need at least OpenSSH 3.7\n";
4383                     return "failed starting socks5 server";
4384                 }
4385                 elsif(($sshdid =~ /SunSSH/)  && ($sshdvernum < 100)) {
4386                     # Need SunSSH 1.0 for socks5
4387                     logmsg "$sshdverstr insufficient; socks5 tests need at least SunSSH 1.0\n";
4388                     return "failed starting socks5 server";
4389                 }
4390             }
4391         }
4392         elsif($what eq "none") {
4393             logmsg "* starts no server\n" if ($verbose);
4394         }
4395         else {
4396             warn "we don't support a server for $what";
4397             return "no server for $what";
4398         }
4399     }
4400     return 0;
4401 }
4402
4403 ##############################################################################
4404 # This function makes sure the right set of server is running for the
4405 # specified test case. This is a useful design when we run single tests as not
4406 # all servers need to run then!
4407 #
4408 # Returns: a string, blank if everything is fine or a reason why it failed
4409 #
4410 sub serverfortest {
4411     my ($testnum)=@_;
4412
4413     my @what = getpart("client", "server");
4414
4415     if(!$what[0]) {
4416         warn "Test case $testnum has no server(s) specified";
4417         return "no server specified";
4418     }
4419
4420     for(my $i = scalar(@what) - 1; $i >= 0; $i--) {
4421         my $srvrline = $what[$i];
4422         chomp $srvrline if($srvrline);
4423         if($srvrline =~ /^(\S+)((\s*)(.*))/) {
4424             my $server = "${1}";
4425             my $lnrest = "${2}";
4426             my $tlsext;
4427             if($server =~ /^(httptls)(\+)(ext|srp)(\d*)(-ipv6|)$/) {
4428                 $server = "${1}${4}${5}";
4429                 $tlsext = uc("TLS-${3}");
4430             }
4431             if(! grep /^\Q$server\E$/, @protocols) {
4432                 if(substr($server,0,5) ne "socks") {
4433                     if($tlsext) {
4434                         return "curl lacks $tlsext support";
4435                     }
4436                     else {
4437                         return "curl lacks $server server support";
4438                     }
4439                 }
4440             }
4441             $what[$i] = "$server$lnrest" if($tlsext);
4442         }
4443     }
4444
4445     return &startservers(@what);
4446 }
4447
4448 #######################################################################
4449 # runtimestats displays test-suite run time statistics
4450 #
4451 sub runtimestats {
4452     my $lasttest = $_[0];
4453
4454     return if(not $timestats);
4455
4456     logmsg "\nTest suite total running time breakdown per task...\n\n";
4457
4458     my @timesrvr;
4459     my @timeprep;
4460     my @timetool;
4461     my @timelock;
4462     my @timevrfy;
4463     my @timetest;
4464     my $timesrvrtot = 0.0;
4465     my $timepreptot = 0.0;
4466     my $timetooltot = 0.0;
4467     my $timelocktot = 0.0;
4468     my $timevrfytot = 0.0;
4469     my $timetesttot = 0.0;
4470     my $counter;
4471
4472     for my $testnum (1 .. $lasttest) {
4473         if($timesrvrini{$testnum}) {
4474             $timesrvrtot += $timesrvrend{$testnum} - $timesrvrini{$testnum};
4475             $timepreptot +=
4476                 (($timetoolini{$testnum} - $timeprepini{$testnum}) -
4477                  ($timesrvrend{$testnum} - $timesrvrini{$testnum}));
4478             $timetooltot += $timetoolend{$testnum} - $timetoolini{$testnum};
4479             $timelocktot += $timesrvrlog{$testnum} - $timetoolend{$testnum};
4480             $timevrfytot += $timevrfyend{$testnum} - $timesrvrlog{$testnum};
4481             $timetesttot += $timevrfyend{$testnum} - $timeprepini{$testnum};
4482             push @timesrvr, sprintf("%06.3f  %04d",
4483                 $timesrvrend{$testnum} - $timesrvrini{$testnum}, $testnum);
4484             push @timeprep, sprintf("%06.3f  %04d",
4485                 ($timetoolini{$testnum} - $timeprepini{$testnum}) -
4486                 ($timesrvrend{$testnum} - $timesrvrini{$testnum}), $testnum);
4487             push @timetool, sprintf("%06.3f  %04d",
4488                 $timetoolend{$testnum} - $timetoolini{$testnum}, $testnum);
4489             push @timelock, sprintf("%06.3f  %04d",
4490                 $timesrvrlog{$testnum} - $timetoolend{$testnum}, $testnum);
4491             push @timevrfy, sprintf("%06.3f  %04d",
4492                 $timevrfyend{$testnum} - $timesrvrlog{$testnum}, $testnum);
4493             push @timetest, sprintf("%06.3f  %04d",
4494                 $timevrfyend{$testnum} - $timeprepini{$testnum}, $testnum);
4495         }
4496     }
4497
4498     {
4499         no warnings 'numeric';
4500         @timesrvr = sort { $b <=> $a } @timesrvr;
4501         @timeprep = sort { $b <=> $a } @timeprep;
4502         @timetool = sort { $b <=> $a } @timetool;
4503         @timelock = sort { $b <=> $a } @timelock;
4504         @timevrfy = sort { $b <=> $a } @timevrfy;
4505         @timetest = sort { $b <=> $a } @timetest;
4506     }
4507
4508     logmsg "Spent ". sprintf("%08.3f ", $timesrvrtot) .
4509            "seconds starting and verifying test harness servers.\n";
4510     logmsg "Spent ". sprintf("%08.3f ", $timepreptot) .
4511            "seconds reading definitions and doing test preparations.\n";
4512     logmsg "Spent ". sprintf("%08.3f ", $timetooltot) .
4513            "seconds actually running test tools.\n";
4514     logmsg "Spent ". sprintf("%08.3f ", $timelocktot) .
4515            "seconds awaiting server logs lock removal.\n";
4516     logmsg "Spent ". sprintf("%08.3f ", $timevrfytot) .
4517            "seconds verifying test results.\n";
4518     logmsg "Spent ". sprintf("%08.3f ", $timetesttot) .
4519            "seconds doing all of the above.\n";
4520
4521     $counter = 25;
4522     logmsg "\nTest server starting and verification time per test ".
4523         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4524     logmsg "-time-  test\n";
4525     logmsg "------  ----\n";
4526     foreach my $txt (@timesrvr) {
4527         last if((not $fullstats) && (not $counter--));
4528         logmsg "$txt\n";
4529     }
4530
4531     $counter = 10;
4532     logmsg "\nTest definition reading and preparation time per test ".
4533         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4534     logmsg "-time-  test\n";
4535     logmsg "------  ----\n";
4536     foreach my $txt (@timeprep) {
4537         last if((not $fullstats) && (not $counter--));
4538         logmsg "$txt\n";
4539     }
4540
4541     $counter = 25;
4542     logmsg "\nTest tool execution time per test ".
4543         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4544     logmsg "-time-  test\n";
4545     logmsg "------  ----\n";
4546     foreach my $txt (@timetool) {
4547         last if((not $fullstats) && (not $counter--));
4548         logmsg "$txt\n";
4549     }
4550
4551     $counter = 15;
4552     logmsg "\nTest server logs lock removal time per test ".
4553         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4554     logmsg "-time-  test\n";
4555     logmsg "------  ----\n";
4556     foreach my $txt (@timelock) {
4557         last if((not $fullstats) && (not $counter--));
4558         logmsg "$txt\n";
4559     }
4560
4561     $counter = 10;
4562     logmsg "\nTest results verification time per test ".
4563         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4564     logmsg "-time-  test\n";
4565     logmsg "------  ----\n";
4566     foreach my $txt (@timevrfy) {
4567         last if((not $fullstats) && (not $counter--));
4568         logmsg "$txt\n";
4569     }
4570
4571     $counter = 50;
4572     logmsg "\nTotal time per test ".
4573         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4574     logmsg "-time-  test\n";
4575     logmsg "------  ----\n";
4576     foreach my $txt (@timetest) {
4577         last if((not $fullstats) && (not $counter--));
4578         logmsg "$txt\n";
4579     }
4580
4581     logmsg "\n";
4582 }
4583
4584 #######################################################################
4585 # Check options to this test program
4586 #
4587
4588 my $number=0;
4589 my $fromnum=-1;
4590 my @testthis;
4591 while(@ARGV) {
4592     if ($ARGV[0] eq "-v") {
4593         # verbose output
4594         $verbose=1;
4595     }
4596     elsif($ARGV[0] =~ /^-b(.*)/) {
4597         my $portno=$1;
4598         if($portno =~ s/(\d+)$//) {
4599             $base = int $1;
4600         }
4601     }
4602     elsif ($ARGV[0] eq "-c") {
4603         # use this path to curl instead of default
4604         $DBGCURL=$CURL=$ARGV[1];
4605         shift @ARGV;
4606     }
4607     elsif ($ARGV[0] eq "-vc") {
4608         # use this path to a curl used to verify servers
4609
4610         # Particularly useful when you introduce a crashing bug somewhere in
4611         # the development version as then it won't be able to run any tests
4612         # since it can't verify the servers!
4613
4614         $VCURL=$ARGV[1];
4615         shift @ARGV;
4616     }
4617     elsif ($ARGV[0] eq "-d") {
4618         # have the servers display protocol output
4619         $debugprotocol=1;
4620     }
4621     elsif ($ARGV[0] eq "-g") {
4622         # run this test with gdb
4623         $gdbthis=1;
4624     }
4625     elsif ($ARGV[0] eq "-gw") {
4626         # run this test with windowed gdb
4627         $gdbthis=1;
4628         $gdbxwin=1;
4629     }
4630     elsif($ARGV[0] eq "-s") {
4631         # short output
4632         $short=1;
4633     }
4634     elsif($ARGV[0] eq "-am") {
4635         # automake-style output
4636         $short=1;
4637         $automakestyle=1;
4638     }
4639     elsif($ARGV[0] eq "-n") {
4640         # no valgrind
4641         undef $valgrind;
4642     }
4643     elsif($ARGV[0] =~ /^-t(.*)/) {
4644         # torture
4645         $torture=1;
4646         my $xtra = $1;
4647
4648         if($xtra =~ s/(\d+)$//) {
4649             $tortalloc = $1;
4650         }
4651         # we undef valgrind to make this fly in comparison
4652         undef $valgrind;
4653     }
4654     elsif($ARGV[0] eq "-a") {
4655         # continue anyway, even if a test fail
4656         $anyway=1;
4657     }
4658     elsif($ARGV[0] eq "-e") {
4659         # run the tests cases event based if possible
4660         $run_event_based=1;
4661     }
4662     elsif($ARGV[0] eq "-p") {
4663         $postmortem=1;
4664     }
4665     elsif($ARGV[0] eq "-l") {
4666         # lists the test case names only
4667         $listonly=1;
4668     }
4669     elsif($ARGV[0] eq "-k") {
4670         # keep stdout and stderr files after tests
4671         $keepoutfiles=1;
4672     }
4673     elsif($ARGV[0] eq "-r") {
4674         # run time statistics needs Time::HiRes
4675         if($Time::HiRes::VERSION) {
4676             keys(%timeprepini) = 1000;
4677             keys(%timesrvrini) = 1000;
4678             keys(%timesrvrend) = 1000;
4679             keys(%timetoolini) = 1000;
4680             keys(%timetoolend) = 1000;
4681             keys(%timesrvrlog) = 1000;
4682             keys(%timevrfyend) = 1000;
4683             $timestats=1;
4684             $fullstats=0;
4685         }
4686     }
4687     elsif($ARGV[0] eq "-rf") {
4688         # run time statistics needs Time::HiRes
4689         if($Time::HiRes::VERSION) {
4690             keys(%timeprepini) = 1000;
4691             keys(%timesrvrini) = 1000;
4692             keys(%timesrvrend) = 1000;
4693             keys(%timetoolini) = 1000;
4694             keys(%timetoolend) = 1000;
4695             keys(%timesrvrlog) = 1000;
4696             keys(%timevrfyend) = 1000;
4697             $timestats=1;
4698             $fullstats=1;
4699         }
4700     }
4701     elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
4702         # show help text
4703         print <<EOHELP
4704 Usage: runtests.pl [options] [test selection(s)]
4705   -a       continue even if a test fails
4706   -bN      use base port number N for test servers (default $base)
4707   -c path  use this curl executable
4708   -d       display server debug info
4709   -g       run the test case with gdb
4710   -gw      run the test case with gdb as a windowed application
4711   -h       this help text
4712   -k       keep stdout and stderr files present after tests
4713   -l       list all test case names/descriptions
4714   -n       no valgrind
4715   -p       print log file contents when a test fails
4716   -r       run time statistics
4717   -rf      full run time statistics
4718   -s       short output
4719   -am      automake style output PASS/FAIL: [number] [name]
4720   -t[N]    torture (simulate memory alloc failures); N means fail Nth alloc
4721   -v       verbose output
4722   -vc path use this curl only to verify the existing servers
4723   [num]    like "5 6 9" or " 5 to 22 " to run those tests only
4724   [!num]   like "!5 !6 !9" to disable those tests
4725   [keyword] like "IPv6" to select only tests containing the key word
4726   [!keyword] like "!cookies" to disable any tests containing the key word
4727 EOHELP
4728     ;
4729         exit;
4730     }
4731     elsif($ARGV[0] =~ /^(\d+)/) {
4732         $number = $1;
4733         if($fromnum >= 0) {
4734             for($fromnum .. $number) {
4735                 push @testthis, $_;
4736             }
4737             $fromnum = -1;
4738         }
4739         else {
4740             push @testthis, $1;
4741         }
4742     }
4743     elsif($ARGV[0] =~ /^to$/i) {
4744         $fromnum = $number+1;
4745     }
4746     elsif($ARGV[0] =~ /^!(\d+)/) {
4747         $fromnum = -1;
4748         $disabled{$1}=$1;
4749     }
4750     elsif($ARGV[0] =~ /^!(.+)/) {
4751         $disabled_keywords{$1}=$1;
4752     }
4753     elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) {
4754         $enabled_keywords{$1}=$1;
4755     }
4756     else {
4757         print "Unknown option: $ARGV[0]\n";
4758         exit;
4759     }
4760     shift @ARGV;
4761 }
4762
4763 if(@testthis && ($testthis[0] ne "")) {
4764     $TESTCASES=join(" ", @testthis);
4765 }
4766
4767 if($valgrind) {
4768     # we have found valgrind on the host, use it
4769
4770     # verify that we can invoke it fine
4771     my $code = runclient("valgrind >/dev/null 2>&1");
4772
4773     if(($code>>8) != 1) {
4774         #logmsg "Valgrind failure, disable it\n";
4775         undef $valgrind;
4776     } else {
4777
4778         # since valgrind 2.1.x, '--tool' option is mandatory
4779         # use it, if it is supported by the version installed on the system
4780         runclient("valgrind --help 2>&1 | grep -- --tool > /dev/null 2>&1");
4781         if (($? >> 8)==0) {
4782             $valgrind_tool="--tool=memcheck";
4783         }
4784         open(C, "<$CURL");
4785         my $l = <C>;
4786         if($l =~ /^\#\!/) {
4787             # A shell script. This is typically when built with libtool,
4788             $valgrind="../libtool --mode=execute $valgrind";
4789         }
4790         close(C);
4791
4792         # valgrind 3 renamed the --logfile option to --log-file!!!
4793         my $ver=join(' ', runclientoutput("valgrind --version"));
4794         # cut off all but digits and dots
4795         $ver =~ s/[^0-9.]//g;
4796
4797         if($ver =~ /^(\d+)/) {
4798             $ver = $1;
4799             if($ver >= 3) {
4800                 $valgrind_logfile="--log-file";
4801             }
4802         }
4803     }
4804 }
4805
4806 if ($gdbthis) {
4807     # open the executable curl and read the first 4 bytes of it
4808     open(CHECK, "<$CURL");
4809     my $c;
4810     sysread CHECK, $c, 4;
4811     close(CHECK);
4812     if($c eq "#! /") {
4813         # A shell script. This is typically when built with libtool,
4814         $libtool = 1;
4815         $gdb = "libtool --mode=execute gdb";
4816     }
4817 }
4818
4819 $HTTPPORT        = $base++; # HTTP server port
4820 $HTTPSPORT       = $base++; # HTTPS (stunnel) server port
4821 $FTPPORT         = $base++; # FTP server port
4822 $FTPSPORT        = $base++; # FTPS (stunnel) server port
4823 $HTTP6PORT       = $base++; # HTTP IPv6 server port
4824 $FTP2PORT        = $base++; # FTP server 2 port
4825 $FTP6PORT        = $base++; # FTP IPv6 port
4826 $TFTPPORT        = $base++; # TFTP (UDP) port
4827 $TFTP6PORT       = $base++; # TFTP IPv6 (UDP) port
4828 $SSHPORT         = $base++; # SSH (SCP/SFTP) port
4829 $SOCKSPORT       = $base++; # SOCKS port
4830 $POP3PORT        = $base++; # POP3 server port
4831 $POP36PORT       = $base++; # POP3 IPv6 server port
4832 $IMAPPORT        = $base++; # IMAP server port
4833 $IMAP6PORT       = $base++; # IMAP IPv6 server port
4834 $SMTPPORT        = $base++; # SMTP server port
4835 $SMTP6PORT       = $base++; # SMTP IPv6 server port
4836 $RTSPPORT        = $base++; # RTSP server port
4837 $RTSP6PORT       = $base++; # RTSP IPv6 server port
4838 $GOPHERPORT      = $base++; # Gopher IPv4 server port
4839 $GOPHER6PORT     = $base++; # Gopher IPv6 server port
4840 $HTTPTLSPORT     = $base++; # HTTP TLS (non-stunnel) server port
4841 $HTTPTLS6PORT    = $base++; # HTTP TLS (non-stunnel) IPv6 server port
4842 $HTTPPROXYPORT   = $base++; # HTTP proxy port, when using CONNECT
4843 $HTTPPIPEPORT    = $base++; # HTTP pipelining port
4844
4845 #######################################################################
4846 # clear and create logging directory:
4847 #
4848
4849 cleardir($LOGDIR);
4850 mkdir($LOGDIR, 0777);
4851
4852 #######################################################################
4853 # initialize some variables
4854 #
4855
4856 get_disttests();
4857 init_serverpidfile_hash();
4858
4859 #######################################################################
4860 # Output curl version and host info being tested
4861 #
4862
4863 if(!$listonly) {
4864     checksystem();
4865 }
4866
4867 #######################################################################
4868 # Fetch all disabled tests
4869 #
4870
4871 open(D, "<$TESTDIR/DISABLED");
4872 while(<D>) {
4873     if(/^ *\#/) {
4874         # allow comments
4875         next;
4876     }
4877     if($_ =~ /(\d+)/) {
4878         $disabled{$1}=$1; # disable this test number
4879     }
4880 }
4881 close(D);
4882
4883 #######################################################################
4884 # If 'all' tests are requested, find out all test numbers
4885 #
4886
4887 if ( $TESTCASES eq "all") {
4888     # Get all commands and find out their test numbers
4889     opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
4890     my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
4891     closedir(DIR);
4892
4893     $TESTCASES=""; # start with no test cases
4894
4895     # cut off everything but the digits
4896     for(@cmds) {
4897         $_ =~ s/[a-z\/\.]*//g;
4898     }
4899     # sort the numbers from low to high
4900     foreach my $n (sort { $a <=> $b } @cmds) {
4901         if($disabled{$n}) {
4902             # skip disabled test cases
4903             my $why = "configured as DISABLED";
4904             $skipped++;
4905             $skipped{$why}++;
4906             $teststat[$n]=$why; # store reason for this test case
4907             next;
4908         }
4909         $TESTCASES .= " $n";
4910     }
4911 }
4912 else {
4913     my $verified="";
4914     map {
4915         if (-e "$TESTDIR/test$_") {
4916             $verified.="$_ ";
4917         }
4918     } split(" ", $TESTCASES);
4919     if($verified eq "") {
4920         print "No existing test cases were specified\n";
4921         exit;
4922     }
4923     $TESTCASES = $verified;
4924 }
4925
4926 #######################################################################
4927 # Start the command line log
4928 #
4929 open(CMDLOG, ">$CURLLOG") ||
4930     logmsg "can't log command lines to $CURLLOG\n";
4931
4932 #######################################################################
4933
4934 # Display the contents of the given file.  Line endings are canonicalized
4935 # and excessively long files are elided
4936 sub displaylogcontent {
4937     my ($file)=@_;
4938     if(open(SINGLE, "<$file")) {
4939         my $linecount = 0;
4940         my $truncate;
4941         my @tail;
4942         while(my $string = <SINGLE>) {
4943             $string =~ s/\r\n/\n/g;
4944             $string =~ s/[\r\f\032]/\n/g;
4945             $string .= "\n" unless ($string =~ /\n$/);
4946             $string =~ tr/\n//;
4947             for my $line (split("\n", $string)) {
4948                 $line =~ s/\s*\!$//;
4949                 if ($truncate) {
4950                     push @tail, " $line\n";
4951                 } else {
4952                     logmsg " $line\n";
4953                 }
4954                 $linecount++;
4955                 $truncate = $linecount > 1000;
4956             }
4957         }
4958         if(@tail) {
4959             my $tailshow = 200;
4960             my $tailskip = 0;
4961             my $tailtotal = scalar @tail;
4962             if($tailtotal > $tailshow) {
4963                 $tailskip = $tailtotal - $tailshow;
4964                 logmsg "=== File too long: $tailskip lines omitted here\n";
4965             }
4966             for($tailskip .. $tailtotal-1) {
4967                 logmsg "$tail[$_]";
4968             }
4969         }
4970         close(SINGLE);
4971     }
4972 }
4973
4974 sub displaylogs {
4975     my ($testnum)=@_;
4976     opendir(DIR, "$LOGDIR") ||
4977         die "can't open dir: $!";
4978     my @logs = readdir(DIR);
4979     closedir(DIR);
4980
4981     logmsg "== Contents of files in the $LOGDIR/ dir after test $testnum\n";
4982     foreach my $log (sort @logs) {
4983         if($log =~ /\.(\.|)$/) {
4984             next; # skip "." and ".."
4985         }
4986         if($log =~ /^\.nfs/) {
4987             next; # skip ".nfs"
4988         }
4989         if(($log eq "memdump") || ($log eq "core")) {
4990             next; # skip "memdump" and  "core"
4991         }
4992         if((-d "$LOGDIR/$log") || (! -s "$LOGDIR/$log")) {
4993             next; # skip directory and empty files
4994         }
4995         if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) {
4996             next; # skip stdoutNnn of other tests
4997         }
4998         if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) {
4999             next; # skip stderrNnn of other tests
5000         }
5001         if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) {
5002             next; # skip uploadNnn of other tests
5003         }
5004         if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) {
5005             next; # skip curlNnn.out of other tests
5006         }
5007         if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) {
5008             next; # skip testNnn.txt of other tests
5009         }
5010         if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) {
5011             next; # skip fileNnn.txt of other tests
5012         }
5013         if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) {
5014             next; # skip netrcNnn of other tests
5015         }
5016         if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) {
5017             next; # skip traceNnn of other tests
5018         }
5019         if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(\..*|)$/)) {
5020             next; # skip valgrindNnn of other tests
5021         }
5022         logmsg "=== Start of file $log\n";
5023         displaylogcontent("$LOGDIR/$log");
5024         logmsg "=== End of file $log\n";
5025     }
5026 }
5027
5028 #######################################################################
5029 # The main test-loop
5030 #
5031
5032 my $failed;
5033 my $testnum;
5034 my $ok=0;
5035 my $total=0;
5036 my $lasttest=0;
5037 my @at = split(" ", $TESTCASES);
5038 my $count=0;
5039
5040 $start = time();
5041
5042 foreach $testnum (@at) {
5043
5044     $lasttest = $testnum if($testnum > $lasttest);
5045     $count++;
5046
5047     my $error = singletest($run_event_based, $testnum, $count, scalar(@at));
5048     if($error < 0) {
5049         # not a test we can run
5050         next;
5051     }
5052
5053     $total++; # number of tests we've run
5054
5055     if($error>0) {
5056         $failed.= "$testnum ";
5057         if($postmortem) {
5058             # display all files in log/ in a nice way
5059             displaylogs($testnum);
5060         }
5061         if(!$anyway) {
5062             # a test failed, abort
5063             logmsg "\n - abort tests\n";
5064             last;
5065         }
5066     }
5067     elsif(!$error) {
5068         $ok++; # successful test counter
5069     }
5070
5071     # loop for next test
5072 }
5073
5074 my $sofar = time() - $start;
5075
5076 #######################################################################
5077 # Close command log
5078 #
5079 close(CMDLOG);
5080
5081 # Tests done, stop the servers
5082 stopservers($verbose);
5083
5084 my $all = $total + $skipped;
5085
5086 runtimestats($lasttest);
5087
5088 if($total) {
5089     logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
5090                    $ok/$total*100);
5091
5092     if($ok != $total) {
5093         logmsg "TESTFAIL: These test cases failed: $failed\n";
5094     }
5095 }
5096 else {
5097     logmsg "TESTFAIL: No tests were performed\n";
5098 }
5099
5100 if($all) {
5101     logmsg "TESTDONE: $all tests were considered during ".
5102         sprintf("%.0f", $sofar) ." seconds.\n";
5103 }
5104
5105 if($skipped && !$short) {
5106     my $s=0;
5107     logmsg "TESTINFO: $skipped tests were skipped due to these restraints:\n";
5108
5109     for(keys %skipped) {
5110         my $r = $_;
5111         printf "TESTINFO: \"%s\" %d times (", $r, $skipped{$_};
5112
5113         # now show all test case numbers that had this reason for being
5114         # skipped
5115         my $c=0;
5116         my $max = 9;
5117         for(0 .. scalar @teststat) {
5118             my $t = $_;
5119             if($teststat[$_] && ($teststat[$_] eq $r)) {
5120                 if($c < $max) {
5121                     logmsg ", " if($c);
5122                     logmsg $_;
5123                 }
5124                 $c++;
5125             }
5126         }
5127         if($c > $max) {
5128             logmsg " and ".($c-$max)." more";
5129         }
5130         logmsg ")\n";
5131     }
5132 }
5133
5134 if($total && ($ok != $total)) {
5135     exit 1;
5136 }