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