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