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