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