tests/runtests.pl

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