tests/runtests.pl

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