1#!/usr/bin/env perl 2#*************************************************************************** 3# _ _ ____ _ 4# Project ___| | | | _ \| | 5# / __| | | | |_) | | 6# | (__| |_| | _ <| |___ 7# \___|\___/|_| \_\_____| 8# 9# Copyright (C) 1998 - 2019, 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.haxx.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########################################################################### 23 24# Experimental hooks are available to run tests remotely on machines that 25# are able to run curl but are unable to run the test harness. 26# The following sections need to be modified: 27# 28# $HOSTIP, $HOST6IP - Set to the address of the host running the test suite 29# $CLIENTIP, $CLIENT6IP - Set to the address of the host running curl 30# runclient, runclientoutput - Modify to copy all the files in the log/ 31# directory to the system running curl, run the given command remotely 32# and save the return code or returned stdout (respectively), then 33# copy all the files from the remote system's log/ directory back to 34# the host running the test suite. This can be done a few ways, such 35# as using scp & ssh, rsync & telnet, or using a NFS shared directory 36# and ssh. 37# 38# 'make && make test' needs to be done on both machines before making the 39# above changes and running runtests.pl manually. In the shared NFS case, 40# the contents of the tests/server/ directory must be from the host 41# running the test suite, while the rest must be from the host running curl. 42# 43# Note that even with these changes a number of tests will still fail (mainly 44# to do with cookies, those that set environment variables, or those that 45# do more than touch the file system in a <precheck> or <postcheck> 46# section). These can be added to the $TESTCASES line below, 47# e.g. $TESTCASES="!8 !31 !63 !cookies..." 48# 49# Finally, to properly support -g and -n, checktestcmd needs to change 50# to check the remote system's PATH, and the places in the code where 51# the curl binary is read directly to determine its type also need to be 52# fixed. As long as the -g option is never given, and the -n is always 53# given, this won't be a problem. 54 55 56# These should be the only variables that might be needed to get edited: 57 58BEGIN { 59 push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'}); 60 push(@INC, "."); 61 # run time statistics needs Time::HiRes 62 eval { 63 no warnings "all"; 64 require Time::HiRes; 65 import Time::HiRes qw( time ); 66 } 67} 68 69use strict; 70use warnings; 71use Cwd; 72 73# Subs imported from serverhelp module 74use serverhelp qw( 75 serverfactors 76 servername_id 77 servername_str 78 servername_canon 79 server_pidfilename 80 server_logfilename 81 ); 82 83# Variables and subs imported from sshhelp module 84use sshhelp qw( 85 $sshdexe 86 $sshexe 87 $sftpexe 88 $sshconfig 89 $sftpconfig 90 $sshdlog 91 $sshlog 92 $sftplog 93 $sftpcmds 94 display_sshdconfig 95 display_sshconfig 96 display_sftpconfig 97 display_sshdlog 98 display_sshlog 99 display_sftplog 100 exe_ext 101 find_sshd 102 find_ssh 103 find_sftp 104 find_httptlssrv 105 sshversioninfo 106 ); 107 108use pathhelp; 109 110require "getpart.pm"; # array functions 111require "valgrind.pm"; # valgrind report parser 112require "ftp.pm"; 113 114my $HOSTIP="127.0.0.1"; # address on which the test server listens 115my $HOST6IP="[::1]"; # address on which the test server listens 116my $CLIENTIP="127.0.0.1"; # address which curl uses for incoming connections 117my $CLIENT6IP="[::1]"; # address which curl uses for incoming connections 118 119my $base = 8990; # base port number 120 121my $HTTPPORT; # HTTP server port 122my $HTTP6PORT; # HTTP IPv6 server port 123my $HTTPSPORT; # HTTPS (stunnel) server port 124my $FTPPORT; # FTP server port 125my $FTP2PORT; # FTP server 2 port 126my $FTPSPORT; # FTPS (stunnel) server port 127my $FTP6PORT; # FTP IPv6 server port 128my $TFTPPORT; # TFTP 129my $TFTP6PORT; # TFTP 130my $SSHPORT; # SCP/SFTP 131my $SOCKSPORT; # SOCKS4/5 port 132my $POP3PORT; # POP3 133my $POP36PORT; # POP3 IPv6 server port 134my $IMAPPORT; # IMAP 135my $IMAP6PORT; # IMAP IPv6 server port 136my $SMTPPORT; # SMTP 137my $SMTP6PORT; # SMTP IPv6 server port 138my $RTSPPORT; # RTSP 139my $RTSP6PORT; # RTSP IPv6 server port 140my $GOPHERPORT; # Gopher 141my $GOPHER6PORT; # Gopher IPv6 server port 142my $HTTPTLSPORT; # HTTP TLS (non-stunnel) server port 143my $HTTPTLS6PORT; # HTTP TLS (non-stunnel) IPv6 server port 144my $HTTPPROXYPORT; # HTTP proxy port, when using CONNECT 145my $HTTPUNIXPATH; # HTTP server Unix domain socket path 146my $HTTP2PORT; # HTTP/2 server port 147my $DICTPORT; # DICT server port 148my $SMBPORT; # SMB server port 149my $SMBSPORT; # SMBS server port 150my $NEGTELNETPORT; # TELNET server port with negotiation 151 152my $srcdir = $ENV{'srcdir'} || '.'; 153my $CURL="../src/curl".exe_ext(); # what curl executable to run on the tests 154my $VCURL=$CURL; # what curl binary to use to verify the servers with 155 # VCURL is handy to set to the system one when the one you 156 # just built hangs or crashes and thus prevent verification 157my $DBGCURL=$CURL; #"../src/.libs/curl"; # alternative for debugging 158my $LOGDIR="log"; 159my $TESTDIR="$srcdir/data"; 160my $LIBDIR="./libtest"; 161my $UNITDIR="./unit"; 162# TODO: change this to use server_inputfilename() 163my $SERVERIN="$LOGDIR/server.input"; # what curl sent the server 164my $SERVER2IN="$LOGDIR/server2.input"; # what curl sent the second server 165my $PROXYIN="$LOGDIR/proxy.input"; # what curl sent the proxy 166my $CURLLOG="$LOGDIR/curl.log"; # all command lines run 167my $FTPDCMD="$LOGDIR/ftpserver.cmd"; # copy ftp server instructions here 168my $SERVERLOGS_LOCK="$LOGDIR/serverlogs.lock"; # server logs advisor read lock 169my $CURLCONFIG="../curl-config"; # curl-config from current build 170 171# Normally, all test cases should be run, but at times it is handy to 172# simply run a particular one: 173my $TESTCASES="all"; 174 175# To run specific test cases, set them like: 176# $TESTCASES="1 2 3 7 8"; 177 178####################################################################### 179# No variables below this point should need to be modified 180# 181 182# invoke perl like this: 183my $perl="perl -I$srcdir"; 184my $server_response_maxtime=13; 185 186my $debug_build=0; # built debug enabled (--enable-debug) 187my $has_memory_tracking=0; # built with memory tracking (--enable-curldebug) 188my $libtool; 189 190# name of the file that the memory debugging creates: 191my $memdump="$LOGDIR/memdump"; 192 193# the path to the script that analyzes the memory debug output file: 194my $memanalyze="$perl $srcdir/memanalyze.pl"; 195 196my $pwd = getcwd(); # current working directory 197my $posix_pwd = $pwd; 198 199my $start; 200my $ftpchecktime=1; # time it took to verify our test FTP server 201my $scrambleorder; 202my $stunnel = checkcmd("stunnel4") || checkcmd("tstunnel") || checkcmd("stunnel"); 203my $valgrind = checktestcmd("valgrind"); 204my $valgrind_logfile="--logfile"; 205my $valgrind_tool; 206my $gdb = checktestcmd("gdb"); 207my $httptlssrv = find_httptlssrv(); 208 209my $has_ssl; # set if libcurl is built with SSL support 210my $has_largefile; # set if libcurl is built with large file support 211my $has_idn; # set if libcurl is built with IDN support 212my $http_ipv6; # set if HTTP server has IPv6 support 213my $http_unix; # set if HTTP server has Unix sockets support 214my $ftp_ipv6; # set if FTP server has IPv6 support 215my $tftp_ipv6; # set if TFTP server has IPv6 support 216my $gopher_ipv6; # set if Gopher server has IPv6 support 217my $has_ipv6; # set if libcurl is built with IPv6 support 218my $has_unix; # set if libcurl is built with Unix sockets support 219my $has_libz; # set if libcurl is built with libz support 220my $has_brotli; # set if libcurl is built with brotli support 221my $has_getrlimit; # set if system has getrlimit() 222my $has_ntlm; # set if libcurl is built with NTLM support 223my $has_ntlm_wb; # set if libcurl is built with NTLM delegation to winbind 224my $has_sspi; # set if libcurl is built with Windows SSPI 225my $has_gssapi; # set if libcurl is built with a GSS-API library 226my $has_kerberos; # set if libcurl is built with Kerberos support 227my $has_spnego; # set if libcurl is built with SPNEGO support 228my $has_charconv; # set if libcurl is built with CharConv support 229my $has_tls_srp; # set if libcurl is built with TLS-SRP support 230my $has_metalink; # set if curl is built with Metalink support 231my $has_http2; # set if libcurl is built with HTTP2 support 232my $has_crypto; # set if libcurl is built with cryptographic support 233my $has_cares; # set if built with c-ares 234my $has_threadedres;# set if built with threaded resolver 235my $has_psl; # set if libcurl is built with PSL support 236my $has_altsvc; # set if libcurl is built with alt-svc support 237my $has_ldpreload; # set if curl is built for systems supporting LD_PRELOAD 238my $has_multissl; # set if curl is build with MultiSSL support 239my $has_manual; # set if curl is built with built-in manual 240 241# this version is decided by the particular nghttp2 library that is being used 242my $h2cver = "h2c"; 243 244my $has_openssl; # built with a lib using an OpenSSL-like API 245my $has_gnutls; # built with GnuTLS 246my $has_nss; # built with NSS 247my $has_yassl; # built with yassl 248my $has_polarssl; # built with polarssl 249my $has_winssl; # built with WinSSL (Secure Channel aka Schannel) 250my $has_darwinssl; # built with DarwinSSL (Secure Transport) 251my $has_boringssl; # built with BoringSSL 252my $has_libressl; # built with libressl 253my $has_mbedtls; # built with mbedTLS 254my $has_mesalink; # built with MesaLink 255 256my $has_sslpinning; # built with a TLS backend that supports pinning 257 258my $has_shared = "unknown"; # built shared 259 260my $resolver; # name of the resolver backend (for human presentation) 261 262my $has_textaware; # set if running on a system that has a text mode concept 263 # on files. Windows for example 264 265my @protocols; # array of lowercase supported protocol servers 266 267my $skipped=0; # number of tests skipped; reported in main loop 268my %skipped; # skipped{reason}=counter, reasons for skip 269my @teststat; # teststat[testnum]=reason, reasons for skip 270my %disabled_keywords; # key words of tests to skip 271my %enabled_keywords; # key words of tests to run 272my %disabled; # disabled test cases 273 274my $sshdid; # for socks server, ssh daemon version id 275my $sshdvernum; # for socks server, ssh daemon version number 276my $sshdverstr; # for socks server, ssh daemon version string 277my $sshderror; # for socks server, ssh daemon version error 278 279my $defserverlogslocktimeout = 20; # timeout to await server logs lock removal 280my $defpostcommanddelay = 0; # delay between command and postcheck sections 281 282my $timestats; # time stamping and stats generation 283my $fullstats; # show time stats for every single test 284my %timeprepini; # timestamp for each test preparation start 285my %timesrvrini; # timestamp for each test required servers verification start 286my %timesrvrend; # timestamp for each test required servers verification end 287my %timetoolini; # timestamp for each test command run starting 288my %timetoolend; # timestamp for each test command run stopping 289my %timesrvrlog; # timestamp for each test server logs lock removal 290my %timevrfyend; # timestamp for each test result verification end 291 292my $testnumcheck; # test number, set in singletest sub. 293my %oldenv; 294 295####################################################################### 296# variables that command line options may set 297# 298 299my $short; 300my $automakestyle; 301my $verbose; 302my $debugprotocol; 303my $anyway; 304my $gdbthis; # run test case with gdb debugger 305my $gdbxwin; # use windowed gdb when using gdb 306my $keepoutfiles; # keep stdout and stderr files after tests 307my $listonly; # only list the tests 308my $postmortem; # display detailed info about failed tests 309my $run_event_based; # run curl with --test-event to test the event API 310 311my %run; # running server 312my %doesntrun; # servers that don't work, identified by pidfile 313my %serverpidfile;# all server pid file names, identified by server id 314my %runcert; # cert file currently in use by an ssl running server 315 316# torture test variables 317my $torture; 318my $tortnum; 319my $tortalloc; 320 321####################################################################### 322# logmsg is our general message logging subroutine. 323# 324sub logmsg { 325 for(@_) { 326 print "$_"; 327 } 328} 329 330# get the name of the current user 331my $USER = $ENV{USER}; # Linux 332if (!$USER) { 333 $USER = $ENV{USERNAME}; # Windows 334 if (!$USER) { 335 $USER = $ENV{LOGNAME}; # Some Unix (I think) 336 } 337} 338 339# enable memory debugging if curl is compiled with it 340$ENV{'CURL_MEMDEBUG'} = $memdump; 341$ENV{'CURL_ENTROPY'}="12345678"; 342$ENV{'CURL_FORCETIME'}=1; # for debug NTLM magic 343$ENV{'HOME'}=$pwd; 344$ENV{'COLUMNS'}=79; # screen width! 345 346sub catch_zap { 347 my $signame = shift; 348 logmsg "runtests.pl received SIG$signame, exiting\n"; 349 stopservers($verbose); 350 die "Somebody sent me a SIG$signame"; 351} 352$SIG{INT} = \&catch_zap; 353$SIG{TERM} = \&catch_zap; 354 355########################################################################## 356# Clear all possible '*_proxy' environment variables for various protocols 357# to prevent them to interfere with our testing! 358 359my $protocol; 360foreach $protocol (('ftp', 'http', 'ftps', 'https', 'no', 'all')) { 361 my $proxy = "${protocol}_proxy"; 362 # clear lowercase version 363 delete $ENV{$proxy} if($ENV{$proxy}); 364 # clear uppercase version 365 delete $ENV{uc($proxy)} if($ENV{uc($proxy)}); 366} 367 368# make sure we don't get affected by other variables that control our 369# behaviour 370 371delete $ENV{'SSL_CERT_DIR'} if($ENV{'SSL_CERT_DIR'}); 372delete $ENV{'SSL_CERT_PATH'} if($ENV{'SSL_CERT_PATH'}); 373delete $ENV{'CURL_CA_BUNDLE'} if($ENV{'CURL_CA_BUNDLE'}); 374 375####################################################################### 376# Load serverpidfile hash with pidfile names for all possible servers. 377# 378sub init_serverpidfile_hash { 379 for my $proto (('ftp', 'http', 'imap', 'pop3', 'smtp', 'http/2')) { 380 for my $ssl (('', 's')) { 381 for my $ipvnum ((4, 6)) { 382 for my $idnum ((1, 2, 3)) { 383 my $serv = servername_id("$proto$ssl", $ipvnum, $idnum); 384 my $pidf = server_pidfilename("$proto$ssl", $ipvnum, $idnum); 385 $serverpidfile{$serv} = $pidf; 386 } 387 } 388 } 389 } 390 for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'gopher', 'httptls', 391 'dict', 'smb', 'smbs', 'telnet')) { 392 for my $ipvnum ((4, 6)) { 393 for my $idnum ((1, 2)) { 394 my $serv = servername_id($proto, $ipvnum, $idnum); 395 my $pidf = server_pidfilename($proto, $ipvnum, $idnum); 396 $serverpidfile{$serv} = $pidf; 397 } 398 } 399 } 400 for my $proto (('http', 'imap', 'pop3', 'smtp', 'http/2')) { 401 for my $ssl (('', 's')) { 402 my $serv = servername_id("$proto$ssl", "unix", 1); 403 my $pidf = server_pidfilename("$proto$ssl", "unix", 1); 404 $serverpidfile{$serv} = $pidf; 405 } 406 } 407} 408 409####################################################################### 410# Check if a given child process has just died. Reaps it if so. 411# 412sub checkdied { 413 use POSIX ":sys_wait_h"; 414 my $pid = $_[0]; 415 if((not defined $pid) || $pid <= 0) { 416 return 0; 417 } 418 my $rc = waitpid($pid, &WNOHANG); 419 return ($rc == $pid)?1:0; 420} 421 422####################################################################### 423# Start a new thread/process and run the given command line in there. 424# Return the pids (yes plural) of the new child process to the parent. 425# 426sub startnew { 427 my ($cmd, $pidfile, $timeout, $fake)=@_; 428 429 logmsg "startnew: $cmd\n" if ($verbose); 430 431 my $child = fork(); 432 my $pid2 = 0; 433 434 if(not defined $child) { 435 logmsg "startnew: fork() failure detected\n"; 436 return (-1,-1); 437 } 438 439 if(0 == $child) { 440 # Here we are the child. Run the given command. 441 442 # Put an "exec" in front of the command so that the child process 443 # keeps this child's process ID. 444 exec("exec $cmd") || die "Can't exec() $cmd: $!"; 445 446 # exec() should never return back here to this process. We protect 447 # ourselves by calling die() just in case something goes really bad. 448 die "error: exec() has returned"; 449 } 450 451 # Ugly hack but ssh client and gnutls-serv don't support pid files 452 if ($fake) { 453 if(open(OUT, ">$pidfile")) { 454 print OUT $child . "\n"; 455 close(OUT); 456 logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose); 457 } 458 else { 459 logmsg "startnew: failed to write fake $pidfile with pid=$child\n"; 460 } 461 # could/should do a while connect fails sleep a bit and loop 462 sleep $timeout; 463 if (checkdied($child)) { 464 logmsg "startnew: child process has failed to start\n" if($verbose); 465 return (-1,-1); 466 } 467 } 468 469 my $count = $timeout; 470 while($count--) { 471 if(-f $pidfile && -s $pidfile && open(PID, "<$pidfile")) { 472 $pid2 = 0 + <PID>; 473 close(PID); 474 if(($pid2 > 0) && pidexists($pid2)) { 475 # if $pid2 is valid, then make sure this pid is alive, as 476 # otherwise it is just likely to be the _previous_ pidfile or 477 # similar! 478 last; 479 } 480 # invalidate $pid2 if not actually alive 481 $pid2 = 0; 482 } 483 if (checkdied($child)) { 484 logmsg "startnew: child process has died, server might start up\n" 485 if($verbose); 486 # We can't just abort waiting for the server with a 487 # return (-1,-1); 488 # because the server might have forked and could still start 489 # up normally. Instead, just reduce the amount of time we remain 490 # waiting. 491 $count >>= 2; 492 } 493 sleep(1); 494 } 495 496 # Return two PIDs, the one for the child process we spawned and the one 497 # reported by the server itself (in case it forked again on its own). 498 # Both (potentially) need to be killed at the end of the test. 499 return ($child, $pid2); 500} 501 502 503####################################################################### 504# Check for a command in the PATH of the test server. 505# 506sub checkcmd { 507 my ($cmd)=@_; 508 my @paths=(split(":", $ENV{'PATH'}), "/usr/sbin", "/usr/local/sbin", 509 "/sbin", "/usr/bin", "/usr/local/bin", 510 "./libtest/.libs", "./libtest"); 511 for(@paths) { 512 if( -x "$_/$cmd" && ! -d "$_/$cmd") { 513 # executable bit but not a directory! 514 return "$_/$cmd"; 515 } 516 } 517} 518 519####################################################################### 520# Get the list of tests that the tests/data/Makefile.am knows about! 521# 522my $disttests; 523sub get_disttests { 524 my @dist = `cd data && make show`; 525 $disttests = join("", @dist); 526} 527 528####################################################################### 529# Check for a command in the PATH of the machine running curl. 530# 531sub checktestcmd { 532 my ($cmd)=@_; 533 return checkcmd($cmd); 534} 535 536####################################################################### 537# Run the application under test and return its return code 538# 539sub runclient { 540 my ($cmd)=@_; 541 my $ret = system($cmd); 542 print "CMD ($ret): $cmd\n" if($verbose && !$torture); 543 return $ret; 544 545# This is one way to test curl on a remote machine 546# my $out = system("ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'"); 547# sleep 2; # time to allow the NFS server to be updated 548# return $out; 549} 550 551####################################################################### 552# Run the application under test and return its stdout 553# 554sub runclientoutput { 555 my ($cmd)=@_; 556 return `$cmd`; 557 558# This is one way to test curl on a remote machine 559# my @out = `ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'`; 560# sleep 2; # time to allow the NFS server to be updated 561# return @out; 562 } 563 564####################################################################### 565# Memory allocation test and failure torture testing. 566# 567sub torture { 568 my ($testcmd, $testnum, $gdbline) = @_; 569 570 # remove memdump first to be sure we get a new nice and clean one 571 unlink($memdump); 572 573 # First get URL from test server, ignore the output/result 574 runclient($testcmd); 575 576 logmsg " CMD: $testcmd\n" if($verbose); 577 578 # memanalyze -v is our friend, get the number of allocations made 579 my $count=0; 580 my @out = `$memanalyze -v $memdump`; 581 for(@out) { 582 if(/^Operations: (\d+)/) { 583 $count = $1; 584 last; 585 } 586 } 587 if(!$count) { 588 logmsg " found no functions to make fail\n"; 589 return 0; 590 } 591 592 logmsg " $count functions to make fail\n"; 593 594 for ( 1 .. $count ) { 595 my $limit = $_; 596 my $fail; 597 my $dumped_core; 598 599 if($tortalloc && ($tortalloc != $limit)) { 600 next; 601 } 602 603 if($verbose) { 604 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 605 localtime(time()); 606 my $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec); 607 logmsg "Fail function no: $limit at $now\r"; 608 } 609 610 # make the memory allocation function number $limit return failure 611 $ENV{'CURL_MEMLIMIT'} = $limit; 612 613 # remove memdump first to be sure we get a new nice and clean one 614 unlink($memdump); 615 616 my $cmd = $testcmd; 617 if($valgrind && !$gdbthis) { 618 my @valgrindoption = getpart("verify", "valgrind"); 619 if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) { 620 my $valgrindcmd = "$valgrind "; 621 $valgrindcmd .= "$valgrind_tool " if($valgrind_tool); 622 $valgrindcmd .= "--quiet --leak-check=yes "; 623 $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp "; 624 # $valgrindcmd .= "--gen-suppressions=all "; 625 $valgrindcmd .= "--num-callers=16 "; 626 $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum"; 627 $cmd = "$valgrindcmd $testcmd"; 628 } 629 } 630 logmsg "*** Function number $limit is now set to fail ***\n" if($gdbthis); 631 632 my $ret = 0; 633 if($gdbthis) { 634 runclient($gdbline); 635 } 636 else { 637 $ret = runclient($cmd); 638 } 639 #logmsg "$_ Returned " . ($ret >> 8) . "\n"; 640 641 # Now clear the variable again 642 delete $ENV{'CURL_MEMLIMIT'} if($ENV{'CURL_MEMLIMIT'}); 643 644 if(-r "core") { 645 # there's core file present now! 646 logmsg " core dumped\n"; 647 $dumped_core = 1; 648 $fail = 2; 649 } 650 651 if($valgrind) { 652 my @e = valgrindparse("$LOGDIR/valgrind$testnum"); 653 if(@e && $e[0]) { 654 if($automakestyle) { 655 logmsg "FAIL: torture $testnum - valgrind\n"; 656 } 657 else { 658 logmsg " valgrind ERROR "; 659 logmsg @e; 660 } 661 $fail = 1; 662 } 663 } 664 665 # verify that it returns a proper error code, doesn't leak memory 666 # and doesn't core dump 667 if(($ret & 255) || ($ret >> 8) >= 128) { 668 logmsg " system() returned $ret\n"; 669 $fail=1; 670 } 671 else { 672 my @memdata=`$memanalyze $memdump`; 673 my $leak=0; 674 for(@memdata) { 675 if($_ ne "") { 676 # well it could be other memory problems as well, but 677 # we call it leak for short here 678 $leak=1; 679 } 680 } 681 if($leak) { 682 logmsg "** MEMORY FAILURE\n"; 683 logmsg @memdata; 684 logmsg `$memanalyze -l $memdump`; 685 $fail = 1; 686 } 687 } 688 if($fail) { 689 logmsg " Failed on function number $limit in test.\n", 690 " invoke with \"-t$limit\" to repeat this single case.\n"; 691 stopservers($verbose); 692 return 1; 693 } 694 } 695 696 logmsg "torture OK\n"; 697 return 0; 698} 699 700####################################################################### 701# Stop a test server along with pids which aren't in the %run hash yet. 702# This also stops all servers which are relative to the given one. 703# 704sub stopserver { 705 my ($server, $pidlist) = @_; 706 # 707 # kill sockfilter processes for pingpong relative server 708 # 709 if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) { 710 my $proto = $1; 711 my $idnum = ($2 && ($2 > 1)) ? $2 : 1; 712 my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4; 713 killsockfilters($proto, $ipvnum, $idnum, $verbose); 714 } 715 # 716 # All servers relative to the given one must be stopped also 717 # 718 my @killservers; 719 if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) { 720 # given a stunnel based ssl server, also kill non-ssl underlying one 721 push @killservers, "${1}${2}"; 722 } 723 elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|-unix|))$/) { 724 # given a non-ssl server, also kill stunnel based ssl piggybacking one 725 push @killservers, "${1}s${2}"; 726 } 727 elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) { 728 # given a socks server, also kill ssh underlying one 729 push @killservers, "ssh${2}"; 730 } 731 elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) { 732 # given a ssh server, also kill socks piggybacking one 733 push @killservers, "socks${2}"; 734 } 735 push @killservers, $server; 736 # 737 # kill given pids and server relative ones clearing them in %run hash 738 # 739 foreach my $server (@killservers) { 740 if($run{$server}) { 741 # we must prepend a space since $pidlist may already contain a pid 742 $pidlist .= " $run{$server}"; 743 $run{$server} = 0; 744 } 745 $runcert{$server} = 0 if($runcert{$server}); 746 } 747 killpid($verbose, $pidlist); 748 # 749 # cleanup server pid files 750 # 751 foreach my $server (@killservers) { 752 my $pidfile = $serverpidfile{$server}; 753 my $pid = processexists($pidfile); 754 if($pid > 0) { 755 logmsg "Warning: $server server unexpectedly alive\n"; 756 killpid($verbose, $pid); 757 } 758 unlink($pidfile) if(-f $pidfile); 759 } 760} 761 762####################################################################### 763# Verify that the server that runs on $ip, $port is our server. This also 764# implies that we can speak with it, as there might be occasions when the 765# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't 766# assign requested address") 767# 768sub verifyhttp { 769 my ($proto, $ipvnum, $idnum, $ip, $port_or_path) = @_; 770 my $server = servername_id($proto, $ipvnum, $idnum); 771 my $pid = 0; 772 my $bonus=""; 773 # $port_or_path contains a path for Unix sockets, sws ignores the port 774 my $port = ($ipvnum eq "unix") ? 80 : $port_or_path; 775 776 my $verifyout = "$LOGDIR/". 777 servername_canon($proto, $ipvnum, $idnum) .'_verify.out'; 778 unlink($verifyout) if(-f $verifyout); 779 780 my $verifylog = "$LOGDIR/". 781 servername_canon($proto, $ipvnum, $idnum) .'_verify.log'; 782 unlink($verifylog) if(-f $verifylog); 783 784 if($proto eq "gopher") { 785 # gopher is funny 786 $bonus="1/"; 787 } 788 789 my $flags = "--max-time $server_response_maxtime "; 790 $flags .= "--output $verifyout "; 791 $flags .= "--silent "; 792 $flags .= "--verbose "; 793 $flags .= "--globoff "; 794 $flags .= "--unix-socket '$port_or_path' " if $ipvnum eq "unix"; 795 $flags .= "--insecure " if($proto eq 'https'); 796 $flags .= "\"$proto://$ip:$port/${bonus}verifiedserver\""; 797 798 my $cmd = "$VCURL $flags 2>$verifylog"; 799 800 # verify if our/any server is running on this port 801 logmsg "RUN: $cmd\n" if($verbose); 802 my $res = runclient($cmd); 803 804 $res >>= 8; # rotate the result 805 if($res & 128) { 806 logmsg "RUN: curl command died with a coredump\n"; 807 return -1; 808 } 809 810 if($res && $verbose) { 811 logmsg "RUN: curl command returned $res\n"; 812 if(open(FILE, "<$verifylog")) { 813 while(my $string = <FILE>) { 814 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/); 815 } 816 close(FILE); 817 } 818 } 819 820 my $data; 821 if(open(FILE, "<$verifyout")) { 822 while(my $string = <FILE>) { 823 $data = $string; 824 last; # only want first line 825 } 826 close(FILE); 827 } 828 829 if($data && ($data =~ /WE ROOLZ: (\d+)/)) { 830 $pid = 0+$1; 831 } 832 elsif($res == 6) { 833 # curl: (6) Couldn't resolve host '::1' 834 logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n"; 835 return -1; 836 } 837 elsif($data || ($res && ($res != 7))) { 838 logmsg "RUN: Unknown server on our $server port: $port ($res)\n"; 839 return -1; 840 } 841 return $pid; 842} 843 844####################################################################### 845# Verify that the server that runs on $ip, $port is our server. This also 846# implies that we can speak with it, as there might be occasions when the 847# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't 848# assign requested address") 849# 850sub verifyftp { 851 my ($proto, $ipvnum, $idnum, $ip, $port) = @_; 852 my $server = servername_id($proto, $ipvnum, $idnum); 853 my $pid = 0; 854 my $time=time(); 855 my $extra=""; 856 857 my $verifylog = "$LOGDIR/". 858 servername_canon($proto, $ipvnum, $idnum) .'_verify.log'; 859 unlink($verifylog) if(-f $verifylog); 860 861 if($proto eq "ftps") { 862 $extra .= "--insecure --ftp-ssl-control "; 863 } 864 865 my $flags = "--max-time $server_response_maxtime "; 866 $flags .= "--silent "; 867 $flags .= "--verbose "; 868 $flags .= "--globoff "; 869 $flags .= $extra; 870 $flags .= "\"$proto://$ip:$port/verifiedserver\""; 871 872 my $cmd = "$VCURL $flags 2>$verifylog"; 873 874 # check if this is our server running on this port: 875 logmsg "RUN: $cmd\n" if($verbose); 876 my @data = runclientoutput($cmd); 877 878 my $res = $? >> 8; # rotate the result 879 if($res & 128) { 880 logmsg "RUN: curl command died with a coredump\n"; 881 return -1; 882 } 883 884 foreach my $line (@data) { 885 if($line =~ /WE ROOLZ: (\d+)/) { 886 # this is our test server with a known pid! 887 $pid = 0+$1; 888 last; 889 } 890 } 891 if($pid <= 0 && @data && $data[0]) { 892 # this is not a known server 893 logmsg "RUN: Unknown server on our $server port: $port\n"; 894 return 0; 895 } 896 # we can/should use the time it took to verify the FTP server as a measure 897 # on how fast/slow this host/FTP is. 898 my $took = int(0.5+time()-$time); 899 900 if($verbose) { 901 logmsg "RUN: Verifying our test $server server took $took seconds\n"; 902 } 903 $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1 904 905 return $pid; 906} 907 908####################################################################### 909# Verify that the server that runs on $ip, $port is our server. This also 910# implies that we can speak with it, as there might be occasions when the 911# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't 912# assign requested address") 913# 914sub verifyrtsp { 915 my ($proto, $ipvnum, $idnum, $ip, $port) = @_; 916 my $server = servername_id($proto, $ipvnum, $idnum); 917 my $pid = 0; 918 919 my $verifyout = "$LOGDIR/". 920 servername_canon($proto, $ipvnum, $idnum) .'_verify.out'; 921 unlink($verifyout) if(-f $verifyout); 922 923 my $verifylog = "$LOGDIR/". 924 servername_canon($proto, $ipvnum, $idnum) .'_verify.log'; 925 unlink($verifylog) if(-f $verifylog); 926 927 my $flags = "--max-time $server_response_maxtime "; 928 $flags .= "--output $verifyout "; 929 $flags .= "--silent "; 930 $flags .= "--verbose "; 931 $flags .= "--globoff "; 932 # currently verification is done using http 933 $flags .= "\"http://$ip:$port/verifiedserver\""; 934 935 my $cmd = "$VCURL $flags 2>$verifylog"; 936 937 # verify if our/any server is running on this port 938 logmsg "RUN: $cmd\n" if($verbose); 939 my $res = runclient($cmd); 940 941 $res >>= 8; # rotate the result 942 if($res & 128) { 943 logmsg "RUN: curl command died with a coredump\n"; 944 return -1; 945 } 946 947 if($res && $verbose) { 948 logmsg "RUN: curl command returned $res\n"; 949 if(open(FILE, "<$verifylog")) { 950 while(my $string = <FILE>) { 951 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/); 952 } 953 close(FILE); 954 } 955 } 956 957 my $data; 958 if(open(FILE, "<$verifyout")) { 959 while(my $string = <FILE>) { 960 $data = $string; 961 last; # only want first line 962 } 963 close(FILE); 964 } 965 966 if($data && ($data =~ /RTSP_SERVER WE ROOLZ: (\d+)/)) { 967 $pid = 0+$1; 968 } 969 elsif($res == 6) { 970 # curl: (6) Couldn't resolve host '::1' 971 logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n"; 972 return -1; 973 } 974 elsif($data || ($res != 7)) { 975 logmsg "RUN: Unknown server on our $server port: $port\n"; 976 return -1; 977 } 978 return $pid; 979} 980 981####################################################################### 982# Verify that the ssh server has written out its pidfile, recovering 983# the pid from the file and returning it if a process with that pid is 984# actually alive. 985# 986sub verifyssh { 987 my ($proto, $ipvnum, $idnum, $ip, $port) = @_; 988 my $server = servername_id($proto, $ipvnum, $idnum); 989 my $pidfile = server_pidfilename($proto, $ipvnum, $idnum); 990 my $pid = 0; 991 if(open(FILE, "<$pidfile")) { 992 $pid=0+<FILE>; 993 close(FILE); 994 } 995 if($pid > 0) { 996 # if we have a pid it is actually our ssh server, 997 # since runsshserver() unlinks previous pidfile 998 if(!pidexists($pid)) { 999 logmsg "RUN: SSH server has died after starting up\n"; 1000 checkdied($pid); 1001 unlink($pidfile); 1002 $pid = -1; 1003 } 1004 } 1005 return $pid; 1006} 1007 1008####################################################################### 1009# Verify that we can connect to the sftp server, properly authenticate 1010# with generated config and key files and run a simple remote pwd. 1011# 1012sub verifysftp { 1013 my ($proto, $ipvnum, $idnum, $ip, $port) = @_; 1014 my $server = servername_id($proto, $ipvnum, $idnum); 1015 my $verified = 0; 1016 # Find out sftp client canonical file name 1017 my $sftp = find_sftp(); 1018 if(!$sftp) { 1019 logmsg "RUN: SFTP server cannot find $sftpexe\n"; 1020 return -1; 1021 } 1022 # Find out ssh client canonical file name 1023 my $ssh = find_ssh(); 1024 if(!$ssh) { 1025 logmsg "RUN: SFTP server cannot find $sshexe\n"; 1026 return -1; 1027 } 1028 # Connect to sftp server, authenticate and run a remote pwd 1029 # command using our generated configuration and key files 1030 my $cmd = "\"$sftp\" -b $sftpcmds -F $sftpconfig -S \"$ssh\" $ip > $sftplog 2>&1"; 1031 my $res = runclient($cmd); 1032 # Search for pwd command response in log file 1033 if(open(SFTPLOGFILE, "<$sftplog")) { 1034 while(<SFTPLOGFILE>) { 1035 if(/^Remote working directory: /) { 1036 $verified = 1; 1037 last; 1038 } 1039 } 1040 close(SFTPLOGFILE); 1041 } 1042 return $verified; 1043} 1044 1045####################################################################### 1046# Verify that the non-stunnel HTTP TLS extensions capable server that runs 1047# on $ip, $port is our server. This also implies that we can speak with it, 1048# as there might be occasions when the server runs fine but we cannot talk 1049# to it ("Failed to connect to ::1: Can't assign requested address") 1050# 1051sub verifyhttptls { 1052 my ($proto, $ipvnum, $idnum, $ip, $port) = @_; 1053 my $server = servername_id($proto, $ipvnum, $idnum); 1054 my $pidfile = server_pidfilename($proto, $ipvnum, $idnum); 1055 my $pid = 0; 1056 1057 my $verifyout = "$LOGDIR/". 1058 servername_canon($proto, $ipvnum, $idnum) .'_verify.out'; 1059 unlink($verifyout) if(-f $verifyout); 1060 1061 my $verifylog = "$LOGDIR/". 1062 servername_canon($proto, $ipvnum, $idnum) .'_verify.log'; 1063 unlink($verifylog) if(-f $verifylog); 1064 1065 my $flags = "--max-time $server_response_maxtime "; 1066 $flags .= "--output $verifyout "; 1067 $flags .= "--verbose "; 1068 $flags .= "--globoff "; 1069 $flags .= "--insecure "; 1070 $flags .= "--tlsauthtype SRP "; 1071 $flags .= "--tlsuser jsmith "; 1072 $flags .= "--tlspassword abc "; 1073 $flags .= "\"https://$ip:$port/verifiedserver\""; 1074 1075 my $cmd = "$VCURL $flags 2>$verifylog"; 1076 1077 # verify if our/any server is running on this port 1078 logmsg "RUN: $cmd\n" if($verbose); 1079 my $res = runclient($cmd); 1080 1081 $res >>= 8; # rotate the result 1082 if($res & 128) { 1083 logmsg "RUN: curl command died with a coredump\n"; 1084 return -1; 1085 } 1086 1087 if($res && $verbose) { 1088 logmsg "RUN: curl command returned $res\n"; 1089 if(open(FILE, "<$verifylog")) { 1090 while(my $string = <FILE>) { 1091 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/); 1092 } 1093 close(FILE); 1094 } 1095 } 1096 1097 my $data; 1098 if(open(FILE, "<$verifyout")) { 1099 while(my $string = <FILE>) { 1100 $data .= $string; 1101 } 1102 close(FILE); 1103 } 1104 1105 if($data && ($data =~ /(GNUTLS|GnuTLS)/) && open(FILE, "<$pidfile")) { 1106 $pid=0+<FILE>; 1107 close(FILE); 1108 if($pid > 0) { 1109 # if we have a pid it is actually our httptls server, 1110 # since runhttptlsserver() unlinks previous pidfile 1111 if(!pidexists($pid)) { 1112 logmsg "RUN: $server server has died after starting up\n"; 1113 checkdied($pid); 1114 unlink($pidfile); 1115 $pid = -1; 1116 } 1117 } 1118 return $pid; 1119 } 1120 elsif($res == 6) { 1121 # curl: (6) Couldn't resolve host '::1' 1122 logmsg "RUN: failed to resolve host (https://$ip:$port/verifiedserver)\n"; 1123 return -1; 1124 } 1125 elsif($data || ($res && ($res != 7))) { 1126 logmsg "RUN: Unknown server on our $server port: $port ($res)\n"; 1127 return -1; 1128 } 1129 return $pid; 1130} 1131 1132####################################################################### 1133# STUB for verifying socks 1134# 1135sub verifysocks { 1136 my ($proto, $ipvnum, $idnum, $ip, $port) = @_; 1137 my $server = servername_id($proto, $ipvnum, $idnum); 1138 my $pidfile = server_pidfilename($proto, $ipvnum, $idnum); 1139 my $pid = 0; 1140 if(open(FILE, "<$pidfile")) { 1141 $pid=0+<FILE>; 1142 close(FILE); 1143 } 1144 if($pid > 0) { 1145 # if we have a pid it is actually our socks server, 1146 # since runsocksserver() unlinks previous pidfile 1147 if(!pidexists($pid)) { 1148 logmsg "RUN: SOCKS server has died after starting up\n"; 1149 checkdied($pid); 1150 unlink($pidfile); 1151 $pid = -1; 1152 } 1153 } 1154 return $pid; 1155} 1156 1157####################################################################### 1158# Verify that the server that runs on $ip, $port is our server. This also 1159# implies that we can speak with it, as there might be occasions when the 1160# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't 1161# assign requested address") 1162# 1163sub verifysmb { 1164 my ($proto, $ipvnum, $idnum, $ip, $port) = @_; 1165 my $server = servername_id($proto, $ipvnum, $idnum); 1166 my $pid = 0; 1167 my $time=time(); 1168 my $extra=""; 1169 1170 my $verifylog = "$LOGDIR/". 1171 servername_canon($proto, $ipvnum, $idnum) .'_verify.log'; 1172 unlink($verifylog) if(-f $verifylog); 1173 1174 my $flags = "--max-time $server_response_maxtime "; 1175 $flags .= "--silent "; 1176 $flags .= "--verbose "; 1177 $flags .= "--globoff "; 1178 $flags .= "-u 'curltest:curltest' "; 1179 $flags .= $extra; 1180 $flags .= "\"$proto://$ip:$port/SERVER/verifiedserver\""; 1181 1182 my $cmd = "$VCURL $flags 2>$verifylog"; 1183 1184 # check if this is our server running on this port: 1185 logmsg "RUN: $cmd\n" if($verbose); 1186 my @data = runclientoutput($cmd); 1187 1188 my $res = $? >> 8; # rotate the result 1189 if($res & 128) { 1190 logmsg "RUN: curl command died with a coredump\n"; 1191 return -1; 1192 } 1193 1194 foreach my $line (@data) { 1195 if($line =~ /WE ROOLZ: (\d+)/) { 1196 # this is our test server with a known pid! 1197 $pid = 0+$1; 1198 last; 1199 } 1200 } 1201 if($pid <= 0 && @data && $data[0]) { 1202 # this is not a known server 1203 logmsg "RUN: Unknown server on our $server port: $port\n"; 1204 return 0; 1205 } 1206 # we can/should use the time it took to verify the server as a measure 1207 # on how fast/slow this host is. 1208 my $took = int(0.5+time()-$time); 1209 1210 if($verbose) { 1211 logmsg "RUN: Verifying our test $server server took $took seconds\n"; 1212 } 1213 $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1 1214 1215 return $pid; 1216} 1217 1218####################################################################### 1219# Verify that the server that runs on $ip, $port is our server. This also 1220# implies that we can speak with it, as there might be occasions when the 1221# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't 1222# assign requested address") 1223# 1224sub verifytelnet { 1225 my ($proto, $ipvnum, $idnum, $ip, $port) = @_; 1226 my $server = servername_id($proto, $ipvnum, $idnum); 1227 my $pid = 0; 1228 my $time=time(); 1229 my $extra=""; 1230 1231 my $verifylog = "$LOGDIR/". 1232 servername_canon($proto, $ipvnum, $idnum) .'_verify.log'; 1233 unlink($verifylog) if(-f $verifylog); 1234 1235 my $flags = "--max-time $server_response_maxtime "; 1236 $flags .= "--silent "; 1237 $flags .= "--verbose "; 1238 $flags .= "--globoff "; 1239 $flags .= "--upload-file - "; 1240 $flags .= $extra; 1241 $flags .= "\"$proto://$ip:$port\""; 1242 1243 my $cmd = "echo 'verifiedserver' | $VCURL $flags 2>$verifylog"; 1244 1245 # check if this is our server running on this port: 1246 logmsg "RUN: $cmd\n" if($verbose); 1247 my @data = runclientoutput($cmd); 1248 1249 my $res = $? >> 8; # rotate the result 1250 if($res & 128) { 1251 logmsg "RUN: curl command died with a coredump\n"; 1252 return -1; 1253 } 1254 1255 foreach my $line (@data) { 1256 if($line =~ /WE ROOLZ: (\d+)/) { 1257 # this is our test server with a known pid! 1258 $pid = 0+$1; 1259 last; 1260 } 1261 } 1262 if($pid <= 0 && @data && $data[0]) { 1263 # this is not a known server 1264 logmsg "RUN: Unknown server on our $server port: $port\n"; 1265 return 0; 1266 } 1267 # we can/should use the time it took to verify the server as a measure 1268 # on how fast/slow this host is. 1269 my $took = int(0.5+time()-$time); 1270 1271 if($verbose) { 1272 logmsg "RUN: Verifying our test $server server took $took seconds\n"; 1273 } 1274 1275 return $pid; 1276} 1277 1278 1279####################################################################### 1280# Verify that the server that runs on $ip, $port is our server. 1281# Retry over several seconds before giving up. The ssh server in 1282# particular can take a long time to start if it needs to generate 1283# keys on a slow or loaded host. 1284# 1285# Just for convenience, test harness uses 'https' and 'httptls' literals 1286# as values for 'proto' variable in order to differentiate different 1287# servers. 'https' literal is used for stunnel based https test servers, 1288# and 'httptls' is used for non-stunnel https test servers. 1289# 1290 1291my %protofunc = ('http' => \&verifyhttp, 1292 'https' => \&verifyhttp, 1293 'rtsp' => \&verifyrtsp, 1294 'ftp' => \&verifyftp, 1295 'pop3' => \&verifyftp, 1296 'imap' => \&verifyftp, 1297 'smtp' => \&verifyftp, 1298 'ftps' => \&verifyftp, 1299 'tftp' => \&verifyftp, 1300 'ssh' => \&verifyssh, 1301 'socks' => \&verifysocks, 1302 'gopher' => \&verifyhttp, 1303 'httptls' => \&verifyhttptls, 1304 'dict' => \&verifyftp, 1305 'smb' => \&verifysmb, 1306 'telnet' => \&verifytelnet); 1307 1308sub verifyserver { 1309 my ($proto, $ipvnum, $idnum, $ip, $port) = @_; 1310 1311 my $count = 30; # try for this many seconds 1312 my $pid; 1313 1314 while($count--) { 1315 my $fun = $protofunc{$proto}; 1316 1317 $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port); 1318 1319 if($pid > 0) { 1320 last; 1321 } 1322 elsif($pid < 0) { 1323 # a real failure, stop trying and bail out 1324 return 0; 1325 } 1326 sleep(1); 1327 } 1328 return $pid; 1329} 1330 1331####################################################################### 1332# Single shot server responsiveness test. This should only be used 1333# to verify that a server present in %run hash is still functional 1334# 1335sub responsiveserver { 1336 my ($proto, $ipvnum, $idnum, $ip, $port) = @_; 1337 my $prev_verbose = $verbose; 1338 1339 $verbose = 0; 1340 my $fun = $protofunc{$proto}; 1341 my $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port); 1342 $verbose = $prev_verbose; 1343 1344 if($pid > 0) { 1345 return 1; # responsive 1346 } 1347 1348 my $srvrname = servername_str($proto, $ipvnum, $idnum); 1349 logmsg " server precheck FAILED (unresponsive $srvrname server)\n"; 1350 return 0; 1351} 1352 1353####################################################################### 1354# start the http2 server 1355# 1356sub runhttp2server { 1357 my ($verbose, $port) = @_; 1358 my $server; 1359 my $srvrname; 1360 my $pidfile; 1361 my $logfile; 1362 my $flags = ""; 1363 my $proto="http/2"; 1364 my $ipvnum = 4; 1365 my $idnum = 0; 1366 my $exe = "$perl $srcdir/http2-server.pl"; 1367 my $verbose_flag = "--verbose "; 1368 1369 $server = servername_id($proto, $ipvnum, $idnum); 1370 1371 $pidfile = $serverpidfile{$server}; 1372 1373 # don't retry if the server doesn't work 1374 if ($doesntrun{$pidfile}) { 1375 return (0,0); 1376 } 1377 1378 my $pid = processexists($pidfile); 1379 if($pid > 0) { 1380 stopserver($server, "$pid"); 1381 } 1382 unlink($pidfile) if(-f $pidfile); 1383 1384 $srvrname = servername_str($proto, $ipvnum, $idnum); 1385 1386 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 1387 1388 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" "; 1389 $flags .= "--port $HTTP2PORT "; 1390 $flags .= "--connect $HOSTIP:$HTTPPORT "; 1391 $flags .= $verbose_flag if($debugprotocol); 1392 1393 my $cmd = "$exe $flags"; 1394 my ($http2pid, $pid2) = startnew($cmd, $pidfile, 15, 0); 1395 1396 if($http2pid <= 0 || !pidexists($http2pid)) { 1397 # it is NOT alive 1398 logmsg "RUN: failed to start the $srvrname server\n"; 1399 stopserver($server, "$pid2"); 1400 $doesntrun{$pidfile} = 1; 1401 return (0,0); 1402 } 1403 1404 if($verbose) { 1405 logmsg "RUN: $srvrname server is now running PID $http2pid\n"; 1406 } 1407 1408 return ($http2pid, $pid2); 1409} 1410 1411####################################################################### 1412# start the http server 1413# 1414sub runhttpserver { 1415 my ($proto, $verbose, $alt, $port_or_path) = @_; 1416 my $ip = $HOSTIP; 1417 my $ipvnum = 4; 1418 my $idnum = 1; 1419 my $server; 1420 my $srvrname; 1421 my $pidfile; 1422 my $logfile; 1423 my $flags = ""; 1424 my $exe = "$perl $srcdir/httpserver.pl"; 1425 my $verbose_flag = "--verbose "; 1426 1427 if($alt eq "ipv6") { 1428 # if IPv6, use a different setup 1429 $ipvnum = 6; 1430 $ip = $HOST6IP; 1431 } 1432 elsif($alt eq "proxy") { 1433 # basically the same, but another ID 1434 $idnum = 2; 1435 } 1436 elsif($alt eq "unix") { 1437 # IP (protocol) is mutually exclusive with Unix sockets 1438 $ipvnum = "unix"; 1439 } 1440 1441 $server = servername_id($proto, $ipvnum, $idnum); 1442 1443 $pidfile = $serverpidfile{$server}; 1444 1445 # don't retry if the server doesn't work 1446 if ($doesntrun{$pidfile}) { 1447 return (0,0); 1448 } 1449 1450 my $pid = processexists($pidfile); 1451 if($pid > 0) { 1452 stopserver($server, "$pid"); 1453 } 1454 unlink($pidfile) if(-f $pidfile); 1455 1456 $srvrname = servername_str($proto, $ipvnum, $idnum); 1457 1458 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 1459 1460 $flags .= "--gopher " if($proto eq "gopher"); 1461 $flags .= "--connect $HOSTIP " if($alt eq "proxy"); 1462 $flags .= $verbose_flag if($debugprotocol); 1463 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" "; 1464 $flags .= "--id $idnum " if($idnum > 1); 1465 if($ipvnum eq "unix") { 1466 $flags .= "--unix-socket '$port_or_path' "; 1467 } else { 1468 $flags .= "--ipv$ipvnum --port $port_or_path "; 1469 } 1470 $flags .= "--srcdir \"$srcdir\""; 1471 1472 my $cmd = "$exe $flags"; 1473 my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0); 1474 1475 if($httppid <= 0 || !pidexists($httppid)) { 1476 # it is NOT alive 1477 logmsg "RUN: failed to start the $srvrname server\n"; 1478 stopserver($server, "$pid2"); 1479 displaylogs($testnumcheck); 1480 $doesntrun{$pidfile} = 1; 1481 return (0,0); 1482 } 1483 1484 # Server is up. Verify that we can speak to it. 1485 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port_or_path); 1486 if(!$pid3) { 1487 logmsg "RUN: $srvrname server failed verification\n"; 1488 # failed to talk to it properly. Kill the server and return failure 1489 stopserver($server, "$httppid $pid2"); 1490 displaylogs($testnumcheck); 1491 $doesntrun{$pidfile} = 1; 1492 return (0,0); 1493 } 1494 $pid2 = $pid3; 1495 1496 if($verbose) { 1497 logmsg "RUN: $srvrname server is now running PID $httppid\n"; 1498 } 1499 1500 sleep(1); 1501 1502 return ($httppid, $pid2); 1503} 1504 1505####################################################################### 1506# start the https stunnel based server 1507# 1508sub runhttpsserver { 1509 my ($verbose, $ipv6, $certfile) = @_; 1510 my $proto = 'https'; 1511 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP"; 1512 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4; 1513 my $idnum = 1; 1514 my $server; 1515 my $srvrname; 1516 my $pidfile; 1517 my $logfile; 1518 my $flags = ""; 1519 1520 if(!$stunnel) { 1521 return (0,0); 1522 } 1523 1524 $server = servername_id($proto, $ipvnum, $idnum); 1525 1526 $pidfile = $serverpidfile{$server}; 1527 1528 # don't retry if the server doesn't work 1529 if ($doesntrun{$pidfile}) { 1530 return (0,0); 1531 } 1532 1533 my $pid = processexists($pidfile); 1534 if($pid > 0) { 1535 stopserver($server, "$pid"); 1536 } 1537 unlink($pidfile) if(-f $pidfile); 1538 1539 $srvrname = servername_str($proto, $ipvnum, $idnum); 1540 1541 $certfile = 'stunnel.pem' unless($certfile); 1542 1543 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 1544 1545 $flags .= "--verbose " if($debugprotocol); 1546 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" "; 1547 $flags .= "--id $idnum " if($idnum > 1); 1548 $flags .= "--ipv$ipvnum --proto $proto "; 1549 $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem'); 1550 $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" "; 1551 $flags .= "--connect $HTTPPORT --accept $HTTPSPORT"; 1552 1553 my $cmd = "$perl $srcdir/secureserver.pl $flags"; 1554 my ($httpspid, $pid2) = startnew($cmd, $pidfile, 15, 0); 1555 1556 if($httpspid <= 0 || !pidexists($httpspid)) { 1557 # it is NOT alive 1558 logmsg "RUN: failed to start the $srvrname server\n"; 1559 stopserver($server, "$pid2"); 1560 displaylogs($testnumcheck); 1561 $doesntrun{$pidfile} = 1; 1562 return(0,0); 1563 } 1564 1565 # Server is up. Verify that we can speak to it. 1566 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $HTTPSPORT); 1567 if(!$pid3) { 1568 logmsg "RUN: $srvrname server failed verification\n"; 1569 # failed to talk to it properly. Kill the server and return failure 1570 stopserver($server, "$httpspid $pid2"); 1571 displaylogs($testnumcheck); 1572 $doesntrun{$pidfile} = 1; 1573 return (0,0); 1574 } 1575 # Here pid3 is actually the pid returned by the unsecure-http server. 1576 1577 $runcert{$server} = $certfile; 1578 1579 if($verbose) { 1580 logmsg "RUN: $srvrname server is now running PID $httpspid\n"; 1581 } 1582 1583 sleep(1); 1584 1585 return ($httpspid, $pid2); 1586} 1587 1588####################################################################### 1589# start the non-stunnel HTTP TLS extensions capable server 1590# 1591sub runhttptlsserver { 1592 my ($verbose, $ipv6) = @_; 1593 my $proto = "httptls"; 1594 my $port = ($ipv6 && ($ipv6 =~ /6$/)) ? $HTTPTLS6PORT : $HTTPTLSPORT; 1595 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP"; 1596 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4; 1597 my $idnum = 1; 1598 my $server; 1599 my $srvrname; 1600 my $pidfile; 1601 my $logfile; 1602 my $flags = ""; 1603 1604 if(!$httptlssrv) { 1605 return (0,0); 1606 } 1607 1608 $server = servername_id($proto, $ipvnum, $idnum); 1609 1610 $pidfile = $serverpidfile{$server}; 1611 1612 # don't retry if the server doesn't work 1613 if ($doesntrun{$pidfile}) { 1614 return (0,0); 1615 } 1616 1617 my $pid = processexists($pidfile); 1618 if($pid > 0) { 1619 stopserver($server, "$pid"); 1620 } 1621 unlink($pidfile) if(-f $pidfile); 1622 1623 $srvrname = servername_str($proto, $ipvnum, $idnum); 1624 1625 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 1626 1627 $flags .= "--http "; 1628 $flags .= "--debug 1 " if($debugprotocol); 1629 $flags .= "--port $port "; 1630 $flags .= "--priority NORMAL:+SRP "; 1631 $flags .= "--srppasswd $srcdir/certs/srp-verifier-db "; 1632 $flags .= "--srppasswdconf $srcdir/certs/srp-verifier-conf"; 1633 1634 my $cmd = "$httptlssrv $flags > $logfile 2>&1"; 1635 my ($httptlspid, $pid2) = startnew($cmd, $pidfile, 10, 1); # fake pidfile 1636 1637 if($httptlspid <= 0 || !pidexists($httptlspid)) { 1638 # it is NOT alive 1639 logmsg "RUN: failed to start the $srvrname server\n"; 1640 stopserver($server, "$pid2"); 1641 displaylogs($testnumcheck); 1642 $doesntrun{$pidfile} = 1; 1643 return (0,0); 1644 } 1645 1646 # Server is up. Verify that we can speak to it. PID is from fake pidfile 1647 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port); 1648 if(!$pid3) { 1649 logmsg "RUN: $srvrname server failed verification\n"; 1650 # failed to talk to it properly. Kill the server and return failure 1651 stopserver($server, "$httptlspid $pid2"); 1652 displaylogs($testnumcheck); 1653 $doesntrun{$pidfile} = 1; 1654 return (0,0); 1655 } 1656 $pid2 = $pid3; 1657 1658 if($verbose) { 1659 logmsg "RUN: $srvrname server is now running PID $httptlspid\n"; 1660 } 1661 1662 sleep(1); 1663 1664 return ($httptlspid, $pid2); 1665} 1666 1667####################################################################### 1668# start the pingpong server (FTP, POP3, IMAP, SMTP) 1669# 1670sub runpingpongserver { 1671 my ($proto, $id, $verbose, $ipv6) = @_; 1672 my $port; 1673 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP"; 1674 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4; 1675 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1; 1676 my $server; 1677 my $srvrname; 1678 my $pidfile; 1679 my $logfile; 1680 my $flags = ""; 1681 1682 if($proto eq "ftp") { 1683 $port = ($idnum>1)?$FTP2PORT:$FTPPORT; 1684 1685 if($ipvnum==6) { 1686 # if IPv6, use a different setup 1687 $port = $FTP6PORT; 1688 } 1689 } 1690 elsif($proto eq "pop3") { 1691 $port = ($ipvnum==6) ? $POP36PORT : $POP3PORT; 1692 } 1693 elsif($proto eq "imap") { 1694 $port = ($ipvnum==6) ? $IMAP6PORT : $IMAPPORT; 1695 } 1696 elsif($proto eq "smtp") { 1697 $port = ($ipvnum==6) ? $SMTP6PORT : $SMTPPORT; 1698 } 1699 else { 1700 print STDERR "Unsupported protocol $proto!!\n"; 1701 return 0; 1702 } 1703 1704 $server = servername_id($proto, $ipvnum, $idnum); 1705 1706 $pidfile = $serverpidfile{$server}; 1707 1708 # don't retry if the server doesn't work 1709 if ($doesntrun{$pidfile}) { 1710 return (0,0); 1711 } 1712 1713 my $pid = processexists($pidfile); 1714 if($pid > 0) { 1715 stopserver($server, "$pid"); 1716 } 1717 unlink($pidfile) if(-f $pidfile); 1718 1719 $srvrname = servername_str($proto, $ipvnum, $idnum); 1720 1721 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 1722 1723 $flags .= "--verbose " if($debugprotocol); 1724 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" "; 1725 $flags .= "--srcdir \"$srcdir\" --proto $proto "; 1726 $flags .= "--id $idnum " if($idnum > 1); 1727 $flags .= "--ipv$ipvnum --port $port --addr \"$ip\""; 1728 1729 my $cmd = "$perl $srcdir/ftpserver.pl $flags"; 1730 my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0); 1731 1732 if($ftppid <= 0 || !pidexists($ftppid)) { 1733 # it is NOT alive 1734 logmsg "RUN: failed to start the $srvrname server\n"; 1735 stopserver($server, "$pid2"); 1736 displaylogs($testnumcheck); 1737 $doesntrun{$pidfile} = 1; 1738 return (0,0); 1739 } 1740 1741 # Server is up. Verify that we can speak to it. 1742 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port); 1743 if(!$pid3) { 1744 logmsg "RUN: $srvrname server failed verification\n"; 1745 # failed to talk to it properly. Kill the server and return failure 1746 stopserver($server, "$ftppid $pid2"); 1747 displaylogs($testnumcheck); 1748 $doesntrun{$pidfile} = 1; 1749 return (0,0); 1750 } 1751 1752 $pid2 = $pid3; 1753 1754 if($verbose) { 1755 logmsg "RUN: $srvrname server is now running PID $ftppid\n"; 1756 } 1757 1758 sleep(1); 1759 1760 return ($pid2, $ftppid); 1761} 1762 1763####################################################################### 1764# start the ftps server (or rather, tunnel) 1765# 1766sub runftpsserver { 1767 my ($verbose, $ipv6, $certfile) = @_; 1768 my $proto = 'ftps'; 1769 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP"; 1770 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4; 1771 my $idnum = 1; 1772 my $server; 1773 my $srvrname; 1774 my $pidfile; 1775 my $logfile; 1776 my $flags = ""; 1777 1778 if(!$stunnel) { 1779 return (0,0); 1780 } 1781 1782 $server = servername_id($proto, $ipvnum, $idnum); 1783 1784 $pidfile = $serverpidfile{$server}; 1785 1786 # don't retry if the server doesn't work 1787 if ($doesntrun{$pidfile}) { 1788 return (0,0); 1789 } 1790 1791 my $pid = processexists($pidfile); 1792 if($pid > 0) { 1793 stopserver($server, "$pid"); 1794 } 1795 unlink($pidfile) if(-f $pidfile); 1796 1797 $srvrname = servername_str($proto, $ipvnum, $idnum); 1798 1799 $certfile = 'stunnel.pem' unless($certfile); 1800 1801 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 1802 1803 $flags .= "--verbose " if($debugprotocol); 1804 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" "; 1805 $flags .= "--id $idnum " if($idnum > 1); 1806 $flags .= "--ipv$ipvnum --proto $proto "; 1807 $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem'); 1808 $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" "; 1809 $flags .= "--connect $FTPPORT --accept $FTPSPORT"; 1810 1811 my $cmd = "$perl $srcdir/secureserver.pl $flags"; 1812 my ($ftpspid, $pid2) = startnew($cmd, $pidfile, 15, 0); 1813 1814 if($ftpspid <= 0 || !pidexists($ftpspid)) { 1815 # it is NOT alive 1816 logmsg "RUN: failed to start the $srvrname server\n"; 1817 stopserver($server, "$pid2"); 1818 displaylogs($testnumcheck); 1819 $doesntrun{$pidfile} = 1; 1820 return(0,0); 1821 } 1822 1823 # Server is up. Verify that we can speak to it. 1824 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $FTPSPORT); 1825 if(!$pid3) { 1826 logmsg "RUN: $srvrname server failed verification\n"; 1827 # failed to talk to it properly. Kill the server and return failure 1828 stopserver($server, "$ftpspid $pid2"); 1829 displaylogs($testnumcheck); 1830 $doesntrun{$pidfile} = 1; 1831 return (0,0); 1832 } 1833 # Here pid3 is actually the pid returned by the unsecure-ftp server. 1834 1835 $runcert{$server} = $certfile; 1836 1837 if($verbose) { 1838 logmsg "RUN: $srvrname server is now running PID $ftpspid\n"; 1839 } 1840 1841 sleep(1); 1842 1843 return ($ftpspid, $pid2); 1844} 1845 1846####################################################################### 1847# start the tftp server 1848# 1849sub runtftpserver { 1850 my ($id, $verbose, $ipv6) = @_; 1851 my $port = $TFTPPORT; 1852 my $ip = $HOSTIP; 1853 my $proto = 'tftp'; 1854 my $ipvnum = 4; 1855 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1; 1856 my $server; 1857 my $srvrname; 1858 my $pidfile; 1859 my $logfile; 1860 my $flags = ""; 1861 1862 if($ipv6) { 1863 # if IPv6, use a different setup 1864 $ipvnum = 6; 1865 $port = $TFTP6PORT; 1866 $ip = $HOST6IP; 1867 } 1868 1869 $server = servername_id($proto, $ipvnum, $idnum); 1870 1871 $pidfile = $serverpidfile{$server}; 1872 1873 # don't retry if the server doesn't work 1874 if ($doesntrun{$pidfile}) { 1875 return (0,0); 1876 } 1877 1878 my $pid = processexists($pidfile); 1879 if($pid > 0) { 1880 stopserver($server, "$pid"); 1881 } 1882 unlink($pidfile) if(-f $pidfile); 1883 1884 $srvrname = servername_str($proto, $ipvnum, $idnum); 1885 1886 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 1887 1888 $flags .= "--verbose " if($debugprotocol); 1889 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" "; 1890 $flags .= "--id $idnum " if($idnum > 1); 1891 $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\""; 1892 1893 my $cmd = "$perl $srcdir/tftpserver.pl $flags"; 1894 my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0); 1895 1896 if($tftppid <= 0 || !pidexists($tftppid)) { 1897 # it is NOT alive 1898 logmsg "RUN: failed to start the $srvrname server\n"; 1899 stopserver($server, "$pid2"); 1900 displaylogs($testnumcheck); 1901 $doesntrun{$pidfile} = 1; 1902 return (0,0); 1903 } 1904 1905 # Server is up. Verify that we can speak to it. 1906 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port); 1907 if(!$pid3) { 1908 logmsg "RUN: $srvrname server failed verification\n"; 1909 # failed to talk to it properly. Kill the server and return failure 1910 stopserver($server, "$tftppid $pid2"); 1911 displaylogs($testnumcheck); 1912 $doesntrun{$pidfile} = 1; 1913 return (0,0); 1914 } 1915 $pid2 = $pid3; 1916 1917 if($verbose) { 1918 logmsg "RUN: $srvrname server is now running PID $tftppid\n"; 1919 } 1920 1921 sleep(1); 1922 1923 return ($pid2, $tftppid); 1924} 1925 1926 1927####################################################################### 1928# start the rtsp server 1929# 1930sub runrtspserver { 1931 my ($verbose, $ipv6) = @_; 1932 my $port = $RTSPPORT; 1933 my $ip = $HOSTIP; 1934 my $proto = 'rtsp'; 1935 my $ipvnum = 4; 1936 my $idnum = 1; 1937 my $server; 1938 my $srvrname; 1939 my $pidfile; 1940 my $logfile; 1941 my $flags = ""; 1942 1943 if($ipv6) { 1944 # if IPv6, use a different setup 1945 $ipvnum = 6; 1946 $port = $RTSP6PORT; 1947 $ip = $HOST6IP; 1948 } 1949 1950 $server = servername_id($proto, $ipvnum, $idnum); 1951 1952 $pidfile = $serverpidfile{$server}; 1953 1954 # don't retry if the server doesn't work 1955 if ($doesntrun{$pidfile}) { 1956 return (0,0); 1957 } 1958 1959 my $pid = processexists($pidfile); 1960 if($pid > 0) { 1961 stopserver($server, "$pid"); 1962 } 1963 unlink($pidfile) if(-f $pidfile); 1964 1965 $srvrname = servername_str($proto, $ipvnum, $idnum); 1966 1967 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 1968 1969 $flags .= "--verbose " if($debugprotocol); 1970 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" "; 1971 $flags .= "--id $idnum " if($idnum > 1); 1972 $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\""; 1973 1974 my $cmd = "$perl $srcdir/rtspserver.pl $flags"; 1975 my ($rtsppid, $pid2) = startnew($cmd, $pidfile, 15, 0); 1976 1977 if($rtsppid <= 0 || !pidexists($rtsppid)) { 1978 # it is NOT alive 1979 logmsg "RUN: failed to start the $srvrname server\n"; 1980 stopserver($server, "$pid2"); 1981 displaylogs($testnumcheck); 1982 $doesntrun{$pidfile} = 1; 1983 return (0,0); 1984 } 1985 1986 # Server is up. Verify that we can speak to it. 1987 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port); 1988 if(!$pid3) { 1989 logmsg "RUN: $srvrname server failed verification\n"; 1990 # failed to talk to it properly. Kill the server and return failure 1991 stopserver($server, "$rtsppid $pid2"); 1992 displaylogs($testnumcheck); 1993 $doesntrun{$pidfile} = 1; 1994 return (0,0); 1995 } 1996 $pid2 = $pid3; 1997 1998 if($verbose) { 1999 logmsg "RUN: $srvrname server is now running PID $rtsppid\n"; 2000 } 2001 2002 sleep(1); 2003 2004 return ($rtsppid, $pid2); 2005} 2006 2007 2008####################################################################### 2009# Start the ssh (scp/sftp) server 2010# 2011sub runsshserver { 2012 my ($id, $verbose, $ipv6) = @_; 2013 my $ip=$HOSTIP; 2014 my $port = $SSHPORT; 2015 my $socksport = $SOCKSPORT; 2016 my $proto = 'ssh'; 2017 my $ipvnum = 4; 2018 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1; 2019 my $server; 2020 my $srvrname; 2021 my $pidfile; 2022 my $logfile; 2023 my $flags = ""; 2024 2025 $server = servername_id($proto, $ipvnum, $idnum); 2026 2027 $pidfile = $serverpidfile{$server}; 2028 2029 # don't retry if the server doesn't work 2030 if ($doesntrun{$pidfile}) { 2031 return (0,0); 2032 } 2033 2034 my $pid = processexists($pidfile); 2035 if($pid > 0) { 2036 stopserver($server, "$pid"); 2037 } 2038 unlink($pidfile) if(-f $pidfile); 2039 2040 $srvrname = servername_str($proto, $ipvnum, $idnum); 2041 2042 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 2043 2044 $flags .= "--verbose " if($verbose); 2045 $flags .= "--debugprotocol " if($debugprotocol); 2046 $flags .= "--pidfile \"$pidfile\" "; 2047 $flags .= "--id $idnum " if($idnum > 1); 2048 $flags .= "--ipv$ipvnum --addr \"$ip\" "; 2049 $flags .= "--sshport $port --socksport $socksport "; 2050 $flags .= "--user \"$USER\""; 2051 2052 my $cmd = "$perl $srcdir/sshserver.pl $flags"; 2053 my ($sshpid, $pid2) = startnew($cmd, $pidfile, 60, 0); 2054 2055 # on loaded systems sshserver start up can take longer than the timeout 2056 # passed to startnew, when this happens startnew completes without being 2057 # able to read the pidfile and consequently returns a zero pid2 above. 2058 2059 if($sshpid <= 0 || !pidexists($sshpid)) { 2060 # it is NOT alive 2061 logmsg "RUN: failed to start the $srvrname server\n"; 2062 stopserver($server, "$pid2"); 2063 $doesntrun{$pidfile} = 1; 2064 return (0,0); 2065 } 2066 2067 # ssh server verification allows some extra time for the server to start up 2068 # and gives us the opportunity of recovering the pid from the pidfile, when 2069 # this verification succeeds the recovered pid is assigned to pid2. 2070 2071 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port); 2072 if(!$pid3) { 2073 logmsg "RUN: $srvrname server failed verification\n"; 2074 # failed to fetch server pid. Kill the server and return failure 2075 stopserver($server, "$sshpid $pid2"); 2076 $doesntrun{$pidfile} = 1; 2077 return (0,0); 2078 } 2079 $pid2 = $pid3; 2080 2081 # once it is known that the ssh server is alive, sftp server verification 2082 # is performed actually connecting to it, authenticating and performing a 2083 # very simple remote command. This verification is tried only one time. 2084 2085 $sshdlog = server_logfilename($LOGDIR, 'ssh', $ipvnum, $idnum); 2086 $sftplog = server_logfilename($LOGDIR, 'sftp', $ipvnum, $idnum); 2087 2088 if(verifysftp('sftp', $ipvnum, $idnum, $ip, $port) < 1) { 2089 logmsg "RUN: SFTP server failed verification\n"; 2090 # failed to talk to it properly. Kill the server and return failure 2091 display_sftplog(); 2092 display_sftpconfig(); 2093 display_sshdlog(); 2094 display_sshdconfig(); 2095 stopserver($server, "$sshpid $pid2"); 2096 $doesntrun{$pidfile} = 1; 2097 return (0,0); 2098 } 2099 2100 if($verbose) { 2101 logmsg "RUN: $srvrname server is now running PID $pid2\n"; 2102 } 2103 2104 return ($pid2, $sshpid); 2105} 2106 2107####################################################################### 2108# Start the socks server 2109# 2110sub runsocksserver { 2111 my ($id, $verbose, $ipv6) = @_; 2112 my $ip=$HOSTIP; 2113 my $port = $SOCKSPORT; 2114 my $proto = 'socks'; 2115 my $ipvnum = 4; 2116 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1; 2117 my $server; 2118 my $srvrname; 2119 my $pidfile; 2120 my $logfile; 2121 my $flags = ""; 2122 2123 $server = servername_id($proto, $ipvnum, $idnum); 2124 2125 $pidfile = $serverpidfile{$server}; 2126 2127 # don't retry if the server doesn't work 2128 if ($doesntrun{$pidfile}) { 2129 return (0,0); 2130 } 2131 2132 my $pid = processexists($pidfile); 2133 if($pid > 0) { 2134 stopserver($server, "$pid"); 2135 } 2136 unlink($pidfile) if(-f $pidfile); 2137 2138 $srvrname = servername_str($proto, $ipvnum, $idnum); 2139 2140 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 2141 2142 # The ssh server must be already running 2143 if(!$run{'ssh'}) { 2144 logmsg "RUN: SOCKS server cannot find running SSH server\n"; 2145 $doesntrun{$pidfile} = 1; 2146 return (0,0); 2147 } 2148 2149 # Find out ssh daemon canonical file name 2150 my $sshd = find_sshd(); 2151 if(!$sshd) { 2152 logmsg "RUN: SOCKS server cannot find $sshdexe\n"; 2153 $doesntrun{$pidfile} = 1; 2154 return (0,0); 2155 } 2156 2157 # Find out ssh daemon version info 2158 ($sshdid, $sshdvernum, $sshdverstr, $sshderror) = sshversioninfo($sshd); 2159 if(!$sshdid) { 2160 # Not an OpenSSH or SunSSH ssh daemon 2161 logmsg "$sshderror\n" if($verbose); 2162 logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n"; 2163 $doesntrun{$pidfile} = 1; 2164 return (0,0); 2165 } 2166 logmsg "ssh server found $sshd is $sshdverstr\n" if($verbose); 2167 2168 # Find out ssh client canonical file name 2169 my $ssh = find_ssh(); 2170 if(!$ssh) { 2171 logmsg "RUN: SOCKS server cannot find $sshexe\n"; 2172 $doesntrun{$pidfile} = 1; 2173 return (0,0); 2174 } 2175 2176 # Find out ssh client version info 2177 my ($sshid, $sshvernum, $sshverstr, $ssherror) = sshversioninfo($ssh); 2178 if(!$sshid) { 2179 # Not an OpenSSH or SunSSH ssh client 2180 logmsg "$ssherror\n" if($verbose); 2181 logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n"; 2182 $doesntrun{$pidfile} = 1; 2183 return (0,0); 2184 } 2185 2186 # Verify minimum ssh client version 2187 if((($sshid =~ /OpenSSH/) && ($sshvernum < 299)) || 2188 (($sshid =~ /SunSSH/) && ($sshvernum < 100))) { 2189 logmsg "ssh client found $ssh is $sshverstr\n"; 2190 logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n"; 2191 $doesntrun{$pidfile} = 1; 2192 return (0,0); 2193 } 2194 logmsg "ssh client found $ssh is $sshverstr\n" if($verbose); 2195 2196 # Verify if ssh client and ssh daemon versions match 2197 if(($sshdid ne $sshid) || ($sshdvernum != $sshvernum)) { 2198 # Our test harness might work with slightly mismatched versions 2199 logmsg "Warning: version mismatch: sshd $sshdverstr - ssh $sshverstr\n" 2200 if($verbose); 2201 } 2202 2203 # Config file options for ssh client are previously set from sshserver.pl 2204 if(! -e $sshconfig) { 2205 logmsg "RUN: SOCKS server cannot find $sshconfig\n"; 2206 $doesntrun{$pidfile} = 1; 2207 return (0,0); 2208 } 2209 2210 $sshlog = server_logfilename($LOGDIR, 'socks', $ipvnum, $idnum); 2211 2212 # start our socks server 2213 my $cmd="\"$ssh\" -N -F $sshconfig $ip > $sshlog 2>&1"; 2214 my ($sshpid, $pid2) = startnew($cmd, $pidfile, 30, 1); # fake pidfile 2215 2216 if($sshpid <= 0 || !pidexists($sshpid)) { 2217 # it is NOT alive 2218 logmsg "RUN: failed to start the $srvrname server\n"; 2219 display_sshlog(); 2220 display_sshconfig(); 2221 display_sshdlog(); 2222 display_sshdconfig(); 2223 stopserver($server, "$pid2"); 2224 $doesntrun{$pidfile} = 1; 2225 return (0,0); 2226 } 2227 2228 # Ugly hack but ssh doesn't support pid files. PID is from fake pidfile. 2229 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port); 2230 if(!$pid3) { 2231 logmsg "RUN: $srvrname server failed verification\n"; 2232 # failed to talk to it properly. Kill the server and return failure 2233 stopserver($server, "$sshpid $pid2"); 2234 $doesntrun{$pidfile} = 1; 2235 return (0,0); 2236 } 2237 $pid2 = $pid3; 2238 2239 if($verbose) { 2240 logmsg "RUN: $srvrname server is now running PID $pid2\n"; 2241 } 2242 2243 return ($pid2, $sshpid); 2244} 2245 2246####################################################################### 2247# start the dict server 2248# 2249sub rundictserver { 2250 my ($verbose, $alt, $port) = @_; 2251 my $proto = "dict"; 2252 my $ip = $HOSTIP; 2253 my $ipvnum = 4; 2254 my $idnum = 1; 2255 my $server; 2256 my $srvrname; 2257 my $pidfile; 2258 my $logfile; 2259 my $flags = ""; 2260 2261 if($alt eq "ipv6") { 2262 # No IPv6 2263 } 2264 2265 $server = servername_id($proto, $ipvnum, $idnum); 2266 2267 $pidfile = $serverpidfile{$server}; 2268 2269 # don't retry if the server doesn't work 2270 if ($doesntrun{$pidfile}) { 2271 return (0,0); 2272 } 2273 2274 my $pid = processexists($pidfile); 2275 if($pid > 0) { 2276 stopserver($server, "$pid"); 2277 } 2278 unlink($pidfile) if(-f $pidfile); 2279 2280 $srvrname = servername_str($proto, $ipvnum, $idnum); 2281 2282 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 2283 2284 $flags .= "--verbose 1 " if($debugprotocol); 2285 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" "; 2286 $flags .= "--id $idnum " if($idnum > 1); 2287 $flags .= "--port $port --srcdir \"$srcdir\""; 2288 2289 my $cmd = "$srcdir/dictserver.py $flags"; 2290 my ($dictpid, $pid2) = startnew($cmd, $pidfile, 15, 0); 2291 2292 if($dictpid <= 0 || !pidexists($dictpid)) { 2293 # it is NOT alive 2294 logmsg "RUN: failed to start the $srvrname server\n"; 2295 stopserver($server, "$pid2"); 2296 displaylogs($testnumcheck); 2297 $doesntrun{$pidfile} = 1; 2298 return (0,0); 2299 } 2300 2301 # Server is up. Verify that we can speak to it. 2302 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port); 2303 if(!$pid3) { 2304 logmsg "RUN: $srvrname server failed verification\n"; 2305 # failed to talk to it properly. Kill the server and return failure 2306 stopserver($server, "$dictpid $pid2"); 2307 displaylogs($testnumcheck); 2308 $doesntrun{$pidfile} = 1; 2309 return (0,0); 2310 } 2311 $pid2 = $pid3; 2312 2313 if($verbose) { 2314 logmsg "RUN: $srvrname server is now running PID $dictpid\n"; 2315 } 2316 2317 sleep(1); 2318 2319 return ($dictpid, $pid2); 2320} 2321 2322####################################################################### 2323# start the SMB server 2324# 2325sub runsmbserver { 2326 my ($verbose, $alt, $port) = @_; 2327 my $proto = "smb"; 2328 my $ip = $HOSTIP; 2329 my $ipvnum = 4; 2330 my $idnum = 1; 2331 my $server; 2332 my $srvrname; 2333 my $pidfile; 2334 my $logfile; 2335 my $flags = ""; 2336 2337 if($alt eq "ipv6") { 2338 # No IPv6 2339 } 2340 2341 $server = servername_id($proto, $ipvnum, $idnum); 2342 2343 $pidfile = $serverpidfile{$server}; 2344 2345 # don't retry if the server doesn't work 2346 if ($doesntrun{$pidfile}) { 2347 return (0,0); 2348 } 2349 2350 my $pid = processexists($pidfile); 2351 if($pid > 0) { 2352 stopserver($server, "$pid"); 2353 } 2354 unlink($pidfile) if(-f $pidfile); 2355 2356 $srvrname = servername_str($proto, $ipvnum, $idnum); 2357 2358 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 2359 2360 $flags .= "--verbose 1 " if($debugprotocol); 2361 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" "; 2362 $flags .= "--id $idnum " if($idnum > 1); 2363 $flags .= "--port $port --srcdir \"$srcdir\""; 2364 2365 my $cmd = "$srcdir/smbserver.py $flags"; 2366 my ($smbpid, $pid2) = startnew($cmd, $pidfile, 15, 0); 2367 2368 if($smbpid <= 0 || !pidexists($smbpid)) { 2369 # it is NOT alive 2370 logmsg "RUN: failed to start the $srvrname server\n"; 2371 stopserver($server, "$pid2"); 2372 displaylogs($testnumcheck); 2373 $doesntrun{$pidfile} = 1; 2374 return (0,0); 2375 } 2376 2377 # Server is up. Verify that we can speak to it. 2378 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port); 2379 if(!$pid3) { 2380 logmsg "RUN: $srvrname server failed verification\n"; 2381 # failed to talk to it properly. Kill the server and return failure 2382 stopserver($server, "$smbpid $pid2"); 2383 displaylogs($testnumcheck); 2384 $doesntrun{$pidfile} = 1; 2385 return (0,0); 2386 } 2387 $pid2 = $pid3; 2388 2389 if($verbose) { 2390 logmsg "RUN: $srvrname server is now running PID $smbpid\n"; 2391 } 2392 2393 sleep(1); 2394 2395 return ($smbpid, $pid2); 2396} 2397 2398####################################################################### 2399# start the telnet server 2400# 2401sub runnegtelnetserver { 2402 my ($verbose, $alt, $port) = @_; 2403 my $proto = "telnet"; 2404 my $ip = $HOSTIP; 2405 my $ipvnum = 4; 2406 my $idnum = 1; 2407 my $server; 2408 my $srvrname; 2409 my $pidfile; 2410 my $logfile; 2411 my $flags = ""; 2412 2413 if($alt eq "ipv6") { 2414 # No IPv6 2415 } 2416 2417 $server = servername_id($proto, $ipvnum, $idnum); 2418 2419 $pidfile = $serverpidfile{$server}; 2420 2421 # don't retry if the server doesn't work 2422 if ($doesntrun{$pidfile}) { 2423 return (0,0); 2424 } 2425 2426 my $pid = processexists($pidfile); 2427 if($pid > 0) { 2428 stopserver($server, "$pid"); 2429 } 2430 unlink($pidfile) if(-f $pidfile); 2431 2432 $srvrname = servername_str($proto, $ipvnum, $idnum); 2433 2434 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum); 2435 2436 $flags .= "--verbose 1 " if($debugprotocol); 2437 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" "; 2438 $flags .= "--id $idnum " if($idnum > 1); 2439 $flags .= "--port $port --srcdir \"$srcdir\""; 2440 2441 my $cmd = "$srcdir/negtelnetserver.py $flags"; 2442 my ($ntelpid, $pid2) = startnew($cmd, $pidfile, 15, 0); 2443 2444 if($ntelpid <= 0 || !pidexists($ntelpid)) { 2445 # it is NOT alive 2446 logmsg "RUN: failed to start the $srvrname server\n"; 2447 stopserver($server, "$pid2"); 2448 displaylogs($testnumcheck); 2449 $doesntrun{$pidfile} = 1; 2450 return (0,0); 2451 } 2452 2453 # Server is up. Verify that we can speak to it. 2454 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port); 2455 if(!$pid3) { 2456 logmsg "RUN: $srvrname server failed verification\n"; 2457 # failed to talk to it properly. Kill the server and return failure 2458 stopserver($server, "$ntelpid $pid2"); 2459 displaylogs($testnumcheck); 2460 $doesntrun{$pidfile} = 1; 2461 return (0,0); 2462 } 2463 $pid2 = $pid3; 2464 2465 if($verbose) { 2466 logmsg "RUN: $srvrname server is now running PID $ntelpid\n"; 2467 } 2468 2469 sleep(1); 2470 2471 return ($ntelpid, $pid2); 2472} 2473 2474 2475####################################################################### 2476# Single shot http and gopher server responsiveness test. This should only 2477# be used to verify that a server present in %run hash is still functional 2478# 2479sub responsive_http_server { 2480 my ($proto, $verbose, $alt, $port_or_path) = @_; 2481 my $ip = $HOSTIP; 2482 my $ipvnum = 4; 2483 my $idnum = 1; 2484 2485 if($alt eq "ipv6") { 2486 # if IPv6, use a different setup 2487 $ipvnum = 6; 2488 $ip = $HOST6IP; 2489 } 2490 elsif($alt eq "proxy") { 2491 $idnum = 2; 2492 } 2493 elsif($alt eq "unix") { 2494 # IP (protocol) is mutually exclusive with Unix sockets 2495 $ipvnum = "unix"; 2496 } 2497 2498 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port_or_path); 2499} 2500 2501####################################################################### 2502# Single shot pingpong server responsiveness test. This should only be 2503# used to verify that a server present in %run hash is still functional 2504# 2505sub responsive_pingpong_server { 2506 my ($proto, $id, $verbose, $ipv6) = @_; 2507 my $port; 2508 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP"; 2509 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4; 2510 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1; 2511 2512 if($proto eq "ftp") { 2513 $port = ($idnum>1)?$FTP2PORT:$FTPPORT; 2514 2515 if($ipvnum==6) { 2516 # if IPv6, use a different setup 2517 $port = $FTP6PORT; 2518 } 2519 } 2520 elsif($proto eq "pop3") { 2521 $port = ($ipvnum==6) ? $POP36PORT : $POP3PORT; 2522 } 2523 elsif($proto eq "imap") { 2524 $port = ($ipvnum==6) ? $IMAP6PORT : $IMAPPORT; 2525 } 2526 elsif($proto eq "smtp") { 2527 $port = ($ipvnum==6) ? $SMTP6PORT : $SMTPPORT; 2528 } 2529 else { 2530 print STDERR "Unsupported protocol $proto!!\n"; 2531 return 0; 2532 } 2533 2534 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port); 2535} 2536 2537####################################################################### 2538# Single shot rtsp server responsiveness test. This should only be 2539# used to verify that a server present in %run hash is still functional 2540# 2541sub responsive_rtsp_server { 2542 my ($verbose, $ipv6) = @_; 2543 my $port = $RTSPPORT; 2544 my $ip = $HOSTIP; 2545 my $proto = 'rtsp'; 2546 my $ipvnum = 4; 2547 my $idnum = 1; 2548 2549 if($ipv6) { 2550 # if IPv6, use a different setup 2551 $ipvnum = 6; 2552 $port = $RTSP6PORT; 2553 $ip = $HOST6IP; 2554 } 2555 2556 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port); 2557} 2558 2559####################################################################### 2560# Single shot tftp server responsiveness test. This should only be 2561# used to verify that a server present in %run hash is still functional 2562# 2563sub responsive_tftp_server { 2564 my ($id, $verbose, $ipv6) = @_; 2565 my $port = $TFTPPORT; 2566 my $ip = $HOSTIP; 2567 my $proto = 'tftp'; 2568 my $ipvnum = 4; 2569 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1; 2570 2571 if($ipv6) { 2572 # if IPv6, use a different setup 2573 $ipvnum = 6; 2574 $port = $TFTP6PORT; 2575 $ip = $HOST6IP; 2576 } 2577 2578 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port); 2579} 2580 2581####################################################################### 2582# Single shot non-stunnel HTTP TLS extensions capable server 2583# responsiveness test. This should only be used to verify that a 2584# server present in %run hash is still functional 2585# 2586sub responsive_httptls_server { 2587 my ($verbose, $ipv6) = @_; 2588 my $proto = "httptls"; 2589 my $port = ($ipv6 && ($ipv6 =~ /6$/)) ? $HTTPTLS6PORT : $HTTPTLSPORT; 2590 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP"; 2591 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4; 2592 my $idnum = 1; 2593 2594 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port); 2595} 2596 2597####################################################################### 2598# Remove all files in the specified directory 2599# 2600sub cleardir { 2601 my $dir = $_[0]; 2602 my $count; 2603 my $file; 2604 2605 # Get all files 2606 opendir(DIR, $dir) || 2607 return 0; # can't open dir 2608 while($file = readdir(DIR)) { 2609 if($file !~ /^\./) { 2610 unlink("$dir/$file"); 2611 $count++; 2612 } 2613 } 2614 closedir DIR; 2615 return $count; 2616} 2617 2618####################################################################### 2619# compare test results with the expected output, we might filter off 2620# some pattern that is allowed to differ, output test results 2621# 2622sub compare { 2623 my ($testnum, $testname, $subject, $firstref, $secondref)=@_; 2624 2625 my $result = compareparts($firstref, $secondref); 2626 2627 if($result) { 2628 # timestamp test result verification end 2629 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats); 2630 2631 if(!$short) { 2632 logmsg "\n $testnum: $subject FAILED:\n"; 2633 logmsg showdiff($LOGDIR, $firstref, $secondref); 2634 } 2635 elsif(!$automakestyle) { 2636 logmsg "FAILED\n"; 2637 } 2638 else { 2639 # automakestyle 2640 logmsg "FAIL: $testnum - $testname - $subject\n"; 2641 } 2642 } 2643 return $result; 2644} 2645 2646####################################################################### 2647# display information about curl and the host the test suite runs on 2648# 2649sub checksystem { 2650 2651 unlink($memdump); # remove this if there was one left 2652 2653 my $feat; 2654 my $curl; 2655 my $libcurl; 2656 my $versretval; 2657 my $versnoexec; 2658 my @version=(); 2659 2660 my $curlverout="$LOGDIR/curlverout.log"; 2661 my $curlvererr="$LOGDIR/curlvererr.log"; 2662 my $versioncmd="$CURL --version 1>$curlverout 2>$curlvererr"; 2663 2664 unlink($curlverout); 2665 unlink($curlvererr); 2666 2667 $versretval = runclient($versioncmd); 2668 $versnoexec = $!; 2669 2670 open(VERSOUT, "<$curlverout"); 2671 @version = <VERSOUT>; 2672 close(VERSOUT); 2673 2674 $resolver="stock"; 2675 for(@version) { 2676 chomp; 2677 2678 if($_ =~ /^curl/) { 2679 $curl = $_; 2680 $curl =~ s/^(.*)(libcurl.*)/$1/g; 2681 2682 $libcurl = $2; 2683 if($curl =~ /linux|bsd|solaris/) { 2684 $has_ldpreload = 1; 2685 } 2686 if($curl =~ /win32|Windows|mingw(32|64)/) { 2687 # This is a Windows MinGW build or native build, we need to use 2688 # Win32-style path. 2689 $pwd = pathhelp::sys_native_current_path(); 2690 } 2691 if ($libcurl =~ /(winssl|schannel)/i) { 2692 $has_winssl=1; 2693 $has_sslpinning=1; 2694 } 2695 elsif ($libcurl =~ /openssl/i) { 2696 $has_openssl=1; 2697 $has_sslpinning=1; 2698 } 2699 elsif ($libcurl =~ /gnutls/i) { 2700 $has_gnutls=1; 2701 $has_sslpinning=1; 2702 } 2703 elsif ($libcurl =~ /nss/i) { 2704 $has_nss=1; 2705 $has_sslpinning=1; 2706 } 2707 elsif ($libcurl =~ /(yassl|wolfssl)/i) { 2708 $has_yassl=1; 2709 $has_sslpinning=1; 2710 } 2711 elsif ($libcurl =~ /polarssl/i) { 2712 $has_polarssl=1; 2713 $has_sslpinning=1; 2714 } 2715 elsif ($libcurl =~ /securetransport/i) { 2716 $has_darwinssl=1; 2717 $has_sslpinning=1; 2718 } 2719 elsif ($libcurl =~ /BoringSSL/i) { 2720 $has_boringssl=1; 2721 $has_sslpinning=1; 2722 } 2723 elsif ($libcurl =~ /libressl/i) { 2724 $has_libressl=1; 2725 $has_sslpinning=1; 2726 } 2727 elsif ($libcurl =~ /mbedTLS/i) { 2728 $has_mbedtls=1; 2729 $has_sslpinning=1; 2730 } 2731 if ($libcurl =~ /ares/i) { 2732 $has_cares=1; 2733 $resolver="c-ares"; 2734 } 2735 if ($libcurl =~ /mesalink/i) { 2736 $has_mesalink=1; 2737 } 2738 } 2739 elsif($_ =~ /^Protocols: (.*)/i) { 2740 # these are the protocols compiled in to this libcurl 2741 @protocols = split(' ', lc($1)); 2742 2743 # Generate a "proto-ipv6" version of each protocol to match the 2744 # IPv6 <server> name and a "proto-unix" to match the variant which 2745 # uses Unix domain sockets. This works even if support isn't 2746 # compiled in because the <features> test will fail. 2747 push @protocols, map(("$_-ipv6", "$_-unix"), @protocols); 2748 2749 # 'http-proxy' is used in test cases to do CONNECT through 2750 push @protocols, 'http-proxy'; 2751 2752 # 'none' is used in test cases to mean no server 2753 push @protocols, 'none'; 2754 } 2755 elsif($_ =~ /^Features: (.*)/i) { 2756 $feat = $1; 2757 if($feat =~ /TrackMemory/i) { 2758 # built with memory tracking support (--enable-curldebug) 2759 $has_memory_tracking = 1; 2760 } 2761 if($feat =~ /debug/i) { 2762 # curl was built with --enable-debug 2763 $debug_build = 1; 2764 } 2765 if($feat =~ /SSL/i) { 2766 # ssl enabled 2767 $has_ssl=1; 2768 } 2769 if($feat =~ /MultiSSL/i) { 2770 # multiple ssl backends available. 2771 $has_multissl=1; 2772 } 2773 if($feat =~ /Largefile/i) { 2774 # large file support 2775 $has_largefile=1; 2776 } 2777 if($feat =~ /IDN/i) { 2778 # IDN support 2779 $has_idn=1; 2780 } 2781 if($feat =~ /IPv6/i) { 2782 $has_ipv6 = 1; 2783 } 2784 if($feat =~ /UnixSockets/i) { 2785 $has_unix = 1; 2786 } 2787 if($feat =~ /libz/i) { 2788 $has_libz = 1; 2789 } 2790 if($feat =~ /brotli/i) { 2791 $has_brotli = 1; 2792 } 2793 if($feat =~ /NTLM/i) { 2794 # NTLM enabled 2795 $has_ntlm=1; 2796 2797 # Use this as a proxy for any cryptographic authentication 2798 $has_crypto=1; 2799 } 2800 if($feat =~ /NTLM_WB/i) { 2801 # NTLM delegation to winbind daemon ntlm_auth helper enabled 2802 $has_ntlm_wb=1; 2803 } 2804 if($feat =~ /SSPI/i) { 2805 # SSPI enabled 2806 $has_sspi=1; 2807 } 2808 if($feat =~ /GSS-API/i) { 2809 # GSS-API enabled 2810 $has_gssapi=1; 2811 } 2812 if($feat =~ /Kerberos/i) { 2813 # Kerberos enabled 2814 $has_kerberos=1; 2815 2816 # Use this as a proxy for any cryptographic authentication 2817 $has_crypto=1; 2818 } 2819 if($feat =~ /SPNEGO/i) { 2820 # SPNEGO enabled 2821 $has_spnego=1; 2822 2823 # Use this as a proxy for any cryptographic authentication 2824 $has_crypto=1; 2825 } 2826 if($feat =~ /CharConv/i) { 2827 # CharConv enabled 2828 $has_charconv=1; 2829 } 2830 if($feat =~ /TLS-SRP/i) { 2831 # TLS-SRP enabled 2832 $has_tls_srp=1; 2833 } 2834 if($feat =~ /Metalink/i) { 2835 # Metalink enabled 2836 $has_metalink=1; 2837 } 2838 if($feat =~ /PSL/i) { 2839 # PSL enabled 2840 $has_psl=1; 2841 } 2842 if($feat =~ /alt-svc/i) { 2843 # alt-svc enabled 2844 $has_altsvc=1; 2845 } 2846 if($feat =~ /AsynchDNS/i) { 2847 if(!$has_cares) { 2848 # this means threaded resolver 2849 $has_threadedres=1; 2850 $resolver="threaded"; 2851 } 2852 } 2853 if($feat =~ /HTTP2/) { 2854 # http2 enabled 2855 $has_http2=1; 2856 2857 push @protocols, 'http/2'; 2858 } 2859 } 2860 # 2861 # Test harness currently uses a non-stunnel server in order to 2862 # run HTTP TLS-SRP tests required when curl is built with https 2863 # protocol support and TLS-SRP feature enabled. For convenience 2864 # 'httptls' may be included in the test harness protocols array 2865 # to differentiate this from classic stunnel based 'https' test 2866 # harness server. 2867 # 2868 if($has_tls_srp) { 2869 my $add_httptls; 2870 for(@protocols) { 2871 if($_ =~ /^https(-ipv6|)$/) { 2872 $add_httptls=1; 2873 last; 2874 } 2875 } 2876 if($add_httptls && (! grep /^httptls$/, @protocols)) { 2877 push @protocols, 'httptls'; 2878 push @protocols, 'httptls-ipv6'; 2879 } 2880 } 2881 } 2882 if(!$curl) { 2883 logmsg "unable to get curl's version, further details are:\n"; 2884 logmsg "issued command: \n"; 2885 logmsg "$versioncmd \n"; 2886 if ($versretval == -1) { 2887 logmsg "command failed with: \n"; 2888 logmsg "$versnoexec \n"; 2889 } 2890 elsif ($versretval & 127) { 2891 logmsg sprintf("command died with signal %d, and %s coredump.\n", 2892 ($versretval & 127), ($versretval & 128)?"a":"no"); 2893 } 2894 else { 2895 logmsg sprintf("command exited with value %d \n", $versretval >> 8); 2896 } 2897 logmsg "contents of $curlverout: \n"; 2898 displaylogcontent("$curlverout"); 2899 logmsg "contents of $curlvererr: \n"; 2900 displaylogcontent("$curlvererr"); 2901 die "couldn't get curl's version"; 2902 } 2903 2904 if(-r "../lib/curl_config.h") { 2905 open(CONF, "<../lib/curl_config.h"); 2906 while(<CONF>) { 2907 if($_ =~ /^\#define HAVE_GETRLIMIT/) { 2908 $has_getrlimit = 1; 2909 } 2910 } 2911 close(CONF); 2912 } 2913 2914 if($has_ipv6) { 2915 # client has IPv6 support 2916 2917 # check if the HTTP server has it! 2918 my @sws = `server/sws --version`; 2919 if($sws[0] =~ /IPv6/) { 2920 # HTTP server has IPv6 support! 2921 $http_ipv6 = 1; 2922 $gopher_ipv6 = 1; 2923 } 2924 2925 # check if the FTP server has it! 2926 @sws = `server/sockfilt --version`; 2927 if($sws[0] =~ /IPv6/) { 2928 # FTP server has IPv6 support! 2929 $ftp_ipv6 = 1; 2930 } 2931 } 2932 2933 if($has_unix) { 2934 # client has Unix sockets support, check whether the HTTP server has it 2935 my @sws = `server/sws --version`; 2936 $http_unix = 1 if($sws[0] =~ /unix/); 2937 } 2938 2939 if(!$has_memory_tracking && $torture) { 2940 die "can't run torture tests since curl was built without ". 2941 "TrackMemory feature (--enable-curldebug)"; 2942 } 2943 2944 open(M, "$CURL -M 2>&1|"); 2945 while(my $s = <M>) { 2946 if($s =~ /built-in manual was disabled at build-time/) { 2947 $has_manual = 0; 2948 last; 2949 } 2950 $has_manual = 1; 2951 last; 2952 } 2953 close(M); 2954 2955 $has_shared = `sh $CURLCONFIG --built-shared`; 2956 chomp $has_shared; 2957 2958 my $hostname=join(' ', runclientoutput("hostname")); 2959 my $hosttype=join(' ', runclientoutput("uname -a")); 2960 2961 logmsg ("********* System characteristics ******** \n", 2962 "* $curl\n", 2963 "* $libcurl\n", 2964 "* Features: $feat\n", 2965 "* Host: $hostname", 2966 "* System: $hosttype"); 2967 2968 if($has_memory_tracking && $has_threadedres) { 2969 $has_memory_tracking = 0; 2970 logmsg("*\n", 2971 "*** DISABLES memory tracking when using threaded resolver\n", 2972 "*\n"); 2973 } 2974 2975 logmsg sprintf("* Servers: %s", $stunnel?"SSL ":""); 2976 logmsg sprintf("%s", $http_ipv6?"HTTP-IPv6 ":""); 2977 logmsg sprintf("%s", $http_unix?"HTTP-unix ":""); 2978 logmsg sprintf("%s\n", $ftp_ipv6?"FTP-IPv6 ":""); 2979 2980 logmsg sprintf("* Env: %s%s", $valgrind?"Valgrind ":"", 2981 $run_event_based?"event-based ":""); 2982 logmsg sprintf("%s\n", $libtool?"Libtool ":""); 2983 2984 if($verbose) { 2985 logmsg "* Ports:\n"; 2986 2987 logmsg sprintf("* HTTP/%d ", $HTTPPORT); 2988 logmsg sprintf("FTP/%d ", $FTPPORT); 2989 logmsg sprintf("FTP2/%d ", $FTP2PORT); 2990 logmsg sprintf("RTSP/%d ", $RTSPPORT); 2991 if($stunnel) { 2992 logmsg sprintf("FTPS/%d ", $FTPSPORT); 2993 logmsg sprintf("HTTPS/%d ", $HTTPSPORT); 2994 } 2995 logmsg sprintf("\n* TFTP/%d ", $TFTPPORT); 2996 if($http_ipv6) { 2997 logmsg sprintf("HTTP-IPv6/%d ", $HTTP6PORT); 2998 logmsg sprintf("RTSP-IPv6/%d ", $RTSP6PORT); 2999 } 3000 if($ftp_ipv6) { 3001 logmsg sprintf("FTP-IPv6/%d ", $FTP6PORT); 3002 } 3003 if($tftp_ipv6) { 3004 logmsg sprintf("TFTP-IPv6/%d ", $TFTP6PORT); 3005 } 3006 logmsg sprintf("\n* GOPHER/%d ", $GOPHERPORT); 3007 if($gopher_ipv6) { 3008 logmsg sprintf("GOPHER-IPv6/%d", $GOPHER6PORT); 3009 } 3010 logmsg sprintf("\n* SSH/%d ", $SSHPORT); 3011 logmsg sprintf("SOCKS/%d ", $SOCKSPORT); 3012 logmsg sprintf("POP3/%d ", $POP3PORT); 3013 logmsg sprintf("IMAP/%d ", $IMAPPORT); 3014 logmsg sprintf("SMTP/%d\n", $SMTPPORT); 3015 if($ftp_ipv6) { 3016 logmsg sprintf("* POP3-IPv6/%d ", $POP36PORT); 3017 logmsg sprintf("IMAP-IPv6/%d ", $IMAP6PORT); 3018 logmsg sprintf("SMTP-IPv6/%d\n", $SMTP6PORT); 3019 } 3020 if($httptlssrv) { 3021 logmsg sprintf("* HTTPTLS/%d ", $HTTPTLSPORT); 3022 if($has_ipv6) { 3023 logmsg sprintf("HTTPTLS-IPv6/%d ", $HTTPTLS6PORT); 3024 } 3025 logmsg "\n"; 3026 } 3027 3028 if($has_unix) { 3029 logmsg "* Unix socket paths:\n"; 3030 if($http_unix) { 3031 logmsg sprintf("* HTTP-Unix:%s\n", $HTTPUNIXPATH); 3032 } 3033 } 3034 } 3035 $has_textaware = ($^O eq 'MSWin32') || ($^O eq 'msys'); 3036 3037 logmsg "***************************************** \n"; 3038} 3039 3040####################################################################### 3041# substitute the variable stuff into either a joined up file or 3042# a command, in either case passed by reference 3043# 3044sub subVariables { 3045 my ($thing) = @_; 3046 3047 # ports 3048 3049 $$thing =~ s/%FTP6PORT/$FTP6PORT/g; 3050 $$thing =~ s/%FTP2PORT/$FTP2PORT/g; 3051 $$thing =~ s/%FTPSPORT/$FTPSPORT/g; 3052 $$thing =~ s/%FTPPORT/$FTPPORT/g; 3053 3054 $$thing =~ s/%GOPHER6PORT/$GOPHER6PORT/g; 3055 $$thing =~ s/%GOPHERPORT/$GOPHERPORT/g; 3056 3057 $$thing =~ s/%HTTPTLS6PORT/$HTTPTLS6PORT/g; 3058 $$thing =~ s/%HTTPTLSPORT/$HTTPTLSPORT/g; 3059 $$thing =~ s/%HTTP6PORT/$HTTP6PORT/g; 3060 $$thing =~ s/%HTTPSPORT/$HTTPSPORT/g; 3061 $$thing =~ s/%HTTP2PORT/$HTTP2PORT/g; 3062 $$thing =~ s/%HTTPPORT/$HTTPPORT/g; 3063 $$thing =~ s/%PROXYPORT/$HTTPPROXYPORT/g; 3064 3065 $$thing =~ s/%IMAP6PORT/$IMAP6PORT/g; 3066 $$thing =~ s/%IMAPPORT/$IMAPPORT/g; 3067 3068 $$thing =~ s/%POP36PORT/$POP36PORT/g; 3069 $$thing =~ s/%POP3PORT/$POP3PORT/g; 3070 3071 $$thing =~ s/%RTSP6PORT/$RTSP6PORT/g; 3072 $$thing =~ s/%RTSPPORT/$RTSPPORT/g; 3073 3074 $$thing =~ s/%SMTP6PORT/$SMTP6PORT/g; 3075 $$thing =~ s/%SMTPPORT/$SMTPPORT/g; 3076 3077 $$thing =~ s/%SOCKSPORT/$SOCKSPORT/g; 3078 $$thing =~ s/%SSHPORT/$SSHPORT/g; 3079 3080 $$thing =~ s/%TFTP6PORT/$TFTP6PORT/g; 3081 $$thing =~ s/%TFTPPORT/$TFTPPORT/g; 3082 3083 $$thing =~ s/%DICTPORT/$DICTPORT/g; 3084 3085 $$thing =~ s/%SMBPORT/$SMBPORT/g; 3086 $$thing =~ s/%SMBSPORT/$SMBSPORT/g; 3087 3088 $$thing =~ s/%NEGTELNETPORT/$NEGTELNETPORT/g; 3089 3090 # server Unix domain socket paths 3091 3092 $$thing =~ s/%HTTPUNIXPATH/$HTTPUNIXPATH/g; 3093 3094 # client IP addresses 3095 3096 $$thing =~ s/%CLIENT6IP/$CLIENT6IP/g; 3097 $$thing =~ s/%CLIENTIP/$CLIENTIP/g; 3098 3099 # server IP addresses 3100 3101 $$thing =~ s/%HOST6IP/$HOST6IP/g; 3102 $$thing =~ s/%HOSTIP/$HOSTIP/g; 3103 3104 # misc 3105 3106 $$thing =~ s/%CURL/$CURL/g; 3107 $$thing =~ s/%PWD/$pwd/g; 3108 $$thing =~ s/%POSIX_PWD/$posix_pwd/g; 3109 3110 my $file_pwd = $pwd; 3111 if($file_pwd !~ /^\//) { 3112 $file_pwd = "/$file_pwd"; 3113 } 3114 3115 $$thing =~ s/%FILE_PWD/$file_pwd/g; 3116 $$thing =~ s/%SRCDIR/$srcdir/g; 3117 $$thing =~ s/%USER/$USER/g; 3118 3119 # The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be 3120 # used for time-out tests and that whould work on most hosts as these 3121 # adjust for the startup/check time for this particular host. We needed 3122 # to do this to make the test suite run better on very slow hosts. 3123 3124 my $ftp2 = $ftpchecktime * 2; 3125 my $ftp3 = $ftpchecktime * 3; 3126 3127 $$thing =~ s/%FTPTIME2/$ftp2/g; 3128 $$thing =~ s/%FTPTIME3/$ftp3/g; 3129 3130 # HTTP2 3131 3132 $$thing =~ s/%H2CVER/$h2cver/g; 3133} 3134 3135sub fixarray { 3136 my @in = @_; 3137 3138 for(@in) { 3139 subVariables(\$_); 3140 } 3141 return @in; 3142} 3143 3144####################################################################### 3145# Provide time stamps for single test skipped events 3146# 3147sub timestampskippedevents { 3148 my $testnum = $_[0]; 3149 3150 return if((not defined($testnum)) || ($testnum < 1)); 3151 3152 if($timestats) { 3153 3154 if($timevrfyend{$testnum}) { 3155 return; 3156 } 3157 elsif($timesrvrlog{$testnum}) { 3158 $timevrfyend{$testnum} = $timesrvrlog{$testnum}; 3159 return; 3160 } 3161 elsif($timetoolend{$testnum}) { 3162 $timevrfyend{$testnum} = $timetoolend{$testnum}; 3163 $timesrvrlog{$testnum} = $timetoolend{$testnum}; 3164 } 3165 elsif($timetoolini{$testnum}) { 3166 $timevrfyend{$testnum} = $timetoolini{$testnum}; 3167 $timesrvrlog{$testnum} = $timetoolini{$testnum}; 3168 $timetoolend{$testnum} = $timetoolini{$testnum}; 3169 } 3170 elsif($timesrvrend{$testnum}) { 3171 $timevrfyend{$testnum} = $timesrvrend{$testnum}; 3172 $timesrvrlog{$testnum} = $timesrvrend{$testnum}; 3173 $timetoolend{$testnum} = $timesrvrend{$testnum}; 3174 $timetoolini{$testnum} = $timesrvrend{$testnum}; 3175 } 3176 elsif($timesrvrini{$testnum}) { 3177 $timevrfyend{$testnum} = $timesrvrini{$testnum}; 3178 $timesrvrlog{$testnum} = $timesrvrini{$testnum}; 3179 $timetoolend{$testnum} = $timesrvrini{$testnum}; 3180 $timetoolini{$testnum} = $timesrvrini{$testnum}; 3181 $timesrvrend{$testnum} = $timesrvrini{$testnum}; 3182 } 3183 elsif($timeprepini{$testnum}) { 3184 $timevrfyend{$testnum} = $timeprepini{$testnum}; 3185 $timesrvrlog{$testnum} = $timeprepini{$testnum}; 3186 $timetoolend{$testnum} = $timeprepini{$testnum}; 3187 $timetoolini{$testnum} = $timeprepini{$testnum}; 3188 $timesrvrend{$testnum} = $timeprepini{$testnum}; 3189 $timesrvrini{$testnum} = $timeprepini{$testnum}; 3190 } 3191 } 3192} 3193 3194####################################################################### 3195# Run a single specified test case 3196# 3197sub singletest { 3198 my ($evbased, # 1 means switch on if possible (and "curl" is tested) 3199 # returns "not a test" if it can't be used for this test 3200 $testnum, 3201 $count, 3202 $total)=@_; 3203 3204 my @what; 3205 my $why; 3206 my %feature; 3207 my $cmd; 3208 my $disablevalgrind; 3209 3210 # copy test number to a global scope var, this allows 3211 # testnum checking when starting test harness servers. 3212 $testnumcheck = $testnum; 3213 3214 # timestamp test preparation start 3215 $timeprepini{$testnum} = Time::HiRes::time() if($timestats); 3216 3217 if($disttests !~ /test$testnum\W/ ) { 3218 logmsg "Warning: test$testnum not present in tests/data/Makefile.inc\n"; 3219 } 3220 if($disabled{$testnum}) { 3221 logmsg "Warning: test$testnum is explicitly disabled\n"; 3222 } 3223 3224 # load the test case file definition 3225 if(loadtest("${TESTDIR}/test${testnum}")) { 3226 if($verbose) { 3227 # this is not a test 3228 logmsg "RUN: $testnum doesn't look like a test case\n"; 3229 } 3230 $why = "no test"; 3231 } 3232 else { 3233 @what = getpart("client", "features"); 3234 } 3235 3236 # We require a feature to be present 3237 for(@what) { 3238 my $f = $_; 3239 $f =~ s/\s//g; 3240 3241 if($f =~ /^([^!].*)$/) { 3242 # Store the feature for later 3243 $feature{$1} = $1; 3244 3245 if($1 eq "SSL") { 3246 if($has_ssl) { 3247 next; 3248 } 3249 } 3250 elsif($1 eq "MultiSSL") { 3251 if($has_multissl) { 3252 next; 3253 } 3254 } 3255 elsif($1 eq "SSLpinning") { 3256 if($has_sslpinning) { 3257 next; 3258 } 3259 } 3260 elsif($1 eq "OpenSSL") { 3261 if($has_openssl) { 3262 next; 3263 } 3264 } 3265 elsif($1 eq "GnuTLS") { 3266 if($has_gnutls) { 3267 next; 3268 } 3269 } 3270 elsif($1 eq "NSS") { 3271 if($has_nss) { 3272 next; 3273 } 3274 } 3275 elsif(($1 eq "WinSSL") || ($1 eq "Schannel")) { 3276 if($has_winssl) { 3277 next; 3278 } 3279 } 3280 elsif($1 eq "DarwinSSL") { 3281 if($has_darwinssl) { 3282 next; 3283 } 3284 } 3285 elsif($1 eq "ld_preload") { 3286 if($has_ldpreload && !$debug_build) { 3287 next; 3288 } 3289 } 3290 elsif($1 eq "unittest") { 3291 if($debug_build) { 3292 next; 3293 } 3294 } 3295 elsif($1 eq "debug") { 3296 if($debug_build) { 3297 next; 3298 } 3299 } 3300 elsif($1 eq "TrackMemory") { 3301 if($has_memory_tracking) { 3302 next; 3303 } 3304 } 3305 elsif($1 eq "large_file") { 3306 if($has_largefile) { 3307 next; 3308 } 3309 } 3310 elsif($1 eq "idn") { 3311 if($has_idn) { 3312 next; 3313 } 3314 } 3315 elsif($1 eq "ipv6") { 3316 if($has_ipv6) { 3317 next; 3318 } 3319 } 3320 elsif($1 eq "libz") { 3321 if($has_libz) { 3322 next; 3323 } 3324 } 3325 elsif($1 eq "brotli") { 3326 if($has_brotli) { 3327 next; 3328 } 3329 } 3330 elsif($1 eq "NTLM") { 3331 if($has_ntlm) { 3332 next; 3333 } 3334 } 3335 elsif($1 eq "NTLM_WB") { 3336 if($has_ntlm_wb) { 3337 next; 3338 } 3339 } 3340 elsif($1 eq "SSPI") { 3341 if($has_sspi) { 3342 next; 3343 } 3344 } 3345 elsif($1 eq "GSS-API") { 3346 if($has_gssapi) { 3347 next; 3348 } 3349 } 3350 elsif($1 eq "Kerberos") { 3351 if($has_kerberos) { 3352 next; 3353 } 3354 } 3355 elsif($1 eq "SPNEGO") { 3356 if($has_spnego) { 3357 next; 3358 } 3359 } 3360 elsif($1 eq "getrlimit") { 3361 if($has_getrlimit) { 3362 next; 3363 } 3364 } 3365 elsif($1 eq "crypto") { 3366 if($has_crypto) { 3367 next; 3368 } 3369 } 3370 elsif($1 eq "TLS-SRP") { 3371 if($has_tls_srp) { 3372 next; 3373 } 3374 } 3375 elsif($1 eq "Metalink") { 3376 if($has_metalink) { 3377 next; 3378 } 3379 } 3380 elsif($1 eq "http/2") { 3381 if($has_http2) { 3382 next; 3383 } 3384 } 3385 elsif($1 eq "threaded-resolver") { 3386 if($has_threadedres) { 3387 next; 3388 } 3389 } 3390 elsif($1 eq "PSL") { 3391 if($has_psl) { 3392 next; 3393 } 3394 } 3395 elsif($1 eq "alt-svc") { 3396 if($has_altsvc) { 3397 next; 3398 } 3399 } 3400 elsif($1 eq "manual") { 3401 if($has_manual) { 3402 next; 3403 } 3404 } 3405 elsif($1 eq "socks") { 3406 next; 3407 } 3408 elsif($1 eq "unix-sockets") { 3409 next if $has_unix; 3410 } 3411 # See if this "feature" is in the list of supported protocols 3412 elsif (grep /^\Q$1\E$/i, @protocols) { 3413 next; 3414 } 3415 3416 $why = "curl lacks $1 support"; 3417 last; 3418 } 3419 } 3420 3421 # We require a feature to not be present 3422 if(!$why) { 3423 for(@what) { 3424 my $f = $_; 3425 $f =~ s/\s//g; 3426 3427 if($f =~ /^!(.*)$/) { 3428 if($1 eq "SSL") { 3429 if(!$has_ssl) { 3430 next; 3431 } 3432 } 3433 elsif($1 eq "MultiSSL") { 3434 if(!$has_multissl) { 3435 next; 3436 } 3437 } 3438 elsif($1 eq "OpenSSL") { 3439 if(!$has_openssl) { 3440 next; 3441 } 3442 } 3443 elsif($1 eq "GnuTLS") { 3444 if(!$has_gnutls) { 3445 next; 3446 } 3447 } 3448 elsif($1 eq "NSS") { 3449 if(!$has_nss) { 3450 next; 3451 } 3452 } 3453 elsif(($1 eq "WinSSL") || ($1 eq "Schannel")) { 3454 if(!$has_winssl) { 3455 next; 3456 } 3457 } 3458 elsif($1 eq "DarwinSSL") { 3459 if(!$has_darwinssl) { 3460 next; 3461 } 3462 } 3463 elsif($1 eq "TrackMemory") { 3464 if(!$has_memory_tracking) { 3465 next; 3466 } 3467 } 3468 elsif($1 eq "large_file") { 3469 if(!$has_largefile) { 3470 next; 3471 } 3472 } 3473 elsif($1 eq "idn") { 3474 if(!$has_idn) { 3475 next; 3476 } 3477 } 3478 elsif($1 eq "ipv6") { 3479 if(!$has_ipv6) { 3480 next; 3481 } 3482 } 3483 elsif($1 eq "unix-sockets") { 3484 next if !$has_unix; 3485 } 3486 elsif($1 eq "libz") { 3487 if(!$has_libz) { 3488 next; 3489 } 3490 } 3491 elsif($1 eq "brotli") { 3492 if(!$has_brotli) { 3493 next; 3494 } 3495 } 3496 elsif($1 eq "NTLM") { 3497 if(!$has_ntlm) { 3498 next; 3499 } 3500 } 3501 elsif($1 eq "NTLM_WB") { 3502 if(!$has_ntlm_wb) { 3503 next; 3504 } 3505 } 3506 elsif($1 eq "SSPI") { 3507 if(!$has_sspi) { 3508 next; 3509 } 3510 } 3511 elsif($1 eq "GSS-API") { 3512 if(!$has_gssapi) { 3513 next; 3514 } 3515 } 3516 elsif($1 eq "Kerberos") { 3517 if(!$has_kerberos) { 3518 next; 3519 } 3520 } 3521 elsif($1 eq "SPNEGO") { 3522 if(!$has_spnego) { 3523 next; 3524 } 3525 } 3526 elsif($1 eq "getrlimit") { 3527 if(!$has_getrlimit) { 3528 next; 3529 } 3530 } 3531 elsif($1 eq "crypto") { 3532 if(!$has_crypto) { 3533 next; 3534 } 3535 } 3536 elsif($1 eq "TLS-SRP") { 3537 if(!$has_tls_srp) { 3538 next; 3539 } 3540 } 3541 elsif($1 eq "Metalink") { 3542 if(!$has_metalink) { 3543 next; 3544 } 3545 } 3546 elsif($1 eq "PSL") { 3547 if(!$has_psl) { 3548 next; 3549 } 3550 } 3551 elsif($1 eq "threaded-resolver") { 3552 if(!$has_threadedres) { 3553 next; 3554 } 3555 } 3556 else { 3557 next; 3558 } 3559 } 3560 else { 3561 next; 3562 } 3563 3564 $why = "curl has $1 support"; 3565 last; 3566 } 3567 } 3568 3569 if(!$why) { 3570 my @keywords = getpart("info", "keywords"); 3571 my $match; 3572 my $k; 3573 3574 if(!$keywords[0]) { 3575 $why = "missing the <keywords> section!"; 3576 } 3577 3578 for $k (@keywords) { 3579 chomp $k; 3580 if ($disabled_keywords{lc($k)}) { 3581 $why = "disabled by keyword"; 3582 } elsif ($enabled_keywords{lc($k)}) { 3583 $match = 1; 3584 } 3585 } 3586 3587 if(!$why && !$match && %enabled_keywords) { 3588 $why = "disabled by missing keyword"; 3589 } 3590 } 3591 3592 # test definition may instruct to (un)set environment vars 3593 # this is done this early, so that the precheck can use environment 3594 # variables and still bail out fine on errors 3595 3596 # restore environment variables that were modified in a previous run 3597 foreach my $var (keys %oldenv) { 3598 if($oldenv{$var} eq 'notset') { 3599 delete $ENV{$var} if($ENV{$var}); 3600 } 3601 else { 3602 $ENV{$var} = $oldenv{$var}; 3603 } 3604 delete $oldenv{$var}; 3605 } 3606 3607 # remove test server commands file before servers are started/verified 3608 unlink($FTPDCMD) if(-f $FTPDCMD); 3609 3610 # timestamp required servers verification start 3611 $timesrvrini{$testnum} = Time::HiRes::time() if($timestats); 3612 3613 if(!$why) { 3614 $why = serverfortest($testnum); 3615 } 3616 3617 # timestamp required servers verification end 3618 $timesrvrend{$testnum} = Time::HiRes::time() if($timestats); 3619 3620 my @setenv = getpart("client", "setenv"); 3621 if(@setenv) { 3622 foreach my $s (@setenv) { 3623 chomp $s; 3624 subVariables(\$s); 3625 if($s =~ /([^=]*)=(.*)/) { 3626 my ($var, $content) = ($1, $2); 3627 # remember current setting, to restore it once test runs 3628 $oldenv{$var} = ($ENV{$var})?"$ENV{$var}":'notset'; 3629 # set new value 3630 if(!$content) { 3631 delete $ENV{$var} if($ENV{$var}); 3632 } 3633 else { 3634 if($var =~ /^LD_PRELOAD/) { 3635 if(exe_ext() && (exe_ext() eq '.exe')) { 3636 # print "Skipping LD_PRELOAD due to lack of OS support\n"; 3637 next; 3638 } 3639 if($debug_build || ($has_shared ne "yes")) { 3640 # print "Skipping LD_PRELOAD due to no release shared build\n"; 3641 next; 3642 } 3643 } 3644 $ENV{$var} = "$content"; 3645 } 3646 } 3647 } 3648 } 3649 3650 if(!$why) { 3651 my @precheck = getpart("client", "precheck"); 3652 if(@precheck) { 3653 $cmd = $precheck[0]; 3654 chomp $cmd; 3655 subVariables \$cmd; 3656 if($cmd) { 3657 my @p = split(/ /, $cmd); 3658 if($p[0] !~ /\//) { 3659 # the first word, the command, does not contain a slash so 3660 # we will scan the "improved" PATH to find the command to 3661 # be able to run it 3662 my $fullp = checktestcmd($p[0]); 3663 3664 if($fullp) { 3665 $p[0] = $fullp; 3666 } 3667 $cmd = join(" ", @p); 3668 } 3669 3670 my @o = `$cmd 2>/dev/null`; 3671 if($o[0]) { 3672 $why = $o[0]; 3673 chomp $why; 3674 } elsif($?) { 3675 $why = "precheck command error"; 3676 } 3677 logmsg "prechecked $cmd\n" if($verbose); 3678 } 3679 } 3680 } 3681 3682 if($why && !$listonly) { 3683 # there's a problem, count it as "skipped" 3684 $skipped++; 3685 $skipped{$why}++; 3686 $teststat[$testnum]=$why; # store reason for this test case 3687 3688 if(!$short) { 3689 if($skipped{$why} <= 3) { 3690 # show only the first three skips for each reason 3691 logmsg sprintf("test %04d SKIPPED: $why\n", $testnum); 3692 } 3693 } 3694 3695 timestampskippedevents($testnum); 3696 return -1; 3697 } 3698 logmsg sprintf("test %04d...", $testnum) if(!$automakestyle); 3699 3700 my %replyattr = getpartattr("reply", "data"); 3701 my @reply; 3702 if (partexists("reply", "datacheck")) { 3703 for my $partsuffix (('', '1', '2', '3', '4')) { 3704 my @replycheckpart = getpart("reply", "datacheck".$partsuffix); 3705 if(@replycheckpart) { 3706 my %replycheckpartattr = getpartattr("reply", "datacheck".$partsuffix); 3707 # get the mode attribute 3708 my $filemode=$replycheckpartattr{'mode'}; 3709 if($filemode && ($filemode eq "text") && $has_textaware) { 3710 # text mode when running on windows: fix line endings 3711 map s/\r\n/\n/g, @replycheckpart; 3712 map s/\n/\r\n/g, @replycheckpart; 3713 } 3714 if($replycheckpartattr{'nonewline'}) { 3715 # Yes, we must cut off the final newline from the final line 3716 # of the datacheck 3717 chomp($replycheckpart[$#replycheckpart]); 3718 } 3719 push(@reply, @replycheckpart); 3720 } 3721 } 3722 } 3723 else { 3724 # check against the data section 3725 @reply = getpart("reply", "data"); 3726 # get the mode attribute 3727 my $filemode=$replyattr{'mode'}; 3728 if($filemode && ($filemode eq "text") && $has_textaware) { 3729 # text mode when running on windows: fix line endings 3730 map s/\r\n/\n/g, @reply; 3731 map s/\n/\r\n/g, @reply; 3732 } 3733 } 3734 3735 # this is the valid protocol blurb curl should generate 3736 my @protocol= fixarray ( getpart("verify", "protocol") ); 3737 3738 # this is the valid protocol blurb curl should generate to a proxy 3739 my @proxyprot = fixarray ( getpart("verify", "proxy") ); 3740 3741 # redirected stdout/stderr to these files 3742 $STDOUT="$LOGDIR/stdout$testnum"; 3743 $STDERR="$LOGDIR/stderr$testnum"; 3744 3745 # if this section exists, we verify that the stdout contained this: 3746 my @validstdout = fixarray ( getpart("verify", "stdout") ); 3747 my @validstderr = fixarray ( getpart("verify", "stderr") ); 3748 3749 # if this section exists, we verify upload 3750 my @upload = getpart("verify", "upload"); 3751 if(@upload) { 3752 my %hash = getpartattr("verify", "upload"); 3753 if($hash{'nonewline'}) { 3754 # cut off the final newline from the final line of the upload data 3755 chomp($upload[$#upload]); 3756 } 3757 } 3758 3759 # if this section exists, it might be FTP server instructions: 3760 my @ftpservercmd = getpart("reply", "servercmd"); 3761 3762 my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout 3763 3764 # name of the test 3765 my @testname= getpart("client", "name"); 3766 my $testname = $testname[0]; 3767 $testname =~ s/\n//g; 3768 logmsg "[$testname]\n" if(!$short); 3769 3770 if($listonly) { 3771 timestampskippedevents($testnum); 3772 return 0; # look successful 3773 } 3774 3775 my @codepieces = getpart("client", "tool"); 3776 3777 my $tool=""; 3778 if(@codepieces) { 3779 $tool = $codepieces[0]; 3780 chomp $tool; 3781 } 3782 3783 # remove server output logfile 3784 unlink($SERVERIN); 3785 unlink($SERVER2IN); 3786 unlink($PROXYIN); 3787 3788 if(@ftpservercmd) { 3789 # write the instructions to file 3790 writearray($FTPDCMD, \@ftpservercmd); 3791 } 3792 3793 # get the command line options to use 3794 my @blaha; 3795 ($cmd, @blaha)= getpart("client", "command"); 3796 3797 if($cmd) { 3798 # make some nice replace operations 3799 $cmd =~ s/\n//g; # no newlines please 3800 # substitute variables in the command line 3801 subVariables \$cmd; 3802 } 3803 else { 3804 # there was no command given, use something silly 3805 $cmd="-"; 3806 } 3807 if($has_memory_tracking) { 3808 unlink($memdump); 3809 } 3810 3811 # create (possibly-empty) files before starting the test 3812 for my $partsuffix (('', '1', '2', '3', '4')) { 3813 my @inputfile=getpart("client", "file".$partsuffix); 3814 my %fileattr = getpartattr("client", "file".$partsuffix); 3815 my $filename=$fileattr{'name'}; 3816 if(@inputfile || $filename) { 3817 if(!$filename) { 3818 logmsg "ERROR: section client=>file has no name attribute\n"; 3819 timestampskippedevents($testnum); 3820 return -1; 3821 } 3822 my $fileContent = join('', @inputfile); 3823 subVariables \$fileContent; 3824# logmsg "DEBUG: writing file " . $filename . "\n"; 3825 open(OUTFILE, ">$filename"); 3826 binmode OUTFILE; # for crapage systems, use binary 3827 print OUTFILE $fileContent; 3828 close(OUTFILE); 3829 } 3830 } 3831 3832 my %cmdhash = getpartattr("client", "command"); 3833 3834 my $out=""; 3835 3836 if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-output/)) { 3837 #We may slap on --output! 3838 if (!@validstdout || 3839 ($cmdhash{'option'} && $cmdhash{'option'} =~ /force-output/)) { 3840 $out=" --output $CURLOUT "; 3841 } 3842 } 3843 3844 my $serverlogslocktimeout = $defserverlogslocktimeout; 3845 if($cmdhash{'timeout'}) { 3846 # test is allowed to override default server logs lock timeout 3847 if($cmdhash{'timeout'} =~ /(\d+)/) { 3848 $serverlogslocktimeout = $1 if($1 >= 0); 3849 } 3850 } 3851 3852 my $postcommanddelay = $defpostcommanddelay; 3853 if($cmdhash{'delay'}) { 3854 # test is allowed to specify a delay after command is executed 3855 if($cmdhash{'delay'} =~ /(\d+)/) { 3856 $postcommanddelay = $1 if($1 > 0); 3857 } 3858 } 3859 3860 my $CMDLINE; 3861 my $cmdargs; 3862 my $cmdtype = $cmdhash{'type'} || "default"; 3863 my $fail_due_event_based = $evbased; 3864 if($cmdtype eq "perl") { 3865 # run the command line prepended with "perl" 3866 $cmdargs ="$cmd"; 3867 $CMDLINE = "$perl "; 3868 $tool=$CMDLINE; 3869 $disablevalgrind=1; 3870 } 3871 elsif($cmdtype eq "shell") { 3872 # run the command line prepended with "/bin/sh" 3873 $cmdargs ="$cmd"; 3874 $CMDLINE = "/bin/sh "; 3875 $tool=$CMDLINE; 3876 $disablevalgrind=1; 3877 } 3878 elsif(!$tool) { 3879 # run curl, add suitable command line options 3880 my $inc=""; 3881 if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-include/)) { 3882 $inc = " --include"; 3883 } 3884 3885 $cmdargs = "$out$inc "; 3886 $cmdargs .= "--trace-ascii log/trace$testnum "; 3887 $cmdargs .= "--trace-time "; 3888 if($evbased) { 3889 $cmdargs .= "--test-event "; 3890 $fail_due_event_based--; 3891 } 3892 $cmdargs .= $cmd; 3893 } 3894 else { 3895 $cmdargs = " $cmd"; # $cmd is the command line for the test file 3896 $CURLOUT = $STDOUT; # sends received data to stdout 3897 3898 if($tool =~ /^lib/) { 3899 $CMDLINE="$LIBDIR/$tool"; 3900 } 3901 elsif($tool =~ /^unit/) { 3902 $CMDLINE="$UNITDIR/$tool"; 3903 } 3904 3905 if(! -f $CMDLINE) { 3906 logmsg "The tool set in the test case for this: '$tool' does not exist\n"; 3907 timestampskippedevents($testnum); 3908 return -1; 3909 } 3910 $DBGCURL=$CMDLINE; 3911 } 3912 3913 if($gdbthis) { 3914 # gdb is incompatible with valgrind, so disable it when debugging 3915 # Perhaps a better approach would be to run it under valgrind anyway 3916 # with --db-attach=yes or --vgdb=yes. 3917 $disablevalgrind=1; 3918 } 3919 3920 if($fail_due_event_based) { 3921 logmsg "This test cannot run event based\n"; 3922 return -1; 3923 } 3924 3925 my @stdintest = getpart("client", "stdin"); 3926 3927 if(@stdintest) { 3928 my $stdinfile="$LOGDIR/stdin-for-$testnum"; 3929 3930 my %hash = getpartattr("client", "stdin"); 3931 if($hash{'nonewline'}) { 3932 # cut off the final newline from the final line of the stdin data 3933 chomp($stdintest[$#stdintest]); 3934 } 3935 3936 writearray($stdinfile, \@stdintest); 3937 3938 $cmdargs .= " <$stdinfile"; 3939 } 3940 3941 if(!$tool) { 3942 $CMDLINE="$CURL"; 3943 } 3944 3945 my $usevalgrind; 3946 if($valgrind && !$disablevalgrind) { 3947 my @valgrindoption = getpart("verify", "valgrind"); 3948 if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) { 3949 $usevalgrind = 1; 3950 my $valgrindcmd = "$valgrind "; 3951 $valgrindcmd .= "$valgrind_tool " if($valgrind_tool); 3952 $valgrindcmd .= "--quiet --leak-check=yes "; 3953 $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp "; 3954 # $valgrindcmd .= "--gen-suppressions=all "; 3955 $valgrindcmd .= "--num-callers=16 "; 3956 $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum"; 3957 $CMDLINE = "$valgrindcmd $CMDLINE"; 3958 } 3959 } 3960 3961 $CMDLINE .= "$cmdargs >$STDOUT 2>$STDERR"; 3962 3963 if($verbose) { 3964 logmsg "$CMDLINE\n"; 3965 } 3966 3967 print CMDLOG "$CMDLINE\n"; 3968 3969 unlink("core"); 3970 3971 my $dumped_core; 3972 my $cmdres; 3973 3974 if($gdbthis) { 3975 my $gdbinit = "$TESTDIR/gdbinit$testnum"; 3976 open(GDBCMD, ">$LOGDIR/gdbcmd"); 3977 print GDBCMD "set args $cmdargs\n"; 3978 print GDBCMD "show args\n"; 3979 print GDBCMD "source $gdbinit\n" if -e $gdbinit; 3980 close(GDBCMD); 3981 } 3982 3983 # timestamp starting of test command 3984 $timetoolini{$testnum} = Time::HiRes::time() if($timestats); 3985 3986 # run the command line we built 3987 if ($torture) { 3988 $cmdres = torture($CMDLINE, 3989 $testnum, 3990 "$gdb --directory libtest $DBGCURL -x $LOGDIR/gdbcmd"); 3991 } 3992 elsif($gdbthis) { 3993 my $GDBW = ($gdbxwin) ? "-w" : ""; 3994 runclient("$gdb --directory libtest $DBGCURL $GDBW -x $LOGDIR/gdbcmd"); 3995 $cmdres=0; # makes it always continue after a debugged run 3996 } 3997 else { 3998 $cmdres = runclient("$CMDLINE"); 3999 my $signal_num = $cmdres & 127; 4000 $dumped_core = $cmdres & 128; 4001 4002 if(!$anyway && ($signal_num || $dumped_core)) { 4003 $cmdres = 1000; 4004 } 4005 else { 4006 $cmdres >>= 8; 4007 $cmdres = (2000 + $signal_num) if($signal_num && !$cmdres); 4008 } 4009 } 4010 4011 # timestamp finishing of test command 4012 $timetoolend{$testnum} = Time::HiRes::time() if($timestats); 4013 4014 if(!$dumped_core) { 4015 if(-r "core") { 4016 # there's core file present now! 4017 $dumped_core = 1; 4018 } 4019 } 4020 4021 if($dumped_core) { 4022 logmsg "core dumped\n"; 4023 if(0 && $gdb) { 4024 logmsg "running gdb for post-mortem analysis:\n"; 4025 open(GDBCMD, ">$LOGDIR/gdbcmd2"); 4026 print GDBCMD "bt\n"; 4027 close(GDBCMD); 4028 runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch $DBGCURL core "); 4029 # unlink("$LOGDIR/gdbcmd2"); 4030 } 4031 } 4032 4033 # If a server logs advisor read lock file exists, it is an indication 4034 # that the server has not yet finished writing out all its log files, 4035 # including server request log files used for protocol verification. 4036 # So, if the lock file exists the script waits here a certain amount 4037 # of time until the server removes it, or the given time expires. 4038 4039 if($serverlogslocktimeout) { 4040 my $lockretry = $serverlogslocktimeout * 20; 4041 while((-f $SERVERLOGS_LOCK) && $lockretry--) { 4042 select(undef, undef, undef, 0.05); 4043 } 4044 if(($lockretry < 0) && 4045 ($serverlogslocktimeout >= $defserverlogslocktimeout)) { 4046 logmsg "Warning: server logs lock timeout ", 4047 "($serverlogslocktimeout seconds) expired\n"; 4048 } 4049 } 4050 4051 # Test harness ssh server does not have this synchronization mechanism, 4052 # this implies that some ssh server based tests might need a small delay 4053 # once that the client command has run to avoid false test failures. 4054 # 4055 # gnutls-serv also lacks this synchronization mechanism, so gnutls-serv 4056 # based tests might need a small delay once that the client command has 4057 # run to avoid false test failures. 4058 4059 sleep($postcommanddelay) if($postcommanddelay); 4060 4061 # timestamp removal of server logs advisor read lock 4062 $timesrvrlog{$testnum} = Time::HiRes::time() if($timestats); 4063 4064 # test definition might instruct to stop some servers 4065 # stop also all servers relative to the given one 4066 4067 my @killtestservers = getpart("client", "killserver"); 4068 if(@killtestservers) { 4069 # 4070 # All servers relative to the given one must be stopped also 4071 # 4072 my @killservers; 4073 foreach my $server (@killtestservers) { 4074 chomp $server; 4075 if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) { 4076 # given a stunnel ssl server, also kill non-ssl underlying one 4077 push @killservers, "${1}${2}"; 4078 } 4079 elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|-unix|))$/) { 4080 # given a non-ssl server, also kill stunnel piggybacking one 4081 push @killservers, "${1}s${2}"; 4082 } 4083 elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) { 4084 # given a socks server, also kill ssh underlying one 4085 push @killservers, "ssh${2}"; 4086 } 4087 elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) { 4088 # given a ssh server, also kill socks piggybacking one 4089 push @killservers, "socks${2}"; 4090 } 4091 push @killservers, $server; 4092 } 4093 # 4094 # kill sockfilter processes for pingpong relative servers 4095 # 4096 foreach my $server (@killservers) { 4097 if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) { 4098 my $proto = $1; 4099 my $idnum = ($2 && ($2 > 1)) ? $2 : 1; 4100 my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4; 4101 killsockfilters($proto, $ipvnum, $idnum, $verbose); 4102 } 4103 } 4104 # 4105 # kill server relative pids clearing them in %run hash 4106 # 4107 my $pidlist; 4108 foreach my $server (@killservers) { 4109 if($run{$server}) { 4110 $pidlist .= "$run{$server} "; 4111 $run{$server} = 0; 4112 } 4113 $runcert{$server} = 0 if($runcert{$server}); 4114 } 4115 killpid($verbose, $pidlist); 4116 # 4117 # cleanup server pid files 4118 # 4119 foreach my $server (@killservers) { 4120 my $pidfile = $serverpidfile{$server}; 4121 my $pid = processexists($pidfile); 4122 if($pid > 0) { 4123 logmsg "Warning: $server server unexpectedly alive\n"; 4124 killpid($verbose, $pid); 4125 } 4126 unlink($pidfile) if(-f $pidfile); 4127 } 4128 } 4129 4130 # remove the test server commands file after each test 4131 unlink($FTPDCMD) if(-f $FTPDCMD); 4132 4133 # run the postcheck command 4134 my @postcheck= getpart("client", "postcheck"); 4135 if(@postcheck) { 4136 $cmd = join("", @postcheck); 4137 chomp $cmd; 4138 subVariables \$cmd; 4139 if($cmd) { 4140 logmsg "postcheck $cmd\n" if($verbose); 4141 my $rc = runclient("$cmd"); 4142 # Must run the postcheck command in torture mode in order 4143 # to clean up, but the result can't be relied upon. 4144 if($rc != 0 && !$torture) { 4145 logmsg " postcheck FAILED\n"; 4146 # timestamp test result verification end 4147 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats); 4148 return 1; 4149 } 4150 } 4151 } 4152 4153 # restore environment variables that were modified 4154 if(%oldenv) { 4155 foreach my $var (keys %oldenv) { 4156 if($oldenv{$var} eq 'notset') { 4157 delete $ENV{$var} if($ENV{$var}); 4158 } 4159 else { 4160 $ENV{$var} = "$oldenv{$var}"; 4161 } 4162 } 4163 } 4164 4165 # Skip all the verification on torture tests 4166 if ($torture) { 4167 if(!$cmdres && !$keepoutfiles) { 4168 cleardir($LOGDIR); 4169 } 4170 # timestamp test result verification end 4171 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats); 4172 return $cmdres; 4173 } 4174 4175 my @err = getpart("verify", "errorcode"); 4176 my $errorcode = $err[0] || "0"; 4177 my $ok=""; 4178 my $res; 4179 chomp $errorcode; 4180 if (@validstdout) { 4181 # verify redirected stdout 4182 my @actual = loadarray($STDOUT); 4183 4184 # what parts to cut off from stdout 4185 my @stripfile = getpart("verify", "stripfile"); 4186 4187 foreach my $strip (@stripfile) { 4188 chomp $strip; 4189 my @newgen; 4190 for(@actual) { 4191 eval $strip; 4192 if($_) { 4193 push @newgen, $_; 4194 } 4195 } 4196 # this is to get rid of array entries that vanished (zero 4197 # length) because of replacements 4198 @actual = @newgen; 4199 } 4200 4201 # variable-replace in the stdout we have from the test case file 4202 @validstdout = fixarray(@validstdout); 4203 4204 # get all attributes 4205 my %hash = getpartattr("verify", "stdout"); 4206 4207 # get the mode attribute 4208 my $filemode=$hash{'mode'}; 4209 if($filemode && ($filemode eq "text") && $has_textaware) { 4210 # text mode when running on windows: fix line endings 4211 map s/\r\n/\n/g, @validstdout; 4212 map s/\n/\r\n/g, @validstdout; 4213 } 4214 4215 if($hash{'nonewline'}) { 4216 # Yes, we must cut off the final newline from the final line 4217 # of the protocol data 4218 chomp($validstdout[$#validstdout]); 4219 } 4220 4221 $res = compare($testnum, $testname, "stdout", \@actual, \@validstdout); 4222 if($res) { 4223 return 1; 4224 } 4225 $ok .= "s"; 4226 } 4227 else { 4228 $ok .= "-"; # stdout not checked 4229 } 4230 4231 if (@validstderr) { 4232 # verify redirected stderr 4233 my @actual = loadarray($STDERR); 4234 4235 # what parts to cut off from stderr 4236 my @stripfile = getpart("verify", "stripfile"); 4237 4238 foreach my $strip (@stripfile) { 4239 chomp $strip; 4240 my @newgen; 4241 for(@actual) { 4242 eval $strip; 4243 if($_) { 4244 push @newgen, $_; 4245 } 4246 } 4247 # this is to get rid of array entries that vanished (zero 4248 # length) because of replacements 4249 @actual = @newgen; 4250 } 4251 4252 # variable-replace in the stderr we have from the test case file 4253 @validstderr = fixarray(@validstderr); 4254 4255 # get all attributes 4256 my %hash = getpartattr("verify", "stderr"); 4257 4258 # get the mode attribute 4259 my $filemode=$hash{'mode'}; 4260 if($filemode && ($filemode eq "text") && $has_textaware) { 4261 # text mode when running on windows: fix line endings 4262 map s/\r\n/\n/g, @validstderr; 4263 map s/\n/\r\n/g, @validstderr; 4264 } 4265 4266 if($hash{'nonewline'}) { 4267 # Yes, we must cut off the final newline from the final line 4268 # of the protocol data 4269 chomp($validstderr[$#validstderr]); 4270 } 4271 4272 $res = compare($testnum, $testname, "stderr", \@actual, \@validstderr); 4273 if($res) { 4274 return 1; 4275 } 4276 $ok .= "r"; 4277 } 4278 else { 4279 $ok .= "-"; # stderr not checked 4280 } 4281 4282 if(@protocol) { 4283 # Verify the sent request 4284 my @out = loadarray($SERVERIN); 4285 4286 # what to cut off from the live protocol sent by curl 4287 my @strip = getpart("verify", "strip"); 4288 4289 my @protstrip=@protocol; 4290 4291 # check if there's any attributes on the verify/protocol section 4292 my %hash = getpartattr("verify", "protocol"); 4293 4294 if($hash{'nonewline'}) { 4295 # Yes, we must cut off the final newline from the final line 4296 # of the protocol data 4297 chomp($protstrip[$#protstrip]); 4298 } 4299 4300 for(@strip) { 4301 # strip off all lines that match the patterns from both arrays 4302 chomp $_; 4303 @out = striparray( $_, \@out); 4304 @protstrip= striparray( $_, \@protstrip); 4305 } 4306 4307 # what parts to cut off from the protocol 4308 my @strippart = getpart("verify", "strippart"); 4309 my $strip; 4310 @strippart = fixarray(@strippart); 4311 for $strip (@strippart) { 4312 chomp $strip; 4313 for(@out) { 4314 eval $strip; 4315 } 4316 } 4317 4318 $res = compare($testnum, $testname, "protocol", \@out, \@protstrip); 4319 if($res) { 4320 return 1; 4321 } 4322 4323 $ok .= "p"; 4324 4325 } 4326 else { 4327 $ok .= "-"; # protocol not checked 4328 } 4329 4330 if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) { 4331 # verify the received data 4332 my @out = loadarray($CURLOUT); 4333 $res = compare($testnum, $testname, "data", \@out, \@reply); 4334 if ($res) { 4335 return 1; 4336 } 4337 $ok .= "d"; 4338 } 4339 else { 4340 $ok .= "-"; # data not checked 4341 } 4342 4343 if(@upload) { 4344 # verify uploaded data 4345 my @out = loadarray("$LOGDIR/upload.$testnum"); 4346 4347 # what parts to cut off from the upload 4348 my @strippart = getpart("verify", "strippart"); 4349 my $strip; 4350 for $strip (@strippart) { 4351 chomp $strip; 4352 for(@out) { 4353 eval $strip; 4354 } 4355 } 4356 4357 $res = compare($testnum, $testname, "upload", \@out, \@upload); 4358 if ($res) { 4359 return 1; 4360 } 4361 $ok .= "u"; 4362 } 4363 else { 4364 $ok .= "-"; # upload not checked 4365 } 4366 4367 if(@proxyprot) { 4368 # Verify the sent proxy request 4369 my @out = loadarray($PROXYIN); 4370 4371 # what to cut off from the live protocol sent by curl, we use the 4372 # same rules as for <protocol> 4373 my @strip = getpart("verify", "strip"); 4374 4375 my @protstrip=@proxyprot; 4376 4377 # check if there's any attributes on the verify/protocol section 4378 my %hash = getpartattr("verify", "proxy"); 4379 4380 if($hash{'nonewline'}) { 4381 # Yes, we must cut off the final newline from the final line 4382 # of the protocol data 4383 chomp($protstrip[$#protstrip]); 4384 } 4385 4386 for(@strip) { 4387 # strip off all lines that match the patterns from both arrays 4388 chomp $_; 4389 @out = striparray( $_, \@out); 4390 @protstrip= striparray( $_, \@protstrip); 4391 } 4392 4393 # what parts to cut off from the protocol 4394 my @strippart = getpart("verify", "strippart"); 4395 my $strip; 4396 for $strip (@strippart) { 4397 chomp $strip; 4398 for(@out) { 4399 eval $strip; 4400 } 4401 } 4402 4403 $res = compare($testnum, $testname, "proxy", \@out, \@protstrip); 4404 if($res) { 4405 return 1; 4406 } 4407 4408 $ok .= "P"; 4409 4410 } 4411 else { 4412 $ok .= "-"; # protocol not checked 4413 } 4414 4415 my $outputok; 4416 for my $partsuffix (('', '1', '2', '3', '4')) { 4417 my @outfile=getpart("verify", "file".$partsuffix); 4418 if(@outfile || partexists("verify", "file".$partsuffix) ) { 4419 # we're supposed to verify a dynamically generated file! 4420 my %hash = getpartattr("verify", "file".$partsuffix); 4421 4422 my $filename=$hash{'name'}; 4423 if(!$filename) { 4424 logmsg "ERROR: section verify=>file$partsuffix ". 4425 "has no name attribute\n"; 4426 stopservers($verbose); 4427 # timestamp test result verification end 4428 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats); 4429 return -1; 4430 } 4431 my @generated=loadarray($filename); 4432 4433 # what parts to cut off from the file 4434 my @stripfile = getpart("verify", "stripfile".$partsuffix); 4435 4436 my $filemode=$hash{'mode'}; 4437 if($filemode && ($filemode eq "text") && $has_textaware) { 4438 # text mode when running on windows: fix line endings 4439 map s/\r\n/\n/g, @outfile; 4440 map s/\n/\r\n/g, @outfile; 4441 } 4442 4443 my $strip; 4444 for $strip (@stripfile) { 4445 chomp $strip; 4446 my @newgen; 4447 for(@generated) { 4448 eval $strip; 4449 if($_) { 4450 push @newgen, $_; 4451 } 4452 } 4453 # this is to get rid of array entries that vanished (zero 4454 # length) because of replacements 4455 @generated = @newgen; 4456 } 4457 4458 @outfile = fixarray(@outfile); 4459 4460 $res = compare($testnum, $testname, "output ($filename)", 4461 \@generated, \@outfile); 4462 if($res) { 4463 return 1; 4464 } 4465 4466 $outputok = 1; # output checked 4467 } 4468 } 4469 $ok .= ($outputok) ? "o" : "-"; # output checked or not 4470 4471 # accept multiple comma-separated error codes 4472 my @splerr = split(/ *, */, $errorcode); 4473 my $errok; 4474 foreach my $e (@splerr) { 4475 if($e == $cmdres) { 4476 # a fine error code 4477 $errok = 1; 4478 last; 4479 } 4480 } 4481 4482 if($errok) { 4483 $ok .= "e"; 4484 } 4485 else { 4486 if(!$short) { 4487 logmsg sprintf("\n%s returned $cmdres, when expecting %s\n", 4488 (!$tool)?"curl":$tool, $errorcode); 4489 } 4490 logmsg " exit FAILED\n"; 4491 # timestamp test result verification end 4492 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats); 4493 return 1; 4494 } 4495 4496 if($has_memory_tracking) { 4497 if(! -f $memdump) { 4498 logmsg "\n** ALERT! memory tracking with no output file?\n" 4499 if(!$cmdtype eq "perl"); 4500 } 4501 else { 4502 my @memdata=`$memanalyze $memdump`; 4503 my $leak=0; 4504 for(@memdata) { 4505 if($_ ne "") { 4506 # well it could be other memory problems as well, but 4507 # we call it leak for short here 4508 $leak=1; 4509 } 4510 } 4511 if($leak) { 4512 logmsg "\n** MEMORY FAILURE\n"; 4513 logmsg @memdata; 4514 # timestamp test result verification end 4515 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats); 4516 return 1; 4517 } 4518 else { 4519 $ok .= "m"; 4520 } 4521 } 4522 } 4523 else { 4524 $ok .= "-"; # memory not checked 4525 } 4526 4527 if($valgrind) { 4528 if($usevalgrind) { 4529 unless(opendir(DIR, "$LOGDIR")) { 4530 logmsg "ERROR: unable to read $LOGDIR\n"; 4531 # timestamp test result verification end 4532 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats); 4533 return 1; 4534 } 4535 my @files = readdir(DIR); 4536 closedir(DIR); 4537 my $vgfile; 4538 foreach my $file (@files) { 4539 if($file =~ /^valgrind$testnum(\..*|)$/) { 4540 $vgfile = $file; 4541 last; 4542 } 4543 } 4544 if(!$vgfile) { 4545 logmsg "ERROR: valgrind log file missing for test $testnum\n"; 4546 # timestamp test result verification end 4547 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats); 4548 return 1; 4549 } 4550 my @e = valgrindparse("$LOGDIR/$vgfile"); 4551 if(@e && $e[0]) { 4552 if($automakestyle) { 4553 logmsg "FAIL: $testnum - $testname - valgrind\n"; 4554 } 4555 else { 4556 logmsg " valgrind ERROR "; 4557 logmsg @e; 4558 } 4559 # timestamp test result verification end 4560 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats); 4561 return 1; 4562 } 4563 $ok .= "v"; 4564 } 4565 else { 4566 if(!$short && !$disablevalgrind) { 4567 logmsg " valgrind SKIPPED\n"; 4568 } 4569 $ok .= "-"; # skipped 4570 } 4571 } 4572 else { 4573 $ok .= "-"; # valgrind not checked 4574 } 4575 # add 'E' for event-based 4576 $ok .= $evbased ? "E" : "-"; 4577 4578 logmsg "$ok " if(!$short); 4579 4580 my $sofar= time()-$start; 4581 my $esttotal = $sofar/$count * $total; 4582 my $estleft = $esttotal - $sofar; 4583 my $left=sprintf("remaining: %02d:%02d", 4584 $estleft/60, 4585 $estleft%60); 4586 4587 if(!$automakestyle) { 4588 logmsg sprintf("OK (%-3d out of %-3d, %s)\n", $count, $total, $left); 4589 } 4590 else { 4591 logmsg "PASS: $testnum - $testname\n"; 4592 } 4593 4594 # the test succeeded, remove all log files 4595 if(!$keepoutfiles) { 4596 cleardir($LOGDIR); 4597 } 4598 4599 # timestamp test result verification end 4600 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats); 4601 4602 return 0; 4603} 4604 4605####################################################################### 4606# Stop all running test servers 4607# 4608sub stopservers { 4609 my $verbose = $_[0]; 4610 # 4611 # kill sockfilter processes for all pingpong servers 4612 # 4613 killallsockfilters($verbose); 4614 # 4615 # kill all server pids from %run hash clearing them 4616 # 4617 my $pidlist; 4618 foreach my $server (keys %run) { 4619 if($run{$server}) { 4620 if($verbose) { 4621 my $prev = 0; 4622 my $pids = $run{$server}; 4623 foreach my $pid (split(' ', $pids)) { 4624 if($pid != $prev) { 4625 logmsg sprintf("* kill pid for %s => %d\n", 4626 $server, $pid); 4627 $prev = $pid; 4628 } 4629 } 4630 } 4631 $pidlist .= "$run{$server} "; 4632 $run{$server} = 0; 4633 } 4634 $runcert{$server} = 0 if($runcert{$server}); 4635 } 4636 killpid($verbose, $pidlist); 4637 # 4638 # cleanup all server pid files 4639 # 4640 foreach my $server (keys %serverpidfile) { 4641 my $pidfile = $serverpidfile{$server}; 4642 my $pid = processexists($pidfile); 4643 if($pid > 0) { 4644 logmsg "Warning: $server server unexpectedly alive\n"; 4645 killpid($verbose, $pid); 4646 } 4647 unlink($pidfile) if(-f $pidfile); 4648 } 4649} 4650 4651####################################################################### 4652# startservers() starts all the named servers 4653# 4654# Returns: string with error reason or blank for success 4655# 4656sub startservers { 4657 my @what = @_; 4658 my ($pid, $pid2); 4659 for(@what) { 4660 my (@whatlist) = split(/\s+/,$_); 4661 my $what = lc($whatlist[0]); 4662 $what =~ s/[^a-z0-9\/-]//g; 4663 4664 my $certfile; 4665 if($what =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) { 4666 $certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem'; 4667 } 4668 4669 if(($what eq "pop3") || 4670 ($what eq "ftp") || 4671 ($what eq "imap") || 4672 ($what eq "smtp")) { 4673 if($torture && $run{$what} && 4674 !responsive_pingpong_server($what, "", $verbose)) { 4675 stopserver($what); 4676 } 4677 if(!$run{$what}) { 4678 ($pid, $pid2) = runpingpongserver($what, "", $verbose); 4679 if($pid <= 0) { 4680 return "failed starting ". uc($what) ." server"; 4681 } 4682 printf ("* pid $what => %d %d\n", $pid, $pid2) if($verbose); 4683 $run{$what}="$pid $pid2"; 4684 } 4685 } 4686 elsif($what eq "ftp2") { 4687 if($torture && $run{'ftp2'} && 4688 !responsive_pingpong_server("ftp", "2", $verbose)) { 4689 stopserver('ftp2'); 4690 } 4691 if(!$run{'ftp2'}) { 4692 ($pid, $pid2) = runpingpongserver("ftp", "2", $verbose); 4693 if($pid <= 0) { 4694 return "failed starting FTP2 server"; 4695 } 4696 printf ("* pid ftp2 => %d %d\n", $pid, $pid2) if($verbose); 4697 $run{'ftp2'}="$pid $pid2"; 4698 } 4699 } 4700 elsif($what eq "ftp-ipv6") { 4701 if($torture && $run{'ftp-ipv6'} && 4702 !responsive_pingpong_server("ftp", "", $verbose, "ipv6")) { 4703 stopserver('ftp-ipv6'); 4704 } 4705 if(!$run{'ftp-ipv6'}) { 4706 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose, "ipv6"); 4707 if($pid <= 0) { 4708 return "failed starting FTP-IPv6 server"; 4709 } 4710 logmsg sprintf("* pid ftp-ipv6 => %d %d\n", $pid, 4711 $pid2) if($verbose); 4712 $run{'ftp-ipv6'}="$pid $pid2"; 4713 } 4714 } 4715 elsif($what eq "gopher") { 4716 if($torture && $run{'gopher'} && 4717 !responsive_http_server("gopher", $verbose, 0, $GOPHERPORT)) { 4718 stopserver('gopher'); 4719 } 4720 if(!$run{'gopher'}) { 4721 ($pid, $pid2) = runhttpserver("gopher", $verbose, 0, 4722 $GOPHERPORT); 4723 if($pid <= 0) { 4724 return "failed starting GOPHER server"; 4725 } 4726 logmsg sprintf ("* pid gopher => %d %d\n", $pid, $pid2) 4727 if($verbose); 4728 $run{'gopher'}="$pid $pid2"; 4729 } 4730 } 4731 elsif($what eq "gopher-ipv6") { 4732 if($torture && $run{'gopher-ipv6'} && 4733 !responsive_http_server("gopher", $verbose, "ipv6", 4734 $GOPHER6PORT)) { 4735 stopserver('gopher-ipv6'); 4736 } 4737 if(!$run{'gopher-ipv6'}) { 4738 ($pid, $pid2) = runhttpserver("gopher", $verbose, "ipv6", 4739 $GOPHER6PORT); 4740 if($pid <= 0) { 4741 return "failed starting GOPHER-IPv6 server"; 4742 } 4743 logmsg sprintf("* pid gopher-ipv6 => %d %d\n", $pid, 4744 $pid2) if($verbose); 4745 $run{'gopher-ipv6'}="$pid $pid2"; 4746 } 4747 } 4748 elsif($what eq "http/2") { 4749 if(!$run{'http/2'}) { 4750 ($pid, $pid2) = runhttp2server($verbose, $HTTP2PORT); 4751 if($pid <= 0) { 4752 return "failed starting HTTP/2 server"; 4753 } 4754 logmsg sprintf ("* pid http/2 => %d %d\n", $pid, $pid2) 4755 if($verbose); 4756 $run{'http/2'}="$pid $pid2"; 4757 } 4758 } 4759 elsif($what eq "http") { 4760 if($torture && $run{'http'} && 4761 !responsive_http_server("http", $verbose, 0, $HTTPPORT)) { 4762 stopserver('http'); 4763 } 4764 if(!$run{'http'}) { 4765 ($pid, $pid2) = runhttpserver("http", $verbose, 0, 4766 $HTTPPORT); 4767 if($pid <= 0) { 4768 return "failed starting HTTP server"; 4769 } 4770 logmsg sprintf ("* pid http => %d %d\n", $pid, $pid2) 4771 if($verbose); 4772 $run{'http'}="$pid $pid2"; 4773 } 4774 } 4775 elsif($what eq "http-proxy") { 4776 if($torture && $run{'http-proxy'} && 4777 !responsive_http_server("http", $verbose, "proxy", 4778 $HTTPPROXYPORT)) { 4779 stopserver('http-proxy'); 4780 } 4781 if(!$run{'http-proxy'}) { 4782 ($pid, $pid2) = runhttpserver("http", $verbose, "proxy", 4783 $HTTPPROXYPORT); 4784 if($pid <= 0) { 4785 return "failed starting HTTP-proxy server"; 4786 } 4787 logmsg sprintf ("* pid http-proxy => %d %d\n", $pid, $pid2) 4788 if($verbose); 4789 $run{'http-proxy'}="$pid $pid2"; 4790 } 4791 } 4792 elsif($what eq "http-ipv6") { 4793 if($torture && $run{'http-ipv6'} && 4794 !responsive_http_server("http", $verbose, "ipv6", $HTTP6PORT)) { 4795 stopserver('http-ipv6'); 4796 } 4797 if(!$run{'http-ipv6'}) { 4798 ($pid, $pid2) = runhttpserver("http", $verbose, "ipv6", 4799 $HTTP6PORT); 4800 if($pid <= 0) { 4801 return "failed starting HTTP-IPv6 server"; 4802 } 4803 logmsg sprintf("* pid http-ipv6 => %d %d\n", $pid, $pid2) 4804 if($verbose); 4805 $run{'http-ipv6'}="$pid $pid2"; 4806 } 4807 } 4808 elsif($what eq "rtsp") { 4809 if($torture && $run{'rtsp'} && 4810 !responsive_rtsp_server($verbose)) { 4811 stopserver('rtsp'); 4812 } 4813 if(!$run{'rtsp'}) { 4814 ($pid, $pid2) = runrtspserver($verbose); 4815 if($pid <= 0) { 4816 return "failed starting RTSP server"; 4817 } 4818 printf ("* pid rtsp => %d %d\n", $pid, $pid2) if($verbose); 4819 $run{'rtsp'}="$pid $pid2"; 4820 } 4821 } 4822 elsif($what eq "rtsp-ipv6") { 4823 if($torture && $run{'rtsp-ipv6'} && 4824 !responsive_rtsp_server($verbose, "ipv6")) { 4825 stopserver('rtsp-ipv6'); 4826 } 4827 if(!$run{'rtsp-ipv6'}) { 4828 ($pid, $pid2) = runrtspserver($verbose, "ipv6"); 4829 if($pid <= 0) { 4830 return "failed starting RTSP-IPv6 server"; 4831 } 4832 logmsg sprintf("* pid rtsp-ipv6 => %d %d\n", $pid, $pid2) 4833 if($verbose); 4834 $run{'rtsp-ipv6'}="$pid $pid2"; 4835 } 4836 } 4837 elsif($what eq "ftps") { 4838 if(!$stunnel) { 4839 # we can't run ftps tests without stunnel 4840 return "no stunnel"; 4841 } 4842 if(!$has_ssl) { 4843 # we can't run ftps tests if libcurl is SSL-less 4844 return "curl lacks SSL support"; 4845 } 4846 if($runcert{'ftps'} && ($runcert{'ftps'} ne $certfile)) { 4847 # stop server when running and using a different cert 4848 stopserver('ftps'); 4849 } 4850 if($torture && $run{'ftp'} && 4851 !responsive_pingpong_server("ftp", "", $verbose)) { 4852 stopserver('ftp'); 4853 } 4854 if(!$run{'ftp'}) { 4855 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose); 4856 if($pid <= 0) { 4857 return "failed starting FTP server"; 4858 } 4859 printf ("* pid ftp => %d %d\n", $pid, $pid2) if($verbose); 4860 $run{'ftp'}="$pid $pid2"; 4861 } 4862 if(!$run{'ftps'}) { 4863 ($pid, $pid2) = runftpsserver($verbose, "", $certfile); 4864 if($pid <= 0) { 4865 return "failed starting FTPS server (stunnel)"; 4866 } 4867 logmsg sprintf("* pid ftps => %d %d\n", $pid, $pid2) 4868 if($verbose); 4869 $run{'ftps'}="$pid $pid2"; 4870 } 4871 } 4872 elsif($what eq "file") { 4873 # we support it but have no server! 4874 } 4875 elsif($what eq "https") { 4876 if(!$stunnel) { 4877 # we can't run https tests without stunnel 4878 return "no stunnel"; 4879 } 4880 if(!$has_ssl) { 4881 # we can't run https tests if libcurl is SSL-less 4882 return "curl lacks SSL support"; 4883 } 4884 if($runcert{'https'} && ($runcert{'https'} ne $certfile)) { 4885 # stop server when running and using a different cert 4886 stopserver('https'); 4887 } 4888 if($torture && $run{'http'} && 4889 !responsive_http_server("http", $verbose, 0, $HTTPPORT)) { 4890 stopserver('http'); 4891 } 4892 if(!$run{'http'}) { 4893 ($pid, $pid2) = runhttpserver("http", $verbose, 0, 4894 $HTTPPORT); 4895 if($pid <= 0) { 4896 return "failed starting HTTP server"; 4897 } 4898 printf ("* pid http => %d %d\n", $pid, $pid2) if($verbose); 4899 $run{'http'}="$pid $pid2"; 4900 } 4901 if(!$run{'https'}) { 4902 ($pid, $pid2) = runhttpsserver($verbose, "", $certfile); 4903 if($pid <= 0) { 4904 return "failed starting HTTPS server (stunnel)"; 4905 } 4906 logmsg sprintf("* pid https => %d %d\n", $pid, $pid2) 4907 if($verbose); 4908 $run{'https'}="$pid $pid2"; 4909 } 4910 } 4911 elsif($what eq "httptls") { 4912 if(!$httptlssrv) { 4913 # for now, we can't run http TLS-EXT tests without gnutls-serv 4914 return "no gnutls-serv"; 4915 } 4916 if($torture && $run{'httptls'} && 4917 !responsive_httptls_server($verbose, "IPv4")) { 4918 stopserver('httptls'); 4919 } 4920 if(!$run{'httptls'}) { 4921 ($pid, $pid2) = runhttptlsserver($verbose, "IPv4"); 4922 if($pid <= 0) { 4923 return "failed starting HTTPTLS server (gnutls-serv)"; 4924 } 4925 logmsg sprintf("* pid httptls => %d %d\n", $pid, $pid2) 4926 if($verbose); 4927 $run{'httptls'}="$pid $pid2"; 4928 } 4929 } 4930 elsif($what eq "httptls-ipv6") { 4931 if(!$httptlssrv) { 4932 # for now, we can't run http TLS-EXT tests without gnutls-serv 4933 return "no gnutls-serv"; 4934 } 4935 if($torture && $run{'httptls-ipv6'} && 4936 !responsive_httptls_server($verbose, "ipv6")) { 4937 stopserver('httptls-ipv6'); 4938 } 4939 if(!$run{'httptls-ipv6'}) { 4940 ($pid, $pid2) = runhttptlsserver($verbose, "ipv6"); 4941 if($pid <= 0) { 4942 return "failed starting HTTPTLS-IPv6 server (gnutls-serv)"; 4943 } 4944 logmsg sprintf("* pid httptls-ipv6 => %d %d\n", $pid, $pid2) 4945 if($verbose); 4946 $run{'httptls-ipv6'}="$pid $pid2"; 4947 } 4948 } 4949 elsif($what eq "tftp") { 4950 if($torture && $run{'tftp'} && 4951 !responsive_tftp_server("", $verbose)) { 4952 stopserver('tftp'); 4953 } 4954 if(!$run{'tftp'}) { 4955 ($pid, $pid2) = runtftpserver("", $verbose); 4956 if($pid <= 0) { 4957 return "failed starting TFTP server"; 4958 } 4959 printf ("* pid tftp => %d %d\n", $pid, $pid2) if($verbose); 4960 $run{'tftp'}="$pid $pid2"; 4961 } 4962 } 4963 elsif($what eq "tftp-ipv6") { 4964 if($torture && $run{'tftp-ipv6'} && 4965 !responsive_tftp_server("", $verbose, "ipv6")) { 4966 stopserver('tftp-ipv6'); 4967 } 4968 if(!$run{'tftp-ipv6'}) { 4969 ($pid, $pid2) = runtftpserver("", $verbose, "ipv6"); 4970 if($pid <= 0) { 4971 return "failed starting TFTP-IPv6 server"; 4972 } 4973 printf("* pid tftp-ipv6 => %d %d\n", $pid, $pid2) if($verbose); 4974 $run{'tftp-ipv6'}="$pid $pid2"; 4975 } 4976 } 4977 elsif($what eq "sftp" || $what eq "scp" || $what eq "socks4" || $what eq "socks5" ) { 4978 if(!$run{'ssh'}) { 4979 ($pid, $pid2) = runsshserver("", $verbose); 4980 if($pid <= 0) { 4981 return "failed starting SSH server"; 4982 } 4983 printf ("* pid ssh => %d %d\n", $pid, $pid2) if($verbose); 4984 $run{'ssh'}="$pid $pid2"; 4985 } 4986 if($what eq "socks4" || $what eq "socks5") { 4987 if(!$run{'socks'}) { 4988 ($pid, $pid2) = runsocksserver("", $verbose); 4989 if($pid <= 0) { 4990 return "failed starting socks server"; 4991 } 4992 printf ("* pid socks => %d %d\n", $pid, $pid2) if($verbose); 4993 $run{'socks'}="$pid $pid2"; 4994 } 4995 } 4996 if($what eq "socks5") { 4997 if(!$sshdid) { 4998 # Not an OpenSSH or SunSSH ssh daemon 4999 logmsg "Not OpenSSH or SunSSH; socks5 tests need at least OpenSSH 3.7\n"; 5000 return "failed starting socks5 server"; 5001 } 5002 elsif(($sshdid =~ /OpenSSH/) && ($sshdvernum < 370)) { 5003 # Need OpenSSH 3.7 for socks5 - https://www.openssh.com/txt/release-3.7 5004 logmsg "$sshdverstr insufficient; socks5 tests need at least OpenSSH 3.7\n"; 5005 return "failed starting socks5 server"; 5006 } 5007 elsif(($sshdid =~ /SunSSH/) && ($sshdvernum < 100)) { 5008 # Need SunSSH 1.0 for socks5 5009 logmsg "$sshdverstr insufficient; socks5 tests need at least SunSSH 1.0\n"; 5010 return "failed starting socks5 server"; 5011 } 5012 } 5013 } 5014 elsif($what eq "http-unix") { 5015 if($torture && $run{'http-unix'} && 5016 !responsive_http_server("http", $verbose, "unix", $HTTPUNIXPATH)) { 5017 stopserver('http-unix'); 5018 } 5019 if(!$run{'http-unix'}) { 5020 ($pid, $pid2) = runhttpserver("http", $verbose, "unix", 5021 $HTTPUNIXPATH); 5022 if($pid <= 0) { 5023 return "failed starting HTTP-unix server"; 5024 } 5025 logmsg sprintf("* pid http-unix => %d %d\n", $pid, $pid2) 5026 if($verbose); 5027 $run{'http-unix'}="$pid $pid2"; 5028 } 5029 } 5030 elsif($what eq "dict") { 5031 if(!$run{'dict'}) { 5032 ($pid, $pid2) = rundictserver($verbose, "", $DICTPORT); 5033 if($pid <= 0) { 5034 return "failed starting DICT server"; 5035 } 5036 logmsg sprintf ("* pid DICT => %d %d\n", $pid, $pid2) 5037 if($verbose); 5038 $run{'dict'}="$pid $pid2"; 5039 } 5040 } 5041 elsif($what eq "smb") { 5042 if(!$run{'smb'}) { 5043 ($pid, $pid2) = runsmbserver($verbose, "", $SMBPORT); 5044 if($pid <= 0) { 5045 return "failed starting SMB server"; 5046 } 5047 logmsg sprintf ("* pid SMB => %d %d\n", $pid, $pid2) 5048 if($verbose); 5049 $run{'dict'}="$pid $pid2"; 5050 } 5051 } 5052 elsif($what eq "telnet") { 5053 if(!$run{'telnet'}) { 5054 ($pid, $pid2) = runnegtelnetserver($verbose, 5055 "", 5056 $NEGTELNETPORT); 5057 if($pid <= 0) { 5058 return "failed starting neg TELNET server"; 5059 } 5060 logmsg sprintf ("* pid neg TELNET => %d %d\n", $pid, $pid2) 5061 if($verbose); 5062 $run{'dict'}="$pid $pid2"; 5063 } 5064 } 5065 elsif($what eq "none") { 5066 logmsg "* starts no server\n" if ($verbose); 5067 } 5068 else { 5069 warn "we don't support a server for $what"; 5070 return "no server for $what"; 5071 } 5072 } 5073 return 0; 5074} 5075 5076############################################################################## 5077# This function makes sure the right set of server is running for the 5078# specified test case. This is a useful design when we run single tests as not 5079# all servers need to run then! 5080# 5081# Returns: a string, blank if everything is fine or a reason why it failed 5082# 5083sub serverfortest { 5084 my ($testnum)=@_; 5085 5086 my @what = getpart("client", "server"); 5087 5088 if(!$what[0]) { 5089 warn "Test case $testnum has no server(s) specified"; 5090 return "no server specified"; 5091 } 5092 5093 for(my $i = scalar(@what) - 1; $i >= 0; $i--) { 5094 my $srvrline = $what[$i]; 5095 chomp $srvrline if($srvrline); 5096 if($srvrline =~ /^(\S+)((\s*)(.*))/) { 5097 my $server = "${1}"; 5098 my $lnrest = "${2}"; 5099 my $tlsext; 5100 if($server =~ /^(httptls)(\+)(ext|srp)(\d*)(-ipv6|)$/) { 5101 $server = "${1}${4}${5}"; 5102 $tlsext = uc("TLS-${3}"); 5103 } 5104 if(! grep /^\Q$server\E$/, @protocols) { 5105 if(substr($server,0,5) ne "socks") { 5106 if($tlsext) { 5107 return "curl lacks $tlsext support"; 5108 } 5109 else { 5110 return "curl lacks $server server support"; 5111 } 5112 } 5113 } 5114 $what[$i] = "$server$lnrest" if($tlsext); 5115 } 5116 } 5117 5118 return &startservers(@what); 5119} 5120 5121####################################################################### 5122# runtimestats displays test-suite run time statistics 5123# 5124sub runtimestats { 5125 my $lasttest = $_[0]; 5126 5127 return if(not $timestats); 5128 5129 logmsg "\nTest suite total running time breakdown per task...\n\n"; 5130 5131 my @timesrvr; 5132 my @timeprep; 5133 my @timetool; 5134 my @timelock; 5135 my @timevrfy; 5136 my @timetest; 5137 my $timesrvrtot = 0.0; 5138 my $timepreptot = 0.0; 5139 my $timetooltot = 0.0; 5140 my $timelocktot = 0.0; 5141 my $timevrfytot = 0.0; 5142 my $timetesttot = 0.0; 5143 my $counter; 5144 5145 for my $testnum (1 .. $lasttest) { 5146 if($timesrvrini{$testnum}) { 5147 $timesrvrtot += $timesrvrend{$testnum} - $timesrvrini{$testnum}; 5148 $timepreptot += 5149 (($timetoolini{$testnum} - $timeprepini{$testnum}) - 5150 ($timesrvrend{$testnum} - $timesrvrini{$testnum})); 5151 $timetooltot += $timetoolend{$testnum} - $timetoolini{$testnum}; 5152 $timelocktot += $timesrvrlog{$testnum} - $timetoolend{$testnum}; 5153 $timevrfytot += $timevrfyend{$testnum} - $timesrvrlog{$testnum}; 5154 $timetesttot += $timevrfyend{$testnum} - $timeprepini{$testnum}; 5155 push @timesrvr, sprintf("%06.3f %04d", 5156 $timesrvrend{$testnum} - $timesrvrini{$testnum}, $testnum); 5157 push @timeprep, sprintf("%06.3f %04d", 5158 ($timetoolini{$testnum} - $timeprepini{$testnum}) - 5159 ($timesrvrend{$testnum} - $timesrvrini{$testnum}), $testnum); 5160 push @timetool, sprintf("%06.3f %04d", 5161 $timetoolend{$testnum} - $timetoolini{$testnum}, $testnum); 5162 push @timelock, sprintf("%06.3f %04d", 5163 $timesrvrlog{$testnum} - $timetoolend{$testnum}, $testnum); 5164 push @timevrfy, sprintf("%06.3f %04d", 5165 $timevrfyend{$testnum} - $timesrvrlog{$testnum}, $testnum); 5166 push @timetest, sprintf("%06.3f %04d", 5167 $timevrfyend{$testnum} - $timeprepini{$testnum}, $testnum); 5168 } 5169 } 5170 5171 { 5172 no warnings 'numeric'; 5173 @timesrvr = sort { $b <=> $a } @timesrvr; 5174 @timeprep = sort { $b <=> $a } @timeprep; 5175 @timetool = sort { $b <=> $a } @timetool; 5176 @timelock = sort { $b <=> $a } @timelock; 5177 @timevrfy = sort { $b <=> $a } @timevrfy; 5178 @timetest = sort { $b <=> $a } @timetest; 5179 } 5180 5181 logmsg "Spent ". sprintf("%08.3f ", $timesrvrtot) . 5182 "seconds starting and verifying test harness servers.\n"; 5183 logmsg "Spent ". sprintf("%08.3f ", $timepreptot) . 5184 "seconds reading definitions and doing test preparations.\n"; 5185 logmsg "Spent ". sprintf("%08.3f ", $timetooltot) . 5186 "seconds actually running test tools.\n"; 5187 logmsg "Spent ". sprintf("%08.3f ", $timelocktot) . 5188 "seconds awaiting server logs lock removal.\n"; 5189 logmsg "Spent ". sprintf("%08.3f ", $timevrfytot) . 5190 "seconds verifying test results.\n"; 5191 logmsg "Spent ". sprintf("%08.3f ", $timetesttot) . 5192 "seconds doing all of the above.\n"; 5193 5194 $counter = 25; 5195 logmsg "\nTest server starting and verification time per test ". 5196 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full"); 5197 logmsg "-time- test\n"; 5198 logmsg "------ ----\n"; 5199 foreach my $txt (@timesrvr) { 5200 last if((not $fullstats) && (not $counter--)); 5201 logmsg "$txt\n"; 5202 } 5203 5204 $counter = 10; 5205 logmsg "\nTest definition reading and preparation time per test ". 5206 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full"); 5207 logmsg "-time- test\n"; 5208 logmsg "------ ----\n"; 5209 foreach my $txt (@timeprep) { 5210 last if((not $fullstats) && (not $counter--)); 5211 logmsg "$txt\n"; 5212 } 5213 5214 $counter = 25; 5215 logmsg "\nTest tool execution time per test ". 5216 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full"); 5217 logmsg "-time- test\n"; 5218 logmsg "------ ----\n"; 5219 foreach my $txt (@timetool) { 5220 last if((not $fullstats) && (not $counter--)); 5221 logmsg "$txt\n"; 5222 } 5223 5224 $counter = 15; 5225 logmsg "\nTest server logs lock removal time per test ". 5226 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full"); 5227 logmsg "-time- test\n"; 5228 logmsg "------ ----\n"; 5229 foreach my $txt (@timelock) { 5230 last if((not $fullstats) && (not $counter--)); 5231 logmsg "$txt\n"; 5232 } 5233 5234 $counter = 10; 5235 logmsg "\nTest results verification time per test ". 5236 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full"); 5237 logmsg "-time- test\n"; 5238 logmsg "------ ----\n"; 5239 foreach my $txt (@timevrfy) { 5240 last if((not $fullstats) && (not $counter--)); 5241 logmsg "$txt\n"; 5242 } 5243 5244 $counter = 50; 5245 logmsg "\nTotal time per test ". 5246 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full"); 5247 logmsg "-time- test\n"; 5248 logmsg "------ ----\n"; 5249 foreach my $txt (@timetest) { 5250 last if((not $fullstats) && (not $counter--)); 5251 logmsg "$txt\n"; 5252 } 5253 5254 logmsg "\n"; 5255} 5256 5257# globally disabled tests 5258disabledtests("$TESTDIR/DISABLED"); 5259 5260# locally disabled tests, ignored by git etc 5261disabledtests("$TESTDIR/DISABLED.local"); 5262 5263####################################################################### 5264# Check options to this test program 5265# 5266 5267my $number=0; 5268my $fromnum=-1; 5269my @testthis; 5270while(@ARGV) { 5271 if ($ARGV[0] eq "-v") { 5272 # verbose output 5273 $verbose=1; 5274 } 5275 elsif($ARGV[0] =~ /^-b(.*)/) { 5276 my $portno=$1; 5277 if($portno =~ s/(\d+)$//) { 5278 $base = int $1; 5279 } 5280 } 5281 elsif ($ARGV[0] eq "-c") { 5282 # use this path to curl instead of default 5283 $DBGCURL=$CURL="\"$ARGV[1]\""; 5284 shift @ARGV; 5285 } 5286 elsif ($ARGV[0] eq "-vc") { 5287 # use this path to a curl used to verify servers 5288 5289 # Particularly useful when you introduce a crashing bug somewhere in 5290 # the development version as then it won't be able to run any tests 5291 # since it can't verify the servers! 5292 5293 $VCURL="\"$ARGV[1]\""; 5294 shift @ARGV; 5295 } 5296 elsif ($ARGV[0] eq "-d") { 5297 # have the servers display protocol output 5298 $debugprotocol=1; 5299 } 5300 elsif($ARGV[0] eq "-e") { 5301 # run the tests cases event based if possible 5302 $run_event_based=1; 5303 } 5304 elsif ($ARGV[0] eq "-g") { 5305 # run this test with gdb 5306 $gdbthis=1; 5307 } 5308 elsif ($ARGV[0] eq "-gw") { 5309 # run this test with windowed gdb 5310 $gdbthis=1; 5311 $gdbxwin=1; 5312 } 5313 elsif($ARGV[0] eq "-s") { 5314 # short output 5315 $short=1; 5316 } 5317 elsif($ARGV[0] eq "-am") { 5318 # automake-style output 5319 $short=1; 5320 $automakestyle=1; 5321 } 5322 elsif($ARGV[0] eq "-n") { 5323 # no valgrind 5324 undef $valgrind; 5325 } 5326 elsif ($ARGV[0] eq "-R") { 5327 # execute in scrambled order 5328 $scrambleorder=1; 5329 } 5330 elsif($ARGV[0] =~ /^-t(.*)/) { 5331 # torture 5332 $torture=1; 5333 my $xtra = $1; 5334 5335 if($xtra =~ s/(\d+)$//) { 5336 $tortalloc = $1; 5337 } 5338 } 5339 elsif($ARGV[0] eq "-a") { 5340 # continue anyway, even if a test fail 5341 $anyway=1; 5342 } 5343 elsif($ARGV[0] eq "-p") { 5344 $postmortem=1; 5345 } 5346 elsif($ARGV[0] eq "-l") { 5347 # lists the test case names only 5348 $listonly=1; 5349 } 5350 elsif($ARGV[0] eq "-k") { 5351 # keep stdout and stderr files after tests 5352 $keepoutfiles=1; 5353 } 5354 elsif($ARGV[0] eq "-r") { 5355 # run time statistics needs Time::HiRes 5356 if($Time::HiRes::VERSION) { 5357 keys(%timeprepini) = 1000; 5358 keys(%timesrvrini) = 1000; 5359 keys(%timesrvrend) = 1000; 5360 keys(%timetoolini) = 1000; 5361 keys(%timetoolend) = 1000; 5362 keys(%timesrvrlog) = 1000; 5363 keys(%timevrfyend) = 1000; 5364 $timestats=1; 5365 $fullstats=0; 5366 } 5367 } 5368 elsif($ARGV[0] eq "-rf") { 5369 # run time statistics needs Time::HiRes 5370 if($Time::HiRes::VERSION) { 5371 keys(%timeprepini) = 1000; 5372 keys(%timesrvrini) = 1000; 5373 keys(%timesrvrend) = 1000; 5374 keys(%timetoolini) = 1000; 5375 keys(%timetoolend) = 1000; 5376 keys(%timesrvrlog) = 1000; 5377 keys(%timevrfyend) = 1000; 5378 $timestats=1; 5379 $fullstats=1; 5380 } 5381 } 5382 elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) { 5383 # show help text 5384 print <<EOHELP 5385Usage: runtests.pl [options] [test selection(s)] 5386 -a continue even if a test fails 5387 -bN use base port number N for test servers (default $base) 5388 -c path use this curl executable 5389 -d display server debug info 5390 -e event-based execution 5391 -g run the test case with gdb 5392 -gw run the test case with gdb as a windowed application 5393 -h this help text 5394 -k keep stdout and stderr files present after tests 5395 -l list all test case names/descriptions 5396 -n no valgrind 5397 -p print log file contents when a test fails 5398 -R scrambled order 5399 -r run time statistics 5400 -rf full run time statistics 5401 -s short output 5402 -am automake style output PASS/FAIL: [number] [name] 5403 -t[N] torture (simulate function failures); N means fail Nth function 5404 -v verbose output 5405 -vc path use this curl only to verify the existing servers 5406 [num] like "5 6 9" or " 5 to 22 " to run those tests only 5407 [!num] like "!5 !6 !9" to disable those tests 5408 [keyword] like "IPv6" to select only tests containing the key word 5409 [!keyword] like "!cookies" to disable any tests containing the key word 5410EOHELP 5411 ; 5412 exit; 5413 } 5414 elsif($ARGV[0] =~ /^(\d+)/) { 5415 $number = $1; 5416 if($fromnum >= 0) { 5417 for my $n ($fromnum .. $number) { 5418 if($disabled{$n}) { 5419 # skip disabled test cases 5420 my $why = "configured as DISABLED"; 5421 $skipped++; 5422 $skipped{$why}++; 5423 $teststat[$n]=$why; # store reason for this test case 5424 } 5425 else { 5426 push @testthis, $n; 5427 } 5428 } 5429 $fromnum = -1; 5430 } 5431 else { 5432 push @testthis, $1; 5433 } 5434 } 5435 elsif($ARGV[0] =~ /^to$/i) { 5436 $fromnum = $number+1; 5437 } 5438 elsif($ARGV[0] =~ /^!(\d+)/) { 5439 $fromnum = -1; 5440 $disabled{$1}=$1; 5441 } 5442 elsif($ARGV[0] =~ /^!(.+)/) { 5443 $disabled_keywords{lc($1)}=$1; 5444 } 5445 elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) { 5446 $enabled_keywords{lc($1)}=$1; 5447 } 5448 else { 5449 print "Unknown option: $ARGV[0]\n"; 5450 exit; 5451 } 5452 shift @ARGV; 5453} 5454 5455if(@testthis && ($testthis[0] ne "")) { 5456 $TESTCASES=join(" ", @testthis); 5457} 5458 5459if($valgrind) { 5460 # we have found valgrind on the host, use it 5461 5462 # verify that we can invoke it fine 5463 my $code = runclient("valgrind >/dev/null 2>&1"); 5464 5465 if(($code>>8) != 1) { 5466 #logmsg "Valgrind failure, disable it\n"; 5467 undef $valgrind; 5468 } else { 5469 5470 # since valgrind 2.1.x, '--tool' option is mandatory 5471 # use it, if it is supported by the version installed on the system 5472 runclient("valgrind --help 2>&1 | grep -- --tool > /dev/null 2>&1"); 5473 if (($? >> 8)==0) { 5474 $valgrind_tool="--tool=memcheck"; 5475 } 5476 open(C, "<$CURL"); 5477 my $l = <C>; 5478 if($l =~ /^\#\!/) { 5479 # A shell script. This is typically when built with libtool, 5480 $valgrind="../libtool --mode=execute $valgrind"; 5481 } 5482 close(C); 5483 5484 # valgrind 3 renamed the --logfile option to --log-file!!! 5485 my $ver=join(' ', runclientoutput("valgrind --version")); 5486 # cut off all but digits and dots 5487 $ver =~ s/[^0-9.]//g; 5488 5489 if($ver =~ /^(\d+)/) { 5490 $ver = $1; 5491 if($ver >= 3) { 5492 $valgrind_logfile="--log-file"; 5493 } 5494 } 5495 } 5496} 5497 5498if ($gdbthis) { 5499 # open the executable curl and read the first 4 bytes of it 5500 open(CHECK, "<$CURL"); 5501 my $c; 5502 sysread CHECK, $c, 4; 5503 close(CHECK); 5504 if($c eq "#! /") { 5505 # A shell script. This is typically when built with libtool, 5506 $libtool = 1; 5507 $gdb = "../libtool --mode=execute gdb"; 5508 } 5509} 5510 5511$HTTPPORT = $base++; # HTTP server port 5512$HTTPSPORT = $base++; # HTTPS (stunnel) server port 5513$FTPPORT = $base++; # FTP server port 5514$FTPSPORT = $base++; # FTPS (stunnel) server port 5515$HTTP6PORT = $base++; # HTTP IPv6 server port 5516$FTP2PORT = $base++; # FTP server 2 port 5517$FTP6PORT = $base++; # FTP IPv6 port 5518$TFTPPORT = $base++; # TFTP (UDP) port 5519$TFTP6PORT = $base++; # TFTP IPv6 (UDP) port 5520$SSHPORT = $base++; # SSH (SCP/SFTP) port 5521$SOCKSPORT = $base++; # SOCKS port 5522$POP3PORT = $base++; # POP3 server port 5523$POP36PORT = $base++; # POP3 IPv6 server port 5524$IMAPPORT = $base++; # IMAP server port 5525$IMAP6PORT = $base++; # IMAP IPv6 server port 5526$SMTPPORT = $base++; # SMTP server port 5527$SMTP6PORT = $base++; # SMTP IPv6 server port 5528$RTSPPORT = $base++; # RTSP server port 5529$RTSP6PORT = $base++; # RTSP IPv6 server port 5530$GOPHERPORT = $base++; # Gopher IPv4 server port 5531$GOPHER6PORT = $base++; # Gopher IPv6 server port 5532$HTTPTLSPORT = $base++; # HTTP TLS (non-stunnel) server port 5533$HTTPTLS6PORT = $base++; # HTTP TLS (non-stunnel) IPv6 server port 5534$HTTPPROXYPORT = $base++; # HTTP proxy port, when using CONNECT 5535$HTTP2PORT = $base++; # HTTP/2 port 5536$DICTPORT = $base++; # DICT port 5537$SMBPORT = $base++; # SMB port 5538$SMBSPORT = $base++; # SMBS port 5539$NEGTELNETPORT = $base++; # TELNET port with negotiation 5540$HTTPUNIXPATH = 'http.sock'; # HTTP server Unix domain socket path 5541 5542####################################################################### 5543# clear and create logging directory: 5544# 5545 5546cleardir($LOGDIR); 5547mkdir($LOGDIR, 0777); 5548 5549####################################################################### 5550# initialize some variables 5551# 5552 5553get_disttests(); 5554init_serverpidfile_hash(); 5555 5556####################################################################### 5557# Output curl version and host info being tested 5558# 5559 5560if(!$listonly) { 5561 checksystem(); 5562} 5563 5564####################################################################### 5565# Fetch all disabled tests, if there are any 5566# 5567 5568sub disabledtests { 5569 my ($file) = @_; 5570 5571 if(open(D, "<$file")) { 5572 while(<D>) { 5573 if(/^ *\#/) { 5574 # allow comments 5575 next; 5576 } 5577 if($_ =~ /(\d+)/) { 5578 $disabled{$1}=$1; # disable this test number 5579 } 5580 } 5581 close(D); 5582 } 5583} 5584 5585####################################################################### 5586# If 'all' tests are requested, find out all test numbers 5587# 5588 5589if ( $TESTCASES eq "all") { 5590 # Get all commands and find out their test numbers 5591 opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!"; 5592 my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR); 5593 closedir(DIR); 5594 5595 $TESTCASES=""; # start with no test cases 5596 5597 # cut off everything but the digits 5598 for(@cmds) { 5599 $_ =~ s/[a-z\/\.]*//g; 5600 } 5601 # sort the numbers from low to high 5602 foreach my $n (sort { $a <=> $b } @cmds) { 5603 if($disabled{$n}) { 5604 # skip disabled test cases 5605 my $why = "configured as DISABLED"; 5606 $skipped++; 5607 $skipped{$why}++; 5608 $teststat[$n]=$why; # store reason for this test case 5609 next; 5610 } 5611 $TESTCASES .= " $n"; 5612 } 5613} 5614else { 5615 my $verified=""; 5616 map { 5617 if (-e "$TESTDIR/test$_") { 5618 $verified.="$_ "; 5619 } 5620 } split(" ", $TESTCASES); 5621 if($verified eq "") { 5622 print "No existing test cases were specified\n"; 5623 exit; 5624 } 5625 $TESTCASES = $verified; 5626} 5627 5628if($scrambleorder) { 5629 # scramble the order of the test cases 5630 my @rand; 5631 while($TESTCASES) { 5632 my @all = split(/ +/, $TESTCASES); 5633 if(!$all[0]) { 5634 # if the first is blank, shift away it 5635 shift @all; 5636 } 5637 my $r = rand @all; 5638 push @rand, $all[$r]; 5639 $all[$r]=""; 5640 $TESTCASES = join(" ", @all); 5641 } 5642 $TESTCASES = join(" ", @rand); 5643} 5644 5645####################################################################### 5646# Start the command line log 5647# 5648open(CMDLOG, ">$CURLLOG") || 5649 logmsg "can't log command lines to $CURLLOG\n"; 5650 5651####################################################################### 5652 5653# Display the contents of the given file. Line endings are canonicalized 5654# and excessively long files are elided 5655sub displaylogcontent { 5656 my ($file)=@_; 5657 if(open(SINGLE, "<$file")) { 5658 my $linecount = 0; 5659 my $truncate; 5660 my @tail; 5661 while(my $string = <SINGLE>) { 5662 $string =~ s/\r\n/\n/g; 5663 $string =~ s/[\r\f\032]/\n/g; 5664 $string .= "\n" unless ($string =~ /\n$/); 5665 $string =~ tr/\n//; 5666 for my $line (split("\n", $string)) { 5667 $line =~ s/\s*\!$//; 5668 if ($truncate) { 5669 push @tail, " $line\n"; 5670 } else { 5671 logmsg " $line\n"; 5672 } 5673 $linecount++; 5674 $truncate = $linecount > 1000; 5675 } 5676 } 5677 if(@tail) { 5678 my $tailshow = 200; 5679 my $tailskip = 0; 5680 my $tailtotal = scalar @tail; 5681 if($tailtotal > $tailshow) { 5682 $tailskip = $tailtotal - $tailshow; 5683 logmsg "=== File too long: $tailskip lines omitted here\n"; 5684 } 5685 for($tailskip .. $tailtotal-1) { 5686 logmsg "$tail[$_]"; 5687 } 5688 } 5689 close(SINGLE); 5690 } 5691} 5692 5693sub displaylogs { 5694 my ($testnum)=@_; 5695 opendir(DIR, "$LOGDIR") || 5696 die "can't open dir: $!"; 5697 my @logs = readdir(DIR); 5698 closedir(DIR); 5699 5700 logmsg "== Contents of files in the $LOGDIR/ dir after test $testnum\n"; 5701 foreach my $log (sort @logs) { 5702 if($log =~ /\.(\.|)$/) { 5703 next; # skip "." and ".." 5704 } 5705 if($log =~ /^\.nfs/) { 5706 next; # skip ".nfs" 5707 } 5708 if(($log eq "memdump") || ($log eq "core")) { 5709 next; # skip "memdump" and "core" 5710 } 5711 if((-d "$LOGDIR/$log") || (! -s "$LOGDIR/$log")) { 5712 next; # skip directory and empty files 5713 } 5714 if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) { 5715 next; # skip stdoutNnn of other tests 5716 } 5717 if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) { 5718 next; # skip stderrNnn of other tests 5719 } 5720 if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) { 5721 next; # skip uploadNnn of other tests 5722 } 5723 if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) { 5724 next; # skip curlNnn.out of other tests 5725 } 5726 if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) { 5727 next; # skip testNnn.txt of other tests 5728 } 5729 if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) { 5730 next; # skip fileNnn.txt of other tests 5731 } 5732 if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) { 5733 next; # skip netrcNnn of other tests 5734 } 5735 if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) { 5736 next; # skip traceNnn of other tests 5737 } 5738 if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(\..*|)$/)) { 5739 next; # skip valgrindNnn of other tests 5740 } 5741 logmsg "=== Start of file $log\n"; 5742 displaylogcontent("$LOGDIR/$log"); 5743 logmsg "=== End of file $log\n"; 5744 } 5745} 5746 5747####################################################################### 5748# The main test-loop 5749# 5750 5751my $failed; 5752my $testnum; 5753my $ok=0; 5754my $total=0; 5755my $lasttest=0; 5756my @at = split(" ", $TESTCASES); 5757my $count=0; 5758 5759$start = time(); 5760 5761foreach $testnum (@at) { 5762 5763 $lasttest = $testnum if($testnum > $lasttest); 5764 $count++; 5765 5766 my $error = singletest($run_event_based, $testnum, $count, scalar(@at)); 5767 if($error < 0) { 5768 # not a test we can run 5769 next; 5770 } 5771 5772 $total++; # number of tests we've run 5773 5774 if($error>0) { 5775 $failed.= "$testnum "; 5776 if($postmortem) { 5777 # display all files in log/ in a nice way 5778 displaylogs($testnum); 5779 } 5780 if(!$anyway) { 5781 # a test failed, abort 5782 logmsg "\n - abort tests\n"; 5783 last; 5784 } 5785 } 5786 elsif(!$error) { 5787 $ok++; # successful test counter 5788 } 5789 5790 # loop for next test 5791} 5792 5793my $sofar = time() - $start; 5794 5795####################################################################### 5796# Close command log 5797# 5798close(CMDLOG); 5799 5800# Tests done, stop the servers 5801stopservers($verbose); 5802 5803my $all = $total + $skipped; 5804 5805runtimestats($lasttest); 5806 5807if($total) { 5808 logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n", 5809 $ok/$total*100); 5810 5811 if($ok != $total) { 5812 logmsg "TESTFAIL: These test cases failed: $failed\n"; 5813 } 5814} 5815else { 5816 logmsg "TESTFAIL: No tests were performed\n"; 5817} 5818 5819if($all) { 5820 logmsg "TESTDONE: $all tests were considered during ". 5821 sprintf("%.0f", $sofar) ." seconds.\n"; 5822} 5823 5824if($skipped && !$short) { 5825 my $s=0; 5826 logmsg "TESTINFO: $skipped tests were skipped due to these restraints:\n"; 5827 5828 for(keys %skipped) { 5829 my $r = $_; 5830 printf "TESTINFO: \"%s\" %d times (", $r, $skipped{$_}; 5831 5832 # now show all test case numbers that had this reason for being 5833 # skipped 5834 my $c=0; 5835 my $max = 9; 5836 for(0 .. scalar @teststat) { 5837 my $t = $_; 5838 if($teststat[$_] && ($teststat[$_] eq $r)) { 5839 if($c < $max) { 5840 logmsg ", " if($c); 5841 logmsg $_; 5842 } 5843 $c++; 5844 } 5845 } 5846 if($c > $max) { 5847 logmsg " and ".($c-$max)." more"; 5848 } 5849 logmsg ")\n"; 5850 } 5851} 5852 5853if($total && ($ok != $total)) { 5854 exit 1; 5855} 5856