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