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