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