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