tests/runtests.pl

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