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