tests/runtests.pl

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