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