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