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