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