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