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