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