2 #***************************************************************************
4 # Project ___| | | | _ \| |
6 # | (__| |_| | _ <| |___
7 # \___|\___/|_| \_\_____|
9 # Copyright (C) 1998 - 2017, Daniel Stenberg, <daniel@haxx.se>, et al.
11 # This software is licensed as described in the file COPYING, which
12 # you should have received as part of this distribution. The terms
13 # are also available at https://curl.haxx.se/docs/copyright.html.
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.
19 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
20 # KIND, either express or implied.
22 ###########################################################################
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:
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
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.
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..."
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.
56 # These should be the only variables that might be needed to get edited:
59 push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'});
61 # run time statistics needs Time::HiRes
65 import Time::HiRes qw( time );
73 # Subs imported from serverhelp module
83 # Variables and subs imported from sshhelp module
110 require "getpart.pm"; # array functions
111 require "valgrind.pm"; # valgrind report parser
114 my $HOSTIP="127.0.0.1"; # address on which the test server listens
115 my $HOST6IP="[::1]"; # address on which the test server listens
116 my $CLIENTIP="127.0.0.1"; # address which curl uses for incoming connections
117 my $CLIENT6IP="[::1]"; # address which curl uses for incoming connections
119 my $base = 8990; # base port number
121 my $HTTPPORT; # HTTP server port
122 my $HTTP6PORT; # HTTP IPv6 server port
123 my $HTTPSPORT; # HTTPS (stunnel) server port
124 my $FTPPORT; # FTP server port
125 my $FTP2PORT; # FTP server 2 port
126 my $FTPSPORT; # FTPS (stunnel) server port
127 my $FTP6PORT; # FTP IPv6 server port
129 my $TFTP6PORT; # TFTP
130 my $SSHPORT; # SCP/SFTP
131 my $SOCKSPORT; # SOCKS4/5 port
133 my $POP36PORT; # POP3 IPv6 server port
135 my $IMAP6PORT; # IMAP IPv6 server port
137 my $SMTP6PORT; # SMTP IPv6 server port
139 my $RTSP6PORT; # RTSP IPv6 server port
140 my $GOPHERPORT; # Gopher
141 my $GOPHER6PORT; # Gopher IPv6 server port
142 my $HTTPTLSPORT; # HTTP TLS (non-stunnel) server port
143 my $HTTPTLS6PORT; # HTTP TLS (non-stunnel) IPv6 server port
144 my $HTTPPROXYPORT; # HTTP proxy port, when using CONNECT
145 my $HTTPPIPEPORT; # HTTP pipelining port
146 my $HTTPUNIXPATH; # HTTP server Unix domain socket path
147 my $HTTP2PORT; # HTTP/2 server port
148 my $DICTPORT; # DICT server port
149 my $SMBPORT; # SMB server port
150 my $SMBSPORT; # SMBS server port
151 my $NEGTELNETPORT; # TELNET server port with negotiation
153 my $srcdir = $ENV{'srcdir'} || '.';
154 my $CURL="../src/curl".exe_ext(); # what curl executable to run on the tests
155 my $VCURL=$CURL; # what curl binary to use to verify the servers with
156 # VCURL is handy to set to the system one when the one you
157 # just built hangs or crashes and thus prevent verification
158 my $DBGCURL=$CURL; #"../src/.libs/curl"; # alternative for debugging
160 my $TESTDIR="$srcdir/data";
161 my $LIBDIR="./libtest";
162 my $UNITDIR="./unit";
163 # TODO: change this to use server_inputfilename()
164 my $SERVERIN="$LOGDIR/server.input"; # what curl sent the server
165 my $SERVER2IN="$LOGDIR/server2.input"; # what curl sent the second server
166 my $PROXYIN="$LOGDIR/proxy.input"; # what curl sent the proxy
167 my $CURLLOG="$LOGDIR/curl.log"; # all command lines run
168 my $FTPDCMD="$LOGDIR/ftpserver.cmd"; # copy ftp server instructions here
169 my $SERVERLOGS_LOCK="$LOGDIR/serverlogs.lock"; # server logs advisor read lock
170 my $CURLCONFIG="../curl-config"; # curl-config from current build
172 # Normally, all test cases should be run, but at times it is handy to
173 # simply run a particular one:
176 # To run specific test cases, set them like:
177 # $TESTCASES="1 2 3 7 8";
179 #######################################################################
180 # No variables below this point should need to be modified
183 # invoke perl like this:
184 my $perl="perl -I$srcdir";
185 my $server_response_maxtime=13;
187 my $debug_build=0; # built debug enabled (--enable-debug)
188 my $has_memory_tracking=0; # built with memory tracking (--enable-curldebug)
191 # name of the file that the memory debugging creates:
192 my $memdump="$LOGDIR/memdump";
194 # the path to the script that analyzes the memory debug output file:
195 my $memanalyze="$perl $srcdir/memanalyze.pl";
197 my $pwd = getcwd(); # current working directory
200 my $ftpchecktime=1; # time it took to verify our test FTP server
202 my $stunnel = checkcmd("stunnel4") || checkcmd("tstunnel") || checkcmd("stunnel");
203 my $valgrind = checktestcmd("valgrind");
204 my $valgrind_logfile="--logfile";
206 my $gdb = checktestcmd("gdb");
207 my $httptlssrv = find_httptlssrv();
209 my $has_ssl; # set if libcurl is built with SSL support
210 my $has_largefile; # set if libcurl is built with large file support
211 my $has_idn; # set if libcurl is built with IDN support
212 my $http_ipv6; # set if HTTP server has IPv6 support
213 my $http_unix; # set if HTTP server has Unix sockets support
214 my $ftp_ipv6; # set if FTP server has IPv6 support
215 my $tftp_ipv6; # set if TFTP server has IPv6 support
216 my $gopher_ipv6; # set if Gopher server has IPv6 support
217 my $has_ipv6; # set if libcurl is built with IPv6 support
218 my $has_unix; # set if libcurl is built with Unix sockets support
219 my $has_libz; # set if libcurl is built with libz support
220 my $has_getrlimit; # set if system has getrlimit()
221 my $has_ntlm; # set if libcurl is built with NTLM support
222 my $has_ntlm_wb; # set if libcurl is built with NTLM delegation to winbind
223 my $has_sspi; # set if libcurl is built with Windows SSPI
224 my $has_gssapi; # set if libcurl is built with a GSS-API library
225 my $has_kerberos; # set if libcurl is built with Kerberos support
226 my $has_spnego; # set if libcurl is built with SPNEGO support
227 my $has_charconv; # set if libcurl is built with CharConv support
228 my $has_tls_srp; # set if libcurl is built with TLS-SRP support
229 my $has_metalink; # set if curl is built with Metalink support
230 my $has_http2; # set if libcurl is built with HTTP2 support
231 my $has_crypto; # set if libcurl is built with cryptographic support
232 my $has_cares; # set if built with c-ares
233 my $has_threadedres;# set if built with threaded resolver
234 my $has_psl; # set if libcurl is built with PSL support
235 my $has_ldpreload; # set if curl is built for systems supporting LD_PRELOAD
236 my $has_multissl; # set if curl is build with MultiSSL support
238 # this version is decided by the particular nghttp2 library that is being used
241 my $has_openssl; # built with a lib using an OpenSSL-like API
242 my $has_gnutls; # built with GnuTLS
243 my $has_nss; # built with NSS
244 my $has_yassl; # built with yassl
245 my $has_polarssl; # built with polarssl
246 my $has_axtls; # built with axTLS
247 my $has_winssl; # built with WinSSL (Secure Channel aka Schannel)
248 my $has_darwinssl; # built with DarwinSSL (Secure Transport)
249 my $has_boringssl; # built with BoringSSL
250 my $has_libressl; # built with libressl
251 my $has_mbedtls; # built with mbedTLS
253 my $has_sslpinning; # built with a TLS backend that supports pinning
255 my $has_shared = "unknown"; # built shared
257 my $resolver; # name of the resolver backend (for human presentation)
258 my $ssllib; # name of the SSL library we use (for human presentation)
260 my $has_textaware; # set if running on a system that has a text mode concept
261 # on files. Windows for example
263 my @protocols; # array of lowercase supported protocol servers
265 my $skipped=0; # number of tests skipped; reported in main loop
266 my %skipped; # skipped{reason}=counter, reasons for skip
267 my @teststat; # teststat[testnum]=reason, reasons for skip
268 my %disabled_keywords; # key words of tests to skip
269 my %enabled_keywords; # key words of tests to run
270 my %disabled; # disabled test cases
272 my $sshdid; # for socks server, ssh daemon version id
273 my $sshdvernum; # for socks server, ssh daemon version number
274 my $sshdverstr; # for socks server, ssh daemon version string
275 my $sshderror; # for socks server, ssh daemon version error
277 my $defserverlogslocktimeout = 20; # timeout to await server logs lock removal
278 my $defpostcommanddelay = 0; # delay between command and postcheck sections
280 my $timestats; # time stamping and stats generation
281 my $fullstats; # show time stats for every single test
282 my %timeprepini; # timestamp for each test preparation start
283 my %timesrvrini; # timestamp for each test required servers verification start
284 my %timesrvrend; # timestamp for each test required servers verification end
285 my %timetoolini; # timestamp for each test command run starting
286 my %timetoolend; # timestamp for each test command run stopping
287 my %timesrvrlog; # timestamp for each test server logs lock removal
288 my %timevrfyend; # timestamp for each test result verification end
290 my $testnumcheck; # test number, set in singletest sub.
293 #######################################################################
294 # variables that command line options may set
302 my $gdbthis; # run test case with gdb debugger
303 my $gdbxwin; # use windowed gdb when using gdb
304 my $keepoutfiles; # keep stdout and stderr files after tests
305 my $listonly; # only list the tests
306 my $postmortem; # display detailed info about failed tests
307 my $run_event_based; # run curl with --test-event to test the event API
309 my %run; # running server
310 my %doesntrun; # servers that don't work, identified by pidfile
311 my %serverpidfile;# all server pid file names, identified by server id
312 my %runcert; # cert file currently in use by an ssl running server
314 # torture test variables
319 #######################################################################
320 # logmsg is our general message logging subroutine.
328 # get the name of the current user
329 my $USER = $ENV{USER}; # Linux
331 $USER = $ENV{USERNAME}; # Windows
333 $USER = $ENV{LOGNAME}; # Some Unix (I think)
337 # enable memory debugging if curl is compiled with it
338 $ENV{'CURL_MEMDEBUG'} = $memdump;
339 $ENV{'CURL_ENTROPY'}="12345678";
340 $ENV{'CURL_FORCETIME'}=1; # for debug NTLM magic
345 logmsg "runtests.pl received SIG$signame, exiting\n";
346 stopservers($verbose);
347 die "Somebody sent me a SIG$signame";
349 $SIG{INT} = \&catch_zap;
350 $SIG{TERM} = \&catch_zap;
352 ##########################################################################
353 # Clear all possible '*_proxy' environment variables for various protocols
354 # to prevent them to interfere with our testing!
357 foreach $protocol (('ftp', 'http', 'ftps', 'https', 'no', 'all')) {
358 my $proxy = "${protocol}_proxy";
359 # clear lowercase version
360 delete $ENV{$proxy} if($ENV{$proxy});
361 # clear uppercase version
362 delete $ENV{uc($proxy)} if($ENV{uc($proxy)});
365 # make sure we don't get affected by other variables that control our
368 delete $ENV{'SSL_CERT_DIR'} if($ENV{'SSL_CERT_DIR'});
369 delete $ENV{'SSL_CERT_PATH'} if($ENV{'SSL_CERT_PATH'});
370 delete $ENV{'CURL_CA_BUNDLE'} if($ENV{'CURL_CA_BUNDLE'});
372 #######################################################################
373 # Load serverpidfile hash with pidfile names for all possible servers.
375 sub init_serverpidfile_hash {
376 for my $proto (('ftp', 'http', 'imap', 'pop3', 'smtp', 'http/2')) {
377 for my $ssl (('', 's')) {
378 for my $ipvnum ((4, 6)) {
379 for my $idnum ((1, 2, 3)) {
380 my $serv = servername_id("$proto$ssl", $ipvnum, $idnum);
381 my $pidf = server_pidfilename("$proto$ssl", $ipvnum, $idnum);
382 $serverpidfile{$serv} = $pidf;
387 for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'gopher', 'httptls',
388 'dict', 'smb', 'smbs', 'telnet')) {
389 for my $ipvnum ((4, 6)) {
390 for my $idnum ((1, 2)) {
391 my $serv = servername_id($proto, $ipvnum, $idnum);
392 my $pidf = server_pidfilename($proto, $ipvnum, $idnum);
393 $serverpidfile{$serv} = $pidf;
397 for my $proto (('http', 'imap', 'pop3', 'smtp', 'http/2')) {
398 for my $ssl (('', 's')) {
399 my $serv = servername_id("$proto$ssl", "unix", 1);
400 my $pidf = server_pidfilename("$proto$ssl", "unix", 1);
401 $serverpidfile{$serv} = $pidf;
406 #######################################################################
407 # Check if a given child process has just died. Reaps it if so.
410 use POSIX ":sys_wait_h";
412 if((not defined $pid) || $pid <= 0) {
415 my $rc = waitpid($pid, &WNOHANG);
416 return ($rc == $pid)?1:0;
419 #######################################################################
420 # Start a new thread/process and run the given command line in there.
421 # Return the pids (yes plural) of the new child process to the parent.
424 my ($cmd, $pidfile, $timeout, $fake)=@_;
426 logmsg "startnew: $cmd\n" if ($verbose);
431 if(not defined $child) {
432 logmsg "startnew: fork() failure detected\n";
437 # Here we are the child. Run the given command.
439 # Put an "exec" in front of the command so that the child process
440 # keeps this child's process ID.
441 exec("exec $cmd") || die "Can't exec() $cmd: $!";
443 # exec() should never return back here to this process. We protect
444 # ourselves by calling die() just in case something goes really bad.
445 die "error: exec() has returned";
448 # Ugly hack but ssh client and gnutls-serv don't support pid files
450 if(open(OUT, ">$pidfile")) {
451 print OUT $child . "\n";
453 logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose);
456 logmsg "startnew: failed to write fake $pidfile with pid=$child\n";
458 # could/should do a while connect fails sleep a bit and loop
460 if (checkdied($child)) {
461 logmsg "startnew: child process has failed to start\n" if($verbose);
466 my $count = $timeout;
468 if(-f $pidfile && -s $pidfile && open(PID, "<$pidfile")) {
471 if(($pid2 > 0) && pidexists($pid2)) {
472 # if $pid2 is valid, then make sure this pid is alive, as
473 # otherwise it is just likely to be the _previous_ pidfile or
477 # invalidate $pid2 if not actually alive
480 if (checkdied($child)) {
481 logmsg "startnew: child process has died, server might start up\n"
483 # We can't just abort waiting for the server with a
485 # because the server might have forked and could still start
486 # up normally. Instead, just reduce the amount of time we remain
493 # Return two PIDs, the one for the child process we spawned and the one
494 # reported by the server itself (in case it forked again on its own).
495 # Both (potentially) need to be killed at the end of the test.
496 return ($child, $pid2);
500 #######################################################################
501 # Check for a command in the PATH of the test server.
505 my @paths=(split(":", $ENV{'PATH'}), "/usr/sbin", "/usr/local/sbin",
506 "/sbin", "/usr/bin", "/usr/local/bin",
507 "./libtest/.libs", "./libtest");
509 if( -x "$_/$cmd" && ! -d "$_/$cmd") {
510 # executable bit but not a directory!
516 #######################################################################
517 # Get the list of tests that the tests/data/Makefile.am knows about!
521 my @dist = `cd data && make show`;
522 $disttests = join("", @dist);
525 #######################################################################
526 # Check for a command in the PATH of the machine running curl.
530 return checkcmd($cmd);
533 #######################################################################
534 # Run the application under test and return its return code
538 my $ret = system($cmd);
539 print "CMD ($ret): $cmd\n" if($verbose && !$torture);
542 # This is one way to test curl on a remote machine
543 # my $out = system("ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'");
544 # sleep 2; # time to allow the NFS server to be updated
548 #######################################################################
549 # Run the application under test and return its stdout
551 sub runclientoutput {
555 # This is one way to test curl on a remote machine
556 # my @out = `ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'`;
557 # sleep 2; # time to allow the NFS server to be updated
561 #######################################################################
562 # Memory allocation test and failure torture testing.
565 my ($testcmd, $testnum, $gdbline) = @_;
567 # remove memdump first to be sure we get a new nice and clean one
570 # First get URL from test server, ignore the output/result
573 logmsg " CMD: $testcmd\n" if($verbose);
575 # memanalyze -v is our friend, get the number of allocations made
577 my @out = `$memanalyze -v $memdump`;
579 if(/^Operations: (\d+)/) {
585 logmsg " found no functions to make fail\n";
589 logmsg " $count functions to make fail\n";
591 for ( 1 .. $count ) {
596 if($tortalloc && ($tortalloc != $limit)) {
601 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
603 my $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
604 logmsg "Fail funcion no: $limit at $now\r";
607 # make the memory allocation function number $limit return failure
608 $ENV{'CURL_MEMLIMIT'} = $limit;
610 # remove memdump first to be sure we get a new nice and clean one
614 if($valgrind && !$gdbthis) {
615 my @valgrindoption = getpart("verify", "valgrind");
616 if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) {
617 my $valgrindcmd = "$valgrind ";
618 $valgrindcmd .= "$valgrind_tool " if($valgrind_tool);
619 $valgrindcmd .= "--quiet --leak-check=yes ";
620 $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp ";
621 # $valgrindcmd .= "--gen-suppressions=all ";
622 $valgrindcmd .= "--num-callers=16 ";
623 $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum";
624 $cmd = "$valgrindcmd $testcmd";
627 logmsg "*** Function number $limit is now set to fail ***\n" if($gdbthis);
634 $ret = runclient($cmd);
636 #logmsg "$_ Returned " . ($ret >> 8) . "\n";
638 # Now clear the variable again
639 delete $ENV{'CURL_MEMLIMIT'} if($ENV{'CURL_MEMLIMIT'});
642 # there's core file present now!
643 logmsg " core dumped\n";
649 my @e = valgrindparse("$LOGDIR/valgrind$testnum");
652 logmsg "FAIL: torture $testnum - valgrind\n";
655 logmsg " valgrind ERROR ";
662 # verify that it returns a proper error code, doesn't leak memory
663 # and doesn't core dump
664 if(($ret & 255) || ($ret >> 8) >= 128) {
665 logmsg " system() returned $ret\n";
669 my @memdata=`$memanalyze $memdump`;
673 # well it could be other memory problems as well, but
674 # we call it leak for short here
679 logmsg "** MEMORY FAILURE\n";
681 logmsg `$memanalyze -l $memdump`;
686 logmsg " Failed on function number $limit in test.\n",
687 " invoke with \"-t$limit\" to repeat this single case.\n";
688 stopservers($verbose);
693 logmsg "torture OK\n";
697 #######################################################################
698 # Stop a test server along with pids which aren't in the %run hash yet.
699 # This also stops all servers which are relative to the given one.
702 my ($server, $pidlist) = @_;
704 # kill sockfilter processes for pingpong relative server
706 if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
708 my $idnum = ($2 && ($2 > 1)) ? $2 : 1;
709 my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
710 killsockfilters($proto, $ipvnum, $idnum, $verbose);
713 # All servers relative to the given one must be stopped also
716 if($server =~ /^(ftp|http|imap|pop3|smtp|httppipe)s((\d*)(-ipv6|-unix|))$/) {
717 # given a stunnel based ssl server, also kill non-ssl underlying one
718 push @killservers, "${1}${2}";
720 elsif($server =~ /^(ftp|http|imap|pop3|smtp|httppipe)((\d*)(-ipv6|-unix|))$/) {
721 # given a non-ssl server, also kill stunnel based ssl piggybacking one
722 push @killservers, "${1}s${2}";
724 elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
725 # given a socks server, also kill ssh underlying one
726 push @killservers, "ssh${2}";
728 elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
729 # given a ssh server, also kill socks piggybacking one
730 push @killservers, "socks${2}";
732 push @killservers, $server;
734 # kill given pids and server relative ones clearing them in %run hash
736 foreach my $server (@killservers) {
738 # we must prepend a space since $pidlist may already contain a pid
739 $pidlist .= " $run{$server}";
742 $runcert{$server} = 0 if($runcert{$server});
744 killpid($verbose, $pidlist);
746 # cleanup server pid files
748 foreach my $server (@killservers) {
749 my $pidfile = $serverpidfile{$server};
750 my $pid = processexists($pidfile);
752 logmsg "Warning: $server server unexpectedly alive\n";
753 killpid($verbose, $pid);
755 unlink($pidfile) if(-f $pidfile);
759 #######################################################################
760 # Verify that the server that runs on $ip, $port is our server. This also
761 # implies that we can speak with it, as there might be occasions when the
762 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
763 # assign requested address")
766 my ($proto, $ipvnum, $idnum, $ip, $port_or_path) = @_;
767 my $server = servername_id($proto, $ipvnum, $idnum);
770 # $port_or_path contains a path for Unix sockets, sws ignores the port
771 my $port = ($ipvnum eq "unix") ? 80 : $port_or_path;
773 my $verifyout = "$LOGDIR/".
774 servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
775 unlink($verifyout) if(-f $verifyout);
777 my $verifylog = "$LOGDIR/".
778 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
779 unlink($verifylog) if(-f $verifylog);
781 if($proto eq "gopher") {
786 my $flags = "--max-time $server_response_maxtime ";
787 $flags .= "--output $verifyout ";
788 $flags .= "--silent ";
789 $flags .= "--verbose ";
790 $flags .= "--globoff ";
791 $flags .= "--unix-socket '$port_or_path' " if $ipvnum eq "unix";
792 $flags .= "-1 " if($has_axtls);
793 $flags .= "--insecure " if($proto eq 'https');
794 $flags .= "\"$proto://$ip:$port/${bonus}verifiedserver\"";
796 my $cmd = "$VCURL $flags 2>$verifylog";
798 # verify if our/any server is running on this port
799 logmsg "RUN: $cmd\n" if($verbose);
800 my $res = runclient($cmd);
802 $res >>= 8; # rotate the result
804 logmsg "RUN: curl command died with a coredump\n";
808 if($res && $verbose) {
809 logmsg "RUN: curl command returned $res\n";
810 if(open(FILE, "<$verifylog")) {
811 while(my $string = <FILE>) {
812 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
819 if(open(FILE, "<$verifyout")) {
820 while(my $string = <FILE>) {
822 last; # only want first line
827 if($data && ($data =~ /WE ROOLZ: (\d+)/)) {
831 # curl: (6) Couldn't resolve host '::1'
832 logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
835 elsif($data || ($res && ($res != 7))) {
836 logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
842 #######################################################################
843 # Verify that the server that runs on $ip, $port is our server. This also
844 # implies that we can speak with it, as there might be occasions when the
845 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
846 # assign requested address")
849 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
850 my $server = servername_id($proto, $ipvnum, $idnum);
855 my $verifylog = "$LOGDIR/".
856 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
857 unlink($verifylog) if(-f $verifylog);
859 if($proto eq "ftps") {
860 $extra .= "--insecure --ftp-ssl-control ";
863 my $flags = "--max-time $server_response_maxtime ";
864 $flags .= "--silent ";
865 $flags .= "--verbose ";
866 $flags .= "--globoff ";
868 $flags .= "\"$proto://$ip:$port/verifiedserver\"";
870 my $cmd = "$VCURL $flags 2>$verifylog";
872 # check if this is our server running on this port:
873 logmsg "RUN: $cmd\n" if($verbose);
874 my @data = runclientoutput($cmd);
876 my $res = $? >> 8; # rotate the result
878 logmsg "RUN: curl command died with a coredump\n";
882 foreach my $line (@data) {
883 if($line =~ /WE ROOLZ: (\d+)/) {
884 # this is our test server with a known pid!
889 if($pid <= 0 && @data && $data[0]) {
890 # this is not a known server
891 logmsg "RUN: Unknown server on our $server port: $port\n";
894 # we can/should use the time it took to verify the FTP server as a measure
895 # on how fast/slow this host/FTP is.
896 my $took = int(0.5+time()-$time);
899 logmsg "RUN: Verifying our test $server server took $took seconds\n";
901 $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
906 #######################################################################
907 # Verify that the server that runs on $ip, $port is our server. This also
908 # implies that we can speak with it, as there might be occasions when the
909 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
910 # assign requested address")
913 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
914 my $server = servername_id($proto, $ipvnum, $idnum);
917 my $verifyout = "$LOGDIR/".
918 servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
919 unlink($verifyout) if(-f $verifyout);
921 my $verifylog = "$LOGDIR/".
922 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
923 unlink($verifylog) if(-f $verifylog);
925 my $flags = "--max-time $server_response_maxtime ";
926 $flags .= "--output $verifyout ";
927 $flags .= "--silent ";
928 $flags .= "--verbose ";
929 $flags .= "--globoff ";
930 # currently verification is done using http
931 $flags .= "\"http://$ip:$port/verifiedserver\"";
933 my $cmd = "$VCURL $flags 2>$verifylog";
935 # verify if our/any server is running on this port
936 logmsg "RUN: $cmd\n" if($verbose);
937 my $res = runclient($cmd);
939 $res >>= 8; # rotate the result
941 logmsg "RUN: curl command died with a coredump\n";
945 if($res && $verbose) {
946 logmsg "RUN: curl command returned $res\n";
947 if(open(FILE, "<$verifylog")) {
948 while(my $string = <FILE>) {
949 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
956 if(open(FILE, "<$verifyout")) {
957 while(my $string = <FILE>) {
959 last; # only want first line
964 if($data && ($data =~ /RTSP_SERVER WE ROOLZ: (\d+)/)) {
968 # curl: (6) Couldn't resolve host '::1'
969 logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
972 elsif($data || ($res != 7)) {
973 logmsg "RUN: Unknown server on our $server port: $port\n";
979 #######################################################################
980 # Verify that the ssh server has written out its pidfile, recovering
981 # the pid from the file and returning it if a process with that pid is
985 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
986 my $server = servername_id($proto, $ipvnum, $idnum);
987 my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
989 if(open(FILE, "<$pidfile")) {
994 # if we have a pid it is actually our ssh server,
995 # since runsshserver() unlinks previous pidfile
996 if(!pidexists($pid)) {
997 logmsg "RUN: SSH server has died after starting up\n";
1006 #######################################################################
1007 # Verify that we can connect to the sftp server, properly authenticate
1008 # with generated config and key files and run a simple remote pwd.
1011 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1012 my $server = servername_id($proto, $ipvnum, $idnum);
1014 # Find out sftp client canonical file name
1015 my $sftp = find_sftp();
1017 logmsg "RUN: SFTP server cannot find $sftpexe\n";
1020 # Find out ssh client canonical file name
1021 my $ssh = find_ssh();
1023 logmsg "RUN: SFTP server cannot find $sshexe\n";
1026 # Connect to sftp server, authenticate and run a remote pwd
1027 # command using our generated configuration and key files
1028 my $cmd = "\"$sftp\" -b $sftpcmds -F $sftpconfig -S \"$ssh\" $ip > $sftplog 2>&1";
1029 my $res = runclient($cmd);
1030 # Search for pwd command response in log file
1031 if(open(SFTPLOGFILE, "<$sftplog")) {
1032 while(<SFTPLOGFILE>) {
1033 if(/^Remote working directory: /) {
1043 #######################################################################
1044 # Verify that the non-stunnel HTTP TLS extensions capable server that runs
1045 # on $ip, $port is our server. This also implies that we can speak with it,
1046 # as there might be occasions when the server runs fine but we cannot talk
1047 # to it ("Failed to connect to ::1: Can't assign requested address")
1050 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1051 my $server = servername_id($proto, $ipvnum, $idnum);
1052 my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
1055 my $verifyout = "$LOGDIR/".
1056 servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
1057 unlink($verifyout) if(-f $verifyout);
1059 my $verifylog = "$LOGDIR/".
1060 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
1061 unlink($verifylog) if(-f $verifylog);
1063 my $flags = "--max-time $server_response_maxtime ";
1064 $flags .= "--output $verifyout ";
1065 $flags .= "--verbose ";
1066 $flags .= "--globoff ";
1067 $flags .= "--insecure ";
1068 $flags .= "--tlsauthtype SRP ";
1069 $flags .= "--tlsuser jsmith ";
1070 $flags .= "--tlspassword abc ";
1071 $flags .= "\"https://$ip:$port/verifiedserver\"";
1073 my $cmd = "$VCURL $flags 2>$verifylog";
1075 # verify if our/any server is running on this port
1076 logmsg "RUN: $cmd\n" if($verbose);
1077 my $res = runclient($cmd);
1079 $res >>= 8; # rotate the result
1081 logmsg "RUN: curl command died with a coredump\n";
1085 if($res && $verbose) {
1086 logmsg "RUN: curl command returned $res\n";
1087 if(open(FILE, "<$verifylog")) {
1088 while(my $string = <FILE>) {
1089 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
1096 if(open(FILE, "<$verifyout")) {
1097 while(my $string = <FILE>) {
1103 if($data && ($data =~ /(GNUTLS|GnuTLS)/) && open(FILE, "<$pidfile")) {
1107 # if we have a pid it is actually our httptls server,
1108 # since runhttptlsserver() unlinks previous pidfile
1109 if(!pidexists($pid)) {
1110 logmsg "RUN: $server server has died after starting up\n";
1119 # curl: (6) Couldn't resolve host '::1'
1120 logmsg "RUN: failed to resolve host (https://$ip:$port/verifiedserver)\n";
1123 elsif($data || ($res && ($res != 7))) {
1124 logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
1130 #######################################################################
1131 # STUB for verifying socks
1134 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1135 my $server = servername_id($proto, $ipvnum, $idnum);
1136 my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
1138 if(open(FILE, "<$pidfile")) {
1143 # if we have a pid it is actually our socks server,
1144 # since runsocksserver() unlinks previous pidfile
1145 if(!pidexists($pid)) {
1146 logmsg "RUN: SOCKS server has died after starting up\n";
1155 #######################################################################
1156 # Verify that the server that runs on $ip, $port is our server. This also
1157 # implies that we can speak with it, as there might be occasions when the
1158 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
1159 # assign requested address")
1162 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1163 my $server = servername_id($proto, $ipvnum, $idnum);
1168 my $verifylog = "$LOGDIR/".
1169 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
1170 unlink($verifylog) if(-f $verifylog);
1172 my $flags = "--max-time $server_response_maxtime ";
1173 $flags .= "--silent ";
1174 $flags .= "--verbose ";
1175 $flags .= "--globoff ";
1176 $flags .= "-u 'curltest:curltest' ";
1178 $flags .= "\"$proto://$ip:$port/SERVER/verifiedserver\"";
1180 my $cmd = "$VCURL $flags 2>$verifylog";
1182 # check if this is our server running on this port:
1183 logmsg "RUN: $cmd\n" if($verbose);
1184 my @data = runclientoutput($cmd);
1186 my $res = $? >> 8; # rotate the result
1188 logmsg "RUN: curl command died with a coredump\n";
1192 foreach my $line (@data) {
1193 if($line =~ /WE ROOLZ: (\d+)/) {
1194 # this is our test server with a known pid!
1199 if($pid <= 0 && @data && $data[0]) {
1200 # this is not a known server
1201 logmsg "RUN: Unknown server on our $server port: $port\n";
1204 # we can/should use the time it took to verify the server as a measure
1205 # on how fast/slow this host is.
1206 my $took = int(0.5+time()-$time);
1209 logmsg "RUN: Verifying our test $server server took $took seconds\n";
1211 $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
1216 #######################################################################
1217 # Verify that the server that runs on $ip, $port is our server. This also
1218 # implies that we can speak with it, as there might be occasions when the
1219 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
1220 # assign requested address")
1223 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1224 my $server = servername_id($proto, $ipvnum, $idnum);
1229 my $verifylog = "$LOGDIR/".
1230 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
1231 unlink($verifylog) if(-f $verifylog);
1233 my $flags = "--max-time $server_response_maxtime ";
1234 $flags .= "--silent ";
1235 $flags .= "--verbose ";
1236 $flags .= "--globoff ";
1237 $flags .= "--upload-file - ";
1239 $flags .= "\"$proto://$ip:$port\"";
1241 my $cmd = "echo 'verifiedserver' | $VCURL $flags 2>$verifylog";
1243 # check if this is our server running on this port:
1244 logmsg "RUN: $cmd\n" if($verbose);
1245 my @data = runclientoutput($cmd);
1247 my $res = $? >> 8; # rotate the result
1249 logmsg "RUN: curl command died with a coredump\n";
1253 foreach my $line (@data) {
1254 if($line =~ /WE ROOLZ: (\d+)/) {
1255 # this is our test server with a known pid!
1260 if($pid <= 0 && @data && $data[0]) {
1261 # this is not a known server
1262 logmsg "RUN: Unknown server on our $server port: $port\n";
1265 # we can/should use the time it took to verify the server as a measure
1266 # on how fast/slow this host is.
1267 my $took = int(0.5+time()-$time);
1270 logmsg "RUN: Verifying our test $server server took $took seconds\n";
1277 #######################################################################
1278 # Verify that the server that runs on $ip, $port is our server.
1279 # Retry over several seconds before giving up. The ssh server in
1280 # particular can take a long time to start if it needs to generate
1281 # keys on a slow or loaded host.
1283 # Just for convenience, test harness uses 'https' and 'httptls' literals
1284 # as values for 'proto' variable in order to differentiate different
1285 # servers. 'https' literal is used for stunnel based https test servers,
1286 # and 'httptls' is used for non-stunnel https test servers.
1289 my %protofunc = ('http' => \&verifyhttp,
1290 'https' => \&verifyhttp,
1291 'rtsp' => \&verifyrtsp,
1292 'ftp' => \&verifyftp,
1293 'pop3' => \&verifyftp,
1294 'imap' => \&verifyftp,
1295 'smtp' => \&verifyftp,
1296 'httppipe' => \&verifyhttp,
1297 'ftps' => \&verifyftp,
1298 'tftp' => \&verifyftp,
1299 'ssh' => \&verifyssh,
1300 'socks' => \&verifysocks,
1301 'gopher' => \&verifyhttp,
1302 'httptls' => \&verifyhttptls,
1303 'dict' => \&verifyftp,
1304 'smb' => \&verifysmb,
1305 'telnet' => \&verifytelnet);
1308 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1310 my $count = 30; # try for this many seconds
1314 my $fun = $protofunc{$proto};
1316 $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
1322 # a real failure, stop trying and bail out
1330 #######################################################################
1331 # Single shot server responsiveness test. This should only be used
1332 # to verify that a server present in %run hash is still functional
1334 sub responsiveserver {
1335 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1336 my $prev_verbose = $verbose;
1339 my $fun = $protofunc{$proto};
1340 my $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
1341 $verbose = $prev_verbose;
1344 return 1; # responsive
1347 my $srvrname = servername_str($proto, $ipvnum, $idnum);
1348 logmsg " server precheck FAILED (unresponsive $srvrname server)\n";
1352 #######################################################################
1353 # start the http2 server
1355 sub runhttp2server {
1356 my ($verbose, $port) = @_;
1365 my $exe = "$perl $srcdir/http2-server.pl";
1366 my $verbose_flag = "--verbose ";
1368 $server = servername_id($proto, $ipvnum, $idnum);
1370 $pidfile = $serverpidfile{$server};
1372 # don't retry if the server doesn't work
1373 if ($doesntrun{$pidfile}) {
1377 my $pid = processexists($pidfile);
1379 stopserver($server, "$pid");
1381 unlink($pidfile) if(-f $pidfile);
1383 $srvrname = servername_str($proto, $ipvnum, $idnum);
1385 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1387 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1388 $flags .= "--port $HTTP2PORT ";
1389 $flags .= "--connect $HOSTIP:$HTTPPORT ";
1390 $flags .= $verbose_flag if($debugprotocol);
1392 my $cmd = "$exe $flags";
1393 my ($http2pid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1395 if($http2pid <= 0 || !pidexists($http2pid)) {
1397 logmsg "RUN: failed to start the $srvrname server\n";
1398 stopserver($server, "$pid2");
1399 $doesntrun{$pidfile} = 1;
1404 logmsg "RUN: $srvrname server is now running PID $http2pid\n";
1407 return ($http2pid, $pid2);
1410 #######################################################################
1411 # start the http server
1414 my ($proto, $verbose, $alt, $port_or_path) = @_;
1423 my $exe = "$perl $srcdir/httpserver.pl";
1424 my $verbose_flag = "--verbose ";
1426 if($alt eq "ipv6") {
1427 # if IPv6, use a different setup
1431 elsif($alt eq "proxy") {
1432 # basically the same, but another ID
1435 elsif($alt eq "pipe") {
1436 # basically the same, but another ID
1438 $exe = "python $srcdir/http_pipe.py";
1439 $verbose_flag .= "1 ";
1441 elsif($alt eq "unix") {
1442 # IP (protocol) is mutually exclusive with Unix sockets
1446 $server = servername_id($proto, $ipvnum, $idnum);
1448 $pidfile = $serverpidfile{$server};
1450 # don't retry if the server doesn't work
1451 if ($doesntrun{$pidfile}) {
1455 my $pid = processexists($pidfile);
1457 stopserver($server, "$pid");
1459 unlink($pidfile) if(-f $pidfile);
1461 $srvrname = servername_str($proto, $ipvnum, $idnum);
1463 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1465 $flags .= "--gopher " if($proto eq "gopher");
1466 $flags .= "--connect $HOSTIP " if($alt eq "proxy");
1467 $flags .= $verbose_flag if($debugprotocol);
1468 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1469 $flags .= "--id $idnum " if($idnum > 1);
1470 if($ipvnum eq "unix") {
1471 $flags .= "--unix-socket '$port_or_path' ";
1473 $flags .= "--ipv$ipvnum --port $port_or_path ";
1475 $flags .= "--srcdir \"$srcdir\"";
1477 my $cmd = "$exe $flags";
1478 my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1480 if($httppid <= 0 || !pidexists($httppid)) {
1482 logmsg "RUN: failed to start the $srvrname server\n";
1483 stopserver($server, "$pid2");
1484 displaylogs($testnumcheck);
1485 $doesntrun{$pidfile} = 1;
1489 # Server is up. Verify that we can speak to it.
1490 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
1492 logmsg "RUN: $srvrname server failed verification\n";
1493 # failed to talk to it properly. Kill the server and return failure
1494 stopserver($server, "$httppid $pid2");
1495 displaylogs($testnumcheck);
1496 $doesntrun{$pidfile} = 1;
1502 logmsg "RUN: $srvrname server is now running PID $httppid\n";
1507 return ($httppid, $pid2);
1510 #######################################################################
1511 # start the http server
1513 sub runhttp_pipeserver {
1514 my ($proto, $verbose, $alt, $port) = @_;
1524 if($alt eq "ipv6") {
1528 $server = servername_id($proto, $ipvnum, $idnum);
1530 $pidfile = $serverpidfile{$server};
1532 # don't retry if the server doesn't work
1533 if ($doesntrun{$pidfile}) {
1537 my $pid = processexists($pidfile);
1539 stopserver($server, "$pid");
1541 unlink($pidfile) if(-f $pidfile);
1543 $srvrname = servername_str($proto, $ipvnum, $idnum);
1545 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1547 $flags .= "--verbose 1 " if($debugprotocol);
1548 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1549 $flags .= "--id $idnum " if($idnum > 1);
1550 $flags .= "--port $port --srcdir \"$srcdir\"";
1552 my $cmd = "$srcdir/http_pipe.py $flags";
1553 my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1555 if($httppid <= 0 || !pidexists($httppid)) {
1557 logmsg "RUN: failed to start the $srvrname server\n";
1558 stopserver($server, "$pid2");
1559 displaylogs($testnumcheck);
1560 $doesntrun{$pidfile} = 1;
1564 # Server is up. Verify that we can speak to it.
1565 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1567 logmsg "RUN: $srvrname server failed verification\n";
1568 # failed to talk to it properly. Kill the server and return failure
1569 stopserver($server, "$httppid $pid2");
1570 displaylogs($testnumcheck);
1571 $doesntrun{$pidfile} = 1;
1577 logmsg "RUN: $srvrname server is now running PID $httppid\n";
1582 return ($httppid, $pid2);
1585 #######################################################################
1586 # start the https stunnel based server
1588 sub runhttpsserver {
1589 my ($verbose, $ipv6, $certfile) = @_;
1590 my $proto = 'https';
1591 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1592 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1604 $server = servername_id($proto, $ipvnum, $idnum);
1606 $pidfile = $serverpidfile{$server};
1608 # don't retry if the server doesn't work
1609 if ($doesntrun{$pidfile}) {
1613 my $pid = processexists($pidfile);
1615 stopserver($server, "$pid");
1617 unlink($pidfile) if(-f $pidfile);
1619 $srvrname = servername_str($proto, $ipvnum, $idnum);
1621 $certfile = 'stunnel.pem' unless($certfile);
1623 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1625 $flags .= "--verbose " if($debugprotocol);
1626 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1627 $flags .= "--id $idnum " if($idnum > 1);
1628 $flags .= "--ipv$ipvnum --proto $proto ";
1629 $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
1630 $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
1631 $flags .= "--connect $HTTPPORT --accept $HTTPSPORT";
1633 my $cmd = "$perl $srcdir/secureserver.pl $flags";
1634 my ($httpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1636 if($httpspid <= 0 || !pidexists($httpspid)) {
1638 logmsg "RUN: failed to start the $srvrname server\n";
1639 stopserver($server, "$pid2");
1640 displaylogs($testnumcheck);
1641 $doesntrun{$pidfile} = 1;
1645 # Server is up. Verify that we can speak to it.
1646 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $HTTPSPORT);
1648 logmsg "RUN: $srvrname server failed verification\n";
1649 # failed to talk to it properly. Kill the server and return failure
1650 stopserver($server, "$httpspid $pid2");
1651 displaylogs($testnumcheck);
1652 $doesntrun{$pidfile} = 1;
1655 # Here pid3 is actually the pid returned by the unsecure-http server.
1657 $runcert{$server} = $certfile;
1660 logmsg "RUN: $srvrname server is now running PID $httpspid\n";
1665 return ($httpspid, $pid2);
1668 #######################################################################
1669 # start the non-stunnel HTTP TLS extensions capable server
1671 sub runhttptlsserver {
1672 my ($verbose, $ipv6) = @_;
1673 my $proto = "httptls";
1674 my $port = ($ipv6 && ($ipv6 =~ /6$/)) ? $HTTPTLS6PORT : $HTTPTLSPORT;
1675 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1676 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1688 $server = servername_id($proto, $ipvnum, $idnum);
1690 $pidfile = $serverpidfile{$server};
1692 # don't retry if the server doesn't work
1693 if ($doesntrun{$pidfile}) {
1697 my $pid = processexists($pidfile);
1699 stopserver($server, "$pid");
1701 unlink($pidfile) if(-f $pidfile);
1703 $srvrname = servername_str($proto, $ipvnum, $idnum);
1705 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1707 $flags .= "--http ";
1708 $flags .= "--debug 1 " if($debugprotocol);
1709 $flags .= "--port $port ";
1710 $flags .= "--priority NORMAL:+SRP ";
1711 $flags .= "--srppasswd $srcdir/certs/srp-verifier-db ";
1712 $flags .= "--srppasswdconf $srcdir/certs/srp-verifier-conf";
1714 my $cmd = "$httptlssrv $flags > $logfile 2>&1";
1715 my ($httptlspid, $pid2) = startnew($cmd, $pidfile, 10, 1); # fake pidfile
1717 if($httptlspid <= 0 || !pidexists($httptlspid)) {
1719 logmsg "RUN: failed to start the $srvrname server\n";
1720 stopserver($server, "$pid2");
1721 displaylogs($testnumcheck);
1722 $doesntrun{$pidfile} = 1;
1726 # Server is up. Verify that we can speak to it. PID is from fake pidfile
1727 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1729 logmsg "RUN: $srvrname server failed verification\n";
1730 # failed to talk to it properly. Kill the server and return failure
1731 stopserver($server, "$httptlspid $pid2");
1732 displaylogs($testnumcheck);
1733 $doesntrun{$pidfile} = 1;
1739 logmsg "RUN: $srvrname server is now running PID $httptlspid\n";
1744 return ($httptlspid, $pid2);
1747 #######################################################################
1748 # start the pingpong server (FTP, POP3, IMAP, SMTP)
1750 sub runpingpongserver {
1751 my ($proto, $id, $verbose, $ipv6) = @_;
1753 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1754 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1755 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1762 if($proto eq "ftp") {
1763 $port = ($idnum>1)?$FTP2PORT:$FTPPORT;
1766 # if IPv6, use a different setup
1770 elsif($proto eq "pop3") {
1771 $port = ($ipvnum==6) ? $POP36PORT : $POP3PORT;
1773 elsif($proto eq "imap") {
1774 $port = ($ipvnum==6) ? $IMAP6PORT : $IMAPPORT;
1776 elsif($proto eq "smtp") {
1777 $port = ($ipvnum==6) ? $SMTP6PORT : $SMTPPORT;
1780 print STDERR "Unsupported protocol $proto!!\n";
1784 $server = servername_id($proto, $ipvnum, $idnum);
1786 $pidfile = $serverpidfile{$server};
1788 # don't retry if the server doesn't work
1789 if ($doesntrun{$pidfile}) {
1793 my $pid = processexists($pidfile);
1795 stopserver($server, "$pid");
1797 unlink($pidfile) if(-f $pidfile);
1799 $srvrname = servername_str($proto, $ipvnum, $idnum);
1801 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1803 $flags .= "--verbose " if($debugprotocol);
1804 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1805 $flags .= "--srcdir \"$srcdir\" --proto $proto ";
1806 $flags .= "--id $idnum " if($idnum > 1);
1807 $flags .= "--ipv$ipvnum --port $port --addr \"$ip\"";
1809 my $cmd = "$perl $srcdir/ftpserver.pl $flags";
1810 my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1812 if($ftppid <= 0 || !pidexists($ftppid)) {
1814 logmsg "RUN: failed to start the $srvrname server\n";
1815 stopserver($server, "$pid2");
1816 displaylogs($testnumcheck);
1817 $doesntrun{$pidfile} = 1;
1821 # Server is up. Verify that we can speak to it.
1822 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1824 logmsg "RUN: $srvrname server failed verification\n";
1825 # failed to talk to it properly. Kill the server and return failure
1826 stopserver($server, "$ftppid $pid2");
1827 displaylogs($testnumcheck);
1828 $doesntrun{$pidfile} = 1;
1835 logmsg "RUN: $srvrname server is now running PID $ftppid\n";
1840 return ($pid2, $ftppid);
1843 #######################################################################
1844 # start the ftps server (or rather, tunnel)
1847 my ($verbose, $ipv6, $certfile) = @_;
1849 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1850 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1862 $server = servername_id($proto, $ipvnum, $idnum);
1864 $pidfile = $serverpidfile{$server};
1866 # don't retry if the server doesn't work
1867 if ($doesntrun{$pidfile}) {
1871 my $pid = processexists($pidfile);
1873 stopserver($server, "$pid");
1875 unlink($pidfile) if(-f $pidfile);
1877 $srvrname = servername_str($proto, $ipvnum, $idnum);
1879 $certfile = 'stunnel.pem' unless($certfile);
1881 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1883 $flags .= "--verbose " if($debugprotocol);
1884 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1885 $flags .= "--id $idnum " if($idnum > 1);
1886 $flags .= "--ipv$ipvnum --proto $proto ";
1887 $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
1888 $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
1889 $flags .= "--connect $FTPPORT --accept $FTPSPORT";
1891 my $cmd = "$perl $srcdir/secureserver.pl $flags";
1892 my ($ftpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1894 if($ftpspid <= 0 || !pidexists($ftpspid)) {
1896 logmsg "RUN: failed to start the $srvrname server\n";
1897 stopserver($server, "$pid2");
1898 displaylogs($testnumcheck);
1899 $doesntrun{$pidfile} = 1;
1903 # Server is up. Verify that we can speak to it.
1904 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $FTPSPORT);
1906 logmsg "RUN: $srvrname server failed verification\n";
1907 # failed to talk to it properly. Kill the server and return failure
1908 stopserver($server, "$ftpspid $pid2");
1909 displaylogs($testnumcheck);
1910 $doesntrun{$pidfile} = 1;
1913 # Here pid3 is actually the pid returned by the unsecure-ftp server.
1915 $runcert{$server} = $certfile;
1918 logmsg "RUN: $srvrname server is now running PID $ftpspid\n";
1923 return ($ftpspid, $pid2);
1926 #######################################################################
1927 # start the tftp server
1930 my ($id, $verbose, $ipv6) = @_;
1931 my $port = $TFTPPORT;
1935 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1943 # if IPv6, use a different setup
1949 $server = servername_id($proto, $ipvnum, $idnum);
1951 $pidfile = $serverpidfile{$server};
1953 # don't retry if the server doesn't work
1954 if ($doesntrun{$pidfile}) {
1958 my $pid = processexists($pidfile);
1960 stopserver($server, "$pid");
1962 unlink($pidfile) if(-f $pidfile);
1964 $srvrname = servername_str($proto, $ipvnum, $idnum);
1966 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1968 $flags .= "--verbose " if($debugprotocol);
1969 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1970 $flags .= "--id $idnum " if($idnum > 1);
1971 $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\"";
1973 my $cmd = "$perl $srcdir/tftpserver.pl $flags";
1974 my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1976 if($tftppid <= 0 || !pidexists($tftppid)) {
1978 logmsg "RUN: failed to start the $srvrname server\n";
1979 stopserver($server, "$pid2");
1980 displaylogs($testnumcheck);
1981 $doesntrun{$pidfile} = 1;
1985 # Server is up. Verify that we can speak to it.
1986 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1988 logmsg "RUN: $srvrname server failed verification\n";
1989 # failed to talk to it properly. Kill the server and return failure
1990 stopserver($server, "$tftppid $pid2");
1991 displaylogs($testnumcheck);
1992 $doesntrun{$pidfile} = 1;
1998 logmsg "RUN: $srvrname server is now running PID $tftppid\n";
2003 return ($pid2, $tftppid);
2007 #######################################################################
2008 # start the rtsp server
2011 my ($verbose, $ipv6) = @_;
2012 my $port = $RTSPPORT;
2024 # if IPv6, use a different setup
2030 $server = servername_id($proto, $ipvnum, $idnum);
2032 $pidfile = $serverpidfile{$server};
2034 # don't retry if the server doesn't work
2035 if ($doesntrun{$pidfile}) {
2039 my $pid = processexists($pidfile);
2041 stopserver($server, "$pid");
2043 unlink($pidfile) if(-f $pidfile);
2045 $srvrname = servername_str($proto, $ipvnum, $idnum);
2047 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
2049 $flags .= "--verbose " if($debugprotocol);
2050 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
2051 $flags .= "--id $idnum " if($idnum > 1);
2052 $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\"";
2054 my $cmd = "$perl $srcdir/rtspserver.pl $flags";
2055 my ($rtsppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
2057 if($rtsppid <= 0 || !pidexists($rtsppid)) {
2059 logmsg "RUN: failed to start the $srvrname server\n";
2060 stopserver($server, "$pid2");
2061 displaylogs($testnumcheck);
2062 $doesntrun{$pidfile} = 1;
2066 # Server is up. Verify that we can speak to it.
2067 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
2069 logmsg "RUN: $srvrname server failed verification\n";
2070 # failed to talk to it properly. Kill the server and return failure
2071 stopserver($server, "$rtsppid $pid2");
2072 displaylogs($testnumcheck);
2073 $doesntrun{$pidfile} = 1;
2079 logmsg "RUN: $srvrname server is now running PID $rtsppid\n";
2084 return ($rtsppid, $pid2);
2088 #######################################################################
2089 # Start the ssh (scp/sftp) server
2092 my ($id, $verbose, $ipv6) = @_;
2094 my $port = $SSHPORT;
2095 my $socksport = $SOCKSPORT;
2098 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2105 $server = servername_id($proto, $ipvnum, $idnum);
2107 $pidfile = $serverpidfile{$server};
2109 # don't retry if the server doesn't work
2110 if ($doesntrun{$pidfile}) {
2114 my $pid = processexists($pidfile);
2116 stopserver($server, "$pid");
2118 unlink($pidfile) if(-f $pidfile);
2120 $srvrname = servername_str($proto, $ipvnum, $idnum);
2122 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
2124 $flags .= "--verbose " if($verbose);
2125 $flags .= "--debugprotocol " if($debugprotocol);
2126 $flags .= "--pidfile \"$pidfile\" ";
2127 $flags .= "--id $idnum " if($idnum > 1);
2128 $flags .= "--ipv$ipvnum --addr \"$ip\" ";
2129 $flags .= "--sshport $port --socksport $socksport ";
2130 $flags .= "--user \"$USER\"";
2132 my $cmd = "$perl $srcdir/sshserver.pl $flags";
2133 my ($sshpid, $pid2) = startnew($cmd, $pidfile, 60, 0);
2135 # on loaded systems sshserver start up can take longer than the timeout
2136 # passed to startnew, when this happens startnew completes without being
2137 # able to read the pidfile and consequently returns a zero pid2 above.
2139 if($sshpid <= 0 || !pidexists($sshpid)) {
2141 logmsg "RUN: failed to start the $srvrname server\n";
2142 stopserver($server, "$pid2");
2143 $doesntrun{$pidfile} = 1;
2147 # ssh server verification allows some extra time for the server to start up
2148 # and gives us the opportunity of recovering the pid from the pidfile, when
2149 # this verification succeeds the recovered pid is assigned to pid2.
2151 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
2153 logmsg "RUN: $srvrname server failed verification\n";
2154 # failed to fetch server pid. Kill the server and return failure
2155 stopserver($server, "$sshpid $pid2");
2156 $doesntrun{$pidfile} = 1;
2161 # once it is known that the ssh server is alive, sftp server verification
2162 # is performed actually connecting to it, authenticating and performing a
2163 # very simple remote command. This verification is tried only one time.
2165 $sshdlog = server_logfilename($LOGDIR, 'ssh', $ipvnum, $idnum);
2166 $sftplog = server_logfilename($LOGDIR, 'sftp', $ipvnum, $idnum);
2168 if(verifysftp('sftp', $ipvnum, $idnum, $ip, $port) < 1) {
2169 logmsg "RUN: SFTP server failed verification\n";
2170 # failed to talk to it properly. Kill the server and return failure
2172 display_sftpconfig();
2174 display_sshdconfig();
2175 stopserver($server, "$sshpid $pid2");
2176 $doesntrun{$pidfile} = 1;
2181 logmsg "RUN: $srvrname server is now running PID $pid2\n";
2184 return ($pid2, $sshpid);
2187 #######################################################################
2188 # Start the socks server
2190 sub runsocksserver {
2191 my ($id, $verbose, $ipv6) = @_;
2193 my $port = $SOCKSPORT;
2194 my $proto = 'socks';
2196 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2203 $server = servername_id($proto, $ipvnum, $idnum);
2205 $pidfile = $serverpidfile{$server};
2207 # don't retry if the server doesn't work
2208 if ($doesntrun{$pidfile}) {
2212 my $pid = processexists($pidfile);
2214 stopserver($server, "$pid");
2216 unlink($pidfile) if(-f $pidfile);
2218 $srvrname = servername_str($proto, $ipvnum, $idnum);
2220 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
2222 # The ssh server must be already running
2224 logmsg "RUN: SOCKS server cannot find running SSH server\n";
2225 $doesntrun{$pidfile} = 1;
2229 # Find out ssh daemon canonical file name
2230 my $sshd = find_sshd();
2232 logmsg "RUN: SOCKS server cannot find $sshdexe\n";
2233 $doesntrun{$pidfile} = 1;
2237 # Find out ssh daemon version info
2238 ($sshdid, $sshdvernum, $sshdverstr, $sshderror) = sshversioninfo($sshd);
2240 # Not an OpenSSH or SunSSH ssh daemon
2241 logmsg "$sshderror\n" if($verbose);
2242 logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2243 $doesntrun{$pidfile} = 1;
2246 logmsg "ssh server found $sshd is $sshdverstr\n" if($verbose);
2248 # Find out ssh client canonical file name
2249 my $ssh = find_ssh();
2251 logmsg "RUN: SOCKS server cannot find $sshexe\n";
2252 $doesntrun{$pidfile} = 1;
2256 # Find out ssh client version info
2257 my ($sshid, $sshvernum, $sshverstr, $ssherror) = sshversioninfo($ssh);
2259 # Not an OpenSSH or SunSSH ssh client
2260 logmsg "$ssherror\n" if($verbose);
2261 logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2262 $doesntrun{$pidfile} = 1;
2266 # Verify minimum ssh client version
2267 if((($sshid =~ /OpenSSH/) && ($sshvernum < 299)) ||
2268 (($sshid =~ /SunSSH/) && ($sshvernum < 100))) {
2269 logmsg "ssh client found $ssh is $sshverstr\n";
2270 logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2271 $doesntrun{$pidfile} = 1;
2274 logmsg "ssh client found $ssh is $sshverstr\n" if($verbose);
2276 # Verify if ssh client and ssh daemon versions match
2277 if(($sshdid ne $sshid) || ($sshdvernum != $sshvernum)) {
2278 # Our test harness might work with slightly mismatched versions
2279 logmsg "Warning: version mismatch: sshd $sshdverstr - ssh $sshverstr\n"
2283 # Config file options for ssh client are previously set from sshserver.pl
2284 if(! -e $sshconfig) {
2285 logmsg "RUN: SOCKS server cannot find $sshconfig\n";
2286 $doesntrun{$pidfile} = 1;
2290 $sshlog = server_logfilename($LOGDIR, 'socks', $ipvnum, $idnum);
2292 # start our socks server
2293 my $cmd="\"$ssh\" -N -F $sshconfig $ip > $sshlog 2>&1";
2294 my ($sshpid, $pid2) = startnew($cmd, $pidfile, 30, 1); # fake pidfile
2296 if($sshpid <= 0 || !pidexists($sshpid)) {
2298 logmsg "RUN: failed to start the $srvrname server\n";
2300 display_sshconfig();
2302 display_sshdconfig();
2303 stopserver($server, "$pid2");
2304 $doesntrun{$pidfile} = 1;
2308 # Ugly hack but ssh doesn't support pid files. PID is from fake pidfile.
2309 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
2311 logmsg "RUN: $srvrname server failed verification\n";
2312 # failed to talk to it properly. Kill the server and return failure
2313 stopserver($server, "$sshpid $pid2");
2314 $doesntrun{$pidfile} = 1;
2320 logmsg "RUN: $srvrname server is now running PID $pid2\n";
2323 return ($pid2, $sshpid);
2326 #######################################################################
2327 # start the dict server
2330 my ($verbose, $alt, $port) = @_;
2341 if($alt eq "ipv6") {
2345 $server = servername_id($proto, $ipvnum, $idnum);
2347 $pidfile = $serverpidfile{$server};
2349 # don't retry if the server doesn't work
2350 if ($doesntrun{$pidfile}) {
2354 my $pid = processexists($pidfile);
2356 stopserver($server, "$pid");
2358 unlink($pidfile) if(-f $pidfile);
2360 $srvrname = servername_str($proto, $ipvnum, $idnum);
2362 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
2364 $flags .= "--verbose 1 " if($debugprotocol);
2365 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
2366 $flags .= "--id $idnum " if($idnum > 1);
2367 $flags .= "--port $port --srcdir \"$srcdir\"";
2369 my $cmd = "$srcdir/dictserver.py $flags";
2370 my ($dictpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
2372 if($dictpid <= 0 || !pidexists($dictpid)) {
2374 logmsg "RUN: failed to start the $srvrname server\n";
2375 stopserver($server, "$pid2");
2376 displaylogs($testnumcheck);
2377 $doesntrun{$pidfile} = 1;
2381 # Server is up. Verify that we can speak to it.
2382 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
2384 logmsg "RUN: $srvrname server failed verification\n";
2385 # failed to talk to it properly. Kill the server and return failure
2386 stopserver($server, "$dictpid $pid2");
2387 displaylogs($testnumcheck);
2388 $doesntrun{$pidfile} = 1;
2394 logmsg "RUN: $srvrname server is now running PID $dictpid\n";
2399 return ($dictpid, $pid2);
2402 #######################################################################
2403 # start the SMB server
2406 my ($verbose, $alt, $port) = @_;
2417 if($alt eq "ipv6") {
2421 $server = servername_id($proto, $ipvnum, $idnum);
2423 $pidfile = $serverpidfile{$server};
2425 # don't retry if the server doesn't work
2426 if ($doesntrun{$pidfile}) {
2430 my $pid = processexists($pidfile);
2432 stopserver($server, "$pid");
2434 unlink($pidfile) if(-f $pidfile);
2436 $srvrname = servername_str($proto, $ipvnum, $idnum);
2438 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
2440 $flags .= "--verbose 1 " if($debugprotocol);
2441 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
2442 $flags .= "--id $idnum " if($idnum > 1);
2443 $flags .= "--port $port --srcdir \"$srcdir\"";
2445 my $cmd = "$srcdir/smbserver.py $flags";
2446 my ($smbpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
2448 if($smbpid <= 0 || !pidexists($smbpid)) {
2450 logmsg "RUN: failed to start the $srvrname server\n";
2451 stopserver($server, "$pid2");
2452 displaylogs($testnumcheck);
2453 $doesntrun{$pidfile} = 1;
2457 # Server is up. Verify that we can speak to it.
2458 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
2460 logmsg "RUN: $srvrname server failed verification\n";
2461 # failed to talk to it properly. Kill the server and return failure
2462 stopserver($server, "$smbpid $pid2");
2463 displaylogs($testnumcheck);
2464 $doesntrun{$pidfile} = 1;
2470 logmsg "RUN: $srvrname server is now running PID $smbpid\n";
2475 return ($smbpid, $pid2);
2478 #######################################################################
2479 # start the telnet server
2481 sub runnegtelnetserver {
2482 my ($verbose, $alt, $port) = @_;
2483 my $proto = "telnet";
2493 if($alt eq "ipv6") {
2497 $server = servername_id($proto, $ipvnum, $idnum);
2499 $pidfile = $serverpidfile{$server};
2501 # don't retry if the server doesn't work
2502 if ($doesntrun{$pidfile}) {
2506 my $pid = processexists($pidfile);
2508 stopserver($server, "$pid");
2510 unlink($pidfile) if(-f $pidfile);
2512 $srvrname = servername_str($proto, $ipvnum, $idnum);
2514 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
2516 $flags .= "--verbose 1 " if($debugprotocol);
2517 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
2518 $flags .= "--id $idnum " if($idnum > 1);
2519 $flags .= "--port $port --srcdir \"$srcdir\"";
2521 my $cmd = "$srcdir/negtelnetserver.py $flags";
2522 my ($ntelpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
2524 if($ntelpid <= 0 || !pidexists($ntelpid)) {
2526 logmsg "RUN: failed to start the $srvrname server\n";
2527 stopserver($server, "$pid2");
2528 displaylogs($testnumcheck);
2529 $doesntrun{$pidfile} = 1;
2533 # Server is up. Verify that we can speak to it.
2534 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
2536 logmsg "RUN: $srvrname server failed verification\n";
2537 # failed to talk to it properly. Kill the server and return failure
2538 stopserver($server, "$ntelpid $pid2");
2539 displaylogs($testnumcheck);
2540 $doesntrun{$pidfile} = 1;
2546 logmsg "RUN: $srvrname server is now running PID $ntelpid\n";
2551 return ($ntelpid, $pid2);
2555 #######################################################################
2556 # Single shot http and gopher server responsiveness test. This should only
2557 # be used to verify that a server present in %run hash is still functional
2559 sub responsive_http_server {
2560 my ($proto, $verbose, $alt, $port_or_path) = @_;
2565 if($alt eq "ipv6") {
2566 # if IPv6, use a different setup
2570 elsif($alt eq "proxy") {
2573 elsif($alt eq "unix") {
2574 # IP (protocol) is mutually exclusive with Unix sockets
2578 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
2581 #######################################################################
2582 # Single shot pingpong server responsiveness test. This should only be
2583 # used to verify that a server present in %run hash is still functional
2585 sub responsive_pingpong_server {
2586 my ($proto, $id, $verbose, $ipv6) = @_;
2588 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
2589 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
2590 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2592 if($proto eq "ftp") {
2593 $port = ($idnum>1)?$FTP2PORT:$FTPPORT;
2596 # if IPv6, use a different setup
2600 elsif($proto eq "pop3") {
2601 $port = ($ipvnum==6) ? $POP36PORT : $POP3PORT;
2603 elsif($proto eq "imap") {
2604 $port = ($ipvnum==6) ? $IMAP6PORT : $IMAPPORT;
2606 elsif($proto eq "smtp") {
2607 $port = ($ipvnum==6) ? $SMTP6PORT : $SMTPPORT;
2610 print STDERR "Unsupported protocol $proto!!\n";
2614 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2617 #######################################################################
2618 # Single shot rtsp server responsiveness test. This should only be
2619 # used to verify that a server present in %run hash is still functional
2621 sub responsive_rtsp_server {
2622 my ($verbose, $ipv6) = @_;
2623 my $port = $RTSPPORT;
2630 # if IPv6, use a different setup
2636 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2639 #######################################################################
2640 # Single shot tftp server responsiveness test. This should only be
2641 # used to verify that a server present in %run hash is still functional
2643 sub responsive_tftp_server {
2644 my ($id, $verbose, $ipv6) = @_;
2645 my $port = $TFTPPORT;
2649 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2652 # if IPv6, use a different setup
2658 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2661 #######################################################################
2662 # Single shot non-stunnel HTTP TLS extensions capable server
2663 # responsiveness test. This should only be used to verify that a
2664 # server present in %run hash is still functional
2666 sub responsive_httptls_server {
2667 my ($verbose, $ipv6) = @_;
2668 my $proto = "httptls";
2669 my $port = ($ipv6 && ($ipv6 =~ /6$/)) ? $HTTPTLS6PORT : $HTTPTLSPORT;
2670 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
2671 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
2674 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2677 #######################################################################
2678 # Remove all files in the specified directory
2686 opendir(DIR, $dir) ||
2687 return 0; # can't open dir
2688 while($file = readdir(DIR)) {
2689 if($file !~ /^\./) {
2690 unlink("$dir/$file");
2698 #######################################################################
2699 # compare test results with the expected output, we might filter off
2700 # some pattern that is allowed to differ, output test results
2703 my ($testnum, $testname, $subject, $firstref, $secondref)=@_;
2705 my $result = compareparts($firstref, $secondref);
2708 # timestamp test result verification end
2709 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
2712 logmsg "\n $testnum: $subject FAILED:\n";
2713 logmsg showdiff($LOGDIR, $firstref, $secondref);
2715 elsif(!$automakestyle) {
2720 logmsg "FAIL: $testnum - $testname - $subject\n";
2726 #######################################################################
2727 # display information about curl and the host the test suite runs on
2731 unlink($memdump); # remove this if there was one left
2740 my $curlverout="$LOGDIR/curlverout.log";
2741 my $curlvererr="$LOGDIR/curlvererr.log";
2742 my $versioncmd="$CURL --version 1>$curlverout 2>$curlvererr";
2744 unlink($curlverout);
2745 unlink($curlvererr);
2747 $versretval = runclient($versioncmd);
2750 open(VERSOUT, "<$curlverout");
2751 @version = <VERSOUT>;
2760 $curl =~ s/^(.*)(libcurl.*)/$1/g;
2763 if($curl =~ /linux|bsd|solaris|darwin/) {
2766 if($curl =~ /win32|mingw(32|64)/) {
2767 # This is a Windows MinGW build or native build, we need to use
2769 $pwd = pathhelp::sys_native_current_path();
2771 if ($libcurl =~ /winssl/i) {
2775 elsif ($libcurl =~ /openssl/i) {
2780 elsif ($libcurl =~ /gnutls/i) {
2785 elsif ($libcurl =~ /nss/i) {
2790 elsif ($libcurl =~ /(yassl|wolfssl)/i) {
2795 elsif ($libcurl =~ /polarssl/i) {
2800 elsif ($libcurl =~ /axtls/i) {
2804 elsif ($libcurl =~ /securetransport/i) {
2807 $ssllib="DarwinSSL";
2809 elsif ($libcurl =~ /BoringSSL/i) {
2812 $ssllib="BoringSSL";
2814 elsif ($libcurl =~ /libressl/i) {
2819 elsif ($libcurl =~ /mbedTLS/i) {
2824 if ($libcurl =~ /ares/i) {
2829 elsif($_ =~ /^Protocols: (.*)/i) {
2830 # these are the protocols compiled in to this libcurl
2831 @protocols = split(' ', lc($1));
2833 # Generate a "proto-ipv6" version of each protocol to match the
2834 # IPv6 <server> name and a "proto-unix" to match the variant which
2835 # uses Unix domain sockets. This works even if support isn't
2836 # compiled in because the <features> test will fail.
2837 push @protocols, map(("$_-ipv6", "$_-unix"), @protocols);
2839 # 'http-proxy' is used in test cases to do CONNECT through
2840 push @protocols, 'http-proxy';
2842 # 'http-pipe' is the special server for testing pipelining
2843 push @protocols, 'http-pipe';
2845 # 'none' is used in test cases to mean no server
2846 push @protocols, 'none';
2848 elsif($_ =~ /^Features: (.*)/i) {
2850 if($feat =~ /TrackMemory/i) {
2851 # built with memory tracking support (--enable-curldebug)
2852 $has_memory_tracking = 1;
2854 if($feat =~ /debug/i) {
2855 # curl was built with --enable-debug
2858 if($feat =~ /SSL/i) {
2862 if($feat =~ /MultiSSL/i) {
2863 # multiple ssl backends available.
2866 if($feat =~ /Largefile/i) {
2867 # large file support
2870 if($feat =~ /IDN/i) {
2874 if($feat =~ /IPv6/i) {
2877 if($feat =~ /UnixSockets/i) {
2880 if($feat =~ /libz/i) {
2883 if($feat =~ /NTLM/i) {
2887 # Use this as a proxy for any cryptographic authentication
2890 if($feat =~ /NTLM_WB/i) {
2891 # NTLM delegation to winbind daemon ntlm_auth helper enabled
2894 if($feat =~ /SSPI/i) {
2898 if($feat =~ /GSS-API/i) {
2902 if($feat =~ /Kerberos/i) {
2906 # Use this as a proxy for any cryptographic authentication
2909 if($feat =~ /SPNEGO/i) {
2913 # Use this as a proxy for any cryptographic authentication
2916 if($feat =~ /CharConv/i) {
2920 if($feat =~ /TLS-SRP/i) {
2924 if($feat =~ /Metalink/i) {
2928 if($feat =~ /PSL/i) {
2932 if($feat =~ /AsynchDNS/i) {
2934 # this means threaded resolver
2936 $resolver="threaded";
2939 if($feat =~ /HTTP2/) {
2943 push @protocols, 'http/2';
2947 # Test harness currently uses a non-stunnel server in order to
2948 # run HTTP TLS-SRP tests required when curl is built with https
2949 # protocol support and TLS-SRP feature enabled. For convenience
2950 # 'httptls' may be included in the test harness protocols array
2951 # to differentiate this from classic stunnel based 'https' test
2957 if($_ =~ /^https(-ipv6|)$/) {
2962 if($add_httptls && (! grep /^httptls$/, @protocols)) {
2963 push @protocols, 'httptls';
2964 push @protocols, 'httptls-ipv6';
2969 logmsg "unable to get curl's version, further details are:\n";
2970 logmsg "issued command: \n";
2971 logmsg "$versioncmd \n";
2972 if ($versretval == -1) {
2973 logmsg "command failed with: \n";
2974 logmsg "$versnoexec \n";
2976 elsif ($versretval & 127) {
2977 logmsg sprintf("command died with signal %d, and %s coredump.\n",
2978 ($versretval & 127), ($versretval & 128)?"a":"no");
2981 logmsg sprintf("command exited with value %d \n", $versretval >> 8);
2983 logmsg "contents of $curlverout: \n";
2984 displaylogcontent("$curlverout");
2985 logmsg "contents of $curlvererr: \n";
2986 displaylogcontent("$curlvererr");
2987 die "couldn't get curl's version";
2990 if(-r "../lib/curl_config.h") {
2991 open(CONF, "<../lib/curl_config.h");
2993 if($_ =~ /^\#define HAVE_GETRLIMIT/) {
3001 # client has IPv6 support
3003 # check if the HTTP server has it!
3004 my @sws = `server/sws --version`;
3005 if($sws[0] =~ /IPv6/) {
3006 # HTTP server has IPv6 support!
3011 # check if the FTP server has it!
3012 @sws = `server/sockfilt --version`;
3013 if($sws[0] =~ /IPv6/) {
3014 # FTP server has IPv6 support!
3020 # client has Unix sockets support, check whether the HTTP server has it
3021 my @sws = `server/sws --version`;
3022 $http_unix = 1 if($sws[0] =~ /unix/);
3025 if(!$has_memory_tracking && $torture) {
3026 die "can't run torture tests since curl was built without ".
3027 "TrackMemory feature (--enable-curldebug)";
3030 $has_shared = `sh $CURLCONFIG --built-shared`;
3033 my $hostname=join(' ', runclientoutput("hostname"));
3034 my $hosttype=join(' ', runclientoutput("uname -a"));
3036 logmsg ("********* System characteristics ******** \n",
3039 "* Features: $feat\n",
3040 "* Host: $hostname",
3041 "* System: $hosttype");
3043 if($has_memory_tracking && $has_threadedres) {
3044 $has_memory_tracking = 0;
3046 "*** DISABLES memory tracking when using threaded resolver\n",
3050 logmsg sprintf("* Servers: %s", $stunnel?"SSL ":"");
3051 logmsg sprintf("%s", $http_ipv6?"HTTP-IPv6 ":"");
3052 logmsg sprintf("%s", $http_unix?"HTTP-unix ":"");
3053 logmsg sprintf("%s\n", $ftp_ipv6?"FTP-IPv6 ":"");
3055 logmsg sprintf("* Env: %s%s", $valgrind?"Valgrind ":"",
3056 $run_event_based?"event-based ":"");
3057 logmsg sprintf("%s\n", $libtool?"Libtool ":"");
3060 logmsg "* Ports:\n";
3062 logmsg sprintf("* HTTP/%d ", $HTTPPORT);
3063 logmsg sprintf("FTP/%d ", $FTPPORT);
3064 logmsg sprintf("FTP2/%d ", $FTP2PORT);
3065 logmsg sprintf("RTSP/%d ", $RTSPPORT);
3067 logmsg sprintf("FTPS/%d ", $FTPSPORT);
3068 logmsg sprintf("HTTPS/%d ", $HTTPSPORT);
3070 logmsg sprintf("\n* TFTP/%d ", $TFTPPORT);
3072 logmsg sprintf("HTTP-IPv6/%d ", $HTTP6PORT);
3073 logmsg sprintf("RTSP-IPv6/%d ", $RTSP6PORT);
3076 logmsg sprintf("FTP-IPv6/%d ", $FTP6PORT);
3079 logmsg sprintf("TFTP-IPv6/%d ", $TFTP6PORT);
3081 logmsg sprintf("\n* GOPHER/%d ", $GOPHERPORT);
3083 logmsg sprintf("GOPHER-IPv6/%d", $GOPHER6PORT);
3085 logmsg sprintf("\n* SSH/%d ", $SSHPORT);
3086 logmsg sprintf("SOCKS/%d ", $SOCKSPORT);
3087 logmsg sprintf("POP3/%d ", $POP3PORT);
3088 logmsg sprintf("IMAP/%d ", $IMAPPORT);
3089 logmsg sprintf("SMTP/%d\n", $SMTPPORT);
3091 logmsg sprintf("* POP3-IPv6/%d ", $POP36PORT);
3092 logmsg sprintf("IMAP-IPv6/%d ", $IMAP6PORT);
3093 logmsg sprintf("SMTP-IPv6/%d\n", $SMTP6PORT);
3096 logmsg sprintf("* HTTPTLS/%d ", $HTTPTLSPORT);
3098 logmsg sprintf("HTTPTLS-IPv6/%d ", $HTTPTLS6PORT);
3102 logmsg sprintf("* HTTP-PIPE/%d \n", $HTTPPIPEPORT);
3105 logmsg "* Unix socket paths:\n";
3107 logmsg sprintf("* HTTP-Unix:%s\n", $HTTPUNIXPATH);
3111 $has_textaware = ($^O eq 'MSWin32') || ($^O eq 'msys');
3113 logmsg "***************************************** \n";
3116 #######################################################################
3117 # substitute the variable stuff into either a joined up file or
3118 # a command, in either case passed by reference
3125 $$thing =~ s/%FTP6PORT/$FTP6PORT/g;
3126 $$thing =~ s/%FTP2PORT/$FTP2PORT/g;
3127 $$thing =~ s/%FTPSPORT/$FTPSPORT/g;
3128 $$thing =~ s/%FTPPORT/$FTPPORT/g;
3130 $$thing =~ s/%GOPHER6PORT/$GOPHER6PORT/g;
3131 $$thing =~ s/%GOPHERPORT/$GOPHERPORT/g;
3133 $$thing =~ s/%HTTPTLS6PORT/$HTTPTLS6PORT/g;
3134 $$thing =~ s/%HTTPTLSPORT/$HTTPTLSPORT/g;
3135 $$thing =~ s/%HTTP6PORT/$HTTP6PORT/g;
3136 $$thing =~ s/%HTTPSPORT/$HTTPSPORT/g;
3137 $$thing =~ s/%HTTP2PORT/$HTTP2PORT/g;
3138 $$thing =~ s/%HTTPPORT/$HTTPPORT/g;
3139 $$thing =~ s/%HTTPPIPEPORT/$HTTPPIPEPORT/g;
3140 $$thing =~ s/%PROXYPORT/$HTTPPROXYPORT/g;
3142 $$thing =~ s/%IMAP6PORT/$IMAP6PORT/g;
3143 $$thing =~ s/%IMAPPORT/$IMAPPORT/g;
3145 $$thing =~ s/%POP36PORT/$POP36PORT/g;
3146 $$thing =~ s/%POP3PORT/$POP3PORT/g;
3148 $$thing =~ s/%RTSP6PORT/$RTSP6PORT/g;
3149 $$thing =~ s/%RTSPPORT/$RTSPPORT/g;
3151 $$thing =~ s/%SMTP6PORT/$SMTP6PORT/g;
3152 $$thing =~ s/%SMTPPORT/$SMTPPORT/g;
3154 $$thing =~ s/%SOCKSPORT/$SOCKSPORT/g;
3155 $$thing =~ s/%SSHPORT/$SSHPORT/g;
3157 $$thing =~ s/%TFTP6PORT/$TFTP6PORT/g;
3158 $$thing =~ s/%TFTPPORT/$TFTPPORT/g;
3160 $$thing =~ s/%DICTPORT/$DICTPORT/g;
3162 $$thing =~ s/%SMBPORT/$SMBPORT/g;
3163 $$thing =~ s/%SMBSPORT/$SMBSPORT/g;
3165 $$thing =~ s/%NEGTELNETPORT/$NEGTELNETPORT/g;
3167 # server Unix domain socket paths
3169 $$thing =~ s/%HTTPUNIXPATH/$HTTPUNIXPATH/g;
3171 # client IP addresses
3173 $$thing =~ s/%CLIENT6IP/$CLIENT6IP/g;
3174 $$thing =~ s/%CLIENTIP/$CLIENTIP/g;
3176 # server IP addresses
3178 $$thing =~ s/%HOST6IP/$HOST6IP/g;
3179 $$thing =~ s/%HOSTIP/$HOSTIP/g;
3183 $$thing =~ s/%CURL/$CURL/g;
3184 $$thing =~ s/%PWD/$pwd/g;
3185 $$thing =~ s/%SRCDIR/$srcdir/g;
3186 $$thing =~ s/%USER/$USER/g;
3188 # The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be
3189 # used for time-out tests and that whould work on most hosts as these
3190 # adjust for the startup/check time for this particular host. We needed
3191 # to do this to make the test suite run better on very slow hosts.
3193 my $ftp2 = $ftpchecktime * 2;
3194 my $ftp3 = $ftpchecktime * 3;
3196 $$thing =~ s/%FTPTIME2/$ftp2/g;
3197 $$thing =~ s/%FTPTIME3/$ftp3/g;
3201 $$thing =~ s/%H2CVER/$h2cver/g;
3213 #######################################################################
3214 # Provide time stamps for single test skipped events
3216 sub timestampskippedevents {
3217 my $testnum = $_[0];
3219 return if((not defined($testnum)) || ($testnum < 1));
3223 if($timevrfyend{$testnum}) {
3226 elsif($timesrvrlog{$testnum}) {
3227 $timevrfyend{$testnum} = $timesrvrlog{$testnum};
3230 elsif($timetoolend{$testnum}) {
3231 $timevrfyend{$testnum} = $timetoolend{$testnum};
3232 $timesrvrlog{$testnum} = $timetoolend{$testnum};
3234 elsif($timetoolini{$testnum}) {
3235 $timevrfyend{$testnum} = $timetoolini{$testnum};
3236 $timesrvrlog{$testnum} = $timetoolini{$testnum};
3237 $timetoolend{$testnum} = $timetoolini{$testnum};
3239 elsif($timesrvrend{$testnum}) {
3240 $timevrfyend{$testnum} = $timesrvrend{$testnum};
3241 $timesrvrlog{$testnum} = $timesrvrend{$testnum};
3242 $timetoolend{$testnum} = $timesrvrend{$testnum};
3243 $timetoolini{$testnum} = $timesrvrend{$testnum};
3245 elsif($timesrvrini{$testnum}) {
3246 $timevrfyend{$testnum} = $timesrvrini{$testnum};
3247 $timesrvrlog{$testnum} = $timesrvrini{$testnum};
3248 $timetoolend{$testnum} = $timesrvrini{$testnum};
3249 $timetoolini{$testnum} = $timesrvrini{$testnum};
3250 $timesrvrend{$testnum} = $timesrvrini{$testnum};
3252 elsif($timeprepini{$testnum}) {
3253 $timevrfyend{$testnum} = $timeprepini{$testnum};
3254 $timesrvrlog{$testnum} = $timeprepini{$testnum};
3255 $timetoolend{$testnum} = $timeprepini{$testnum};
3256 $timetoolini{$testnum} = $timeprepini{$testnum};
3257 $timesrvrend{$testnum} = $timeprepini{$testnum};
3258 $timesrvrini{$testnum} = $timeprepini{$testnum};
3263 #######################################################################
3264 # Run a single specified test case
3267 my ($evbased, # 1 means switch on if possible (and "curl" is tested)
3268 # returns "not a test" if it can't be used for this test
3277 my $disablevalgrind;
3279 # copy test number to a global scope var, this allows
3280 # testnum checking when starting test harness servers.
3281 $testnumcheck = $testnum;
3283 # timestamp test preparation start
3284 $timeprepini{$testnum} = Time::HiRes::time() if($timestats);
3286 if($disttests !~ /test$testnum\W/ ) {
3287 logmsg "Warning: test$testnum not present in tests/data/Makefile.inc\n";
3289 if($disabled{$testnum}) {
3290 logmsg "Warning: test$testnum is explicitly disabled\n";
3293 # load the test case file definition
3294 if(loadtest("${TESTDIR}/test${testnum}")) {
3296 # this is not a test
3297 logmsg "RUN: $testnum doesn't look like a test case\n";
3302 @what = getpart("client", "features");
3305 # We require a feature to be present
3310 if($f =~ /^([^!].*)$/) {
3311 # Store the feature for later
3319 elsif($1 eq "MultiSSL") {
3324 elsif($1 eq "SSLpinning") {
3325 if($has_sslpinning) {
3329 elsif($1 eq "OpenSSL") {
3334 elsif($1 eq "GnuTLS") {
3339 elsif($1 eq "NSS") {
3344 elsif($1 eq "axTLS") {
3349 elsif($1 eq "WinSSL") {
3354 elsif($1 eq "DarwinSSL") {
3355 if($has_darwinssl) {
3359 elsif($1 eq "ld_preload") {
3360 if($has_ldpreload && !$debug_build) {
3364 elsif($1 eq "unittest") {
3369 elsif($1 eq "debug") {
3374 elsif($1 eq "TrackMemory") {
3375 if($has_memory_tracking) {
3379 elsif($1 eq "large_file") {
3380 if($has_largefile) {
3384 elsif($1 eq "idn") {
3389 elsif($1 eq "ipv6") {
3394 elsif($1 eq "libz") {
3399 elsif($1 eq "NTLM") {
3404 elsif($1 eq "NTLM_WB") {
3409 elsif($1 eq "SSPI") {
3414 elsif($1 eq "GSS-API") {
3419 elsif($1 eq "Kerberos") {
3424 elsif($1 eq "SPNEGO") {
3429 elsif($1 eq "getrlimit") {
3430 if($has_getrlimit) {
3434 elsif($1 eq "crypto") {
3439 elsif($1 eq "TLS-SRP") {
3444 elsif($1 eq "Metalink") {
3449 elsif($1 eq "http/2") {
3454 elsif($1 eq "threaded-resolver") {
3455 if($has_threadedres) {
3459 elsif($1 eq "PSL") {
3464 elsif($1 eq "socks") {
3467 elsif($1 eq "unix-sockets") {
3470 # See if this "feature" is in the list of supported protocols
3471 elsif (grep /^\Q$1\E$/i, @protocols) {
3475 $why = "curl lacks $1 support";
3480 # We require a feature to not be present
3486 if($f =~ /^!(.*)$/) {
3492 elsif($1 eq "MultiSSL") {
3493 if(!$has_multissl) {
3497 elsif($1 eq "OpenSSL") {
3502 elsif($1 eq "GnuTLS") {
3507 elsif($1 eq "NSS") {
3512 elsif($1 eq "axTLS") {
3517 elsif($1 eq "WinSSL") {
3522 elsif($1 eq "DarwinSSL") {
3523 if(!$has_darwinssl) {
3527 elsif($1 eq "TrackMemory") {
3528 if(!$has_memory_tracking) {
3532 elsif($1 eq "large_file") {
3533 if(!$has_largefile) {
3537 elsif($1 eq "idn") {
3542 elsif($1 eq "ipv6") {
3547 elsif($1 eq "unix-sockets") {
3550 elsif($1 eq "libz") {
3555 elsif($1 eq "NTLM") {
3560 elsif($1 eq "NTLM_WB") {
3565 elsif($1 eq "SSPI") {
3570 elsif($1 eq "GSS-API") {
3575 elsif($1 eq "Kerberos") {
3576 if(!$has_kerberos) {
3580 elsif($1 eq "SPNEGO") {
3585 elsif($1 eq "getrlimit") {
3586 if(!$has_getrlimit) {
3590 elsif($1 eq "crypto") {
3595 elsif($1 eq "TLS-SRP") {
3600 elsif($1 eq "Metalink") {
3601 if(!$has_metalink) {
3605 elsif($1 eq "PSL") {
3610 elsif($1 eq "threaded-resolver") {
3611 if(!$has_threadedres) {
3623 $why = "curl has $1 support";
3629 my @keywords = getpart("info", "keywords");
3634 $why = "missing the <keywords> section!";
3637 for $k (@keywords) {
3639 if ($disabled_keywords{lc($k)}) {
3640 $why = "disabled by keyword";
3641 } elsif ($enabled_keywords{lc($k)}) {
3646 if(!$why && !$match && %enabled_keywords) {
3647 $why = "disabled by missing keyword";
3651 # test definition may instruct to (un)set environment vars
3652 # this is done this early, so that the precheck can use environment
3653 # variables and still bail out fine on errors
3655 # restore environment variables that were modified in a previous run
3656 foreach my $var (keys %oldenv) {
3657 if($oldenv{$var} eq 'notset') {
3658 delete $ENV{$var} if($ENV{$var});
3661 $ENV{$var} = $oldenv{$var};
3663 delete $oldenv{$var};
3666 # remove test server commands file before servers are started/verified
3667 unlink($FTPDCMD) if(-f $FTPDCMD);
3669 # timestamp required servers verification start
3670 $timesrvrini{$testnum} = Time::HiRes::time() if($timestats);
3673 $why = serverfortest($testnum);
3676 # timestamp required servers verification end
3677 $timesrvrend{$testnum} = Time::HiRes::time() if($timestats);
3679 my @setenv = getpart("client", "setenv");
3681 foreach my $s (@setenv) {
3684 if($s =~ /([^=]*)=(.*)/) {
3685 my ($var, $content) = ($1, $2);
3686 # remember current setting, to restore it once test runs
3687 $oldenv{$var} = ($ENV{$var})?"$ENV{$var}":'notset';
3690 delete $ENV{$var} if($ENV{$var});
3693 if($var =~ /^LD_PRELOAD/) {
3694 if(exe_ext() && (exe_ext() eq '.exe')) {
3695 # print "Skipping LD_PRELOAD due to lack of OS support\n";
3698 if($debug_build || ($has_shared ne "yes")) {
3699 # print "Skipping LD_PRELOAD due to no release shared build\n";
3703 $ENV{$var} = "$content";
3710 my @precheck = getpart("client", "precheck");
3712 $cmd = $precheck[0];
3716 my @p = split(/ /, $cmd);
3718 # the first word, the command, does not contain a slash so
3719 # we will scan the "improved" PATH to find the command to
3721 my $fullp = checktestcmd($p[0]);
3726 $cmd = join(" ", @p);
3729 my @o = `$cmd 2>/dev/null`;
3734 $why = "precheck command error";
3736 logmsg "prechecked $cmd\n" if($verbose);
3741 if($why && !$listonly) {
3742 # there's a problem, count it as "skipped"
3745 $teststat[$testnum]=$why; # store reason for this test case
3748 if($skipped{$why} <= 3) {
3749 # show only the first three skips for each reason
3750 logmsg sprintf("test %04d SKIPPED: $why\n", $testnum);
3754 timestampskippedevents($testnum);
3757 logmsg sprintf("test %04d...", $testnum) if(!$automakestyle);
3759 my %replyattr = getpartattr("reply", "data");
3761 if (partexists("reply", "datacheck")) {
3762 for my $partsuffix (('', '1', '2', '3', '4')) {
3763 my @replycheckpart = getpart("reply", "datacheck".$partsuffix);
3764 if(@replycheckpart) {
3765 my %replycheckpartattr = getpartattr("reply", "datacheck".$partsuffix);
3766 # get the mode attribute
3767 my $filemode=$replycheckpartattr{'mode'};
3768 if($filemode && ($filemode eq "text") && $has_textaware) {
3769 # text mode when running on windows: fix line endings
3770 map s/\r\n/\n/g, @replycheckpart;
3771 map s/\n/\r\n/g, @replycheckpart;
3773 if($replycheckpartattr{'nonewline'}) {
3774 # Yes, we must cut off the final newline from the final line
3776 chomp($replycheckpart[$#replycheckpart]);
3778 push(@reply, @replycheckpart);
3783 # check against the data section
3784 @reply = getpart("reply", "data");
3785 # get the mode attribute
3786 my $filemode=$replyattr{'mode'};
3787 if($filemode && ($filemode eq "text") && $has_textaware) {
3788 # text mode when running on windows: fix line endings
3789 map s/\r\n/\n/g, @reply;
3790 map s/\n/\r\n/g, @reply;
3794 # this is the valid protocol blurb curl should generate
3795 my @protocol= fixarray ( getpart("verify", "protocol") );
3797 # this is the valid protocol blurb curl should generate to a proxy
3798 my @proxyprot = fixarray ( getpart("verify", "proxy") );
3800 # redirected stdout/stderr to these files
3801 $STDOUT="$LOGDIR/stdout$testnum";
3802 $STDERR="$LOGDIR/stderr$testnum";
3804 # if this section exists, we verify that the stdout contained this:
3805 my @validstdout = fixarray ( getpart("verify", "stdout") );
3807 # if this section exists, we verify upload
3808 my @upload = getpart("verify", "upload");
3810 my %hash = getpartattr("verify", "upload");
3811 if($hash{'nonewline'}) {
3812 # cut off the final newline from the final line of the upload data
3813 chomp($upload[$#upload]);
3817 # if this section exists, it might be FTP server instructions:
3818 my @ftpservercmd = getpart("reply", "servercmd");
3820 my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout
3823 my @testname= getpart("client", "name");
3824 my $testname = $testname[0];
3825 $testname =~ s/\n//g;
3826 logmsg "[$testname]\n" if(!$short);
3829 timestampskippedevents($testnum);
3830 return 0; # look successful
3833 my @codepieces = getpart("client", "tool");
3837 $tool = $codepieces[0];
3841 # remove server output logfile
3847 # write the instructions to file
3848 writearray($FTPDCMD, \@ftpservercmd);
3851 # get the command line options to use
3853 ($cmd, @blaha)= getpart("client", "command");
3856 # make some nice replace operations
3857 $cmd =~ s/\n//g; # no newlines please
3858 # substitute variables in the command line
3862 # there was no command given, use something silly
3865 if($has_memory_tracking) {
3869 # create (possibly-empty) files before starting the test
3870 for my $partsuffix (('', '1', '2', '3', '4')) {
3871 my @inputfile=getpart("client", "file".$partsuffix);
3872 my %fileattr = getpartattr("client", "file".$partsuffix);
3873 my $filename=$fileattr{'name'};
3874 if(@inputfile || $filename) {
3876 logmsg "ERROR: section client=>file has no name attribute\n";
3877 timestampskippedevents($testnum);
3880 my $fileContent = join('', @inputfile);
3881 subVariables \$fileContent;
3882 # logmsg "DEBUG: writing file " . $filename . "\n";
3883 open(OUTFILE, ">$filename");
3884 binmode OUTFILE; # for crapage systems, use binary
3885 print OUTFILE $fileContent;
3890 my %cmdhash = getpartattr("client", "command");
3894 if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-output/)) {
3895 #We may slap on --output!
3896 if (!@validstdout) {
3897 $out=" --output $CURLOUT ";
3901 my $serverlogslocktimeout = $defserverlogslocktimeout;
3902 if($cmdhash{'timeout'}) {
3903 # test is allowed to override default server logs lock timeout
3904 if($cmdhash{'timeout'} =~ /(\d+)/) {
3905 $serverlogslocktimeout = $1 if($1 >= 0);
3909 my $postcommanddelay = $defpostcommanddelay;
3910 if($cmdhash{'delay'}) {
3911 # test is allowed to specify a delay after command is executed
3912 if($cmdhash{'delay'} =~ /(\d+)/) {
3913 $postcommanddelay = $1 if($1 > 0);
3919 my $cmdtype = $cmdhash{'type'} || "default";
3920 my $fail_due_event_based = $evbased;
3921 if($cmdtype eq "perl") {
3922 # run the command line prepended with "perl"
3928 elsif($cmdtype eq "shell") {
3929 # run the command line prepended with "/bin/sh"
3931 $CMDLINE = "/bin/sh ";
3936 # run curl, add suitable command line options
3937 $cmd = "-1 ".$cmd if(exists $feature{"SSL"} && ($has_axtls));
3940 if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-include/)) {
3941 $inc = " --include";
3944 $cmdargs = "$out$inc ";
3945 $cmdargs .= "--trace-ascii log/trace$testnum ";
3946 $cmdargs .= "--trace-time ";
3948 $cmdargs .= "--test-event ";
3949 $fail_due_event_based--;
3954 $cmdargs = " $cmd"; # $cmd is the command line for the test file
3955 $CURLOUT = $STDOUT; # sends received data to stdout
3957 if($tool =~ /^lib/) {
3958 $CMDLINE="$LIBDIR/$tool";
3960 elsif($tool =~ /^unit/) {
3961 $CMDLINE="$UNITDIR/$tool";
3965 logmsg "The tool set in the test case for this: '$tool' does not exist\n";
3966 timestampskippedevents($testnum);
3973 # gdb is incompatible with valgrind, so disable it when debugging
3974 # Perhaps a better approach would be to run it under valgrind anyway
3975 # with --db-attach=yes or --vgdb=yes.
3979 if($fail_due_event_based) {
3980 logmsg "This test cannot run event based\n";
3984 my @stdintest = getpart("client", "stdin");
3987 my $stdinfile="$LOGDIR/stdin-for-$testnum";
3989 my %hash = getpartattr("client", "stdin");
3990 if($hash{'nonewline'}) {
3991 # cut off the final newline from the final line of the stdin data
3992 chomp($stdintest[$#stdintest]);
3995 writearray($stdinfile, \@stdintest);
3997 $cmdargs .= " <$stdinfile";
4005 if($valgrind && !$disablevalgrind) {
4006 my @valgrindoption = getpart("verify", "valgrind");
4007 if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) {
4009 my $valgrindcmd = "$valgrind ";
4010 $valgrindcmd .= "$valgrind_tool " if($valgrind_tool);
4011 $valgrindcmd .= "--quiet --leak-check=yes ";
4012 $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp ";
4013 # $valgrindcmd .= "--gen-suppressions=all ";
4014 $valgrindcmd .= "--num-callers=16 ";
4015 $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum";
4016 $CMDLINE = "$valgrindcmd $CMDLINE";
4020 $CMDLINE .= "$cmdargs >$STDOUT 2>$STDERR";
4023 logmsg "$CMDLINE\n";
4026 print CMDLOG "$CMDLINE\n";
4034 my $gdbinit = "$TESTDIR/gdbinit$testnum";
4035 open(GDBCMD, ">$LOGDIR/gdbcmd");
4036 print GDBCMD "set args $cmdargs\n";
4037 print GDBCMD "show args\n";
4038 print GDBCMD "source $gdbinit\n" if -e $gdbinit;
4042 # timestamp starting of test command
4043 $timetoolini{$testnum} = Time::HiRes::time() if($timestats);
4045 # run the command line we built
4047 $cmdres = torture($CMDLINE,
4049 "$gdb --directory libtest $DBGCURL -x $LOGDIR/gdbcmd");
4052 my $GDBW = ($gdbxwin) ? "-w" : "";
4053 runclient("$gdb --directory libtest $DBGCURL $GDBW -x $LOGDIR/gdbcmd");
4054 $cmdres=0; # makes it always continue after a debugged run
4057 $cmdres = runclient("$CMDLINE");
4058 my $signal_num = $cmdres & 127;
4059 $dumped_core = $cmdres & 128;
4061 if(!$anyway && ($signal_num || $dumped_core)) {
4066 $cmdres = (2000 + $signal_num) if($signal_num && !$cmdres);
4070 # timestamp finishing of test command
4071 $timetoolend{$testnum} = Time::HiRes::time() if($timestats);
4075 # there's core file present now!
4081 logmsg "core dumped\n";
4083 logmsg "running gdb for post-mortem analysis:\n";
4084 open(GDBCMD, ">$LOGDIR/gdbcmd2");
4085 print GDBCMD "bt\n";
4087 runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch $DBGCURL core ");
4088 # unlink("$LOGDIR/gdbcmd2");
4092 # If a server logs advisor read lock file exists, it is an indication
4093 # that the server has not yet finished writing out all its log files,
4094 # including server request log files used for protocol verification.
4095 # So, if the lock file exists the script waits here a certain amount
4096 # of time until the server removes it, or the given time expires.
4098 if($serverlogslocktimeout) {
4099 my $lockretry = $serverlogslocktimeout * 20;
4100 while((-f $SERVERLOGS_LOCK) && $lockretry--) {
4101 select(undef, undef, undef, 0.05);
4103 if(($lockretry < 0) &&
4104 ($serverlogslocktimeout >= $defserverlogslocktimeout)) {
4105 logmsg "Warning: server logs lock timeout ",
4106 "($serverlogslocktimeout seconds) expired\n";
4110 # Test harness ssh server does not have this synchronization mechanism,
4111 # this implies that some ssh server based tests might need a small delay
4112 # once that the client command has run to avoid false test failures.
4114 # gnutls-serv also lacks this synchronization mechanism, so gnutls-serv
4115 # based tests might need a small delay once that the client command has
4116 # run to avoid false test failures.
4118 sleep($postcommanddelay) if($postcommanddelay);
4120 # timestamp removal of server logs advisor read lock
4121 $timesrvrlog{$testnum} = Time::HiRes::time() if($timestats);
4123 # test definition might instruct to stop some servers
4124 # stop also all servers relative to the given one
4126 my @killtestservers = getpart("client", "killserver");
4127 if(@killtestservers) {
4129 # All servers relative to the given one must be stopped also
4132 foreach my $server (@killtestservers) {
4134 if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
4135 # given a stunnel ssl server, also kill non-ssl underlying one
4136 push @killservers, "${1}${2}";
4138 elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|-unix|))$/) {
4139 # given a non-ssl server, also kill stunnel piggybacking one
4140 push @killservers, "${1}s${2}";
4142 elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
4143 # given a socks server, also kill ssh underlying one
4144 push @killservers, "ssh${2}";
4146 elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
4147 # given a ssh server, also kill socks piggybacking one
4148 push @killservers, "socks${2}";
4150 push @killservers, $server;
4153 # kill sockfilter processes for pingpong relative servers
4155 foreach my $server (@killservers) {
4156 if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
4158 my $idnum = ($2 && ($2 > 1)) ? $2 : 1;
4159 my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
4160 killsockfilters($proto, $ipvnum, $idnum, $verbose);
4164 # kill server relative pids clearing them in %run hash
4167 foreach my $server (@killservers) {
4169 $pidlist .= "$run{$server} ";
4172 $runcert{$server} = 0 if($runcert{$server});
4174 killpid($verbose, $pidlist);
4176 # cleanup server pid files
4178 foreach my $server (@killservers) {
4179 my $pidfile = $serverpidfile{$server};
4180 my $pid = processexists($pidfile);
4182 logmsg "Warning: $server server unexpectedly alive\n";
4183 killpid($verbose, $pid);
4185 unlink($pidfile) if(-f $pidfile);
4189 # remove the test server commands file after each test
4190 unlink($FTPDCMD) if(-f $FTPDCMD);
4192 # run the postcheck command
4193 my @postcheck= getpart("client", "postcheck");
4195 $cmd = join("", @postcheck);
4199 logmsg "postcheck $cmd\n" if($verbose);
4200 my $rc = runclient("$cmd");
4201 # Must run the postcheck command in torture mode in order
4202 # to clean up, but the result can't be relied upon.
4203 if($rc != 0 && !$torture) {
4204 logmsg " postcheck FAILED\n";
4205 # timestamp test result verification end
4206 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4212 # restore environment variables that were modified
4214 foreach my $var (keys %oldenv) {
4215 if($oldenv{$var} eq 'notset') {
4216 delete $ENV{$var} if($ENV{$var});
4219 $ENV{$var} = "$oldenv{$var}";
4224 # Skip all the verification on torture tests
4226 if(!$cmdres && !$keepoutfiles) {
4229 # timestamp test result verification end
4230 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4234 my @err = getpart("verify", "errorcode");
4235 my $errorcode = $err[0] || "0";
4240 # verify redirected stdout
4241 my @actual = loadarray($STDOUT);
4243 # what parts to cut off from stdout
4244 my @stripfile = getpart("verify", "stripfile");
4246 foreach my $strip (@stripfile) {
4255 # this is to get rid of array entries that vanished (zero
4256 # length) because of replacements
4260 # variable-replace in the stdout we have from the test case file
4261 @validstdout = fixarray(@validstdout);
4263 # get all attributes
4264 my %hash = getpartattr("verify", "stdout");
4266 # get the mode attribute
4267 my $filemode=$hash{'mode'};
4268 if($filemode && ($filemode eq "text") && $has_textaware) {
4269 # text mode when running on windows: fix line endings
4270 map s/\r\n/\n/g, @validstdout;
4271 map s/\n/\r\n/g, @validstdout;
4274 if($hash{'nonewline'}) {
4275 # Yes, we must cut off the final newline from the final line
4276 # of the protocol data
4277 chomp($validstdout[$#validstdout]);
4280 $res = compare($testnum, $testname, "stdout", \@actual, \@validstdout);
4287 $ok .= "-"; # stdout not checked
4291 # Verify the sent request
4292 my @out = loadarray($SERVERIN);
4294 # what to cut off from the live protocol sent by curl
4295 my @strip = getpart("verify", "strip");
4297 my @protstrip=@protocol;
4299 # check if there's any attributes on the verify/protocol section
4300 my %hash = getpartattr("verify", "protocol");
4302 if($hash{'nonewline'}) {
4303 # Yes, we must cut off the final newline from the final line
4304 # of the protocol data
4305 chomp($protstrip[$#protstrip]);
4309 # strip off all lines that match the patterns from both arrays
4311 @out = striparray( $_, \@out);
4312 @protstrip= striparray( $_, \@protstrip);
4315 # what parts to cut off from the protocol
4316 my @strippart = getpart("verify", "strippart");
4318 for $strip (@strippart) {
4325 $res = compare($testnum, $testname, "protocol", \@out, \@protstrip);
4334 $ok .= "-"; # protocol not checked
4337 if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
4338 # verify the received data
4339 my @out = loadarray($CURLOUT);
4340 $res = compare($testnum, $testname, "data", \@out, \@reply);
4347 $ok .= "-"; # data not checked
4351 # verify uploaded data
4352 my @out = loadarray("$LOGDIR/upload.$testnum");
4354 # what parts to cut off from the upload
4355 my @strippart = getpart("verify", "strippart");
4357 for $strip (@strippart) {
4364 $res = compare($testnum, $testname, "upload", \@out, \@upload);
4371 $ok .= "-"; # upload not checked
4375 # Verify the sent proxy request
4376 my @out = loadarray($PROXYIN);
4378 # what to cut off from the live protocol sent by curl, we use the
4379 # same rules as for <protocol>
4380 my @strip = getpart("verify", "strip");
4382 my @protstrip=@proxyprot;
4384 # check if there's any attributes on the verify/protocol section
4385 my %hash = getpartattr("verify", "proxy");
4387 if($hash{'nonewline'}) {
4388 # Yes, we must cut off the final newline from the final line
4389 # of the protocol data
4390 chomp($protstrip[$#protstrip]);
4394 # strip off all lines that match the patterns from both arrays
4396 @out = striparray( $_, \@out);
4397 @protstrip= striparray( $_, \@protstrip);
4400 # what parts to cut off from the protocol
4401 my @strippart = getpart("verify", "strippart");
4403 for $strip (@strippart) {
4410 $res = compare($testnum, $testname, "proxy", \@out, \@protstrip);
4419 $ok .= "-"; # protocol not checked
4423 for my $partsuffix (('', '1', '2', '3', '4')) {
4424 my @outfile=getpart("verify", "file".$partsuffix);
4425 if(@outfile || partexists("verify", "file".$partsuffix) ) {
4426 # we're supposed to verify a dynamically generated file!
4427 my %hash = getpartattr("verify", "file".$partsuffix);
4429 my $filename=$hash{'name'};
4431 logmsg "ERROR: section verify=>file$partsuffix ".
4432 "has no name attribute\n";
4433 stopservers($verbose);
4434 # timestamp test result verification end
4435 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4438 my @generated=loadarray($filename);
4440 # what parts to cut off from the file
4441 my @stripfile = getpart("verify", "stripfile".$partsuffix);
4443 my $filemode=$hash{'mode'};
4444 if($filemode && ($filemode eq "text") && $has_textaware) {
4445 # text mode when running on windows: fix line endings
4446 map s/\r\n/\n/g, @outfile;
4447 map s/\n/\r\n/g, @outfile;
4451 for $strip (@stripfile) {
4460 # this is to get rid of array entries that vanished (zero
4461 # length) because of replacements
4462 @generated = @newgen;
4465 @outfile = fixarray(@outfile);
4467 $res = compare($testnum, $testname, "output ($filename)",
4468 \@generated, \@outfile);
4473 $outputok = 1; # output checked
4476 $ok .= ($outputok) ? "o" : "-"; # output checked or not
4478 # accept multiple comma-separated error codes
4479 my @splerr = split(/ *, */, $errorcode);
4481 foreach my $e (@splerr) {
4494 logmsg sprintf("\n%s returned $cmdres, when expecting %s\n",
4495 (!$tool)?"curl":$tool, $errorcode);
4497 logmsg " exit FAILED\n";
4498 # timestamp test result verification end
4499 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4503 if($has_memory_tracking) {
4505 logmsg "\n** ALERT! memory tracking with no output file?\n"
4506 if(!$cmdtype eq "perl");
4509 my @memdata=`$memanalyze $memdump`;
4513 # well it could be other memory problems as well, but
4514 # we call it leak for short here
4519 logmsg "\n** MEMORY FAILURE\n";
4521 # timestamp test result verification end
4522 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4531 $ok .= "-"; # memory not checked
4536 unless(opendir(DIR, "$LOGDIR")) {
4537 logmsg "ERROR: unable to read $LOGDIR\n";
4538 # timestamp test result verification end
4539 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4542 my @files = readdir(DIR);
4545 foreach my $file (@files) {
4546 if($file =~ /^valgrind$testnum(\..*|)$/) {
4552 logmsg "ERROR: valgrind log file missing for test $testnum\n";
4553 # timestamp test result verification end
4554 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4557 my @e = valgrindparse("$LOGDIR/$vgfile");
4559 if($automakestyle) {
4560 logmsg "FAIL: $testnum - $testname - valgrind\n";
4563 logmsg " valgrind ERROR ";
4566 # timestamp test result verification end
4567 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4573 if(!$short && !$disablevalgrind) {
4574 logmsg " valgrind SKIPPED\n";
4576 $ok .= "-"; # skipped
4580 $ok .= "-"; # valgrind not checked
4582 # add 'E' for event-based
4583 $ok .= $evbased ? "E" : "-";
4585 logmsg "$ok " if(!$short);
4587 my $sofar= time()-$start;
4588 my $esttotal = $sofar/$count * $total;
4589 my $estleft = $esttotal - $sofar;
4590 my $left=sprintf("remaining: %02d:%02d",
4594 if(!$automakestyle) {
4595 logmsg sprintf("OK (%-3d out of %-3d, %s)\n", $count, $total, $left);
4598 logmsg "PASS: $testnum - $testname\n";
4601 # the test succeeded, remove all log files
4602 if(!$keepoutfiles) {
4606 # timestamp test result verification end
4607 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4612 #######################################################################
4613 # Stop all running test servers
4616 my $verbose = $_[0];
4618 # kill sockfilter processes for all pingpong servers
4620 killallsockfilters($verbose);
4622 # kill all server pids from %run hash clearing them
4625 foreach my $server (keys %run) {
4629 my $pids = $run{$server};
4630 foreach my $pid (split(' ', $pids)) {
4632 logmsg sprintf("* kill pid for %s => %d\n",
4638 $pidlist .= "$run{$server} ";
4641 $runcert{$server} = 0 if($runcert{$server});
4643 killpid($verbose, $pidlist);
4645 # cleanup all server pid files
4647 foreach my $server (keys %serverpidfile) {
4648 my $pidfile = $serverpidfile{$server};
4649 my $pid = processexists($pidfile);
4651 logmsg "Warning: $server server unexpectedly alive\n";
4652 killpid($verbose, $pid);
4654 unlink($pidfile) if(-f $pidfile);
4658 #######################################################################
4659 # startservers() starts all the named servers
4661 # Returns: string with error reason or blank for success
4667 my (@whatlist) = split(/\s+/,$_);
4668 my $what = lc($whatlist[0]);
4669 $what =~ s/[^a-z0-9\/-]//g;
4672 if($what =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
4673 $certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem';
4676 if(($what eq "pop3") ||
4678 ($what eq "imap") ||
4679 ($what eq "smtp")) {
4680 if($torture && $run{$what} &&
4681 !responsive_pingpong_server($what, "", $verbose)) {
4685 ($pid, $pid2) = runpingpongserver($what, "", $verbose);
4687 return "failed starting ". uc($what) ." server";
4689 printf ("* pid $what => %d %d\n", $pid, $pid2) if($verbose);
4690 $run{$what}="$pid $pid2";
4693 elsif($what eq "ftp2") {
4694 if($torture && $run{'ftp2'} &&
4695 !responsive_pingpong_server("ftp", "2", $verbose)) {
4699 ($pid, $pid2) = runpingpongserver("ftp", "2", $verbose);
4701 return "failed starting FTP2 server";
4703 printf ("* pid ftp2 => %d %d\n", $pid, $pid2) if($verbose);
4704 $run{'ftp2'}="$pid $pid2";
4707 elsif($what eq "ftp-ipv6") {
4708 if($torture && $run{'ftp-ipv6'} &&
4709 !responsive_pingpong_server("ftp", "", $verbose, "ipv6")) {
4710 stopserver('ftp-ipv6');
4712 if(!$run{'ftp-ipv6'}) {
4713 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose, "ipv6");
4715 return "failed starting FTP-IPv6 server";
4717 logmsg sprintf("* pid ftp-ipv6 => %d %d\n", $pid,
4718 $pid2) if($verbose);
4719 $run{'ftp-ipv6'}="$pid $pid2";
4722 elsif($what eq "gopher") {
4723 if($torture && $run{'gopher'} &&
4724 !responsive_http_server("gopher", $verbose, 0, $GOPHERPORT)) {
4725 stopserver('gopher');
4727 if(!$run{'gopher'}) {
4728 ($pid, $pid2) = runhttpserver("gopher", $verbose, 0,
4731 return "failed starting GOPHER server";
4733 logmsg sprintf ("* pid gopher => %d %d\n", $pid, $pid2)
4735 $run{'gopher'}="$pid $pid2";
4738 elsif($what eq "gopher-ipv6") {
4739 if($torture && $run{'gopher-ipv6'} &&
4740 !responsive_http_server("gopher", $verbose, "ipv6",
4742 stopserver('gopher-ipv6');
4744 if(!$run{'gopher-ipv6'}) {
4745 ($pid, $pid2) = runhttpserver("gopher", $verbose, "ipv6",
4748 return "failed starting GOPHER-IPv6 server";
4750 logmsg sprintf("* pid gopher-ipv6 => %d %d\n", $pid,
4751 $pid2) if($verbose);
4752 $run{'gopher-ipv6'}="$pid $pid2";
4755 elsif($what eq "http/2") {
4756 if(!$run{'http/2'}) {
4757 ($pid, $pid2) = runhttp2server($verbose, $HTTP2PORT);
4759 return "failed starting HTTP/2 server";
4761 logmsg sprintf ("* pid http/2 => %d %d\n", $pid, $pid2)
4763 $run{'http/2'}="$pid $pid2";
4766 elsif($what eq "http") {
4767 if($torture && $run{'http'} &&
4768 !responsive_http_server("http", $verbose, 0, $HTTPPORT)) {
4772 ($pid, $pid2) = runhttpserver("http", $verbose, 0,
4775 return "failed starting HTTP server";
4777 logmsg sprintf ("* pid http => %d %d\n", $pid, $pid2)
4779 $run{'http'}="$pid $pid2";
4782 elsif($what eq "http-proxy") {
4783 if($torture && $run{'http-proxy'} &&
4784 !responsive_http_server("http", $verbose, "proxy",
4786 stopserver('http-proxy');
4788 if(!$run{'http-proxy'}) {
4789 ($pid, $pid2) = runhttpserver("http", $verbose, "proxy",
4792 return "failed starting HTTP-proxy server";
4794 logmsg sprintf ("* pid http-proxy => %d %d\n", $pid, $pid2)
4796 $run{'http-proxy'}="$pid $pid2";
4799 elsif($what eq "http-ipv6") {
4800 if($torture && $run{'http-ipv6'} &&
4801 !responsive_http_server("http", $verbose, "ipv6", $HTTP6PORT)) {
4802 stopserver('http-ipv6');
4804 if(!$run{'http-ipv6'}) {
4805 ($pid, $pid2) = runhttpserver("http", $verbose, "ipv6",
4808 return "failed starting HTTP-IPv6 server";
4810 logmsg sprintf("* pid http-ipv6 => %d %d\n", $pid, $pid2)
4812 $run{'http-ipv6'}="$pid $pid2";
4815 elsif($what eq "http-pipe") {
4816 if($torture && $run{'http-pipe'} &&
4817 !responsive_http_server("http", $verbose, "pipe",
4819 stopserver('http-pipe');
4821 if(!$run{'http-pipe'}) {
4822 ($pid, $pid2) = runhttpserver("http", $verbose, "pipe",
4825 return "failed starting HTTP-pipe server";
4827 logmsg sprintf ("* pid http-pipe => %d %d\n", $pid, $pid2)
4829 $run{'http-pipe'}="$pid $pid2";
4832 elsif($what eq "rtsp") {
4833 if($torture && $run{'rtsp'} &&
4834 !responsive_rtsp_server($verbose)) {
4838 ($pid, $pid2) = runrtspserver($verbose);
4840 return "failed starting RTSP server";
4842 printf ("* pid rtsp => %d %d\n", $pid, $pid2) if($verbose);
4843 $run{'rtsp'}="$pid $pid2";
4846 elsif($what eq "rtsp-ipv6") {
4847 if($torture && $run{'rtsp-ipv6'} &&
4848 !responsive_rtsp_server($verbose, "ipv6")) {
4849 stopserver('rtsp-ipv6');
4851 if(!$run{'rtsp-ipv6'}) {
4852 ($pid, $pid2) = runrtspserver($verbose, "ipv6");
4854 return "failed starting RTSP-IPv6 server";
4856 logmsg sprintf("* pid rtsp-ipv6 => %d %d\n", $pid, $pid2)
4858 $run{'rtsp-ipv6'}="$pid $pid2";
4861 elsif($what eq "ftps") {
4863 # we can't run ftps tests without stunnel
4864 return "no stunnel";
4867 # we can't run ftps tests if libcurl is SSL-less
4868 return "curl lacks SSL support";
4870 if($runcert{'ftps'} && ($runcert{'ftps'} ne $certfile)) {
4871 # stop server when running and using a different cert
4874 if($torture && $run{'ftp'} &&
4875 !responsive_pingpong_server("ftp", "", $verbose)) {
4879 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose);
4881 return "failed starting FTP server";
4883 printf ("* pid ftp => %d %d\n", $pid, $pid2) if($verbose);
4884 $run{'ftp'}="$pid $pid2";
4887 ($pid, $pid2) = runftpsserver($verbose, "", $certfile);
4889 return "failed starting FTPS server (stunnel)";
4891 logmsg sprintf("* pid ftps => %d %d\n", $pid, $pid2)
4893 $run{'ftps'}="$pid $pid2";
4896 elsif($what eq "file") {
4897 # we support it but have no server!
4899 elsif($what eq "https") {
4901 # we can't run https tests without stunnel
4902 return "no stunnel";
4905 # we can't run https tests if libcurl is SSL-less
4906 return "curl lacks SSL support";
4908 if($runcert{'https'} && ($runcert{'https'} ne $certfile)) {
4909 # stop server when running and using a different cert
4910 stopserver('https');
4912 if($torture && $run{'http'} &&
4913 !responsive_http_server("http", $verbose, 0, $HTTPPORT)) {
4917 ($pid, $pid2) = runhttpserver("http", $verbose, 0,
4920 return "failed starting HTTP server";
4922 printf ("* pid http => %d %d\n", $pid, $pid2) if($verbose);
4923 $run{'http'}="$pid $pid2";
4925 if(!$run{'https'}) {
4926 ($pid, $pid2) = runhttpsserver($verbose, "", $certfile);
4928 return "failed starting HTTPS server (stunnel)";
4930 logmsg sprintf("* pid https => %d %d\n", $pid, $pid2)
4932 $run{'https'}="$pid $pid2";
4935 elsif($what eq "httptls") {
4937 # for now, we can't run http TLS-EXT tests without gnutls-serv
4938 return "no gnutls-serv";
4940 if($torture && $run{'httptls'} &&
4941 !responsive_httptls_server($verbose, "IPv4")) {
4942 stopserver('httptls');
4944 if(!$run{'httptls'}) {
4945 ($pid, $pid2) = runhttptlsserver($verbose, "IPv4");
4947 return "failed starting HTTPTLS server (gnutls-serv)";
4949 logmsg sprintf("* pid httptls => %d %d\n", $pid, $pid2)
4951 $run{'httptls'}="$pid $pid2";
4954 elsif($what eq "httptls-ipv6") {
4956 # for now, we can't run http TLS-EXT tests without gnutls-serv
4957 return "no gnutls-serv";
4959 if($torture && $run{'httptls-ipv6'} &&
4960 !responsive_httptls_server($verbose, "ipv6")) {
4961 stopserver('httptls-ipv6');
4963 if(!$run{'httptls-ipv6'}) {
4964 ($pid, $pid2) = runhttptlsserver($verbose, "ipv6");
4966 return "failed starting HTTPTLS-IPv6 server (gnutls-serv)";
4968 logmsg sprintf("* pid httptls-ipv6 => %d %d\n", $pid, $pid2)
4970 $run{'httptls-ipv6'}="$pid $pid2";
4973 elsif($what eq "tftp") {
4974 if($torture && $run{'tftp'} &&
4975 !responsive_tftp_server("", $verbose)) {
4979 ($pid, $pid2) = runtftpserver("", $verbose);
4981 return "failed starting TFTP server";
4983 printf ("* pid tftp => %d %d\n", $pid, $pid2) if($verbose);
4984 $run{'tftp'}="$pid $pid2";
4987 elsif($what eq "tftp-ipv6") {
4988 if($torture && $run{'tftp-ipv6'} &&
4989 !responsive_tftp_server("", $verbose, "ipv6")) {
4990 stopserver('tftp-ipv6');
4992 if(!$run{'tftp-ipv6'}) {
4993 ($pid, $pid2) = runtftpserver("", $verbose, "ipv6");
4995 return "failed starting TFTP-IPv6 server";
4997 printf("* pid tftp-ipv6 => %d %d\n", $pid, $pid2) if($verbose);
4998 $run{'tftp-ipv6'}="$pid $pid2";
5001 elsif($what eq "sftp" || $what eq "scp" || $what eq "socks4" || $what eq "socks5" ) {
5003 ($pid, $pid2) = runsshserver("", $verbose);
5005 return "failed starting SSH server";
5007 printf ("* pid ssh => %d %d\n", $pid, $pid2) if($verbose);
5008 $run{'ssh'}="$pid $pid2";
5010 if($what eq "socks4" || $what eq "socks5") {
5011 if(!$run{'socks'}) {
5012 ($pid, $pid2) = runsocksserver("", $verbose);
5014 return "failed starting socks server";
5016 printf ("* pid socks => %d %d\n", $pid, $pid2) if($verbose);
5017 $run{'socks'}="$pid $pid2";
5020 if($what eq "socks5") {
5022 # Not an OpenSSH or SunSSH ssh daemon
5023 logmsg "Not OpenSSH or SunSSH; socks5 tests need at least OpenSSH 3.7\n";
5024 return "failed starting socks5 server";
5026 elsif(($sshdid =~ /OpenSSH/) && ($sshdvernum < 370)) {
5027 # Need OpenSSH 3.7 for socks5 - https://www.openssh.com/txt/release-3.7
5028 logmsg "$sshdverstr insufficient; socks5 tests need at least OpenSSH 3.7\n";
5029 return "failed starting socks5 server";
5031 elsif(($sshdid =~ /SunSSH/) && ($sshdvernum < 100)) {
5032 # Need SunSSH 1.0 for socks5
5033 logmsg "$sshdverstr insufficient; socks5 tests need at least SunSSH 1.0\n";
5034 return "failed starting socks5 server";
5038 elsif($what eq "http-unix") {
5039 if($torture && $run{'http-unix'} &&
5040 !responsive_http_server("http", $verbose, "unix", $HTTPUNIXPATH)) {
5041 stopserver('http-unix');
5043 if(!$run{'http-unix'}) {
5044 ($pid, $pid2) = runhttpserver("http", $verbose, "unix",
5047 return "failed starting HTTP-unix server";
5049 logmsg sprintf("* pid http-unix => %d %d\n", $pid, $pid2)
5051 $run{'http-unix'}="$pid $pid2";
5054 elsif($what eq "dict") {
5056 ($pid, $pid2) = rundictserver($verbose, "", $DICTPORT);
5058 return "failed starting DICT server";
5060 logmsg sprintf ("* pid DICT => %d %d\n", $pid, $pid2)
5062 $run{'dict'}="$pid $pid2";
5065 elsif($what eq "smb") {
5067 ($pid, $pid2) = runsmbserver($verbose, "", $SMBPORT);
5069 return "failed starting SMB server";
5071 logmsg sprintf ("* pid SMB => %d %d\n", $pid, $pid2)
5073 $run{'dict'}="$pid $pid2";
5076 elsif($what eq "telnet") {
5077 if(!$run{'telnet'}) {
5078 ($pid, $pid2) = runnegtelnetserver($verbose,
5082 return "failed starting neg TELNET server";
5084 logmsg sprintf ("* pid neg TELNET => %d %d\n", $pid, $pid2)
5086 $run{'dict'}="$pid $pid2";
5089 elsif($what eq "none") {
5090 logmsg "* starts no server\n" if ($verbose);
5093 warn "we don't support a server for $what";
5094 return "no server for $what";
5100 ##############################################################################
5101 # This function makes sure the right set of server is running for the
5102 # specified test case. This is a useful design when we run single tests as not
5103 # all servers need to run then!
5105 # Returns: a string, blank if everything is fine or a reason why it failed
5110 my @what = getpart("client", "server");
5113 warn "Test case $testnum has no server(s) specified";
5114 return "no server specified";
5117 for(my $i = scalar(@what) - 1; $i >= 0; $i--) {
5118 my $srvrline = $what[$i];
5119 chomp $srvrline if($srvrline);
5120 if($srvrline =~ /^(\S+)((\s*)(.*))/) {
5121 my $server = "${1}";
5122 my $lnrest = "${2}";
5124 if($server =~ /^(httptls)(\+)(ext|srp)(\d*)(-ipv6|)$/) {
5125 $server = "${1}${4}${5}";
5126 $tlsext = uc("TLS-${3}");
5128 if(! grep /^\Q$server\E$/, @protocols) {
5129 if(substr($server,0,5) ne "socks") {
5131 return "curl lacks $tlsext support";
5134 return "curl lacks $server server support";
5138 $what[$i] = "$server$lnrest" if($tlsext);
5142 return &startservers(@what);
5145 #######################################################################
5146 # runtimestats displays test-suite run time statistics
5149 my $lasttest = $_[0];
5151 return if(not $timestats);
5153 logmsg "\nTest suite total running time breakdown per task...\n\n";
5161 my $timesrvrtot = 0.0;
5162 my $timepreptot = 0.0;
5163 my $timetooltot = 0.0;
5164 my $timelocktot = 0.0;
5165 my $timevrfytot = 0.0;
5166 my $timetesttot = 0.0;
5169 for my $testnum (1 .. $lasttest) {
5170 if($timesrvrini{$testnum}) {
5171 $timesrvrtot += $timesrvrend{$testnum} - $timesrvrini{$testnum};
5173 (($timetoolini{$testnum} - $timeprepini{$testnum}) -
5174 ($timesrvrend{$testnum} - $timesrvrini{$testnum}));
5175 $timetooltot += $timetoolend{$testnum} - $timetoolini{$testnum};
5176 $timelocktot += $timesrvrlog{$testnum} - $timetoolend{$testnum};
5177 $timevrfytot += $timevrfyend{$testnum} - $timesrvrlog{$testnum};
5178 $timetesttot += $timevrfyend{$testnum} - $timeprepini{$testnum};
5179 push @timesrvr, sprintf("%06.3f %04d",
5180 $timesrvrend{$testnum} - $timesrvrini{$testnum}, $testnum);
5181 push @timeprep, sprintf("%06.3f %04d",
5182 ($timetoolini{$testnum} - $timeprepini{$testnum}) -
5183 ($timesrvrend{$testnum} - $timesrvrini{$testnum}), $testnum);
5184 push @timetool, sprintf("%06.3f %04d",
5185 $timetoolend{$testnum} - $timetoolini{$testnum}, $testnum);
5186 push @timelock, sprintf("%06.3f %04d",
5187 $timesrvrlog{$testnum} - $timetoolend{$testnum}, $testnum);
5188 push @timevrfy, sprintf("%06.3f %04d",
5189 $timevrfyend{$testnum} - $timesrvrlog{$testnum}, $testnum);
5190 push @timetest, sprintf("%06.3f %04d",
5191 $timevrfyend{$testnum} - $timeprepini{$testnum}, $testnum);
5196 no warnings 'numeric';
5197 @timesrvr = sort { $b <=> $a } @timesrvr;
5198 @timeprep = sort { $b <=> $a } @timeprep;
5199 @timetool = sort { $b <=> $a } @timetool;
5200 @timelock = sort { $b <=> $a } @timelock;
5201 @timevrfy = sort { $b <=> $a } @timevrfy;
5202 @timetest = sort { $b <=> $a } @timetest;
5205 logmsg "Spent ". sprintf("%08.3f ", $timesrvrtot) .
5206 "seconds starting and verifying test harness servers.\n";
5207 logmsg "Spent ". sprintf("%08.3f ", $timepreptot) .
5208 "seconds reading definitions and doing test preparations.\n";
5209 logmsg "Spent ". sprintf("%08.3f ", $timetooltot) .
5210 "seconds actually running test tools.\n";
5211 logmsg "Spent ". sprintf("%08.3f ", $timelocktot) .
5212 "seconds awaiting server logs lock removal.\n";
5213 logmsg "Spent ". sprintf("%08.3f ", $timevrfytot) .
5214 "seconds verifying test results.\n";
5215 logmsg "Spent ". sprintf("%08.3f ", $timetesttot) .
5216 "seconds doing all of the above.\n";
5219 logmsg "\nTest server starting and verification time per test ".
5220 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
5221 logmsg "-time- test\n";
5222 logmsg "------ ----\n";
5223 foreach my $txt (@timesrvr) {
5224 last if((not $fullstats) && (not $counter--));
5229 logmsg "\nTest definition reading and preparation time per test ".
5230 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
5231 logmsg "-time- test\n";
5232 logmsg "------ ----\n";
5233 foreach my $txt (@timeprep) {
5234 last if((not $fullstats) && (not $counter--));
5239 logmsg "\nTest tool execution time per test ".
5240 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
5241 logmsg "-time- test\n";
5242 logmsg "------ ----\n";
5243 foreach my $txt (@timetool) {
5244 last if((not $fullstats) && (not $counter--));
5249 logmsg "\nTest server logs lock removal time per test ".
5250 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
5251 logmsg "-time- test\n";
5252 logmsg "------ ----\n";
5253 foreach my $txt (@timelock) {
5254 last if((not $fullstats) && (not $counter--));
5259 logmsg "\nTest results verification time per test ".
5260 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
5261 logmsg "-time- test\n";
5262 logmsg "------ ----\n";
5263 foreach my $txt (@timevrfy) {
5264 last if((not $fullstats) && (not $counter--));
5269 logmsg "\nTotal time per test ".
5270 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
5271 logmsg "-time- test\n";
5272 logmsg "------ ----\n";
5273 foreach my $txt (@timetest) {
5274 last if((not $fullstats) && (not $counter--));
5281 #######################################################################
5282 # Check options to this test program
5289 if ($ARGV[0] eq "-v") {
5293 elsif($ARGV[0] =~ /^-b(.*)/) {
5295 if($portno =~ s/(\d+)$//) {
5299 elsif ($ARGV[0] eq "-c") {
5300 # use this path to curl instead of default
5301 $DBGCURL=$CURL="\"$ARGV[1]\"";
5304 elsif ($ARGV[0] eq "-vc") {
5305 # use this path to a curl used to verify servers
5307 # Particularly useful when you introduce a crashing bug somewhere in
5308 # the development version as then it won't be able to run any tests
5309 # since it can't verify the servers!
5311 $VCURL="\"$ARGV[1]\"";
5314 elsif ($ARGV[0] eq "-d") {
5315 # have the servers display protocol output
5318 elsif($ARGV[0] eq "-e") {
5319 # run the tests cases event based if possible
5322 elsif ($ARGV[0] eq "-g") {
5323 # run this test with gdb
5326 elsif ($ARGV[0] eq "-gw") {
5327 # run this test with windowed gdb
5331 elsif($ARGV[0] eq "-s") {
5335 elsif($ARGV[0] eq "-am") {
5336 # automake-style output
5340 elsif($ARGV[0] eq "-n") {
5344 elsif ($ARGV[0] eq "-R") {
5345 # execute in scrambled order
5348 elsif($ARGV[0] =~ /^-t(.*)/) {
5353 if($xtra =~ s/(\d+)$//) {
5357 elsif($ARGV[0] eq "-a") {
5358 # continue anyway, even if a test fail
5361 elsif($ARGV[0] eq "-p") {
5364 elsif($ARGV[0] eq "-l") {
5365 # lists the test case names only
5368 elsif($ARGV[0] eq "-k") {
5369 # keep stdout and stderr files after tests
5372 elsif($ARGV[0] eq "-r") {
5373 # run time statistics needs Time::HiRes
5374 if($Time::HiRes::VERSION) {
5375 keys(%timeprepini) = 1000;
5376 keys(%timesrvrini) = 1000;
5377 keys(%timesrvrend) = 1000;
5378 keys(%timetoolini) = 1000;
5379 keys(%timetoolend) = 1000;
5380 keys(%timesrvrlog) = 1000;
5381 keys(%timevrfyend) = 1000;
5386 elsif($ARGV[0] eq "-rf") {
5387 # run time statistics needs Time::HiRes
5388 if($Time::HiRes::VERSION) {
5389 keys(%timeprepini) = 1000;
5390 keys(%timesrvrini) = 1000;
5391 keys(%timesrvrend) = 1000;
5392 keys(%timetoolini) = 1000;
5393 keys(%timetoolend) = 1000;
5394 keys(%timesrvrlog) = 1000;
5395 keys(%timevrfyend) = 1000;
5400 elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
5403 Usage: runtests.pl [options] [test selection(s)]
5404 -a continue even if a test fails
5405 -bN use base port number N for test servers (default $base)
5406 -c path use this curl executable
5407 -d display server debug info
5408 -e event-based execution
5409 -g run the test case with gdb
5410 -gw run the test case with gdb as a windowed application
5412 -k keep stdout and stderr files present after tests
5413 -l list all test case names/descriptions
5415 -p print log file contents when a test fails
5417 -r run time statistics
5418 -rf full run time statistics
5420 -am automake style output PASS/FAIL: [number] [name]
5421 -t[N] torture (simulate function failures); N means fail Nth function
5423 -vc path use this curl only to verify the existing servers
5424 [num] like "5 6 9" or " 5 to 22 " to run those tests only
5425 [!num] like "!5 !6 !9" to disable those tests
5426 [keyword] like "IPv6" to select only tests containing the key word
5427 [!keyword] like "!cookies" to disable any tests containing the key word
5432 elsif($ARGV[0] =~ /^(\d+)/) {
5435 for($fromnum .. $number) {
5444 elsif($ARGV[0] =~ /^to$/i) {
5445 $fromnum = $number+1;
5447 elsif($ARGV[0] =~ /^!(\d+)/) {
5451 elsif($ARGV[0] =~ /^!(.+)/) {
5452 $disabled_keywords{lc($1)}=$1;
5454 elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) {
5455 $enabled_keywords{lc($1)}=$1;
5458 print "Unknown option: $ARGV[0]\n";
5464 if(@testthis && ($testthis[0] ne "")) {
5465 $TESTCASES=join(" ", @testthis);
5469 # we have found valgrind on the host, use it
5471 # verify that we can invoke it fine
5472 my $code = runclient("valgrind >/dev/null 2>&1");
5474 if(($code>>8) != 1) {
5475 #logmsg "Valgrind failure, disable it\n";
5479 # since valgrind 2.1.x, '--tool' option is mandatory
5480 # use it, if it is supported by the version installed on the system
5481 runclient("valgrind --help 2>&1 | grep -- --tool > /dev/null 2>&1");
5483 $valgrind_tool="--tool=memcheck";
5488 # A shell script. This is typically when built with libtool,
5489 $valgrind="../libtool --mode=execute $valgrind";
5493 # valgrind 3 renamed the --logfile option to --log-file!!!
5494 my $ver=join(' ', runclientoutput("valgrind --version"));
5495 # cut off all but digits and dots
5496 $ver =~ s/[^0-9.]//g;
5498 if($ver =~ /^(\d+)/) {
5501 $valgrind_logfile="--log-file";
5508 # open the executable curl and read the first 4 bytes of it
5509 open(CHECK, "<$CURL");
5511 sysread CHECK, $c, 4;
5514 # A shell script. This is typically when built with libtool,
5516 $gdb = "../libtool --mode=execute gdb";
5520 $HTTPPORT = $base++; # HTTP server port
5521 $HTTPSPORT = $base++; # HTTPS (stunnel) server port
5522 $FTPPORT = $base++; # FTP server port
5523 $FTPSPORT = $base++; # FTPS (stunnel) server port
5524 $HTTP6PORT = $base++; # HTTP IPv6 server port
5525 $FTP2PORT = $base++; # FTP server 2 port
5526 $FTP6PORT = $base++; # FTP IPv6 port
5527 $TFTPPORT = $base++; # TFTP (UDP) port
5528 $TFTP6PORT = $base++; # TFTP IPv6 (UDP) port
5529 $SSHPORT = $base++; # SSH (SCP/SFTP) port
5530 $SOCKSPORT = $base++; # SOCKS port
5531 $POP3PORT = $base++; # POP3 server port
5532 $POP36PORT = $base++; # POP3 IPv6 server port
5533 $IMAPPORT = $base++; # IMAP server port
5534 $IMAP6PORT = $base++; # IMAP IPv6 server port
5535 $SMTPPORT = $base++; # SMTP server port
5536 $SMTP6PORT = $base++; # SMTP IPv6 server port
5537 $RTSPPORT = $base++; # RTSP server port
5538 $RTSP6PORT = $base++; # RTSP IPv6 server port
5539 $GOPHERPORT = $base++; # Gopher IPv4 server port
5540 $GOPHER6PORT = $base++; # Gopher IPv6 server port
5541 $HTTPTLSPORT = $base++; # HTTP TLS (non-stunnel) server port
5542 $HTTPTLS6PORT = $base++; # HTTP TLS (non-stunnel) IPv6 server port
5543 $HTTPPROXYPORT = $base++; # HTTP proxy port, when using CONNECT
5544 $HTTPPIPEPORT = $base++; # HTTP pipelining port
5545 $HTTP2PORT = $base++; # HTTP/2 port
5546 $DICTPORT = $base++; # DICT port
5547 $SMBPORT = $base++; # SMB port
5548 $SMBSPORT = $base++; # SMBS port
5549 $NEGTELNETPORT = $base++; # TELNET port with negotiation
5550 $HTTPUNIXPATH = 'http.sock'; # HTTP server Unix domain socket path
5552 #######################################################################
5553 # clear and create logging directory:
5557 mkdir($LOGDIR, 0777);
5559 #######################################################################
5560 # initialize some variables
5564 init_serverpidfile_hash();
5566 #######################################################################
5567 # Output curl version and host info being tested
5574 #######################################################################
5575 # Fetch all disabled tests, if there are any
5581 if(open(D, "<$file")) {
5588 $disabled{$1}=$1; # disable this test number
5595 # globally disabled tests
5596 disabledtests("$TESTDIR/DISABLED");
5598 # locally disabled tests, ignored by git etc
5599 disabledtests("$TESTDIR/DISABLED.local");
5601 #######################################################################
5602 # If 'all' tests are requested, find out all test numbers
5605 if ( $TESTCASES eq "all") {
5606 # Get all commands and find out their test numbers
5607 opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
5608 my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
5611 $TESTCASES=""; # start with no test cases
5613 # cut off everything but the digits
5615 $_ =~ s/[a-z\/\.]*//g;
5617 # sort the numbers from low to high
5618 foreach my $n (sort { $a <=> $b } @cmds) {
5620 # skip disabled test cases
5621 my $why = "configured as DISABLED";
5624 $teststat[$n]=$why; # store reason for this test case
5627 $TESTCASES .= " $n";
5633 if (-e "$TESTDIR/test$_") {
5636 } split(" ", $TESTCASES);
5637 if($verified eq "") {
5638 print "No existing test cases were specified\n";
5641 $TESTCASES = $verified;
5644 if($scrambleorder) {
5645 # scramble the order of the test cases
5648 my @all = split(/ +/, $TESTCASES);
5650 # if the first is blank, shift away it
5654 push @rand, $all[$r];
5656 $TESTCASES = join(" ", @all);
5658 $TESTCASES = join(" ", @rand);
5661 #######################################################################
5662 # Start the command line log
5664 open(CMDLOG, ">$CURLLOG") ||
5665 logmsg "can't log command lines to $CURLLOG\n";
5667 #######################################################################
5669 # Display the contents of the given file. Line endings are canonicalized
5670 # and excessively long files are elided
5671 sub displaylogcontent {
5673 if(open(SINGLE, "<$file")) {
5677 while(my $string = <SINGLE>) {
5678 $string =~ s/\r\n/\n/g;
5679 $string =~ s/[\r\f\032]/\n/g;
5680 $string .= "\n" unless ($string =~ /\n$/);
5682 for my $line (split("\n", $string)) {
5683 $line =~ s/\s*\!$//;
5685 push @tail, " $line\n";
5690 $truncate = $linecount > 1000;
5696 my $tailtotal = scalar @tail;
5697 if($tailtotal > $tailshow) {
5698 $tailskip = $tailtotal - $tailshow;
5699 logmsg "=== File too long: $tailskip lines omitted here\n";
5701 for($tailskip .. $tailtotal-1) {
5711 opendir(DIR, "$LOGDIR") ||
5712 die "can't open dir: $!";
5713 my @logs = readdir(DIR);
5716 logmsg "== Contents of files in the $LOGDIR/ dir after test $testnum\n";
5717 foreach my $log (sort @logs) {
5718 if($log =~ /\.(\.|)$/) {
5719 next; # skip "." and ".."
5721 if($log =~ /^\.nfs/) {
5724 if(($log eq "memdump") || ($log eq "core")) {
5725 next; # skip "memdump" and "core"
5727 if((-d "$LOGDIR/$log") || (! -s "$LOGDIR/$log")) {
5728 next; # skip directory and empty files
5730 if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) {
5731 next; # skip stdoutNnn of other tests
5733 if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) {
5734 next; # skip stderrNnn of other tests
5736 if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) {
5737 next; # skip uploadNnn of other tests
5739 if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) {
5740 next; # skip curlNnn.out of other tests
5742 if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) {
5743 next; # skip testNnn.txt of other tests
5745 if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) {
5746 next; # skip fileNnn.txt of other tests
5748 if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) {
5749 next; # skip netrcNnn of other tests
5751 if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) {
5752 next; # skip traceNnn of other tests
5754 if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(\..*|)$/)) {
5755 next; # skip valgrindNnn of other tests
5757 logmsg "=== Start of file $log\n";
5758 displaylogcontent("$LOGDIR/$log");
5759 logmsg "=== End of file $log\n";
5763 #######################################################################
5764 # The main test-loop
5772 my @at = split(" ", $TESTCASES);
5777 foreach $testnum (@at) {
5779 $lasttest = $testnum if($testnum > $lasttest);
5782 my $error = singletest($run_event_based, $testnum, $count, scalar(@at));
5784 # not a test we can run
5788 $total++; # number of tests we've run
5791 $failed.= "$testnum ";
5793 # display all files in log/ in a nice way
5794 displaylogs($testnum);
5797 # a test failed, abort
5798 logmsg "\n - abort tests\n";
5803 $ok++; # successful test counter
5806 # loop for next test
5809 my $sofar = time() - $start;
5811 #######################################################################
5816 # Tests done, stop the servers
5817 stopservers($verbose);
5819 my $all = $total + $skipped;
5821 runtimestats($lasttest);
5824 logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
5828 logmsg "TESTFAIL: These test cases failed: $failed\n";
5832 logmsg "TESTFAIL: No tests were performed\n";
5836 logmsg "TESTDONE: $all tests were considered during ".
5837 sprintf("%.0f", $sofar) ." seconds.\n";
5840 if($skipped && !$short) {
5842 logmsg "TESTINFO: $skipped tests were skipped due to these restraints:\n";
5844 for(keys %skipped) {
5846 printf "TESTINFO: \"%s\" %d times (", $r, $skipped{$_};
5848 # now show all test case numbers that had this reason for being
5852 for(0 .. scalar @teststat) {
5854 if($teststat[$_] && ($teststat[$_] eq $r)) {
5863 logmsg " and ".($c-$max)." more";
5869 if($total && ($ok != $total)) {