2 #***************************************************************************
4 # Project ___| | | | _ \| |
6 # | (__| |_| | _ <| |___
7 # \___|\___/|_| \_\_____|
9 # Copyright (C) 1998 - 2016, 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
149 my $srcdir = $ENV{'srcdir'} || '.';
150 my $CURL="../src/curl".exe_ext(); # what curl executable to run on the tests
151 my $VCURL=$CURL; # what curl binary to use to verify the servers with
152 # VCURL is handy to set to the system one when the one you
153 # just built hangs or crashes and thus prevent verification
154 my $DBGCURL=$CURL; #"../src/.libs/curl"; # alternative for debugging
156 my $TESTDIR="$srcdir/data";
157 my $LIBDIR="./libtest";
158 my $UNITDIR="./unit";
159 # TODO: change this to use server_inputfilename()
160 my $SERVERIN="$LOGDIR/server.input"; # what curl sent the server
161 my $SERVER2IN="$LOGDIR/server2.input"; # what curl sent the second server
162 my $PROXYIN="$LOGDIR/proxy.input"; # what curl sent the proxy
163 my $CURLLOG="$LOGDIR/curl.log"; # all command lines run
164 my $FTPDCMD="$LOGDIR/ftpserver.cmd"; # copy ftp server instructions here
165 my $SERVERLOGS_LOCK="$LOGDIR/serverlogs.lock"; # server logs advisor read lock
166 my $CURLCONFIG="../curl-config"; # curl-config from current build
168 # Normally, all test cases should be run, but at times it is handy to
169 # simply run a particular one:
172 # To run specific test cases, set them like:
173 # $TESTCASES="1 2 3 7 8";
175 #######################################################################
176 # No variables below this point should need to be modified
179 # invoke perl like this:
180 my $perl="perl -I$srcdir";
181 my $server_response_maxtime=13;
183 my $debug_build=0; # built debug enabled (--enable-debug)
184 my $has_memory_tracking=0; # built with memory tracking (--enable-curldebug)
187 # name of the file that the memory debugging creates:
188 my $memdump="$LOGDIR/memdump";
190 # the path to the script that analyzes the memory debug output file:
191 my $memanalyze="$perl $srcdir/memanalyze.pl";
193 my $pwd = getcwd(); # current working directory
196 my $ftpchecktime=1; # time it took to verify our test FTP server
198 my $stunnel = checkcmd("stunnel4") || checkcmd("tstunnel") || checkcmd("stunnel");
199 my $valgrind = checktestcmd("valgrind");
200 my $valgrind_logfile="--logfile";
202 my $gdb = checktestcmd("gdb");
203 my $httptlssrv = find_httptlssrv();
205 my $has_ssl; # set if libcurl is built with SSL support
206 my $has_largefile; # set if libcurl is built with large file support
207 my $has_idn; # set if libcurl is built with IDN support
208 my $http_ipv6; # set if HTTP server has IPv6 support
209 my $http_unix; # set if HTTP server has Unix sockets support
210 my $ftp_ipv6; # set if FTP server has IPv6 support
211 my $tftp_ipv6; # set if TFTP server has IPv6 support
212 my $gopher_ipv6; # set if Gopher server has IPv6 support
213 my $has_ipv6; # set if libcurl is built with IPv6 support
214 my $has_unix; # set if libcurl is built with Unix sockets support
215 my $has_libz; # set if libcurl is built with libz support
216 my $has_getrlimit; # set if system has getrlimit()
217 my $has_ntlm; # set if libcurl is built with NTLM support
218 my $has_ntlm_wb; # set if libcurl is built with NTLM delegation to winbind
219 my $has_sspi; # set if libcurl is built with Windows SSPI
220 my $has_gssapi; # set if libcurl is built with a GSS-API library
221 my $has_kerberos; # set if libcurl is built with Kerberos support
222 my $has_spnego; # set if libcurl is built with SPNEGO support
223 my $has_charconv; # set if libcurl is built with CharConv support
224 my $has_tls_srp; # set if libcurl is built with TLS-SRP support
225 my $has_metalink; # set if curl is built with Metalink support
226 my $has_http2; # set if libcurl is built with HTTP2 support
227 my $has_crypto; # set if libcurl is built with cryptographic support
228 my $has_cares; # set if built with c-ares
229 my $has_threadedres;# set if built with threaded resolver
230 my $has_psl; # set if libcurl is built with PSL support
232 # this version is decided by the particular nghttp2 library that is being used
235 my $has_openssl; # built with a lib using an OpenSSL-like API
236 my $has_gnutls; # built with GnuTLS
237 my $has_nss; # built with NSS
238 my $has_yassl; # built with yassl
239 my $has_polarssl; # built with polarssl
240 my $has_axtls; # built with axTLS
241 my $has_winssl; # built with WinSSL (Secure Channel aka Schannel)
242 my $has_darwinssl; # built with DarwinSSL (Secure Transport)
243 my $has_boringssl; # built with BoringSSL
244 my $has_libressl; # built with libressl
245 my $has_mbedtls; # built with mbedTLS
247 my $has_sslpinning; # built with a TLS backend that supports pinning
249 my $has_shared = "unknown"; # built shared
251 my $resolver; # name of the resolver backend (for human presentation)
252 my $ssllib; # name of the SSL library we use (for human presentation)
254 my $has_textaware; # set if running on a system that has a text mode concept
255 # on files. Windows for example
257 my @protocols; # array of lowercase supported protocol servers
259 my $skipped=0; # number of tests skipped; reported in main loop
260 my %skipped; # skipped{reason}=counter, reasons for skip
261 my @teststat; # teststat[testnum]=reason, reasons for skip
262 my %disabled_keywords; # key words of tests to skip
263 my %enabled_keywords; # key words of tests to run
264 my %disabled; # disabled test cases
266 my $sshdid; # for socks server, ssh daemon version id
267 my $sshdvernum; # for socks server, ssh daemon version number
268 my $sshdverstr; # for socks server, ssh daemon version string
269 my $sshderror; # for socks server, ssh daemon version error
271 my $defserverlogslocktimeout = 20; # timeout to await server logs lock removal
272 my $defpostcommanddelay = 0; # delay between command and postcheck sections
274 my $timestats; # time stamping and stats generation
275 my $fullstats; # show time stats for every single test
276 my %timeprepini; # timestamp for each test preparation start
277 my %timesrvrini; # timestamp for each test required servers verification start
278 my %timesrvrend; # timestamp for each test required servers verification end
279 my %timetoolini; # timestamp for each test command run starting
280 my %timetoolend; # timestamp for each test command run stopping
281 my %timesrvrlog; # timestamp for each test server logs lock removal
282 my %timevrfyend; # timestamp for each test result verification end
284 my $testnumcheck; # test number, set in singletest sub.
287 #######################################################################
288 # variables that command line options may set
296 my $gdbthis; # run test case with gdb debugger
297 my $gdbxwin; # use windowed gdb when using gdb
298 my $keepoutfiles; # keep stdout and stderr files after tests
299 my $listonly; # only list the tests
300 my $postmortem; # display detailed info about failed tests
301 my $run_event_based; # run curl with --test-event to test the event API
303 my %run; # running server
304 my %doesntrun; # servers that don't work, identified by pidfile
305 my %serverpidfile;# all server pid file names, identified by server id
306 my %runcert; # cert file currently in use by an ssl running server
308 # torture test variables
313 #######################################################################
314 # logmsg is our general message logging subroutine.
322 # get the name of the current user
323 my $USER = $ENV{USER}; # Linux
325 $USER = $ENV{USERNAME}; # Windows
327 $USER = $ENV{LOGNAME}; # Some Unix (I think)
331 # enable memory debugging if curl is compiled with it
332 $ENV{'CURL_MEMDEBUG'} = $memdump;
333 $ENV{'CURL_ENTROPY'}="12345678";
334 $ENV{'CURL_FORCETIME'}=1; # for debug NTLM magic
339 logmsg "runtests.pl received SIG$signame, exiting\n";
340 stopservers($verbose);
341 die "Somebody sent me a SIG$signame";
343 $SIG{INT} = \&catch_zap;
344 $SIG{TERM} = \&catch_zap;
346 ##########################################################################
347 # Clear all possible '*_proxy' environment variables for various protocols
348 # to prevent them to interfere with our testing!
351 foreach $protocol (('ftp', 'http', 'ftps', 'https', 'no', 'all')) {
352 my $proxy = "${protocol}_proxy";
353 # clear lowercase version
354 delete $ENV{$proxy} if($ENV{$proxy});
355 # clear uppercase version
356 delete $ENV{uc($proxy)} if($ENV{uc($proxy)});
359 # make sure we don't get affected by other variables that control our
362 delete $ENV{'SSL_CERT_DIR'} if($ENV{'SSL_CERT_DIR'});
363 delete $ENV{'SSL_CERT_PATH'} if($ENV{'SSL_CERT_PATH'});
364 delete $ENV{'CURL_CA_BUNDLE'} if($ENV{'CURL_CA_BUNDLE'});
366 #######################################################################
367 # Load serverpidfile hash with pidfile names for all possible servers.
369 sub init_serverpidfile_hash {
370 for my $proto (('ftp', 'http', 'imap', 'pop3', 'smtp', 'http/2')) {
371 for my $ssl (('', 's')) {
372 for my $ipvnum ((4, 6)) {
373 for my $idnum ((1, 2, 3)) {
374 my $serv = servername_id("$proto$ssl", $ipvnum, $idnum);
375 my $pidf = server_pidfilename("$proto$ssl", $ipvnum, $idnum);
376 $serverpidfile{$serv} = $pidf;
381 for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'gopher', 'httptls')) {
382 for my $ipvnum ((4, 6)) {
383 for my $idnum ((1, 2)) {
384 my $serv = servername_id($proto, $ipvnum, $idnum);
385 my $pidf = server_pidfilename($proto, $ipvnum, $idnum);
386 $serverpidfile{$serv} = $pidf;
390 for my $proto (('http', 'imap', 'pop3', 'smtp', 'http/2')) {
391 for my $ssl (('', 's')) {
392 my $serv = servername_id("$proto$ssl", "unix", 1);
393 my $pidf = server_pidfilename("$proto$ssl", "unix", 1);
394 $serverpidfile{$serv} = $pidf;
399 #######################################################################
400 # Check if a given child process has just died. Reaps it if so.
403 use POSIX ":sys_wait_h";
405 if((not defined $pid) || $pid <= 0) {
408 my $rc = waitpid($pid, &WNOHANG);
409 return ($rc == $pid)?1:0;
412 #######################################################################
413 # Start a new thread/process and run the given command line in there.
414 # Return the pids (yes plural) of the new child process to the parent.
417 my ($cmd, $pidfile, $timeout, $fake)=@_;
419 logmsg "startnew: $cmd\n" if ($verbose);
424 if(not defined $child) {
425 logmsg "startnew: fork() failure detected\n";
430 # Here we are the child. Run the given command.
432 # Put an "exec" in front of the command so that the child process
433 # keeps this child's process ID.
434 exec("exec $cmd") || die "Can't exec() $cmd: $!";
436 # exec() should never return back here to this process. We protect
437 # ourselves by calling die() just in case something goes really bad.
438 die "error: exec() has returned";
441 # Ugly hack but ssh client and gnutls-serv don't support pid files
443 if(open(OUT, ">$pidfile")) {
444 print OUT $child . "\n";
446 logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose);
449 logmsg "startnew: failed to write fake $pidfile with pid=$child\n";
451 # could/should do a while connect fails sleep a bit and loop
453 if (checkdied($child)) {
454 logmsg "startnew: child process has failed to start\n" if($verbose);
459 my $count = $timeout;
461 if(-f $pidfile && -s $pidfile && open(PID, "<$pidfile")) {
464 if(($pid2 > 0) && pidexists($pid2)) {
465 # if $pid2 is valid, then make sure this pid is alive, as
466 # otherwise it is just likely to be the _previous_ pidfile or
470 # invalidate $pid2 if not actually alive
473 if (checkdied($child)) {
474 logmsg "startnew: child process has died, server might start up\n"
476 # We can't just abort waiting for the server with a
478 # because the server might have forked and could still start
479 # up normally. Instead, just reduce the amount of time we remain
486 # Return two PIDs, the one for the child process we spawned and the one
487 # reported by the server itself (in case it forked again on its own).
488 # Both (potentially) need to be killed at the end of the test.
489 return ($child, $pid2);
493 #######################################################################
494 # Check for a command in the PATH of the test server.
498 my @paths=(split(":", $ENV{'PATH'}), "/usr/sbin", "/usr/local/sbin",
499 "/sbin", "/usr/bin", "/usr/local/bin",
500 "./libtest/.libs", "./libtest");
502 if( -x "$_/$cmd" && ! -d "$_/$cmd") {
503 # executable bit but not a directory!
509 #######################################################################
510 # Get the list of tests that the tests/data/Makefile.am knows about!
514 my @dist = `cd data && make show`;
515 $disttests = join("", @dist);
518 #######################################################################
519 # Check for a command in the PATH of the machine running curl.
523 return checkcmd($cmd);
526 #######################################################################
527 # Run the application under test and return its return code
531 my $ret = system($cmd);
532 print "CMD ($ret): $cmd\n" if($verbose && !$torture);
535 # This is one way to test curl on a remote machine
536 # my $out = system("ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'");
537 # sleep 2; # time to allow the NFS server to be updated
541 #######################################################################
542 # Run the application under test and return its stdout
544 sub runclientoutput {
548 # This is one way to test curl on a remote machine
549 # my @out = `ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'`;
550 # sleep 2; # time to allow the NFS server to be updated
554 #######################################################################
555 # Memory allocation test and failure torture testing.
561 # remove memdump first to be sure we get a new nice and clean one
564 # First get URL from test server, ignore the output/result
567 logmsg " CMD: $testcmd\n" if($verbose);
569 # memanalyze -v is our friend, get the number of allocations made
571 my @out = `$memanalyze -v $memdump`;
573 if(/^Allocations: (\d+)/) {
579 logmsg " found no allocs to make fail\n";
583 logmsg " $count allocations to make fail\n";
585 for ( 1 .. $count ) {
590 if($tortalloc && ($tortalloc != $limit)) {
595 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
597 my $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
598 logmsg "Fail alloc no: $limit at $now\r";
601 # make the memory allocation function number $limit return failure
602 $ENV{'CURL_MEMLIMIT'} = $limit;
604 # remove memdump first to be sure we get a new nice and clean one
607 logmsg "*** Alloc number $limit is now set to fail ***\n" if($gdbthis);
614 $ret = runclient($testcmd);
616 #logmsg "$_ Returned " . ($ret >> 8) . "\n";
618 # Now clear the variable again
619 delete $ENV{'CURL_MEMLIMIT'} if($ENV{'CURL_MEMLIMIT'});
622 # there's core file present now!
623 logmsg " core dumped\n";
628 # verify that it returns a proper error code, doesn't leak memory
629 # and doesn't core dump
630 if(($ret & 255) || ($ret >> 8) >= 128) {
631 logmsg " system() returned $ret\n";
635 my @memdata=`$memanalyze $memdump`;
639 # well it could be other memory problems as well, but
640 # we call it leak for short here
645 logmsg "** MEMORY FAILURE\n";
647 logmsg `$memanalyze -l $memdump`;
652 logmsg " Failed on alloc number $limit in test.\n",
653 " invoke with \"-t$limit\" to repeat this single case.\n";
654 stopservers($verbose);
659 logmsg "torture OK\n";
663 #######################################################################
664 # Stop a test server along with pids which aren't in the %run hash yet.
665 # This also stops all servers which are relative to the given one.
668 my ($server, $pidlist) = @_;
670 # kill sockfilter processes for pingpong relative server
672 if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
674 my $idnum = ($2 && ($2 > 1)) ? $2 : 1;
675 my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
676 killsockfilters($proto, $ipvnum, $idnum, $verbose);
679 # All servers relative to the given one must be stopped also
682 if($server =~ /^(ftp|http|imap|pop3|smtp|httppipe)s((\d*)(-ipv6|-unix|))$/) {
683 # given a stunnel based ssl server, also kill non-ssl underlying one
684 push @killservers, "${1}${2}";
686 elsif($server =~ /^(ftp|http|imap|pop3|smtp|httppipe)((\d*)(-ipv6|-unix|))$/) {
687 # given a non-ssl server, also kill stunnel based ssl piggybacking one
688 push @killservers, "${1}s${2}";
690 elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
691 # given a socks server, also kill ssh underlying one
692 push @killservers, "ssh${2}";
694 elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
695 # given a ssh server, also kill socks piggybacking one
696 push @killservers, "socks${2}";
698 push @killservers, $server;
700 # kill given pids and server relative ones clearing them in %run hash
702 foreach my $server (@killservers) {
704 # we must prepend a space since $pidlist may already contain a pid
705 $pidlist .= " $run{$server}";
708 $runcert{$server} = 0 if($runcert{$server});
710 killpid($verbose, $pidlist);
712 # cleanup server pid files
714 foreach my $server (@killservers) {
715 my $pidfile = $serverpidfile{$server};
716 my $pid = processexists($pidfile);
718 logmsg "Warning: $server server unexpectedly alive\n";
719 killpid($verbose, $pid);
721 unlink($pidfile) if(-f $pidfile);
725 #######################################################################
726 # Verify that the server that runs on $ip, $port is our server. This also
727 # implies that we can speak with it, as there might be occasions when the
728 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
729 # assign requested address")
732 my ($proto, $ipvnum, $idnum, $ip, $port_or_path) = @_;
733 my $server = servername_id($proto, $ipvnum, $idnum);
736 # $port_or_path contains a path for Unix sockets, sws ignores the port
737 my $port = ($ipvnum eq "unix") ? 80 : $port_or_path;
739 my $verifyout = "$LOGDIR/".
740 servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
741 unlink($verifyout) if(-f $verifyout);
743 my $verifylog = "$LOGDIR/".
744 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
745 unlink($verifylog) if(-f $verifylog);
747 if($proto eq "gopher") {
752 my $flags = "--max-time $server_response_maxtime ";
753 $flags .= "--output $verifyout ";
754 $flags .= "--silent ";
755 $flags .= "--verbose ";
756 $flags .= "--globoff ";
757 $flags .= "--unix-socket '$port_or_path' " if $ipvnum eq "unix";
758 $flags .= "-1 " if($has_axtls);
759 $flags .= "--insecure " if($proto eq 'https');
760 $flags .= "\"$proto://$ip:$port/${bonus}verifiedserver\"";
762 my $cmd = "$VCURL $flags 2>$verifylog";
764 # verify if our/any server is running on this port
765 logmsg "RUN: $cmd\n" if($verbose);
766 my $res = runclient($cmd);
768 $res >>= 8; # rotate the result
770 logmsg "RUN: curl command died with a coredump\n";
774 if($res && $verbose) {
775 logmsg "RUN: curl command returned $res\n";
776 if(open(FILE, "<$verifylog")) {
777 while(my $string = <FILE>) {
778 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
785 if(open(FILE, "<$verifyout")) {
786 while(my $string = <FILE>) {
788 last; # only want first line
793 if($data && ($data =~ /WE ROOLZ: (\d+)/)) {
797 # curl: (6) Couldn't resolve host '::1'
798 logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
801 elsif($data || ($res && ($res != 7))) {
802 logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
808 #######################################################################
809 # Verify that the server that runs on $ip, $port is our server. This also
810 # implies that we can speak with it, as there might be occasions when the
811 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
812 # assign requested address")
815 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
816 my $server = servername_id($proto, $ipvnum, $idnum);
821 my $verifylog = "$LOGDIR/".
822 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
823 unlink($verifylog) if(-f $verifylog);
825 if($proto eq "ftps") {
826 $extra .= "--insecure --ftp-ssl-control ";
829 my $flags = "--max-time $server_response_maxtime ";
830 $flags .= "--silent ";
831 $flags .= "--verbose ";
832 $flags .= "--globoff ";
834 $flags .= "\"$proto://$ip:$port/verifiedserver\"";
836 my $cmd = "$VCURL $flags 2>$verifylog";
838 # check if this is our server running on this port:
839 logmsg "RUN: $cmd\n" if($verbose);
840 my @data = runclientoutput($cmd);
842 my $res = $? >> 8; # rotate the result
844 logmsg "RUN: curl command died with a coredump\n";
848 foreach my $line (@data) {
849 if($line =~ /WE ROOLZ: (\d+)/) {
850 # this is our test server with a known pid!
855 if($pid <= 0 && @data && $data[0]) {
856 # this is not a known server
857 logmsg "RUN: Unknown server on our $server port: $port\n";
860 # we can/should use the time it took to verify the FTP server as a measure
861 # on how fast/slow this host/FTP is.
862 my $took = int(0.5+time()-$time);
865 logmsg "RUN: Verifying our test $server server took $took seconds\n";
867 $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
872 #######################################################################
873 # Verify that the server that runs on $ip, $port is our server. This also
874 # implies that we can speak with it, as there might be occasions when the
875 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
876 # assign requested address")
879 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
880 my $server = servername_id($proto, $ipvnum, $idnum);
883 my $verifyout = "$LOGDIR/".
884 servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
885 unlink($verifyout) if(-f $verifyout);
887 my $verifylog = "$LOGDIR/".
888 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
889 unlink($verifylog) if(-f $verifylog);
891 my $flags = "--max-time $server_response_maxtime ";
892 $flags .= "--output $verifyout ";
893 $flags .= "--silent ";
894 $flags .= "--verbose ";
895 $flags .= "--globoff ";
896 # currently verification is done using http
897 $flags .= "\"http://$ip:$port/verifiedserver\"";
899 my $cmd = "$VCURL $flags 2>$verifylog";
901 # verify if our/any server is running on this port
902 logmsg "RUN: $cmd\n" if($verbose);
903 my $res = runclient($cmd);
905 $res >>= 8; # rotate the result
907 logmsg "RUN: curl command died with a coredump\n";
911 if($res && $verbose) {
912 logmsg "RUN: curl command returned $res\n";
913 if(open(FILE, "<$verifylog")) {
914 while(my $string = <FILE>) {
915 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
922 if(open(FILE, "<$verifyout")) {
923 while(my $string = <FILE>) {
925 last; # only want first line
930 if($data && ($data =~ /RTSP_SERVER WE ROOLZ: (\d+)/)) {
934 # curl: (6) Couldn't resolve host '::1'
935 logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
938 elsif($data || ($res != 7)) {
939 logmsg "RUN: Unknown server on our $server port: $port\n";
945 #######################################################################
946 # Verify that the ssh server has written out its pidfile, recovering
947 # the pid from the file and returning it if a process with that pid is
951 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
952 my $server = servername_id($proto, $ipvnum, $idnum);
953 my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
955 if(open(FILE, "<$pidfile")) {
960 # if we have a pid it is actually our ssh server,
961 # since runsshserver() unlinks previous pidfile
962 if(!pidexists($pid)) {
963 logmsg "RUN: SSH server has died after starting up\n";
972 #######################################################################
973 # Verify that we can connect to the sftp server, properly authenticate
974 # with generated config and key files and run a simple remote pwd.
977 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
978 my $server = servername_id($proto, $ipvnum, $idnum);
980 # Find out sftp client canonical file name
981 my $sftp = find_sftp();
983 logmsg "RUN: SFTP server cannot find $sftpexe\n";
986 # Find out ssh client canonical file name
987 my $ssh = find_ssh();
989 logmsg "RUN: SFTP server cannot find $sshexe\n";
992 # Connect to sftp server, authenticate and run a remote pwd
993 # command using our generated configuration and key files
994 my $cmd = "\"$sftp\" -b $sftpcmds -F $sftpconfig -S \"$ssh\" $ip > $sftplog 2>&1";
995 my $res = runclient($cmd);
996 # Search for pwd command response in log file
997 if(open(SFTPLOGFILE, "<$sftplog")) {
998 while(<SFTPLOGFILE>) {
999 if(/^Remote working directory: /) {
1009 #######################################################################
1010 # Verify that the non-stunnel HTTP TLS extensions capable server that runs
1011 # on $ip, $port is our server. This also implies that we can speak with it,
1012 # as there might be occasions when the server runs fine but we cannot talk
1013 # to it ("Failed to connect to ::1: Can't assign requested address")
1016 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1017 my $server = servername_id($proto, $ipvnum, $idnum);
1018 my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
1021 my $verifyout = "$LOGDIR/".
1022 servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
1023 unlink($verifyout) if(-f $verifyout);
1025 my $verifylog = "$LOGDIR/".
1026 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
1027 unlink($verifylog) if(-f $verifylog);
1029 my $flags = "--max-time $server_response_maxtime ";
1030 $flags .= "--output $verifyout ";
1031 $flags .= "--verbose ";
1032 $flags .= "--globoff ";
1033 $flags .= "--insecure ";
1034 $flags .= "--tlsauthtype SRP ";
1035 $flags .= "--tlsuser jsmith ";
1036 $flags .= "--tlspassword abc ";
1037 $flags .= "\"https://$ip:$port/verifiedserver\"";
1039 my $cmd = "$VCURL $flags 2>$verifylog";
1041 # verify if our/any server is running on this port
1042 logmsg "RUN: $cmd\n" if($verbose);
1043 my $res = runclient($cmd);
1045 $res >>= 8; # rotate the result
1047 logmsg "RUN: curl command died with a coredump\n";
1051 if($res && $verbose) {
1052 logmsg "RUN: curl command returned $res\n";
1053 if(open(FILE, "<$verifylog")) {
1054 while(my $string = <FILE>) {
1055 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
1062 if(open(FILE, "<$verifyout")) {
1063 while(my $string = <FILE>) {
1069 if($data && ($data =~ /(GNUTLS|GnuTLS)/) && open(FILE, "<$pidfile")) {
1073 # if we have a pid it is actually our httptls server,
1074 # since runhttptlsserver() unlinks previous pidfile
1075 if(!pidexists($pid)) {
1076 logmsg "RUN: $server server has died after starting up\n";
1085 # curl: (6) Couldn't resolve host '::1'
1086 logmsg "RUN: failed to resolve host (https://$ip:$port/verifiedserver)\n";
1089 elsif($data || ($res && ($res != 7))) {
1090 logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
1096 #######################################################################
1097 # STUB for verifying socks
1100 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1101 my $server = servername_id($proto, $ipvnum, $idnum);
1102 my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
1104 if(open(FILE, "<$pidfile")) {
1109 # if we have a pid it is actually our socks server,
1110 # since runsocksserver() unlinks previous pidfile
1111 if(!pidexists($pid)) {
1112 logmsg "RUN: SOCKS server has died after starting up\n";
1121 #######################################################################
1122 # Verify that the server that runs on $ip, $port is our server.
1123 # Retry over several seconds before giving up. The ssh server in
1124 # particular can take a long time to start if it needs to generate
1125 # keys on a slow or loaded host.
1127 # Just for convenience, test harness uses 'https' and 'httptls' literals
1128 # as values for 'proto' variable in order to differentiate different
1129 # servers. 'https' literal is used for stunnel based https test servers,
1130 # and 'httptls' is used for non-stunnel https test servers.
1133 my %protofunc = ('http' => \&verifyhttp,
1134 'https' => \&verifyhttp,
1135 'rtsp' => \&verifyrtsp,
1136 'ftp' => \&verifyftp,
1137 'pop3' => \&verifyftp,
1138 'imap' => \&verifyftp,
1139 'smtp' => \&verifyftp,
1140 'httppipe' => \&verifyhttp,
1141 'ftps' => \&verifyftp,
1142 'tftp' => \&verifyftp,
1143 'ssh' => \&verifyssh,
1144 'socks' => \&verifysocks,
1145 'gopher' => \&verifyhttp,
1146 'httptls' => \&verifyhttptls);
1149 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1151 my $count = 30; # try for this many seconds
1155 my $fun = $protofunc{$proto};
1157 $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
1163 # a real failure, stop trying and bail out
1171 #######################################################################
1172 # Single shot server responsiveness test. This should only be used
1173 # to verify that a server present in %run hash is still functional
1175 sub responsiveserver {
1176 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1177 my $prev_verbose = $verbose;
1180 my $fun = $protofunc{$proto};
1181 my $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
1182 $verbose = $prev_verbose;
1185 return 1; # responsive
1188 my $srvrname = servername_str($proto, $ipvnum, $idnum);
1189 logmsg " server precheck FAILED (unresponsive $srvrname server)\n";
1193 #######################################################################
1194 # start the http2 server
1196 sub runhttp2server {
1197 my ($verbose, $port) = @_;
1206 my $exe = "$perl $srcdir/http2-server.pl";
1207 my $verbose_flag = "--verbose ";
1209 $server = servername_id($proto, $ipvnum, $idnum);
1211 $pidfile = $serverpidfile{$server};
1213 # don't retry if the server doesn't work
1214 if ($doesntrun{$pidfile}) {
1218 my $pid = processexists($pidfile);
1220 stopserver($server, "$pid");
1222 unlink($pidfile) if(-f $pidfile);
1224 $srvrname = servername_str($proto, $ipvnum, $idnum);
1226 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1228 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1229 $flags .= "--port $HTTP2PORT ";
1230 $flags .= $verbose_flag if($debugprotocol);
1232 my $cmd = "$exe $flags";
1233 my ($http2pid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1235 if($http2pid <= 0 || !pidexists($http2pid)) {
1237 logmsg "RUN: failed to start the $srvrname server\n";
1238 stopserver($server, "$pid2");
1239 $doesntrun{$pidfile} = 1;
1244 logmsg "RUN: $srvrname server is now running PID $http2pid\n";
1247 return ($http2pid, $pid2);
1250 #######################################################################
1251 # start the http server
1254 my ($proto, $verbose, $alt, $port_or_path) = @_;
1263 my $exe = "$perl $srcdir/httpserver.pl";
1264 my $verbose_flag = "--verbose ";
1266 if($alt eq "ipv6") {
1267 # if IPv6, use a different setup
1271 elsif($alt eq "proxy") {
1272 # basically the same, but another ID
1275 elsif($alt eq "pipe") {
1276 # basically the same, but another ID
1278 $exe = "python $srcdir/http_pipe.py";
1279 $verbose_flag .= "1 ";
1281 elsif($alt eq "unix") {
1282 # IP (protocol) is mutually exclusive with Unix sockets
1286 $server = servername_id($proto, $ipvnum, $idnum);
1288 $pidfile = $serverpidfile{$server};
1290 # don't retry if the server doesn't work
1291 if ($doesntrun{$pidfile}) {
1295 my $pid = processexists($pidfile);
1297 stopserver($server, "$pid");
1299 unlink($pidfile) if(-f $pidfile);
1301 $srvrname = servername_str($proto, $ipvnum, $idnum);
1303 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1305 $flags .= "--gopher " if($proto eq "gopher");
1306 $flags .= "--connect $HOSTIP " if($alt eq "proxy");
1307 $flags .= $verbose_flag if($debugprotocol);
1308 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1309 $flags .= "--id $idnum " if($idnum > 1);
1310 if($ipvnum eq "unix") {
1311 $flags .= "--unix-socket '$port_or_path' ";
1313 $flags .= "--ipv$ipvnum --port $port_or_path ";
1315 $flags .= "--srcdir \"$srcdir\"";
1317 my $cmd = "$exe $flags";
1318 my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1320 if($httppid <= 0 || !pidexists($httppid)) {
1322 logmsg "RUN: failed to start the $srvrname server\n";
1323 stopserver($server, "$pid2");
1324 displaylogs($testnumcheck);
1325 $doesntrun{$pidfile} = 1;
1329 # Server is up. Verify that we can speak to it.
1330 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
1332 logmsg "RUN: $srvrname server failed verification\n";
1333 # failed to talk to it properly. Kill the server and return failure
1334 stopserver($server, "$httppid $pid2");
1335 displaylogs($testnumcheck);
1336 $doesntrun{$pidfile} = 1;
1342 logmsg "RUN: $srvrname server is now running PID $httppid\n";
1347 return ($httppid, $pid2);
1350 #######################################################################
1351 # start the http server
1353 sub runhttp_pipeserver {
1354 my ($proto, $verbose, $alt, $port) = @_;
1364 if($alt eq "ipv6") {
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 .= "--verbose 1 " if($debugprotocol);
1388 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1389 $flags .= "--id $idnum " if($idnum > 1);
1390 $flags .= "--port $port --srcdir \"$srcdir\"";
1392 my $cmd = "$srcdir/http_pipe.py $flags";
1393 my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1395 if($httppid <= 0 || !pidexists($httppid)) {
1397 logmsg "RUN: failed to start the $srvrname server\n";
1398 stopserver($server, "$pid2");
1399 displaylogs($testnumcheck);
1400 $doesntrun{$pidfile} = 1;
1404 # Server is up. Verify that we can speak to it.
1405 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1407 logmsg "RUN: $srvrname server failed verification\n";
1408 # failed to talk to it properly. Kill the server and return failure
1409 stopserver($server, "$httppid $pid2");
1410 displaylogs($testnumcheck);
1411 $doesntrun{$pidfile} = 1;
1417 logmsg "RUN: $srvrname server is now running PID $httppid\n";
1422 return ($httppid, $pid2);
1425 #######################################################################
1426 # start the https stunnel based server
1428 sub runhttpsserver {
1429 my ($verbose, $ipv6, $certfile) = @_;
1430 my $proto = 'https';
1431 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1432 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1444 $server = servername_id($proto, $ipvnum, $idnum);
1446 $pidfile = $serverpidfile{$server};
1448 # don't retry if the server doesn't work
1449 if ($doesntrun{$pidfile}) {
1453 my $pid = processexists($pidfile);
1455 stopserver($server, "$pid");
1457 unlink($pidfile) if(-f $pidfile);
1459 $srvrname = servername_str($proto, $ipvnum, $idnum);
1461 $certfile = 'stunnel.pem' unless($certfile);
1463 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1465 $flags .= "--verbose " if($debugprotocol);
1466 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1467 $flags .= "--id $idnum " if($idnum > 1);
1468 $flags .= "--ipv$ipvnum --proto $proto ";
1469 $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
1470 $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
1471 $flags .= "--connect $HTTPPORT --accept $HTTPSPORT";
1473 my $cmd = "$perl $srcdir/secureserver.pl $flags";
1474 my ($httpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1476 if($httpspid <= 0 || !pidexists($httpspid)) {
1478 logmsg "RUN: failed to start the $srvrname server\n";
1479 stopserver($server, "$pid2");
1480 displaylogs($testnumcheck);
1481 $doesntrun{$pidfile} = 1;
1485 # Server is up. Verify that we can speak to it.
1486 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $HTTPSPORT);
1488 logmsg "RUN: $srvrname server failed verification\n";
1489 # failed to talk to it properly. Kill the server and return failure
1490 stopserver($server, "$httpspid $pid2");
1491 displaylogs($testnumcheck);
1492 $doesntrun{$pidfile} = 1;
1495 # Here pid3 is actually the pid returned by the unsecure-http server.
1497 $runcert{$server} = $certfile;
1500 logmsg "RUN: $srvrname server is now running PID $httpspid\n";
1505 return ($httpspid, $pid2);
1508 #######################################################################
1509 # start the non-stunnel HTTP TLS extensions capable server
1511 sub runhttptlsserver {
1512 my ($verbose, $ipv6) = @_;
1513 my $proto = "httptls";
1514 my $port = ($ipv6 && ($ipv6 =~ /6$/)) ? $HTTPTLS6PORT : $HTTPTLSPORT;
1515 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1516 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
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 .= "--http ";
1548 $flags .= "--debug 1 " if($debugprotocol);
1549 $flags .= "--port $port ";
1550 $flags .= "--priority NORMAL:+SRP ";
1551 $flags .= "--srppasswd $srcdir/certs/srp-verifier-db ";
1552 $flags .= "--srppasswdconf $srcdir/certs/srp-verifier-conf";
1554 my $cmd = "$httptlssrv $flags > $logfile 2>&1";
1555 my ($httptlspid, $pid2) = startnew($cmd, $pidfile, 10, 1); # fake pidfile
1557 if($httptlspid <= 0 || !pidexists($httptlspid)) {
1559 logmsg "RUN: failed to start the $srvrname server\n";
1560 stopserver($server, "$pid2");
1561 displaylogs($testnumcheck);
1562 $doesntrun{$pidfile} = 1;
1566 # Server is up. Verify that we can speak to it. PID is from fake pidfile
1567 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1569 logmsg "RUN: $srvrname server failed verification\n";
1570 # failed to talk to it properly. Kill the server and return failure
1571 stopserver($server, "$httptlspid $pid2");
1572 displaylogs($testnumcheck);
1573 $doesntrun{$pidfile} = 1;
1579 logmsg "RUN: $srvrname server is now running PID $httptlspid\n";
1584 return ($httptlspid, $pid2);
1587 #######################################################################
1588 # start the pingpong server (FTP, POP3, IMAP, SMTP)
1590 sub runpingpongserver {
1591 my ($proto, $id, $verbose, $ipv6) = @_;
1593 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1594 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1595 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1602 if($proto eq "ftp") {
1603 $port = ($idnum>1)?$FTP2PORT:$FTPPORT;
1606 # if IPv6, use a different setup
1610 elsif($proto eq "pop3") {
1611 $port = ($ipvnum==6) ? $POP36PORT : $POP3PORT;
1613 elsif($proto eq "imap") {
1614 $port = ($ipvnum==6) ? $IMAP6PORT : $IMAPPORT;
1616 elsif($proto eq "smtp") {
1617 $port = ($ipvnum==6) ? $SMTP6PORT : $SMTPPORT;
1620 print STDERR "Unsupported protocol $proto!!\n";
1624 $server = servername_id($proto, $ipvnum, $idnum);
1626 $pidfile = $serverpidfile{$server};
1628 # don't retry if the server doesn't work
1629 if ($doesntrun{$pidfile}) {
1633 my $pid = processexists($pidfile);
1635 stopserver($server, "$pid");
1637 unlink($pidfile) if(-f $pidfile);
1639 $srvrname = servername_str($proto, $ipvnum, $idnum);
1641 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1643 $flags .= "--verbose " if($debugprotocol);
1644 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1645 $flags .= "--srcdir \"$srcdir\" --proto $proto ";
1646 $flags .= "--id $idnum " if($idnum > 1);
1647 $flags .= "--ipv$ipvnum --port $port --addr \"$ip\"";
1649 my $cmd = "$perl $srcdir/ftpserver.pl $flags";
1650 my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1652 if($ftppid <= 0 || !pidexists($ftppid)) {
1654 logmsg "RUN: failed to start the $srvrname server\n";
1655 stopserver($server, "$pid2");
1656 displaylogs($testnumcheck);
1657 $doesntrun{$pidfile} = 1;
1661 # Server is up. Verify that we can speak to it.
1662 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1664 logmsg "RUN: $srvrname server failed verification\n";
1665 # failed to talk to it properly. Kill the server and return failure
1666 stopserver($server, "$ftppid $pid2");
1667 displaylogs($testnumcheck);
1668 $doesntrun{$pidfile} = 1;
1675 logmsg "RUN: $srvrname server is now running PID $ftppid\n";
1680 return ($pid2, $ftppid);
1683 #######################################################################
1684 # start the ftps server (or rather, tunnel)
1687 my ($verbose, $ipv6, $certfile) = @_;
1689 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1690 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1702 $server = servername_id($proto, $ipvnum, $idnum);
1704 $pidfile = $serverpidfile{$server};
1706 # don't retry if the server doesn't work
1707 if ($doesntrun{$pidfile}) {
1711 my $pid = processexists($pidfile);
1713 stopserver($server, "$pid");
1715 unlink($pidfile) if(-f $pidfile);
1717 $srvrname = servername_str($proto, $ipvnum, $idnum);
1719 $certfile = 'stunnel.pem' unless($certfile);
1721 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1723 $flags .= "--verbose " if($debugprotocol);
1724 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1725 $flags .= "--id $idnum " if($idnum > 1);
1726 $flags .= "--ipv$ipvnum --proto $proto ";
1727 $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
1728 $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
1729 $flags .= "--connect $FTPPORT --accept $FTPSPORT";
1731 my $cmd = "$perl $srcdir/secureserver.pl $flags";
1732 my ($ftpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1734 if($ftpspid <= 0 || !pidexists($ftpspid)) {
1736 logmsg "RUN: failed to start the $srvrname server\n";
1737 stopserver($server, "$pid2");
1738 displaylogs($testnumcheck);
1739 $doesntrun{$pidfile} = 1;
1743 # Server is up. Verify that we can speak to it.
1744 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $FTPSPORT);
1746 logmsg "RUN: $srvrname server failed verification\n";
1747 # failed to talk to it properly. Kill the server and return failure
1748 stopserver($server, "$ftpspid $pid2");
1749 displaylogs($testnumcheck);
1750 $doesntrun{$pidfile} = 1;
1753 # Here pid3 is actually the pid returned by the unsecure-ftp server.
1755 $runcert{$server} = $certfile;
1758 logmsg "RUN: $srvrname server is now running PID $ftpspid\n";
1763 return ($ftpspid, $pid2);
1766 #######################################################################
1767 # start the tftp server
1770 my ($id, $verbose, $ipv6) = @_;
1771 my $port = $TFTPPORT;
1775 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1783 # if IPv6, use a different setup
1789 $server = servername_id($proto, $ipvnum, $idnum);
1791 $pidfile = $serverpidfile{$server};
1793 # don't retry if the server doesn't work
1794 if ($doesntrun{$pidfile}) {
1798 my $pid = processexists($pidfile);
1800 stopserver($server, "$pid");
1802 unlink($pidfile) if(-f $pidfile);
1804 $srvrname = servername_str($proto, $ipvnum, $idnum);
1806 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1808 $flags .= "--verbose " if($debugprotocol);
1809 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1810 $flags .= "--id $idnum " if($idnum > 1);
1811 $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\"";
1813 my $cmd = "$perl $srcdir/tftpserver.pl $flags";
1814 my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1816 if($tftppid <= 0 || !pidexists($tftppid)) {
1818 logmsg "RUN: failed to start the $srvrname server\n";
1819 stopserver($server, "$pid2");
1820 displaylogs($testnumcheck);
1821 $doesntrun{$pidfile} = 1;
1825 # Server is up. Verify that we can speak to it.
1826 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1828 logmsg "RUN: $srvrname server failed verification\n";
1829 # failed to talk to it properly. Kill the server and return failure
1830 stopserver($server, "$tftppid $pid2");
1831 displaylogs($testnumcheck);
1832 $doesntrun{$pidfile} = 1;
1838 logmsg "RUN: $srvrname server is now running PID $tftppid\n";
1843 return ($pid2, $tftppid);
1847 #######################################################################
1848 # start the rtsp server
1851 my ($verbose, $ipv6) = @_;
1852 my $port = $RTSPPORT;
1864 # if IPv6, use a different setup
1870 $server = servername_id($proto, $ipvnum, $idnum);
1872 $pidfile = $serverpidfile{$server};
1874 # don't retry if the server doesn't work
1875 if ($doesntrun{$pidfile}) {
1879 my $pid = processexists($pidfile);
1881 stopserver($server, "$pid");
1883 unlink($pidfile) if(-f $pidfile);
1885 $srvrname = servername_str($proto, $ipvnum, $idnum);
1887 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1889 $flags .= "--verbose " if($debugprotocol);
1890 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1891 $flags .= "--id $idnum " if($idnum > 1);
1892 $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\"";
1894 my $cmd = "$perl $srcdir/rtspserver.pl $flags";
1895 my ($rtsppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1897 if($rtsppid <= 0 || !pidexists($rtsppid)) {
1899 logmsg "RUN: failed to start the $srvrname server\n";
1900 stopserver($server, "$pid2");
1901 displaylogs($testnumcheck);
1902 $doesntrun{$pidfile} = 1;
1906 # Server is up. Verify that we can speak to it.
1907 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1909 logmsg "RUN: $srvrname server failed verification\n";
1910 # failed to talk to it properly. Kill the server and return failure
1911 stopserver($server, "$rtsppid $pid2");
1912 displaylogs($testnumcheck);
1913 $doesntrun{$pidfile} = 1;
1919 logmsg "RUN: $srvrname server is now running PID $rtsppid\n";
1924 return ($rtsppid, $pid2);
1928 #######################################################################
1929 # Start the ssh (scp/sftp) server
1932 my ($id, $verbose, $ipv6) = @_;
1934 my $port = $SSHPORT;
1935 my $socksport = $SOCKSPORT;
1938 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1945 $server = servername_id($proto, $ipvnum, $idnum);
1947 $pidfile = $serverpidfile{$server};
1949 # don't retry if the server doesn't work
1950 if ($doesntrun{$pidfile}) {
1954 my $pid = processexists($pidfile);
1956 stopserver($server, "$pid");
1958 unlink($pidfile) if(-f $pidfile);
1960 $srvrname = servername_str($proto, $ipvnum, $idnum);
1962 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1964 $flags .= "--verbose " if($verbose);
1965 $flags .= "--debugprotocol " if($debugprotocol);
1966 $flags .= "--pidfile \"$pidfile\" ";
1967 $flags .= "--id $idnum " if($idnum > 1);
1968 $flags .= "--ipv$ipvnum --addr \"$ip\" ";
1969 $flags .= "--sshport $port --socksport $socksport ";
1970 $flags .= "--user \"$USER\"";
1972 my $cmd = "$perl $srcdir/sshserver.pl $flags";
1973 my ($sshpid, $pid2) = startnew($cmd, $pidfile, 60, 0);
1975 # on loaded systems sshserver start up can take longer than the timeout
1976 # passed to startnew, when this happens startnew completes without being
1977 # able to read the pidfile and consequently returns a zero pid2 above.
1979 if($sshpid <= 0 || !pidexists($sshpid)) {
1981 logmsg "RUN: failed to start the $srvrname server\n";
1982 stopserver($server, "$pid2");
1983 $doesntrun{$pidfile} = 1;
1987 # ssh server verification allows some extra time for the server to start up
1988 # and gives us the opportunity of recovering the pid from the pidfile, when
1989 # this verification succeeds the recovered pid is assigned to pid2.
1991 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1993 logmsg "RUN: $srvrname server failed verification\n";
1994 # failed to fetch server pid. Kill the server and return failure
1995 stopserver($server, "$sshpid $pid2");
1996 $doesntrun{$pidfile} = 1;
2001 # once it is known that the ssh server is alive, sftp server verification
2002 # is performed actually connecting to it, authenticating and performing a
2003 # very simple remote command. This verification is tried only one time.
2005 $sshdlog = server_logfilename($LOGDIR, 'ssh', $ipvnum, $idnum);
2006 $sftplog = server_logfilename($LOGDIR, 'sftp', $ipvnum, $idnum);
2008 if(verifysftp('sftp', $ipvnum, $idnum, $ip, $port) < 1) {
2009 logmsg "RUN: SFTP server failed verification\n";
2010 # failed to talk to it properly. Kill the server and return failure
2012 display_sftpconfig();
2014 display_sshdconfig();
2015 stopserver($server, "$sshpid $pid2");
2016 $doesntrun{$pidfile} = 1;
2021 logmsg "RUN: $srvrname server is now running PID $pid2\n";
2024 return ($pid2, $sshpid);
2027 #######################################################################
2028 # Start the socks server
2030 sub runsocksserver {
2031 my ($id, $verbose, $ipv6) = @_;
2033 my $port = $SOCKSPORT;
2034 my $proto = 'socks';
2036 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2043 $server = servername_id($proto, $ipvnum, $idnum);
2045 $pidfile = $serverpidfile{$server};
2047 # don't retry if the server doesn't work
2048 if ($doesntrun{$pidfile}) {
2052 my $pid = processexists($pidfile);
2054 stopserver($server, "$pid");
2056 unlink($pidfile) if(-f $pidfile);
2058 $srvrname = servername_str($proto, $ipvnum, $idnum);
2060 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
2062 # The ssh server must be already running
2064 logmsg "RUN: SOCKS server cannot find running SSH server\n";
2065 $doesntrun{$pidfile} = 1;
2069 # Find out ssh daemon canonical file name
2070 my $sshd = find_sshd();
2072 logmsg "RUN: SOCKS server cannot find $sshdexe\n";
2073 $doesntrun{$pidfile} = 1;
2077 # Find out ssh daemon version info
2078 ($sshdid, $sshdvernum, $sshdverstr, $sshderror) = sshversioninfo($sshd);
2080 # Not an OpenSSH or SunSSH ssh daemon
2081 logmsg "$sshderror\n" if($verbose);
2082 logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2083 $doesntrun{$pidfile} = 1;
2086 logmsg "ssh server found $sshd is $sshdverstr\n" if($verbose);
2088 # Find out ssh client canonical file name
2089 my $ssh = find_ssh();
2091 logmsg "RUN: SOCKS server cannot find $sshexe\n";
2092 $doesntrun{$pidfile} = 1;
2096 # Find out ssh client version info
2097 my ($sshid, $sshvernum, $sshverstr, $ssherror) = sshversioninfo($ssh);
2099 # Not an OpenSSH or SunSSH ssh client
2100 logmsg "$ssherror\n" if($verbose);
2101 logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2102 $doesntrun{$pidfile} = 1;
2106 # Verify minimum ssh client version
2107 if((($sshid =~ /OpenSSH/) && ($sshvernum < 299)) ||
2108 (($sshid =~ /SunSSH/) && ($sshvernum < 100))) {
2109 logmsg "ssh client found $ssh is $sshverstr\n";
2110 logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2111 $doesntrun{$pidfile} = 1;
2114 logmsg "ssh client found $ssh is $sshverstr\n" if($verbose);
2116 # Verify if ssh client and ssh daemon versions match
2117 if(($sshdid ne $sshid) || ($sshdvernum != $sshvernum)) {
2118 # Our test harness might work with slightly mismatched versions
2119 logmsg "Warning: version mismatch: sshd $sshdverstr - ssh $sshverstr\n"
2123 # Config file options for ssh client are previously set from sshserver.pl
2124 if(! -e $sshconfig) {
2125 logmsg "RUN: SOCKS server cannot find $sshconfig\n";
2126 $doesntrun{$pidfile} = 1;
2130 $sshlog = server_logfilename($LOGDIR, 'socks', $ipvnum, $idnum);
2132 # start our socks server
2133 my $cmd="\"$ssh\" -N -F $sshconfig $ip > $sshlog 2>&1";
2134 my ($sshpid, $pid2) = startnew($cmd, $pidfile, 30, 1); # fake pidfile
2136 if($sshpid <= 0 || !pidexists($sshpid)) {
2138 logmsg "RUN: failed to start the $srvrname server\n";
2140 display_sshconfig();
2142 display_sshdconfig();
2143 stopserver($server, "$pid2");
2144 $doesntrun{$pidfile} = 1;
2148 # Ugly hack but ssh doesn't support pid files. PID is from fake pidfile.
2149 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
2151 logmsg "RUN: $srvrname server failed verification\n";
2152 # failed to talk to it properly. Kill the server and return failure
2153 stopserver($server, "$sshpid $pid2");
2154 $doesntrun{$pidfile} = 1;
2160 logmsg "RUN: $srvrname server is now running PID $pid2\n";
2163 return ($pid2, $sshpid);
2166 #######################################################################
2167 # Single shot http and gopher server responsiveness test. This should only
2168 # be used to verify that a server present in %run hash is still functional
2170 sub responsive_http_server {
2171 my ($proto, $verbose, $alt, $port_or_path) = @_;
2176 if($alt eq "ipv6") {
2177 # if IPv6, use a different setup
2181 elsif($alt eq "proxy") {
2184 elsif($alt eq "unix") {
2185 # IP (protocol) is mutually exclusive with Unix sockets
2189 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
2192 #######################################################################
2193 # Single shot pingpong server responsiveness test. This should only be
2194 # used to verify that a server present in %run hash is still functional
2196 sub responsive_pingpong_server {
2197 my ($proto, $id, $verbose, $ipv6) = @_;
2199 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
2200 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
2201 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2203 if($proto eq "ftp") {
2204 $port = ($idnum>1)?$FTP2PORT:$FTPPORT;
2207 # if IPv6, use a different setup
2211 elsif($proto eq "pop3") {
2212 $port = ($ipvnum==6) ? $POP36PORT : $POP3PORT;
2214 elsif($proto eq "imap") {
2215 $port = ($ipvnum==6) ? $IMAP6PORT : $IMAPPORT;
2217 elsif($proto eq "smtp") {
2218 $port = ($ipvnum==6) ? $SMTP6PORT : $SMTPPORT;
2221 print STDERR "Unsupported protocol $proto!!\n";
2225 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2228 #######################################################################
2229 # Single shot rtsp server responsiveness test. This should only be
2230 # used to verify that a server present in %run hash is still functional
2232 sub responsive_rtsp_server {
2233 my ($verbose, $ipv6) = @_;
2234 my $port = $RTSPPORT;
2241 # if IPv6, use a different setup
2247 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2250 #######################################################################
2251 # Single shot tftp server responsiveness test. This should only be
2252 # used to verify that a server present in %run hash is still functional
2254 sub responsive_tftp_server {
2255 my ($id, $verbose, $ipv6) = @_;
2256 my $port = $TFTPPORT;
2260 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2263 # if IPv6, use a different setup
2269 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2272 #######################################################################
2273 # Single shot non-stunnel HTTP TLS extensions capable server
2274 # responsiveness test. This should only be used to verify that a
2275 # server present in %run hash is still functional
2277 sub responsive_httptls_server {
2278 my ($verbose, $ipv6) = @_;
2279 my $proto = "httptls";
2280 my $port = ($ipv6 && ($ipv6 =~ /6$/)) ? $HTTPTLS6PORT : $HTTPTLSPORT;
2281 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
2282 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
2285 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2288 #######################################################################
2289 # Remove all files in the specified directory
2297 opendir(DIR, $dir) ||
2298 return 0; # can't open dir
2299 while($file = readdir(DIR)) {
2300 if($file !~ /^\./) {
2301 unlink("$dir/$file");
2309 #######################################################################
2310 # compare test results with the expected output, we might filter off
2311 # some pattern that is allowed to differ, output test results
2314 my ($testnum, $testname, $subject, $firstref, $secondref)=@_;
2316 my $result = compareparts($firstref, $secondref);
2319 # timestamp test result verification end
2320 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
2323 logmsg "\n $testnum: $subject FAILED:\n";
2324 logmsg showdiff($LOGDIR, $firstref, $secondref);
2326 elsif(!$automakestyle) {
2331 logmsg "FAIL: $testnum - $testname - $subject\n";
2337 #######################################################################
2338 # display information about curl and the host the test suite runs on
2342 unlink($memdump); # remove this if there was one left
2351 my $curlverout="$LOGDIR/curlverout.log";
2352 my $curlvererr="$LOGDIR/curlvererr.log";
2353 my $versioncmd="$CURL --version 1>$curlverout 2>$curlvererr";
2355 unlink($curlverout);
2356 unlink($curlvererr);
2358 $versretval = runclient($versioncmd);
2361 open(VERSOUT, "<$curlverout");
2362 @version = <VERSOUT>;
2371 $curl =~ s/^(.*)(libcurl.*)/$1/g;
2374 if($curl =~ /win32|mingw(32|64)/) {
2375 # This is a Windows MinGW build or native build, we need to use
2377 $pwd = pathhelp::sys_native_current_path();
2379 if ($libcurl =~ /winssl/i) {
2383 elsif ($libcurl =~ /openssl/i) {
2388 elsif ($libcurl =~ /gnutls/i) {
2393 elsif ($libcurl =~ /nss/i) {
2398 elsif ($libcurl =~ /(yassl|wolfssl)/i) {
2403 elsif ($libcurl =~ /polarssl/i) {
2408 elsif ($libcurl =~ /axtls/i) {
2412 elsif ($libcurl =~ /securetransport/i) {
2414 $ssllib="DarwinSSL";
2416 elsif ($libcurl =~ /BoringSSL/i) {
2419 $ssllib="BoringSSL";
2421 elsif ($libcurl =~ /libressl/i) {
2426 elsif ($libcurl =~ /mbedTLS/i) {
2431 if ($libcurl =~ /ares/i) {
2436 elsif($_ =~ /^Protocols: (.*)/i) {
2437 # these are the protocols compiled in to this libcurl
2438 @protocols = split(' ', lc($1));
2440 # Generate a "proto-ipv6" version of each protocol to match the
2441 # IPv6 <server> name and a "proto-unix" to match the variant which
2442 # uses Unix domain sockets. This works even if support isn't
2443 # compiled in because the <features> test will fail.
2444 push @protocols, map(("$_-ipv6", "$_-unix"), @protocols);
2446 # 'http-proxy' is used in test cases to do CONNECT through
2447 push @protocols, 'http-proxy';
2449 # 'http-pipe' is the special server for testing pipelining
2450 push @protocols, 'http-pipe';
2452 # 'none' is used in test cases to mean no server
2453 push @protocols, 'none';
2455 elsif($_ =~ /^Features: (.*)/i) {
2457 if($feat =~ /TrackMemory/i) {
2458 # built with memory tracking support (--enable-curldebug)
2459 $has_memory_tracking = 1;
2461 if($feat =~ /debug/i) {
2462 # curl was built with --enable-debug
2465 if($feat =~ /SSL/i) {
2469 if($feat =~ /Largefile/i) {
2470 # large file support
2473 if($feat =~ /IDN/i) {
2477 if($feat =~ /IPv6/i) {
2480 if($feat =~ /UnixSockets/i) {
2483 if($feat =~ /libz/i) {
2486 if($feat =~ /NTLM/i) {
2490 # Use this as a proxy for any cryptographic authentication
2493 if($feat =~ /NTLM_WB/i) {
2494 # NTLM delegation to winbind daemon ntlm_auth helper enabled
2497 if($feat =~ /SSPI/i) {
2501 if($feat =~ /GSS-API/i) {
2505 if($feat =~ /Kerberos/i) {
2509 # Use this as a proxy for any cryptographic authentication
2512 if($feat =~ /SPNEGO/i) {
2516 # Use this as a proxy for any cryptographic authentication
2519 if($feat =~ /CharConv/i) {
2523 if($feat =~ /TLS-SRP/i) {
2527 if($feat =~ /Metalink/i) {
2531 if($feat =~ /PSL/i) {
2535 if($feat =~ /AsynchDNS/i) {
2537 # this means threaded resolver
2539 $resolver="threaded";
2542 if($feat =~ /HTTP2/) {
2546 push @protocols, 'http/2';
2550 # Test harness currently uses a non-stunnel server in order to
2551 # run HTTP TLS-SRP tests required when curl is built with https
2552 # protocol support and TLS-SRP feature enabled. For convenience
2553 # 'httptls' may be included in the test harness protocols array
2554 # to differentiate this from classic stunnel based 'https' test
2560 if($_ =~ /^https(-ipv6|)$/) {
2565 if($add_httptls && (! grep /^httptls$/, @protocols)) {
2566 push @protocols, 'httptls';
2567 push @protocols, 'httptls-ipv6';
2572 logmsg "unable to get curl's version, further details are:\n";
2573 logmsg "issued command: \n";
2574 logmsg "$versioncmd \n";
2575 if ($versretval == -1) {
2576 logmsg "command failed with: \n";
2577 logmsg "$versnoexec \n";
2579 elsif ($versretval & 127) {
2580 logmsg sprintf("command died with signal %d, and %s coredump.\n",
2581 ($versretval & 127), ($versretval & 128)?"a":"no");
2584 logmsg sprintf("command exited with value %d \n", $versretval >> 8);
2586 logmsg "contents of $curlverout: \n";
2587 displaylogcontent("$curlverout");
2588 logmsg "contents of $curlvererr: \n";
2589 displaylogcontent("$curlvererr");
2590 die "couldn't get curl's version";
2593 if(-r "../lib/curl_config.h") {
2594 open(CONF, "<../lib/curl_config.h");
2596 if($_ =~ /^\#define HAVE_GETRLIMIT/) {
2604 # client has IPv6 support
2606 # check if the HTTP server has it!
2607 my @sws = `server/sws --version`;
2608 if($sws[0] =~ /IPv6/) {
2609 # HTTP server has IPv6 support!
2614 # check if the FTP server has it!
2615 @sws = `server/sockfilt --version`;
2616 if($sws[0] =~ /IPv6/) {
2617 # FTP server has IPv6 support!
2623 # client has Unix sockets support, check whether the HTTP server has it
2624 my @sws = `server/sws --version`;
2625 $http_unix = 1 if($sws[0] =~ /unix/);
2628 if(!$has_memory_tracking && $torture) {
2629 die "can't run torture tests since curl was built without ".
2630 "TrackMemory feature (--enable-curldebug)";
2633 $has_shared = `sh $CURLCONFIG --built-shared`;
2636 my $hostname=join(' ', runclientoutput("hostname"));
2637 my $hosttype=join(' ', runclientoutput("uname -a"));
2639 logmsg ("********* System characteristics ******** \n",
2642 "* Features: $feat\n",
2643 "* Host: $hostname",
2644 "* System: $hosttype");
2646 if($has_memory_tracking && $has_threadedres) {
2647 $has_memory_tracking = 0;
2649 "*** DISABLES memory tracking when using threaded resolver\n",
2653 logmsg sprintf("* Servers: %s", $stunnel?"SSL ":"");
2654 logmsg sprintf("%s", $http_ipv6?"HTTP-IPv6 ":"");
2655 logmsg sprintf("%s", $http_unix?"HTTP-unix ":"");
2656 logmsg sprintf("%s\n", $ftp_ipv6?"FTP-IPv6 ":"");
2658 logmsg sprintf("* Env: %s%s", $valgrind?"Valgrind ":"",
2659 $run_event_based?"event-based ":"");
2660 logmsg sprintf("%s\n", $libtool?"Libtool ":"");
2663 logmsg "* Ports:\n";
2665 logmsg sprintf("* HTTP/%d ", $HTTPPORT);
2666 logmsg sprintf("FTP/%d ", $FTPPORT);
2667 logmsg sprintf("FTP2/%d ", $FTP2PORT);
2668 logmsg sprintf("RTSP/%d ", $RTSPPORT);
2670 logmsg sprintf("FTPS/%d ", $FTPSPORT);
2671 logmsg sprintf("HTTPS/%d ", $HTTPSPORT);
2673 logmsg sprintf("\n* TFTP/%d ", $TFTPPORT);
2675 logmsg sprintf("HTTP-IPv6/%d ", $HTTP6PORT);
2676 logmsg sprintf("RTSP-IPv6/%d ", $RTSP6PORT);
2679 logmsg sprintf("FTP-IPv6/%d ", $FTP6PORT);
2682 logmsg sprintf("TFTP-IPv6/%d ", $TFTP6PORT);
2684 logmsg sprintf("\n* GOPHER/%d ", $GOPHERPORT);
2686 logmsg sprintf("GOPHER-IPv6/%d", $GOPHERPORT);
2688 logmsg sprintf("\n* SSH/%d ", $SSHPORT);
2689 logmsg sprintf("SOCKS/%d ", $SOCKSPORT);
2690 logmsg sprintf("POP3/%d ", $POP3PORT);
2691 logmsg sprintf("IMAP/%d ", $IMAPPORT);
2692 logmsg sprintf("SMTP/%d\n", $SMTPPORT);
2694 logmsg sprintf("* POP3-IPv6/%d ", $POP36PORT);
2695 logmsg sprintf("IMAP-IPv6/%d ", $IMAP6PORT);
2696 logmsg sprintf("SMTP-IPv6/%d\n", $SMTP6PORT);
2699 logmsg sprintf("* HTTPTLS/%d ", $HTTPTLSPORT);
2701 logmsg sprintf("HTTPTLS-IPv6/%d ", $HTTPTLS6PORT);
2705 logmsg sprintf("* HTTP-PIPE/%d \n", $HTTPPIPEPORT);
2708 logmsg "* Unix socket paths:\n";
2710 logmsg sprintf("* HTTP-Unix:%s\n", $HTTPUNIXPATH);
2714 $has_textaware = ($^O eq 'MSWin32') || ($^O eq 'msys');
2716 logmsg "***************************************** \n";
2719 #######################################################################
2720 # substitute the variable stuff into either a joined up file or
2721 # a command, in either case passed by reference
2728 $$thing =~ s/%FTP6PORT/$FTP6PORT/g;
2729 $$thing =~ s/%FTP2PORT/$FTP2PORT/g;
2730 $$thing =~ s/%FTPSPORT/$FTPSPORT/g;
2731 $$thing =~ s/%FTPPORT/$FTPPORT/g;
2733 $$thing =~ s/%GOPHER6PORT/$GOPHER6PORT/g;
2734 $$thing =~ s/%GOPHERPORT/$GOPHERPORT/g;
2736 $$thing =~ s/%HTTPTLS6PORT/$HTTPTLS6PORT/g;
2737 $$thing =~ s/%HTTPTLSPORT/$HTTPTLSPORT/g;
2738 $$thing =~ s/%HTTP6PORT/$HTTP6PORT/g;
2739 $$thing =~ s/%HTTPSPORT/$HTTPSPORT/g;
2740 $$thing =~ s/%HTTP2PORT/$HTTP2PORT/g;
2741 $$thing =~ s/%HTTPPORT/$HTTPPORT/g;
2742 $$thing =~ s/%HTTPPIPEPORT/$HTTPPIPEPORT/g;
2743 $$thing =~ s/%PROXYPORT/$HTTPPROXYPORT/g;
2745 $$thing =~ s/%IMAP6PORT/$IMAP6PORT/g;
2746 $$thing =~ s/%IMAPPORT/$IMAPPORT/g;
2748 $$thing =~ s/%POP36PORT/$POP36PORT/g;
2749 $$thing =~ s/%POP3PORT/$POP3PORT/g;
2751 $$thing =~ s/%RTSP6PORT/$RTSP6PORT/g;
2752 $$thing =~ s/%RTSPPORT/$RTSPPORT/g;
2754 $$thing =~ s/%SMTP6PORT/$SMTP6PORT/g;
2755 $$thing =~ s/%SMTPPORT/$SMTPPORT/g;
2757 $$thing =~ s/%SOCKSPORT/$SOCKSPORT/g;
2758 $$thing =~ s/%SSHPORT/$SSHPORT/g;
2760 $$thing =~ s/%TFTP6PORT/$TFTP6PORT/g;
2761 $$thing =~ s/%TFTPPORT/$TFTPPORT/g;
2763 # server Unix domain socket paths
2765 $$thing =~ s/%HTTPUNIXPATH/$HTTPUNIXPATH/g;
2767 # client IP addresses
2769 $$thing =~ s/%CLIENT6IP/$CLIENT6IP/g;
2770 $$thing =~ s/%CLIENTIP/$CLIENTIP/g;
2772 # server IP addresses
2774 $$thing =~ s/%HOST6IP/$HOST6IP/g;
2775 $$thing =~ s/%HOSTIP/$HOSTIP/g;
2779 $$thing =~ s/%CURL/$CURL/g;
2780 $$thing =~ s/%PWD/$pwd/g;
2781 $$thing =~ s/%SRCDIR/$srcdir/g;
2782 $$thing =~ s/%USER/$USER/g;
2784 # The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be
2785 # used for time-out tests and that whould work on most hosts as these
2786 # adjust for the startup/check time for this particular host. We needed
2787 # to do this to make the test suite run better on very slow hosts.
2789 my $ftp2 = $ftpchecktime * 2;
2790 my $ftp3 = $ftpchecktime * 3;
2792 $$thing =~ s/%FTPTIME2/$ftp2/g;
2793 $$thing =~ s/%FTPTIME3/$ftp3/g;
2797 $$thing =~ s/%H2CVER/$h2cver/g;
2809 #######################################################################
2810 # Provide time stamps for single test skipped events
2812 sub timestampskippedevents {
2813 my $testnum = $_[0];
2815 return if((not defined($testnum)) || ($testnum < 1));
2819 if($timevrfyend{$testnum}) {
2822 elsif($timesrvrlog{$testnum}) {
2823 $timevrfyend{$testnum} = $timesrvrlog{$testnum};
2826 elsif($timetoolend{$testnum}) {
2827 $timevrfyend{$testnum} = $timetoolend{$testnum};
2828 $timesrvrlog{$testnum} = $timetoolend{$testnum};
2830 elsif($timetoolini{$testnum}) {
2831 $timevrfyend{$testnum} = $timetoolini{$testnum};
2832 $timesrvrlog{$testnum} = $timetoolini{$testnum};
2833 $timetoolend{$testnum} = $timetoolini{$testnum};
2835 elsif($timesrvrend{$testnum}) {
2836 $timevrfyend{$testnum} = $timesrvrend{$testnum};
2837 $timesrvrlog{$testnum} = $timesrvrend{$testnum};
2838 $timetoolend{$testnum} = $timesrvrend{$testnum};
2839 $timetoolini{$testnum} = $timesrvrend{$testnum};
2841 elsif($timesrvrini{$testnum}) {
2842 $timevrfyend{$testnum} = $timesrvrini{$testnum};
2843 $timesrvrlog{$testnum} = $timesrvrini{$testnum};
2844 $timetoolend{$testnum} = $timesrvrini{$testnum};
2845 $timetoolini{$testnum} = $timesrvrini{$testnum};
2846 $timesrvrend{$testnum} = $timesrvrini{$testnum};
2848 elsif($timeprepini{$testnum}) {
2849 $timevrfyend{$testnum} = $timeprepini{$testnum};
2850 $timesrvrlog{$testnum} = $timeprepini{$testnum};
2851 $timetoolend{$testnum} = $timeprepini{$testnum};
2852 $timetoolini{$testnum} = $timeprepini{$testnum};
2853 $timesrvrend{$testnum} = $timeprepini{$testnum};
2854 $timesrvrini{$testnum} = $timeprepini{$testnum};
2859 #######################################################################
2860 # Run a single specified test case
2863 my ($evbased, # 1 means switch on if possible (and "curl" is tested)
2864 # returns "not a test" if it can't be used for this test
2873 my $disablevalgrind;
2875 # copy test number to a global scope var, this allows
2876 # testnum checking when starting test harness servers.
2877 $testnumcheck = $testnum;
2879 # timestamp test preparation start
2880 $timeprepini{$testnum} = Time::HiRes::time() if($timestats);
2882 if($disttests !~ /test$testnum\W/ ) {
2883 logmsg "Warning: test$testnum not present in tests/data/Makefile.inc\n";
2885 if($disabled{$testnum}) {
2886 logmsg "Warning: test$testnum is explicitly disabled\n";
2889 # load the test case file definition
2890 if(loadtest("${TESTDIR}/test${testnum}")) {
2892 # this is not a test
2893 logmsg "RUN: $testnum doesn't look like a test case\n";
2898 @what = getpart("client", "features");
2901 # We require a feature to be present
2906 if($f =~ /^([^!].*)$/) {
2907 # Store the feature for later
2915 elsif($1 eq "SSLpinning") {
2916 if($has_sslpinning) {
2920 elsif($1 eq "OpenSSL") {
2925 elsif($1 eq "GnuTLS") {
2930 elsif($1 eq "NSS") {
2935 elsif($1 eq "axTLS") {
2940 elsif($1 eq "WinSSL") {
2945 elsif($1 eq "DarwinSSL") {
2946 if($has_darwinssl) {
2950 elsif($1 eq "unittest") {
2955 elsif($1 eq "debug") {
2960 elsif($1 eq "TrackMemory") {
2961 if($has_memory_tracking) {
2965 elsif($1 eq "large_file") {
2966 if($has_largefile) {
2970 elsif($1 eq "idn") {
2975 elsif($1 eq "ipv6") {
2980 elsif($1 eq "libz") {
2985 elsif($1 eq "NTLM") {
2990 elsif($1 eq "NTLM_WB") {
2995 elsif($1 eq "SSPI") {
3000 elsif($1 eq "GSS-API") {
3005 elsif($1 eq "Kerberos") {
3010 elsif($1 eq "SPNEGO") {
3015 elsif($1 eq "getrlimit") {
3016 if($has_getrlimit) {
3020 elsif($1 eq "crypto") {
3025 elsif($1 eq "TLS-SRP") {
3030 elsif($1 eq "Metalink") {
3035 elsif($1 eq "http/2") {
3040 elsif($1 eq "PSL") {
3045 elsif($1 eq "socks") {
3048 elsif($1 eq "unix-sockets") {
3051 # See if this "feature" is in the list of supported protocols
3052 elsif (grep /^\Q$1\E$/i, @protocols) {
3056 $why = "curl lacks $1 support";
3061 # We require a feature to not be present
3067 if($f =~ /^!(.*)$/) {
3073 elsif($1 eq "OpenSSL") {
3078 elsif($1 eq "GnuTLS") {
3083 elsif($1 eq "NSS") {
3088 elsif($1 eq "axTLS") {
3093 elsif($1 eq "WinSSL") {
3098 elsif($1 eq "DarwinSSL") {
3099 if(!$has_darwinssl) {
3103 elsif($1 eq "TrackMemory") {
3104 if(!$has_memory_tracking) {
3108 elsif($1 eq "large_file") {
3109 if(!$has_largefile) {
3113 elsif($1 eq "idn") {
3118 elsif($1 eq "ipv6") {
3123 elsif($1 eq "unix-sockets") {
3126 elsif($1 eq "libz") {
3131 elsif($1 eq "NTLM") {
3136 elsif($1 eq "NTLM_WB") {
3141 elsif($1 eq "SSPI") {
3146 elsif($1 eq "GSS-API") {
3151 elsif($1 eq "Kerberos") {
3152 if(!$has_kerberos) {
3156 elsif($1 eq "SPNEGO") {
3161 elsif($1 eq "getrlimit") {
3162 if(!$has_getrlimit) {
3166 elsif($1 eq "crypto") {
3171 elsif($1 eq "TLS-SRP") {
3176 elsif($1 eq "Metalink") {
3177 if(!$has_metalink) {
3181 elsif($1 eq "PSL") {
3194 $why = "curl has $1 support";
3200 my @keywords = getpart("info", "keywords");
3205 $why = "missing the <keywords> section!";
3208 for $k (@keywords) {
3210 if ($disabled_keywords{$k}) {
3211 $why = "disabled by keyword";
3212 } elsif ($enabled_keywords{$k}) {
3217 if(!$why && !$match && %enabled_keywords) {
3218 $why = "disabled by missing keyword";
3222 # test definition may instruct to (un)set environment vars
3223 # this is done this early, so that the precheck can use environment
3224 # variables and still bail out fine on errors
3226 # restore environment variables that were modified in a previous run
3227 foreach my $var (keys %oldenv) {
3228 if($oldenv{$var} eq 'notset') {
3229 delete $ENV{$var} if($ENV{$var});
3232 $ENV{$var} = $oldenv{$var};
3234 delete $oldenv{$var};
3237 # remove test server commands file before servers are started/verified
3238 unlink($FTPDCMD) if(-f $FTPDCMD);
3240 # timestamp required servers verification start
3241 $timesrvrini{$testnum} = Time::HiRes::time() if($timestats);
3244 $why = serverfortest($testnum);
3247 # timestamp required servers verification end
3248 $timesrvrend{$testnum} = Time::HiRes::time() if($timestats);
3250 my @setenv = getpart("client", "setenv");
3252 foreach my $s (@setenv) {
3255 if($s =~ /([^=]*)=(.*)/) {
3256 my ($var, $content) = ($1, $2);
3257 # remember current setting, to restore it once test runs
3258 $oldenv{$var} = ($ENV{$var})?"$ENV{$var}":'notset';
3261 delete $ENV{$var} if($ENV{$var});
3264 if($var =~ /^LD_PRELOAD/) {
3265 if(exe_ext() && (exe_ext() eq '.exe')) {
3266 # print "Skipping LD_PRELOAD due to lack of OS support\n";
3269 if($debug_build || ($has_shared ne "yes")) {
3270 # print "Skipping LD_PRELOAD due to no release shared build\n";
3274 $ENV{$var} = "$content";
3282 # Add a precheck cache. If a precheck command was already invoked
3283 # exactly like this, then use the previous result to speed up
3284 # successive test invokes!
3286 my @precheck = getpart("client", "precheck");
3288 $cmd = $precheck[0];
3292 my @p = split(/ /, $cmd);
3294 # the first word, the command, does not contain a slash so
3295 # we will scan the "improved" PATH to find the command to
3297 my $fullp = checktestcmd($p[0]);
3302 $cmd = join(" ", @p);
3305 my @o = `$cmd 2>/dev/null`;
3310 $why = "precheck command error";
3312 logmsg "prechecked $cmd\n" if($verbose);
3317 if($why && !$listonly) {
3318 # there's a problem, count it as "skipped"
3321 $teststat[$testnum]=$why; # store reason for this test case
3324 if($skipped{$why} <= 3) {
3325 # show only the first three skips for each reason
3326 logmsg sprintf("test %04d SKIPPED: $why\n", $testnum);
3330 timestampskippedevents($testnum);
3333 logmsg sprintf("test %04d...", $testnum) if(!$automakestyle);
3335 # extract the reply data
3336 my @reply = getpart("reply", "data");
3337 my @replycheck = getpart("reply", "datacheck");
3339 my %replyattr = getpartattr("reply", "data");
3340 my %replycheckattr = getpartattr("reply", "datacheck");
3343 # we use this file instead to check the final output against
3344 # get the mode attribute
3345 my $filemode=$replycheckattr{'mode'};
3346 if($filemode && ($filemode eq "text") && $has_textaware) {
3347 # text mode when running on windows: fix line endings
3348 map s/\r\n/\n/g, @replycheck;
3349 map s/\n/\r\n/g, @replycheck;
3351 if($replycheckattr{'nonewline'}) {
3352 # Yes, we must cut off the final newline from the final line
3354 chomp($replycheck[$#replycheck]);
3357 for my $partsuffix (('1', '2', '3', '4')) {
3358 my @replycheckpart = getpart("reply", "datacheck".$partsuffix);
3359 if(@replycheckpart || partexists("reply", "datacheck".$partsuffix) ) {
3360 my %replycheckpartattr = getpartattr("reply", "datacheck".$partsuffix);
3361 # get the mode attribute
3362 my $filemode=$replycheckpartattr{'mode'};
3363 if($filemode && ($filemode eq "text") && $has_textaware) {
3364 # text mode when running on windows: fix line endings
3365 map s/\r\n/\n/g, @replycheckpart;
3366 map s/\n/\r\n/g, @replycheckpart;
3368 if($replycheckpartattr{'nonewline'}) {
3369 # Yes, we must cut off the final newline from the final line
3371 chomp($replycheckpart[$#replycheckpart]);
3373 push(@replycheck, @replycheckpart);
3380 # get the mode attribute
3381 my $filemode=$replyattr{'mode'};
3382 if($filemode && ($filemode eq "text") && $has_textaware) {
3383 # text mode when running on windows: fix line endings
3384 map s/\r\n/\n/g, @reply;
3385 map s/\n/\r\n/g, @reply;
3389 # this is the valid protocol blurb curl should generate
3390 my @protocol= fixarray ( getpart("verify", "protocol") );
3392 # this is the valid protocol blurb curl should generate to a proxy
3393 my @proxyprot = fixarray ( getpart("verify", "proxy") );
3395 # redirected stdout/stderr to these files
3396 $STDOUT="$LOGDIR/stdout$testnum";
3397 $STDERR="$LOGDIR/stderr$testnum";
3399 # if this section exists, we verify that the stdout contained this:
3400 my @validstdout = fixarray ( getpart("verify", "stdout") );
3402 # if this section exists, we verify upload
3403 my @upload = getpart("verify", "upload");
3405 # if this section exists, it might be FTP server instructions:
3406 my @ftpservercmd = getpart("reply", "servercmd");
3408 my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout
3411 my @testname= getpart("client", "name");
3412 my $testname = $testname[0];
3413 $testname =~ s/\n//g;
3414 logmsg "[$testname]\n" if(!$short);
3417 timestampskippedevents($testnum);
3418 return 0; # look successful
3421 my @codepieces = getpart("client", "tool");
3425 $tool = $codepieces[0];
3429 # remove server output logfile
3435 # write the instructions to file
3436 writearray($FTPDCMD, \@ftpservercmd);
3439 # get the command line options to use
3441 ($cmd, @blaha)= getpart("client", "command");
3444 # make some nice replace operations
3445 $cmd =~ s/\n//g; # no newlines please
3446 # substitute variables in the command line
3450 # there was no command given, use something silly
3453 if($has_memory_tracking) {
3457 # create a (possibly-empty) file before starting the test
3458 my @inputfile=getpart("client", "file");
3459 my %fileattr = getpartattr("client", "file");
3460 my $filename=$fileattr{'name'};
3461 if(@inputfile || $filename) {
3463 logmsg "ERROR: section client=>file has no name attribute\n";
3464 timestampskippedevents($testnum);
3467 my $fileContent = join('', @inputfile);
3468 subVariables \$fileContent;
3469 # logmsg "DEBUG: writing file " . $filename . "\n";
3470 open(OUTFILE, ">$filename");
3471 binmode OUTFILE; # for crapage systems, use binary
3472 print OUTFILE $fileContent;
3476 my %cmdhash = getpartattr("client", "command");
3480 if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-output/)) {
3481 #We may slap on --output!
3482 if (!@validstdout) {
3483 $out=" --output $CURLOUT ";
3487 my $serverlogslocktimeout = $defserverlogslocktimeout;
3488 if($cmdhash{'timeout'}) {
3489 # test is allowed to override default server logs lock timeout
3490 if($cmdhash{'timeout'} =~ /(\d+)/) {
3491 $serverlogslocktimeout = $1 if($1 >= 0);
3495 my $postcommanddelay = $defpostcommanddelay;
3496 if($cmdhash{'delay'}) {
3497 # test is allowed to specify a delay after command is executed
3498 if($cmdhash{'delay'} =~ /(\d+)/) {
3499 $postcommanddelay = $1 if($1 > 0);
3505 my $cmdtype = $cmdhash{'type'} || "default";
3506 my $fail_due_event_based = $evbased;
3507 if($cmdtype eq "perl") {
3508 # run the command line prepended with "perl"
3514 elsif($cmdtype eq "shell") {
3515 # run the command line prepended with "/bin/sh"
3517 $CMDLINE = "/bin/sh ";
3522 # run curl, add suitable command line options
3523 $cmd = "-1 ".$cmd if(exists $feature{"SSL"} && ($has_axtls));
3526 if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-include/)) {
3527 $inc = " --include";
3530 $cmdargs = "$out$inc ";
3531 $cmdargs .= "--trace-ascii log/trace$testnum ";
3532 $cmdargs .= "--trace-time ";
3534 $cmdargs .= "--test-event ";
3535 $fail_due_event_based--;
3540 $cmdargs = " $cmd"; # $cmd is the command line for the test file
3541 $CURLOUT = $STDOUT; # sends received data to stdout
3543 if($tool =~ /^lib/) {
3544 $CMDLINE="$LIBDIR/$tool";
3546 elsif($tool =~ /^unit/) {
3547 $CMDLINE="$UNITDIR/$tool";
3551 logmsg "The tool set in the test case for this: '$tool' does not exist\n";
3552 timestampskippedevents($testnum);
3559 # gdb is incompatible with valgrind, so disable it when debugging
3560 # Perhaps a better approach would be to run it under valgrind anyway
3561 # with --db-attach=yes or --vgdb=yes.
3565 if($fail_due_event_based) {
3566 logmsg "This test cannot run event based\n";
3570 my @stdintest = getpart("client", "stdin");
3573 my $stdinfile="$LOGDIR/stdin-for-$testnum";
3575 my %hash = getpartattr("client", "stdin");
3576 if($hash{'nonewline'}) {
3577 # cut off the final newline from the final line of the stdin data
3578 chomp($stdintest[$#stdintest]);
3581 writearray($stdinfile, \@stdintest);
3583 $cmdargs .= " <$stdinfile";
3591 if($valgrind && !$disablevalgrind) {
3592 my @valgrindoption = getpart("verify", "valgrind");
3593 if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) {
3595 my $valgrindcmd = "$valgrind ";
3596 $valgrindcmd .= "$valgrind_tool " if($valgrind_tool);
3597 $valgrindcmd .= "--quiet --leak-check=yes ";
3598 $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp ";
3599 # $valgrindcmd .= "--gen-suppressions=all ";
3600 $valgrindcmd .= "--num-callers=16 ";
3601 $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum";
3602 $CMDLINE = "$valgrindcmd $CMDLINE";
3606 $CMDLINE .= "$cmdargs >$STDOUT 2>$STDERR";
3609 logmsg "$CMDLINE\n";
3612 print CMDLOG "$CMDLINE\n";
3619 # Apr 2007: precommand isn't being used and could be removed
3620 my @precommand= getpart("client", "precommand");
3621 if($precommand[0]) {
3622 # this is pure perl to eval!
3623 my $code = join("", @precommand);
3626 logmsg "perl: $code\n";
3627 logmsg "precommand: $@";
3628 stopservers($verbose);
3629 timestampskippedevents($testnum);
3635 my $gdbinit = "$TESTDIR/gdbinit$testnum";
3636 open(GDBCMD, ">$LOGDIR/gdbcmd");
3637 print GDBCMD "set args $cmdargs\n";
3638 print GDBCMD "show args\n";
3639 print GDBCMD "source $gdbinit\n" if -e $gdbinit;
3643 # timestamp starting of test command
3644 $timetoolini{$testnum} = Time::HiRes::time() if($timestats);
3646 # run the command line we built
3648 $cmdres = torture($CMDLINE,
3649 "$gdb --directory libtest $DBGCURL -x $LOGDIR/gdbcmd");
3652 my $GDBW = ($gdbxwin) ? "-w" : "";
3653 runclient("$gdb --directory libtest $DBGCURL $GDBW -x $LOGDIR/gdbcmd");
3654 $cmdres=0; # makes it always continue after a debugged run
3657 $cmdres = runclient("$CMDLINE");
3658 my $signal_num = $cmdres & 127;
3659 $dumped_core = $cmdres & 128;
3661 if(!$anyway && ($signal_num || $dumped_core)) {
3666 $cmdres = (2000 + $signal_num) if($signal_num && !$cmdres);
3670 # timestamp finishing of test command
3671 $timetoolend{$testnum} = Time::HiRes::time() if($timestats);
3675 # there's core file present now!
3681 logmsg "core dumped\n";
3683 logmsg "running gdb for post-mortem analysis:\n";
3684 open(GDBCMD, ">$LOGDIR/gdbcmd2");
3685 print GDBCMD "bt\n";
3687 runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch $DBGCURL core ");
3688 # unlink("$LOGDIR/gdbcmd2");
3692 # If a server logs advisor read lock file exists, it is an indication
3693 # that the server has not yet finished writing out all its log files,
3694 # including server request log files used for protocol verification.
3695 # So, if the lock file exists the script waits here a certain amount
3696 # of time until the server removes it, or the given time expires.
3698 if($serverlogslocktimeout) {
3699 my $lockretry = $serverlogslocktimeout * 20;
3700 while((-f $SERVERLOGS_LOCK) && $lockretry--) {
3701 select(undef, undef, undef, 0.05);
3703 if(($lockretry < 0) &&
3704 ($serverlogslocktimeout >= $defserverlogslocktimeout)) {
3705 logmsg "Warning: server logs lock timeout ",
3706 "($serverlogslocktimeout seconds) expired\n";
3710 # Test harness ssh server does not have this synchronization mechanism,
3711 # this implies that some ssh server based tests might need a small delay
3712 # once that the client command has run to avoid false test failures.
3714 # gnutls-serv also lacks this synchronization mechanism, so gnutls-serv
3715 # based tests might need a small delay once that the client command has
3716 # run to avoid false test failures.
3718 sleep($postcommanddelay) if($postcommanddelay);
3720 # timestamp removal of server logs advisor read lock
3721 $timesrvrlog{$testnum} = Time::HiRes::time() if($timestats);
3723 # test definition might instruct to stop some servers
3724 # stop also all servers relative to the given one
3726 my @killtestservers = getpart("client", "killserver");
3727 if(@killtestservers) {
3729 # All servers relative to the given one must be stopped also
3732 foreach my $server (@killtestservers) {
3734 if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
3735 # given a stunnel ssl server, also kill non-ssl underlying one
3736 push @killservers, "${1}${2}";
3738 elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|-unix|))$/) {
3739 # given a non-ssl server, also kill stunnel piggybacking one
3740 push @killservers, "${1}s${2}";
3742 elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
3743 # given a socks server, also kill ssh underlying one
3744 push @killservers, "ssh${2}";
3746 elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
3747 # given a ssh server, also kill socks piggybacking one
3748 push @killservers, "socks${2}";
3750 push @killservers, $server;
3753 # kill sockfilter processes for pingpong relative servers
3755 foreach my $server (@killservers) {
3756 if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
3758 my $idnum = ($2 && ($2 > 1)) ? $2 : 1;
3759 my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
3760 killsockfilters($proto, $ipvnum, $idnum, $verbose);
3764 # kill server relative pids clearing them in %run hash
3767 foreach my $server (@killservers) {
3769 $pidlist .= "$run{$server} ";
3772 $runcert{$server} = 0 if($runcert{$server});
3774 killpid($verbose, $pidlist);
3776 # cleanup server pid files
3778 foreach my $server (@killservers) {
3779 my $pidfile = $serverpidfile{$server};
3780 my $pid = processexists($pidfile);
3782 logmsg "Warning: $server server unexpectedly alive\n";
3783 killpid($verbose, $pid);
3785 unlink($pidfile) if(-f $pidfile);
3789 # remove the test server commands file after each test
3790 unlink($FTPDCMD) if(-f $FTPDCMD);
3792 # run the postcheck command
3793 my @postcheck= getpart("client", "postcheck");
3795 $cmd = $postcheck[0];
3799 logmsg "postcheck $cmd\n" if($verbose);
3800 my $rc = runclient("$cmd");
3801 # Must run the postcheck command in torture mode in order
3802 # to clean up, but the result can't be relied upon.
3803 if($rc != 0 && !$torture) {
3804 logmsg " postcheck FAILED\n";
3805 # timestamp test result verification end
3806 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3812 # restore environment variables that were modified
3814 foreach my $var (keys %oldenv) {
3815 if($oldenv{$var} eq 'notset') {
3816 delete $ENV{$var} if($ENV{$var});
3819 $ENV{$var} = "$oldenv{$var}";
3824 # Skip all the verification on torture tests
3826 if(!$cmdres && !$keepoutfiles) {
3829 # timestamp test result verification end
3830 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3834 my @err = getpart("verify", "errorcode");
3835 my $errorcode = $err[0] || "0";
3840 # verify redirected stdout
3841 my @actual = loadarray($STDOUT);
3843 # what parts to cut off from stdout
3844 my @stripfile = getpart("verify", "stripfile");
3846 foreach my $strip (@stripfile) {
3855 # this is to get rid of array entries that vanished (zero
3856 # length) because of replacements
3860 # variable-replace in the stdout we have from the test case file
3861 @validstdout = fixarray(@validstdout);
3863 # get all attributes
3864 my %hash = getpartattr("verify", "stdout");
3866 # get the mode attribute
3867 my $filemode=$hash{'mode'};
3868 if($filemode && ($filemode eq "text") && $has_textaware) {
3869 # text mode when running on windows: fix line endings
3870 map s/\r\n/\n/g, @validstdout;
3871 map s/\n/\r\n/g, @validstdout;
3874 if($hash{'nonewline'}) {
3875 # Yes, we must cut off the final newline from the final line
3876 # of the protocol data
3877 chomp($validstdout[$#validstdout]);
3880 $res = compare($testnum, $testname, "stdout", \@actual, \@validstdout);
3887 $ok .= "-"; # stdout not checked
3891 # Verify the sent request
3892 my @out = loadarray($SERVERIN);
3894 # what to cut off from the live protocol sent by curl
3895 my @strip = getpart("verify", "strip");
3897 my @protstrip=@protocol;
3899 # check if there's any attributes on the verify/protocol section
3900 my %hash = getpartattr("verify", "protocol");
3902 if($hash{'nonewline'}) {
3903 # Yes, we must cut off the final newline from the final line
3904 # of the protocol data
3905 chomp($protstrip[$#protstrip]);
3909 # strip off all lines that match the patterns from both arrays
3911 @out = striparray( $_, \@out);
3912 @protstrip= striparray( $_, \@protstrip);
3915 # what parts to cut off from the protocol
3916 my @strippart = getpart("verify", "strippart");
3918 for $strip (@strippart) {
3925 $res = compare($testnum, $testname, "protocol", \@out, \@protstrip);
3934 $ok .= "-"; # protocol not checked
3937 if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
3938 # verify the received data
3939 my @out = loadarray($CURLOUT);
3940 $res = compare($testnum, $testname, "data", \@out, \@reply);
3947 $ok .= "-"; # data not checked
3951 # verify uploaded data
3952 my @out = loadarray("$LOGDIR/upload.$testnum");
3953 $res = compare($testnum, $testname, "upload", \@out, \@upload);
3960 $ok .= "-"; # upload not checked
3964 # Verify the sent proxy request
3965 my @out = loadarray($PROXYIN);
3967 # what to cut off from the live protocol sent by curl, we use the
3968 # same rules as for <protocol>
3969 my @strip = getpart("verify", "strip");
3971 my @protstrip=@proxyprot;
3973 # check if there's any attributes on the verify/protocol section
3974 my %hash = getpartattr("verify", "proxy");
3976 if($hash{'nonewline'}) {
3977 # Yes, we must cut off the final newline from the final line
3978 # of the protocol data
3979 chomp($protstrip[$#protstrip]);
3983 # strip off all lines that match the patterns from both arrays
3985 @out = striparray( $_, \@out);
3986 @protstrip= striparray( $_, \@protstrip);
3989 # what parts to cut off from the protocol
3990 my @strippart = getpart("verify", "strippart");
3992 for $strip (@strippart) {
3999 $res = compare($testnum, $testname, "proxy", \@out, \@protstrip);
4008 $ok .= "-"; # protocol not checked
4012 for my $partsuffix (('', '1', '2', '3', '4')) {
4013 my @outfile=getpart("verify", "file".$partsuffix);
4014 if(@outfile || partexists("verify", "file".$partsuffix) ) {
4015 # we're supposed to verify a dynamically generated file!
4016 my %hash = getpartattr("verify", "file".$partsuffix);
4018 my $filename=$hash{'name'};
4020 logmsg "ERROR: section verify=>file$partsuffix ".
4021 "has no name attribute\n";
4022 stopservers($verbose);
4023 # timestamp test result verification end
4024 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4027 my @generated=loadarray($filename);
4029 # what parts to cut off from the file
4030 my @stripfile = getpart("verify", "stripfile".$partsuffix);
4032 my $filemode=$hash{'mode'};
4033 if($filemode && ($filemode eq "text") && $has_textaware) {
4034 # text mode when running on windows: fix line endings
4035 map s/\r\n/\n/g, @outfile;
4036 map s/\n/\r\n/g, @outfile;
4040 for $strip (@stripfile) {
4049 # this is to get rid of array entries that vanished (zero
4050 # length) because of replacements
4051 @generated = @newgen;
4054 @outfile = fixarray(@outfile);
4056 $res = compare($testnum, $testname, "output ($filename)",
4057 \@generated, \@outfile);
4062 $outputok = 1; # output checked
4065 $ok .= ($outputok) ? "o" : "-"; # output checked or not
4067 # accept multiple comma-separated error codes
4068 my @splerr = split(/ *, */, $errorcode);
4070 foreach my $e (@splerr) {
4083 logmsg sprintf("\n%s returned $cmdres, when expecting %s\n",
4084 (!$tool)?"curl":$tool, $errorcode);
4086 logmsg " exit FAILED\n";
4087 # timestamp test result verification end
4088 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4092 if($has_memory_tracking) {
4094 logmsg "\n** ALERT! memory tracking with no output file?\n"
4095 if(!$cmdtype eq "perl");
4098 my @memdata=`$memanalyze $memdump`;
4102 # well it could be other memory problems as well, but
4103 # we call it leak for short here
4108 logmsg "\n** MEMORY FAILURE\n";
4110 # timestamp test result verification end
4111 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4120 $ok .= "-"; # memory not checked
4125 unless(opendir(DIR, "$LOGDIR")) {
4126 logmsg "ERROR: unable to read $LOGDIR\n";
4127 # timestamp test result verification end
4128 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4131 my @files = readdir(DIR);
4134 foreach my $file (@files) {
4135 if($file =~ /^valgrind$testnum(\..*|)$/) {
4141 logmsg "ERROR: valgrind log file missing for test $testnum\n";
4142 # timestamp test result verification end
4143 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4146 my @e = valgrindparse($srcdir, $feature{'SSL'}, "$LOGDIR/$vgfile");
4148 if($automakestyle) {
4149 logmsg "FAIL: $testnum - $testname - valgrind\n";
4152 logmsg " valgrind ERROR ";
4155 # timestamp test result verification end
4156 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4162 if(!$short && !$disablevalgrind) {
4163 logmsg " valgrind SKIPPED\n";
4165 $ok .= "-"; # skipped
4169 $ok .= "-"; # valgrind not checked
4171 # add 'E' for event-based
4172 $ok .= $evbased ? "E" : "-";
4174 logmsg "$ok " if(!$short);
4176 my $sofar= time()-$start;
4177 my $esttotal = $sofar/$count * $total;
4178 my $estleft = $esttotal - $sofar;
4179 my $left=sprintf("remaining: %02d:%02d",
4183 if(!$automakestyle) {
4184 logmsg sprintf("OK (%-3d out of %-3d, %s)\n", $count, $total, $left);
4187 logmsg "PASS: $testnum - $testname\n";
4190 # the test succeeded, remove all log files
4191 if(!$keepoutfiles) {
4195 # timestamp test result verification end
4196 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
4201 #######################################################################
4202 # Stop all running test servers
4205 my $verbose = $_[0];
4207 # kill sockfilter processes for all pingpong servers
4209 killallsockfilters($verbose);
4211 # kill all server pids from %run hash clearing them
4214 foreach my $server (keys %run) {
4218 my $pids = $run{$server};
4219 foreach my $pid (split(' ', $pids)) {
4221 logmsg sprintf("* kill pid for %s => %d\n",
4227 $pidlist .= "$run{$server} ";
4230 $runcert{$server} = 0 if($runcert{$server});
4232 killpid($verbose, $pidlist);
4234 # cleanup all server pid files
4236 foreach my $server (keys %serverpidfile) {
4237 my $pidfile = $serverpidfile{$server};
4238 my $pid = processexists($pidfile);
4240 logmsg "Warning: $server server unexpectedly alive\n";
4241 killpid($verbose, $pid);
4243 unlink($pidfile) if(-f $pidfile);
4247 #######################################################################
4248 # startservers() starts all the named servers
4250 # Returns: string with error reason or blank for success
4256 my (@whatlist) = split(/\s+/,$_);
4257 my $what = lc($whatlist[0]);
4258 $what =~ s/[^a-z0-9\/-]//g;
4261 if($what =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
4262 $certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem';
4265 if(($what eq "pop3") ||
4267 ($what eq "imap") ||
4268 ($what eq "smtp")) {
4269 if($torture && $run{$what} &&
4270 !responsive_pingpong_server($what, "", $verbose)) {
4274 ($pid, $pid2) = runpingpongserver($what, "", $verbose);
4276 return "failed starting ". uc($what) ." server";
4278 printf ("* pid $what => %d %d\n", $pid, $pid2) if($verbose);
4279 $run{$what}="$pid $pid2";
4282 elsif($what eq "ftp2") {
4283 if($torture && $run{'ftp2'} &&
4284 !responsive_pingpong_server("ftp", "2", $verbose)) {
4288 ($pid, $pid2) = runpingpongserver("ftp", "2", $verbose);
4290 return "failed starting FTP2 server";
4292 printf ("* pid ftp2 => %d %d\n", $pid, $pid2) if($verbose);
4293 $run{'ftp2'}="$pid $pid2";
4296 elsif($what eq "ftp-ipv6") {
4297 if($torture && $run{'ftp-ipv6'} &&
4298 !responsive_pingpong_server("ftp", "", $verbose, "ipv6")) {
4299 stopserver('ftp-ipv6');
4301 if(!$run{'ftp-ipv6'}) {
4302 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose, "ipv6");
4304 return "failed starting FTP-IPv6 server";
4306 logmsg sprintf("* pid ftp-ipv6 => %d %d\n", $pid,
4307 $pid2) if($verbose);
4308 $run{'ftp-ipv6'}="$pid $pid2";
4311 elsif($what eq "gopher") {
4312 if($torture && $run{'gopher'} &&
4313 !responsive_http_server("gopher", $verbose, 0, $GOPHERPORT)) {
4314 stopserver('gopher');
4316 if(!$run{'gopher'}) {
4317 ($pid, $pid2) = runhttpserver("gopher", $verbose, 0,
4320 return "failed starting GOPHER server";
4322 logmsg sprintf ("* pid gopher => %d %d\n", $pid, $pid2)
4324 $run{'gopher'}="$pid $pid2";
4327 elsif($what eq "gopher-ipv6") {
4328 if($torture && $run{'gopher-ipv6'} &&
4329 !responsive_http_server("gopher", $verbose, "ipv6",
4331 stopserver('gopher-ipv6');
4333 if(!$run{'gopher-ipv6'}) {
4334 ($pid, $pid2) = runhttpserver("gopher", $verbose, "ipv6",
4337 return "failed starting GOPHER-IPv6 server";
4339 logmsg sprintf("* pid gopher-ipv6 => %d %d\n", $pid,
4340 $pid2) if($verbose);
4341 $run{'gopher-ipv6'}="$pid $pid2";
4344 elsif($what eq "http/2") {
4345 if(!$run{'http/2'}) {
4346 ($pid, $pid2) = runhttp2server($verbose, $HTTP2PORT);
4348 return "failed starting HTTP/2 server";
4350 logmsg sprintf ("* pid http/2 => %d %d\n", $pid, $pid2)
4352 $run{'http/2'}="$pid $pid2";
4355 elsif($what eq "http") {
4356 if($torture && $run{'http'} &&
4357 !responsive_http_server("http", $verbose, 0, $HTTPPORT)) {
4361 ($pid, $pid2) = runhttpserver("http", $verbose, 0,
4364 return "failed starting HTTP server";
4366 logmsg sprintf ("* pid http => %d %d\n", $pid, $pid2)
4368 $run{'http'}="$pid $pid2";
4371 elsif($what eq "http-proxy") {
4372 if($torture && $run{'http-proxy'} &&
4373 !responsive_http_server("http", $verbose, "proxy",
4375 stopserver('http-proxy');
4377 if(!$run{'http-proxy'}) {
4378 ($pid, $pid2) = runhttpserver("http", $verbose, "proxy",
4381 return "failed starting HTTP-proxy server";
4383 logmsg sprintf ("* pid http-proxy => %d %d\n", $pid, $pid2)
4385 $run{'http-proxy'}="$pid $pid2";
4388 elsif($what eq "http-ipv6") {
4389 if($torture && $run{'http-ipv6'} &&
4390 !responsive_http_server("http", $verbose, "ipv6", $HTTP6PORT)) {
4391 stopserver('http-ipv6');
4393 if(!$run{'http-ipv6'}) {
4394 ($pid, $pid2) = runhttpserver("http", $verbose, "ipv6",
4397 return "failed starting HTTP-IPv6 server";
4399 logmsg sprintf("* pid http-ipv6 => %d %d\n", $pid, $pid2)
4401 $run{'http-ipv6'}="$pid $pid2";
4404 elsif($what eq "http-pipe") {
4405 if($torture && $run{'http-pipe'} &&
4406 !responsive_http_server("http", $verbose, "pipe",
4408 stopserver('http-pipe');
4410 if(!$run{'http-pipe'}) {
4411 ($pid, $pid2) = runhttpserver("http", $verbose, "pipe",
4414 return "failed starting HTTP-pipe server";
4416 logmsg sprintf ("* pid http-pipe => %d %d\n", $pid, $pid2)
4418 $run{'http-pipe'}="$pid $pid2";
4421 elsif($what eq "rtsp") {
4422 if($torture && $run{'rtsp'} &&
4423 !responsive_rtsp_server($verbose)) {
4427 ($pid, $pid2) = runrtspserver($verbose);
4429 return "failed starting RTSP server";
4431 printf ("* pid rtsp => %d %d\n", $pid, $pid2) if($verbose);
4432 $run{'rtsp'}="$pid $pid2";
4435 elsif($what eq "rtsp-ipv6") {
4436 if($torture && $run{'rtsp-ipv6'} &&
4437 !responsive_rtsp_server($verbose, "ipv6")) {
4438 stopserver('rtsp-ipv6');
4440 if(!$run{'rtsp-ipv6'}) {
4441 ($pid, $pid2) = runrtspserver($verbose, "ipv6");
4443 return "failed starting RTSP-IPv6 server";
4445 logmsg sprintf("* pid rtsp-ipv6 => %d %d\n", $pid, $pid2)
4447 $run{'rtsp-ipv6'}="$pid $pid2";
4450 elsif($what eq "ftps") {
4452 # we can't run ftps tests without stunnel
4453 return "no stunnel";
4456 # we can't run ftps tests if libcurl is SSL-less
4457 return "curl lacks SSL support";
4459 if($runcert{'ftps'} && ($runcert{'ftps'} ne $certfile)) {
4460 # stop server when running and using a different cert
4463 if($torture && $run{'ftp'} &&
4464 !responsive_pingpong_server("ftp", "", $verbose)) {
4468 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose);
4470 return "failed starting FTP server";
4472 printf ("* pid ftp => %d %d\n", $pid, $pid2) if($verbose);
4473 $run{'ftp'}="$pid $pid2";
4476 ($pid, $pid2) = runftpsserver($verbose, "", $certfile);
4478 return "failed starting FTPS server (stunnel)";
4480 logmsg sprintf("* pid ftps => %d %d\n", $pid, $pid2)
4482 $run{'ftps'}="$pid $pid2";
4485 elsif($what eq "file") {
4486 # we support it but have no server!
4488 elsif($what eq "https") {
4490 # we can't run https tests without stunnel
4491 return "no stunnel";
4494 # we can't run https tests if libcurl is SSL-less
4495 return "curl lacks SSL support";
4497 if($runcert{'https'} && ($runcert{'https'} ne $certfile)) {
4498 # stop server when running and using a different cert
4499 stopserver('https');
4501 if($torture && $run{'http'} &&
4502 !responsive_http_server("http", $verbose, 0, $HTTPPORT)) {
4506 ($pid, $pid2) = runhttpserver("http", $verbose, 0,
4509 return "failed starting HTTP server";
4511 printf ("* pid http => %d %d\n", $pid, $pid2) if($verbose);
4512 $run{'http'}="$pid $pid2";
4514 if(!$run{'https'}) {
4515 ($pid, $pid2) = runhttpsserver($verbose, "", $certfile);
4517 return "failed starting HTTPS server (stunnel)";
4519 logmsg sprintf("* pid https => %d %d\n", $pid, $pid2)
4521 $run{'https'}="$pid $pid2";
4524 elsif($what eq "httptls") {
4526 # for now, we can't run http TLS-EXT tests without gnutls-serv
4527 return "no gnutls-serv";
4529 if($torture && $run{'httptls'} &&
4530 !responsive_httptls_server($verbose, "IPv4")) {
4531 stopserver('httptls');
4533 if(!$run{'httptls'}) {
4534 ($pid, $pid2) = runhttptlsserver($verbose, "IPv4");
4536 return "failed starting HTTPTLS server (gnutls-serv)";
4538 logmsg sprintf("* pid httptls => %d %d\n", $pid, $pid2)
4540 $run{'httptls'}="$pid $pid2";
4543 elsif($what eq "httptls-ipv6") {
4545 # for now, we can't run http TLS-EXT tests without gnutls-serv
4546 return "no gnutls-serv";
4548 if($torture && $run{'httptls-ipv6'} &&
4549 !responsive_httptls_server($verbose, "ipv6")) {
4550 stopserver('httptls-ipv6');
4552 if(!$run{'httptls-ipv6'}) {
4553 ($pid, $pid2) = runhttptlsserver($verbose, "ipv6");
4555 return "failed starting HTTPTLS-IPv6 server (gnutls-serv)";
4557 logmsg sprintf("* pid httptls-ipv6 => %d %d\n", $pid, $pid2)
4559 $run{'httptls-ipv6'}="$pid $pid2";
4562 elsif($what eq "tftp") {
4563 if($torture && $run{'tftp'} &&
4564 !responsive_tftp_server("", $verbose)) {
4568 ($pid, $pid2) = runtftpserver("", $verbose);
4570 return "failed starting TFTP server";
4572 printf ("* pid tftp => %d %d\n", $pid, $pid2) if($verbose);
4573 $run{'tftp'}="$pid $pid2";
4576 elsif($what eq "tftp-ipv6") {
4577 if($torture && $run{'tftp-ipv6'} &&
4578 !responsive_tftp_server("", $verbose, "ipv6")) {
4579 stopserver('tftp-ipv6');
4581 if(!$run{'tftp-ipv6'}) {
4582 ($pid, $pid2) = runtftpserver("", $verbose, "ipv6");
4584 return "failed starting TFTP-IPv6 server";
4586 printf("* pid tftp-ipv6 => %d %d\n", $pid, $pid2) if($verbose);
4587 $run{'tftp-ipv6'}="$pid $pid2";
4590 elsif($what eq "sftp" || $what eq "scp" || $what eq "socks4" || $what eq "socks5" ) {
4592 ($pid, $pid2) = runsshserver("", $verbose);
4594 return "failed starting SSH server";
4596 printf ("* pid ssh => %d %d\n", $pid, $pid2) if($verbose);
4597 $run{'ssh'}="$pid $pid2";
4599 if($what eq "socks4" || $what eq "socks5") {
4600 if(!$run{'socks'}) {
4601 ($pid, $pid2) = runsocksserver("", $verbose);
4603 return "failed starting socks server";
4605 printf ("* pid socks => %d %d\n", $pid, $pid2) if($verbose);
4606 $run{'socks'}="$pid $pid2";
4609 if($what eq "socks5") {
4611 # Not an OpenSSH or SunSSH ssh daemon
4612 logmsg "Not OpenSSH or SunSSH; socks5 tests need at least OpenSSH 3.7\n";
4613 return "failed starting socks5 server";
4615 elsif(($sshdid =~ /OpenSSH/) && ($sshdvernum < 370)) {
4616 # Need OpenSSH 3.7 for socks5 - http://www.openssh.com/txt/release-3.7
4617 logmsg "$sshdverstr insufficient; socks5 tests need at least OpenSSH 3.7\n";
4618 return "failed starting socks5 server";
4620 elsif(($sshdid =~ /SunSSH/) && ($sshdvernum < 100)) {
4621 # Need SunSSH 1.0 for socks5
4622 logmsg "$sshdverstr insufficient; socks5 tests need at least SunSSH 1.0\n";
4623 return "failed starting socks5 server";
4627 elsif($what eq "http-unix") {
4628 if($torture && $run{'http-unix'} &&
4629 !responsive_http_server("http", $verbose, "unix", $HTTPUNIXPATH)) {
4630 stopserver('http-unix');
4632 if(!$run{'http-unix'}) {
4633 ($pid, $pid2) = runhttpserver("http", $verbose, "unix",
4636 return "failed starting HTTP-unix server";
4638 logmsg sprintf("* pid http-unix => %d %d\n", $pid, $pid2)
4640 $run{'http-unix'}="$pid $pid2";
4643 elsif($what eq "none") {
4644 logmsg "* starts no server\n" if ($verbose);
4647 warn "we don't support a server for $what";
4648 return "no server for $what";
4654 ##############################################################################
4655 # This function makes sure the right set of server is running for the
4656 # specified test case. This is a useful design when we run single tests as not
4657 # all servers need to run then!
4659 # Returns: a string, blank if everything is fine or a reason why it failed
4664 my @what = getpart("client", "server");
4667 warn "Test case $testnum has no server(s) specified";
4668 return "no server specified";
4671 for(my $i = scalar(@what) - 1; $i >= 0; $i--) {
4672 my $srvrline = $what[$i];
4673 chomp $srvrline if($srvrline);
4674 if($srvrline =~ /^(\S+)((\s*)(.*))/) {
4675 my $server = "${1}";
4676 my $lnrest = "${2}";
4678 if($server =~ /^(httptls)(\+)(ext|srp)(\d*)(-ipv6|)$/) {
4679 $server = "${1}${4}${5}";
4680 $tlsext = uc("TLS-${3}");
4682 if(! grep /^\Q$server\E$/, @protocols) {
4683 if(substr($server,0,5) ne "socks") {
4685 return "curl lacks $tlsext support";
4688 return "curl lacks $server server support";
4692 $what[$i] = "$server$lnrest" if($tlsext);
4696 return &startservers(@what);
4699 #######################################################################
4700 # runtimestats displays test-suite run time statistics
4703 my $lasttest = $_[0];
4705 return if(not $timestats);
4707 logmsg "\nTest suite total running time breakdown per task...\n\n";
4715 my $timesrvrtot = 0.0;
4716 my $timepreptot = 0.0;
4717 my $timetooltot = 0.0;
4718 my $timelocktot = 0.0;
4719 my $timevrfytot = 0.0;
4720 my $timetesttot = 0.0;
4723 for my $testnum (1 .. $lasttest) {
4724 if($timesrvrini{$testnum}) {
4725 $timesrvrtot += $timesrvrend{$testnum} - $timesrvrini{$testnum};
4727 (($timetoolini{$testnum} - $timeprepini{$testnum}) -
4728 ($timesrvrend{$testnum} - $timesrvrini{$testnum}));
4729 $timetooltot += $timetoolend{$testnum} - $timetoolini{$testnum};
4730 $timelocktot += $timesrvrlog{$testnum} - $timetoolend{$testnum};
4731 $timevrfytot += $timevrfyend{$testnum} - $timesrvrlog{$testnum};
4732 $timetesttot += $timevrfyend{$testnum} - $timeprepini{$testnum};
4733 push @timesrvr, sprintf("%06.3f %04d",
4734 $timesrvrend{$testnum} - $timesrvrini{$testnum}, $testnum);
4735 push @timeprep, sprintf("%06.3f %04d",
4736 ($timetoolini{$testnum} - $timeprepini{$testnum}) -
4737 ($timesrvrend{$testnum} - $timesrvrini{$testnum}), $testnum);
4738 push @timetool, sprintf("%06.3f %04d",
4739 $timetoolend{$testnum} - $timetoolini{$testnum}, $testnum);
4740 push @timelock, sprintf("%06.3f %04d",
4741 $timesrvrlog{$testnum} - $timetoolend{$testnum}, $testnum);
4742 push @timevrfy, sprintf("%06.3f %04d",
4743 $timevrfyend{$testnum} - $timesrvrlog{$testnum}, $testnum);
4744 push @timetest, sprintf("%06.3f %04d",
4745 $timevrfyend{$testnum} - $timeprepini{$testnum}, $testnum);
4750 no warnings 'numeric';
4751 @timesrvr = sort { $b <=> $a } @timesrvr;
4752 @timeprep = sort { $b <=> $a } @timeprep;
4753 @timetool = sort { $b <=> $a } @timetool;
4754 @timelock = sort { $b <=> $a } @timelock;
4755 @timevrfy = sort { $b <=> $a } @timevrfy;
4756 @timetest = sort { $b <=> $a } @timetest;
4759 logmsg "Spent ". sprintf("%08.3f ", $timesrvrtot) .
4760 "seconds starting and verifying test harness servers.\n";
4761 logmsg "Spent ". sprintf("%08.3f ", $timepreptot) .
4762 "seconds reading definitions and doing test preparations.\n";
4763 logmsg "Spent ". sprintf("%08.3f ", $timetooltot) .
4764 "seconds actually running test tools.\n";
4765 logmsg "Spent ". sprintf("%08.3f ", $timelocktot) .
4766 "seconds awaiting server logs lock removal.\n";
4767 logmsg "Spent ". sprintf("%08.3f ", $timevrfytot) .
4768 "seconds verifying test results.\n";
4769 logmsg "Spent ". sprintf("%08.3f ", $timetesttot) .
4770 "seconds doing all of the above.\n";
4773 logmsg "\nTest server starting and verification time per test ".
4774 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4775 logmsg "-time- test\n";
4776 logmsg "------ ----\n";
4777 foreach my $txt (@timesrvr) {
4778 last if((not $fullstats) && (not $counter--));
4783 logmsg "\nTest definition reading and preparation time per test ".
4784 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4785 logmsg "-time- test\n";
4786 logmsg "------ ----\n";
4787 foreach my $txt (@timeprep) {
4788 last if((not $fullstats) && (not $counter--));
4793 logmsg "\nTest tool execution time per test ".
4794 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4795 logmsg "-time- test\n";
4796 logmsg "------ ----\n";
4797 foreach my $txt (@timetool) {
4798 last if((not $fullstats) && (not $counter--));
4803 logmsg "\nTest server logs lock removal time per test ".
4804 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4805 logmsg "-time- test\n";
4806 logmsg "------ ----\n";
4807 foreach my $txt (@timelock) {
4808 last if((not $fullstats) && (not $counter--));
4813 logmsg "\nTest results verification time per test ".
4814 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4815 logmsg "-time- test\n";
4816 logmsg "------ ----\n";
4817 foreach my $txt (@timevrfy) {
4818 last if((not $fullstats) && (not $counter--));
4823 logmsg "\nTotal time per test ".
4824 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4825 logmsg "-time- test\n";
4826 logmsg "------ ----\n";
4827 foreach my $txt (@timetest) {
4828 last if((not $fullstats) && (not $counter--));
4835 #######################################################################
4836 # Check options to this test program
4843 if ($ARGV[0] eq "-v") {
4847 elsif($ARGV[0] =~ /^-b(.*)/) {
4849 if($portno =~ s/(\d+)$//) {
4853 elsif ($ARGV[0] eq "-c") {
4854 # use this path to curl instead of default
4855 $DBGCURL=$CURL="\"$ARGV[1]\"";
4858 elsif ($ARGV[0] eq "-vc") {
4859 # use this path to a curl used to verify servers
4861 # Particularly useful when you introduce a crashing bug somewhere in
4862 # the development version as then it won't be able to run any tests
4863 # since it can't verify the servers!
4865 $VCURL="\"$ARGV[1]\"";
4868 elsif ($ARGV[0] eq "-d") {
4869 # have the servers display protocol output
4872 elsif ($ARGV[0] eq "-g") {
4873 # run this test with gdb
4876 elsif ($ARGV[0] eq "-gw") {
4877 # run this test with windowed gdb
4881 elsif($ARGV[0] eq "-s") {
4885 elsif($ARGV[0] eq "-am") {
4886 # automake-style output
4890 elsif($ARGV[0] eq "-n") {
4894 elsif($ARGV[0] =~ /^-t(.*)/) {
4899 if($xtra =~ s/(\d+)$//) {
4902 # we undef valgrind to make this fly in comparison
4905 elsif($ARGV[0] eq "-a") {
4906 # continue anyway, even if a test fail
4909 elsif($ARGV[0] eq "-e") {
4910 # run the tests cases event based if possible
4913 elsif($ARGV[0] eq "-p") {
4916 elsif($ARGV[0] eq "-l") {
4917 # lists the test case names only
4920 elsif($ARGV[0] eq "-k") {
4921 # keep stdout and stderr files after tests
4924 elsif($ARGV[0] eq "-r") {
4925 # run time statistics needs Time::HiRes
4926 if($Time::HiRes::VERSION) {
4927 keys(%timeprepini) = 1000;
4928 keys(%timesrvrini) = 1000;
4929 keys(%timesrvrend) = 1000;
4930 keys(%timetoolini) = 1000;
4931 keys(%timetoolend) = 1000;
4932 keys(%timesrvrlog) = 1000;
4933 keys(%timevrfyend) = 1000;
4938 elsif($ARGV[0] eq "-rf") {
4939 # run time statistics needs Time::HiRes
4940 if($Time::HiRes::VERSION) {
4941 keys(%timeprepini) = 1000;
4942 keys(%timesrvrini) = 1000;
4943 keys(%timesrvrend) = 1000;
4944 keys(%timetoolini) = 1000;
4945 keys(%timetoolend) = 1000;
4946 keys(%timesrvrlog) = 1000;
4947 keys(%timevrfyend) = 1000;
4952 elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
4955 Usage: runtests.pl [options] [test selection(s)]
4956 -a continue even if a test fails
4957 -bN use base port number N for test servers (default $base)
4958 -c path use this curl executable
4959 -d display server debug info
4960 -g run the test case with gdb
4961 -gw run the test case with gdb as a windowed application
4963 -k keep stdout and stderr files present after tests
4964 -l list all test case names/descriptions
4966 -p print log file contents when a test fails
4967 -r run time statistics
4968 -rf full run time statistics
4970 -am automake style output PASS/FAIL: [number] [name]
4971 -t[N] torture (simulate memory alloc failures); N means fail Nth alloc
4973 -vc path use this curl only to verify the existing servers
4974 [num] like "5 6 9" or " 5 to 22 " to run those tests only
4975 [!num] like "!5 !6 !9" to disable those tests
4976 [keyword] like "IPv6" to select only tests containing the key word
4977 [!keyword] like "!cookies" to disable any tests containing the key word
4982 elsif($ARGV[0] =~ /^(\d+)/) {
4985 for($fromnum .. $number) {
4994 elsif($ARGV[0] =~ /^to$/i) {
4995 $fromnum = $number+1;
4997 elsif($ARGV[0] =~ /^!(\d+)/) {
5001 elsif($ARGV[0] =~ /^!(.+)/) {
5002 $disabled_keywords{$1}=$1;
5004 elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) {
5005 $enabled_keywords{$1}=$1;
5008 print "Unknown option: $ARGV[0]\n";
5014 if(@testthis && ($testthis[0] ne "")) {
5015 $TESTCASES=join(" ", @testthis);
5019 # we have found valgrind on the host, use it
5021 # verify that we can invoke it fine
5022 my $code = runclient("valgrind >/dev/null 2>&1");
5024 if(($code>>8) != 1) {
5025 #logmsg "Valgrind failure, disable it\n";
5029 # since valgrind 2.1.x, '--tool' option is mandatory
5030 # use it, if it is supported by the version installed on the system
5031 runclient("valgrind --help 2>&1 | grep -- --tool > /dev/null 2>&1");
5033 $valgrind_tool="--tool=memcheck";
5038 # A shell script. This is typically when built with libtool,
5039 $valgrind="../libtool --mode=execute $valgrind";
5043 # valgrind 3 renamed the --logfile option to --log-file!!!
5044 my $ver=join(' ', runclientoutput("valgrind --version"));
5045 # cut off all but digits and dots
5046 $ver =~ s/[^0-9.]//g;
5048 if($ver =~ /^(\d+)/) {
5051 $valgrind_logfile="--log-file";
5058 # open the executable curl and read the first 4 bytes of it
5059 open(CHECK, "<$CURL");
5061 sysread CHECK, $c, 4;
5064 # A shell script. This is typically when built with libtool,
5066 $gdb = "../libtool --mode=execute gdb";
5070 $HTTPPORT = $base++; # HTTP server port
5071 $HTTPSPORT = $base++; # HTTPS (stunnel) server port
5072 $FTPPORT = $base++; # FTP server port
5073 $FTPSPORT = $base++; # FTPS (stunnel) server port
5074 $HTTP6PORT = $base++; # HTTP IPv6 server port
5075 $FTP2PORT = $base++; # FTP server 2 port
5076 $FTP6PORT = $base++; # FTP IPv6 port
5077 $TFTPPORT = $base++; # TFTP (UDP) port
5078 $TFTP6PORT = $base++; # TFTP IPv6 (UDP) port
5079 $SSHPORT = $base++; # SSH (SCP/SFTP) port
5080 $SOCKSPORT = $base++; # SOCKS port
5081 $POP3PORT = $base++; # POP3 server port
5082 $POP36PORT = $base++; # POP3 IPv6 server port
5083 $IMAPPORT = $base++; # IMAP server port
5084 $IMAP6PORT = $base++; # IMAP IPv6 server port
5085 $SMTPPORT = $base++; # SMTP server port
5086 $SMTP6PORT = $base++; # SMTP IPv6 server port
5087 $RTSPPORT = $base++; # RTSP server port
5088 $RTSP6PORT = $base++; # RTSP IPv6 server port
5089 $GOPHERPORT = $base++; # Gopher IPv4 server port
5090 $GOPHER6PORT = $base++; # Gopher IPv6 server port
5091 $HTTPTLSPORT = $base++; # HTTP TLS (non-stunnel) server port
5092 $HTTPTLS6PORT = $base++; # HTTP TLS (non-stunnel) IPv6 server port
5093 $HTTPPROXYPORT = $base++; # HTTP proxy port, when using CONNECT
5094 $HTTPPIPEPORT = $base++; # HTTP pipelining port
5095 $HTTP2PORT = $base++; # HTTP/2 port
5096 $HTTPUNIXPATH = 'http.sock'; # HTTP server Unix domain socket path
5098 #######################################################################
5099 # clear and create logging directory:
5103 mkdir($LOGDIR, 0777);
5105 #######################################################################
5106 # initialize some variables
5110 init_serverpidfile_hash();
5112 #######################################################################
5113 # Output curl version and host info being tested
5120 #######################################################################
5121 # Fetch all disabled tests, if there are any
5127 if(open(D, "<$file")) {
5134 $disabled{$1}=$1; # disable this test number
5141 # globally disabled tests
5142 disabledtests("$TESTDIR/DISABLED");
5144 # locally disabled tests, ignored by git etc
5145 disabledtests("$TESTDIR/DISABLED.local");
5147 #######################################################################
5148 # If 'all' tests are requested, find out all test numbers
5151 if ( $TESTCASES eq "all") {
5152 # Get all commands and find out their test numbers
5153 opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
5154 my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
5157 $TESTCASES=""; # start with no test cases
5159 # cut off everything but the digits
5161 $_ =~ s/[a-z\/\.]*//g;
5163 # sort the numbers from low to high
5164 foreach my $n (sort { $a <=> $b } @cmds) {
5166 # skip disabled test cases
5167 my $why = "configured as DISABLED";
5170 $teststat[$n]=$why; # store reason for this test case
5173 $TESTCASES .= " $n";
5179 if (-e "$TESTDIR/test$_") {
5182 } split(" ", $TESTCASES);
5183 if($verified eq "") {
5184 print "No existing test cases were specified\n";
5187 $TESTCASES = $verified;
5190 #######################################################################
5191 # Start the command line log
5193 open(CMDLOG, ">$CURLLOG") ||
5194 logmsg "can't log command lines to $CURLLOG\n";
5196 #######################################################################
5198 # Display the contents of the given file. Line endings are canonicalized
5199 # and excessively long files are elided
5200 sub displaylogcontent {
5202 if(open(SINGLE, "<$file")) {
5206 while(my $string = <SINGLE>) {
5207 $string =~ s/\r\n/\n/g;
5208 $string =~ s/[\r\f\032]/\n/g;
5209 $string .= "\n" unless ($string =~ /\n$/);
5211 for my $line (split("\n", $string)) {
5212 $line =~ s/\s*\!$//;
5214 push @tail, " $line\n";
5219 $truncate = $linecount > 1000;
5225 my $tailtotal = scalar @tail;
5226 if($tailtotal > $tailshow) {
5227 $tailskip = $tailtotal - $tailshow;
5228 logmsg "=== File too long: $tailskip lines omitted here\n";
5230 for($tailskip .. $tailtotal-1) {
5240 opendir(DIR, "$LOGDIR") ||
5241 die "can't open dir: $!";
5242 my @logs = readdir(DIR);
5245 logmsg "== Contents of files in the $LOGDIR/ dir after test $testnum\n";
5246 foreach my $log (sort @logs) {
5247 if($log =~ /\.(\.|)$/) {
5248 next; # skip "." and ".."
5250 if($log =~ /^\.nfs/) {
5253 if(($log eq "memdump") || ($log eq "core")) {
5254 next; # skip "memdump" and "core"
5256 if((-d "$LOGDIR/$log") || (! -s "$LOGDIR/$log")) {
5257 next; # skip directory and empty files
5259 if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) {
5260 next; # skip stdoutNnn of other tests
5262 if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) {
5263 next; # skip stderrNnn of other tests
5265 if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) {
5266 next; # skip uploadNnn of other tests
5268 if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) {
5269 next; # skip curlNnn.out of other tests
5271 if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) {
5272 next; # skip testNnn.txt of other tests
5274 if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) {
5275 next; # skip fileNnn.txt of other tests
5277 if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) {
5278 next; # skip netrcNnn of other tests
5280 if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) {
5281 next; # skip traceNnn of other tests
5283 if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(\..*|)$/)) {
5284 next; # skip valgrindNnn of other tests
5286 logmsg "=== Start of file $log\n";
5287 displaylogcontent("$LOGDIR/$log");
5288 logmsg "=== End of file $log\n";
5292 #######################################################################
5293 # The main test-loop
5301 my @at = split(" ", $TESTCASES);
5306 foreach $testnum (@at) {
5308 $lasttest = $testnum if($testnum > $lasttest);
5311 my $error = singletest($run_event_based, $testnum, $count, scalar(@at));
5313 # not a test we can run
5317 $total++; # number of tests we've run
5320 $failed.= "$testnum ";
5322 # display all files in log/ in a nice way
5323 displaylogs($testnum);
5326 # a test failed, abort
5327 logmsg "\n - abort tests\n";
5332 $ok++; # successful test counter
5335 # loop for next test
5338 my $sofar = time() - $start;
5340 #######################################################################
5345 # Tests done, stop the servers
5346 stopservers($verbose);
5348 my $all = $total + $skipped;
5350 runtimestats($lasttest);
5353 logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
5357 logmsg "TESTFAIL: These test cases failed: $failed\n";
5361 logmsg "TESTFAIL: No tests were performed\n";
5365 logmsg "TESTDONE: $all tests were considered during ".
5366 sprintf("%.0f", $sofar) ." seconds.\n";
5369 if($skipped && !$short) {
5371 logmsg "TESTINFO: $skipped tests were skipped due to these restraints:\n";
5373 for(keys %skipped) {
5375 printf "TESTINFO: \"%s\" %d times (", $r, $skipped{$_};
5377 # now show all test case numbers that had this reason for being
5381 for(0 .. scalar @teststat) {
5383 if($teststat[$_] && ($teststat[$_] eq $r)) {
5392 logmsg " and ".($c-$max)." more";
5398 if($total && ($ok != $total)) {