tests/runtests.pl

   1 #!/usr/bin/env perl
   2 #***************************************************************************
   3 #                                  _   _ ____  _
   4 #  Project                     ___| | | |  _ \| |
   5 #                             / __| | | | |_) | |
   6 #                            | (__| |_| |  _ <| |___
   7 #                             \___|\___/|_| \_\_____|
   8 #
   9 # Copyright (C) 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 https://curl.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 # SPDX-License-Identifier: curl
  23 #
  24 ###########################################################################
  25
  26 # For documentation, run `man ./runtests.1` and see README.md.
  27
  28 # Experimental hooks are available to run tests remotely on machines that
  29 # are able to run curl but are unable to run the test harness.
  30 # The following sections need to be modified:
  31 #
  32 #  $HOSTIP, $HOST6IP - Set to the address of the host running the test suite
  33 #  $CLIENTIP, $CLIENT6IP - Set to the address of the host running curl
  34 #  runclient, runclientoutput - Modify to copy all the files in the log/
  35 #    directory to the system running curl, run the given command remotely
  36 #    and save the return code or returned stdout (respectively), then
  37 #    copy all the files from the remote system's log/ directory back to
  38 #    the host running the test suite.  This can be done a few ways, such
  39 #    as using scp & ssh, rsync & telnet, or using a NFS shared directory
  40 #    and ssh.
  41 #
  42 # 'make && make test' needs to be done on both machines before making the
  43 # above changes and running runtests.pl manually.  In the shared NFS case,
  44 # the contents of the tests/server/ directory must be from the host
  45 # running the test suite, while the rest must be from the host running curl.
  46 #
  47 # Note that even with these changes a number of tests will still fail (mainly
  48 # to do with cookies, those that set environment variables, or those that
  49 # do more than touch the file system in a <precheck> or <postcheck>
  50 # section). These can be added to the $TESTCASES line below,
  51 # e.g. $TESTCASES="!8 !31 !63 !cookies..."
  52 #
  53 # Finally, to properly support -g and -n, checktestcmd needs to change
  54 # to check the remote system's PATH, and the places in the code where
  55 # the curl binary is read directly to determine its type also need to be
  56 # fixed. As long as the -g option is never given, and the -n is always
  57 # given, this won't be a problem.
  58
  59 use strict;
  60 # Promote all warnings to fatal
  61 use warnings FATAL => 'all';
  62 use 5.006;
  63
  64 # These should be the only variables that might be needed to get edited:
  65
  66 BEGIN {
  67     # Define srcdir to the location of the tests source directory. This is
  68     # usually set by the Makefile, but for out-of-tree builds with direct
  69     # invocation of runtests.pl, it may not be set.
  70     if(!defined $ENV{'srcdir'}) {
  71         use File::Basename;
  72         $ENV{'srcdir'} = dirname(__FILE__);
  73     }
  74     push(@INC, $ENV{'srcdir'});
  75     # run time statistics needs Time::HiRes
  76     eval {
  77         no warnings "all";
  78         require Time::HiRes;
  79         import  Time::HiRes qw( time );
  80     }
  81 }
  82
  83 use Digest::MD5 qw(md5);
  84 use List::Util 'sum';
  85
  86 use pathhelp qw(
  87     exe_ext
  88     sys_native_current_path
  89     );
  90 use processhelp qw(
  91     portable_sleep
  92     );
  93
  94 use appveyor;
  95 use azure;
  96 use getpart;   # array functions
  97 use servers;
  98 use valgrind;  # valgrind report parser
  99 use globalconfig;
 100 use runner;
 101 use testutil;
 102
 103 my %custom_skip_reasons;
 104
 105 my $ACURL=$VCURL;  # what curl binary to use to talk to APIs (relevant for CI)
 106                    # ACURL is handy to set to the system one for reliability
 107 my $CURLCONFIG="../curl-config"; # curl-config from current build
 108
 109 # Normally, all test cases should be run, but at times it is handy to
 110 # simply run a particular one:
 111 my $TESTCASES="all";
 112
 113 # To run specific test cases, set them like:
 114 # $TESTCASES="1 2 3 7 8";
 115
 116 #######################################################################
 117 # No variables below this point should need to be modified
 118 #
 119
 120 my $libtool;
 121 my $repeat = 0;
 122
 123 my $start;          # time at which testing started
 124
 125 my $uname_release = `uname -r`;
 126 my $is_wsl = $uname_release =~ /Microsoft$/;
 127
 128 my $http_ipv6;      # set if HTTP server has IPv6 support
 129 my $http_unix;      # set if HTTP server has Unix sockets support
 130 my $ftp_ipv6;       # set if FTP server has IPv6 support
 131
 132 my $resolver;       # name of the resolver backend (for human presentation)
 133
 134 my $has_textaware;  # set if running on a system that has a text mode concept
 135                     # on files. Windows for example
 136
 137 my %skipped;    # skipped{reason}=counter, reasons for skip
 138 my @teststat;   # teststat[testnum]=reason, reasons for skip
 139 my %disabled_keywords;  # key words of tests to skip
 140 my %ignored_keywords;   # key words of tests to ignore results
 141 my %enabled_keywords;   # key words of tests to run
 142 my %disabled;           # disabled test cases
 143 my %ignored;            # ignored results of test cases
 144 my %ignoretestcodes;    # if test results are to be ignored
 145
 146 my $timestats;   # time stamping and stats generation
 147 my $fullstats;   # show time stats for every single test
 148 my %timeprepini; # timestamp for each test preparation start
 149 my %timesrvrini; # timestamp for each test required servers verification start
 150 my %timesrvrend; # timestamp for each test required servers verification end
 151 my %timetoolini; # timestamp for each test command run starting
 152 my %timetoolend; # timestamp for each test command run stopping
 153 my %timesrvrlog; # timestamp for each test server logs lock removal
 154 my %timevrfyend; # timestamp for each test result verification end
 155 my $globalabort; # flag signalling program abort
 156
 157 # values for $singletest_state
 158 use constant {
 159     ST_INIT => 0,
 160     ST_CLEARLOCKS => 1,
 161     ST_INITED => 2,
 162     ST_PREPROCESS => 3,
 163     ST_RUN => 4,
 164 };
 165 my %singletest_state;  # current state of singletest() by runner ID
 166 my %singletest_logs;   # log messages while in singletest array ref by runner
 167 my $singletest_bufferedrunner; # runner ID which is buffering logs
 168 my %runnerids;         # runner IDs by number
 169 my @runnersidle;       # runner IDs idle and ready to execute a test
 170 my %countforrunner;    # test count by runner ID
 171 my %runnersrunning;    # tests currently running by runner ID
 172
 173 #######################################################################
 174 # variables that command line options may set
 175 #
 176 my $short;
 177 my $no_debuginfod;
 178 my $keepoutfiles; # keep stdout and stderr files after tests
 179 my $clearlocks;   # force removal of files by killing locking processes
 180 my $postmortem;   # display detailed info about failed tests
 181 my $run_disabled; # run the specific tests even if listed in DISABLED
 182 my $scrambleorder;
 183 my $jobs = 0;
 184
 185 # Azure Pipelines specific variables
 186 my $AZURE_RUN_ID = 0;
 187 my $AZURE_RESULT_ID = 0;
 188
 189 #######################################################################
 190 # logmsg is our general message logging subroutine.
 191 #
 192 sub logmsg {
 193     if($singletest_bufferedrunner) {
 194         # Logs are currently being buffered
 195         return singletest_logmsg(@_);
 196     }
 197     for(@_) {
 198         my $line = $_;
 199         if(!$line) {
 200             next;
 201         }
 202         if ($is_wsl) {
 203             # use \r\n for WSL shell
 204             $line =~ s/\r?\n$/\r\n/g;
 205         }
 206         print "$line";
 207     }
 208 }
 209
 210 #######################################################################
 211 # enable logmsg buffering for the given runner ID
 212 #
 213 sub logmsg_bufferfortest {
 214     my ($runnerid)=@_;
 215     if($jobs) {
 216         # Only enable buffering in multiprocess mode
 217         $singletest_bufferedrunner = $runnerid;
 218     }
 219 }
 220 #######################################################################
 221 # Store a log message in a buffer for this test
 222 # The messages can then be displayed all at once at the end of the test
 223 # which prevents messages from different tests from being interleaved.
 224 sub singletest_logmsg {
 225     if(!exists $singletest_logs{$singletest_bufferedrunner}) {
 226         # initialize to a reference to an empty anonymous array
 227         $singletest_logs{$singletest_bufferedrunner} = [];
 228     }
 229     my $logsref = $singletest_logs{$singletest_bufferedrunner};
 230     push @$logsref, @_;
 231 }
 232
 233 #######################################################################
 234 # Stop buffering log messages, but don't touch them
 235 sub singletest_unbufferlogs {
 236     undef $singletest_bufferedrunner;
 237 }
 238
 239 #######################################################################
 240 # Clear the buffered log messages & stop buffering after returning them
 241 sub singletest_dumplogs {
 242     if(!defined $singletest_bufferedrunner) {
 243         # probably not multiprocess mode and logs weren't buffered
 244         return undef;
 245     }
 246     my $logsref = $singletest_logs{$singletest_bufferedrunner};
 247     my $msg = join("", @$logsref);
 248     delete $singletest_logs{$singletest_bufferedrunner};
 249     singletest_unbufferlogs();
 250     return $msg;
 251 }
 252
 253 sub catch_zap {
 254     my $signame = shift;
 255     print "runtests.pl received SIG$signame, exiting\r\n";
 256     $globalabort = 1;
 257 }
 258 $SIG{INT} = \&catch_zap;
 259 $SIG{TERM} = \&catch_zap;
 260
 261 sub catch_usr1 {
 262     print "runtests.pl internal state:\r\n";
 263     print scalar(%runnersrunning) . " busy test runner(s) of " . scalar(keys %runnerids) . "\r\n";
 264     foreach my $rid (sort(keys(%runnersrunning))) {
 265         my $runnernum = "unknown";
 266         foreach my $rnum (keys %runnerids) {
 267             if($runnerids{$rnum} == $rid) {
 268                 $runnernum = $rnum;
 269                 last;
 270             }
 271         }
 272         print "Runner $runnernum (id $rid) running test $runnersrunning{$rid} in state $singletest_state{$rid}\r\n";
 273     }
 274 }
 275
 276 eval {
 277     # some msys2 perl versions don't define SIGUSR1
 278     $SIG{USR1} = \&catch_usr1;
 279 };
 280 $SIG{PIPE} = 'IGNORE';  # these errors are captured in the read/write calls
 281
 282 ##########################################################################
 283 # Clear all possible '*_proxy' environment variables for various protocols
 284 # to prevent them to interfere with our testing!
 285
 286 foreach my $protocol (('ftp', 'http', 'ftps', 'https', 'no', 'all')) {
 287     my $proxy = "${protocol}_proxy";
 288     # clear lowercase version
 289     delete $ENV{$proxy} if($ENV{$proxy});
 290     # clear uppercase version
 291     delete $ENV{uc($proxy)} if($ENV{uc($proxy)});
 292 }
 293
 294 # make sure we don't get affected by other variables that control our
 295 # behavior
 296
 297 delete $ENV{'SSL_CERT_DIR'} if($ENV{'SSL_CERT_DIR'});
 298 delete $ENV{'SSL_CERT_PATH'} if($ENV{'SSL_CERT_PATH'});
 299 delete $ENV{'CURL_CA_BUNDLE'} if($ENV{'CURL_CA_BUNDLE'});
 300
 301 # provide defaults from our config file for ENV vars not explicitly
 302 # set by the caller
 303 if (open(my $fd, "<", "config")) {
 304     while(my $line = <$fd>) {
 305         next if ($line =~ /^#/);
 306         chomp $line;
 307         my ($name, $val) = split(/\s*:\s*/, $line, 2);
 308         $ENV{$name} = $val if(!$ENV{$name});
 309     }
 310     close($fd);
 311 }
 312
 313 # Check if we have nghttpx available and if it talks http/3
 314 my $nghttpx_h3 = 0;
 315 if (!$ENV{"NGHTTPX"}) {
 316     $ENV{"NGHTTPX"} = checktestcmd("nghttpx");
 317 }
 318 if ($ENV{"NGHTTPX"}) {
 319     my $nghttpx_version=join(' ', `"$ENV{'NGHTTPX'}" -v 2>/dev/null`);
 320     $nghttpx_h3 = $nghttpx_version =~ /nghttp3\//;
 321     chomp $nghttpx_h3;
 322 }
 323
 324
 325 #######################################################################
 326 # Get the list of tests that the tests/data/Makefile.am knows about!
 327 #
 328 my $disttests = "";
 329 sub get_disttests {
 330     # If a non-default $TESTDIR is being used there may not be any
 331     # Makefile.inc in which case there's nothing to do.
 332     open(my $dh, "<", "$TESTDIR/Makefile.inc") or return;
 333     while(<$dh>) {
 334         chomp $_;
 335         if(($_ =~ /^#/) ||($_ !~ /test/)) {
 336             next;
 337         }
 338         $disttests .= $_;
 339     }
 340     close($dh);
 341 }
 342
 343
 344 #######################################################################
 345 # Remove all files in the specified directory
 346 #
 347 sub cleardir {
 348     my $dir = $_[0];
 349     my $done = 1;  # success
 350     my $file;
 351
 352     # Get all files
 353     opendir(my $dh, $dir) ||
 354         return 0; # can't open dir
 355     while($file = readdir($dh)) {
 356         # Don't clear the $PIDDIR or $LOCKDIR since those need to live beyond
 357         # one test
 358         if(($file !~ /^(\.|\.\.)\z/) &&
 359             "$file" ne $PIDDIR && "$file" ne $LOCKDIR) {
 360             if(-d "$dir/$file") {
 361                 if(!cleardir("$dir/$file")) {
 362                     $done = 0;
 363                 }
 364                 if(!rmdir("$dir/$file")) {
 365                     $done = 0;
 366                 }
 367             }
 368             else {
 369                 # Ignore stunnel since we cannot do anything about its locks
 370                 if(!unlink("$dir/$file") && "$file" !~ /_stunnel\.log$/) {
 371                     $done = 0;
 372                 }
 373             }
 374         }
 375     }
 376     closedir $dh;
 377     return $done;
 378 }
 379
 380
 381 #######################################################################
 382 # Given two array references, this function will store them in two temporary
 383 # files, run 'diff' on them, store the result and return the diff output!
 384 sub showdiff {
 385     my ($logdir, $firstref, $secondref)=@_;
 386
 387     my $file1="$logdir/check-generated";
 388     my $file2="$logdir/check-expected";
 389
 390     open(my $temp, ">", "$file1") || die "Failure writing diff file";
 391     for(@$firstref) {
 392         my $l = $_;
 393         $l =~ s/\r/[CR]/g;
 394         $l =~ s/\n/[LF]/g;
 395         $l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
 396         print $temp $l;
 397         print $temp "\n";
 398     }
 399     close($temp) || die "Failure writing diff file";
 400
 401     open($temp, ">", "$file2") || die "Failure writing diff file";
 402     for(@$secondref) {
 403         my $l = $_;
 404         $l =~ s/\r/[CR]/g;
 405         $l =~ s/\n/[LF]/g;
 406         $l =~ s/([^\x20-\x7f])/sprintf "%%%02x", ord $1/eg;
 407         print $temp $l;
 408         print $temp "\n";
 409     }
 410     close($temp) || die "Failure writing diff file";
 411     my @out = `diff -u $file2 $file1 2>/dev/null`;
 412
 413     if(!$out[0]) {
 414         @out = `diff -c $file2 $file1 2>/dev/null`;
 415     }
 416
 417     return @out;
 418 }
 419
 420
 421 #######################################################################
 422 # compare test results with the expected output, we might filter off
 423 # some pattern that is allowed to differ, output test results
 424 #
 425 sub compare {
 426     my ($runnerid, $testnum, $testname, $subject, $firstref, $secondref)=@_;
 427
 428     my $result = compareparts($firstref, $secondref);
 429
 430     if($result) {
 431         # timestamp test result verification end
 432         $timevrfyend{$testnum} = Time::HiRes::time();
 433
 434         if(!$short) {
 435             logmsg "\n $testnum: $subject FAILED:\n";
 436             my $logdir = getrunnerlogdir($runnerid);
 437             logmsg showdiff($logdir, $firstref, $secondref);
 438         }
 439         elsif(!$automakestyle) {
 440             logmsg "FAILED\n";
 441         }
 442         else {
 443             # automakestyle
 444             logmsg "FAIL: $testnum - $testname - $subject\n";
 445         }
 446     }
 447     return $result;
 448 }
 449
 450 #######################################################################
 451 # Parse and store the protocols in curl's Protocols: line
 452 sub parseprotocols {
 453     my ($line)=@_;
 454
 455     @protocols = split(' ', lc($line));
 456
 457     # Generate a "proto-ipv6" version of each protocol to match the
 458     # IPv6 <server> name and a "proto-unix" to match the variant which
 459     # uses Unix domain sockets. This works even if support isn't
 460     # compiled in because the <features> test will fail.
 461     push @protocols, map(("$_-ipv6", "$_-unix"), @protocols);
 462
 463     # 'http-proxy' is used in test cases to do CONNECT through
 464     push @protocols, 'http-proxy';
 465
 466     # 'none' is used in test cases to mean no server
 467     push @protocols, 'none';
 468 }
 469
 470
 471 #######################################################################
 472 # Check & display information about curl and the host the test suite runs on.
 473 # Information to do with servers is displayed in displayserverfeatures, after
 474 # the server initialization is performed.
 475 sub checksystemfeatures {
 476     my $feat;
 477     my $curl;
 478     my $libcurl;
 479     my $versretval;
 480     my $versnoexec;
 481     my @version=();
 482     my @disabled;
 483     my $dis = "";
 484
 485     my $curlverout="$LOGDIR/curlverout.log";
 486     my $curlvererr="$LOGDIR/curlvererr.log";
 487     my $versioncmd=shell_quote($CURL) . " --version 1>$curlverout 2>$curlvererr";
 488
 489     unlink($curlverout);
 490     unlink($curlvererr);
 491
 492     $versretval = runclient($versioncmd);
 493     $versnoexec = $!;
 494
 495     open(my $versout, "<", "$curlverout");
 496     @version = <$versout>;
 497     close($versout);
 498
 499     open(my $disabledh, "-|", "server/disabled".exe_ext('TOOL'));
 500     @disabled = <$disabledh>;
 501     close($disabledh);
 502
 503     if($disabled[0]) {
 504         s/[\r\n]//g for @disabled;
 505         $dis = join(", ", @disabled);
 506     }
 507
 508     $resolver="stock";
 509     for(@version) {
 510         chomp;
 511
 512         if($_ =~ /^curl ([^ ]*)/) {
 513             $curl = $_;
 514             $CURLVERSION = $1;
 515             $curl =~ s/^(.*)(libcurl.*)/$1/g || die "Failure determining curl binary version";
 516
 517             $libcurl = $2;
 518             if($curl =~ /linux|bsd|solaris/) {
 519                 # system support LD_PRELOAD; may be disabled later
 520                 $feature{"ld_preload"} = 1;
 521             }
 522             if($curl =~ /win32|Windows|mingw(32|64)/) {
 523                 # This is a Windows MinGW build or native build, we need to use
 524                 # Win32-style path.
 525                 $pwd = sys_native_current_path();
 526                 $has_textaware = 1;
 527                 $feature{"win32"} = 1;
 528                 # set if built with MinGW (as opposed to MinGW-w64)
 529                 $feature{"MinGW"} = 1 if ($curl =~ /-pc-mingw32/);
 530             }
 531            if ($libcurl =~ /\s(winssl|schannel)\b/i) {
 532                $feature{"Schannel"} = 1;
 533                $feature{"SSLpinning"} = 1;
 534            }
 535            elsif ($libcurl =~ /\sopenssl\b/i) {
 536                $feature{"OpenSSL"} = 1;
 537                $feature{"SSLpinning"} = 1;
 538            }
 539            elsif ($libcurl =~ /\sgnutls\b/i) {
 540                $feature{"GnuTLS"} = 1;
 541                $feature{"SSLpinning"} = 1;
 542            }
 543            elsif ($libcurl =~ /\srustls-ffi\b/i) {
 544                $feature{"rustls"} = 1;
 545            }
 546            elsif ($libcurl =~ /\swolfssl\b/i) {
 547                $feature{"wolfssl"} = 1;
 548                $feature{"SSLpinning"} = 1;
 549            }
 550            elsif ($libcurl =~ /\sbearssl\b/i) {
 551                $feature{"bearssl"} = 1;
 552            }
 553            elsif ($libcurl =~ /\ssecuretransport\b/i) {
 554                $feature{"sectransp"} = 1;
 555                $feature{"SSLpinning"} = 1;
 556            }
 557            elsif ($libcurl =~ /\sBoringSSL\b/i) {
 558                # OpenSSL compatible API
 559                $feature{"OpenSSL"} = 1;
 560                $feature{"SSLpinning"} = 1;
 561            }
 562            elsif ($libcurl =~ /\slibressl\b/i) {
 563                # OpenSSL compatible API
 564                $feature{"OpenSSL"} = 1;
 565                $feature{"SSLpinning"} = 1;
 566            }
 567            elsif ($libcurl =~ /\smbedTLS\b/i) {
 568                $feature{"mbedtls"} = 1;
 569                $feature{"SSLpinning"} = 1;
 570            }
 571            if ($libcurl =~ /ares/i) {
 572                $feature{"c-ares"} = 1;
 573                $resolver="c-ares";
 574            }
 575            if ($libcurl =~ /Hyper/i) {
 576                $feature{"hyper"} = 1;
 577            }
 578             if ($libcurl =~ /nghttp2/i) {
 579                 # nghttp2 supports h2c, hyper does not
 580                 $feature{"h2c"} = 1;
 581             }
 582             if ($libcurl =~ /libssh2/i) {
 583                 $feature{"libssh2"} = 1;
 584             }
 585             if ($libcurl =~ /libssh\/([0-9.]*)\//i) {
 586                 $feature{"libssh"} = 1;
 587                 if($1 =~ /(\d+)\.(\d+).(\d+)/) {
 588                     my $v = $1 * 100 + $2 * 10 + $3;
 589                     if($v < 94) {
 590                         # before 0.9.4
 591                         $feature{"oldlibssh"} = 1;
 592                     }
 593                 }
 594             }
 595             if ($libcurl =~ /wolfssh/i) {
 596                 $feature{"wolfssh"} = 1;
 597             }
 598         }
 599         elsif($_ =~ /^Protocols: (.*)/i) {
 600             # these are the protocols compiled in to this libcurl
 601             parseprotocols($1);
 602         }
 603         elsif($_ =~ /^Features: (.*)/i) {
 604             $feat = $1;
 605
 606             # built with memory tracking support (--enable-curldebug); may be disabled later
 607             $feature{"TrackMemory"} = $feat =~ /TrackMemory/i;
 608             # curl was built with --enable-debug
 609             $feature{"debug"} = $feat =~ /debug/i;
 610             # ssl enabled
 611             $feature{"SSL"} = $feat =~ /SSL/i;
 612             # multiple ssl backends available.
 613             $feature{"MultiSSL"} = $feat =~ /MultiSSL/i;
 614             # large file support
 615             $feature{"large_file"} = $feat =~ /Largefile/i;
 616             # IDN support
 617             $feature{"idn"} = $feat =~ /IDN/i;
 618             # IPv6 support
 619             $feature{"ipv6"} = $feat =~ /IPv6/i;
 620             # Unix sockets support
 621             $feature{"unix-sockets"} = $feat =~ /UnixSockets/i;
 622             # libz compression
 623             $feature{"libz"} = $feat =~ /libz/i;
 624             # Brotli compression
 625             $feature{"brotli"} = $feat =~ /brotli/i;
 626             # Zstd compression
 627             $feature{"zstd"} = $feat =~ /zstd/i;
 628             # NTLM enabled
 629             $feature{"NTLM"} = $feat =~ /NTLM/i;
 630             # NTLM delegation to winbind daemon ntlm_auth helper enabled
 631             $feature{"NTLM_WB"} = $feat =~ /NTLM_WB/i;
 632             # SSPI enabled
 633             $feature{"SSPI"} = $feat =~ /SSPI/i;
 634             # GSS-API enabled
 635             $feature{"GSS-API"} = $feat =~ /GSS-API/i;
 636             # Kerberos enabled
 637             $feature{"Kerberos"} = $feat =~ /Kerberos/i;
 638             # SPNEGO enabled
 639             $feature{"SPNEGO"} = $feat =~ /SPNEGO/i;
 640             # CharConv enabled
 641             $feature{"CharConv"} = $feat =~ /CharConv/i;
 642             # TLS-SRP enabled
 643             $feature{"TLS-SRP"} = $feat =~ /TLS-SRP/i;
 644             # PSL enabled
 645             $feature{"PSL"} = $feat =~ /PSL/i;
 646             # alt-svc enabled
 647             $feature{"alt-svc"} = $feat =~ /alt-svc/i;
 648             # HSTS support
 649             $feature{"HSTS"} = $feat =~ /HSTS/i;
 650             if($feat =~ /AsynchDNS/i) {
 651                 if(!$feature{"c-ares"}) {
 652                     # this means threaded resolver
 653                     $feature{"threaded-resolver"} = 1;
 654                     $resolver="threaded";
 655                 }
 656             }
 657             # http2 enabled
 658             $feature{"http/2"} = $feat =~ /HTTP2/;
 659             if($feature{"http/2"}) {
 660                 push @protocols, 'http/2';
 661             }
 662             # http3 enabled
 663             $feature{"http/3"} = $feat =~ /HTTP3/;
 664             if($feature{"http/3"}) {
 665                 push @protocols, 'http/3';
 666             }
 667             # https proxy support
 668             $feature{"https-proxy"} = $feat =~ /HTTPS-proxy/;
 669             if($feature{"https-proxy"}) {
 670                 # 'https-proxy' is used as "server" so consider it a protocol
 671                 push @protocols, 'https-proxy';
 672             }
 673             # UNICODE support
 674             $feature{"Unicode"} = $feat =~ /Unicode/i;
 675             # Thread-safe init
 676             $feature{"threadsafe"} = $feat =~ /threadsafe/i;
 677         }
 678         #
 679         # Test harness currently uses a non-stunnel server in order to
 680         # run HTTP TLS-SRP tests required when curl is built with https
 681         # protocol support and TLS-SRP feature enabled. For convenience
 682         # 'httptls' may be included in the test harness protocols array
 683         # to differentiate this from classic stunnel based 'https' test
 684         # harness server.
 685         #
 686         if($feature{"TLS-SRP"}) {
 687             my $add_httptls;
 688             for(@protocols) {
 689                 if($_ =~ /^https(-ipv6|)$/) {
 690                     $add_httptls=1;
 691                     last;
 692                 }
 693             }
 694             if($add_httptls && (! grep /^httptls$/, @protocols)) {
 695                 push @protocols, 'httptls';
 696                 push @protocols, 'httptls-ipv6';
 697             }
 698         }
 699     }
 700
 701     if(!$curl) {
 702         logmsg "unable to get curl's version, further details are:\n";
 703         logmsg "issued command: \n";
 704         logmsg "$versioncmd \n";
 705         if ($versretval == -1) {
 706             logmsg "command failed with: \n";
 707             logmsg "$versnoexec \n";
 708         }
 709         elsif ($versretval & 127) {
 710             logmsg sprintf("command died with signal %d, and %s coredump.\n",
 711                            ($versretval & 127), ($versretval & 128)?"a":"no");
 712         }
 713         else {
 714             logmsg sprintf("command exited with value %d \n", $versretval >> 8);
 715         }
 716         logmsg "contents of $curlverout: \n";
 717         displaylogcontent("$curlverout");
 718         logmsg "contents of $curlvererr: \n";
 719         displaylogcontent("$curlvererr");
 720         die "couldn't get curl's version";
 721     }
 722
 723     if(-r "../lib/curl_config.h") {
 724         open(my $conf, "<", "../lib/curl_config.h");
 725         while(<$conf>) {
 726             if($_ =~ /^\#define HAVE_GETRLIMIT/) {
 727                 # set if system has getrlimit()
 728                 $feature{"getrlimit"} = 1;
 729             }
 730         }
 731         close($conf);
 732     }
 733
 734     # allow this feature only if debug mode is disabled
 735     $feature{"ld_preload"} = $feature{"ld_preload"} && !$feature{"debug"};
 736
 737     if($feature{"ipv6"}) {
 738         # client has IPv6 support
 739
 740         # check if the HTTP server has it!
 741         my $cmd = "server/sws".exe_ext('SRV')." --version";
 742         my @sws = `$cmd`;
 743         if($sws[0] =~ /IPv6/) {
 744             # HTTP server has IPv6 support!
 745             $http_ipv6 = 1;
 746         }
 747
 748         # check if the FTP server has it!
 749         $cmd = "server/sockfilt".exe_ext('SRV')." --version";
 750         @sws = `$cmd`;
 751         if($sws[0] =~ /IPv6/) {
 752             # FTP server has IPv6 support!
 753             $ftp_ipv6 = 1;
 754         }
 755     }
 756
 757     if($feature{"unix-sockets"}) {
 758         # client has Unix sockets support, check whether the HTTP server has it
 759         my $cmd = "server/sws".exe_ext('SRV')." --version";
 760         my @sws = `$cmd`;
 761         $http_unix = 1 if($sws[0] =~ /unix/);
 762     }
 763
 764     open(my $manh, "-|", shell_quote($CURL) . " -M 2>&1");
 765     while(my $s = <$manh>) {
 766         if($s =~ /built-in manual was disabled at build-time/) {
 767             $feature{"manual"} = 0;
 768             last;
 769         }
 770         $feature{"manual"} = 1;
 771         last;
 772     }
 773     close($manh);
 774
 775     $feature{"unittest"} = $feature{"debug"};
 776     $feature{"nghttpx"} = !!$ENV{'NGHTTPX'};
 777     $feature{"nghttpx-h3"} = !!$nghttpx_h3;
 778
 779     #
 780     # strings that must exactly match the names used in server/disabled.c
 781     #
 782     $feature{"cookies"} = 1;
 783     # Use this as a proxy for any cryptographic authentication
 784     $feature{"crypto"} = $feature{"NTLM"} || $feature{"Kerberos"} || $feature{"SPNEGO"};
 785     $feature{"DoH"} = 1;
 786     $feature{"HTTP-auth"} = 1;
 787     $feature{"Mime"} = 1;
 788     $feature{"form-api"} = 1;
 789     $feature{"netrc"} = 1;
 790     $feature{"parsedate"} = 1;
 791     $feature{"proxy"} = 1;
 792     $feature{"shuffle-dns"} = 1;
 793     $feature{"typecheck"} = 1;
 794     $feature{"verbose-strings"} = 1;
 795     $feature{"wakeup"} = 1;
 796     $feature{"headers-api"} = 1;
 797     $feature{"xattr"} = 1;
 798     $feature{"large-time"} = 1;
 799
 800     # make each protocol an enabled "feature"
 801     for my $p (@protocols) {
 802         $feature{$p} = 1;
 803     }
 804     # 'socks' was once here but is now removed
 805
 806     $has_shared = `sh $CURLCONFIG --built-shared`;
 807     chomp $has_shared;
 808     $has_shared = $has_shared eq "yes";
 809
 810     if(!$feature{"TrackMemory"} && $torture) {
 811         die "can't run torture tests since curl was built without ".
 812             "TrackMemory feature (--enable-curldebug)";
 813     }
 814
 815     my $hostname=join(' ', runclientoutput("hostname"));
 816     my $hosttype=join(' ', runclientoutput("uname -a"));
 817     my $hostos=$^O;
 818
 819     # display summary information about curl and the test host
 820     logmsg ("********* System characteristics ******** \n",
 821             "* $curl\n",
 822             "* $libcurl\n",
 823             "* Features: $feat\n",
 824             "* Disabled: $dis\n",
 825             "* Host: $hostname",
 826             "* System: $hosttype",
 827             "* OS: $hostos\n");
 828
 829     if($jobs) {
 830         # Only show if not the default for now
 831         logmsg "* Jobs: $jobs\n";
 832     }
 833     if($feature{"TrackMemory"} && $feature{"threaded-resolver"}) {
 834         logmsg("*\n",
 835                "*** DISABLES memory tracking when using threaded resolver\n",
 836                "*\n");
 837     }
 838
 839     logmsg sprintf("* Env: %s%s%s", $valgrind?"Valgrind ":"",
 840                    $run_event_based?"event-based ":"",
 841                    $nghttpx_h3);
 842     logmsg sprintf("%s\n", $libtool?"Libtool ":"");
 843     logmsg ("* Seed: $randseed\n");
 844
 845     # Disable memory tracking when using threaded resolver
 846     $feature{"TrackMemory"} = $feature{"TrackMemory"} && !$feature{"threaded-resolver"};
 847
 848     # toggle off the features that were disabled in the build
 849     for my $d(@disabled) {
 850         $feature{$d} = 0;
 851     }
 852 }
 853
 854 #######################################################################
 855 # display information about server features
 856 #
 857 sub displayserverfeatures {
 858     logmsg sprintf("* Servers: %s", $stunnel?"SSL ":"");
 859     logmsg sprintf("%s", $http_ipv6?"HTTP-IPv6 ":"");
 860     logmsg sprintf("%s", $http_unix?"HTTP-unix ":"");
 861     logmsg sprintf("%s\n", $ftp_ipv6?"FTP-IPv6 ":"");
 862     logmsg "***************************************** \n";
 863 }
 864
 865 #######################################################################
 866 # Provide time stamps for single test skipped events
 867 #
 868 sub timestampskippedevents {
 869     my $testnum = $_[0];
 870
 871     return if((not defined($testnum)) || ($testnum < 1));
 872
 873     if($timestats) {
 874
 875         if($timevrfyend{$testnum}) {
 876             return;
 877         }
 878         elsif($timesrvrlog{$testnum}) {
 879             $timevrfyend{$testnum} = $timesrvrlog{$testnum};
 880             return;
 881         }
 882         elsif($timetoolend{$testnum}) {
 883             $timevrfyend{$testnum} = $timetoolend{$testnum};
 884             $timesrvrlog{$testnum} = $timetoolend{$testnum};
 885         }
 886         elsif($timetoolini{$testnum}) {
 887             $timevrfyend{$testnum} = $timetoolini{$testnum};
 888             $timesrvrlog{$testnum} = $timetoolini{$testnum};
 889             $timetoolend{$testnum} = $timetoolini{$testnum};
 890         }
 891         elsif($timesrvrend{$testnum}) {
 892             $timevrfyend{$testnum} = $timesrvrend{$testnum};
 893             $timesrvrlog{$testnum} = $timesrvrend{$testnum};
 894             $timetoolend{$testnum} = $timesrvrend{$testnum};
 895             $timetoolini{$testnum} = $timesrvrend{$testnum};
 896         }
 897         elsif($timesrvrini{$testnum}) {
 898             $timevrfyend{$testnum} = $timesrvrini{$testnum};
 899             $timesrvrlog{$testnum} = $timesrvrini{$testnum};
 900             $timetoolend{$testnum} = $timesrvrini{$testnum};
 901             $timetoolini{$testnum} = $timesrvrini{$testnum};
 902             $timesrvrend{$testnum} = $timesrvrini{$testnum};
 903         }
 904         elsif($timeprepini{$testnum}) {
 905             $timevrfyend{$testnum} = $timeprepini{$testnum};
 906             $timesrvrlog{$testnum} = $timeprepini{$testnum};
 907             $timetoolend{$testnum} = $timeprepini{$testnum};
 908             $timetoolini{$testnum} = $timeprepini{$testnum};
 909             $timesrvrend{$testnum} = $timeprepini{$testnum};
 910             $timesrvrini{$testnum} = $timeprepini{$testnum};
 911         }
 912     }
 913 }
 914
 915
 916 # Setup CI Test Run
 917 sub citest_starttestrun {
 918     if(azure_check_environment()) {
 919         $AZURE_RUN_ID = azure_create_test_run($ACURL);
 920         logmsg "Azure Run ID: $AZURE_RUN_ID\n" if ($verbose);
 921     }
 922     # Appveyor doesn't require anything here
 923 }
 924
 925
 926 # Register the test case with the CI runner
 927 sub citest_starttest {
 928     my $testnum = $_[0];
 929
 930     # get the name of the test early
 931     my $testname= (getpart("client", "name"))[0];
 932     chomp $testname;
 933
 934     # create test result in CI services
 935     if(azure_check_environment() && $AZURE_RUN_ID) {
 936         $AZURE_RESULT_ID = azure_create_test_result($ACURL, $AZURE_RUN_ID, $testnum, $testname);
 937     }
 938     elsif(appveyor_check_environment()) {
 939         appveyor_create_test_result($ACURL, $testnum, $testname);
 940     }
 941 }
 942
 943
 944 # Submit the test case result with the CI runner
 945 sub citest_finishtest {
 946     my ($testnum, $error) = @_;
 947     # update test result in CI services
 948     if(azure_check_environment() && $AZURE_RUN_ID && $AZURE_RESULT_ID) {
 949         $AZURE_RESULT_ID = azure_update_test_result($ACURL, $AZURE_RUN_ID, $AZURE_RESULT_ID, $testnum, $error,
 950                                                     $timeprepini{$testnum}, $timevrfyend{$testnum});
 951     }
 952     elsif(appveyor_check_environment()) {
 953         appveyor_update_test_result($ACURL, $testnum, $error, $timeprepini{$testnum}, $timevrfyend{$testnum});
 954     }
 955 }
 956
 957 # Complete CI test run
 958 sub citest_finishtestrun {
 959     if(azure_check_environment() && $AZURE_RUN_ID) {
 960         $AZURE_RUN_ID = azure_update_test_run($ACURL, $AZURE_RUN_ID);
 961     }
 962     # Appveyor doesn't require anything here
 963 }
 964
 965
 966 # add one set of test timings from the runner to global set
 967 sub updatetesttimings {
 968     my ($testnum, %testtimings)=@_;
 969
 970     if(defined $testtimings{"timeprepini"}) {
 971         $timeprepini{$testnum} = $testtimings{"timeprepini"};
 972     }
 973     if(defined $testtimings{"timesrvrini"}) {
 974         $timesrvrini{$testnum} = $testtimings{"timesrvrini"};
 975     }
 976     if(defined $testtimings{"timesrvrend"}) {
 977         $timesrvrend{$testnum} = $testtimings{"timesrvrend"};
 978     }
 979     if(defined $testtimings{"timetoolini"}) {
 980         $timetoolini{$testnum} = $testtimings{"timetoolini"};
 981     }
 982     if(defined $testtimings{"timetoolend"}) {
 983         $timetoolend{$testnum} = $testtimings{"timetoolend"};
 984     }
 985     if(defined $testtimings{"timesrvrlog"}) {
 986         $timesrvrlog{$testnum} = $testtimings{"timesrvrlog"};
 987     }
 988 }
 989
 990
 991 #######################################################################
 992 # Return the log directory for the given test runner
 993 sub getrunnernumlogdir {
 994     my $runnernum = $_[0];
 995     return $jobs > 1 ? "$LOGDIR/$runnernum" : $LOGDIR;
 996 }
 997
 998 #######################################################################
 999 # Return the log directory for the given test runner ID
1000 sub getrunnerlogdir {
1001     my $runnerid = $_[0];
1002     if($jobs <= 1) {
1003         return $LOGDIR;
1004     }
1005     # TODO: speed up this O(n) operation
1006     for my $runnernum (keys %runnerids) {
1007         if($runnerid eq $runnerids{$runnernum}) {
1008             return "$LOGDIR/$runnernum";
1009         }
1010     }
1011     die "Internal error: runner ID $runnerid not found";
1012 }
1013
1014
1015 #######################################################################
1016 # Verify that this test case should be run
1017 sub singletest_shouldrun {
1018     my $testnum = $_[0];
1019     my $why;   # why the test won't be run
1020     my $errorreturncode = 1; # 1 means normal error, 2 means ignored error
1021     my @what;  # what features are needed
1022
1023     if($disttests !~ /test$testnum(\W|\z)/ ) {
1024         logmsg "Warning: test$testnum not present in tests/data/Makefile.inc\n";
1025     }
1026     if($disabled{$testnum}) {
1027         if(!$run_disabled) {
1028             $why = "listed in DISABLED";
1029         }
1030         else {
1031             logmsg "Warning: test$testnum is explicitly disabled\n";
1032         }
1033     }
1034     if($ignored{$testnum}) {
1035         logmsg "Warning: test$testnum result is ignored\n";
1036         $errorreturncode = 2;
1037     }
1038
1039     if(loadtest("${TESTDIR}/test${testnum}")) {
1040         if($verbose) {
1041             # this is not a test
1042             logmsg "RUN: $testnum doesn't look like a test case\n";
1043         }
1044         $why = "no test";
1045     }
1046     else {
1047         @what = getpart("client", "features");
1048     }
1049
1050     # We require a feature to be present
1051     for(@what) {
1052         my $f = $_;
1053         $f =~ s/\s//g;
1054
1055         if($f =~ /^([^!].*)$/) {
1056             if($feature{$1}) {
1057                 next;
1058             }
1059
1060             $why = "curl lacks $1 support";
1061             last;
1062         }
1063     }
1064
1065     # We require a feature to not be present
1066     if(!$why) {
1067         for(@what) {
1068             my $f = $_;
1069             $f =~ s/\s//g;
1070
1071             if($f =~ /^!(.*)$/) {
1072                 if(!$feature{$1}) {
1073                     next;
1074                 }
1075             }
1076             else {
1077                 next;
1078             }
1079
1080             $why = "curl has $1 support";
1081             last;
1082         }
1083     }
1084
1085     my @info_keywords;
1086     if(!$why) {
1087         @info_keywords = getpart("info", "keywords");
1088
1089         if(!$info_keywords[0]) {
1090             $why = "missing the <keywords> section!";
1091         }
1092
1093         my $match;
1094         for my $k (@info_keywords) {
1095             chomp $k;
1096             if ($disabled_keywords{lc($k)}) {
1097                 $why = "disabled by keyword";
1098             }
1099             elsif ($enabled_keywords{lc($k)}) {
1100                 $match = 1;
1101             }
1102             if ($ignored_keywords{lc($k)}) {
1103                 logmsg "Warning: test$testnum result is ignored due to $k\n";
1104                 $errorreturncode = 2;
1105             }
1106         }
1107
1108         if(!$why && !$match && %enabled_keywords) {
1109             $why = "disabled by missing keyword";
1110         }
1111     }
1112
1113     if (!$why && defined $custom_skip_reasons{test}{$testnum}) {
1114         $why = $custom_skip_reasons{test}{$testnum};
1115     }
1116
1117     if (!$why && defined $custom_skip_reasons{tool}) {
1118         foreach my $tool (getpart("client", "tool")) {
1119             foreach my $tool_skip_pattern (keys %{$custom_skip_reasons{tool}}) {
1120                 if ($tool =~ /$tool_skip_pattern/i) {
1121                     $why = $custom_skip_reasons{tool}{$tool_skip_pattern};
1122                 }
1123             }
1124         }
1125     }
1126
1127     if (!$why && defined $custom_skip_reasons{keyword}) {
1128         foreach my $keyword (@info_keywords) {
1129             foreach my $keyword_skip_pattern (keys %{$custom_skip_reasons{keyword}}) {
1130                 if ($keyword =~ /$keyword_skip_pattern/i) {
1131                     $why = $custom_skip_reasons{keyword}{$keyword_skip_pattern};
1132                 }
1133             }
1134         }
1135     }
1136
1137     return ($why, $errorreturncode);
1138 }
1139
1140
1141 #######################################################################
1142 # Print the test name and count tests
1143 sub singletest_count {
1144     my ($testnum, $why) = @_;
1145
1146     if($why && !$listonly) {
1147         # there's a problem, count it as "skipped"
1148         $skipped{$why}++;
1149         $teststat[$testnum]=$why; # store reason for this test case
1150
1151         if(!$short) {
1152             if($skipped{$why} <= 3) {
1153                 # show only the first three skips for each reason
1154                 logmsg sprintf("test %04d SKIPPED: $why\n", $testnum);
1155             }
1156         }
1157
1158         timestampskippedevents($testnum);
1159         return -1;
1160     }
1161
1162     # At this point we've committed to run this test
1163     logmsg sprintf("test %04d...", $testnum) if(!$automakestyle);
1164
1165     # name of the test
1166     my $testname= (getpart("client", "name"))[0];
1167     chomp $testname;
1168     logmsg "[$testname]\n" if(!$short);
1169
1170     if($listonly) {
1171         timestampskippedevents($testnum);
1172     }
1173     return 0;
1174 }
1175
1176
1177 #######################################################################
1178 # Verify test succeeded
1179 sub singletest_check {
1180     my ($runnerid, $testnum, $cmdres, $CURLOUT, $tool, $usedvalgrind)=@_;
1181
1182     # Skip all the verification on torture tests
1183     if ($torture) {
1184         # timestamp test result verification end
1185         $timevrfyend{$testnum} = Time::HiRes::time();
1186         return -2;
1187     }
1188
1189     my $logdir = getrunnerlogdir($runnerid);
1190     my @err = getpart("verify", "errorcode");
1191     my $errorcode = $err[0] || "0";
1192     my $ok="";
1193     my $res;
1194     chomp $errorcode;
1195     my $testname= (getpart("client", "name"))[0];
1196     chomp $testname;
1197     # what parts to cut off from stdout/stderr
1198     my @stripfile = getpart("verify", "stripfile");
1199
1200     my @validstdout = getpart("verify", "stdout");
1201     # get all attributes
1202     my %hash = getpartattr("verify", "stdout");
1203
1204     my $loadfile = $hash{'loadfile'};
1205     if ($loadfile) {
1206         open(my $tmp, "<", "$loadfile") || die "Cannot open file $loadfile: $!";
1207         @validstdout = <$tmp>;
1208         close($tmp);
1209
1210         # Enforce LF newlines on load
1211         s/\r\n/\n/g for @validstdout;
1212     }
1213
1214     if (@validstdout) {
1215         # verify redirected stdout
1216         my @actual = loadarray(stdoutfilename($logdir, $testnum));
1217
1218         foreach my $strip (@stripfile) {
1219             chomp $strip;
1220             my @newgen;
1221             for(@actual) {
1222                 eval $strip;
1223                 if($_) {
1224                     push @newgen, $_;
1225                 }
1226             }
1227             # this is to get rid of array entries that vanished (zero
1228             # length) because of replacements
1229             @actual = @newgen;
1230         }
1231
1232         # get the mode attribute
1233         my $filemode=$hash{'mode'};
1234         if($filemode && ($filemode eq "text") && $has_textaware) {
1235             # text mode when running on windows: fix line endings
1236             s/\r\n/\n/g for @validstdout;
1237             s/\n/\r\n/g for @validstdout;
1238         }
1239
1240         if($hash{'nonewline'}) {
1241             # Yes, we must cut off the final newline from the final line
1242             # of the protocol data
1243             chomp($validstdout[-1]);
1244         }
1245
1246         if($hash{'crlf'} ||
1247            ($feature{"hyper"} && ($keywords{"HTTP"}
1248                            || $keywords{"HTTPS"}))) {
1249             subnewlines(0, \$_) for @validstdout;
1250         }
1251
1252         $res = compare($runnerid, $testnum, $testname, "stdout", \@actual, \@validstdout);
1253         if($res) {
1254             return -1;
1255         }
1256         $ok .= "s";
1257     }
1258     else {
1259         $ok .= "-"; # stdout not checked
1260     }
1261
1262     my @validstderr = getpart("verify", "stderr");
1263     if (@validstderr) {
1264         # verify redirected stderr
1265         my @actual = loadarray(stderrfilename($logdir, $testnum));
1266
1267         foreach my $strip (@stripfile) {
1268             chomp $strip;
1269             my @newgen;
1270             for(@actual) {
1271                 eval $strip;
1272                 if($_) {
1273                     push @newgen, $_;
1274                 }
1275             }
1276             # this is to get rid of array entries that vanished (zero
1277             # length) because of replacements
1278             @actual = @newgen;
1279         }
1280
1281         # get all attributes
1282         my %hash = getpartattr("verify", "stderr");
1283
1284         # get the mode attribute
1285         my $filemode=$hash{'mode'};
1286         if($filemode && ($filemode eq "text") && $feature{"hyper"}) {
1287             # text mode check in hyper-mode. Sometimes necessary if the stderr
1288             # data *looks* like HTTP and thus has gotten CRLF newlines
1289             # mistakenly
1290             s/\r\n/\n/g for @validstderr;
1291         }
1292         if($filemode && ($filemode eq "text") && $has_textaware) {
1293             # text mode when running on windows: fix line endings
1294             s/\r\n/\n/g for @validstderr;
1295             s/\n/\r\n/g for @validstderr;
1296         }
1297
1298         if($hash{'nonewline'}) {
1299             # Yes, we must cut off the final newline from the final line
1300             # of the protocol data
1301             chomp($validstderr[-1]);
1302         }
1303
1304         $res = compare($runnerid, $testnum, $testname, "stderr", \@actual, \@validstderr);
1305         if($res) {
1306             return -1;
1307         }
1308         $ok .= "r";
1309     }
1310     else {
1311         $ok .= "-"; # stderr not checked
1312     }
1313
1314     # what to cut off from the live protocol sent by curl
1315     my @strip = getpart("verify", "strip");
1316
1317     # what parts to cut off from the protocol & upload
1318     my @strippart = getpart("verify", "strippart");
1319
1320     # this is the valid protocol blurb curl should generate
1321     my @protocol= getpart("verify", "protocol");
1322     if(@protocol) {
1323         # Verify the sent request
1324         my @out = loadarray("$logdir/$SERVERIN");
1325
1326         # check if there's any attributes on the verify/protocol section
1327         my %hash = getpartattr("verify", "protocol");
1328
1329         if($hash{'nonewline'}) {
1330             # Yes, we must cut off the final newline from the final line
1331             # of the protocol data
1332             chomp($protocol[-1]);
1333         }
1334
1335         for(@strip) {
1336             # strip off all lines that match the patterns from both arrays
1337             chomp $_;
1338             @out = striparray( $_, \@out);
1339             @protocol= striparray( $_, \@protocol);
1340         }
1341
1342         for my $strip (@strippart) {
1343             chomp $strip;
1344             for(@out) {
1345                 eval $strip;
1346             }
1347         }
1348
1349         if($hash{'crlf'}) {
1350             subnewlines(1, \$_) for @protocol;
1351         }
1352
1353         if((!$out[0] || ($out[0] eq "")) && $protocol[0]) {
1354             logmsg "\n $testnum: protocol FAILED!\n".
1355                 " There was no content at all in the file $logdir/$SERVERIN.\n".
1356                 " Server glitch? Total curl failure? Returned: $cmdres\n";
1357             # timestamp test result verification end
1358             $timevrfyend{$testnum} = Time::HiRes::time();
1359             return -1;
1360         }
1361
1362         $res = compare($runnerid, $testnum, $testname, "protocol", \@out, \@protocol);
1363         if($res) {
1364             return -1;
1365         }
1366
1367         $ok .= "p";
1368
1369     }
1370     else {
1371         $ok .= "-"; # protocol not checked
1372     }
1373
1374     my %replyattr = getpartattr("reply", "data");
1375     my @reply;
1376     if (partexists("reply", "datacheck")) {
1377         for my $partsuffix (('', '1', '2', '3', '4')) {
1378             my @replycheckpart = getpart("reply", "datacheck".$partsuffix);
1379             if(@replycheckpart) {
1380                 my %replycheckpartattr = getpartattr("reply", "datacheck".$partsuffix);
1381                 # get the mode attribute
1382                 my $filemode=$replycheckpartattr{'mode'};
1383                 if($filemode && ($filemode eq "text") && $has_textaware) {
1384                     # text mode when running on windows: fix line endings
1385                     s/\r\n/\n/g for @replycheckpart;
1386                     s/\n/\r\n/g for @replycheckpart;
1387                 }
1388                 if($replycheckpartattr{'nonewline'}) {
1389                     # Yes, we must cut off the final newline from the final line
1390                     # of the datacheck
1391                     chomp($replycheckpart[-1]);
1392                 }
1393                 if($replycheckpartattr{'crlf'} ||
1394                    ($feature{"hyper"} && ($keywords{"HTTP"}
1395                                    || $keywords{"HTTPS"}))) {
1396                     subnewlines(0, \$_) for @replycheckpart;
1397                 }
1398                 push(@reply, @replycheckpart);
1399             }
1400         }
1401     }
1402     else {
1403         # check against the data section
1404         @reply = getpart("reply", "data");
1405         if(@reply) {
1406             if($replyattr{'nonewline'}) {
1407                 # cut off the final newline from the final line of the data
1408                 chomp($reply[-1]);
1409             }
1410         }
1411         # get the mode attribute
1412         my $filemode=$replyattr{'mode'};
1413         if($filemode && ($filemode eq "text") && $has_textaware) {
1414             # text mode when running on windows: fix line endings
1415             s/\r\n/\n/g for @reply;
1416             s/\n/\r\n/g for @reply;
1417         }
1418         if($replyattr{'crlf'} ||
1419            ($feature{"hyper"} && ($keywords{"HTTP"}
1420                            || $keywords{"HTTPS"}))) {
1421             subnewlines(0, \$_) for @reply;
1422         }
1423     }
1424
1425     if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
1426         # verify the received data
1427         my @out = loadarray($CURLOUT);
1428         $res = compare($runnerid, $testnum, $testname, "data", \@out, \@reply);
1429         if ($res) {
1430             return -1;
1431         }
1432         $ok .= "d";
1433     }
1434     else {
1435         $ok .= "-"; # data not checked
1436     }
1437
1438     # if this section exists, we verify upload
1439     my @upload = getpart("verify", "upload");
1440     if(@upload) {
1441         my %hash = getpartattr("verify", "upload");
1442         if($hash{'nonewline'}) {
1443             # cut off the final newline from the final line of the upload data
1444             chomp($upload[-1]);
1445         }
1446
1447         # verify uploaded data
1448         my @out = loadarray("$logdir/upload.$testnum");
1449         for my $strip (@strippart) {
1450             chomp $strip;
1451             for(@out) {
1452                 eval $strip;
1453             }
1454         }
1455
1456         $res = compare($runnerid, $testnum, $testname, "upload", \@out, \@upload);
1457         if ($res) {
1458             return -1;
1459         }
1460         $ok .= "u";
1461     }
1462     else {
1463         $ok .= "-"; # upload not checked
1464     }
1465
1466     # this is the valid protocol blurb curl should generate to a proxy
1467     my @proxyprot = getpart("verify", "proxy");
1468     if(@proxyprot) {
1469         # Verify the sent proxy request
1470         # check if there's any attributes on the verify/protocol section
1471         my %hash = getpartattr("verify", "proxy");
1472
1473         if($hash{'nonewline'}) {
1474             # Yes, we must cut off the final newline from the final line
1475             # of the protocol data
1476             chomp($proxyprot[-1]);
1477         }
1478
1479         my @out = loadarray("$logdir/$PROXYIN");
1480         for(@strip) {
1481             # strip off all lines that match the patterns from both arrays
1482             chomp $_;
1483             @out = striparray( $_, \@out);
1484             @proxyprot= striparray( $_, \@proxyprot);
1485         }
1486
1487         for my $strip (@strippart) {
1488             chomp $strip;
1489             for(@out) {
1490                 eval $strip;
1491             }
1492         }
1493
1494         if($hash{'crlf'} ||
1495            ($feature{"hyper"} && ($keywords{"HTTP"} || $keywords{"HTTPS"}))) {
1496             subnewlines(0, \$_) for @proxyprot;
1497         }
1498
1499         $res = compare($runnerid, $testnum, $testname, "proxy", \@out, \@proxyprot);
1500         if($res) {
1501             return -1;
1502         }
1503
1504         $ok .= "P";
1505
1506     }
1507     else {
1508         $ok .= "-"; # proxy not checked
1509     }
1510
1511     my $outputok;
1512     for my $partsuffix (('', '1', '2', '3', '4')) {
1513         my @outfile=getpart("verify", "file".$partsuffix);
1514         if(@outfile || partexists("verify", "file".$partsuffix) ) {
1515             # we're supposed to verify a dynamically generated file!
1516             my %hash = getpartattr("verify", "file".$partsuffix);
1517
1518             my $filename=$hash{'name'};
1519             if(!$filename) {
1520                 logmsg " $testnum: IGNORED: section verify=>file$partsuffix ".
1521                        "has no name attribute\n";
1522                 if (runnerac_stopservers($runnerid)) {
1523                     logmsg "ERROR: runner $runnerid seems to have died\n";
1524                 } else {
1525
1526                     # TODO: this is a blocking call that will stall the controller,
1527                     if($verbose) {
1528                         logmsg "WARNING: blocking call in async function\n";
1529                     }
1530                     # but this error condition should never happen except during
1531                     # development.
1532                     my ($rid, $unexpected, $logs) = runnerar($runnerid);
1533                     if(!$rid) {
1534                         logmsg "ERROR: runner $runnerid seems to have died\n";
1535                     } else {
1536                         logmsg $logs;
1537                     }
1538                 }
1539                 # timestamp test result verification end
1540                 $timevrfyend{$testnum} = Time::HiRes::time();
1541                 return -1;
1542             }
1543             my @generated=loadarray($filename);
1544
1545             # what parts to cut off from the file
1546             my @stripfilepar = getpart("verify", "stripfile".$partsuffix);
1547
1548             my $filemode=$hash{'mode'};
1549             if($filemode && ($filemode eq "text") && $has_textaware) {
1550                 # text mode when running on windows: fix line endings
1551                 s/\r\n/\n/g for @outfile;
1552                 s/\n/\r\n/g for @outfile;
1553             }
1554             if($hash{'crlf'} ||
1555                ($feature{"hyper"} && ($keywords{"HTTP"}
1556                                || $keywords{"HTTPS"}))) {
1557                 subnewlines(0, \$_) for @outfile;
1558             }
1559
1560             for my $strip (@stripfilepar) {
1561                 chomp $strip;
1562                 my @newgen;
1563                 for(@generated) {
1564                     eval $strip;
1565                     if($_) {
1566                         push @newgen, $_;
1567                     }
1568                 }
1569                 # this is to get rid of array entries that vanished (zero
1570                 # length) because of replacements
1571                 @generated = @newgen;
1572             }
1573
1574             if($hash{'nonewline'}) {
1575                 # cut off the final newline from the final line of the
1576                 # output data
1577                 chomp($outfile[-1]);
1578             }
1579
1580             $res = compare($runnerid, $testnum, $testname, "output ($filename)",
1581                            \@generated, \@outfile);
1582             if($res) {
1583                 return -1;
1584             }
1585
1586             $outputok = 1; # output checked
1587         }
1588     }
1589     $ok .= ($outputok) ? "o" : "-"; # output checked or not
1590
1591     # verify SOCKS proxy details
1592     my @socksprot = getpart("verify", "socks");
1593     if(@socksprot) {
1594         # Verify the sent SOCKS proxy details
1595         my @out = loadarray("$logdir/$SOCKSIN");
1596         $res = compare($runnerid, $testnum, $testname, "socks", \@out, \@socksprot);
1597         if($res) {
1598             return -1;
1599         }
1600     }
1601
1602     # accept multiple comma-separated error codes
1603     my @splerr = split(/ *, */, $errorcode);
1604     my $errok;
1605     foreach my $e (@splerr) {
1606         if($e == $cmdres) {
1607             # a fine error code
1608             $errok = 1;
1609             last;
1610         }
1611     }
1612
1613     if($errok) {
1614         $ok .= "e";
1615     }
1616     else {
1617         if(!$short) {
1618             logmsg sprintf("\n%s returned $cmdres, when expecting %s\n",
1619                            (!$tool)?"curl":$tool, $errorcode);
1620         }
1621         logmsg " $testnum: exit FAILED\n";
1622         # timestamp test result verification end
1623         $timevrfyend{$testnum} = Time::HiRes::time();
1624         return -1;
1625     }
1626
1627     if($feature{"TrackMemory"}) {
1628         if(! -f "$logdir/$MEMDUMP") {
1629             my %cmdhash = getpartattr("client", "command");
1630             my $cmdtype = $cmdhash{'type'} || "default";
1631             logmsg "\n** ALERT! memory tracking with no output file?\n"
1632                 if(!$cmdtype eq "perl");
1633             $ok .= "-"; # problem with memory checking
1634         }
1635         else {
1636             my @memdata=`$memanalyze "$logdir/$MEMDUMP"`;
1637             my $leak=0;
1638             for(@memdata) {
1639                 if($_ ne "") {
1640                     # well it could be other memory problems as well, but
1641                     # we call it leak for short here
1642                     $leak=1;
1643                 }
1644             }
1645             if($leak) {
1646                 logmsg "\n** MEMORY FAILURE\n";
1647                 logmsg @memdata;
1648                 # timestamp test result verification end
1649                 $timevrfyend{$testnum} = Time::HiRes::time();
1650                 return -1;
1651             }
1652             else {
1653                 $ok .= "m";
1654             }
1655         }
1656     }
1657     else {
1658         $ok .= "-"; # memory not checked
1659     }
1660
1661     if($valgrind) {
1662         if($usedvalgrind) {
1663             if(!opendir(DIR, "$logdir")) {
1664                 logmsg "ERROR: unable to read $logdir\n";
1665                 # timestamp test result verification end
1666                 $timevrfyend{$testnum} = Time::HiRes::time();
1667                 return -1;
1668             }
1669             my @files = readdir(DIR);
1670             closedir(DIR);
1671             my $vgfile;
1672             foreach my $file (@files) {
1673                 if($file =~ /^valgrind$testnum(\..*|)$/) {
1674                     $vgfile = $file;
1675                     last;
1676                 }
1677             }
1678             if(!$vgfile) {
1679                 logmsg "ERROR: valgrind log file missing for test $testnum\n";
1680                 # timestamp test result verification end
1681                 $timevrfyend{$testnum} = Time::HiRes::time();
1682                 return -1;
1683             }
1684             my @e = valgrindparse("$logdir/$vgfile");
1685             if(@e && $e[0]) {
1686                 if($automakestyle) {
1687                     logmsg "FAIL: $testnum - $testname - valgrind\n";
1688                 }
1689                 else {
1690                     logmsg " valgrind ERROR ";
1691                     logmsg @e;
1692                 }
1693                 # timestamp test result verification end
1694                 $timevrfyend{$testnum} = Time::HiRes::time();
1695                 return -1;
1696             }
1697             $ok .= "v";
1698         }
1699         else {
1700             if($verbose) {
1701                 logmsg " valgrind SKIPPED\n";
1702             }
1703             $ok .= "-"; # skipped
1704         }
1705     }
1706     else {
1707         $ok .= "-"; # valgrind not checked
1708     }
1709     # add 'E' for event-based
1710     $ok .= $run_event_based ? "E" : "-";
1711
1712     logmsg "$ok " if(!$short);
1713
1714     # timestamp test result verification end
1715     $timevrfyend{$testnum} = Time::HiRes::time();
1716
1717     return 0;
1718 }
1719
1720
1721 #######################################################################
1722 # Report a successful test
1723 sub singletest_success {
1724     my ($testnum, $count, $total, $errorreturncode)=@_;
1725
1726     my $sofar= time()-$start;
1727     my $esttotal = $sofar/$count * $total;
1728     my $estleft = $esttotal - $sofar;
1729     my $timeleft=sprintf("remaining: %02d:%02d",
1730                      $estleft/60,
1731                      $estleft%60);
1732     my $took = $timevrfyend{$testnum} - $timeprepini{$testnum};
1733     my $duration = sprintf("duration: %02d:%02d",
1734                            $sofar/60, $sofar%60);
1735     if(!$automakestyle) {
1736         logmsg sprintf("OK (%-3d out of %-3d, %s, took %.3fs, %s)\n",
1737                        $count, $total, $timeleft, $took, $duration);
1738     }
1739     else {
1740         my $testname= (getpart("client", "name"))[0];
1741         chomp $testname;
1742         logmsg "PASS: $testnum - $testname\n";
1743     }
1744
1745     if($errorreturncode==2) {
1746         logmsg "Warning: test$testnum result is ignored, but passed!\n";
1747     }
1748 }
1749
1750 #######################################################################
1751 # Run a single specified test case
1752 # This is structured as a state machine which changes state after an
1753 # asynchronous call is made that awaits a response. The function returns with
1754 # an error code and a flag that indicates if the state machine has completed,
1755 # which means (if not) the function must be called again once the response has
1756 # arrived.
1757 #
1758 sub singletest {
1759     my ($runnerid, $testnum, $count, $total)=@_;
1760
1761     # start buffering logmsg; stop it on return
1762     logmsg_bufferfortest($runnerid);
1763     if(!exists $singletest_state{$runnerid}) {
1764         # First time in singletest() for this test
1765         $singletest_state{$runnerid} = ST_INIT;
1766     }
1767
1768     if($singletest_state{$runnerid} == ST_INIT) {
1769         my $logdir = getrunnerlogdir($runnerid);
1770         # first, remove all lingering log & lock files
1771         if((!cleardir($logdir) || !cleardir("$logdir/$LOCKDIR"))
1772             && $clearlocks) {
1773             # On Windows, lock files can't be deleted when the process still
1774             # has them open, so kill those processes first
1775             if(runnerac_clearlocks($runnerid, "$logdir/$LOCKDIR")) {
1776                 logmsg "ERROR: runner $runnerid seems to have died\n";
1777                 $singletest_state{$runnerid} = ST_INIT;
1778                 return (-1, 0);
1779             }
1780             $singletest_state{$runnerid} = ST_CLEARLOCKS;
1781         } else {
1782             $singletest_state{$runnerid} = ST_INITED;
1783             # Recursively call the state machine again because there is no
1784             # event expected that would otherwise trigger a new call.
1785             return singletest(@_);
1786         }
1787
1788     } elsif($singletest_state{$runnerid} == ST_CLEARLOCKS) {
1789         my ($rid, $logs) = runnerar($runnerid);
1790         if(!$rid) {
1791             logmsg "ERROR: runner $runnerid seems to have died\n";
1792             $singletest_state{$runnerid} = ST_INIT;
1793             return (-1, 0);
1794         }
1795         logmsg $logs;
1796         my $logdir = getrunnerlogdir($runnerid);
1797         cleardir($logdir);
1798         $singletest_state{$runnerid} = ST_INITED;
1799         # Recursively call the state machine again because there is no
1800         # event expected that would otherwise trigger a new call.
1801         return singletest(@_);
1802
1803     } elsif($singletest_state{$runnerid} == ST_INITED) {
1804         ###################################################################
1805         # Restore environment variables that were modified in a previous run.
1806         # Test definition may instruct to (un)set environment vars.
1807         # This is done this early so that leftover variables don't affect
1808         # starting servers or CI registration.
1809         # restore_test_env(1);
1810
1811         ###################################################################
1812         # Load test file so CI registration can get the right data before the
1813         # runner is called
1814         loadtest("${TESTDIR}/test${testnum}");
1815
1816         ###################################################################
1817         # Register the test case with the CI environment
1818         citest_starttest($testnum);
1819
1820         if(runnerac_test_preprocess($runnerid, $testnum)) {
1821             logmsg "ERROR: runner $runnerid seems to have died\n";
1822             $singletest_state{$runnerid} = ST_INIT;
1823             return (-1, 0);
1824         }
1825         $singletest_state{$runnerid} = ST_PREPROCESS;
1826
1827     } elsif($singletest_state{$runnerid} == ST_PREPROCESS) {
1828         my ($rid, $why, $error, $logs, $testtimings) = runnerar($runnerid);
1829         if(!$rid) {
1830             logmsg "ERROR: runner $runnerid seems to have died\n";
1831             $singletest_state{$runnerid} = ST_INIT;
1832             return (-1, 0);
1833         }
1834         logmsg $logs;
1835         updatetesttimings($testnum, %$testtimings);
1836         if($error == -2) {
1837             if($postmortem) {
1838                 # Error indicates an actual problem starting the server, so
1839                 # display the server logs
1840                 displaylogs($rid, $testnum);
1841             }
1842         }
1843
1844         #######################################################################
1845         # Load test file for this test number
1846         my $logdir = getrunnerlogdir($runnerid);
1847         loadtest("${logdir}/test${testnum}");
1848
1849         #######################################################################
1850         # Print the test name and count tests
1851         $error = singletest_count($testnum, $why);
1852         if($error) {
1853             # Submit the test case result with the CI environment
1854             citest_finishtest($testnum, $error);
1855             $singletest_state{$runnerid} = ST_INIT;
1856             logmsg singletest_dumplogs();
1857             return ($error, 0);
1858         }
1859
1860         #######################################################################
1861         # Execute this test number
1862         my $cmdres;
1863         my $CURLOUT;
1864         my $tool;
1865         my $usedvalgrind;
1866         if(runnerac_test_run($runnerid, $testnum)) {
1867             logmsg "ERROR: runner $runnerid seems to have died\n";
1868             $singletest_state{$runnerid} = ST_INIT;
1869             return (-1, 0);
1870         }
1871         $singletest_state{$runnerid} = ST_RUN;
1872
1873     } elsif($singletest_state{$runnerid} == ST_RUN) {
1874         my ($rid, $error, $logs, $testtimings, $cmdres, $CURLOUT, $tool, $usedvalgrind) = runnerar($runnerid);
1875         if(!$rid) {
1876             logmsg "ERROR: runner $runnerid seems to have died\n";
1877             $singletest_state{$runnerid} = ST_INIT;
1878             return (-1, 0);
1879         }
1880         logmsg $logs;
1881         updatetesttimings($testnum, %$testtimings);
1882         if($error == -1) {
1883             # no further verification will occur
1884             $timevrfyend{$testnum} = Time::HiRes::time();
1885             my $err = ignoreresultcode($testnum);
1886             # Submit the test case result with the CI environment
1887             citest_finishtest($testnum, $err);
1888             $singletest_state{$runnerid} = ST_INIT;
1889             logmsg singletest_dumplogs();
1890             # return a test failure, either to be reported or to be ignored
1891             return ($err, 0);
1892         }
1893         elsif($error == -2) {
1894             # fill in the missing timings on error
1895             timestampskippedevents($testnum);
1896             # Submit the test case result with the CI environment
1897             citest_finishtest($testnum, $error);
1898             $singletest_state{$runnerid} = ST_INIT;
1899             logmsg singletest_dumplogs();
1900             return ($error, 0);
1901         }
1902         elsif($error > 0) {
1903             # no further verification will occur
1904             $timevrfyend{$testnum} = Time::HiRes::time();
1905             # Submit the test case result with the CI environment
1906             citest_finishtest($testnum, $error);
1907             $singletest_state{$runnerid} = ST_INIT;
1908             logmsg singletest_dumplogs();
1909             return ($error, 0);
1910         }
1911
1912         #######################################################################
1913         # Verify that the test succeeded
1914         #
1915         # Load test file for this test number
1916         my $logdir = getrunnerlogdir($runnerid);
1917         loadtest("${logdir}/test${testnum}");
1918         readtestkeywords();
1919
1920         $error = singletest_check($runnerid, $testnum, $cmdres, $CURLOUT, $tool, $usedvalgrind);
1921         if($error == -1) {
1922             my $err = ignoreresultcode($testnum);
1923             # Submit the test case result with the CI environment
1924             citest_finishtest($testnum, $err);
1925             $singletest_state{$runnerid} = ST_INIT;
1926             logmsg singletest_dumplogs();
1927             # return a test failure, either to be reported or to be ignored
1928             return ($err, 0);
1929         }
1930         elsif($error == -2) {
1931             # torture test; there is no verification, so the run result holds the
1932             # test success code
1933             # Submit the test case result with the CI environment
1934             citest_finishtest($testnum, $cmdres);
1935             $singletest_state{$runnerid} = ST_INIT;
1936             logmsg singletest_dumplogs();
1937             return ($cmdres, 0);
1938         }
1939
1940
1941         #######################################################################
1942         # Report a successful test
1943         singletest_success($testnum, $count, $total, ignoreresultcode($testnum));
1944
1945         # Submit the test case result with the CI environment
1946         citest_finishtest($testnum, 0);
1947         $singletest_state{$runnerid} = ST_INIT;
1948
1949         logmsg singletest_dumplogs();
1950         return (0, 0);  # state machine is finished
1951     }
1952     singletest_unbufferlogs();
1953     return (0, 1);  # state machine must be called again on event
1954 }
1955
1956 #######################################################################
1957 # runtimestats displays test-suite run time statistics
1958 #
1959 sub runtimestats {
1960     my $lasttest = $_[0];
1961
1962     return if(not $timestats);
1963
1964     logmsg "\nTest suite total running time breakdown per task...\n\n";
1965
1966     my @timesrvr;
1967     my @timeprep;
1968     my @timetool;
1969     my @timelock;
1970     my @timevrfy;
1971     my @timetest;
1972     my $timesrvrtot = 0.0;
1973     my $timepreptot = 0.0;
1974     my $timetooltot = 0.0;
1975     my $timelocktot = 0.0;
1976     my $timevrfytot = 0.0;
1977     my $timetesttot = 0.0;
1978     my $counter;
1979
1980     for my $testnum (1 .. $lasttest) {
1981         if($timesrvrini{$testnum}) {
1982             $timesrvrtot += $timesrvrend{$testnum} - $timesrvrini{$testnum};
1983             $timepreptot +=
1984                 (($timetoolini{$testnum} - $timeprepini{$testnum}) -
1985                  ($timesrvrend{$testnum} - $timesrvrini{$testnum}));
1986             $timetooltot += $timetoolend{$testnum} - $timetoolini{$testnum};
1987             $timelocktot += $timesrvrlog{$testnum} - $timetoolend{$testnum};
1988             $timevrfytot += $timevrfyend{$testnum} - $timesrvrlog{$testnum};
1989             $timetesttot += $timevrfyend{$testnum} - $timeprepini{$testnum};
1990             push @timesrvr, sprintf("%06.3f  %04d",
1991                 $timesrvrend{$testnum} - $timesrvrini{$testnum}, $testnum);
1992             push @timeprep, sprintf("%06.3f  %04d",
1993                 ($timetoolini{$testnum} - $timeprepini{$testnum}) -
1994                 ($timesrvrend{$testnum} - $timesrvrini{$testnum}), $testnum);
1995             push @timetool, sprintf("%06.3f  %04d",
1996                 $timetoolend{$testnum} - $timetoolini{$testnum}, $testnum);
1997             push @timelock, sprintf("%06.3f  %04d",
1998                 $timesrvrlog{$testnum} - $timetoolend{$testnum}, $testnum);
1999             push @timevrfy, sprintf("%06.3f  %04d",
2000                 $timevrfyend{$testnum} - $timesrvrlog{$testnum}, $testnum);
2001             push @timetest, sprintf("%06.3f  %04d",
2002                 $timevrfyend{$testnum} - $timeprepini{$testnum}, $testnum);
2003         }
2004     }
2005
2006     {
2007         no warnings 'numeric';
2008         @timesrvr = sort { $b <=> $a } @timesrvr;
2009         @timeprep = sort { $b <=> $a } @timeprep;
2010         @timetool = sort { $b <=> $a } @timetool;
2011         @timelock = sort { $b <=> $a } @timelock;
2012         @timevrfy = sort { $b <=> $a } @timevrfy;
2013         @timetest = sort { $b <=> $a } @timetest;
2014     }
2015
2016     logmsg "Spent ". sprintf("%08.3f ", $timesrvrtot) .
2017            "seconds starting and verifying test harness servers.\n";
2018     logmsg "Spent ". sprintf("%08.3f ", $timepreptot) .
2019            "seconds reading definitions and doing test preparations.\n";
2020     logmsg "Spent ". sprintf("%08.3f ", $timetooltot) .
2021            "seconds actually running test tools.\n";
2022     logmsg "Spent ". sprintf("%08.3f ", $timelocktot) .
2023            "seconds awaiting server logs lock removal.\n";
2024     logmsg "Spent ". sprintf("%08.3f ", $timevrfytot) .
2025            "seconds verifying test results.\n";
2026     logmsg "Spent ". sprintf("%08.3f ", $timetesttot) .
2027            "seconds doing all of the above.\n";
2028
2029     $counter = 25;
2030     logmsg "\nTest server starting and verification time per test ".
2031         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
2032     logmsg "-time-  test\n";
2033     logmsg "------  ----\n";
2034     foreach my $txt (@timesrvr) {
2035         last if((not $fullstats) && (not $counter--));
2036         logmsg "$txt\n";
2037     }
2038
2039     $counter = 10;
2040     logmsg "\nTest definition reading and preparation time per test ".
2041         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
2042     logmsg "-time-  test\n";
2043     logmsg "------  ----\n";
2044     foreach my $txt (@timeprep) {
2045         last if((not $fullstats) && (not $counter--));
2046         logmsg "$txt\n";
2047     }
2048
2049     $counter = 25;
2050     logmsg "\nTest tool execution time per test ".
2051         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
2052     logmsg "-time-  test\n";
2053     logmsg "------  ----\n";
2054     foreach my $txt (@timetool) {
2055         last if((not $fullstats) && (not $counter--));
2056         logmsg "$txt\n";
2057     }
2058
2059     $counter = 15;
2060     logmsg "\nTest server logs lock removal time per test ".
2061         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
2062     logmsg "-time-  test\n";
2063     logmsg "------  ----\n";
2064     foreach my $txt (@timelock) {
2065         last if((not $fullstats) && (not $counter--));
2066         logmsg "$txt\n";
2067     }
2068
2069     $counter = 10;
2070     logmsg "\nTest results verification time per test ".
2071         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
2072     logmsg "-time-  test\n";
2073     logmsg "------  ----\n";
2074     foreach my $txt (@timevrfy) {
2075         last if((not $fullstats) && (not $counter--));
2076         logmsg "$txt\n";
2077     }
2078
2079     $counter = 50;
2080     logmsg "\nTotal time per test ".
2081         sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
2082     logmsg "-time-  test\n";
2083     logmsg "------  ----\n";
2084     foreach my $txt (@timetest) {
2085         last if((not $fullstats) && (not $counter--));
2086         logmsg "$txt\n";
2087     }
2088
2089     logmsg "\n";
2090 }
2091
2092 #######################################################################
2093 # returns code indicating why a test was skipped
2094 # 0=unknown test, 1=use test result, 2=ignore test result
2095 #
2096 sub ignoreresultcode {
2097     my ($testnum)=@_;
2098     if(defined $ignoretestcodes{$testnum}) {
2099         return $ignoretestcodes{$testnum};
2100     }
2101     return 0;
2102 }
2103
2104 #######################################################################
2105 # Put the given runner ID onto the queue of runners ready for a new task
2106 #
2107 sub runnerready {
2108     my ($runnerid)=@_;
2109     push @runnersidle, $runnerid;
2110 }
2111
2112 #######################################################################
2113 # Create test runners
2114 #
2115 sub createrunners {
2116     my ($numrunners)=@_;
2117     if(! $numrunners) {
2118         $numrunners++;
2119     }
2120     # create $numrunners runners with minimum 1
2121     for my $runnernum (1..$numrunners) {
2122         my $dir = getrunnernumlogdir($runnernum);
2123         cleardir($dir);
2124         mkdir($dir, 0777);
2125         $runnerids{$runnernum} = runner_init($dir, $jobs);
2126         runnerready($runnerids{$runnernum});
2127     }
2128 }
2129
2130 #######################################################################
2131 # Pick a test runner for the given test
2132 #
2133 sub pickrunner {
2134     my ($testnum)=@_;
2135     scalar(@runnersidle) || die "No runners available";
2136
2137     return pop @runnersidle;
2138 }
2139
2140 #######################################################################
2141 # Check options to this test program
2142 #
2143
2144 # Special case for CMake: replace '$TFLAGS' by the contents of the
2145 # environment variable (if any).
2146 if(@ARGV && $ARGV[-1] eq '$TFLAGS') {
2147     pop @ARGV;
2148     push(@ARGV, split(' ', $ENV{'TFLAGS'})) if defined($ENV{'TFLAGS'});
2149 }
2150
2151 $valgrind = checktestcmd("valgrind");
2152 my $number=0;
2153 my $fromnum=-1;
2154 my @testthis;
2155 while(@ARGV) {
2156     if ($ARGV[0] eq "-v") {
2157         # verbose output
2158         $verbose=1;
2159     }
2160     elsif ($ARGV[0] eq "-c") {
2161         # use this path to curl instead of default
2162         $DBGCURL=$CURL=$ARGV[1];
2163         shift @ARGV;
2164     }
2165     elsif ($ARGV[0] eq "-vc") {
2166         # use this path to a curl used to verify servers
2167
2168         # Particularly useful when you introduce a crashing bug somewhere in
2169         # the development version as then it won't be able to run any tests
2170         # since it can't verify the servers!
2171
2172         $VCURL=shell_quote($ARGV[1]);
2173         shift @ARGV;
2174     }
2175     elsif ($ARGV[0] eq "-ac") {
2176         # use this curl only to talk to APIs (currently only CI test APIs)
2177         $ACURL=shell_quote($ARGV[1]);
2178         shift @ARGV;
2179     }
2180     elsif ($ARGV[0] eq "-d") {
2181         # have the servers display protocol output
2182         $debugprotocol=1;
2183     }
2184     elsif($ARGV[0] eq "-e") {
2185         # run the tests cases event based if possible
2186         $run_event_based=1;
2187     }
2188     elsif($ARGV[0] eq "-f") {
2189         # force - run the test case even if listed in DISABLED
2190         $run_disabled=1;
2191     }
2192     elsif($ARGV[0] eq "-E") {
2193         # load additional reasons to skip tests
2194         shift @ARGV;
2195         my $exclude_file = $ARGV[0];
2196         open(my $fd, "<", $exclude_file) or die "Couldn't open '$exclude_file': $!";
2197         while(my $line = <$fd>) {
2198             next if ($line =~ /^#/);
2199             chomp $line;
2200             my ($type, $patterns, $skip_reason) = split(/\s*:\s*/, $line, 3);
2201
2202             die "Unsupported type: $type\n" if($type !~ /^keyword|test|tool$/);
2203
2204             foreach my $pattern (split(/,/, $patterns)) {
2205                 if($type eq "test") {
2206                     # Strip leading zeros in the test number
2207                     $pattern = int($pattern);
2208                 }
2209                 $custom_skip_reasons{$type}{$pattern} = $skip_reason;
2210             }
2211         }
2212         close($fd);
2213     }
2214     elsif ($ARGV[0] eq "-g") {
2215         # run this test with gdb
2216         $gdbthis=1;
2217     }
2218     elsif ($ARGV[0] eq "-gw") {
2219         # run this test with windowed gdb
2220         $gdbthis=1;
2221         $gdbxwin=1;
2222     }
2223     elsif($ARGV[0] eq "-s") {
2224         # short output
2225         $short=1;
2226     }
2227     elsif($ARGV[0] eq "-am") {
2228         # automake-style output
2229         $short=1;
2230         $automakestyle=1;
2231     }
2232     elsif($ARGV[0] eq "-n") {
2233         # no valgrind
2234         undef $valgrind;
2235     }
2236     elsif($ARGV[0] eq "--no-debuginfod") {
2237         # disable the valgrind debuginfod functionality
2238         $no_debuginfod = 1;
2239     }
2240     elsif ($ARGV[0] eq "-R") {
2241         # execute in scrambled order
2242         $scrambleorder=1;
2243     }
2244     elsif($ARGV[0] =~ /^-t(.*)/) {
2245         # torture
2246         $torture=1;
2247         my $xtra = $1;
2248
2249         if($xtra =~ s/(\d+)$//) {
2250             $tortalloc = $1;
2251         }
2252     }
2253     elsif($ARGV[0] =~ /--shallow=(\d+)/) {
2254         # Fail no more than this amount per tests when running
2255         # torture.
2256         my ($num)=($1);
2257         $shallow=$num;
2258     }
2259     elsif($ARGV[0] =~ /--repeat=(\d+)/) {
2260         # Repeat-run the given tests this many times
2261         $repeat = $1;
2262     }
2263     elsif($ARGV[0] =~ /--seed=(\d+)/) {
2264         # Set a fixed random seed (used for -R and --shallow)
2265         $randseed = $1;
2266     }
2267     elsif($ARGV[0] eq "-a") {
2268         # continue anyway, even if a test fail
2269         $anyway=1;
2270     }
2271     elsif($ARGV[0] eq "-o") {
2272         shift @ARGV;
2273         if ($ARGV[0] =~ /^(\w+)=([\w.:\/\[\]-]+)$/) {
2274             my ($variable, $value) = ($1, $2);
2275             eval "\$$variable='$value'" or die "Failed to set \$$variable to $value: $@";
2276         } else {
2277             die "Failed to parse '-o $ARGV[0]'. May contain unexpected characters.\n";
2278         }
2279     }
2280     elsif($ARGV[0] eq "-p") {
2281         $postmortem=1;
2282     }
2283     elsif($ARGV[0] eq "-P") {
2284         shift @ARGV;
2285         $proxy_address=$ARGV[0];
2286     }
2287     elsif($ARGV[0] eq "-L") {
2288         # require additional library file
2289         shift @ARGV;
2290         require $ARGV[0];
2291     }
2292     elsif($ARGV[0] eq "-l") {
2293         # lists the test case names only
2294         $listonly=1;
2295     }
2296     elsif($ARGV[0] =~ /^-j(.*)/) {
2297         # parallel jobs
2298         $jobs=1;
2299         my $xtra = $1;
2300         if($xtra =~ s/(\d+)$//) {
2301             $jobs = $1;
2302         }
2303     }
2304     elsif($ARGV[0] eq "-k") {
2305         # keep stdout and stderr files after tests
2306         $keepoutfiles=1;
2307     }
2308     elsif($ARGV[0] eq "-r") {
2309         # run time statistics needs Time::HiRes
2310         if($Time::HiRes::VERSION) {
2311             # presize hashes appropriately to hold an entire test run
2312             keys(%timeprepini) = 2000;
2313             keys(%timesrvrini) = 2000;
2314             keys(%timesrvrend) = 2000;
2315             keys(%timetoolini) = 2000;
2316             keys(%timetoolend) = 2000;
2317             keys(%timesrvrlog) = 2000;
2318             keys(%timevrfyend) = 2000;
2319             $timestats=1;
2320             $fullstats=0;
2321         }
2322     }
2323     elsif($ARGV[0] eq "-rf") {
2324         # run time statistics needs Time::HiRes
2325         if($Time::HiRes::VERSION) {
2326             # presize hashes appropriately to hold an entire test run
2327             keys(%timeprepini) = 2000;
2328             keys(%timesrvrini) = 2000;
2329             keys(%timesrvrend) = 2000;
2330             keys(%timetoolini) = 2000;
2331             keys(%timetoolend) = 2000;
2332             keys(%timesrvrlog) = 2000;
2333             keys(%timevrfyend) = 2000;
2334             $timestats=1;
2335             $fullstats=1;
2336         }
2337     }
2338     elsif($ARGV[0] eq "-rm") {
2339         # force removal of files by killing locking processes
2340         $clearlocks=1;
2341     }
2342     elsif($ARGV[0] eq "-u") {
2343         # error instead of warning on server unexpectedly alive
2344         $err_unexpected=1;
2345     }
2346     elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
2347         # show help text
2348         print <<"EOHELP"
2349 Usage: runtests.pl [options] [test selection(s)]
2350   -a       continue even if a test fails
2351   -ac path use this curl only to talk to APIs (currently only CI test APIs)
2352   -am      automake style output PASS/FAIL: [number] [name]
2353   -c path  use this curl executable
2354   -d       display server debug info
2355   -e       event-based execution
2356   -E file  load the specified file to exclude certain tests
2357   -f       forcibly run even if disabled
2358   -g       run the test case with gdb
2359   -gw      run the test case with gdb as a windowed application
2360   -h       this help text
2361   -j[N]    spawn this number of processes to run tests (default 0)
2362   -k       keep stdout and stderr files present after tests
2363   -L path  require an additional perl library file to replace certain functions
2364   -l       list all test case names/descriptions
2365   -n       no valgrind
2366   --no-debuginfod disable the valgrind debuginfod functionality
2367   -o variable=value set internal variable to the specified value
2368   -P proxy use the specified proxy
2369   -p       print log file contents when a test fails
2370   -R       scrambled order (uses the random seed, see --seed)
2371   -r       run time statistics
2372   -rf      full run time statistics
2373   -rm      force removal of files by killing locking processes (Windows only)
2374   --repeat=[num] run the given tests this many times
2375   -s       short output
2376   --seed=[num] set the random seed to a fixed number
2377   --shallow=[num] randomly makes the torture tests "thinner"
2378   -t[N]    torture (simulate function failures); N means fail Nth function
2379   -u       error instead of warning on server unexpectedly alive
2380   -v       verbose output
2381   -vc path use this curl only to verify the existing servers
2382   [num]    like "5 6 9" or " 5 to 22 " to run those tests only
2383   [!num]   like "!5 !6 !9" to disable those tests
2384   [~num]   like "~5 ~6 ~9" to ignore the result of those tests
2385   [keyword] like "IPv6" to select only tests containing the key word
2386   [!keyword] like "!cookies" to disable any tests containing the key word
2387   [~keyword] like "~cookies" to ignore results of tests containing key word
2388 EOHELP
2389     ;
2390         exit;
2391     }
2392     elsif($ARGV[0] =~ /^(\d+)/) {
2393         $number = $1;
2394         if($fromnum >= 0) {
2395             for my $n ($fromnum .. $number) {
2396                 push @testthis, $n;
2397             }
2398             $fromnum = -1;
2399         }
2400         else {
2401             push @testthis, $1;
2402         }
2403     }
2404     elsif($ARGV[0] =~ /^to$/i) {
2405         $fromnum = $number+1;
2406     }
2407     elsif($ARGV[0] =~ /^!(\d+)/) {
2408         $fromnum = -1;
2409         $disabled{$1}=$1;
2410     }
2411     elsif($ARGV[0] =~ /^~(\d+)/) {
2412         $fromnum = -1;
2413         $ignored{$1}=$1;
2414     }
2415     elsif($ARGV[0] =~ /^!(.+)/) {
2416         $disabled_keywords{lc($1)}=$1;
2417     }
2418     elsif($ARGV[0] =~ /^~(.+)/) {
2419         $ignored_keywords{lc($1)}=$1;
2420     }
2421     elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) {
2422         $enabled_keywords{lc($1)}=$1;
2423     }
2424     else {
2425         print "Unknown option: $ARGV[0]\n";
2426         exit;
2427     }
2428     shift @ARGV;
2429 }
2430
2431 delete $ENV{'DEBUGINFOD_URLS'} if($ENV{'DEBUGINFOD_URLS'} && $no_debuginfod);
2432
2433 if(!$randseed) {
2434     my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
2435         localtime(time);
2436     # seed of the month. December 2019 becomes 201912
2437     $randseed = ($year+1900)*100 + $mon+1;
2438     print "Using curl: $CURL\n";
2439     open(my $curlvh, "-|", shell_quote($CURL) . " --version 2>/dev/null") ||
2440         die "could not get curl version!";
2441     my @c = <$curlvh>;
2442     close($curlvh) || die "could not get curl version!";
2443     # use the first line of output and get the md5 out of it
2444     my $str = md5($c[0]);
2445     $randseed += unpack('S', $str);  # unsigned 16 bit value
2446 }
2447 srand $randseed;
2448
2449 if(@testthis && ($testthis[0] ne "")) {
2450     $TESTCASES=join(" ", @testthis);
2451 }
2452
2453 if($valgrind) {
2454     # we have found valgrind on the host, use it
2455
2456     # verify that we can invoke it fine
2457     my $code = runclient("valgrind >/dev/null 2>&1");
2458
2459     if(($code>>8) != 1) {
2460         #logmsg "Valgrind failure, disable it\n";
2461         undef $valgrind;
2462     } else {
2463
2464         # since valgrind 2.1.x, '--tool' option is mandatory
2465         # use it, if it is supported by the version installed on the system
2466         # (this happened in 2003, so we could probably don't need to care about
2467         # that old version any longer and just delete this check)
2468         runclient("valgrind --help 2>&1 | grep -- --tool > /dev/null 2>&1");
2469         if (($? >> 8)) {
2470             $valgrind_tool="";
2471         }
2472         open(my $curlh, "<", "$CURL");
2473         my $l = <$curlh>;
2474         if($l =~ /^\#\!/) {
2475             # A shell script. This is typically when built with libtool,
2476             $valgrind="../libtool --mode=execute $valgrind";
2477         }
2478         close($curlh);
2479
2480         # valgrind 3 renamed the --logfile option to --log-file!!!
2481         # (this happened in 2005, so we could probably don't need to care about
2482         # that old version any longer and just delete this check)
2483         my $ver=join(' ', runclientoutput("valgrind --version"));
2484         # cut off all but digits and dots
2485         $ver =~ s/[^0-9.]//g;
2486
2487         if($ver =~ /^(\d+)/) {
2488             $ver = $1;
2489             if($ver < 3) {
2490                 $valgrind_logfile="--logfile";
2491             }
2492         }
2493     }
2494 }
2495
2496 if ($gdbthis) {
2497     # open the executable curl and read the first 4 bytes of it
2498     open(my $check, "<", "$CURL");
2499     my $c;
2500     sysread $check, $c, 4;
2501     close($check);
2502     if($c eq "#! /") {
2503         # A shell script. This is typically when built with libtool,
2504         $libtool = 1;
2505         $gdb = "../libtool --mode=execute gdb";
2506     }
2507 }
2508
2509 #######################################################################
2510 # clear and create logging directory:
2511 #
2512
2513 # TODO: figure how to get around this. This dir is needed for checksystemfeatures()
2514 # Maybe create & use & delete a temporary directory in that function
2515 cleardir($LOGDIR);
2516 mkdir($LOGDIR, 0777);
2517 mkdir("$LOGDIR/$LOCKDIR", 0777);
2518
2519 #######################################################################
2520 # initialize some variables
2521 #
2522
2523 get_disttests();
2524 if(!$jobs) {
2525     # Disable buffered logging with only one test job
2526     setlogfunc(\&logmsg);
2527 }
2528
2529 #######################################################################
2530 # Output curl version and host info being tested
2531 #
2532
2533 if(!$listonly) {
2534     checksystemfeatures();
2535 }
2536
2537 #######################################################################
2538 # initialize configuration needed to set up servers
2539 # TODO: rearrange things so this can be called only in runner_init()
2540 #
2541 initserverconfig();
2542
2543 if(!$listonly) {
2544     # these can only be displayed after initserverconfig() has been called
2545     displayserverfeatures();
2546
2547     # globally disabled tests
2548     disabledtests("$TESTDIR/DISABLED");
2549 }
2550
2551 #######################################################################
2552 # Fetch all disabled tests, if there are any
2553 #
2554
2555 sub disabledtests {
2556     my ($file) = @_;
2557     my @input;
2558
2559     if(open(my $disabledh, "<", "$file")) {
2560         while(<$disabledh>) {
2561             if(/^ *\#/) {
2562                 # allow comments
2563                 next;
2564             }
2565             push @input, $_;
2566         }
2567         close($disabledh);
2568
2569         # preprocess the input to make conditionally disabled tests depending
2570         # on variables
2571         my @pp = prepro(0, @input);
2572         for my $t (@pp) {
2573             if($t =~ /(\d+)/) {
2574                 my ($n) = $1;
2575                 $disabled{$n}=$n; # disable this test number
2576                 if(! -f "$srcdir/data/test$n") {
2577                     print STDERR "WARNING! Non-existing test $n in $file!\n";
2578                     # fail hard to make user notice
2579                     exit 1;
2580                 }
2581                 logmsg "DISABLED: test $n\n" if ($verbose);
2582             }
2583             else {
2584                 print STDERR "$file: rubbish content: $t\n";
2585                 exit 2;
2586             }
2587         }
2588     }
2589 }
2590
2591 #######################################################################
2592 # If 'all' tests are requested, find out all test numbers
2593 #
2594
2595 if ( $TESTCASES eq "all") {
2596     # Get all commands and find out their test numbers
2597     opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
2598     my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
2599     closedir(DIR);
2600
2601     $TESTCASES=""; # start with no test cases
2602
2603     # cut off everything but the digits
2604     for(@cmds) {
2605         $_ =~ s/[a-z\/\.]*//g;
2606     }
2607     # sort the numbers from low to high
2608     foreach my $n (sort { $a <=> $b } @cmds) {
2609         if($disabled{$n}) {
2610             # skip disabled test cases
2611             my $why = "configured as DISABLED";
2612             $skipped{$why}++;
2613             $teststat[$n]=$why; # store reason for this test case
2614             next;
2615         }
2616         $TESTCASES .= " $n";
2617     }
2618 }
2619 else {
2620     my $verified="";
2621     for(split(" ", $TESTCASES)) {
2622         if (-e "$TESTDIR/test$_") {
2623             $verified.="$_ ";
2624         }
2625     }
2626     if($verified eq "") {
2627         print "No existing test cases were specified\n";
2628         exit;
2629     }
2630     $TESTCASES = $verified;
2631 }
2632 if($repeat) {
2633     my $s;
2634     for(1 .. $repeat) {
2635         $s .= $TESTCASES;
2636     }
2637     $TESTCASES = $s;
2638 }
2639
2640 if($scrambleorder) {
2641     # scramble the order of the test cases
2642     my @rand;
2643     while($TESTCASES) {
2644         my @all = split(/ +/, $TESTCASES);
2645         if(!$all[0]) {
2646             # if the first is blank, shift away it
2647             shift @all;
2648         }
2649         my $r = rand @all;
2650         push @rand, $all[$r];
2651         $all[$r]="";
2652         $TESTCASES = join(" ", @all);
2653     }
2654     $TESTCASES = join(" ", @rand);
2655 }
2656
2657 # Display the contents of the given file.  Line endings are canonicalized
2658 # and excessively long files are elided
2659 sub displaylogcontent {
2660     my ($file)=@_;
2661     if(open(my $single, "<", "$file")) {
2662         my $linecount = 0;
2663         my $truncate;
2664         my @tail;
2665         while(my $string = <$single>) {
2666             $string =~ s/\r\n/\n/g;
2667             $string =~ s/[\r\f\032]/\n/g;
2668             $string .= "\n" unless ($string =~ /\n$/);
2669             $string =~ tr/\n//;
2670             for my $line (split(m/\n/, $string)) {
2671                 $line =~ s/\s*\!$//;
2672                 if ($truncate) {
2673                     push @tail, " $line\n";
2674                 } else {
2675                     logmsg " $line\n";
2676                 }
2677                 $linecount++;
2678                 $truncate = $linecount > 1200;
2679             }
2680         }
2681         close($single);
2682         if(@tail) {
2683             my $tailshow = 200;
2684             my $tailskip = 0;
2685             my $tailtotal = scalar @tail;
2686             if($tailtotal > $tailshow) {
2687                 $tailskip = $tailtotal - $tailshow;
2688                 logmsg "=== File too long: $tailskip lines omitted here\n";
2689             }
2690             for($tailskip .. $tailtotal-1) {
2691                 logmsg "$tail[$_]";
2692             }
2693         }
2694     }
2695 }
2696
2697 sub displaylogs {
2698     my ($runnerid, $testnum)=@_;
2699     my $logdir = getrunnerlogdir($runnerid);
2700     opendir(DIR, "$logdir") ||
2701         die "can't open dir: $!";
2702     my @logs = readdir(DIR);
2703     closedir(DIR);
2704
2705     logmsg "== Contents of files in the $logdir/ dir after test $testnum\n";
2706     foreach my $log (sort @logs) {
2707         if($log =~ /\.(\.|)$/) {
2708             next; # skip "." and ".."
2709         }
2710         if($log =~ /^\.nfs/) {
2711             next; # skip ".nfs"
2712         }
2713         if(($log eq "memdump") || ($log eq "core")) {
2714             next; # skip "memdump" and  "core"
2715         }
2716         if((-d "$logdir/$log") || (! -s "$logdir/$log")) {
2717             next; # skip directory and empty files
2718         }
2719         if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) {
2720             next; # skip stdoutNnn of other tests
2721         }
2722         if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) {
2723             next; # skip stderrNnn of other tests
2724         }
2725         if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) {
2726             next; # skip uploadNnn of other tests
2727         }
2728         if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) {
2729             next; # skip curlNnn.out of other tests
2730         }
2731         if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) {
2732             next; # skip testNnn.txt of other tests
2733         }
2734         if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) {
2735             next; # skip fileNnn.txt of other tests
2736         }
2737         if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) {
2738             next; # skip netrcNnn of other tests
2739         }
2740         if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) {
2741             next; # skip traceNnn of other tests
2742         }
2743         if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(?:\..*)?$/)) {
2744             next; # skip valgrindNnn of other tests
2745         }
2746         if(($log =~ /^test$testnum$/)) {
2747             next; # skip test$testnum since it can be very big
2748         }
2749         logmsg "=== Start of file $log\n";
2750         displaylogcontent("$logdir/$log");
2751         logmsg "=== End of file $log\n";
2752     }
2753 }
2754
2755 #######################################################################
2756 # Scan tests to find suitable candidates
2757 #
2758
2759 my $failed;
2760 my $failedign;
2761 my $ok=0;
2762 my $ign=0;
2763 my $total=0;
2764 my $lasttest=0;
2765 my @at = split(" ", $TESTCASES);
2766 my $count=0;
2767 my $endwaitcnt=0;
2768
2769 $start = time();
2770
2771 # scan all tests to find ones we should try to run
2772 my @runtests;
2773 foreach my $testnum (@at) {
2774     $lasttest = $testnum if($testnum > $lasttest);
2775     my ($why, $errorreturncode) = singletest_shouldrun($testnum);
2776     if($why || $listonly) {
2777         # Display test name now--test will be completely skipped later
2778         my $error = singletest_count($testnum, $why);
2779         next;
2780     }
2781     $ignoretestcodes{$testnum} = $errorreturncode;
2782     push(@runtests, $testnum);
2783 }
2784 my $totaltests = scalar(@runtests);
2785
2786 if($listonly) {
2787     exit(0);
2788 }
2789
2790 #######################################################################
2791 # Setup CI Test Run
2792 citest_starttestrun();
2793
2794 #######################################################################
2795 # Start test runners
2796 #
2797 my $numrunners = $jobs < scalar(@runtests) ? $jobs : scalar(@runtests);
2798 createrunners($numrunners);
2799
2800 #######################################################################
2801 # The main test-loop
2802 #
2803 # Every iteration through the loop consists of these steps:
2804 #   - if the global abort flag is set, exit the loop; we are done
2805 #   - if a runner is idle, start a new test on it
2806 #   - if all runners are idle, exit the loop; we are done
2807 #   - if a runner has a response for us, process the response
2808
2809 # run through each candidate test and execute it
2810 while () {
2811     # check the abort flag
2812     if($globalabort) {
2813         logmsg singletest_dumplogs();
2814         logmsg "Aborting tests\n";
2815         logmsg "Waiting for " . scalar((keys %runnersrunning)) . " outstanding test(s) to finish...\n";
2816         # Wait for the last requests to complete and throw them away so
2817         # that IPC calls & responses stay in sync
2818         # TODO: send a signal to the runners to interrupt a long test
2819         foreach my $rid (keys %runnersrunning) {
2820             runnerar($rid);
2821             delete $runnersrunning{$rid};
2822             logmsg ".";
2823             $| = 1;
2824         }
2825         logmsg "\n";
2826         last;
2827     }
2828
2829     # Start a new test if possible
2830     if(scalar(@runnersidle) && scalar(@runtests)) {
2831         # A runner is ready to run a test, and tests are still available to run
2832         # so start a new test.
2833         $count++;
2834         my $testnum = shift(@runtests);
2835
2836         # pick a runner for this new test
2837         my $runnerid = pickrunner($testnum);
2838         $countforrunner{$runnerid} = $count;
2839
2840         # Start the test
2841         my ($error, $again) = singletest($runnerid, $testnum, $countforrunner{$runnerid}, $totaltests);
2842         if($again) {
2843             # this runner is busy running a test
2844             $runnersrunning{$runnerid} = $testnum;
2845         } else {
2846             runnerready($runnerid);
2847             if($error >= 0) {
2848                 # We make this simplifying assumption to avoid having to handle
2849                 # $error properly here, but we must handle the case of runner
2850                 # death without abending here.
2851                 die "Internal error: test must not complete on first call";
2852             }
2853         }
2854     }
2855
2856     # See if we've completed all the tests
2857     if(!scalar(%runnersrunning)) {
2858         # No runners are running; we must be done
2859         scalar(@runtests) && die 'Internal error: still have tests to run';
2860         last;
2861     }
2862
2863     # See if a test runner needs attention
2864     # If we could be running more tests, don't wait so we can schedule a new
2865     # one immediately. If all runners are busy, wait a fraction of a second
2866     # for one to finish so we can still loop around to check the abort flag.
2867     my $runnerwait = scalar(@runnersidle) && scalar(@runtests) ? 0 : 0.5;
2868     my ($ridready, $riderror) = runnerar_ready($runnerwait);
2869     if($ridready && ! defined $runnersrunning{$ridready}) {
2870         # On Linux, a closed pipe still shows up as ready instead of error.
2871         # Detect this here by seeing if we are expecting it to be ready and
2872         # treat it as an error if not.
2873         logmsg "ERROR: Runner $ridready is unexpectedly ready; is probably actually dead\n";
2874         $riderror = $ridready;
2875         undef $ridready;
2876     }
2877     if($ridready) {
2878         # This runner is ready to be serviced
2879         my $testnum = $runnersrunning{$ridready};
2880         defined $testnum ||  die "Internal error: test for runner $ridready unknown";
2881         delete $runnersrunning{$ridready};
2882         my ($error, $again) = singletest($ridready, $testnum, $countforrunner{$ridready}, $totaltests);
2883         if($again) {
2884             # this runner is busy running a test
2885             $runnersrunning{$ridready} = $testnum;
2886         } else {
2887             # Test is complete
2888             runnerready($ridready);
2889
2890             if($error < 0) {
2891                 # not a test we can run
2892                 next;
2893             }
2894
2895             $total++; # number of tests we've run
2896
2897             if($error>0) {
2898                 if($error==2) {
2899                     # ignored test failures
2900                     $failedign .= "$testnum ";
2901                 }
2902                 else {
2903                     $failed.= "$testnum ";
2904                 }
2905                 if($postmortem) {
2906                     # display all files in $LOGDIR/ in a nice way
2907                     displaylogs($ridready, $testnum);
2908                 }
2909                 if($error==2) {
2910                     $ign++; # ignored test result counter
2911                 }
2912                 elsif(!$anyway) {
2913                     # a test failed, abort
2914                     logmsg "\n - abort tests\n";
2915                     undef @runtests;  # empty out the remaining tests
2916                 }
2917             }
2918             elsif(!$error) {
2919                 $ok++; # successful test counter
2920             }
2921         }
2922     }
2923     if($riderror) {
2924         logmsg "ERROR: runner $riderror is dead! aborting test run\n";
2925         delete $runnersrunning{$riderror} if(defined $runnersrunning{$riderror});
2926         $globalabort = 1;
2927     }
2928     if(!scalar(@runtests) && ++$endwaitcnt == (240 + $jobs)) {
2929         # Once all tests have been scheduled on a runner at the end of a test
2930         # run, we just wait for their results to come in. If we're still
2931         # waiting after a couple of minutes ($endwaitcnt multiplied by
2932         # $runnerwait, plus $jobs because that number won't time out), display
2933         # the same test runner status as we give with a SIGUSR1. This will
2934         # likely point to a single test that has hung.
2935         logmsg "Hmmm, the tests are taking a while to finish. Here is the status:\n";
2936         catch_usr1();
2937     }
2938 }
2939
2940 my $sofar = time() - $start;
2941
2942 #######################################################################
2943 # Finish CI Test Run
2944 citest_finishtestrun();
2945
2946 # Tests done, stop the servers
2947 foreach my $runnerid (values %runnerids) {
2948     runnerac_stopservers($runnerid);
2949 }
2950
2951 # Wait for servers to stop
2952 my $unexpected;
2953 foreach my $runnerid (values %runnerids) {
2954     my ($rid, $unexpect, $logs) = runnerar($runnerid);
2955     $unexpected ||= $unexpect;
2956     logmsg $logs;
2957 }
2958
2959 # Kill the runners
2960 # There is a race condition here since we don't know exactly when the runners
2961 # have each finished shutting themselves down, but we're about to exit so it
2962 # doesn't make much difference.
2963 foreach my $runnerid (values %runnerids) {
2964     runnerac_shutdown($runnerid);
2965     sleep 0;  # give runner a context switch so it can shut itself down
2966 }
2967
2968 my $numskipped = %skipped ? sum values %skipped : 0;
2969 my $all = $total + $numskipped;
2970
2971 runtimestats($lasttest);
2972
2973 if($all) {
2974     logmsg "TESTDONE: $all tests were considered during ".
2975         sprintf("%.0f", $sofar) ." seconds.\n";
2976 }
2977
2978 if(%skipped && !$short) {
2979     my $s=0;
2980     # Temporary hash to print the restraints sorted by the number
2981     # of their occurrences
2982     my %restraints;
2983     logmsg "TESTINFO: $numskipped tests were skipped due to these restraints:\n";
2984
2985     for(keys %skipped) {
2986         my $r = $_;
2987         my $skip_count = $skipped{$r};
2988         my $log_line = sprintf("TESTINFO: \"%s\" %d time%s (", $r, $skip_count,
2989                            ($skip_count == 1) ? "" : "s");
2990
2991         # now gather all test case numbers that had this reason for being
2992         # skipped
2993         my $c=0;
2994         my $max = 9;
2995         for(0 .. scalar @teststat) {
2996             my $t = $_;
2997             if($teststat[$t] && ($teststat[$t] eq $r)) {
2998                 if($c < $max) {
2999                     $log_line .= ", " if($c);
3000                     $log_line .= $t;
3001                 }
3002                 $c++;
3003             }
3004         }
3005         if($c > $max) {
3006             $log_line .= " and ".($c-$max)." more";
3007         }
3008         $log_line .= ")\n";
3009         $restraints{$log_line} = $skip_count;
3010     }
3011     foreach my $log_line (sort {$restraints{$b} <=> $restraints{$a}} keys %restraints) {
3012         logmsg $log_line;
3013     }
3014 }
3015
3016 if($total) {
3017     if($failedign) {
3018         logmsg "IGNORED: failed tests: $failedign\n";
3019     }
3020     logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
3021                    $ok/$total*100);
3022
3023     if($failed && ($ok != $total)) {
3024         logmsg "\nTESTFAIL: These test cases failed: $failed\n\n";
3025     }
3026 }
3027 else {
3028     logmsg "\nTESTFAIL: No tests were performed\n\n";
3029     if(scalar(keys %enabled_keywords)) {
3030         logmsg "TESTFAIL: Nothing matched these keywords: ";
3031         for(keys %enabled_keywords) {
3032             logmsg "$_ ";
3033         }
3034         logmsg "\n";
3035     }
3036 }
3037
3038 if(($total && (($ok+$ign) != $total)) || !$total || $unexpected) {
3039     exit 1;
3040 }