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