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