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