2 #***************************************************************************
4 # Project ___| | | | _ \| |
6 # | (__| |_| | _ <| |___
7 # \___|\___/|_| \_\_____|
9 # Copyright (C) 1998 - 2013, 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 http://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
108 require "getpart.pm"; # array functions
109 require "valgrind.pm"; # valgrind report parser
112 my $HOSTIP="127.0.0.1"; # address on which the test server listens
113 my $HOST6IP="[::1]"; # address on which the test server listens
114 my $CLIENTIP="127.0.0.1"; # address which curl uses for incoming connections
115 my $CLIENT6IP="[::1]"; # address which curl uses for incoming connections
117 my $base = 8990; # base port number
119 my $HTTPPORT; # HTTP server port
120 my $HTTP6PORT; # HTTP IPv6 server port
121 my $HTTPSPORT; # HTTPS (stunnel) server port
122 my $FTPPORT; # FTP server port
123 my $FTP2PORT; # FTP server 2 port
124 my $FTPSPORT; # FTPS (stunnel) server port
125 my $FTP6PORT; # FTP IPv6 server port
127 my $TFTP6PORT; # TFTP
128 my $SSHPORT; # SCP/SFTP
129 my $SOCKSPORT; # SOCKS4/5 port
131 my $POP36PORT; # POP3 IPv6 server port
133 my $IMAP6PORT; # IMAP IPv6 server port
135 my $SMTP6PORT; # SMTP IPv6 server port
137 my $RTSP6PORT; # RTSP IPv6 server port
138 my $GOPHERPORT; # Gopher
139 my $GOPHER6PORT; # Gopher IPv6 server port
140 my $HTTPTLSPORT; # HTTP TLS (non-stunnel) server port
141 my $HTTPTLS6PORT; # HTTP TLS (non-stunnel) IPv6 server port
142 my $HTTPPROXYPORT; # HTTP proxy port, when using CONNECT
143 my $HTTPPIPEPORT; # HTTP pipelining port
145 my $srcdir = $ENV{'srcdir'} || '.';
146 my $CURL="../src/curl".exe_ext(); # what curl executable to run on the tests
147 my $VCURL=$CURL; # what curl binary to use to verify the servers with
148 # VCURL is handy to set to the system one when the one you
149 # just built hangs or crashes and thus prevent verification
150 my $DBGCURL=$CURL; #"../src/.libs/curl"; # alternative for debugging
152 my $TESTDIR="$srcdir/data";
153 my $LIBDIR="./libtest";
154 my $UNITDIR="./unit";
155 # TODO: change this to use server_inputfilename()
156 my $SERVERIN="$LOGDIR/server.input"; # what curl sent the server
157 my $SERVER2IN="$LOGDIR/server2.input"; # what curl sent the second server
158 my $PROXYIN="$LOGDIR/proxy.input"; # what curl sent the proxy
159 my $CURLLOG="$LOGDIR/curl.log"; # all command lines run
160 my $FTPDCMD="$LOGDIR/ftpserver.cmd"; # copy ftp server instructions here
161 my $SERVERLOGS_LOCK="$LOGDIR/serverlogs.lock"; # server logs advisor read lock
162 my $CURLCONFIG="../curl-config"; # curl-config from current build
164 # Normally, all test cases should be run, but at times it is handy to
165 # simply run a particular one:
168 # To run specific test cases, set them like:
169 # $TESTCASES="1 2 3 7 8";
171 #######################################################################
172 # No variables below this point should need to be modified
175 # invoke perl like this:
176 my $perl="perl -I$srcdir";
177 my $server_response_maxtime=13;
179 my $debug_build=0; # built debug enabled (--enable-debug)
180 my $has_memory_tracking=0; # built with memory tracking (--enable-curldebug)
183 # name of the file that the memory debugging creates:
184 my $memdump="$LOGDIR/memdump";
186 # the path to the script that analyzes the memory debug output file:
187 my $memanalyze="$perl $srcdir/memanalyze.pl";
189 my $pwd = getcwd(); # current working directory
192 my $ftpchecktime=1; # time it took to verify our test FTP server
194 my $stunnel = checkcmd("stunnel4") || checkcmd("stunnel");
195 my $valgrind = checktestcmd("valgrind");
196 my $valgrind_logfile="--logfile";
198 my $gdb = checktestcmd("gdb");
199 my $httptlssrv = find_httptlssrv();
201 my $ssl_version; # set if libcurl is built with SSL support
202 my $large_file; # set if libcurl is built with large file support
203 my $has_idn; # set if libcurl is built with IDN support
204 my $http_ipv6; # set if HTTP server has IPv6 support
205 my $ftp_ipv6; # set if FTP server has IPv6 support
206 my $tftp_ipv6; # set if TFTP server has IPv6 support
207 my $gopher_ipv6; # set if Gopher server has IPv6 support
208 my $has_ipv6; # set if libcurl is built with IPv6 support
209 my $has_libz; # set if libcurl is built with libz support
210 my $has_getrlimit; # set if system has getrlimit()
211 my $has_ntlm; # set if libcurl is built with NTLM support
212 my $has_ntlm_wb; # set if libcurl is built with NTLM delegation to winbind
213 my $has_charconv;# set if libcurl is built with CharConv support
214 my $has_tls_srp; # set if libcurl is built with TLS-SRP support
215 my $has_metalink;# set if curl is built with Metalink support
217 my $has_openssl; # built with a lib using an OpenSSL-like API
218 my $has_gnutls; # built with GnuTLS
219 my $has_nss; # built with NSS
220 my $has_yassl; # built with yassl
221 my $has_polarssl; # built with polarssl
222 my $has_axtls; # built with axTLS
223 my $has_winssl; # built with WinSSL (Schannel/SSPI)
224 my $has_darwinssl;# build with DarwinSSL (Secure Transport)
226 my $has_shared = "unknown"; # built shared
228 my $ssllib; # name of the lib we use (for human presentation)
229 my $has_crypto; # set if libcurl is built with cryptographic support
230 my $has_textaware; # set if running on a system that has a text mode concept
231 # on files. Windows for example
233 my @protocols; # array of lowercase supported protocol servers
235 my $skipped=0; # number of tests skipped; reported in main loop
236 my %skipped; # skipped{reason}=counter, reasons for skip
237 my @teststat; # teststat[testnum]=reason, reasons for skip
238 my %disabled_keywords; # key words of tests to skip
239 my %enabled_keywords; # key words of tests to run
240 my %disabled; # disabled test cases
242 my $sshdid; # for socks server, ssh daemon version id
243 my $sshdvernum; # for socks server, ssh daemon version number
244 my $sshdverstr; # for socks server, ssh daemon version string
245 my $sshderror; # for socks server, ssh daemon version error
247 my $defserverlogslocktimeout = 20; # timeout to await server logs lock removal
248 my $defpostcommanddelay = 0; # delay between command and postcheck sections
250 my $timestats; # time stamping and stats generation
251 my $fullstats; # show time stats for every single test
252 my %timeprepini; # timestamp for each test preparation start
253 my %timesrvrini; # timestamp for each test required servers verification start
254 my %timesrvrend; # timestamp for each test required servers verification end
255 my %timetoolini; # timestamp for each test command run starting
256 my %timetoolend; # timestamp for each test command run stopping
257 my %timesrvrlog; # timestamp for each test server logs lock removal
258 my %timevrfyend; # timestamp for each test result verification end
260 my $testnumcheck; # test number, set in singletest sub.
263 #######################################################################
264 # variables that command line options may set
272 my $gdbthis; # run test case with gdb debugger
273 my $gdbxwin; # use windowed gdb when using gdb
274 my $keepoutfiles; # keep stdout and stderr files after tests
275 my $listonly; # only list the tests
276 my $postmortem; # display detailed info about failed tests
278 my %run; # running server
279 my %doesntrun; # servers that don't work, identified by pidfile
280 my %serverpidfile;# all server pid file names, identified by server id
281 my %runcert; # cert file currently in use by an ssl running server
283 # torture test variables
288 #######################################################################
289 # logmsg is our general message logging subroutine.
297 # get the name of the current user
298 my $USER = $ENV{USER}; # Linux
300 $USER = $ENV{USERNAME}; # Windows
302 $USER = $ENV{LOGNAME}; # Some UNIX (I think)
306 # enable memory debugging if curl is compiled with it
307 $ENV{'CURL_MEMDEBUG'} = $memdump;
312 logmsg "runtests.pl received SIG$signame, exiting\n";
313 stopservers($verbose);
314 die "Somebody sent me a SIG$signame";
316 $SIG{INT} = \&catch_zap;
317 $SIG{TERM} = \&catch_zap;
319 ##########################################################################
320 # Clear all possible '*_proxy' environment variables for various protocols
321 # to prevent them to interfere with our testing!
324 foreach $protocol (('ftp', 'http', 'ftps', 'https', 'no', 'all')) {
325 my $proxy = "${protocol}_proxy";
326 # clear lowercase version
327 delete $ENV{$proxy} if($ENV{$proxy});
328 # clear uppercase version
329 delete $ENV{uc($proxy)} if($ENV{uc($proxy)});
332 # make sure we don't get affected by other variables that control our
335 delete $ENV{'SSL_CERT_DIR'} if($ENV{'SSL_CERT_DIR'});
336 delete $ENV{'SSL_CERT_PATH'} if($ENV{'SSL_CERT_PATH'});
337 delete $ENV{'CURL_CA_BUNDLE'} if($ENV{'CURL_CA_BUNDLE'});
339 #######################################################################
340 # Load serverpidfile hash with pidfile names for all possible servers.
342 sub init_serverpidfile_hash {
343 for my $proto (('ftp', 'http', 'imap', 'pop3', 'smtp', 'http')) {
344 for my $ssl (('', 's')) {
345 for my $ipvnum ((4, 6)) {
346 for my $idnum ((1, 2, 3)) {
347 my $serv = servername_id("$proto$ssl", $ipvnum, $idnum);
348 my $pidf = server_pidfilename("$proto$ssl", $ipvnum, $idnum);
349 $serverpidfile{$serv} = $pidf;
354 for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'gopher', 'httptls')) {
355 for my $ipvnum ((4, 6)) {
356 for my $idnum ((1, 2)) {
357 my $serv = servername_id($proto, $ipvnum, $idnum);
358 my $pidf = server_pidfilename($proto, $ipvnum, $idnum);
359 $serverpidfile{$serv} = $pidf;
365 #######################################################################
366 # Check if a given child process has just died. Reaps it if so.
369 use POSIX ":sys_wait_h";
371 if(not defined $pid || $pid <= 0) {
374 my $rc = waitpid($pid, &WNOHANG);
375 return ($rc == $pid)?1:0;
378 #######################################################################
379 # Start a new thread/process and run the given command line in there.
380 # Return the pids (yes plural) of the new child process to the parent.
383 my ($cmd, $pidfile, $timeout, $fake)=@_;
385 logmsg "startnew: $cmd\n" if ($verbose);
390 if(not defined $child) {
391 logmsg "startnew: fork() failure detected\n";
396 # Here we are the child. Run the given command.
398 # Put an "exec" in front of the command so that the child process
399 # keeps this child's process ID.
400 exec("exec $cmd") || die "Can't exec() $cmd: $!";
402 # exec() should never return back here to this process. We protect
403 # ourselves by calling die() just in case something goes really bad.
404 die "error: exec() has returned";
407 # Ugly hack but ssh client and gnutls-serv don't support pid files
409 if(open(OUT, ">$pidfile")) {
410 print OUT $child . "\n";
412 logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose);
415 logmsg "startnew: failed to write fake $pidfile with pid=$child\n";
417 # could/should do a while connect fails sleep a bit and loop
419 if (checkdied($child)) {
420 logmsg "startnew: child process has failed to start\n" if($verbose);
425 my $count = $timeout;
427 if(-f $pidfile && -s $pidfile && open(PID, "<$pidfile")) {
430 if(($pid2 > 0) && pidexists($pid2)) {
431 # if $pid2 is valid, then make sure this pid is alive, as
432 # otherwise it is just likely to be the _previous_ pidfile or
436 # invalidate $pid2 if not actually alive
439 if (checkdied($child)) {
440 logmsg "startnew: child process has died, server might start up\n"
442 # We can't just abort waiting for the server with a
444 # because the server might have forked and could still start
445 # up normally. Instead, just reduce the amount of time we remain
452 # Return two PIDs, the one for the child process we spawned and the one
453 # reported by the server itself (in case it forked again on its own).
454 # Both (potentially) need to be killed at the end of the test.
455 return ($child, $pid2);
459 #######################################################################
460 # Check for a command in the PATH of the test server.
464 my @paths=(split(":", $ENV{'PATH'}), "/usr/sbin", "/usr/local/sbin",
465 "/sbin", "/usr/bin", "/usr/local/bin",
466 "./libtest/.libs", "./libtest");
468 if( -x "$_/$cmd" && ! -d "$_/$cmd") {
469 # executable bit but not a directory!
475 #######################################################################
476 # Get the list of tests that the tests/data/Makefile.am knows about!
480 my @dist = `cd data && make show`;
481 $disttests = join("", @dist);
484 #######################################################################
485 # Check for a command in the PATH of the machine running curl.
489 return checkcmd($cmd);
492 #######################################################################
493 # Run the application under test and return its return code
497 my $ret = system($cmd);
498 print "CMD ($ret): $cmd\n" if($verbose);
501 # This is one way to test curl on a remote machine
502 # my $out = system("ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'");
503 # sleep 2; # time to allow the NFS server to be updated
507 #######################################################################
508 # Run the application under test and return its stdout
510 sub runclientoutput {
514 # This is one way to test curl on a remote machine
515 # my @out = `ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'`;
516 # sleep 2; # time to allow the NFS server to be updated
520 #######################################################################
521 # Memory allocation test and failure torture testing.
527 # remove memdump first to be sure we get a new nice and clean one
530 # First get URL from test server, ignore the output/result
533 logmsg " CMD: $testcmd\n" if($verbose);
535 # memanalyze -v is our friend, get the number of allocations made
537 my @out = `$memanalyze -v $memdump`;
539 if(/^Allocations: (\d+)/) {
545 logmsg " found no allocs to make fail\n";
549 logmsg " $count allocations to make fail\n";
551 for ( 1 .. $count ) {
556 if($tortalloc && ($tortalloc != $limit)) {
561 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
563 my $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
564 logmsg "Fail alloc no: $limit at $now\r";
567 # make the memory allocation function number $limit return failure
568 $ENV{'CURL_MEMLIMIT'} = $limit;
570 # remove memdump first to be sure we get a new nice and clean one
573 logmsg "*** Alloc number $limit is now set to fail ***\n" if($gdbthis);
580 $ret = runclient($testcmd);
582 #logmsg "$_ Returned " . $ret >> 8 . "\n";
584 # Now clear the variable again
585 delete $ENV{'CURL_MEMLIMIT'} if($ENV{'CURL_MEMLIMIT'});
588 # there's core file present now!
589 logmsg " core dumped\n";
594 # verify that it returns a proper error code, doesn't leak memory
595 # and doesn't core dump
597 logmsg " system() returned $ret\n";
601 my @memdata=`$memanalyze $memdump`;
605 # well it could be other memory problems as well, but
606 # we call it leak for short here
611 logmsg "** MEMORY FAILURE\n";
613 logmsg `$memanalyze -l $memdump`;
618 logmsg " Failed on alloc number $limit in test.\n",
619 " invoke with \"-t$limit\" to repeat this single case.\n";
620 stopservers($verbose);
625 logmsg "torture OK\n";
629 #######################################################################
630 # Stop a test server along with pids which aren't in the %run hash yet.
631 # This also stops all servers which are relative to the given one.
634 my ($server, $pidlist) = @_;
636 # kill sockfilter processes for pingpong relative server
638 if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
640 my $idnum = ($2 && ($2 > 1)) ? $2 : 1;
641 my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
642 killsockfilters($proto, $ipvnum, $idnum, $verbose);
645 # All servers relative to the given one must be stopped also
648 if($server =~ /^(ftp|http|imap|pop3|smtp|httppipe)s((\d*)(-ipv6|))$/) {
649 # given a stunnel based ssl server, also kill non-ssl underlying one
650 push @killservers, "${1}${2}";
652 elsif($server =~ /^(ftp|http|imap|pop3|smtp|httppipe)((\d*)(-ipv6|))$/) {
653 # given a non-ssl server, also kill stunnel based ssl piggybacking one
654 push @killservers, "${1}s${2}";
656 elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
657 # given a socks server, also kill ssh underlying one
658 push @killservers, "ssh${2}";
660 elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
661 # given a ssh server, also kill socks piggybacking one
662 push @killservers, "socks${2}";
664 push @killservers, $server;
666 # kill given pids and server relative ones clearing them in %run hash
668 foreach my $server (@killservers) {
670 # we must prepend a space since $pidlist may already contain a pid
671 $pidlist .= " $run{$server}";
674 $runcert{$server} = 0 if($runcert{$server});
676 killpid($verbose, $pidlist);
678 # cleanup server pid files
680 foreach my $server (@killservers) {
681 my $pidfile = $serverpidfile{$server};
682 my $pid = processexists($pidfile);
684 logmsg "Warning: $server server unexpectedly alive\n";
685 killpid($verbose, $pid);
687 unlink($pidfile) if(-f $pidfile);
691 #######################################################################
692 # Verify that the server that runs on $ip, $port is our server. This also
693 # implies that we can speak with it, as there might be occasions when the
694 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
695 # assign requested address")
698 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
699 my $server = servername_id($proto, $ipvnum, $idnum);
703 my $verifyout = "$LOGDIR/".
704 servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
705 unlink($verifyout) if(-f $verifyout);
707 my $verifylog = "$LOGDIR/".
708 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
709 unlink($verifylog) if(-f $verifylog);
711 if($proto eq "gopher") {
716 my $flags = "--max-time $server_response_maxtime ";
717 $flags .= "--output $verifyout ";
718 $flags .= "--silent ";
719 $flags .= "--verbose ";
720 $flags .= "--globoff ";
721 $flags .= "-1 " if($has_axtls);
722 $flags .= "--insecure " if($proto eq 'https');
723 $flags .= "\"$proto://$ip:$port/${bonus}verifiedserver\"";
725 my $cmd = "$VCURL $flags 2>$verifylog";
727 # verify if our/any server is running on this port
728 logmsg "RUN: $cmd\n" if($verbose);
729 my $res = runclient($cmd);
731 $res >>= 8; # rotate the result
733 logmsg "RUN: curl command died with a coredump\n";
737 if($res && $verbose) {
738 logmsg "RUN: curl command returned $res\n";
739 if(open(FILE, "<$verifylog")) {
740 while(my $string = <FILE>) {
741 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
748 if(open(FILE, "<$verifyout")) {
749 while(my $string = <FILE>) {
751 last; # only want first line
756 if($data && ($data =~ /WE ROOLZ: (\d+)/)) {
760 # curl: (6) Couldn't resolve host '::1'
761 logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
764 elsif($data || ($res && ($res != 7))) {
765 logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
771 #######################################################################
772 # Verify that the server that runs on $ip, $port is our server. This also
773 # implies that we can speak with it, as there might be occasions when the
774 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
775 # assign requested address")
778 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
779 my $server = servername_id($proto, $ipvnum, $idnum);
784 my $verifylog = "$LOGDIR/".
785 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
786 unlink($verifylog) if(-f $verifylog);
788 if($proto eq "ftps") {
789 $extra .= "--insecure --ftp-ssl-control ";
791 elsif($proto eq "smtp") {
792 # SMTP is a bit different since it requires more options and it
794 $extra .= "--mail-rcpt verifiedserver ";
795 $extra .= "--mail-from fake ";
796 $extra .= "--upload /dev/null ";
797 $extra .= "--stderr - "; # move stderr to parse the verbose stuff
800 my $flags = "--max-time $server_response_maxtime ";
801 $flags .= "--silent ";
802 $flags .= "--verbose ";
803 $flags .= "--globoff ";
805 $flags .= "\"$proto://$ip:$port/verifiedserver\"";
807 my $cmd = "$VCURL $flags 2>$verifylog";
809 # check if this is our server running on this port:
810 logmsg "RUN: $cmd\n" if($verbose);
811 my @data = runclientoutput($cmd);
813 my $res = $? >> 8; # rotate the result
815 logmsg "RUN: curl command died with a coredump\n";
819 foreach my $line (@data) {
820 if($line =~ /WE ROOLZ: (\d+)/) {
821 # this is our test server with a known pid!
826 if($pid <= 0 && @data && $data[0]) {
827 # this is not a known server
828 logmsg "RUN: Unknown server on our $server port: $port\n";
831 # we can/should use the time it took to verify the FTP server as a measure
832 # on how fast/slow this host/FTP is.
833 my $took = int(0.5+time()-$time);
836 logmsg "RUN: Verifying our test $server server took $took seconds\n";
838 $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
843 #######################################################################
844 # Verify that the server that runs on $ip, $port is our server. This also
845 # implies that we can speak with it, as there might be occasions when the
846 # server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
847 # assign requested address")
850 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
851 my $server = servername_id($proto, $ipvnum, $idnum);
854 my $verifyout = "$LOGDIR/".
855 servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
856 unlink($verifyout) if(-f $verifyout);
858 my $verifylog = "$LOGDIR/".
859 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
860 unlink($verifylog) if(-f $verifylog);
862 my $flags = "--max-time $server_response_maxtime ";
863 $flags .= "--output $verifyout ";
864 $flags .= "--silent ";
865 $flags .= "--verbose ";
866 $flags .= "--globoff ";
867 # currently verification is done using http
868 $flags .= "\"http://$ip:$port/verifiedserver\"";
870 my $cmd = "$VCURL $flags 2>$verifylog";
872 # verify if our/any server is running on this port
873 logmsg "RUN: $cmd\n" if($verbose);
874 my $res = runclient($cmd);
876 $res >>= 8; # rotate the result
878 logmsg "RUN: curl command died with a coredump\n";
882 if($res && $verbose) {
883 logmsg "RUN: curl command returned $res\n";
884 if(open(FILE, "<$verifylog")) {
885 while(my $string = <FILE>) {
886 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
893 if(open(FILE, "<$verifyout")) {
894 while(my $string = <FILE>) {
896 last; # only want first line
901 if($data && ($data =~ /RTSP_SERVER WE ROOLZ: (\d+)/)) {
905 # curl: (6) Couldn't resolve host '::1'
906 logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
909 elsif($data || ($res != 7)) {
910 logmsg "RUN: Unknown server on our $server port: $port\n";
916 #######################################################################
917 # Verify that the ssh server has written out its pidfile, recovering
918 # the pid from the file and returning it if a process with that pid is
922 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
923 my $server = servername_id($proto, $ipvnum, $idnum);
924 my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
926 if(open(FILE, "<$pidfile")) {
931 # if we have a pid it is actually our ssh server,
932 # since runsshserver() unlinks previous pidfile
933 if(!pidexists($pid)) {
934 logmsg "RUN: SSH server has died after starting up\n";
943 #######################################################################
944 # Verify that we can connect to the sftp server, properly authenticate
945 # with generated config and key files and run a simple remote pwd.
948 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
949 my $server = servername_id($proto, $ipvnum, $idnum);
951 # Find out sftp client canonical file name
952 my $sftp = find_sftp();
954 logmsg "RUN: SFTP server cannot find $sftpexe\n";
957 # Find out ssh client canonical file name
958 my $ssh = find_ssh();
960 logmsg "RUN: SFTP server cannot find $sshexe\n";
963 # Connect to sftp server, authenticate and run a remote pwd
964 # command using our generated configuration and key files
965 my $cmd = "$sftp -b $sftpcmds -F $sftpconfig -S $ssh $ip > $sftplog 2>&1";
966 my $res = runclient($cmd);
967 # Search for pwd command response in log file
968 if(open(SFTPLOGFILE, "<$sftplog")) {
969 while(<SFTPLOGFILE>) {
970 if(/^Remote working directory: /) {
980 #######################################################################
981 # Verify that the non-stunnel HTTP TLS extensions capable server that runs
982 # on $ip, $port is our server. This also implies that we can speak with it,
983 # as there might be occasions when the server runs fine but we cannot talk
984 # to it ("Failed to connect to ::1: Can't assign requested address")
987 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
988 my $server = servername_id($proto, $ipvnum, $idnum);
989 my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
992 my $verifyout = "$LOGDIR/".
993 servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
994 unlink($verifyout) if(-f $verifyout);
996 my $verifylog = "$LOGDIR/".
997 servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
998 unlink($verifylog) if(-f $verifylog);
1000 my $flags = "--max-time $server_response_maxtime ";
1001 $flags .= "--output $verifyout ";
1002 $flags .= "--verbose ";
1003 $flags .= "--globoff ";
1004 $flags .= "--insecure ";
1005 $flags .= "--tlsauthtype SRP ";
1006 $flags .= "--tlsuser jsmith ";
1007 $flags .= "--tlspassword abc ";
1008 $flags .= "\"https://$ip:$port/verifiedserver\"";
1010 my $cmd = "$VCURL $flags 2>$verifylog";
1012 # verify if our/any server is running on this port
1013 logmsg "RUN: $cmd\n" if($verbose);
1014 my $res = runclient($cmd);
1016 $res >>= 8; # rotate the result
1018 logmsg "RUN: curl command died with a coredump\n";
1022 if($res && $verbose) {
1023 logmsg "RUN: curl command returned $res\n";
1024 if(open(FILE, "<$verifylog")) {
1025 while(my $string = <FILE>) {
1026 logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
1033 if(open(FILE, "<$verifyout")) {
1034 while(my $string = <FILE>) {
1040 if($data && ($data =~ /GNUTLS/) && open(FILE, "<$pidfile")) {
1044 # if we have a pid it is actually our httptls server,
1045 # since runhttptlsserver() unlinks previous pidfile
1046 if(!pidexists($pid)) {
1047 logmsg "RUN: $server server has died after starting up\n";
1056 # curl: (6) Couldn't resolve host '::1'
1057 logmsg "RUN: failed to resolve host (https://$ip:$port/verifiedserver)\n";
1060 elsif($data || ($res && ($res != 7))) {
1061 logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
1067 #######################################################################
1068 # STUB for verifying socks
1071 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1072 my $server = servername_id($proto, $ipvnum, $idnum);
1073 my $pidfile = server_pidfilename($proto, $ipvnum, $idnum);
1075 if(open(FILE, "<$pidfile")) {
1080 # if we have a pid it is actually our socks server,
1081 # since runsocksserver() unlinks previous pidfile
1082 if(!pidexists($pid)) {
1083 logmsg "RUN: SOCKS server has died after starting up\n";
1092 #######################################################################
1093 # Verify that the server that runs on $ip, $port is our server.
1094 # Retry over several seconds before giving up. The ssh server in
1095 # particular can take a long time to start if it needs to generate
1096 # keys on a slow or loaded host.
1098 # Just for convenience, test harness uses 'https' and 'httptls' literals
1099 # as values for 'proto' variable in order to differentiate different
1100 # servers. 'https' literal is used for stunnel based https test servers,
1101 # and 'httptls' is used for non-stunnel https test servers.
1104 my %protofunc = ('http' => \&verifyhttp,
1105 'https' => \&verifyhttp,
1106 'rtsp' => \&verifyrtsp,
1107 'ftp' => \&verifyftp,
1108 'pop3' => \&verifyftp,
1109 'imap' => \&verifyftp,
1110 'smtp' => \&verifyftp,
1111 'httppipe' => \&verifyhttp,
1112 'ftps' => \&verifyftp,
1113 'tftp' => \&verifyftp,
1114 'ssh' => \&verifyssh,
1115 'socks' => \&verifysocks,
1116 'gopher' => \&verifyhttp,
1117 'httptls' => \&verifyhttptls);
1120 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1122 my $count = 30; # try for this many seconds
1126 my $fun = $protofunc{$proto};
1128 $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
1134 # a real failure, stop trying and bail out
1142 #######################################################################
1143 # Single shot server responsiveness test. This should only be used
1144 # to verify that a server present in %run hash is still functional
1146 sub responsiveserver {
1147 my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1148 my $prev_verbose = $verbose;
1151 my $fun = $protofunc{$proto};
1152 my $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
1153 $verbose = $prev_verbose;
1156 return 1; # responsive
1159 my $srvrname = servername_str($proto, $ipvnum, $idnum);
1160 logmsg " server precheck FAILED (unresponsive $srvrname server)\n";
1164 #######################################################################
1165 # start the http server
1168 my ($proto, $verbose, $alt, $port) = @_;
1177 my $exe = "$perl $srcdir/httpserver.pl";
1178 my $verbose_flag = "--verbose ";
1180 if($alt eq "ipv6") {
1181 # if IPv6, use a different setup
1185 elsif($alt eq "proxy") {
1186 # basically the same, but another ID
1189 elsif($alt eq "pipe") {
1190 # basically the same, but another ID
1192 $exe = "python $srcdir/http_pipe.py";
1193 $verbose_flag .= "1 ";
1196 $server = servername_id($proto, $ipvnum, $idnum);
1198 $pidfile = $serverpidfile{$server};
1200 # don't retry if the server doesn't work
1201 if ($doesntrun{$pidfile}) {
1205 my $pid = processexists($pidfile);
1207 stopserver($server, "$pid");
1209 unlink($pidfile) if(-f $pidfile);
1211 $srvrname = servername_str($proto, $ipvnum, $idnum);
1213 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1215 $flags .= "--gopher " if($proto eq "gopher");
1216 $flags .= "--connect $HOSTIP " if($alt eq "proxy");
1217 $flags .= $verbose_flag if($debugprotocol);
1218 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1219 $flags .= "--id $idnum " if($idnum > 1);
1220 $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\"";
1222 my $cmd = "$exe $flags";
1223 my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1225 if($httppid <= 0 || !pidexists($httppid)) {
1227 logmsg "RUN: failed to start the $srvrname server\n";
1228 stopserver($server, "$pid2");
1229 displaylogs($testnumcheck);
1230 $doesntrun{$pidfile} = 1;
1234 # Server is up. Verify that we can speak to it.
1235 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1237 logmsg "RUN: $srvrname server failed verification\n";
1238 # failed to talk to it properly. Kill the server and return failure
1239 stopserver($server, "$httppid $pid2");
1240 displaylogs($testnumcheck);
1241 $doesntrun{$pidfile} = 1;
1247 logmsg "RUN: $srvrname server is now running PID $httppid\n";
1252 return ($httppid, $pid2);
1255 #######################################################################
1256 # start the http server
1258 sub runhttp_pipeserver {
1259 my ($proto, $verbose, $alt, $port) = @_;
1269 if($alt eq "ipv6") {
1273 $server = servername_id($proto, $ipvnum, $idnum);
1275 $pidfile = $serverpidfile{$server};
1277 # don't retry if the server doesn't work
1278 if ($doesntrun{$pidfile}) {
1282 my $pid = processexists($pidfile);
1284 stopserver($server, "$pid");
1286 unlink($pidfile) if(-f $pidfile);
1288 $srvrname = servername_str($proto, $ipvnum, $idnum);
1290 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1292 $flags .= "--verbose 1 " if($debugprotocol);
1293 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1294 $flags .= "--id $idnum " if($idnum > 1);
1295 $flags .= "--port $port --srcdir \"$srcdir\"";
1297 my $cmd = "$srcdir/http_pipe.py $flags";
1298 my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1300 if($httppid <= 0 || !pidexists($httppid)) {
1302 logmsg "RUN: failed to start the $srvrname server\n";
1303 stopserver($server, "$pid2");
1304 displaylogs($testnumcheck);
1305 $doesntrun{$pidfile} = 1;
1309 # Server is up. Verify that we can speak to it.
1310 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1312 logmsg "RUN: $srvrname server failed verification\n";
1313 # failed to talk to it properly. Kill the server and return failure
1314 stopserver($server, "$httppid $pid2");
1315 displaylogs($testnumcheck);
1316 $doesntrun{$pidfile} = 1;
1322 logmsg "RUN: $srvrname server is now running PID $httppid\n";
1327 return ($httppid, $pid2);
1330 #######################################################################
1331 # start the https stunnel based server
1333 sub runhttpsserver {
1334 my ($verbose, $ipv6, $certfile) = @_;
1335 my $proto = 'https';
1336 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1337 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1349 $server = servername_id($proto, $ipvnum, $idnum);
1351 $pidfile = $serverpidfile{$server};
1353 # don't retry if the server doesn't work
1354 if ($doesntrun{$pidfile}) {
1358 my $pid = processexists($pidfile);
1360 stopserver($server, "$pid");
1362 unlink($pidfile) if(-f $pidfile);
1364 $srvrname = servername_str($proto, $ipvnum, $idnum);
1366 $certfile = 'stunnel.pem' unless($certfile);
1368 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1370 $flags .= "--verbose " if($debugprotocol);
1371 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1372 $flags .= "--id $idnum " if($idnum > 1);
1373 $flags .= "--ipv$ipvnum --proto $proto ";
1374 $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
1375 $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
1376 $flags .= "--connect $HTTPPORT --accept $HTTPSPORT";
1378 my $cmd = "$perl $srcdir/secureserver.pl $flags";
1379 my ($httpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1381 if($httpspid <= 0 || !pidexists($httpspid)) {
1383 logmsg "RUN: failed to start the $srvrname server\n";
1384 stopserver($server, "$pid2");
1385 displaylogs($testnumcheck);
1386 $doesntrun{$pidfile} = 1;
1390 # Server is up. Verify that we can speak to it.
1391 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $HTTPSPORT);
1393 logmsg "RUN: $srvrname server failed verification\n";
1394 # failed to talk to it properly. Kill the server and return failure
1395 stopserver($server, "$httpspid $pid2");
1396 displaylogs($testnumcheck);
1397 $doesntrun{$pidfile} = 1;
1400 # Here pid3 is actually the pid returned by the unsecure-http server.
1402 $runcert{$server} = $certfile;
1405 logmsg "RUN: $srvrname server is now running PID $httpspid\n";
1410 return ($httpspid, $pid2);
1413 #######################################################################
1414 # start the non-stunnel HTTP TLS extensions capable server
1416 sub runhttptlsserver {
1417 my ($verbose, $ipv6) = @_;
1418 my $proto = "httptls";
1419 my $port = ($ipv6 && ($ipv6 =~ /6$/)) ? $HTTPTLS6PORT : $HTTPTLSPORT;
1420 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1421 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1433 $server = servername_id($proto, $ipvnum, $idnum);
1435 $pidfile = $serverpidfile{$server};
1437 # don't retry if the server doesn't work
1438 if ($doesntrun{$pidfile}) {
1442 my $pid = processexists($pidfile);
1444 stopserver($server, "$pid");
1446 unlink($pidfile) if(-f $pidfile);
1448 $srvrname = servername_str($proto, $ipvnum, $idnum);
1450 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1452 $flags .= "--http ";
1453 $flags .= "--debug 1 " if($debugprotocol);
1454 $flags .= "--port $port ";
1455 $flags .= "--srppasswd $srcdir/certs/srp-verifier-db ";
1456 $flags .= "--srppasswdconf $srcdir/certs/srp-verifier-conf";
1458 my $cmd = "$httptlssrv $flags > $logfile 2>&1";
1459 my ($httptlspid, $pid2) = startnew($cmd, $pidfile, 10, 1); # fake pidfile
1461 if($httptlspid <= 0 || !pidexists($httptlspid)) {
1463 logmsg "RUN: failed to start the $srvrname server\n";
1464 stopserver($server, "$pid2");
1465 displaylogs($testnumcheck);
1466 $doesntrun{$pidfile} = 1;
1470 # Server is up. Verify that we can speak to it. PID is from fake pidfile
1471 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1473 logmsg "RUN: $srvrname server failed verification\n";
1474 # failed to talk to it properly. Kill the server and return failure
1475 stopserver($server, "$httptlspid $pid2");
1476 displaylogs($testnumcheck);
1477 $doesntrun{$pidfile} = 1;
1483 logmsg "RUN: $srvrname server is now running PID $httptlspid\n";
1488 return ($httptlspid, $pid2);
1491 #######################################################################
1492 # start the pingpong server (FTP, POP3, IMAP, SMTP)
1494 sub runpingpongserver {
1495 my ($proto, $id, $verbose, $ipv6) = @_;
1497 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1498 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1499 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1506 if($proto eq "ftp") {
1507 $port = ($idnum>1)?$FTP2PORT:$FTPPORT;
1510 # if IPv6, use a different setup
1514 elsif($proto eq "pop3") {
1515 $port = ($ipvnum==6) ? $POP36PORT : $POP3PORT;
1517 elsif($proto eq "imap") {
1518 $port = ($ipvnum==6) ? $IMAP6PORT : $IMAPPORT;
1520 elsif($proto eq "smtp") {
1521 $port = ($ipvnum==6) ? $SMTP6PORT : $SMTPPORT;
1524 print STDERR "Unsupported protocol $proto!!\n";
1528 $server = servername_id($proto, $ipvnum, $idnum);
1530 $pidfile = $serverpidfile{$server};
1532 # don't retry if the server doesn't work
1533 if ($doesntrun{$pidfile}) {
1537 my $pid = processexists($pidfile);
1539 stopserver($server, "$pid");
1541 unlink($pidfile) if(-f $pidfile);
1543 $srvrname = servername_str($proto, $ipvnum, $idnum);
1545 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1547 $flags .= "--verbose " if($debugprotocol);
1548 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1549 $flags .= "--srcdir \"$srcdir\" --proto $proto ";
1550 $flags .= "--id $idnum " if($idnum > 1);
1551 $flags .= "--ipv$ipvnum --port $port --addr \"$ip\"";
1553 my $cmd = "$perl $srcdir/ftpserver.pl $flags";
1554 my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1556 if($ftppid <= 0 || !pidexists($ftppid)) {
1558 logmsg "RUN: failed to start the $srvrname server\n";
1559 stopserver($server, "$pid2");
1560 displaylogs($testnumcheck);
1561 $doesntrun{$pidfile} = 1;
1565 # Server is up. Verify that we can speak to it.
1566 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1568 logmsg "RUN: $srvrname server failed verification\n";
1569 # failed to talk to it properly. Kill the server and return failure
1570 stopserver($server, "$ftppid $pid2");
1571 displaylogs($testnumcheck);
1572 $doesntrun{$pidfile} = 1;
1579 logmsg "RUN: $srvrname server is now running PID $ftppid\n";
1584 return ($pid2, $ftppid);
1587 #######################################################################
1588 # start the ftps server (or rather, tunnel)
1591 my ($verbose, $ipv6, $certfile) = @_;
1593 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1594 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1606 $server = servername_id($proto, $ipvnum, $idnum);
1608 $pidfile = $serverpidfile{$server};
1610 # don't retry if the server doesn't work
1611 if ($doesntrun{$pidfile}) {
1615 my $pid = processexists($pidfile);
1617 stopserver($server, "$pid");
1619 unlink($pidfile) if(-f $pidfile);
1621 $srvrname = servername_str($proto, $ipvnum, $idnum);
1623 $certfile = 'stunnel.pem' unless($certfile);
1625 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1627 $flags .= "--verbose " if($debugprotocol);
1628 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1629 $flags .= "--id $idnum " if($idnum > 1);
1630 $flags .= "--ipv$ipvnum --proto $proto ";
1631 $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
1632 $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
1633 $flags .= "--connect $FTPPORT --accept $FTPSPORT";
1635 my $cmd = "$perl $srcdir/secureserver.pl $flags";
1636 my ($ftpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1638 if($ftpspid <= 0 || !pidexists($ftpspid)) {
1640 logmsg "RUN: failed to start the $srvrname server\n";
1641 stopserver($server, "$pid2");
1642 displaylogs($testnumcheck);
1643 $doesntrun{$pidfile} = 1;
1647 # Server is up. Verify that we can speak to it.
1648 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $FTPSPORT);
1650 logmsg "RUN: $srvrname server failed verification\n";
1651 # failed to talk to it properly. Kill the server and return failure
1652 stopserver($server, "$ftpspid $pid2");
1653 displaylogs($testnumcheck);
1654 $doesntrun{$pidfile} = 1;
1657 # Here pid3 is actually the pid returned by the unsecure-ftp server.
1659 $runcert{$server} = $certfile;
1662 logmsg "RUN: $srvrname server is now running PID $ftpspid\n";
1667 return ($ftpspid, $pid2);
1670 #######################################################################
1671 # start the tftp server
1674 my ($id, $verbose, $ipv6) = @_;
1675 my $port = $TFTPPORT;
1679 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1687 # if IPv6, use a different setup
1693 $server = servername_id($proto, $ipvnum, $idnum);
1695 $pidfile = $serverpidfile{$server};
1697 # don't retry if the server doesn't work
1698 if ($doesntrun{$pidfile}) {
1702 my $pid = processexists($pidfile);
1704 stopserver($server, "$pid");
1706 unlink($pidfile) if(-f $pidfile);
1708 $srvrname = servername_str($proto, $ipvnum, $idnum);
1710 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1712 $flags .= "--verbose " if($debugprotocol);
1713 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1714 $flags .= "--id $idnum " if($idnum > 1);
1715 $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\"";
1717 my $cmd = "$perl $srcdir/tftpserver.pl $flags";
1718 my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1720 if($tftppid <= 0 || !pidexists($tftppid)) {
1722 logmsg "RUN: failed to start the $srvrname server\n";
1723 stopserver($server, "$pid2");
1724 displaylogs($testnumcheck);
1725 $doesntrun{$pidfile} = 1;
1729 # Server is up. Verify that we can speak to it.
1730 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1732 logmsg "RUN: $srvrname server failed verification\n";
1733 # failed to talk to it properly. Kill the server and return failure
1734 stopserver($server, "$tftppid $pid2");
1735 displaylogs($testnumcheck);
1736 $doesntrun{$pidfile} = 1;
1742 logmsg "RUN: $srvrname server is now running PID $tftppid\n";
1747 return ($pid2, $tftppid);
1751 #######################################################################
1752 # start the rtsp server
1755 my ($verbose, $ipv6) = @_;
1756 my $port = $RTSPPORT;
1768 # if IPv6, use a different setup
1774 $server = servername_id($proto, $ipvnum, $idnum);
1776 $pidfile = $serverpidfile{$server};
1778 # don't retry if the server doesn't work
1779 if ($doesntrun{$pidfile}) {
1783 my $pid = processexists($pidfile);
1785 stopserver($server, "$pid");
1787 unlink($pidfile) if(-f $pidfile);
1789 $srvrname = servername_str($proto, $ipvnum, $idnum);
1791 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1793 $flags .= "--verbose " if($debugprotocol);
1794 $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1795 $flags .= "--id $idnum " if($idnum > 1);
1796 $flags .= "--ipv$ipvnum --port $port --srcdir \"$srcdir\"";
1798 my $cmd = "$perl $srcdir/rtspserver.pl $flags";
1799 my ($rtsppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1801 if($rtsppid <= 0 || !pidexists($rtsppid)) {
1803 logmsg "RUN: failed to start the $srvrname server\n";
1804 stopserver($server, "$pid2");
1805 displaylogs($testnumcheck);
1806 $doesntrun{$pidfile} = 1;
1810 # Server is up. Verify that we can speak to it.
1811 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1813 logmsg "RUN: $srvrname server failed verification\n";
1814 # failed to talk to it properly. Kill the server and return failure
1815 stopserver($server, "$rtsppid $pid2");
1816 displaylogs($testnumcheck);
1817 $doesntrun{$pidfile} = 1;
1823 logmsg "RUN: $srvrname server is now running PID $rtsppid\n";
1828 return ($rtsppid, $pid2);
1832 #######################################################################
1833 # Start the ssh (scp/sftp) server
1836 my ($id, $verbose, $ipv6) = @_;
1838 my $port = $SSHPORT;
1839 my $socksport = $SOCKSPORT;
1842 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1849 $server = servername_id($proto, $ipvnum, $idnum);
1851 $pidfile = $serverpidfile{$server};
1853 # don't retry if the server doesn't work
1854 if ($doesntrun{$pidfile}) {
1858 my $pid = processexists($pidfile);
1860 stopserver($server, "$pid");
1862 unlink($pidfile) if(-f $pidfile);
1864 $srvrname = servername_str($proto, $ipvnum, $idnum);
1866 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1868 $flags .= "--verbose " if($verbose);
1869 $flags .= "--debugprotocol " if($debugprotocol);
1870 $flags .= "--pidfile \"$pidfile\" ";
1871 $flags .= "--id $idnum " if($idnum > 1);
1872 $flags .= "--ipv$ipvnum --addr \"$ip\" ";
1873 $flags .= "--sshport $port --socksport $socksport ";
1874 $flags .= "--user \"$USER\"";
1876 my $cmd = "$perl $srcdir/sshserver.pl $flags";
1877 my ($sshpid, $pid2) = startnew($cmd, $pidfile, 60, 0);
1879 # on loaded systems sshserver start up can take longer than the timeout
1880 # passed to startnew, when this happens startnew completes without being
1881 # able to read the pidfile and consequently returns a zero pid2 above.
1883 if($sshpid <= 0 || !pidexists($sshpid)) {
1885 logmsg "RUN: failed to start the $srvrname server\n";
1886 stopserver($server, "$pid2");
1887 $doesntrun{$pidfile} = 1;
1891 # ssh server verification allows some extra time for the server to start up
1892 # and gives us the opportunity of recovering the pid from the pidfile, when
1893 # this verification succeeds the recovered pid is assigned to pid2.
1895 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1897 logmsg "RUN: $srvrname server failed verification\n";
1898 # failed to fetch server pid. Kill the server and return failure
1899 stopserver($server, "$sshpid $pid2");
1900 $doesntrun{$pidfile} = 1;
1905 # once it is known that the ssh server is alive, sftp server verification
1906 # is performed actually connecting to it, authenticating and performing a
1907 # very simple remote command. This verification is tried only one time.
1909 $sshdlog = server_logfilename($LOGDIR, 'ssh', $ipvnum, $idnum);
1910 $sftplog = server_logfilename($LOGDIR, 'sftp', $ipvnum, $idnum);
1912 if(verifysftp('sftp', $ipvnum, $idnum, $ip, $port) < 1) {
1913 logmsg "RUN: SFTP server failed verification\n";
1914 # failed to talk to it properly. Kill the server and return failure
1916 display_sftpconfig();
1918 display_sshdconfig();
1919 stopserver($server, "$sshpid $pid2");
1920 $doesntrun{$pidfile} = 1;
1925 logmsg "RUN: $srvrname server is now running PID $pid2\n";
1928 return ($pid2, $sshpid);
1931 #######################################################################
1932 # Start the socks server
1934 sub runsocksserver {
1935 my ($id, $verbose, $ipv6) = @_;
1937 my $port = $SOCKSPORT;
1938 my $proto = 'socks';
1940 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1947 $server = servername_id($proto, $ipvnum, $idnum);
1949 $pidfile = $serverpidfile{$server};
1951 # don't retry if the server doesn't work
1952 if ($doesntrun{$pidfile}) {
1956 my $pid = processexists($pidfile);
1958 stopserver($server, "$pid");
1960 unlink($pidfile) if(-f $pidfile);
1962 $srvrname = servername_str($proto, $ipvnum, $idnum);
1964 $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1966 # The ssh server must be already running
1968 logmsg "RUN: SOCKS server cannot find running SSH server\n";
1969 $doesntrun{$pidfile} = 1;
1973 # Find out ssh daemon canonical file name
1974 my $sshd = find_sshd();
1976 logmsg "RUN: SOCKS server cannot find $sshdexe\n";
1977 $doesntrun{$pidfile} = 1;
1981 # Find out ssh daemon version info
1982 ($sshdid, $sshdvernum, $sshdverstr, $sshderror) = sshversioninfo($sshd);
1984 # Not an OpenSSH or SunSSH ssh daemon
1985 logmsg "$sshderror\n" if($verbose);
1986 logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
1987 $doesntrun{$pidfile} = 1;
1990 logmsg "ssh server found $sshd is $sshdverstr\n" if($verbose);
1992 # Find out ssh client canonical file name
1993 my $ssh = find_ssh();
1995 logmsg "RUN: SOCKS server cannot find $sshexe\n";
1996 $doesntrun{$pidfile} = 1;
2000 # Find out ssh client version info
2001 my ($sshid, $sshvernum, $sshverstr, $ssherror) = sshversioninfo($ssh);
2003 # Not an OpenSSH or SunSSH ssh client
2004 logmsg "$ssherror\n" if($verbose);
2005 logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2006 $doesntrun{$pidfile} = 1;
2010 # Verify minimum ssh client version
2011 if((($sshid =~ /OpenSSH/) && ($sshvernum < 299)) ||
2012 (($sshid =~ /SunSSH/) && ($sshvernum < 100))) {
2013 logmsg "ssh client found $ssh is $sshverstr\n";
2014 logmsg "SCP, SFTP and SOCKS tests require OpenSSH 2.9.9 or later\n";
2015 $doesntrun{$pidfile} = 1;
2018 logmsg "ssh client found $ssh is $sshverstr\n" if($verbose);
2020 # Verify if ssh client and ssh daemon versions match
2021 if(($sshdid ne $sshid) || ($sshdvernum != $sshvernum)) {
2022 # Our test harness might work with slightly mismatched versions
2023 logmsg "Warning: version mismatch: sshd $sshdverstr - ssh $sshverstr\n"
2027 # Config file options for ssh client are previously set from sshserver.pl
2028 if(! -e $sshconfig) {
2029 logmsg "RUN: SOCKS server cannot find $sshconfig\n";
2030 $doesntrun{$pidfile} = 1;
2034 $sshlog = server_logfilename($LOGDIR, 'socks', $ipvnum, $idnum);
2036 # start our socks server
2037 my $cmd="$ssh -N -F $sshconfig $ip > $sshlog 2>&1";
2038 my ($sshpid, $pid2) = startnew($cmd, $pidfile, 30, 1); # fake pidfile
2040 if($sshpid <= 0 || !pidexists($sshpid)) {
2042 logmsg "RUN: failed to start the $srvrname server\n";
2044 display_sshconfig();
2046 display_sshdconfig();
2047 stopserver($server, "$pid2");
2048 $doesntrun{$pidfile} = 1;
2052 # Ugly hack but ssh doesn't support pid files. PID is from fake pidfile.
2053 my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
2055 logmsg "RUN: $srvrname server failed verification\n";
2056 # failed to talk to it properly. Kill the server and return failure
2057 stopserver($server, "$sshpid $pid2");
2058 $doesntrun{$pidfile} = 1;
2064 logmsg "RUN: $srvrname server is now running PID $pid2\n";
2067 return ($pid2, $sshpid);
2070 #######################################################################
2071 # Single shot http and gopher server responsiveness test. This should only
2072 # be used to verify that a server present in %run hash is still functional
2074 sub responsive_http_server {
2075 my ($proto, $verbose, $alt, $port) = @_;
2080 if($alt eq "ipv6") {
2081 # if IPv6, use a different setup
2085 elsif($alt eq "proxy") {
2089 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2092 #######################################################################
2093 # Single shot pingpong server responsiveness test. This should only be
2094 # used to verify that a server present in %run hash is still functional
2096 sub responsive_pingpong_server {
2097 my ($proto, $id, $verbose, $ipv6) = @_;
2099 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
2100 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
2101 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2103 if($proto eq "ftp") {
2104 $port = ($idnum>1)?$FTP2PORT:$FTPPORT;
2107 # if IPv6, use a different setup
2111 elsif($proto eq "pop3") {
2112 $port = ($ipvnum==6) ? $POP36PORT : $POP3PORT;
2114 elsif($proto eq "imap") {
2115 $port = ($ipvnum==6) ? $IMAP6PORT : $IMAPPORT;
2117 elsif($proto eq "smtp") {
2118 $port = ($ipvnum==6) ? $SMTP6PORT : $SMTPPORT;
2121 print STDERR "Unsupported protocol $proto!!\n";
2125 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2128 #######################################################################
2129 # Single shot rtsp server responsiveness test. This should only be
2130 # used to verify that a server present in %run hash is still functional
2132 sub responsive_rtsp_server {
2133 my ($verbose, $ipv6) = @_;
2134 my $port = $RTSPPORT;
2141 # if IPv6, use a different setup
2147 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2150 #######################################################################
2151 # Single shot tftp server responsiveness test. This should only be
2152 # used to verify that a server present in %run hash is still functional
2154 sub responsive_tftp_server {
2155 my ($id, $verbose, $ipv6) = @_;
2156 my $port = $TFTPPORT;
2160 my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2163 # if IPv6, use a different setup
2169 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2172 #######################################################################
2173 # Single shot non-stunnel HTTP TLS extensions capable server
2174 # responsiveness test. This should only be used to verify that a
2175 # server present in %run hash is still functional
2177 sub responsive_httptls_server {
2178 my ($verbose, $ipv6) = @_;
2179 my $proto = "httptls";
2180 my $port = ($ipv6 && ($ipv6 =~ /6$/)) ? $HTTPTLS6PORT : $HTTPTLSPORT;
2181 my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
2182 my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
2185 return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2188 #######################################################################
2189 # Remove all files in the specified directory
2197 opendir(DIR, $dir) ||
2198 return 0; # can't open dir
2199 while($file = readdir(DIR)) {
2200 if($file !~ /^\./) {
2201 unlink("$dir/$file");
2209 #######################################################################
2210 # filter out the specified pattern from the given input file and store the
2211 # results in the given output file
2218 open(IN, "<$infile")
2221 open(OUT, ">$ofile")
2224 # logmsg "FILTER: off $filter from $infile to $ofile\n";
2235 #######################################################################
2236 # compare test results with the expected output, we might filter off
2237 # some pattern that is allowed to differ, output test results
2240 # filter off patterns _before_ this comparison!
2241 my ($testnum, $testname, $subject, $firstref, $secondref)=@_;
2243 my $result = compareparts($firstref, $secondref);
2246 # timestamp test result verification end
2247 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
2250 logmsg "\n $testnum: $subject FAILED:\n";
2251 logmsg showdiff($LOGDIR, $firstref, $secondref);
2253 elsif(!$automakestyle) {
2258 logmsg "FAIL: $testnum - $testname - $subject\n";
2264 #######################################################################
2265 # display information about curl and the host the test suite runs on
2269 unlink($memdump); # remove this if there was one left
2278 my $curlverout="$LOGDIR/curlverout.log";
2279 my $curlvererr="$LOGDIR/curlvererr.log";
2280 my $versioncmd="$CURL --version 1>$curlverout 2>$curlvererr";
2282 unlink($curlverout);
2283 unlink($curlvererr);
2285 $versretval = runclient($versioncmd);
2288 open(VERSOUT, "<$curlverout");
2289 @version = <VERSOUT>;
2297 $curl =~ s/^(.*)(libcurl.*)/$1/g;
2300 if($curl =~ /mingw32/) {
2301 # This is a windows minw32 build, we need to translate the
2302 # given path to the "actual" windows path. The MSYS shell
2303 # has a builtin 'pwd -W' command which converts the path.
2304 $pwd = `sh -c "echo \$(pwd -W)"`;
2307 elsif ($curl =~ /win32/) {
2308 # Native Windows builds don't understand the
2309 # output of cygwin's pwd. It will be
2310 # something like /cygdrive/c/<some path>.
2312 # Use the cygpath utility to convert the
2313 # working directory to a Windows friendly
2314 # path. The -m option converts to use drive
2315 # letter:, but it uses / instead \. Forward
2316 # slashes (/) are easier for us. We don't
2317 # have to escape them to get them to curl
2319 chomp($pwd = `cygpath -m $pwd`);
2321 if ($libcurl =~ /winssl/i) {
2325 elsif ($libcurl =~ /openssl/i) {
2329 elsif ($libcurl =~ /gnutls/i) {
2333 elsif ($libcurl =~ /nss/i) {
2337 elsif ($libcurl =~ /yassl/i) {
2341 elsif ($libcurl =~ /polarssl/i) {
2345 elsif ($libcurl =~ /axtls/i) {
2349 elsif ($libcurl =~ /securetransport/i) {
2351 $ssllib="DarwinSSL";
2354 elsif($_ =~ /^Protocols: (.*)/i) {
2355 # these are the protocols compiled in to this libcurl
2356 @protocols = split(' ', lc($1));
2358 # Generate a "proto-ipv6" version of each protocol to match the
2359 # IPv6 <server> name. This works even if IPv6 support isn't
2360 # compiled in because the <features> test will fail.
2361 push @protocols, map($_ . '-ipv6', @protocols);
2363 # 'http-proxy' is used in test cases to do CONNECT through
2364 push @protocols, 'http-proxy';
2366 # 'http-pipe' is the special server for testing pipelining
2367 push @protocols, 'http-pipe';
2369 # 'none' is used in test cases to mean no server
2370 push @protocols, 'none';
2372 elsif($_ =~ /^Features: (.*)/i) {
2374 if($feat =~ /TrackMemory/i) {
2375 # built with memory tracking support (--enable-curldebug)
2376 $has_memory_tracking = 1;
2378 if($feat =~ /debug/i) {
2379 # curl was built with --enable-debug
2382 if($feat =~ /SSL/i) {
2386 if($feat =~ /Largefile/i) {
2387 # large file support
2390 if($feat =~ /IDN/i) {
2394 if($feat =~ /IPv6/i) {
2397 if($feat =~ /libz/i) {
2400 if($feat =~ /NTLM/i) {
2404 if($feat =~ /NTLM_WB/i) {
2405 # NTLM delegation to winbind daemon ntlm_auth helper enabled
2408 if($feat =~ /CharConv/i) {
2412 if($feat =~ /TLS-SRP/i) {
2416 if($feat =~ /Metalink/i) {
2422 # Test harness currently uses a non-stunnel server in order to
2423 # run HTTP TLS-SRP tests required when curl is built with https
2424 # protocol support and TLS-SRP feature enabled. For convenience
2425 # 'httptls' may be included in the test harness protocols array
2426 # to differentiate this from classic stunnel based 'https' test
2432 if($_ =~ /^https(-ipv6|)$/) {
2437 if($add_httptls && (! grep /^httptls$/, @protocols)) {
2438 push @protocols, 'httptls';
2439 push @protocols, 'httptls-ipv6';
2444 logmsg "unable to get curl's version, further details are:\n";
2445 logmsg "issued command: \n";
2446 logmsg "$versioncmd \n";
2447 if ($versretval == -1) {
2448 logmsg "command failed with: \n";
2449 logmsg "$versnoexec \n";
2451 elsif ($versretval & 127) {
2452 logmsg sprintf("command died with signal %d, and %s coredump.\n",
2453 ($versretval & 127), ($versretval & 128)?"a":"no");
2456 logmsg sprintf("command exited with value %d \n", $versretval >> 8);
2458 logmsg "contents of $curlverout: \n";
2459 displaylogcontent("$curlverout");
2460 logmsg "contents of $curlvererr: \n";
2461 displaylogcontent("$curlvererr");
2462 die "couldn't get curl's version";
2465 if(-r "../lib/curl_config.h") {
2466 open(CONF, "<../lib/curl_config.h");
2468 if($_ =~ /^\#define HAVE_GETRLIMIT/) {
2476 # client has ipv6 support
2478 # check if the HTTP server has it!
2479 my @sws = `server/sws --version`;
2480 if($sws[0] =~ /IPv6/) {
2481 # HTTP server has ipv6 support!
2486 # check if the FTP server has it!
2487 @sws = `server/sockfilt --version`;
2488 if($sws[0] =~ /IPv6/) {
2489 # FTP server has ipv6 support!
2494 if(!$has_memory_tracking && $torture) {
2495 die "can't run torture tests since curl was built without ".
2496 "TrackMemory feature (--enable-curldebug)";
2499 $has_shared = `sh $CURLCONFIG --built-shared`;
2502 # curl doesn't list cryptographic support separately, so assume it's
2506 my $hostname=join(' ', runclientoutput("hostname"));
2507 my $hosttype=join(' ', runclientoutput("uname -a"));
2509 logmsg ("********* System characteristics ******** \n",
2512 "* Features: $feat\n",
2513 "* Host: $hostname",
2514 "* System: $hosttype");
2516 logmsg sprintf("* Server SSL: %8s", $stunnel?"ON ":"OFF");
2517 logmsg sprintf(" libcurl SSL: %s\n", $ssl_version?"ON ":"OFF");
2518 logmsg sprintf("* debug build: %8s", $debug_build?"ON ":"OFF");
2519 logmsg sprintf(" track memory: %s\n", $has_memory_tracking?"ON ":"OFF");
2520 logmsg sprintf("* valgrind: %8s", $valgrind?"ON ":"OFF");
2521 logmsg sprintf(" HTTP IPv6 %s\n", $http_ipv6?"ON ":"OFF");
2522 logmsg sprintf("* FTP IPv6 %8s", $ftp_ipv6?"ON ":"OFF");
2523 logmsg sprintf(" Libtool lib: %s\n", $libtool?"ON ":"OFF");
2524 logmsg sprintf("* Shared build: %s\n", $has_shared);
2526 logmsg sprintf("* SSL library: %13s\n", $ssllib);
2529 logmsg "* Ports:\n";
2531 logmsg sprintf("* HTTP/%d ", $HTTPPORT);
2532 logmsg sprintf("FTP/%d ", $FTPPORT);
2533 logmsg sprintf("FTP2/%d ", $FTP2PORT);
2534 logmsg sprintf("RTSP/%d ", $RTSPPORT);
2536 logmsg sprintf("FTPS/%d ", $FTPSPORT);
2537 logmsg sprintf("HTTPS/%d ", $HTTPSPORT);
2539 logmsg sprintf("\n* TFTP/%d ", $TFTPPORT);
2541 logmsg sprintf("HTTP-IPv6/%d ", $HTTP6PORT);
2542 logmsg sprintf("RTSP-IPv6/%d ", $RTSP6PORT);
2545 logmsg sprintf("FTP-IPv6/%d ", $FTP6PORT);
2548 logmsg sprintf("TFTP-IPv6/%d ", $TFTP6PORT);
2550 logmsg sprintf("\n* GOPHER/%d ", $GOPHERPORT);
2552 logmsg sprintf("GOPHER-IPv6/%d", $GOPHERPORT);
2554 logmsg sprintf("\n* SSH/%d ", $SSHPORT);
2555 logmsg sprintf("SOCKS/%d ", $SOCKSPORT);
2556 logmsg sprintf("POP3/%d ", $POP3PORT);
2557 logmsg sprintf("IMAP/%d ", $IMAPPORT);
2558 logmsg sprintf("SMTP/%d\n", $SMTPPORT);
2560 logmsg sprintf("* POP3-IPv6/%d ", $POP36PORT);
2561 logmsg sprintf("IMAP-IPv6/%d ", $IMAP6PORT);
2562 logmsg sprintf("SMTP-IPv6/%d\n", $SMTP6PORT);
2565 logmsg sprintf("* HTTPTLS/%d ", $HTTPTLSPORT);
2567 logmsg sprintf("HTTPTLS-IPv6/%d ", $HTTPTLS6PORT);
2571 logmsg sprintf("* HTTP-PIPE/%d \n", $HTTPPIPEPORT);
2573 $has_textaware = ($^O eq 'MSWin32') || ($^O eq 'msys');
2575 logmsg "***************************************** \n";
2578 #######################################################################
2579 # substitute the variable stuff into either a joined up file or
2580 # a command, in either case passed by reference
2587 $$thing =~ s/%FTP6PORT/$FTP6PORT/g;
2588 $$thing =~ s/%FTP2PORT/$FTP2PORT/g;
2589 $$thing =~ s/%FTPSPORT/$FTPSPORT/g;
2590 $$thing =~ s/%FTPPORT/$FTPPORT/g;
2592 $$thing =~ s/%GOPHER6PORT/$GOPHER6PORT/g;
2593 $$thing =~ s/%GOPHERPORT/$GOPHERPORT/g;
2595 $$thing =~ s/%HTTPTLS6PORT/$HTTPTLS6PORT/g;
2596 $$thing =~ s/%HTTPTLSPORT/$HTTPTLSPORT/g;
2597 $$thing =~ s/%HTTP6PORT/$HTTP6PORT/g;
2598 $$thing =~ s/%HTTPSPORT/$HTTPSPORT/g;
2599 $$thing =~ s/%HTTPPORT/$HTTPPORT/g;
2600 $$thing =~ s/%HTTPPIPEPORT/$HTTPPIPEPORT/g;
2601 $$thing =~ s/%PROXYPORT/$HTTPPROXYPORT/g;
2603 $$thing =~ s/%IMAP6PORT/$IMAP6PORT/g;
2604 $$thing =~ s/%IMAPPORT/$IMAPPORT/g;
2606 $$thing =~ s/%POP36PORT/$POP36PORT/g;
2607 $$thing =~ s/%POP3PORT/$POP3PORT/g;
2609 $$thing =~ s/%RTSP6PORT/$RTSP6PORT/g;
2610 $$thing =~ s/%RTSPPORT/$RTSPPORT/g;
2612 $$thing =~ s/%SMTP6PORT/$SMTP6PORT/g;
2613 $$thing =~ s/%SMTPPORT/$SMTPPORT/g;
2615 $$thing =~ s/%SOCKSPORT/$SOCKSPORT/g;
2616 $$thing =~ s/%SSHPORT/$SSHPORT/g;
2618 $$thing =~ s/%TFTP6PORT/$TFTP6PORT/g;
2619 $$thing =~ s/%TFTPPORT/$TFTPPORT/g;
2621 # client IP addresses
2623 $$thing =~ s/%CLIENT6IP/$CLIENT6IP/g;
2624 $$thing =~ s/%CLIENTIP/$CLIENTIP/g;
2626 # server IP addresses
2628 $$thing =~ s/%HOST6IP/$HOST6IP/g;
2629 $$thing =~ s/%HOSTIP/$HOSTIP/g;
2633 $$thing =~ s/%CURL/$CURL/g;
2634 $$thing =~ s/%PWD/$pwd/g;
2635 $$thing =~ s/%SRCDIR/$srcdir/g;
2636 $$thing =~ s/%USER/$USER/g;
2638 # The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be
2639 # used for time-out tests and that whould work on most hosts as these
2640 # adjust for the startup/check time for this particular host. We needed
2641 # to do this to make the test suite run better on very slow hosts.
2643 my $ftp2 = $ftpchecktime * 2;
2644 my $ftp3 = $ftpchecktime * 3;
2646 $$thing =~ s/%FTPTIME2/$ftp2/g;
2647 $$thing =~ s/%FTPTIME3/$ftp3/g;
2659 #######################################################################
2660 # Provide time stamps for single test skipped events
2662 sub timestampskippedevents {
2663 my $testnum = $_[0];
2665 return if((not defined($testnum)) || ($testnum < 1));
2669 if($timevrfyend{$testnum}) {
2672 elsif($timesrvrlog{$testnum}) {
2673 $timevrfyend{$testnum} = $timesrvrlog{$testnum};
2676 elsif($timetoolend{$testnum}) {
2677 $timevrfyend{$testnum} = $timetoolend{$testnum};
2678 $timesrvrlog{$testnum} = $timetoolend{$testnum};
2680 elsif($timetoolini{$testnum}) {
2681 $timevrfyend{$testnum} = $timetoolini{$testnum};
2682 $timesrvrlog{$testnum} = $timetoolini{$testnum};
2683 $timetoolend{$testnum} = $timetoolini{$testnum};
2685 elsif($timesrvrend{$testnum}) {
2686 $timevrfyend{$testnum} = $timesrvrend{$testnum};
2687 $timesrvrlog{$testnum} = $timesrvrend{$testnum};
2688 $timetoolend{$testnum} = $timesrvrend{$testnum};
2689 $timetoolini{$testnum} = $timesrvrend{$testnum};
2691 elsif($timesrvrini{$testnum}) {
2692 $timevrfyend{$testnum} = $timesrvrini{$testnum};
2693 $timesrvrlog{$testnum} = $timesrvrini{$testnum};
2694 $timetoolend{$testnum} = $timesrvrini{$testnum};
2695 $timetoolini{$testnum} = $timesrvrini{$testnum};
2696 $timesrvrend{$testnum} = $timesrvrini{$testnum};
2698 elsif($timeprepini{$testnum}) {
2699 $timevrfyend{$testnum} = $timeprepini{$testnum};
2700 $timesrvrlog{$testnum} = $timeprepini{$testnum};
2701 $timetoolend{$testnum} = $timeprepini{$testnum};
2702 $timetoolini{$testnum} = $timeprepini{$testnum};
2703 $timesrvrend{$testnum} = $timeprepini{$testnum};
2704 $timesrvrini{$testnum} = $timeprepini{$testnum};
2709 #######################################################################
2710 # Run a single specified test case
2713 my ($testnum, $count, $total)=@_;
2719 my $disablevalgrind;
2721 # copy test number to a global scope var, this allows
2722 # testnum checking when starting test harness servers.
2723 $testnumcheck = $testnum;
2725 # timestamp test preparation start
2726 $timeprepini{$testnum} = Time::HiRes::time() if($timestats);
2728 if($disttests !~ /test$testnum\W/ ) {
2729 logmsg "Warning: test$testnum not present in tests/data/Makefile.am\n";
2731 if($disabled{$testnum}) {
2732 logmsg "Warning: test$testnum is explicitly disabled\n";
2735 # load the test case file definition
2736 if(loadtest("${TESTDIR}/test${testnum}")) {
2738 # this is not a test
2739 logmsg "RUN: $testnum doesn't look like a test case\n";
2744 @what = getpart("client", "features");
2751 $feature{$f}=$f; # we require this feature
2758 elsif($f eq "OpenSSL") {
2763 elsif($f eq "GnuTLS") {
2768 elsif($f eq "NSS") {
2773 elsif($f eq "axTLS") {
2778 elsif($f eq "WinSSL") {
2783 elsif($f eq "DarwinSSL") {
2784 if($has_darwinssl) {
2788 elsif($f eq "unittest") {
2793 elsif($f eq "debug") {
2798 elsif($f eq "TrackMemory") {
2799 if($has_memory_tracking) {
2803 elsif($f eq "large_file") {
2808 elsif($f eq "idn") {
2813 elsif($f eq "ipv6") {
2818 elsif($f eq "libz") {
2823 elsif($f eq "NTLM") {
2828 elsif($f eq "NTLM_WB") {
2833 elsif($f eq "getrlimit") {
2834 if($has_getrlimit) {
2838 elsif($f eq "crypto") {
2843 elsif($f eq "TLS-SRP") {
2848 elsif($f eq "Metalink") {
2853 elsif($f eq "socks") {
2856 # See if this "feature" is in the list of supported protocols
2857 elsif (grep /^\Q$f\E$/i, @protocols) {
2861 $why = "curl lacks $f support";
2866 my @keywords = getpart("info", "keywords");
2869 for $k (@keywords) {
2871 if ($disabled_keywords{$k}) {
2872 $why = "disabled by keyword";
2873 } elsif ($enabled_keywords{$k}) {
2878 if(!$why && !$match && %enabled_keywords) {
2879 $why = "disabled by missing keyword";
2883 # test definition may instruct to (un)set environment vars
2884 # this is done this early, so that the precheck can use environment
2885 # variables and still bail out fine on errors
2887 # restore environment variables that were modified in a previous run
2888 foreach my $var (keys %oldenv) {
2889 if($oldenv{$var} eq 'notset') {
2890 delete $ENV{$var} if($ENV{$var});
2893 $ENV{$var} = $oldenv{$var};
2895 delete $oldenv{$var};
2898 # remove test server commands file before servers are started/verified
2899 unlink($FTPDCMD) if(-f $FTPDCMD);
2901 # timestamp required servers verification start
2902 $timesrvrini{$testnum} = Time::HiRes::time() if($timestats);
2905 $why = serverfortest($testnum);
2908 # timestamp required servers verification end
2909 $timesrvrend{$testnum} = Time::HiRes::time() if($timestats);
2911 my @setenv = getpart("client", "setenv");
2913 foreach my $s (@setenv) {
2916 if($s =~ /([^=]*)=(.*)/) {
2917 my ($var, $content) = ($1, $2);
2918 # remember current setting, to restore it once test runs
2919 $oldenv{$var} = ($ENV{$var})?"$ENV{$var}":'notset';
2922 delete $ENV{$var} if($ENV{$var});
2925 if($var =~ /^LD_PRELOAD/) {
2926 if(exe_ext() && (exe_ext() eq '.exe')) {
2927 # print "Skipping LD_PRELOAD due to lack of OS support\n";
2930 if($debug_build || ($has_shared ne "yes")) {
2931 # print "Skipping LD_PRELOAD due to no release shared build\n";
2935 $ENV{$var} = "$content";
2943 # Add a precheck cache. If a precheck command was already invoked
2944 # exactly like this, then use the previous result to speed up
2945 # successive test invokes!
2947 my @precheck = getpart("client", "precheck");
2949 $cmd = $precheck[0];
2953 my @p = split(/ /, $cmd);
2955 # the first word, the command, does not contain a slash so
2956 # we will scan the "improved" PATH to find the command to
2958 my $fullp = checktestcmd($p[0]);
2963 $cmd = join(" ", @p);
2966 my @o = `$cmd 2>/dev/null`;
2971 $why = "precheck command error";
2973 logmsg "prechecked $cmd\n" if($verbose);
2978 if($why && !$listonly) {
2979 # there's a problem, count it as "skipped"
2982 $teststat[$testnum]=$why; # store reason for this test case
2985 if($skipped{$why} <= 3) {
2986 # show only the first three skips for each reason
2987 logmsg sprintf("test %03d SKIPPED: $why\n", $testnum);
2991 timestampskippedevents($testnum);
2994 logmsg sprintf("test %03d...", $testnum) if(!$automakestyle);
2996 # extract the reply data
2997 my @reply = getpart("reply", "data");
2998 my @replycheck = getpart("reply", "datacheck");
3001 # we use this file instead to check the final output against
3003 my %hash = getpartattr("reply", "datacheck");
3004 if($hash{'nonewline'}) {
3005 # Yes, we must cut off the final newline from the final line
3007 chomp($replycheck[$#replycheck]);
3013 # this is the valid protocol blurb curl should generate
3014 my @protocol= fixarray ( getpart("verify", "protocol") );
3016 # this is the valid protocol blurb curl should generate to a proxy
3017 my @proxyprot = fixarray ( getpart("verify", "proxy") );
3019 # redirected stdout/stderr to these files
3020 $STDOUT="$LOGDIR/stdout$testnum";
3021 $STDERR="$LOGDIR/stderr$testnum";
3023 # if this section exists, we verify that the stdout contained this:
3024 my @validstdout = fixarray ( getpart("verify", "stdout") );
3026 # if this section exists, we verify upload
3027 my @upload = getpart("verify", "upload");
3029 # if this section exists, it might be FTP server instructions:
3030 my @ftpservercmd = getpart("reply", "servercmd");
3032 my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout
3035 my @testname= getpart("client", "name");
3036 my $testname = $testname[0];
3037 $testname =~ s/\n//g;
3038 logmsg "[$testname]\n" if(!$short);
3041 timestampskippedevents($testnum);
3042 return 0; # look successful
3045 my @codepieces = getpart("client", "tool");
3049 $tool = $codepieces[0];
3053 # remove server output logfile
3059 # write the instructions to file
3060 writearray($FTPDCMD, \@ftpservercmd);
3063 # get the command line options to use
3065 ($cmd, @blaha)= getpart("client", "command");
3068 # make some nice replace operations
3069 $cmd =~ s/\n//g; # no newlines please
3070 # substitute variables in the command line
3074 # there was no command given, use something silly
3077 if($has_memory_tracking) {
3081 # create a (possibly-empty) file before starting the test
3082 my @inputfile=getpart("client", "file");
3083 my %fileattr = getpartattr("client", "file");
3084 my $filename=$fileattr{'name'};
3085 if(@inputfile || $filename) {
3087 logmsg "ERROR: section client=>file has no name attribute\n";
3088 timestampskippedevents($testnum);
3091 my $fileContent = join('', @inputfile);
3092 subVariables \$fileContent;
3093 # logmsg "DEBUG: writing file " . $filename . "\n";
3094 open(OUTFILE, ">$filename");
3095 binmode OUTFILE; # for crapage systems, use binary
3096 print OUTFILE $fileContent;
3100 my %cmdhash = getpartattr("client", "command");
3104 if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-output/)) {
3105 #We may slap on --output!
3106 if (!@validstdout) {
3107 $out=" --output $CURLOUT ";
3111 my $serverlogslocktimeout = $defserverlogslocktimeout;
3112 if($cmdhash{'timeout'}) {
3113 # test is allowed to override default server logs lock timeout
3114 if($cmdhash{'timeout'} =~ /(\d+)/) {
3115 $serverlogslocktimeout = $1 if($1 >= 0);
3119 my $postcommanddelay = $defpostcommanddelay;
3120 if($cmdhash{'delay'}) {
3121 # test is allowed to specify a delay after command is executed
3122 if($cmdhash{'delay'} =~ /(\d+)/) {
3123 $postcommanddelay = $1 if($1 > 0);
3129 my $cmdtype = $cmdhash{'type'} || "default";
3130 if($cmdtype eq "perl") {
3131 # run the command line prepended with "perl"
3137 elsif($cmdtype eq "shell") {
3138 # run the command line prepended with "/bin/sh"
3140 $CMDLINE = "/bin/sh ";
3145 # run curl, add --verbose for debug information output
3146 $cmd = "-1 ".$cmd if(exists $feature{"SSL"} && ($has_axtls));
3149 if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-include/)) {
3150 $inc = "--include ";
3153 $cmdargs ="$out $inc--trace-ascii log/trace$testnum --trace-time $cmd";
3156 $cmdargs = " $cmd"; # $cmd is the command line for the test file
3157 $CURLOUT = $STDOUT; # sends received data to stdout
3159 if($tool =~ /^lib/) {
3160 $CMDLINE="$LIBDIR/$tool";
3162 elsif($tool =~ /^unit/) {
3163 $CMDLINE="$UNITDIR/$tool";
3167 logmsg "The tool set in the test case for this: '$tool' does not exist\n";
3168 timestampskippedevents($testnum);
3174 my @stdintest = getpart("client", "stdin");
3177 my $stdinfile="$LOGDIR/stdin-for-$testnum";
3179 my %hash = getpartattr("client", "stdin");
3180 if($hash{'nonewline'}) {
3181 # cut off the final newline from the final line of the stdin data
3182 chomp($stdintest[$#stdintest]);
3185 writearray($stdinfile, \@stdintest);
3187 $cmdargs .= " <$stdinfile";
3195 if($valgrind && !$disablevalgrind) {
3196 my @valgrindoption = getpart("verify", "valgrind");
3197 if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) {
3199 my $valgrindcmd = "$valgrind ";
3200 $valgrindcmd .= "$valgrind_tool " if($valgrind_tool);
3201 $valgrindcmd .= "--leak-check=yes ";
3202 $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp ";
3203 $valgrindcmd .= "--num-callers=16 ";
3204 $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum";
3205 $CMDLINE = "$valgrindcmd $CMDLINE";
3209 $CMDLINE .= "$cmdargs >$STDOUT 2>$STDERR";
3212 logmsg "$CMDLINE\n";
3215 print CMDLOG "$CMDLINE\n";
3222 # Apr 2007: precommand isn't being used and could be removed
3223 my @precommand= getpart("client", "precommand");
3224 if($precommand[0]) {
3225 # this is pure perl to eval!
3226 my $code = join("", @precommand);
3229 logmsg "perl: $code\n";
3230 logmsg "precommand: $@";
3231 stopservers($verbose);
3232 timestampskippedevents($testnum);
3238 my $gdbinit = "$TESTDIR/gdbinit$testnum";
3239 open(GDBCMD, ">$LOGDIR/gdbcmd");
3240 print GDBCMD "set args $cmdargs\n";
3241 print GDBCMD "show args\n";
3242 print GDBCMD "source $gdbinit\n" if -e $gdbinit;
3246 # timestamp starting of test command
3247 $timetoolini{$testnum} = Time::HiRes::time() if($timestats);
3249 # run the command line we built
3251 $cmdres = torture($CMDLINE,
3252 "$gdb --directory libtest $DBGCURL -x $LOGDIR/gdbcmd");
3255 my $GDBW = ($gdbxwin) ? "-w" : "";
3256 runclient("$gdb --directory libtest $DBGCURL $GDBW -x $LOGDIR/gdbcmd");
3257 $cmdres=0; # makes it always continue after a debugged run
3260 $cmdres = runclient("$CMDLINE");
3261 my $signal_num = $cmdres & 127;
3262 $dumped_core = $cmdres & 128;
3264 if(!$anyway && ($signal_num || $dumped_core)) {
3269 $cmdres = (2000 + $signal_num) if($signal_num && !$cmdres);
3273 # timestamp finishing of test command
3274 $timetoolend{$testnum} = Time::HiRes::time() if($timestats);
3278 # there's core file present now!
3284 logmsg "core dumped\n";
3286 logmsg "running gdb for post-mortem analysis:\n";
3287 open(GDBCMD, ">$LOGDIR/gdbcmd2");
3288 print GDBCMD "bt\n";
3290 runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch $DBGCURL core ");
3291 # unlink("$LOGDIR/gdbcmd2");
3295 # If a server logs advisor read lock file exists, it is an indication
3296 # that the server has not yet finished writing out all its log files,
3297 # including server request log files used for protocol verification.
3298 # So, if the lock file exists the script waits here a certain amount
3299 # of time until the server removes it, or the given time expires.
3301 if($serverlogslocktimeout) {
3302 my $lockretry = $serverlogslocktimeout * 20;
3303 while((-f $SERVERLOGS_LOCK) && $lockretry--) {
3304 select(undef, undef, undef, 0.05);
3306 if(($lockretry < 0) &&
3307 ($serverlogslocktimeout >= $defserverlogslocktimeout)) {
3308 logmsg "Warning: server logs lock timeout ",
3309 "($serverlogslocktimeout seconds) expired\n";
3313 # Test harness ssh server does not have this synchronization mechanism,
3314 # this implies that some ssh server based tests might need a small delay
3315 # once that the client command has run to avoid false test failures.
3317 # gnutls-serv also lacks this synchronization mechanism, so gnutls-serv
3318 # based tests might need a small delay once that the client command has
3319 # run to avoid false test failures.
3321 sleep($postcommanddelay) if($postcommanddelay);
3323 # timestamp removal of server logs advisor read lock
3324 $timesrvrlog{$testnum} = Time::HiRes::time() if($timestats);
3326 # test definition might instruct to stop some servers
3327 # stop also all servers relative to the given one
3329 my @killtestservers = getpart("client", "killserver");
3330 if(@killtestservers) {
3332 # All servers relative to the given one must be stopped also
3335 foreach my $server (@killtestservers) {
3337 if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|))$/) {
3338 # given a stunnel ssl server, also kill non-ssl underlying one
3339 push @killservers, "${1}${2}";
3341 elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|))$/) {
3342 # given a non-ssl server, also kill stunnel piggybacking one
3343 push @killservers, "${1}s${2}";
3345 elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
3346 # given a socks server, also kill ssh underlying one
3347 push @killservers, "ssh${2}";
3349 elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
3350 # given a ssh server, also kill socks piggybacking one
3351 push @killservers, "socks${2}";
3353 push @killservers, $server;
3356 # kill sockfilter processes for pingpong relative servers
3358 foreach my $server (@killservers) {
3359 if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
3361 my $idnum = ($2 && ($2 > 1)) ? $2 : 1;
3362 my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
3363 killsockfilters($proto, $ipvnum, $idnum, $verbose);
3367 # kill server relative pids clearing them in %run hash
3370 foreach my $server (@killservers) {
3372 $pidlist .= "$run{$server} ";
3375 $runcert{$server} = 0 if($runcert{$server});
3377 killpid($verbose, $pidlist);
3379 # cleanup server pid files
3381 foreach my $server (@killservers) {
3382 my $pidfile = $serverpidfile{$server};
3383 my $pid = processexists($pidfile);
3385 logmsg "Warning: $server server unexpectedly alive\n";
3386 killpid($verbose, $pid);
3388 unlink($pidfile) if(-f $pidfile);
3392 # remove the test server commands file after each test
3393 unlink($FTPDCMD) if(-f $FTPDCMD);
3395 # run the postcheck command
3396 my @postcheck= getpart("client", "postcheck");
3398 $cmd = $postcheck[0];
3402 logmsg "postcheck $cmd\n" if($verbose);
3403 my $rc = runclient("$cmd");
3404 # Must run the postcheck command in torture mode in order
3405 # to clean up, but the result can't be relied upon.
3406 if($rc != 0 && !$torture) {
3407 logmsg " postcheck FAILED\n";
3408 # timestamp test result verification end
3409 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3415 # restore environment variables that were modified
3417 foreach my $var (keys %oldenv) {
3418 if($oldenv{$var} eq 'notset') {
3419 delete $ENV{$var} if($ENV{$var});
3422 $ENV{$var} = "$oldenv{$var}";
3427 # Skip all the verification on torture tests
3429 if(!$cmdres && !$keepoutfiles) {
3432 # timestamp test result verification end
3433 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3437 my @err = getpart("verify", "errorcode");
3438 my $errorcode = $err[0] || "0";
3443 # verify redirected stdout
3444 my @actual = loadarray($STDOUT);
3446 # variable-replace in the stdout we have from the test case file
3447 @validstdout = fixarray(@validstdout);
3449 # get all attributes
3450 my %hash = getpartattr("verify", "stdout");
3452 # get the mode attribute
3453 my $filemode=$hash{'mode'};
3454 if($filemode && ($filemode eq "text") && $has_textaware) {
3455 # text mode when running on windows: fix line endings
3456 map s/\r\n/\n/g, @actual;
3459 if($hash{'nonewline'}) {
3460 # Yes, we must cut off the final newline from the final line
3461 # of the protocol data
3462 chomp($validstdout[$#validstdout]);
3465 $res = compare($testnum, $testname, "stdout", \@actual, \@validstdout);
3472 $ok .= "-"; # stdout not checked
3475 my %replyattr = getpartattr("reply", "data");
3476 if(!$replyattr{'nocheck'} && (@reply || $replyattr{'sendzero'})) {
3477 # verify the received data
3478 my @out = loadarray($CURLOUT);
3479 my %hash = getpartattr("reply", "data");
3480 # get the mode attribute
3481 my $filemode=$hash{'mode'};
3482 if($filemode && ($filemode eq "text") && $has_textaware) {
3483 # text mode when running on windows: fix line endings
3484 map s/\r\n/\n/g, @out;
3487 $res = compare($testnum, $testname, "data", \@out, \@reply);
3494 $ok .= "-"; # data not checked
3498 # verify uploaded data
3499 my @out = loadarray("$LOGDIR/upload.$testnum");
3500 $res = compare($testnum, $testname, "upload", \@out, \@upload);
3507 $ok .= "-"; # upload not checked
3511 # Verify the sent request
3512 my @out = loadarray($SERVERIN);
3514 # what to cut off from the live protocol sent by curl
3515 my @strip = getpart("verify", "strip");
3517 my @protstrip=@protocol;
3519 # check if there's any attributes on the verify/protocol section
3520 my %hash = getpartattr("verify", "protocol");
3522 if($hash{'nonewline'}) {
3523 # Yes, we must cut off the final newline from the final line
3524 # of the protocol data
3525 chomp($protstrip[$#protstrip]);
3529 # strip off all lines that match the patterns from both arrays
3531 @out = striparray( $_, \@out);
3532 @protstrip= striparray( $_, \@protstrip);
3535 # what parts to cut off from the protocol
3536 my @strippart = getpart("verify", "strippart");
3538 for $strip (@strippart) {
3545 $res = compare($testnum, $testname, "protocol", \@out, \@protstrip);
3554 $ok .= "-"; # protocol not checked
3558 # Verify the sent proxy request
3559 my @out = loadarray($PROXYIN);
3561 # what to cut off from the live protocol sent by curl, we use the
3562 # same rules as for <protocol>
3563 my @strip = getpart("verify", "strip");
3565 my @protstrip=@proxyprot;
3567 # check if there's any attributes on the verify/protocol section
3568 my %hash = getpartattr("verify", "proxy");
3570 if($hash{'nonewline'}) {
3571 # Yes, we must cut off the final newline from the final line
3572 # of the protocol data
3573 chomp($protstrip[$#protstrip]);
3577 # strip off all lines that match the patterns from both arrays
3579 @out = striparray( $_, \@out);
3580 @protstrip= striparray( $_, \@protstrip);
3583 # what parts to cut off from the protocol
3584 my @strippart = getpart("verify", "strippart");
3586 for $strip (@strippart) {
3593 $res = compare($testnum, $testname, "proxy", \@out, \@protstrip);
3602 $ok .= "-"; # protocol not checked
3606 for my $partsuffix (('', '1', '2', '3', '4')) {
3607 my @outfile=getpart("verify", "file".$partsuffix);
3608 if(@outfile || partexists("verify", "file".$partsuffix) ) {
3609 # we're supposed to verify a dynamically generated file!
3610 my %hash = getpartattr("verify", "file".$partsuffix);
3612 my $filename=$hash{'name'};
3614 logmsg "ERROR: section verify=>file$partsuffix ".
3615 "has no name attribute\n";
3616 stopservers($verbose);
3617 # timestamp test result verification end
3618 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3621 my @generated=loadarray($filename);
3623 # what parts to cut off from the file
3624 my @stripfile = getpart("verify", "stripfile".$partsuffix);
3626 my $filemode=$hash{'mode'};
3627 if($filemode && ($filemode eq "text") && $has_textaware) {
3628 # text mode when running on windows means adding an extra
3630 push @stripfile, "s/\r\n/\n/";
3634 for $strip (@stripfile) {
3641 @outfile = fixarray(@outfile);
3643 $res = compare($testnum, $testname, "output ($filename)",
3644 \@generated, \@outfile);
3649 $outputok = 1; # output checked
3652 $ok .= ($outputok) ? "o" : "-"; # output checked or not
3654 # accept multiple comma-separated error codes
3655 my @splerr = split(/ *, */, $errorcode);
3657 foreach my $e (@splerr) {
3670 logmsg sprintf("\n%s returned $cmdres, when expecting %s\n",
3671 (!$tool)?"curl":$tool, $errorcode);
3673 logmsg " exit FAILED\n";
3674 # timestamp test result verification end
3675 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3679 if($has_memory_tracking) {
3681 logmsg "\n** ALERT! memory tracking with no output file?\n"
3682 if(!$cmdtype eq "perl");
3685 my @memdata=`$memanalyze $memdump`;
3689 # well it could be other memory problems as well, but
3690 # we call it leak for short here
3695 logmsg "\n** MEMORY FAILURE\n";
3697 # timestamp test result verification end
3698 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3707 $ok .= "-"; # memory not checked
3712 unless(opendir(DIR, "$LOGDIR")) {
3713 logmsg "ERROR: unable to read $LOGDIR\n";
3714 # timestamp test result verification end
3715 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3718 my @files = readdir(DIR);
3721 foreach my $file (@files) {
3722 if($file =~ /^valgrind$testnum(\..*|)$/) {
3728 logmsg "ERROR: valgrind log file missing for test $testnum\n";
3729 # timestamp test result verification end
3730 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3733 my @e = valgrindparse($srcdir, $feature{'SSL'}, "$LOGDIR/$vgfile");
3735 if($automakestyle) {
3736 logmsg "FAIL: $testnum - $testname - valgrind\n";
3739 logmsg " valgrind ERROR ";
3742 # timestamp test result verification end
3743 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3749 if(!$short && !$disablevalgrind) {
3750 logmsg " valgrind SKIPPED\n";
3752 $ok .= "-"; # skipped
3756 $ok .= "-"; # valgrind not checked
3759 logmsg "$ok " if(!$short);
3761 my $sofar= time()-$start;
3762 my $esttotal = $sofar/$count * $total;
3763 my $estleft = $esttotal - $sofar;
3764 my $left=sprintf("remaining: %02d:%02d",
3768 if(!$automakestyle) {
3769 logmsg sprintf("OK (%-3d out of %-3d, %s)\n", $count, $total, $left);
3772 logmsg "PASS: $testnum - $testname\n";
3775 # the test succeeded, remove all log files
3776 if(!$keepoutfiles) {
3780 # timestamp test result verification end
3781 $timevrfyend{$testnum} = Time::HiRes::time() if($timestats);
3786 #######################################################################
3787 # Stop all running test servers
3790 my $verbose = $_[0];
3792 # kill sockfilter processes for all pingpong servers
3794 killallsockfilters($verbose);
3796 # kill all server pids from %run hash clearing them
3799 foreach my $server (keys %run) {
3803 my $pids = $run{$server};
3804 foreach my $pid (split(' ', $pids)) {
3806 logmsg sprintf("* kill pid for %s => %d\n",
3812 $pidlist .= "$run{$server} ";
3815 $runcert{$server} = 0 if($runcert{$server});
3817 killpid($verbose, $pidlist);
3819 # cleanup all server pid files
3821 foreach my $server (keys %serverpidfile) {
3822 my $pidfile = $serverpidfile{$server};
3823 my $pid = processexists($pidfile);
3825 logmsg "Warning: $server server unexpectedly alive\n";
3826 killpid($verbose, $pid);
3828 unlink($pidfile) if(-f $pidfile);
3832 #######################################################################
3833 # startservers() starts all the named servers
3835 # Returns: string with error reason or blank for success
3841 my (@whatlist) = split(/\s+/,$_);
3842 my $what = lc($whatlist[0]);
3843 $what =~ s/[^a-z0-9-]//g;
3846 if($what =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|))$/) {
3847 $certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem';
3850 if(($what eq "pop3") ||
3852 ($what eq "imap") ||
3853 ($what eq "smtp")) {
3854 if($torture && $run{$what} &&
3855 !responsive_pingpong_server($what, "", $verbose)) {
3859 ($pid, $pid2) = runpingpongserver($what, "", $verbose);
3861 return "failed starting ". uc($what) ." server";
3863 printf ("* pid $what => %d %d\n", $pid, $pid2) if($verbose);
3864 $run{$what}="$pid $pid2";
3867 elsif($what eq "ftp2") {
3868 if($torture && $run{'ftp2'} &&
3869 !responsive_pingpong_server("ftp", "2", $verbose)) {
3873 ($pid, $pid2) = runpingpongserver("ftp", "2", $verbose);
3875 return "failed starting FTP2 server";
3877 printf ("* pid ftp2 => %d %d\n", $pid, $pid2) if($verbose);
3878 $run{'ftp2'}="$pid $pid2";
3881 elsif($what eq "ftp-ipv6") {
3882 if($torture && $run{'ftp-ipv6'} &&
3883 !responsive_pingpong_server("ftp", "", $verbose, "ipv6")) {
3884 stopserver('ftp-ipv6');
3886 if(!$run{'ftp-ipv6'}) {
3887 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose, "ipv6");
3889 return "failed starting FTP-IPv6 server";
3891 logmsg sprintf("* pid ftp-ipv6 => %d %d\n", $pid,
3892 $pid2) if($verbose);
3893 $run{'ftp-ipv6'}="$pid $pid2";
3896 elsif($what eq "gopher") {
3897 if($torture && $run{'gopher'} &&
3898 !responsive_http_server("gopher", $verbose, 0, $GOPHERPORT)) {
3899 stopserver('gopher');
3901 if(!$run{'gopher'}) {
3902 ($pid, $pid2) = runhttpserver("gopher", $verbose, 0,
3905 return "failed starting GOPHER server";
3907 logmsg sprintf ("* pid gopher => %d %d\n", $pid, $pid2)
3909 $run{'gopher'}="$pid $pid2";
3912 elsif($what eq "gopher-ipv6") {
3913 if($torture && $run{'gopher-ipv6'} &&
3914 !responsive_http_server("gopher", $verbose, "ipv6",
3916 stopserver('gopher-ipv6');
3918 if(!$run{'gopher-ipv6'}) {
3919 ($pid, $pid2) = runhttpserver("gopher", $verbose, "ipv6",
3922 return "failed starting GOPHER-IPv6 server";
3924 logmsg sprintf("* pid gopher-ipv6 => %d %d\n", $pid,
3925 $pid2) if($verbose);
3926 $run{'gopher-ipv6'}="$pid $pid2";
3929 elsif($what eq "http") {
3930 if($torture && $run{'http'} &&
3931 !responsive_http_server("http", $verbose, 0, $HTTPPORT)) {
3935 ($pid, $pid2) = runhttpserver("http", $verbose, 0,
3938 return "failed starting HTTP server";
3940 logmsg sprintf ("* pid http => %d %d\n", $pid, $pid2)
3942 $run{'http'}="$pid $pid2";
3945 elsif($what eq "http-proxy") {
3946 if($torture && $run{'http-proxy'} &&
3947 !responsive_http_server("http", $verbose, "proxy",
3949 stopserver('http-proxy');
3951 if(!$run{'http-proxy'}) {
3952 ($pid, $pid2) = runhttpserver("http", $verbose, "proxy",
3955 return "failed starting HTTP-proxy server";
3957 logmsg sprintf ("* pid http-proxy => %d %d\n", $pid, $pid2)
3959 $run{'http-proxy'}="$pid $pid2";
3962 elsif($what eq "http-ipv6") {
3963 if($torture && $run{'http-ipv6'} &&
3964 !responsive_http_server("http", $verbose, "IPv6", $HTTP6PORT)) {
3965 stopserver('http-ipv6');
3967 if(!$run{'http-ipv6'}) {
3968 ($pid, $pid2) = runhttpserver("http", $verbose, "ipv6",
3971 return "failed starting HTTP-IPv6 server";
3973 logmsg sprintf("* pid http-ipv6 => %d %d\n", $pid, $pid2)
3975 $run{'http-ipv6'}="$pid $pid2";
3978 elsif($what eq "http-pipe") {
3979 if($torture && $run{'http-pipe'} &&
3980 !responsive_http_server("http", $verbose, "pipe",
3982 stopserver('http-pipe');
3984 if(!$run{'http-pipe'}) {
3985 ($pid, $pid2) = runhttpserver("http", $verbose, "pipe",
3988 return "failed starting HTTP-pipe server";
3990 logmsg sprintf ("* pid http-pipe => %d %d\n", $pid, $pid2)
3992 $run{'http-pipe'}="$pid $pid2";
3995 elsif($what eq "rtsp") {
3996 if($torture && $run{'rtsp'} &&
3997 !responsive_rtsp_server($verbose)) {
4001 ($pid, $pid2) = runrtspserver($verbose);
4003 return "failed starting RTSP server";
4005 printf ("* pid rtsp => %d %d\n", $pid, $pid2) if($verbose);
4006 $run{'rtsp'}="$pid $pid2";
4009 elsif($what eq "rtsp-ipv6") {
4010 if($torture && $run{'rtsp-ipv6'} &&
4011 !responsive_rtsp_server($verbose, "IPv6")) {
4012 stopserver('rtsp-ipv6');
4014 if(!$run{'rtsp-ipv6'}) {
4015 ($pid, $pid2) = runrtspserver($verbose, "IPv6");
4017 return "failed starting RTSP-IPv6 server";
4019 logmsg sprintf("* pid rtsp-ipv6 => %d %d\n", $pid, $pid2)
4021 $run{'rtsp-ipv6'}="$pid $pid2";
4024 elsif($what eq "ftps") {
4026 # we can't run ftps tests without stunnel
4027 return "no stunnel";
4030 # we can't run ftps tests if libcurl is SSL-less
4031 return "curl lacks SSL support";
4033 if($runcert{'ftps'} && ($runcert{'ftps'} ne $certfile)) {
4034 # stop server when running and using a different cert
4037 if($torture && $run{'ftp'} &&
4038 !responsive_pingpong_server("ftp", "", $verbose)) {
4042 ($pid, $pid2) = runpingpongserver("ftp", "", $verbose);
4044 return "failed starting FTP server";
4046 printf ("* pid ftp => %d %d\n", $pid, $pid2) if($verbose);
4047 $run{'ftp'}="$pid $pid2";
4050 ($pid, $pid2) = runftpsserver($verbose, "", $certfile);
4052 return "failed starting FTPS server (stunnel)";
4054 logmsg sprintf("* pid ftps => %d %d\n", $pid, $pid2)
4056 $run{'ftps'}="$pid $pid2";
4059 elsif($what eq "file") {
4060 # we support it but have no server!
4062 elsif($what eq "https") {
4064 # we can't run https tests without stunnel
4065 return "no stunnel";
4068 # we can't run https tests if libcurl is SSL-less
4069 return "curl lacks SSL support";
4071 if($runcert{'https'} && ($runcert{'https'} ne $certfile)) {
4072 # stop server when running and using a different cert
4073 stopserver('https');
4075 if($torture && $run{'http'} &&
4076 !responsive_http_server("http", $verbose, 0, $HTTPPORT)) {
4080 ($pid, $pid2) = runhttpserver("http", $verbose, 0,
4083 return "failed starting HTTP server";
4085 printf ("* pid http => %d %d\n", $pid, $pid2) if($verbose);
4086 $run{'http'}="$pid $pid2";
4088 if(!$run{'https'}) {
4089 ($pid, $pid2) = runhttpsserver($verbose, "", $certfile);
4091 return "failed starting HTTPS server (stunnel)";
4093 logmsg sprintf("* pid https => %d %d\n", $pid, $pid2)
4095 $run{'https'}="$pid $pid2";
4098 elsif($what eq "httptls") {
4100 # for now, we can't run http TLS-EXT tests without gnutls-serv
4101 return "no gnutls-serv";
4103 if($torture && $run{'httptls'} &&
4104 !responsive_httptls_server($verbose, "IPv4")) {
4105 stopserver('httptls');
4107 if(!$run{'httptls'}) {
4108 ($pid, $pid2) = runhttptlsserver($verbose, "IPv4");
4110 return "failed starting HTTPTLS server (gnutls-serv)";
4112 logmsg sprintf("* pid httptls => %d %d\n", $pid, $pid2)
4114 $run{'httptls'}="$pid $pid2";
4117 elsif($what eq "httptls-ipv6") {
4119 # for now, we can't run http TLS-EXT tests without gnutls-serv
4120 return "no gnutls-serv";
4122 if($torture && $run{'httptls-ipv6'} &&
4123 !responsive_httptls_server($verbose, "IPv6")) {
4124 stopserver('httptls-ipv6');
4126 if(!$run{'httptls-ipv6'}) {
4127 ($pid, $pid2) = runhttptlsserver($verbose, "IPv6");
4129 return "failed starting HTTPTLS-IPv6 server (gnutls-serv)";
4131 logmsg sprintf("* pid httptls-ipv6 => %d %d\n", $pid, $pid2)
4133 $run{'httptls-ipv6'}="$pid $pid2";
4136 elsif($what eq "tftp") {
4137 if($torture && $run{'tftp'} &&
4138 !responsive_tftp_server("", $verbose)) {
4142 ($pid, $pid2) = runtftpserver("", $verbose);
4144 return "failed starting TFTP server";
4146 printf ("* pid tftp => %d %d\n", $pid, $pid2) if($verbose);
4147 $run{'tftp'}="$pid $pid2";
4150 elsif($what eq "tftp-ipv6") {
4151 if($torture && $run{'tftp-ipv6'} &&
4152 !responsive_tftp_server("", $verbose, "IPv6")) {
4153 stopserver('tftp-ipv6');
4155 if(!$run{'tftp-ipv6'}) {
4156 ($pid, $pid2) = runtftpserver("", $verbose, "IPv6");
4158 return "failed starting TFTP-IPv6 server";
4160 printf("* pid tftp-ipv6 => %d %d\n", $pid, $pid2) if($verbose);
4161 $run{'tftp-ipv6'}="$pid $pid2";
4164 elsif($what eq "sftp" || $what eq "scp" || $what eq "socks4" || $what eq "socks5" ) {
4166 ($pid, $pid2) = runsshserver("", $verbose);
4168 return "failed starting SSH server";
4170 printf ("* pid ssh => %d %d\n", $pid, $pid2) if($verbose);
4171 $run{'ssh'}="$pid $pid2";
4173 if($what eq "socks4" || $what eq "socks5") {
4174 if(!$run{'socks'}) {
4175 ($pid, $pid2) = runsocksserver("", $verbose);
4177 return "failed starting socks server";
4179 printf ("* pid socks => %d %d\n", $pid, $pid2) if($verbose);
4180 $run{'socks'}="$pid $pid2";
4183 if($what eq "socks5") {
4185 # Not an OpenSSH or SunSSH ssh daemon
4186 logmsg "Not OpenSSH or SunSSH; socks5 tests need at least OpenSSH 3.7\n";
4187 return "failed starting socks5 server";
4189 elsif(($sshdid =~ /OpenSSH/) && ($sshdvernum < 370)) {
4190 # Need OpenSSH 3.7 for socks5 - http://www.openssh.com/txt/release-3.7
4191 logmsg "$sshdverstr insufficient; socks5 tests need at least OpenSSH 3.7\n";
4192 return "failed starting socks5 server";
4194 elsif(($sshdid =~ /SunSSH/) && ($sshdvernum < 100)) {
4195 # Need SunSSH 1.0 for socks5
4196 logmsg "$sshdverstr insufficient; socks5 tests need at least SunSSH 1.0\n";
4197 return "failed starting socks5 server";
4201 elsif($what eq "none") {
4202 logmsg "* starts no server\n" if ($verbose);
4205 warn "we don't support a server for $what";
4206 return "no server for $what";
4212 ##############################################################################
4213 # This function makes sure the right set of server is running for the
4214 # specified test case. This is a useful design when we run single tests as not
4215 # all servers need to run then!
4217 # Returns: a string, blank if everything is fine or a reason why it failed
4222 my @what = getpart("client", "server");
4225 warn "Test case $testnum has no server(s) specified";
4226 return "no server specified";
4229 for(my $i = scalar(@what) - 1; $i >= 0; $i--) {
4230 my $srvrline = $what[$i];
4231 chomp $srvrline if($srvrline);
4232 if($srvrline =~ /^(\S+)((\s*)(.*))/) {
4233 my $server = "${1}";
4234 my $lnrest = "${2}";
4236 if($server =~ /^(httptls)(\+)(ext|srp)(\d*)(-ipv6|)$/) {
4237 $server = "${1}${4}${5}";
4238 $tlsext = uc("TLS-${3}");
4240 if(! grep /^\Q$server\E$/, @protocols) {
4241 if(substr($server,0,5) ne "socks") {
4243 return "curl lacks $tlsext support";
4246 return "curl lacks $server server support";
4250 $what[$i] = "$server$lnrest" if($tlsext);
4254 return &startservers(@what);
4257 #######################################################################
4258 # runtimestats displays test-suite run time statistics
4261 my $lasttest = $_[0];
4263 return if(not $timestats);
4265 logmsg "\nTest suite total running time breakdown per task...\n\n";
4273 my $timesrvrtot = 0.0;
4274 my $timepreptot = 0.0;
4275 my $timetooltot = 0.0;
4276 my $timelocktot = 0.0;
4277 my $timevrfytot = 0.0;
4278 my $timetesttot = 0.0;
4281 for my $testnum (1 .. $lasttest) {
4282 if($timesrvrini{$testnum}) {
4283 $timesrvrtot += $timesrvrend{$testnum} - $timesrvrini{$testnum};
4285 (($timetoolini{$testnum} - $timeprepini{$testnum}) -
4286 ($timesrvrend{$testnum} - $timesrvrini{$testnum}));
4287 $timetooltot += $timetoolend{$testnum} - $timetoolini{$testnum};
4288 $timelocktot += $timesrvrlog{$testnum} - $timetoolend{$testnum};
4289 $timevrfytot += $timevrfyend{$testnum} - $timesrvrlog{$testnum};
4290 $timetesttot += $timevrfyend{$testnum} - $timeprepini{$testnum};
4291 push @timesrvr, sprintf("%06.3f %04d",
4292 $timesrvrend{$testnum} - $timesrvrini{$testnum}, $testnum);
4293 push @timeprep, sprintf("%06.3f %04d",
4294 ($timetoolini{$testnum} - $timeprepini{$testnum}) -
4295 ($timesrvrend{$testnum} - $timesrvrini{$testnum}), $testnum);
4296 push @timetool, sprintf("%06.3f %04d",
4297 $timetoolend{$testnum} - $timetoolini{$testnum}, $testnum);
4298 push @timelock, sprintf("%06.3f %04d",
4299 $timesrvrlog{$testnum} - $timetoolend{$testnum}, $testnum);
4300 push @timevrfy, sprintf("%06.3f %04d",
4301 $timevrfyend{$testnum} - $timesrvrlog{$testnum}, $testnum);
4302 push @timetest, sprintf("%06.3f %04d",
4303 $timevrfyend{$testnum} - $timeprepini{$testnum}, $testnum);
4308 no warnings 'numeric';
4309 @timesrvr = sort { $b <=> $a } @timesrvr;
4310 @timeprep = sort { $b <=> $a } @timeprep;
4311 @timetool = sort { $b <=> $a } @timetool;
4312 @timelock = sort { $b <=> $a } @timelock;
4313 @timevrfy = sort { $b <=> $a } @timevrfy;
4314 @timetest = sort { $b <=> $a } @timetest;
4317 logmsg "Spent ". sprintf("%08.3f ", $timesrvrtot) .
4318 "seconds starting and verifying test harness servers.\n";
4319 logmsg "Spent ". sprintf("%08.3f ", $timepreptot) .
4320 "seconds reading definitions and doing test preparations.\n";
4321 logmsg "Spent ". sprintf("%08.3f ", $timetooltot) .
4322 "seconds actually running test tools.\n";
4323 logmsg "Spent ". sprintf("%08.3f ", $timelocktot) .
4324 "seconds awaiting server logs lock removal.\n";
4325 logmsg "Spent ". sprintf("%08.3f ", $timevrfytot) .
4326 "seconds verifying test results.\n";
4327 logmsg "Spent ". sprintf("%08.3f ", $timetesttot) .
4328 "seconds doing all of the above.\n";
4331 logmsg "\nTest server starting and verification time per test ".
4332 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4333 logmsg "-time- test\n";
4334 logmsg "------ ----\n";
4335 foreach my $txt (@timesrvr) {
4336 last if((not $fullstats) && (not $counter--));
4341 logmsg "\nTest definition reading and preparation time per test ".
4342 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4343 logmsg "-time- test\n";
4344 logmsg "------ ----\n";
4345 foreach my $txt (@timeprep) {
4346 last if((not $fullstats) && (not $counter--));
4351 logmsg "\nTest tool execution time per test ".
4352 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4353 logmsg "-time- test\n";
4354 logmsg "------ ----\n";
4355 foreach my $txt (@timetool) {
4356 last if((not $fullstats) && (not $counter--));
4361 logmsg "\nTest server logs lock removal time per test ".
4362 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4363 logmsg "-time- test\n";
4364 logmsg "------ ----\n";
4365 foreach my $txt (@timelock) {
4366 last if((not $fullstats) && (not $counter--));
4371 logmsg "\nTest results verification time per test ".
4372 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4373 logmsg "-time- test\n";
4374 logmsg "------ ----\n";
4375 foreach my $txt (@timevrfy) {
4376 last if((not $fullstats) && (not $counter--));
4381 logmsg "\nTotal time per test ".
4382 sprintf("(%s)...\n\n", (not $fullstats)?"top $counter":"full");
4383 logmsg "-time- test\n";
4384 logmsg "------ ----\n";
4385 foreach my $txt (@timetest) {
4386 last if((not $fullstats) && (not $counter--));
4393 #######################################################################
4394 # Check options to this test program
4401 if ($ARGV[0] eq "-v") {
4405 elsif($ARGV[0] =~ /^-b(.*)/) {
4407 if($portno =~ s/(\d+)$//) {
4411 elsif ($ARGV[0] eq "-c") {
4412 # use this path to curl instead of default
4413 $DBGCURL=$CURL=$ARGV[1];
4416 elsif ($ARGV[0] eq "-d") {
4417 # have the servers display protocol output
4420 elsif ($ARGV[0] eq "-g") {
4421 # run this test with gdb
4424 elsif ($ARGV[0] eq "-gw") {
4425 # run this test with windowed gdb
4429 elsif($ARGV[0] eq "-s") {
4433 elsif($ARGV[0] eq "-am") {
4434 # automake-style output
4438 elsif($ARGV[0] eq "-n") {
4442 elsif($ARGV[0] =~ /^-t(.*)/) {
4447 if($xtra =~ s/(\d+)$//) {
4450 # we undef valgrind to make this fly in comparison
4453 elsif($ARGV[0] eq "-a") {
4454 # continue anyway, even if a test fail
4457 elsif($ARGV[0] eq "-p") {
4460 elsif($ARGV[0] eq "-l") {
4461 # lists the test case names only
4464 elsif($ARGV[0] eq "-k") {
4465 # keep stdout and stderr files after tests
4468 elsif($ARGV[0] eq "-r") {
4469 # run time statistics needs Time::HiRes
4470 if($Time::HiRes::VERSION) {
4471 keys(%timeprepini) = 1000;
4472 keys(%timesrvrini) = 1000;
4473 keys(%timesrvrend) = 1000;
4474 keys(%timetoolini) = 1000;
4475 keys(%timetoolend) = 1000;
4476 keys(%timesrvrlog) = 1000;
4477 keys(%timevrfyend) = 1000;
4482 elsif($ARGV[0] eq "-rf") {
4483 # run time statistics needs Time::HiRes
4484 if($Time::HiRes::VERSION) {
4485 keys(%timeprepini) = 1000;
4486 keys(%timesrvrini) = 1000;
4487 keys(%timesrvrend) = 1000;
4488 keys(%timetoolini) = 1000;
4489 keys(%timetoolend) = 1000;
4490 keys(%timesrvrlog) = 1000;
4491 keys(%timevrfyend) = 1000;
4496 elsif(($ARGV[0] eq "-h") || ($ARGV[0] eq "--help")) {
4499 Usage: runtests.pl [options] [test selection(s)]
4500 -a continue even if a test fails
4501 -bN use base port number N for test servers (default $base)
4502 -c path use this curl executable
4503 -d display server debug info
4504 -g run the test case with gdb
4505 -gw run the test case with gdb as a windowed application
4507 -k keep stdout and stderr files present after tests
4508 -l list all test case names/descriptions
4510 -p print log file contents when a test fails
4511 -r run time statistics
4512 -rf full run time statistics
4514 -am automake style output PASS/FAIL: [number] [name]
4515 -t[N] torture (simulate memory alloc failures); N means fail Nth alloc
4517 [num] like "5 6 9" or " 5 to 22 " to run those tests only
4518 [!num] like "!5 !6 !9" to disable those tests
4519 [keyword] like "IPv6" to select only tests containing the key word
4520 [!keyword] like "!cookies" to disable any tests containing the key word
4525 elsif($ARGV[0] =~ /^(\d+)/) {
4528 for($fromnum .. $number) {
4537 elsif($ARGV[0] =~ /^to$/i) {
4538 $fromnum = $number+1;
4540 elsif($ARGV[0] =~ /^!(\d+)/) {
4544 elsif($ARGV[0] =~ /^!(.+)/) {
4545 $disabled_keywords{$1}=$1;
4547 elsif($ARGV[0] =~ /^([-[{a-zA-Z].*)/) {
4548 $enabled_keywords{$1}=$1;
4551 print "Unknown option: $ARGV[0]\n";
4557 if(@testthis && ($testthis[0] ne "")) {
4558 $TESTCASES=join(" ", @testthis);
4562 # we have found valgrind on the host, use it
4564 # verify that we can invoke it fine
4565 my $code = runclient("valgrind >/dev/null 2>&1");
4567 if(($code>>8) != 1) {
4568 #logmsg "Valgrind failure, disable it\n";
4572 # since valgrind 2.1.x, '--tool' option is mandatory
4573 # use it, if it is supported by the version installed on the system
4574 runclient("valgrind --help 2>&1 | grep -- --tool > /dev/null 2>&1");
4576 $valgrind_tool="--tool=memcheck";
4581 # A shell script. This is typically when built with libtool,
4582 $valgrind="../libtool --mode=execute $valgrind";
4586 # valgrind 3 renamed the --logfile option to --log-file!!!
4587 my $ver=join(' ', runclientoutput("valgrind --version"));
4588 # cut off all but digits and dots
4589 $ver =~ s/[^0-9.]//g;
4591 if($ver =~ /^(\d+)/) {
4594 $valgrind_logfile="--log-file";
4601 # open the executable curl and read the first 4 bytes of it
4602 open(CHECK, "<$CURL");
4604 sysread CHECK, $c, 4;
4607 # A shell script. This is typically when built with libtool,
4609 $gdb = "libtool --mode=execute gdb";
4613 $HTTPPORT = $base++; # HTTP server port
4614 $HTTPSPORT = $base++; # HTTPS (stunnel) server port
4615 $FTPPORT = $base++; # FTP server port
4616 $FTPSPORT = $base++; # FTPS (stunnel) server port
4617 $HTTP6PORT = $base++; # HTTP IPv6 server port
4618 $FTP2PORT = $base++; # FTP server 2 port
4619 $FTP6PORT = $base++; # FTP IPv6 port
4620 $TFTPPORT = $base++; # TFTP (UDP) port
4621 $TFTP6PORT = $base++; # TFTP IPv6 (UDP) port
4622 $SSHPORT = $base++; # SSH (SCP/SFTP) port
4623 $SOCKSPORT = $base++; # SOCKS port
4624 $POP3PORT = $base++; # POP3 server port
4625 $POP36PORT = $base++; # POP3 IPv6 server port
4626 $IMAPPORT = $base++; # IMAP server port
4627 $IMAP6PORT = $base++; # IMAP IPv6 server port
4628 $SMTPPORT = $base++; # SMTP server port
4629 $SMTP6PORT = $base++; # SMTP IPv6 server port
4630 $RTSPPORT = $base++; # RTSP server port
4631 $RTSP6PORT = $base++; # RTSP IPv6 server port
4632 $GOPHERPORT = $base++; # Gopher IPv4 server port
4633 $GOPHER6PORT = $base++; # Gopher IPv6 server port
4634 $HTTPTLSPORT = $base++; # HTTP TLS (non-stunnel) server port
4635 $HTTPTLS6PORT = $base++; # HTTP TLS (non-stunnel) IPv6 server port
4636 $HTTPPROXYPORT = $base++; # HTTP proxy port, when using CONNECT
4637 $HTTPPIPEPORT = $base++; # HTTP pipelining port
4639 #######################################################################
4640 # clear and create logging directory:
4644 mkdir($LOGDIR, 0777);
4646 #######################################################################
4647 # initialize some variables
4651 init_serverpidfile_hash();
4653 #######################################################################
4654 # Output curl version and host info being tested
4661 #######################################################################
4662 # Fetch all disabled tests
4665 open(D, "<$TESTDIR/DISABLED");
4672 $disabled{$1}=$1; # disable this test number
4677 #######################################################################
4678 # If 'all' tests are requested, find out all test numbers
4681 if ( $TESTCASES eq "all") {
4682 # Get all commands and find out their test numbers
4683 opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
4684 my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
4687 $TESTCASES=""; # start with no test cases
4689 # cut off everything but the digits
4691 $_ =~ s/[a-z\/\.]*//g;
4693 # sort the numbers from low to high
4694 foreach my $n (sort { $a <=> $b } @cmds) {
4696 # skip disabled test cases
4697 my $why = "configured as DISABLED";
4700 $teststat[$n]=$why; # store reason for this test case
4703 $TESTCASES .= " $n";
4707 #######################################################################
4708 # Start the command line log
4710 open(CMDLOG, ">$CURLLOG") ||
4711 logmsg "can't log command lines to $CURLLOG\n";
4713 #######################################################################
4715 # Display the contents of the given file. Line endings are canonicalized
4716 # and excessively long files are elided
4717 sub displaylogcontent {
4719 if(open(SINGLE, "<$file")) {
4723 while(my $string = <SINGLE>) {
4724 $string =~ s/\r\n/\n/g;
4725 $string =~ s/[\r\f\032]/\n/g;
4726 $string .= "\n" unless ($string =~ /\n$/);
4728 for my $line (split("\n", $string)) {
4729 $line =~ s/\s*\!$//;
4731 push @tail, " $line\n";
4736 $truncate = $linecount > 1000;
4742 my $tailtotal = scalar @tail;
4743 if($tailtotal > $tailshow) {
4744 $tailskip = $tailtotal - $tailshow;
4745 logmsg "=== File too long: $tailskip lines omitted here\n";
4747 for($tailskip .. $tailtotal-1) {
4757 opendir(DIR, "$LOGDIR") ||
4758 die "can't open dir: $!";
4759 my @logs = readdir(DIR);
4762 logmsg "== Contents of files in the $LOGDIR/ dir after test $testnum\n";
4763 foreach my $log (sort @logs) {
4764 if($log =~ /\.(\.|)$/) {
4765 next; # skip "." and ".."
4767 if($log =~ /^\.nfs/) {
4770 if(($log eq "memdump") || ($log eq "core")) {
4771 next; # skip "memdump" and "core"
4773 if((-d "$LOGDIR/$log") || (! -s "$LOGDIR/$log")) {
4774 next; # skip directory and empty files
4776 if(($log =~ /^stdout\d+/) && ($log !~ /^stdout$testnum/)) {
4777 next; # skip stdoutNnn of other tests
4779 if(($log =~ /^stderr\d+/) && ($log !~ /^stderr$testnum/)) {
4780 next; # skip stderrNnn of other tests
4782 if(($log =~ /^upload\d+/) && ($log !~ /^upload$testnum/)) {
4783 next; # skip uploadNnn of other tests
4785 if(($log =~ /^curl\d+\.out/) && ($log !~ /^curl$testnum\.out/)) {
4786 next; # skip curlNnn.out of other tests
4788 if(($log =~ /^test\d+\.txt/) && ($log !~ /^test$testnum\.txt/)) {
4789 next; # skip testNnn.txt of other tests
4791 if(($log =~ /^file\d+\.txt/) && ($log !~ /^file$testnum\.txt/)) {
4792 next; # skip fileNnn.txt of other tests
4794 if(($log =~ /^netrc\d+/) && ($log !~ /^netrc$testnum/)) {
4795 next; # skip netrcNnn of other tests
4797 if(($log =~ /^trace\d+/) && ($log !~ /^trace$testnum/)) {
4798 next; # skip traceNnn of other tests
4800 if(($log =~ /^valgrind\d+/) && ($log !~ /^valgrind$testnum(\..*|)$/)) {
4801 next; # skip valgrindNnn of other tests
4803 logmsg "=== Start of file $log\n";
4804 displaylogcontent("$LOGDIR/$log");
4805 logmsg "=== End of file $log\n";
4809 #######################################################################
4810 # The main test-loop
4818 my @at = split(" ", $TESTCASES);
4823 foreach $testnum (@at) {
4825 $lasttest = $testnum if($testnum > $lasttest);
4828 my $error = singletest($testnum, $count, scalar(@at));
4830 # not a test we can run
4834 $total++; # number of tests we've run
4837 $failed.= "$testnum ";
4839 # display all files in log/ in a nice way
4840 displaylogs($testnum);
4843 # a test failed, abort
4844 logmsg "\n - abort tests\n";
4849 $ok++; # successful test counter
4852 # loop for next test
4855 my $sofar = time() - $start;
4857 #######################################################################
4862 # Tests done, stop the servers
4863 stopservers($verbose);
4865 my $all = $total + $skipped;
4867 runtimestats($lasttest);
4870 logmsg sprintf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
4874 logmsg "TESTFAIL: These test cases failed: $failed\n";
4878 logmsg "TESTFAIL: No tests were performed\n";
4882 logmsg "TESTDONE: $all tests were considered during ".
4883 sprintf("%.0f", $sofar) ." seconds.\n";
4886 if($skipped && !$short) {
4888 logmsg "TESTINFO: $skipped tests were skipped due to these restraints:\n";
4890 for(keys %skipped) {
4892 printf "TESTINFO: \"%s\" %d times (", $r, $skipped{$_};
4894 # now show all test case numbers that had this reason for being
4898 for(0 .. scalar @teststat) {
4900 if($teststat[$_] && ($teststat[$_] eq $r)) {
4909 logmsg " and ".($c-$max)." more";
4915 if($total && ($ok != $total)) {