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