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