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