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