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