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