xref: /curl/tests/servers.pm (revision ad50d810) 
1#***************************************************************************
2#                                  _   _ ____  _
3#  Project                     ___| | | |  _ \| |
4#                             / __| | | | |_) | |
5#                            | (__| |_| |  _ <| |___
6#                             \___|\___/|_| \_\_____|
7#
8# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
9#
10# This software is licensed as described in the file COPYING, which
11# you should have received as part of this distribution. The terms
12# are also available at https://curl.se/docs/copyright.html.
13#
14# You may opt to use, copy, modify, merge, publish, distribute and/or sell
15# copies of the Software, and permit persons to whom the Software is
16# furnished to do so, under the terms of the COPYING file.
17#
18# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
19# KIND, either express or implied.
20#
21# SPDX-License-Identifier: curl
22#
23###########################################################################
24
25# This module contains functions that are useful for managing the lifecycle of
26# test servers required when running tests. It is not intended for use within
27# those servers, but rather for starting and stopping them.
28
29package servers;
30
31use IO::Socket;
32use strict;
33use warnings;
34
35BEGIN {
36    use base qw(Exporter);
37
38    our @EXPORT = (
39        # variables
40        qw(
41            $SOCKSIN
42            $err_unexpected
43            $debugprotocol
44            $stunnel
45        ),
46
47        # functions
48        qw(
49            initserverconfig
50        )
51    );
52
53    our @EXPORT_OK = (
54        # functions
55        qw(
56            checkcmd
57            clearlocks
58            serverfortest
59            stopserver
60            stopservers
61            subvariables
62        ),
63
64        # for debugging only
65        qw(
66            protoport
67        )
68    );
69}
70
71use serverhelp qw(
72    serverfactors
73    servername_id
74    servername_str
75    servername_canon
76    server_pidfilename
77    server_portfilename
78    server_logfilename
79    );
80
81use sshhelp qw(
82    $hstpubmd5f
83    $hstpubsha256f
84    $sshexe
85    $sftpexe
86    $sftpconfig
87    $sshdlog
88    $sftplog
89    $sftpcmds
90    display_sshdconfig
91    display_sftpconfig
92    display_sshdlog
93    display_sftplog
94    find_sshd
95    find_ssh
96    find_sftp
97    find_httptlssrv
98    sshversioninfo
99    );
100
101use pathhelp qw(
102    exe_ext
103    os_is_win
104    sys_native_abs_path
105    );
106
107use processhelp;
108use globalconfig;
109use testutil qw(
110    logmsg
111    runclient
112    runclientoutput
113    );
114
115
116my %serverpidfile; # all server pid file names, identified by server id
117my %serverportfile;# all server port file names, identified by server id
118my $sshdvernum;  # for socks server, ssh daemon version number
119my $sshdverstr;  # for socks server, ssh daemon version string
120my $sshderror;   # for socks server, ssh daemon version error
121my %doesntrun;    # servers that don't work, identified by pidfile
122my %PORT = (nolisten => 47); # port we use for a local non-listening service
123my $server_response_maxtime=13;
124my $httptlssrv = find_httptlssrv();
125my %run;          # running server
126my %runcert;      # cert file currently in use by an ssl running server
127my $CLIENTIP="127.0.0.1";  # address which curl uses for incoming connections
128my $CLIENT6IP="[::1]";     # address which curl uses for incoming connections
129my $posix_pwd=$pwd;        # current working directory
130my $h2cver = "h2c"; # this version is decided by the nghttp2 lib being used
131my $portrange = 999;       # space from which to choose a random port
132                           # don't increase without making sure generated port
133                           # numbers will always be valid (<=65535)
134my $HOSTIP="127.0.0.1";    # address on which the test server listens
135my $HOST6IP="[::1]";       # address on which the test server listens
136my $HTTPUNIXPATH;          # HTTP server Unix domain socket path
137my $SOCKSUNIXPATH;         # socks server Unix domain socket path
138my $SSHSRVMD5 = "[uninitialized]";    # MD5 of ssh server public key
139my $SSHSRVSHA256 = "[uninitialized]"; # SHA256 of ssh server public key
140my $USER;                  # name of the current user
141my $sshdid;                # for socks server, ssh daemon version id
142my $ftpchecktime=1;        # time it took to verify our test FTP server
143
144# Variables shared with runtests.pl
145our $SOCKSIN="socksd-request.log"; # what curl sent to the SOCKS proxy
146our $err_unexpected; # error instead of warning on server unexpectedly alive
147our $debugprotocol;  # nonzero for verbose server logs
148our $stunnel;        # path to stunnel command
149
150
151#######################################################################
152# Check for a command in the PATH of the test server.
153#
154sub checkcmd {
155    my ($cmd, @extrapaths)=@_;
156    my $sep = '[:]';
157    if ($^O eq 'MSWin32' || $^O eq 'dos' || $^O eq 'os2') {
158        # PATH separator is different
159        $sep = '[;]';
160    }
161    my @paths=(split(m/$sep/, $ENV{'PATH'}), "/usr/sbin", "/usr/local/sbin",
162               "/sbin", "/usr/bin", "/usr/local/bin", @extrapaths);
163    for(@paths) {
164        if( -x "$_/$cmd" . exe_ext('SYS') && ! -d "$_/$cmd" . exe_ext('SYS')) {
165            # executable bit but not a directory!
166            return "$_/$cmd";
167        }
168    }
169    return "";
170}
171
172#######################################################################
173# Create a server socket on a random (unused) port, then close it and
174# return the port number
175#
176sub getfreeport {
177    my ($ipnum) = @_;
178    my $server = IO::Socket->new(LocalPort => 0,
179                                 Domain => $ipnum == 6 ? AF_INET6 : AF_INET,
180                                 Type      => SOCK_STREAM,
181                                 Reuse     => 1,
182                                 Listen    => 10 )
183        or die "Couldn't create tcp server socket: $@\n";
184
185    return $server->sockport();
186}
187
188use File::Temp qw/ tempfile/;
189
190#######################################################################
191# Initialize configuration variables
192sub initserverconfig {
193    my ($fh, $socks) = tempfile("curl-socksd-XXXXXXXX", TMPDIR => 1);
194    close($fh);
195    unlink($socks);
196    my ($f2, $http) = tempfile("curl-http-XXXXXXXX", TMPDIR => 1);
197    close($f2);
198    unlink($http);
199    $SOCKSUNIXPATH = $socks; # SOCKS Unix domain socket
200    $HTTPUNIXPATH = $http;   # HTTP Unix domain socket
201    $stunnel = checkcmd("stunnel4") || checkcmd("tstunnel") || checkcmd("stunnel");
202
203    # get the name of the current user
204    $USER = $ENV{USER};          # Linux
205    if (!$USER) {
206        $USER = $ENV{USERNAME};     # Windows
207        if (!$USER) {
208            $USER = $ENV{LOGNAME};  # Some Unix (I think)
209        }
210    }
211    init_serverpidfile_hash();
212}
213
214#######################################################################
215# Load serverpidfile and serverportfile hashes with file names for all
216# possible servers.
217#
218sub init_serverpidfile_hash {
219  for my $proto (('ftp', 'gopher', 'http', 'imap', 'pop3', 'smtp', 'http/2', 'http/3')) {
220    for my $ssl (('', 's')) {
221      for my $ipvnum ((4, 6)) {
222        for my $idnum ((1, 2, 3)) {
223          my $serv = servername_id("$proto$ssl", $ipvnum, $idnum);
224          my $pidf = server_pidfilename("$LOGDIR/$PIDDIR", "$proto$ssl",
225                                        $ipvnum, $idnum);
226          $serverpidfile{$serv} = $pidf;
227          my $portf = server_portfilename("$LOGDIR/$PIDDIR", "$proto$ssl",
228                                          $ipvnum, $idnum);
229          $serverportfile{$serv} = $portf;
230        }
231      }
232    }
233  }
234  for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'httptls',
235                  'dict', 'smb', 'smbs', 'telnet', 'mqtt')) {
236    for my $ipvnum ((4, 6)) {
237      for my $idnum ((1, 2)) {
238        my $serv = servername_id($proto, $ipvnum, $idnum);
239        my $pidf = server_pidfilename("$LOGDIR/$PIDDIR", $proto, $ipvnum,
240                                      $idnum);
241        $serverpidfile{$serv} = $pidf;
242        my $portf = server_portfilename("$LOGDIR/$PIDDIR", $proto, $ipvnum,
243                                        $idnum);
244        $serverportfile{$serv} = $portf;
245      }
246    }
247  }
248  for my $proto (('http', 'imap', 'pop3', 'smtp', 'http/2', 'http/3')) {
249    for my $ssl (('', 's')) {
250      my $serv = servername_id("$proto$ssl", "unix", 1);
251      my $pidf = server_pidfilename("$LOGDIR/$PIDDIR", "$proto$ssl",
252                                    "unix", 1);
253      $serverpidfile{$serv} = $pidf;
254      my $portf = server_portfilename("$LOGDIR/$PIDDIR", "$proto$ssl",
255                                      "unix", 1);
256      $serverportfile{$serv} = $portf;
257    }
258  }
259}
260
261
262#######################################################################
263# Kill the processes that still have lock files in a directory
264#
265sub clearlocks {
266    my $dir = $_[0];
267    my $done = 0;
268
269    if(os_is_win()) {
270        $dir = sys_native_abs_path($dir);
271        $dir =~ s/\//\\\\/g;
272        my $handle = "handle";
273        if($ENV{"PROCESSOR_ARCHITECTURE"} =~ /64$/) {
274            $handle = "handle64";
275        }
276        if(checkcmd($handle)) {
277            my @handles = `$handle $dir -accepteula -nobanner`;
278            for my $tryhandle (@handles) {
279                # Skip the "No matching handles found." warning when returned
280                if($tryhandle =~ /^(\S+)\s+pid:\s+(\d+)\s+type:\s+(\w+)\s+([0-9A-F]+):\s+(.+)\r\r/) {
281                    logmsg "Found $3 lock of '$5' ($4) by $1 ($2)\n";
282                    # Ignore stunnel since we cannot do anything about its locks
283                    if("$3" eq "File" && "$1" ne "tstunnel.exe") {
284                        logmsg "Killing IMAGENAME eq $1 and PID eq $2\n";
285                        system("taskkill.exe -f -fi \"IMAGENAME eq $1\" -fi \"PID eq $2\" >nul 2>&1");
286                        $done = 1;
287                    }
288                }
289            }
290        }
291    }
292    return $done;
293}
294
295#######################################################################
296# Check if a given child process has just died. Reaps it if so.
297#
298sub checkdied {
299    my $pid = $_[0];
300    if((not defined $pid) || $pid <= 0) {
301        return 0;
302    }
303    use POSIX ":sys_wait_h";
304    my $rc = pidwait($pid, &WNOHANG);
305    return ($rc == $pid)?1:0;
306}
307
308
309##############################################################################
310# This function makes sure the right set of server is running for the
311# specified test case. This is a useful design when we run single tests as not
312# all servers need to run then!
313#
314# Returns: a string, blank if everything is fine or a reason why it failed, and
315#          an integer:
316#          0 for success
317#          1 for an error starting the server
318#          2 for not the first time getting an error starting the server
319#          3 for a failure to stop a server in order to restart it
320#          4 for an unsupported server type
321#
322sub serverfortest {
323    my (@what)=@_;
324
325    for(my $i = scalar(@what) - 1; $i >= 0; $i--) {
326        my $srvrline = $what[$i];
327        chomp $srvrline if($srvrline);
328        if($srvrline =~ /^(\S+)((\s*)(.*))/) {
329            my $server = "${1}";
330            my $lnrest = "${2}";
331            my $tlsext;
332            if($server =~ /^(httptls)(\+)(ext|srp)(\d*)(-ipv6|)$/) {
333                $server = "${1}${4}${5}";
334                $tlsext = uc("TLS-${3}");
335            }
336            if(! grep /^\Q$server\E$/, @protocols) {
337                if(substr($server,0,5) ne "socks") {
338                    if($tlsext) {
339                        return ("curl lacks $tlsext support", 4);
340                    }
341                    else {
342                        return ("curl lacks $server server support", 4);
343                    }
344                }
345            }
346            $what[$i] = "$server$lnrest" if($tlsext);
347        }
348    }
349
350    return &startservers(@what);
351}
352
353
354#######################################################################
355# Start a new thread/process and run the given command line in there.
356# Return the pids (yes plural) of the new child process to the parent.
357#
358sub startnew {
359    my ($cmd, $pidfile, $timeout, $fakepidfile)=@_;
360
361    logmsg "startnew: $cmd\n" if ($verbose);
362
363    my $child = fork();
364
365    if(not defined $child) {
366        logmsg "startnew: fork() failure detected\n";
367        return (-1,-1);
368    }
369
370    if(0 == $child) {
371        # Here we are the child. Run the given command.
372
373        # Flush output.
374        $| = 1;
375
376        # Put an "exec" in front of the command so that the child process
377        # keeps this child's process ID.
378        exec("exec $cmd") || die "Can't exec() $cmd: $!";
379
380        # exec() should never return back here to this process. We protect
381        # ourselves by calling die() just in case something goes really bad.
382        die "error: exec() has returned";
383    }
384
385    # Ugly hack but ssh client and gnutls-serv don't support pid files
386    if ($fakepidfile) {
387        if(open(my $out, ">", "$pidfile")) {
388            print $out $child . "\n";
389            close($out) || die "Failure writing pidfile";
390            logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose);
391        }
392        else {
393            logmsg "startnew: failed to write fake $pidfile with pid=$child\n";
394        }
395        # could/should do a while connect fails sleep a bit and loop
396        portable_sleep($timeout);
397        if (checkdied($child)) {
398            logmsg "startnew: child process has failed to start\n" if($verbose);
399            return (-1,-1);
400        }
401    }
402
403    my $pid2 = 0;
404    my $count = $timeout;
405    while($count--) {
406        $pid2 = pidfromfile($pidfile);
407        if(($pid2 > 0) && pidexists($pid2)) {
408            # if $pid2 is valid, then make sure this pid is alive, as
409            # otherwise it is just likely to be the _previous_ pidfile or
410            # similar!
411            last;
412        }
413        if (checkdied($child)) {
414            logmsg "startnew: child process has died, server might start up\n"
415                if($verbose);
416            # We can't just abort waiting for the server with a
417            # return (-1,-1);
418            # because the server might have forked and could still start
419            # up normally. Instead, just reduce the amount of time we remain
420            # waiting.
421            $count >>= 2;
422        }
423        sleep(1);
424    }
425
426    # Return two PIDs, the one for the child process we spawned and the one
427    # reported by the server itself (in case it forked again on its own).
428    # Both (potentially) need to be killed at the end of the test.
429    return ($child, $pid2);
430}
431
432
433#######################################################################
434# Return the port to use for the given protocol.
435#
436sub protoport {
437    my ($proto) = @_;
438    return $PORT{$proto} || "[not running]";
439}
440
441
442#######################################################################
443# Stop a test server along with pids which aren't in the %run hash yet.
444# This also stops all servers which are relative to the given one.
445#
446sub stopserver {
447    my ($server, $pidlist) = @_;
448
449    #
450    # kill sockfilter processes for pingpong relative server
451    #
452    if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
453        my $proto  = $1;
454        my $idnum  = ($2 && ($2 > 1)) ? $2 : 1;
455        my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
456        killsockfilters("$LOGDIR/$PIDDIR", $proto, $ipvnum, $idnum, $verbose);
457    }
458    #
459    # All servers relative to the given one must be stopped also
460    #
461    my @killservers;
462    if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
463        # given a stunnel based ssl server, also kill non-ssl underlying one
464        push @killservers, "${1}${2}";
465    }
466    elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|-unix|))$/) {
467        # given a non-ssl server, also kill stunnel based ssl piggybacking one
468        push @killservers, "${1}s${2}";
469    }
470    elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
471        # given a socks server, also kill ssh underlying one
472        push @killservers, "ssh${2}";
473    }
474    elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
475        # given a ssh server, also kill socks piggybacking one
476        push @killservers, "socks${2}";
477    }
478    if($server eq "http" or $server eq "https") {
479        # since the http2+3 server is a proxy that needs to know about the
480        # dynamic http port it too needs to get restarted when the http server
481        # is killed
482        push @killservers, "http/2";
483        push @killservers, "http/3";
484    }
485    push @killservers, $server;
486    #
487    # kill given pids and server relative ones clearing them in %run hash
488    #
489    foreach my $server (@killservers) {
490        if($run{$server}) {
491            # we must prepend a space since $pidlist may already contain a pid
492            $pidlist .= " $run{$server}";
493            $run{$server} = 0;
494        }
495        $runcert{$server} = 0 if($runcert{$server});
496    }
497    killpid($verbose, $pidlist);
498    #
499    # cleanup server pid files
500    #
501    my $result = 0;
502    foreach my $server (@killservers) {
503        my $pidfile = $serverpidfile{$server};
504        my $pid = processexists($pidfile);
505        if($pid > 0) {
506            if($err_unexpected) {
507                logmsg "ERROR: ";
508                $result = -1;
509            }
510            else {
511                logmsg "Warning: ";
512            }
513            logmsg "$server server unexpectedly alive\n";
514            killpid($verbose, $pid);
515        }
516        unlink($pidfile) if(-f $pidfile);
517    }
518
519    return $result;
520}
521
522
523#######################################################################
524# Return flags to let curl use an external HTTP proxy
525#
526sub getexternalproxyflags {
527    return " --proxy $proxy_address ";
528}
529
530#######################################################################
531# Verify that the server that runs on $ip, $port is our server.  This also
532# implies that we can speak with it, as there might be occasions when the
533# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
534# assign requested address")
535#
536sub verifyhttp {
537    my ($proto, $ipvnum, $idnum, $ip, $port_or_path) = @_;
538    my $server = servername_id($proto, $ipvnum, $idnum);
539    my $bonus="";
540    # $port_or_path contains a path for Unix sockets, sws ignores the port
541    my $port = ($ipvnum eq "unix") ? 80 : $port_or_path;
542
543    my $verifyout = "$LOGDIR/".
544        servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
545    unlink($verifyout) if(-f $verifyout);
546
547    my $verifylog = "$LOGDIR/".
548        servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
549    unlink($verifylog) if(-f $verifylog);
550
551    if($proto eq "gopher") {
552        # gopher is funny
553        $bonus="1/";
554    }
555
556    my $flags = "--max-time $server_response_maxtime ";
557    $flags .= "--output $verifyout ";
558    $flags .= "--silent ";
559    $flags .= "--verbose ";
560    $flags .= "--globoff ";
561    $flags .= "--unix-socket '$port_or_path' " if $ipvnum eq "unix";
562    $flags .= "--insecure " if($proto eq 'https');
563    if($proxy_address) {
564        $flags .= getexternalproxyflags();
565    }
566    $flags .= "\"$proto://$ip:$port/${bonus}verifiedserver\"";
567
568    my $cmd = "$VCURL $flags 2>$verifylog";
569
570    # verify if our/any server is running on this port
571    logmsg "RUN: $cmd\n" if($verbose);
572    my $res = runclient($cmd);
573
574    $res >>= 8; # rotate the result
575    if($res & 128) {
576        logmsg "RUN: curl command died with a coredump\n";
577        return -1;
578    }
579
580    if($res && $verbose) {
581        logmsg "RUN: curl command returned $res\n";
582        if(open(my $file, "<", "$verifylog")) {
583            while(my $string = <$file>) {
584                logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
585            }
586            close($file);
587        }
588    }
589
590    my $data;
591    if(open(my $file, "<", "$verifyout")) {
592        while(my $string = <$file>) {
593            $data = $string;
594            last; # only want first line
595        }
596        close($file);
597    }
598
599    my $pid = 0;
600    if($data && ($data =~ /WE ROOLZ: (\d+)/)) {
601        $pid = 0+$1;
602    }
603    elsif($res == 6) {
604        # curl: (6) Couldn't resolve host '::1'
605        logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
606        return -1;
607    }
608    elsif($data || ($res && ($res != 7))) {
609        logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
610        return -1;
611    }
612    return $pid;
613}
614
615#######################################################################
616# Verify that the server that runs on $ip, $port is our server.  This also
617# implies that we can speak with it, as there might be occasions when the
618# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
619# assign requested address")
620#
621sub verifyftp {
622    my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
623    my $server = servername_id($proto, $ipvnum, $idnum);
624    my $time=time();
625    my $extra="";
626
627    my $verifylog = "$LOGDIR/".
628        servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
629    unlink($verifylog) if(-f $verifylog);
630
631    if($proto eq "ftps") {
632        $extra .= "--insecure --ftp-ssl-control ";
633    }
634
635    my $flags = "--max-time $server_response_maxtime ";
636    $flags .= "--silent ";
637    $flags .= "--verbose ";
638    $flags .= "--globoff ";
639    $flags .= $extra;
640    if($proxy_address) {
641        $flags .= getexternalproxyflags();
642    }
643    $flags .= "\"$proto://$ip:$port/verifiedserver\"";
644
645    my $cmd = "$VCURL $flags 2>$verifylog";
646
647    # check if this is our server running on this port:
648    logmsg "RUN: $cmd\n" if($verbose);
649    my @data = runclientoutput($cmd);
650
651    my $res = $? >> 8; # rotate the result
652    if($res & 128) {
653        logmsg "RUN: curl command died with a coredump\n";
654        return -1;
655    }
656
657    my $pid = 0;
658    foreach my $line (@data) {
659        if($line =~ /WE ROOLZ: (\d+)/) {
660            # this is our test server with a known pid!
661            $pid = 0+$1;
662            last;
663        }
664    }
665    if($pid <= 0 && @data && $data[0]) {
666        # this is not a known server
667        logmsg "RUN: Unknown server on our $server port: $port\n";
668        return 0;
669    }
670    # we can/should use the time it took to verify the FTP server as a measure
671    # on how fast/slow this host/FTP is.
672    my $took = int(0.5+time()-$time);
673
674    if($verbose) {
675        logmsg "RUN: Verifying our test $server server took $took seconds\n";
676    }
677    $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
678
679    return $pid;
680}
681
682#######################################################################
683# Verify that the server that runs on $ip, $port is our server.  This also
684# implies that we can speak with it, as there might be occasions when the
685# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
686# assign requested address")
687#
688sub verifyrtsp {
689    my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
690    my $server = servername_id($proto, $ipvnum, $idnum);
691
692    my $verifyout = "$LOGDIR/".
693        servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
694    unlink($verifyout) if(-f $verifyout);
695
696    my $verifylog = "$LOGDIR/".
697        servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
698    unlink($verifylog) if(-f $verifylog);
699
700    my $flags = "--max-time $server_response_maxtime ";
701    $flags .= "--output $verifyout ";
702    $flags .= "--silent ";
703    $flags .= "--verbose ";
704    $flags .= "--globoff ";
705    if($proxy_address) {
706        $flags .= getexternalproxyflags();
707    }
708    # currently verification is done using http
709    $flags .= "\"http://$ip:$port/verifiedserver\"";
710
711    my $cmd = "$VCURL $flags 2>$verifylog";
712
713    # verify if our/any server is running on this port
714    logmsg "RUN: $cmd\n" if($verbose);
715    my $res = runclient($cmd);
716
717    $res >>= 8; # rotate the result
718    if($res & 128) {
719        logmsg "RUN: curl command died with a coredump\n";
720        return -1;
721    }
722
723    if($res && $verbose) {
724        logmsg "RUN: curl command returned $res\n";
725        if(open(my $file, "<", "$verifylog")) {
726            while(my $string = <$file>) {
727                logmsg "RUN: $string" if($string !~ /^[ \t]*$/);
728            }
729            close($file);
730        }
731    }
732
733    my $data;
734    if(open(my $file, "<", "$verifyout")) {
735        while(my $string = <$file>) {
736            $data = $string;
737            last; # only want first line
738        }
739        close($file);
740    }
741
742    my $pid = 0;
743    if($data && ($data =~ /RTSP_SERVER WE ROOLZ: (\d+)/)) {
744        $pid = 0+$1;
745    }
746    elsif($res == 6) {
747        # curl: (6) Couldn't resolve host '::1'
748        logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
749        return -1;
750    }
751    elsif($data || ($res != 7)) {
752        logmsg "RUN: Unknown server on our $server port: $port\n";
753        return -1;
754    }
755    return $pid;
756}
757
758#######################################################################
759# Verify that the ssh server has written out its pidfile, recovering
760# the pid from the file and returning it if a process with that pid is
761# actually alive, or a negative value if the process is dead.
762#
763sub verifyssh {
764    my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
765    my $pidfile = server_pidfilename("$LOGDIR/$PIDDIR", $proto, $ipvnum,
766                                     $idnum);
767    my $pid = processexists($pidfile);
768    if($pid < 0) {
769        logmsg "RUN: SSH server has died after starting up\n";
770    }
771    return $pid;
772}
773
774#######################################################################
775# Verify that we can connect to the sftp server, properly authenticate
776# with generated config and key files and run a simple remote pwd.
777#
778sub verifysftp {
779    my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
780    my $server = servername_id($proto, $ipvnum, $idnum);
781    my $verified = 0;
782    # Find out sftp client canonical file name
783    my $sftp = find_sftp();
784    if(!$sftp) {
785        logmsg "RUN: SFTP server cannot find $sftpexe\n";
786        return -1;
787    }
788    # Find out ssh client canonical file name
789    my $ssh = find_ssh();
790    if(!$ssh) {
791        logmsg "RUN: SFTP server cannot find $sshexe\n";
792        return -1;
793    }
794    # Connect to sftp server, authenticate and run a remote pwd
795    # command using our generated configuration and key files
796    my $cmd = "\"$sftp\" -b $LOGDIR/$PIDDIR/$sftpcmds -F $LOGDIR/$PIDDIR/$sftpconfig -S \"$ssh\" $ip > $sftplog 2>&1";
797    my $res = runclient($cmd);
798    # Search for pwd command response in log file
799    if(open(my $sftplogfile, "<", "$sftplog")) {
800        while(<$sftplogfile>) {
801            if(/^Remote working directory: /) {
802                $verified = 1;
803                last;
804            }
805        }
806        close($sftplogfile);
807    }
808    return $verified;
809}
810
811#######################################################################
812# Verify that the non-stunnel HTTP TLS extensions capable server that runs
813# on $ip, $port is our server.  This also implies that we can speak with it,
814# as there might be occasions when the server runs fine but we cannot talk
815# to it ("Failed to connect to ::1: Can't assign requested address")
816#
817sub verifyhttptls {
818    my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
819    my $server = servername_id($proto, $ipvnum, $idnum);
820    my $pidfile = server_pidfilename("$LOGDIR/$PIDDIR", $proto, $ipvnum,
821                                     $idnum);
822
823    my $verifyout = "$LOGDIR/".
824        servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
825    unlink($verifyout) if(-f $verifyout);
826
827    my $verifylog = "$LOGDIR/".
828        servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
829    unlink($verifylog) if(-f $verifylog);
830
831    my $flags = "--max-time $server_response_maxtime ";
832    $flags .= "--output $verifyout ";
833    $flags .= "--verbose ";
834    $flags .= "--globoff ";
835    $flags .= "--insecure ";
836    $flags .= "--tlsauthtype SRP ";
837    $flags .= "--tlsuser jsmith ";
838    $flags .= "--tlspassword abc ";
839    if($proxy_address) {
840        $flags .= getexternalproxyflags();
841    }
842    $flags .= "\"https://$ip:$port/verifiedserver\"";
843
844    my $cmd = "$VCURL $flags 2>$verifylog";
845
846    # verify if our/any server is running on this port
847    logmsg "RUN: $cmd\n" if($verbose);
848    my $res = runclient($cmd);
849
850    $res >>= 8; # rotate the result
851    if($res & 128) {
852        logmsg "RUN: curl command died with a coredump\n";
853        return -1;
854    }
855
856    if($res && $verbose) {
857        logmsg "RUN: curl command returned $res\n";
858        if(open(my $file, "<", "$verifylog")) {
859            while(my $string = <$file>) {
860                logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
861            }
862            close($file);
863        }
864    }
865
866    my $data;
867    if(open(my $file, "<", "$verifyout")) {
868        while(my $string = <$file>) {
869            $data .= $string;
870        }
871        close($file);
872    }
873
874    my $pid = 0;
875    if($data && ($data =~ /(GNUTLS|GnuTLS)/) && ($pid = processexists($pidfile))) {
876        if($pid < 0) {
877            logmsg "RUN: $server server has died after starting up\n";
878        }
879        return $pid;
880    }
881    elsif($res == 6) {
882        # curl: (6) Couldn't resolve host '::1'
883        logmsg "RUN: failed to resolve host (https://$ip:$port/verifiedserver)\n";
884        return -1;
885    }
886    elsif($data || ($res && ($res != 7))) {
887        logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
888        return -1;
889    }
890    return $pid;
891}
892
893#######################################################################
894# STUB for verifying socks
895#
896sub verifysocks {
897    my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
898    my $pidfile = server_pidfilename("$LOGDIR/$PIDDIR", $proto, $ipvnum,
899                                     $idnum);
900    my $pid = processexists($pidfile);
901    if($pid < 0) {
902        logmsg "RUN: SOCKS server has died after starting up\n";
903    }
904    return $pid;
905}
906
907#######################################################################
908# Verify that the server that runs on $ip, $port is our server.  This also
909# implies that we can speak with it, as there might be occasions when the
910# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
911# assign requested address")
912#
913sub verifysmb {
914    my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
915    my $server = servername_id($proto, $ipvnum, $idnum);
916    my $time=time();
917    my $extra="";
918
919    my $verifylog = "$LOGDIR/".
920        servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
921    unlink($verifylog) if(-f $verifylog);
922
923    my $flags = "--max-time $server_response_maxtime ";
924    $flags .= "--silent ";
925    $flags .= "--verbose ";
926    $flags .= "--globoff ";
927    $flags .= "-u 'curltest:curltest' ";
928    $flags .= $extra;
929    $flags .= "\"$proto://$ip:$port/SERVER/verifiedserver\"";
930
931    my $cmd = "$VCURL $flags 2>$verifylog";
932
933    # check if this is our server running on this port:
934    logmsg "RUN: $cmd\n" if($verbose);
935    my @data = runclientoutput($cmd);
936
937    my $res = $? >> 8; # rotate the result
938    if($res & 128) {
939        logmsg "RUN: curl command died with a coredump\n";
940        return -1;
941    }
942
943    my $pid = 0;
944    foreach my $line (@data) {
945        if($line =~ /WE ROOLZ: (\d+)/) {
946            # this is our test server with a known pid!
947            $pid = 0+$1;
948            last;
949        }
950    }
951    if($pid <= 0 && @data && $data[0]) {
952        # this is not a known server
953        logmsg "RUN: Unknown server on our $server port: $port\n";
954        return 0;
955    }
956    # we can/should use the time it took to verify the server as a measure
957    # on how fast/slow this host is.
958    my $took = int(0.5+time()-$time);
959
960    if($verbose) {
961        logmsg "RUN: Verifying our test $server server took $took seconds\n";
962    }
963
964    return $pid;
965}
966
967#######################################################################
968# Verify that the server that runs on $ip, $port is our server.  This also
969# implies that we can speak with it, as there might be occasions when the
970# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
971# assign requested address")
972#
973sub verifytelnet {
974    my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
975    my $server = servername_id($proto, $ipvnum, $idnum);
976    my $time=time();
977    my $extra="";
978
979    my $verifylog = "$LOGDIR/".
980        servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
981    unlink($verifylog) if(-f $verifylog);
982
983    my $flags = "--max-time $server_response_maxtime ";
984    $flags .= "--silent ";
985    $flags .= "--verbose ";
986    $flags .= "--globoff ";
987    $flags .= "--upload-file - ";
988    $flags .= $extra;
989    $flags .= "\"$proto://$ip:$port\"";
990
991    my $cmd = "echo 'verifiedserver' | $VCURL $flags 2>$verifylog";
992
993    # check if this is our server running on this port:
994    logmsg "RUN: $cmd\n" if($verbose);
995    my @data = runclientoutput($cmd);
996
997    my $res = $? >> 8; # rotate the result
998    if($res & 128) {
999        logmsg "RUN: curl command died with a coredump\n";
1000        return -1;
1001    }
1002
1003    my $pid = 0;
1004    foreach my $line (@data) {
1005        if($line =~ /WE ROOLZ: (\d+)/) {
1006            # this is our test server with a known pid!
1007            $pid = 0+$1;
1008            last;
1009        }
1010    }
1011    if($pid <= 0 && @data && $data[0]) {
1012        # this is not a known server
1013        logmsg "RUN: Unknown server on our $server port: $port\n";
1014        return 0;
1015    }
1016    # we can/should use the time it took to verify the server as a measure
1017    # on how fast/slow this host is.
1018    my $took = int(0.5+time()-$time);
1019
1020    if($verbose) {
1021        logmsg "RUN: Verifying our test $server server took $took seconds\n";
1022    }
1023
1024    return $pid;
1025}
1026
1027#######################################################################
1028# Verify that the server that runs on $ip, $port is our server.
1029# Retry over several seconds before giving up.  The ssh server in
1030# particular can take a long time to start if it needs to generate
1031# keys on a slow or loaded host.
1032#
1033# Just for convenience, test harness uses 'https' and 'httptls' literals
1034# as values for 'proto' variable in order to differentiate different
1035# servers. 'https' literal is used for stunnel based https test servers,
1036# and 'httptls' is used for non-stunnel https test servers.
1037#
1038
1039my %protofunc = ('http' => \&verifyhttp,
1040                 'https' => \&verifyhttp,
1041                 'rtsp' => \&verifyrtsp,
1042                 'ftp' => \&verifyftp,
1043                 'pop3' => \&verifyftp,
1044                 'imap' => \&verifyftp,
1045                 'smtp' => \&verifyftp,
1046                 'ftps' => \&verifyftp,
1047                 'pop3s' => \&verifyftp,
1048                 'imaps' => \&verifyftp,
1049                 'smtps' => \&verifyftp,
1050                 'tftp' => \&verifyftp,
1051                 'ssh' => \&verifyssh,
1052                 'socks' => \&verifysocks,
1053                 'socks5unix' => \&verifysocks,
1054                 'gopher' => \&verifyhttp,
1055                 'httptls' => \&verifyhttptls,
1056                 'dict' => \&verifyftp,
1057                 'smb' => \&verifysmb,
1058                 'telnet' => \&verifytelnet);
1059
1060sub verifyserver {
1061    my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1062
1063    my $count = 30; # try for this many seconds
1064    my $pid;
1065
1066    while($count--) {
1067        my $fun = $protofunc{$proto};
1068
1069        $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
1070
1071        if($pid > 0) {
1072            last;
1073        }
1074        elsif($pid < 0) {
1075            # a real failure, stop trying and bail out
1076            return 0;
1077        }
1078        sleep(1);
1079    }
1080    return $pid;
1081}
1082
1083#######################################################################
1084# Single shot server responsiveness test. This should only be used
1085# to verify that a server present in %run hash is still functional
1086#
1087sub responsiveserver {
1088    my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
1089    my $prev_verbose = $verbose;
1090
1091    $verbose = 0;
1092    my $fun = $protofunc{$proto};
1093    my $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
1094    $verbose = $prev_verbose;
1095
1096    if($pid > 0) {
1097        return 1; # responsive
1098    }
1099
1100    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1101    logmsg " server precheck FAILED (unresponsive $srvrname server)\n";
1102    return 0;
1103}
1104
1105
1106#######################################################################
1107# start the http server
1108#
1109sub runhttpserver {
1110    my ($proto, $verb, $alt, $port_or_path) = @_;
1111    my $ip = $HOSTIP;
1112    my $ipvnum = 4;
1113    my $idnum = 1;
1114    my $exe = "$perl $srcdir/http-server.pl";
1115    my $verbose_flag = "--verbose ";
1116    my $keepalive_secs = 30; # forwarded to sws, was 5 by default which
1117                             # led to pukes in CI jobs
1118
1119    if($alt eq "ipv6") {
1120        # if IPv6, use a different setup
1121        $ipvnum = 6;
1122        $ip = $HOST6IP;
1123    }
1124    elsif($alt eq "proxy") {
1125        # basically the same, but another ID
1126        $idnum = 2;
1127    }
1128    elsif($alt eq "unix") {
1129        # IP (protocol) is mutually exclusive with Unix sockets
1130        $ipvnum = "unix";
1131    }
1132
1133    my $server = servername_id($proto, $ipvnum, $idnum);
1134
1135    my $pidfile = $serverpidfile{$server};
1136
1137    # don't retry if the server doesn't work
1138    if ($doesntrun{$pidfile}) {
1139        return (2, 0, 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    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1149    my $portfile = $serverportfile{$server};
1150
1151    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1152
1153    my $flags = "";
1154    $flags .= "--gopher " if($proto eq "gopher");
1155    $flags .= "--connect $HOSTIP " if($alt eq "proxy");
1156    $flags .= "--keepalive $keepalive_secs ";
1157    $flags .= $verbose_flag if($debugprotocol);
1158    $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1159    $flags .= "--logdir \"$LOGDIR\" ";
1160    $flags .= "--portfile $portfile ";
1161    $flags .= "--config $LOGDIR/$SERVERCMD ";
1162    $flags .= "--id $idnum " if($idnum > 1);
1163    if($ipvnum eq "unix") {
1164        $flags .= "--unix-socket '$port_or_path' ";
1165    } else {
1166        $flags .= "--ipv$ipvnum --port 0 ";
1167    }
1168    $flags .= "--srcdir \"$srcdir\"";
1169
1170    my $cmd = "$exe $flags";
1171    my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1172
1173    if($httppid <= 0 || !pidexists($httppid)) {
1174        # it is NOT alive
1175        logmsg "RUN: failed to start the $srvrname server\n";
1176        stopserver($server, "$pid2");
1177        $doesntrun{$pidfile} = 1;
1178        return (1, 0, 0, 0);
1179    }
1180
1181    # where is it?
1182    my $port = 0;
1183    if(!$port_or_path) {
1184        $port = $port_or_path = pidfromfile($portfile);
1185    }
1186
1187    # Server is up. Verify that we can speak to it.
1188    my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
1189    if(!$pid3) {
1190        logmsg "RUN: $srvrname server failed verification\n";
1191        # failed to talk to it properly. Kill the server and return failure
1192        stopserver($server, "$httppid $pid2");
1193        $doesntrun{$pidfile} = 1;
1194        return (1, 0, 0, 0);
1195    }
1196    $pid2 = $pid3;
1197
1198    if($verb) {
1199        logmsg "RUN: $srvrname server is on PID $httppid port $port_or_path\n";
1200    }
1201
1202    return (0, $httppid, $pid2, $port);
1203}
1204
1205
1206#######################################################################
1207# start the http2 server
1208#
1209sub runhttp2server {
1210    my ($verb) = @_;
1211    my $proto="http/2";
1212    my $ipvnum = 4;
1213    my $idnum = 0;
1214    my $exe = "$perl $srcdir/http2-server.pl";
1215    my $verbose_flag = "--verbose ";
1216
1217    my $server = servername_id($proto, $ipvnum, $idnum);
1218
1219    my $pidfile = $serverpidfile{$server};
1220
1221    # don't retry if the server doesn't work
1222    if ($doesntrun{$pidfile}) {
1223        return (2, 0, 0, 0, 0);
1224    }
1225
1226    my $pid = processexists($pidfile);
1227    if($pid > 0) {
1228        stopserver($server, "$pid");
1229    }
1230    unlink($pidfile) if(-f $pidfile);
1231
1232    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1233    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1234
1235    my $flags = "";
1236    $flags .= "--nghttpx \"$ENV{'NGHTTPX'}\" ";
1237    $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1238    $flags .= "--logdir \"$LOGDIR\" ";
1239    $flags .= "--connect $HOSTIP:" . protoport("http") . " ";
1240    $flags .= $verbose_flag if($debugprotocol);
1241
1242    my $port = getfreeport($ipvnum);
1243    my $port2 = getfreeport($ipvnum);
1244    my $aflags = "--port $port --port2 $port2 $flags";
1245    my $cmd = "$exe $aflags";
1246    my ($http2pid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1247
1248    if($http2pid <= 0 || !pidexists($http2pid)) {
1249        # it is NOT alive
1250        stopserver($server, "$pid2");
1251        $doesntrun{$pidfile} = 1;
1252        $http2pid = $pid2 = 0;
1253        logmsg "RUN: failed to start the $srvrname server\n";
1254        return (3, 0, 0, 0, 0);
1255    }
1256    $doesntrun{$pidfile} = 0;
1257
1258    if($verb) {
1259        logmsg "RUN: $srvrname server PID $http2pid ".
1260            "http-port $port https-port $port2 ".
1261            "backend $HOSTIP:" . protoport("http") . "\n";
1262    }
1263
1264    return (0+!$http2pid, $http2pid, $pid2, $port, $port2);
1265}
1266
1267#######################################################################
1268# start the http3 server
1269#
1270sub runhttp3server {
1271    my ($verb, $cert) = @_;
1272    my $proto="http/3";
1273    my $ipvnum = 4;
1274    my $idnum = 0;
1275    my $exe = "$perl $srcdir/http3-server.pl";
1276    my $verbose_flag = "--verbose ";
1277
1278    my $server = servername_id($proto, $ipvnum, $idnum);
1279
1280    my $pidfile = $serverpidfile{$server};
1281
1282    # don't retry if the server doesn't work
1283    if ($doesntrun{$pidfile}) {
1284        return (2, 0, 0, 0);
1285    }
1286
1287    my $pid = processexists($pidfile);
1288    if($pid > 0) {
1289        stopserver($server, "$pid");
1290    }
1291    unlink($pidfile) if(-f $pidfile);
1292
1293    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1294    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1295
1296    my $flags = "";
1297    $flags .= "--nghttpx \"$ENV{'NGHTTPX'}\" ";
1298    $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1299    $flags .= "--logdir \"$LOGDIR\" ";
1300    $flags .= "--connect $HOSTIP:" . protoport("http") . " ";
1301    $flags .= "--cert \"$cert\" " if($cert);
1302    $flags .= $verbose_flag if($debugprotocol);
1303
1304    my $port = getfreeport($ipvnum);
1305    my $aflags = "--port $port $flags";
1306    my $cmd = "$exe $aflags";
1307    my ($http3pid, $pid3) = startnew($cmd, $pidfile, 15, 0);
1308
1309    if($http3pid <= 0 || !pidexists($http3pid)) {
1310        # it is NOT alive
1311        stopserver($server, "$pid3");
1312        $doesntrun{$pidfile} = 1;
1313        $http3pid = $pid3 = 0;
1314        logmsg "RUN: failed to start the $srvrname server\n";
1315        return (3, 0, 0, 0);
1316    }
1317    $doesntrun{$pidfile} = 0;
1318
1319    if($verb) {
1320        logmsg "RUN: $srvrname server PID $http3pid port $port\n";
1321    }
1322
1323    return (0+!$http3pid, $http3pid, $pid3, $port);
1324}
1325
1326#######################################################################
1327# start the https stunnel based server
1328#
1329sub runhttpsserver {
1330    my ($verb, $proto, $proxy, $certfile) = @_;
1331    my $ip = $HOSTIP;
1332    my $ipvnum = 4;
1333    my $idnum = 1;
1334
1335    if($proxy eq "proxy") {
1336        # the https-proxy runs as https2
1337        $idnum = 2;
1338    }
1339
1340    if(!$stunnel) {
1341        return (4, 0, 0, 0);
1342    }
1343
1344    my $server = servername_id($proto, $ipvnum, $idnum);
1345
1346    my $pidfile = $serverpidfile{$server};
1347
1348    # don't retry if the server doesn't work
1349    if ($doesntrun{$pidfile}) {
1350        return (2, 0, 0, 0);
1351    }
1352
1353    my $pid = processexists($pidfile);
1354    if($pid > 0) {
1355        stopserver($server, "$pid");
1356    }
1357    unlink($pidfile) if(-f $pidfile);
1358
1359    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1360    $certfile = 'stunnel.pem' unless($certfile);
1361    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1362
1363    my $flags = "";
1364    $flags .= "--verbose " if($debugprotocol);
1365    $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1366    $flags .= "--logdir \"$LOGDIR\" ";
1367    $flags .= "--id $idnum " if($idnum > 1);
1368    $flags .= "--ipv$ipvnum --proto $proto ";
1369    $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
1370    $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
1371    if($proto eq "gophers") {
1372        $flags .= "--connect " . protoport("gopher");
1373    }
1374    elsif(!$proxy) {
1375        $flags .= "--connect " . protoport("http");
1376    }
1377    else {
1378        # for HTTPS-proxy we connect to the HTTP proxy
1379        $flags .= "--connect " . protoport("httpproxy");
1380    }
1381
1382    my $port = getfreeport($ipvnum);
1383    my $options = "$flags --accept $port";
1384    my $cmd = "$perl $srcdir/secureserver.pl $options";
1385    my ($httpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1386
1387    if($httpspid <= 0 || !pidexists($httpspid)) {
1388        # it is NOT alive
1389        # don't call stopserver since that will also kill the dependent
1390        # server that has already been started properly
1391        $doesntrun{$pidfile} = 1;
1392        $httpspid = $pid2 = 0;
1393        logmsg "RUN: failed to start the $srvrname server\n";
1394        return (3, 0, 0, 0);
1395    }
1396
1397    $doesntrun{$pidfile} = 0;
1398    # we have a server!
1399    if($verb) {
1400        logmsg "RUN: $srvrname server is PID $httpspid port $port\n";
1401    }
1402
1403    $runcert{$server} = $certfile;
1404
1405    return (0+!$httpspid, $httpspid, $pid2, $port);
1406}
1407
1408#######################################################################
1409# start the non-stunnel HTTP TLS extensions capable server
1410#
1411sub runhttptlsserver {
1412    my ($verb, $ipv6) = @_;
1413    my $proto = "httptls";
1414    my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1415    my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1416    my $idnum = 1;
1417
1418    if(!$httptlssrv) {
1419        return (4, 0, 0);
1420    }
1421
1422    my $server = servername_id($proto, $ipvnum, $idnum);
1423
1424    my $pidfile = $serverpidfile{$server};
1425
1426    # don't retry if the server doesn't work
1427    if ($doesntrun{$pidfile}) {
1428        return (2, 0, 0, 0);
1429    }
1430
1431    my $pid = processexists($pidfile);
1432    if($pid > 0) {
1433        stopserver($server, "$pid");
1434    }
1435    unlink($pidfile) if(-f $pidfile);
1436
1437    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1438    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1439
1440    my $flags = "";
1441    $flags .= "--http ";
1442    $flags .= "--debug 1 " if($debugprotocol);
1443    $flags .= "--priority NORMAL:+SRP ";
1444    $flags .= "--srppasswd $srcdir/certs/srp-verifier-db ";
1445    $flags .= "--srppasswdconf $srcdir/certs/srp-verifier-conf";
1446
1447    my $port = getfreeport($ipvnum);
1448    my $allflags = "--port $port $flags";
1449    my $cmd = "$httptlssrv $allflags > $logfile 2>&1";
1450    my ($httptlspid, $pid2) = startnew($cmd, $pidfile, 10, 1);
1451
1452    if($httptlspid <= 0 || !pidexists($httptlspid)) {
1453        # it is NOT alive
1454        stopserver($server, "$pid2");
1455        $doesntrun{$pidfile} = 1;
1456        $httptlspid = $pid2 = 0;
1457        logmsg "RUN: failed to start the $srvrname server\n";
1458        return (3, 0, 0, 0);
1459    }
1460    $doesntrun{$pidfile} = 0;
1461
1462    if($verb) {
1463        logmsg "RUN: $srvrname server PID $httptlspid port $port\n";
1464    }
1465    return (0+!$httptlspid, $httptlspid, $pid2, $port);
1466}
1467
1468#######################################################################
1469# start the pingpong server (FTP, POP3, IMAP, SMTP)
1470#
1471sub runpingpongserver {
1472    my ($proto, $id, $verb, $ipv6) = @_;
1473
1474    # Check the requested server
1475    if($proto !~ /^(?:ftp|imap|pop3|smtp)$/) {
1476        logmsg "Unsupported protocol $proto!!\n";
1477        return (4, 0, 0);
1478    }
1479
1480    my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1481    my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1482    my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1483
1484    my $server = servername_id($proto, $ipvnum, $idnum);
1485
1486    my $pidfile = $serverpidfile{$server};
1487    my $portfile = $serverportfile{$server};
1488
1489    # don't retry if the server doesn't work
1490    if ($doesntrun{$pidfile}) {
1491        return (2, 0, 0);
1492    }
1493
1494    my $pid = processexists($pidfile);
1495    if($pid > 0) {
1496        stopserver($server, "$pid");
1497    }
1498    unlink($pidfile) if(-f $pidfile);
1499
1500    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1501    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1502
1503    my $flags = "";
1504    $flags .= "--verbose " if($debugprotocol);
1505    $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1506    $flags .= "--logdir \"$LOGDIR\" ";
1507    $flags .= "--portfile \"$portfile\" ";
1508    $flags .= "--srcdir \"$srcdir\" --proto $proto ";
1509    $flags .= "--id $idnum " if($idnum > 1);
1510    $flags .= "--ipv$ipvnum --port 0 --addr \"$ip\"";
1511
1512    my $cmd = "$perl $srcdir/ftpserver.pl $flags";
1513    my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1514
1515    if($ftppid <= 0 || !pidexists($ftppid)) {
1516        # it is NOT alive
1517        logmsg "RUN: failed to start the $srvrname server\n";
1518        stopserver($server, "$pid2");
1519        $doesntrun{$pidfile} = 1;
1520        return (1, 0, 0);
1521    }
1522
1523    # where is it?
1524    my $port = pidfromfile($portfile);
1525
1526    logmsg "PINGPONG runs on port $port ($portfile)\n" if($verb);
1527
1528    # Server is up. Verify that we can speak to it.
1529    my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1530    if(!$pid3) {
1531        logmsg "RUN: $srvrname server failed verification\n";
1532        # failed to talk to it properly. Kill the server and return failure
1533        stopserver($server, "$ftppid $pid2");
1534        $doesntrun{$pidfile} = 1;
1535        return (1, 0, 0);
1536    }
1537    $pid2 = $pid3;
1538
1539    logmsg "RUN: $srvrname server is PID $ftppid port $port\n" if($verb);
1540
1541    # Assign the correct port variable!
1542    $PORT{$proto . ($ipvnum == 6? '6': '')} = $port;
1543
1544    return (0, $pid2, $ftppid);
1545}
1546
1547#######################################################################
1548# start the ftps/imaps/pop3s/smtps server (or rather, tunnel)
1549#
1550sub runsecureserver {
1551    my ($verb, $ipv6, $certfile, $proto, $clearport) = @_;
1552    my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
1553    my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
1554    my $idnum = 1;
1555
1556    if(!$stunnel) {
1557        return (4, 0, 0, 0);
1558    }
1559
1560    my $server = servername_id($proto, $ipvnum, $idnum);
1561
1562    my $pidfile = $serverpidfile{$server};
1563
1564    # don't retry if the server doesn't work
1565    if ($doesntrun{$pidfile}) {
1566        return (2, 0, 0, 0);
1567    }
1568
1569    my $pid = processexists($pidfile);
1570    if($pid > 0) {
1571        stopserver($server, "$pid");
1572    }
1573    unlink($pidfile) if(-f $pidfile);
1574
1575    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1576    $certfile = 'stunnel.pem' unless($certfile);
1577    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1578
1579    my $flags = "";
1580    $flags .= "--verbose " if($debugprotocol);
1581    $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
1582    $flags .= "--logdir \"$LOGDIR\" ";
1583    $flags .= "--id $idnum " if($idnum > 1);
1584    $flags .= "--ipv$ipvnum --proto $proto ";
1585    $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
1586    $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
1587    $flags .= "--connect $clearport";
1588
1589    my $port = getfreeport($ipvnum);
1590    my $options = "$flags --accept $port";
1591
1592    my $cmd = "$perl $srcdir/secureserver.pl $options";
1593    my ($protospid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1594
1595    if($protospid <= 0 || !pidexists($protospid)) {
1596        # it is NOT alive
1597        # don't call stopserver since that will also kill the dependent
1598        # server that has already been started properly
1599        $doesntrun{$pidfile} = 1;
1600        $protospid = $pid2 = 0;
1601        logmsg "RUN: failed to start the $srvrname server\n";
1602        return (3, 0, 0, 0);
1603    }
1604
1605    $doesntrun{$pidfile} = 0;
1606    $runcert{$server} = $certfile;
1607
1608    if($verb) {
1609        logmsg "RUN: $srvrname server is PID $protospid port $port\n";
1610    }
1611
1612    return (0+!$protospid, $protospid, $pid2, $port);
1613}
1614
1615#######################################################################
1616# start the tftp server
1617#
1618sub runtftpserver {
1619    my ($id, $verb, $ipv6) = @_;
1620    my $ip = $HOSTIP;
1621    my $proto = 'tftp';
1622    my $ipvnum = 4;
1623    my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1624
1625    if($ipv6) {
1626        # if IPv6, use a different setup
1627        $ipvnum = 6;
1628        $ip = $HOST6IP;
1629    }
1630
1631    my $server = servername_id($proto, $ipvnum, $idnum);
1632
1633    my $pidfile = $serverpidfile{$server};
1634
1635    # don't retry if the server doesn't work
1636    if ($doesntrun{$pidfile}) {
1637        return (2, 0, 0, 0);
1638    }
1639
1640    my $pid = processexists($pidfile);
1641    if($pid > 0) {
1642        stopserver($server, "$pid");
1643    }
1644    unlink($pidfile) if(-f $pidfile);
1645
1646    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1647    my $portfile = $serverportfile{$server};
1648    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1649
1650    my $flags = "";
1651    $flags .= "--verbose " if($debugprotocol);
1652    $flags .= "--pidfile \"$pidfile\" ";
1653    $flags .= "--portfile \"$portfile\" ";
1654    $flags .= "--logfile \"$logfile\" ";
1655    $flags .= "--logdir \"$LOGDIR\" ";
1656    $flags .= "--id $idnum " if($idnum > 1);
1657    $flags .= "--ipv$ipvnum --port 0 --srcdir \"$srcdir\"";
1658
1659    my $cmd = "$perl $srcdir/tftpserver.pl $flags";
1660    my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1661
1662    if($tftppid <= 0 || !pidexists($tftppid)) {
1663        # it is NOT alive
1664        logmsg "RUN: failed to start the $srvrname server\n";
1665        stopserver($server, "$pid2");
1666        $doesntrun{$pidfile} = 1;
1667        return (1, 0, 0, 0);
1668    }
1669
1670    my $port = pidfromfile($portfile);
1671
1672    # Server is up. Verify that we can speak to it.
1673    my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1674    if(!$pid3) {
1675        logmsg "RUN: $srvrname server failed verification\n";
1676        # failed to talk to it properly. Kill the server and return failure
1677        stopserver($server, "$tftppid $pid2");
1678        $doesntrun{$pidfile} = 1;
1679        return (1, 0, 0, 0);
1680    }
1681    $pid2 = $pid3;
1682
1683    if($verb) {
1684        logmsg "RUN: $srvrname server on PID $tftppid port $port\n";
1685    }
1686
1687    return (0, $pid2, $tftppid, $port);
1688}
1689
1690
1691#######################################################################
1692# start the rtsp server
1693#
1694sub runrtspserver {
1695    my ($verb, $ipv6) = @_;
1696    my $ip = $HOSTIP;
1697    my $proto = 'rtsp';
1698    my $ipvnum = 4;
1699    my $idnum = 1;
1700
1701    if($ipv6) {
1702        # if IPv6, use a different setup
1703        $ipvnum = 6;
1704        $ip = $HOST6IP;
1705    }
1706
1707    my $server = servername_id($proto, $ipvnum, $idnum);
1708
1709    my $pidfile = $serverpidfile{$server};
1710    my $portfile = $serverportfile{$server};
1711
1712    # don't retry if the server doesn't work
1713    if ($doesntrun{$pidfile}) {
1714        return (2, 0, 0, 0);
1715    }
1716
1717    my $pid = processexists($pidfile);
1718    if($pid > 0) {
1719        stopserver($server, "$pid");
1720    }
1721    unlink($pidfile) if(-f $pidfile);
1722
1723    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1724    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1725
1726    my $flags = "";
1727    $flags .= "--verbose " if($debugprotocol);
1728    $flags .= "--pidfile \"$pidfile\" ";
1729    $flags .= "--portfile \"$portfile\" ";
1730    $flags .= "--logfile \"$logfile\" ";
1731    $flags .= "--logdir \"$LOGDIR\" ";
1732    $flags .= "--id $idnum " if($idnum > 1);
1733    $flags .= "--ipv$ipvnum --port 0 --srcdir \"$srcdir\"";
1734
1735    my $cmd = "$perl $srcdir/rtspserver.pl $flags";
1736    my ($rtsppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
1737
1738    if($rtsppid <= 0 || !pidexists($rtsppid)) {
1739        # it is NOT alive
1740        logmsg "RUN: failed to start the $srvrname server\n";
1741        stopserver($server, "$pid2");
1742        $doesntrun{$pidfile} = 1;
1743        return (1, 0, 0, 0);
1744    }
1745
1746    my $port = pidfromfile($portfile);
1747
1748    # Server is up. Verify that we can speak to it.
1749    my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
1750    if(!$pid3) {
1751        logmsg "RUN: $srvrname server failed verification\n";
1752        # failed to talk to it properly. Kill the server and return failure
1753        stopserver($server, "$rtsppid $pid2");
1754        $doesntrun{$pidfile} = 1;
1755        return (1, 0, 0, 0);
1756    }
1757    $pid2 = $pid3;
1758
1759    if($verb) {
1760        logmsg "RUN: $srvrname server PID $rtsppid port $port\n";
1761    }
1762
1763    return (0, $rtsppid, $pid2, $port);
1764}
1765
1766
1767#######################################################################
1768# Start the ssh (scp/sftp) server
1769#
1770sub runsshserver {
1771    my ($id, $verb, $ipv6) = @_;
1772    my $ip=$HOSTIP;
1773    my $proto = 'ssh';
1774    my $ipvnum = 4;
1775    my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1776
1777    if(!$USER) {
1778        logmsg "Can't start ssh server due to lack of USER name\n";
1779        return (4, 0, 0, 0);
1780    }
1781
1782    my $server = servername_id($proto, $ipvnum, $idnum);
1783
1784    my $pidfile = $serverpidfile{$server};
1785
1786    # don't retry if the server doesn't work
1787    if ($doesntrun{$pidfile}) {
1788        return (2, 0, 0, 0);
1789    }
1790
1791    my $sshd = find_sshd();
1792    if($sshd) {
1793        ($sshdid,$sshdvernum,$sshdverstr,$sshderror) = sshversioninfo($sshd);
1794        logmsg $sshderror if($sshderror);
1795    }
1796
1797    my $pid = processexists($pidfile);
1798    if($pid > 0) {
1799        stopserver($server, "$pid");
1800    }
1801    unlink($pidfile) if(-f $pidfile);
1802
1803    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1804    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1805
1806    my $flags = "";
1807    $flags .= "--verbose " if($verb);
1808    $flags .= "--debugprotocol " if($debugprotocol);
1809    $flags .= "--pidfile \"$pidfile\" ";
1810    $flags .= "--logdir \"$LOGDIR\" ";
1811    $flags .= "--id $idnum " if($idnum > 1);
1812    $flags .= "--ipv$ipvnum --addr \"$ip\" ";
1813    $flags .= "--user \"$USER\"";
1814
1815    my @tports;
1816    my $port = getfreeport($ipvnum);
1817
1818    push @tports, $port;
1819
1820    my $options = "$flags --sshport $port";
1821
1822    my $cmd = "$perl $srcdir/sshserver.pl $options";
1823    my ($sshpid, $pid2) = startnew($cmd, $pidfile, 60, 0);
1824
1825    # on loaded systems sshserver start up can take longer than the
1826    # timeout passed to startnew, when this happens startnew completes
1827    # without being able to read the pidfile and consequently returns a
1828    # zero pid2 above.
1829    if($sshpid <= 0 || !pidexists($sshpid)) {
1830        # it is NOT alive
1831        stopserver($server, "$pid2");
1832        $doesntrun{$pidfile} = 1;
1833        $sshpid = $pid2 = 0;
1834        logmsg "RUN: failed to start the $srvrname server on $port\n";
1835        return (3, 0, 0, 0);
1836    }
1837
1838    # once it is known that the ssh server is alive, sftp server
1839    # verification is performed actually connecting to it, authenticating
1840    # and performing a very simple remote command.  This verification is
1841    # tried only one time.
1842
1843    $sshdlog = server_logfilename($LOGDIR, 'ssh', $ipvnum, $idnum);
1844    $sftplog = server_logfilename($LOGDIR, 'sftp', $ipvnum, $idnum);
1845
1846    if(verifysftp('sftp', $ipvnum, $idnum, $ip, $port) < 1) {
1847        logmsg "RUN: SFTP server failed verification\n";
1848        # failed to talk to it properly. Kill the server and return failure
1849        display_sftplog();
1850        display_sftpconfig();
1851        display_sshdlog();
1852        display_sshdconfig();
1853        stopserver($server, "$sshpid $pid2");
1854        $doesntrun{$pidfile} = 1;
1855        $sshpid = $pid2 = 0;
1856        logmsg "RUN: failed to verify the $srvrname server on $port\n";
1857        return (5, 0, 0, 0);
1858    }
1859    # we're happy, no need to loop anymore!
1860    $doesntrun{$pidfile} = 0;
1861
1862    my $hostfile;
1863    if(!open($hostfile, "<", "$LOGDIR/$PIDDIR/$hstpubmd5f") ||
1864       (read($hostfile, $SSHSRVMD5, 32) != 32) ||
1865       !close($hostfile) ||
1866       ($SSHSRVMD5 !~ /^[a-f0-9]{32}$/i))
1867    {
1868        my $msg = "Fatal: $srvrname pubkey md5 missing : \"$hstpubmd5f\" : $!";
1869        logmsg "$msg\n";
1870        stopservers($verb);
1871        die $msg;
1872    }
1873
1874    if(!open($hostfile, "<", "$LOGDIR/$PIDDIR/$hstpubsha256f") ||
1875       (read($hostfile, $SSHSRVSHA256, 48) == 0) ||
1876       !close($hostfile))
1877    {
1878        my $msg = "Fatal: $srvrname pubkey sha256 missing : \"$hstpubsha256f\" : $!";
1879        logmsg "$msg\n";
1880        stopservers($verb);
1881        die $msg;
1882    }
1883
1884    logmsg "RUN: $srvrname on PID $pid2 port $port\n" if($verb);
1885
1886    return (0, $pid2, $sshpid, $port);
1887}
1888
1889#######################################################################
1890# Start the MQTT server
1891#
1892sub runmqttserver {
1893    my ($id, $verb, $ipv6) = @_;
1894    my $ip=$HOSTIP;
1895    my $proto = 'mqtt';
1896    my $port = protoport($proto);
1897    my $ipvnum = 4;
1898    my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1899
1900    my $server = servername_id($proto, $ipvnum, $idnum);
1901    my $pidfile = $serverpidfile{$server};
1902    my $portfile = $serverportfile{$server};
1903
1904    # don't retry if the server doesn't work
1905    if ($doesntrun{$pidfile}) {
1906        return (2, 0, 0);
1907    }
1908
1909    my $pid = processexists($pidfile);
1910    if($pid > 0) {
1911        stopserver($server, "$pid");
1912    }
1913    unlink($pidfile) if(-f $pidfile);
1914
1915    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1916    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1917
1918    # start our MQTT server - on a random port!
1919    my $cmd="server/mqttd".exe_ext('SRV').
1920        " --port 0 ".
1921        " --pidfile $pidfile".
1922        " --portfile $portfile".
1923        " --config $LOGDIR/$SERVERCMD".
1924        " --logfile $logfile".
1925        " --logdir $LOGDIR";
1926    my ($sockspid, $pid2) = startnew($cmd, $pidfile, 30, 0);
1927
1928    if($sockspid <= 0 || !pidexists($sockspid)) {
1929        # it is NOT alive
1930        logmsg "RUN: failed to start the $srvrname server\n";
1931        stopserver($server, "$pid2");
1932        $doesntrun{$pidfile} = 1;
1933        return (1, 0, 0);
1934    }
1935
1936    my $mqttport = pidfromfile($portfile);
1937    $PORT{"mqtt"} = $mqttport;
1938
1939    if($verb) {
1940        logmsg "RUN: $srvrname server is now running PID $pid2 on PORT $mqttport\n";
1941    }
1942
1943    return (0, $pid2, $sockspid);
1944}
1945
1946#######################################################################
1947# Start the socks server
1948#
1949sub runsocksserver {
1950    my ($id, $verb, $ipv6, $is_unix) = @_;
1951    my $ip=$HOSTIP;
1952    my $proto = 'socks';
1953    my $ipvnum = 4;
1954    my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
1955
1956    my $server = servername_id($proto, $ipvnum, $idnum);
1957
1958    my $pidfile = $serverpidfile{$server};
1959
1960    # don't retry if the server doesn't work
1961    if ($doesntrun{$pidfile}) {
1962        return (2, 0, 0, 0);
1963    }
1964
1965    my $pid = processexists($pidfile);
1966    if($pid > 0) {
1967        stopserver($server, "$pid");
1968    }
1969    unlink($pidfile) if(-f $pidfile);
1970
1971    my $srvrname = servername_str($proto, $ipvnum, $idnum);
1972    my $portfile = $serverportfile{$server};
1973    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
1974
1975    # start our socks server, get commands from the FTP cmd file
1976    my $cmd="";
1977    if($is_unix) {
1978        $cmd="server/socksd".exe_ext('SRV').
1979            " --pidfile $pidfile".
1980            " --reqfile $LOGDIR/$SOCKSIN".
1981            " --logfile $logfile".
1982            " --unix-socket $SOCKSUNIXPATH".
1983            " --backend $HOSTIP".
1984            " --config $LOGDIR/$SERVERCMD";
1985    } else {
1986        $cmd="server/socksd".exe_ext('SRV').
1987            " --port 0 ".
1988            " --pidfile $pidfile".
1989            " --portfile $portfile".
1990            " --reqfile $LOGDIR/$SOCKSIN".
1991            " --logfile $logfile".
1992            " --backend $HOSTIP".
1993            " --config $LOGDIR/$SERVERCMD";
1994    }
1995    my ($sockspid, $pid2) = startnew($cmd, $pidfile, 30, 0);
1996
1997    if($sockspid <= 0 || !pidexists($sockspid)) {
1998        # it is NOT alive
1999        logmsg "RUN: failed to start the $srvrname server\n";
2000        stopserver($server, "$pid2");
2001        $doesntrun{$pidfile} = 1;
2002        return (1, 0, 0, 0);
2003    }
2004
2005    my $port = pidfromfile($portfile);
2006
2007    if($verb) {
2008        logmsg "RUN: $srvrname server is now running PID $pid2\n";
2009    }
2010
2011    return (0, $pid2, $sockspid, $port);
2012}
2013
2014#######################################################################
2015# start the dict server
2016#
2017sub rundictserver {
2018    my ($verb, $alt) = @_;
2019    my $proto = "dict";
2020    my $ip = $HOSTIP;
2021    my $ipvnum = 4;
2022    my $idnum = 1;
2023
2024    if($alt eq "ipv6") {
2025        # No IPv6
2026    }
2027
2028    my $server = servername_id($proto, $ipvnum, $idnum);
2029
2030    my $pidfile = $serverpidfile{$server};
2031
2032    # don't retry if the server doesn't work
2033    if ($doesntrun{$pidfile}) {
2034        return (2, 0, 0, 0);
2035    }
2036
2037    my $pid = processexists($pidfile);
2038    if($pid > 0) {
2039        stopserver($server, "$pid");
2040    }
2041    unlink($pidfile) if(-f $pidfile);
2042
2043    my $srvrname = servername_str($proto, $ipvnum, $idnum);
2044    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
2045
2046    my $flags = "";
2047    $flags .= "--verbose 1 " if($debugprotocol);
2048    $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
2049    $flags .= "--id $idnum " if($idnum > 1);
2050    $flags .= "--srcdir \"$srcdir\" ";
2051    $flags .= "--host $HOSTIP";
2052
2053    my $port = getfreeport($ipvnum);
2054    my $aflags = "--port $port $flags";
2055    my $cmd = "$srcdir/dictserver.py $aflags";
2056    my ($dictpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
2057
2058    if($dictpid <= 0 || !pidexists($dictpid)) {
2059        # it is NOT alive
2060        stopserver($server, "$pid2");
2061        $doesntrun{$pidfile} = 1;
2062        $dictpid = $pid2 = 0;
2063        logmsg "RUN: failed to start the $srvrname server\n";
2064        return (3, 0, 0, 0);
2065    }
2066    $doesntrun{$pidfile} = 0;
2067
2068    if($verb) {
2069        logmsg "RUN: $srvrname server PID $dictpid port $port\n";
2070    }
2071
2072    return (0+!$dictpid, $dictpid, $pid2, $port);
2073}
2074
2075#######################################################################
2076# start the SMB server
2077#
2078sub runsmbserver {
2079    my ($verb, $alt) = @_;
2080    my $proto = "smb";
2081    my $ip = $HOSTIP;
2082    my $ipvnum = 4;
2083    my $idnum = 1;
2084
2085    if($alt eq "ipv6") {
2086        # No IPv6
2087    }
2088
2089    my $server = servername_id($proto, $ipvnum, $idnum);
2090
2091    my $pidfile = $serverpidfile{$server};
2092
2093    # don't retry if the server doesn't work
2094    if ($doesntrun{$pidfile}) {
2095        return (2, 0, 0, 0);
2096    }
2097
2098    my $pid = processexists($pidfile);
2099    if($pid > 0) {
2100        stopserver($server, "$pid");
2101    }
2102    unlink($pidfile) if(-f $pidfile);
2103
2104    my $srvrname = servername_str($proto, $ipvnum, $idnum);
2105    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
2106
2107    my $flags = "";
2108    $flags .= "--verbose 1 " if($debugprotocol);
2109    $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
2110    $flags .= "--id $idnum " if($idnum > 1);
2111    $flags .= "--srcdir \"$srcdir\" ";
2112    $flags .= "--host $HOSTIP";
2113
2114    my $port = getfreeport($ipvnum);
2115    my $aflags = "--port $port $flags";
2116    my $cmd = "$srcdir/smbserver.py $aflags";
2117    my ($smbpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
2118
2119    if($smbpid <= 0 || !pidexists($smbpid)) {
2120        # it is NOT alive
2121        stopserver($server, "$pid2");
2122        $doesntrun{$pidfile} = 1;
2123        $smbpid = $pid2 = 0;
2124        logmsg "RUN: failed to start the $srvrname server\n";
2125        return (3, 0, 0, 0);
2126    }
2127    $doesntrun{$pidfile} = 0;
2128
2129    if($verb) {
2130        logmsg "RUN: $srvrname server PID $smbpid port $port\n";
2131    }
2132
2133    return (0+!$smbpid, $smbpid, $pid2, $port);
2134}
2135
2136#######################################################################
2137# start the telnet server
2138#
2139sub runnegtelnetserver {
2140    my ($verb, $alt) = @_;
2141    my $proto = "telnet";
2142    my $ip = $HOSTIP;
2143    my $ipvnum = 4;
2144    my $idnum = 1;
2145
2146    if($alt eq "ipv6") {
2147        # No IPv6
2148    }
2149
2150    my $server = servername_id($proto, $ipvnum, $idnum);
2151
2152    my $pidfile = $serverpidfile{$server};
2153
2154    # don't retry if the server doesn't work
2155    if ($doesntrun{$pidfile}) {
2156        return (2, 0, 0, 0);
2157    }
2158
2159    my $pid = processexists($pidfile);
2160    if($pid > 0) {
2161        stopserver($server, "$pid");
2162    }
2163    unlink($pidfile) if(-f $pidfile);
2164
2165    my $srvrname = servername_str($proto, $ipvnum, $idnum);
2166    my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
2167
2168    my $flags = "";
2169    $flags .= "--verbose 1 " if($debugprotocol);
2170    $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
2171    $flags .= "--id $idnum " if($idnum > 1);
2172    $flags .= "--srcdir \"$srcdir\"";
2173
2174    my $port = getfreeport($ipvnum);
2175    my $aflags = "--port $port $flags";
2176    my $cmd = "$srcdir/negtelnetserver.py $aflags";
2177    my ($ntelpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
2178
2179    if($ntelpid <= 0 || !pidexists($ntelpid)) {
2180        # it is NOT alive
2181        stopserver($server, "$pid2");
2182        $doesntrun{$pidfile} = 1;
2183        $ntelpid = $pid2 = 0;
2184        logmsg "RUN: failed to start the $srvrname server\n";
2185        return (3, 0, 0, 0);
2186    }
2187    $doesntrun{$pidfile} = 0;
2188
2189    if($verb) {
2190        logmsg "RUN: $srvrname server PID $ntelpid port $port\n";
2191    }
2192
2193    return (0+!$ntelpid, $ntelpid, $pid2, $port);
2194}
2195
2196
2197
2198
2199#######################################################################
2200# Single shot http and gopher server responsiveness test. This should only
2201# be used to verify that a server present in %run hash is still functional
2202#
2203sub responsive_http_server {
2204    my ($proto, $verb, $alt, $port_or_path) = @_;
2205    my $ip = $HOSTIP;
2206    my $ipvnum = 4;
2207    my $idnum = 1;
2208
2209    if($alt eq "ipv6") {
2210        # if IPv6, use a different setup
2211        $ipvnum = 6;
2212        $ip = $HOST6IP;
2213    }
2214    elsif($alt eq "proxy") {
2215        $idnum = 2;
2216    }
2217    elsif($alt eq "unix") {
2218        # IP (protocol) is mutually exclusive with Unix sockets
2219        $ipvnum = "unix";
2220    }
2221
2222    return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
2223}
2224
2225#######################################################################
2226# Single shot pingpong server responsiveness test. This should only be
2227# used to verify that a server present in %run hash is still functional
2228#
2229sub responsive_pingpong_server {
2230    my ($proto, $id, $verb, $ipv6) = @_;
2231    my $port;
2232    my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
2233    my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
2234    my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2235    my $protoip = $proto . ($ipvnum == 6? '6': '');
2236
2237    if($proto =~ /^(?:ftp|imap|pop3|smtp)$/) {
2238        $port = protoport($protoip);
2239    }
2240    else {
2241        logmsg "Unsupported protocol $proto!!\n";
2242        return 0;
2243    }
2244
2245    return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2246}
2247
2248#######################################################################
2249# Single shot rtsp server responsiveness test. This should only be
2250# used to verify that a server present in %run hash is still functional
2251#
2252sub responsive_rtsp_server {
2253    my ($verb, $ipv6) = @_;
2254    my $proto = 'rtsp';
2255    my $port = protoport($proto);
2256    my $ip = $HOSTIP;
2257    my $ipvnum = 4;
2258    my $idnum = 1;
2259
2260    if($ipv6) {
2261        # if IPv6, use a different setup
2262        $ipvnum = 6;
2263        $port = protoport('rtsp6');
2264        $ip = $HOST6IP;
2265    }
2266
2267    return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2268}
2269
2270#######################################################################
2271# Single shot tftp server responsiveness test. This should only be
2272# used to verify that a server present in %run hash is still functional
2273#
2274sub responsive_tftp_server {
2275    my ($id, $verb, $ipv6) = @_;
2276    my $proto = 'tftp';
2277    my $port = protoport($proto);
2278    my $ip = $HOSTIP;
2279    my $ipvnum = 4;
2280    my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
2281
2282    if($ipv6) {
2283        # if IPv6, use a different setup
2284        $ipvnum = 6;
2285        $port = protoport('tftp6');
2286        $ip = $HOST6IP;
2287    }
2288
2289    return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2290}
2291
2292#######################################################################
2293# Single shot non-stunnel HTTP TLS extensions capable server
2294# responsiveness test. This should only be used to verify that a
2295# server present in %run hash is still functional
2296#
2297sub responsive_httptls_server {
2298    my ($verb, $ipv6) = @_;
2299    my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
2300    my $proto = "httptls";
2301    my $port = protoport($proto);
2302    my $ip = "$HOSTIP";
2303    my $idnum = 1;
2304
2305    if ($ipvnum == 6) {
2306        $port = protoport("httptls6");
2307        $ip = "$HOST6IP";
2308    }
2309
2310    return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
2311}
2312
2313#######################################################################
2314# startservers() starts all the named servers
2315#
2316# Returns: string with error reason or blank for success, and an integer:
2317#          0 for success
2318#          1 for an error starting the server
2319#          2 for not the first time getting an error starting the server
2320#          3 for a failure to stop a server in order to restart it
2321#          4 for an unsupported server type
2322#
2323sub startservers {
2324    my @what = @_;
2325    my ($pid, $pid2);
2326    my $serr;  # error while starting a server (as as the return enumerations)
2327    for(@what) {
2328        my (@whatlist) = split(/\s+/,$_);
2329        my $what = lc($whatlist[0]);
2330        $what =~ s/[^a-z0-9\/-]//g;
2331
2332        my $certfile;
2333        if($what =~ /^(ftp|gopher|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
2334            $certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem';
2335        }
2336
2337        if(($what eq "pop3") ||
2338           ($what eq "ftp") ||
2339           ($what eq "imap") ||
2340           ($what eq "smtp")) {
2341            if($torture && $run{$what} &&
2342               !responsive_pingpong_server($what, "", $verbose)) {
2343                if(stopserver($what)) {
2344                    return ("failed stopping unresponsive ".uc($what)." server", 3);
2345                }
2346            }
2347            if(!$run{$what}) {
2348                ($serr, $pid, $pid2) = runpingpongserver($what, "", $verbose);
2349                if($pid <= 0) {
2350                    return ("failed starting ". uc($what) ." server", $serr);
2351                }
2352                logmsg sprintf("* pid $what => %d %d\n", $pid, $pid2) if($verbose);
2353                $run{$what}="$pid $pid2";
2354            }
2355        }
2356        elsif($what eq "ftp-ipv6") {
2357            if($torture && $run{'ftp-ipv6'} &&
2358               !responsive_pingpong_server("ftp", "", $verbose, "ipv6")) {
2359                if(stopserver('ftp-ipv6')) {
2360                    return ("failed stopping unresponsive FTP-IPv6 server", 3);
2361                }
2362            }
2363            if(!$run{'ftp-ipv6'}) {
2364                ($serr, $pid, $pid2) = runpingpongserver("ftp", "", $verbose, "ipv6");
2365                if($pid <= 0) {
2366                    return ("failed starting FTP-IPv6 server", $serr);
2367                }
2368                logmsg sprintf("* pid ftp-ipv6 => %d %d\n", $pid,
2369                       $pid2) if($verbose);
2370                $run{'ftp-ipv6'}="$pid $pid2";
2371            }
2372        }
2373        elsif($what eq "gopher") {
2374            if($torture && $run{'gopher'} &&
2375               !responsive_http_server("gopher", $verbose, 0,
2376                                       protoport("gopher"))) {
2377                if(stopserver('gopher')) {
2378                    return ("failed stopping unresponsive GOPHER server", 3);
2379                }
2380            }
2381            if(!$run{'gopher'}) {
2382                ($serr, $pid, $pid2, $PORT{'gopher'}) =
2383                    runhttpserver("gopher", $verbose, 0);
2384                if($pid <= 0) {
2385                    return ("failed starting GOPHER server", $serr);
2386                }
2387                logmsg sprintf ("* pid gopher => %d %d\n", $pid, $pid2)
2388                    if($verbose);
2389                $run{'gopher'}="$pid $pid2";
2390            }
2391        }
2392        elsif($what eq "gopher-ipv6") {
2393            if($torture && $run{'gopher-ipv6'} &&
2394               !responsive_http_server("gopher", $verbose, "ipv6",
2395                                       protoport("gopher"))) {
2396                if(stopserver('gopher-ipv6')) {
2397                    return ("failed stopping unresponsive GOPHER-IPv6 server", 3);
2398                }
2399            }
2400            if(!$run{'gopher-ipv6'}) {
2401                ($serr, $pid, $pid2, $PORT{"gopher6"}) =
2402                    runhttpserver("gopher", $verbose, "ipv6");
2403                if($pid <= 0) {
2404                    return ("failed starting GOPHER-IPv6 server", $serr);
2405                }
2406                logmsg sprintf("* pid gopher-ipv6 => %d %d\n", $pid,
2407                               $pid2) if($verbose);
2408                $run{'gopher-ipv6'}="$pid $pid2";
2409            }
2410        }
2411        elsif($what eq "http/3") {
2412            if(!$run{'http/3'}) {
2413                ($serr, $pid, $pid2, $PORT{"http3"}) = runhttp3server($verbose);
2414                if($pid <= 0) {
2415                    return ("failed starting HTTP/3 server", $serr);
2416                }
2417                logmsg sprintf ("* pid http/3 => %d %d\n", $pid, $pid2)
2418                    if($verbose);
2419                $run{'http/3'}="$pid $pid2";
2420            }
2421        }
2422        elsif($what eq "http/2") {
2423            if(!$run{'http/2'}) {
2424                ($serr, $pid, $pid2, $PORT{"http2"}, $PORT{"http2tls"}) =
2425                    runhttp2server($verbose);
2426                if($pid <= 0) {
2427                    return ("failed starting HTTP/2 server", $serr);
2428                }
2429                logmsg sprintf ("* pid http/2 => %d %d\n", $pid, $pid2)
2430                    if($verbose);
2431                $run{'http/2'}="$pid $pid2";
2432            }
2433        }
2434        elsif($what eq "http") {
2435            if($torture && $run{'http'} &&
2436               !responsive_http_server("http", $verbose, 0, protoport('http'))) {
2437                if(stopserver('http')) {
2438                    return ("failed stopping unresponsive HTTP server", 3);
2439                }
2440            }
2441            if(!$run{'http'}) {
2442                ($serr, $pid, $pid2, $PORT{'http'}) =
2443                    runhttpserver("http", $verbose, 0);
2444                if($pid <= 0) {
2445                    return ("failed starting HTTP server", $serr);
2446                }
2447                logmsg sprintf ("* pid http => %d %d\n", $pid, $pid2)
2448                    if($verbose);
2449                $run{'http'}="$pid $pid2";
2450            }
2451        }
2452        elsif($what eq "http-proxy") {
2453            if($torture && $run{'http-proxy'} &&
2454               !responsive_http_server("http", $verbose, "proxy",
2455                                       protoport("httpproxy"))) {
2456                if(stopserver('http-proxy')) {
2457                    return ("failed stopping unresponsive HTTP-proxy server", 3);
2458                }
2459            }
2460            if(!$run{'http-proxy'}) {
2461                ($serr, $pid, $pid2, $PORT{"httpproxy"}) =
2462                    runhttpserver("http", $verbose, "proxy");
2463                if($pid <= 0) {
2464                    return ("failed starting HTTP-proxy server", $serr);
2465                }
2466                logmsg sprintf ("* pid http-proxy => %d %d\n", $pid, $pid2)
2467                    if($verbose);
2468                $run{'http-proxy'}="$pid $pid2";
2469            }
2470        }
2471        elsif($what eq "http-ipv6") {
2472            if($torture && $run{'http-ipv6'} &&
2473               !responsive_http_server("http", $verbose, "ipv6",
2474                                       protoport("http6"))) {
2475                if(stopserver('http-ipv6')) {
2476                    return ("failed stopping unresponsive HTTP-IPv6 server", 3);
2477                }
2478            }
2479            if(!$run{'http-ipv6'}) {
2480                ($serr, $pid, $pid2, $PORT{"http6"}) =
2481                    runhttpserver("http", $verbose, "ipv6");
2482                if($pid <= 0) {
2483                    return ("failed starting HTTP-IPv6 server", $serr);
2484                }
2485                logmsg sprintf("* pid http-ipv6 => %d %d\n", $pid, $pid2)
2486                    if($verbose);
2487                $run{'http-ipv6'}="$pid $pid2";
2488            }
2489        }
2490        elsif($what eq "rtsp") {
2491            if($torture && $run{'rtsp'} &&
2492               !responsive_rtsp_server($verbose)) {
2493                if(stopserver('rtsp')) {
2494                    return ("failed stopping unresponsive RTSP server", 3);
2495                }
2496            }
2497            if(!$run{'rtsp'}) {
2498                ($serr, $pid, $pid2, $PORT{'rtsp'}) = runrtspserver($verbose);
2499                if($pid <= 0) {
2500                    return ("failed starting RTSP server", $serr);
2501                }
2502                logmsg sprintf("* pid rtsp => %d %d\n", $pid, $pid2) if($verbose);
2503                $run{'rtsp'}="$pid $pid2";
2504            }
2505        }
2506        elsif($what eq "rtsp-ipv6") {
2507            if($torture && $run{'rtsp-ipv6'} &&
2508               !responsive_rtsp_server($verbose, "ipv6")) {
2509                if(stopserver('rtsp-ipv6')) {
2510                    return ("failed stopping unresponsive RTSP-IPv6 server", 3);
2511                }
2512            }
2513            if(!$run{'rtsp-ipv6'}) {
2514                ($serr, $pid, $pid2, $PORT{'rtsp6'}) = runrtspserver($verbose, "ipv6");
2515                if($pid <= 0) {
2516                    return ("failed starting RTSP-IPv6 server", $serr);
2517                }
2518                logmsg sprintf("* pid rtsp-ipv6 => %d %d\n", $pid, $pid2)
2519                    if($verbose);
2520                $run{'rtsp-ipv6'}="$pid $pid2";
2521            }
2522        }
2523        elsif($what =~ /^(ftp|imap|pop3|smtp)s$/) {
2524            my $cproto = $1;
2525            if(!$stunnel) {
2526                # we can't run ftps tests without stunnel
2527                return ("no stunnel", 4);
2528            }
2529            if($runcert{$what} && ($runcert{$what} ne $certfile)) {
2530                # stop server when running and using a different cert
2531                if(stopserver($what)) {
2532                    return ("failed stopping $what server with different cert", 3);
2533                }
2534            }
2535            if($torture && $run{$cproto} &&
2536               !responsive_pingpong_server($cproto, "", $verbose)) {
2537                if(stopserver($cproto)) {
2538                    return ("failed stopping unresponsive $cproto server", 3);
2539                }
2540            }
2541            if(!$run{$cproto}) {
2542                ($serr, $pid, $pid2) = runpingpongserver($cproto, "", $verbose);
2543                if($pid <= 0) {
2544                    return ("failed starting $cproto server", $serr);
2545                }
2546                logmsg sprintf("* pid $cproto => %d %d\n", $pid, $pid2) if($verbose);
2547                $run{$cproto}="$pid $pid2";
2548            }
2549            if(!$run{$what}) {
2550                ($serr, $pid, $pid2, $PORT{$what}) =
2551                    runsecureserver($verbose, "", $certfile, $what,
2552                                    protoport($cproto));
2553                if($pid <= 0) {
2554                    return ("failed starting $what server (stunnel)", $serr);
2555                }
2556                logmsg sprintf("* pid $what => %d %d\n", $pid, $pid2)
2557                    if($verbose);
2558                $run{$what}="$pid $pid2";
2559            }
2560        }
2561        elsif($what eq "file") {
2562            # we support it but have no server!
2563        }
2564        elsif($what eq "https") {
2565            if(!$stunnel) {
2566                # we can't run https tests without stunnel
2567                return ("no stunnel", 4);
2568            }
2569            if($runcert{'https'} && ($runcert{'https'} ne $certfile)) {
2570                # stop server when running and using a different cert
2571                if(stopserver('https')) {
2572                    return ("failed stopping HTTPS server with different cert", 3);
2573                }
2574            }
2575            if($torture && $run{'http'} &&
2576               !responsive_http_server("http", $verbose, 0,
2577                                       protoport('http'))) {
2578                if(stopserver('http')) {
2579                    return ("failed stopping unresponsive HTTP server", 3);
2580                }
2581            }
2582            if(!$run{'http'}) {
2583                ($serr, $pid, $pid2, $PORT{'http'}) =
2584                    runhttpserver("http", $verbose, 0);
2585                if($pid <= 0) {
2586                    return ("failed starting HTTP server", $serr);
2587                }
2588                logmsg sprintf("* pid http => %d %d\n", $pid, $pid2) if($verbose);
2589                $run{'http'}="$pid $pid2";
2590            }
2591            if(!$run{'https'}) {
2592                ($serr, $pid, $pid2, $PORT{'https'}) =
2593                    runhttpsserver($verbose, "https", "", $certfile);
2594                if($pid <= 0) {
2595                    return ("failed starting HTTPS server (stunnel)", $serr);
2596                }
2597                logmsg sprintf("* pid https => %d %d\n", $pid, $pid2)
2598                    if($verbose);
2599                $run{'https'}="$pid $pid2";
2600            }
2601        }
2602        elsif($what eq "gophers") {
2603            if(!$stunnel) {
2604                # we can't run TLS tests without stunnel
2605                return ("no stunnel", 4);
2606            }
2607            if($runcert{'gophers'} && ($runcert{'gophers'} ne $certfile)) {
2608                # stop server when running and using a different cert
2609                if(stopserver('gophers')) {
2610                    return ("failed stopping GOPHERS server with different cert", 3);
2611                }
2612            }
2613            if($torture && $run{'gopher'} &&
2614               !responsive_http_server("gopher", $verbose, 0,
2615                                       protoport('gopher'))) {
2616                if(stopserver('gopher')) {
2617                    return ("failed stopping unresponsive GOPHER server", 3);
2618                }
2619            }
2620            if(!$run{'gopher'}) {
2621                my $port;
2622                ($serr, $pid, $pid2, $port) =
2623                    runhttpserver("gopher", $verbose, 0);
2624                $PORT{'gopher'} = $port;
2625                if($pid <= 0) {
2626                    return ("failed starting GOPHER server", $serr);
2627                }
2628                logmsg sprintf("* pid gopher => %d %d\n", $pid, $pid2) if($verbose);
2629                logmsg "GOPHERPORT => $port\n" if($verbose);
2630                $run{'gopher'}="$pid $pid2";
2631            }
2632            if(!$run{'gophers'}) {
2633                my $port;
2634                ($serr, $pid, $pid2, $port) =
2635                    runhttpsserver($verbose, "gophers", "", $certfile);
2636                $PORT{'gophers'} = $port;
2637                if($pid <= 0) {
2638                    return ("failed starting GOPHERS server (stunnel)", $serr);
2639                }
2640                logmsg sprintf("* pid gophers => %d %d\n", $pid, $pid2)
2641                    if($verbose);
2642                logmsg "GOPHERSPORT => $port\n" if($verbose);
2643                $run{'gophers'}="$pid $pid2";
2644            }
2645        }
2646        elsif($what eq "https-proxy") {
2647            if(!$stunnel) {
2648                # we can't run https-proxy tests without stunnel
2649                return ("no stunnel", 4);
2650            }
2651            if($runcert{'https-proxy'} &&
2652               ($runcert{'https-proxy'} ne $certfile)) {
2653                # stop server when running and using a different cert
2654                if(stopserver('https-proxy')) {
2655                    return ("failed stopping HTTPS-proxy with different cert", 3);
2656                }
2657            }
2658
2659            # we front the http-proxy with stunnel so we need to make sure the
2660            # proxy runs as well
2661            my ($f, $e) = startservers("http-proxy");
2662            if($f) {
2663                return ($f, $e);
2664            }
2665
2666            if(!$run{'https-proxy'}) {
2667                ($serr, $pid, $pid2, $PORT{"httpsproxy"}) =
2668                    runhttpsserver($verbose, "https", "proxy", $certfile);
2669                if($pid <= 0) {
2670                    return ("failed starting HTTPS-proxy (stunnel)", $serr);
2671                }
2672                logmsg sprintf("* pid https-proxy => %d %d\n", $pid, $pid2)
2673                    if($verbose);
2674                $run{'https-proxy'}="$pid $pid2";
2675            }
2676        }
2677        elsif($what eq "httptls") {
2678            if(!$httptlssrv) {
2679                # for now, we can't run http TLS-EXT tests without gnutls-serv
2680                return ("no gnutls-serv (with SRP support)", 4);
2681            }
2682            if($torture && $run{'httptls'} &&
2683               !responsive_httptls_server($verbose, "IPv4")) {
2684                if(stopserver('httptls')) {
2685                    return ("failed stopping unresponsive HTTPTLS server", 3);
2686                }
2687            }
2688            if(!$run{'httptls'}) {
2689                ($serr, $pid, $pid2, $PORT{'httptls'}) =
2690                    runhttptlsserver($verbose, "IPv4");
2691                if($pid <= 0) {
2692                    return ("failed starting HTTPTLS server (gnutls-serv)", $serr);
2693                }
2694                logmsg sprintf("* pid httptls => %d %d\n", $pid, $pid2)
2695                    if($verbose);
2696                $run{'httptls'}="$pid $pid2";
2697            }
2698        }
2699        elsif($what eq "httptls-ipv6") {
2700            if(!$httptlssrv) {
2701                # for now, we can't run http TLS-EXT tests without gnutls-serv
2702                return ("no gnutls-serv", 4);
2703            }
2704            if($torture && $run{'httptls-ipv6'} &&
2705               !responsive_httptls_server($verbose, "ipv6")) {
2706                if(stopserver('httptls-ipv6')) {
2707                    return ("failed stopping unresponsive HTTPTLS-IPv6 server", 3);
2708                }
2709            }
2710            if(!$run{'httptls-ipv6'}) {
2711                ($serr, $pid, $pid2, $PORT{"httptls6"}) =
2712                    runhttptlsserver($verbose, "ipv6");
2713                if($pid <= 0) {
2714                    return ("failed starting HTTPTLS-IPv6 server (gnutls-serv)", $serr);
2715                }
2716                logmsg sprintf("* pid httptls-ipv6 => %d %d\n", $pid, $pid2)
2717                    if($verbose);
2718                $run{'httptls-ipv6'}="$pid $pid2";
2719            }
2720        }
2721        elsif($what eq "tftp") {
2722            if($torture && $run{'tftp'} &&
2723               !responsive_tftp_server("", $verbose)) {
2724                if(stopserver('tftp')) {
2725                    return ("failed stopping unresponsive TFTP server", 3);
2726                }
2727            }
2728            if(!$run{'tftp'}) {
2729                ($serr, $pid, $pid2, $PORT{'tftp'}) =
2730                    runtftpserver("", $verbose);
2731                if($pid <= 0) {
2732                    return ("failed starting TFTP server", $serr);
2733                }
2734                logmsg sprintf("* pid tftp => %d %d\n", $pid, $pid2) if($verbose);
2735                $run{'tftp'}="$pid $pid2";
2736            }
2737        }
2738        elsif($what eq "tftp-ipv6") {
2739            if($torture && $run{'tftp-ipv6'} &&
2740               !responsive_tftp_server("", $verbose, "ipv6")) {
2741                if(stopserver('tftp-ipv6')) {
2742                    return ("failed stopping unresponsive TFTP-IPv6 server", 3);
2743                }
2744            }
2745            if(!$run{'tftp-ipv6'}) {
2746                ($serr, $pid, $pid2, $PORT{'tftp6'}) =
2747                    runtftpserver("", $verbose, "ipv6");
2748                if($pid <= 0) {
2749                    return ("failed starting TFTP-IPv6 server", $serr);
2750                }
2751                logmsg sprintf("* pid tftp-ipv6 => %d %d\n", $pid, $pid2) if($verbose);
2752                $run{'tftp-ipv6'}="$pid $pid2";
2753            }
2754        }
2755        elsif($what eq "sftp" || $what eq "scp") {
2756            if(!$run{'ssh'}) {
2757                ($serr, $pid, $pid2, $PORT{'ssh'}) = runsshserver("", $verbose);
2758                if($pid <= 0) {
2759                    return ("failed starting SSH server", $serr);
2760                }
2761                logmsg sprintf("* pid ssh => %d %d\n", $pid, $pid2) if($verbose);
2762                $run{'ssh'}="$pid $pid2";
2763            }
2764        }
2765        elsif($what eq "socks4" || $what eq "socks5" ) {
2766            if(!$run{'socks'}) {
2767                ($serr, $pid, $pid2, $PORT{"socks"}) = runsocksserver("", $verbose);
2768                if($pid <= 0) {
2769                    return ("failed starting socks server", $serr);
2770                }
2771                logmsg sprintf("* pid socks => %d %d\n", $pid, $pid2) if($verbose);
2772                $run{'socks'}="$pid $pid2";
2773            }
2774        }
2775        elsif($what eq "socks5unix") {
2776            if(!$run{'socks5unix'}) {
2777                ($serr, $pid, $pid2) = runsocksserver("2", $verbose, "", "unix");
2778                if($pid <= 0) {
2779                    return ("failed starting socks5unix server", $serr);
2780                }
2781                logmsg sprintf("* pid socks5unix => %d %d\n", $pid, $pid2) if($verbose);
2782                $run{'socks5unix'}="$pid $pid2";
2783            }
2784        }
2785        elsif($what eq "mqtt" ) {
2786            if(!$run{'mqtt'}) {
2787                ($serr, $pid, $pid2) = runmqttserver("", $verbose);
2788                if($pid <= 0) {
2789                    return ("failed starting mqtt server", $serr);
2790                }
2791                logmsg sprintf("* pid mqtt => %d %d\n", $pid, $pid2) if($verbose);
2792                $run{'mqtt'}="$pid $pid2";
2793            }
2794        }
2795        elsif($what eq "http-unix") {
2796            if($torture && $run{'http-unix'} &&
2797               !responsive_http_server("http", $verbose, "unix", $HTTPUNIXPATH)) {
2798                if(stopserver('http-unix')) {
2799                    return ("failed stopping unresponsive HTTP-unix server", 3);
2800                }
2801            }
2802            if(!$run{'http-unix'}) {
2803                my $unused;
2804                ($serr, $pid, $pid2, $unused) =
2805                    runhttpserver("http", $verbose, "unix", $HTTPUNIXPATH);
2806                if($pid <= 0) {
2807                    return ("failed starting HTTP-unix server", $serr);
2808                }
2809                logmsg sprintf("* pid http-unix => %d %d\n", $pid, $pid2)
2810                    if($verbose);
2811                $run{'http-unix'}="$pid $pid2";
2812            }
2813        }
2814        elsif($what eq "dict") {
2815            if(!$run{'dict'}) {
2816                ($serr, $pid, $pid2, $PORT{"dict"}) = rundictserver($verbose, "");
2817                if($pid <= 0) {
2818                    return ("failed starting DICT server", $serr);
2819                }
2820                logmsg sprintf ("* pid DICT => %d %d\n", $pid, $pid2)
2821                    if($verbose);
2822                $run{'dict'}="$pid $pid2";
2823            }
2824        }
2825        elsif($what eq "smb") {
2826            if(!$run{'smb'}) {
2827                ($serr, $pid, $pid2, $PORT{"smb"}) = runsmbserver($verbose, "");
2828                if($pid <= 0) {
2829                    return ("failed starting SMB server", $serr);
2830                }
2831                logmsg sprintf ("* pid SMB => %d %d\n", $pid, $pid2)
2832                    if($verbose);
2833                $run{'smb'}="$pid $pid2";
2834            }
2835        }
2836        elsif($what eq "telnet") {
2837            if(!$run{'telnet'}) {
2838                ($serr, $pid, $pid2, $PORT{"telnet"}) =
2839                    runnegtelnetserver($verbose, "");
2840                if($pid <= 0) {
2841                    return ("failed starting neg TELNET server", $serr);
2842                }
2843                logmsg sprintf ("* pid neg TELNET => %d %d\n", $pid, $pid2)
2844                    if($verbose);
2845                $run{'telnet'}="$pid $pid2";
2846            }
2847        }
2848        elsif($what eq "none") {
2849            logmsg "* starts no server\n" if ($verbose);
2850        }
2851        else {
2852            warn "we don't support a server for $what";
2853            return ("no server for $what", 4);
2854        }
2855    }
2856    return ("", 0);
2857}
2858
2859#######################################################################
2860# Stop all running test servers
2861#
2862sub stopservers {
2863    my $verb = $_[0];
2864    #
2865    # kill sockfilter processes for all pingpong servers
2866    #
2867    killallsockfilters("$LOGDIR/$PIDDIR", $verb);
2868    #
2869    # kill all server pids from %run hash clearing them
2870    #
2871    my $pidlist;
2872    foreach my $server (keys %run) {
2873        if($run{$server}) {
2874            if($verb) {
2875                my $prev = 0;
2876                my $pids = $run{$server};
2877                foreach my $pid (split(' ', $pids)) {
2878                    if($pid != $prev) {
2879                        logmsg sprintf("* kill pid for %s => %d\n",
2880                            $server, $pid);
2881                        $prev = $pid;
2882                    }
2883                }
2884            }
2885            $pidlist .= "$run{$server} ";
2886            $run{$server} = 0;
2887        }
2888        $runcert{$server} = 0 if($runcert{$server});
2889    }
2890    killpid($verb, $pidlist);
2891    #
2892    # cleanup all server pid files
2893    #
2894    my $result = 0;
2895    foreach my $server (keys %serverpidfile) {
2896        my $pidfile = $serverpidfile{$server};
2897        my $pid = processexists($pidfile);
2898        if($pid > 0) {
2899            if($err_unexpected) {
2900                logmsg "ERROR: ";
2901                $result = -1;
2902            }
2903            else {
2904                logmsg "Warning: ";
2905            }
2906            logmsg "$server server unexpectedly alive\n";
2907            killpid($verb, $pid);
2908        }
2909        unlink($pidfile) if(-f $pidfile);
2910    }
2911
2912    return $result;
2913}
2914
2915
2916#######################################################################
2917# substitute the variable stuff into either a joined up file or
2918# a command, in either case passed by reference
2919#
2920sub subvariables {
2921    my ($thing, $testnum, $prefix) = @_;
2922    my $port;
2923
2924    if(!$prefix) {
2925        $prefix = "%";
2926    }
2927
2928    # test server ports
2929    # Substitutes variables like %HTTPPORT and %SMTP6PORT with the server ports
2930    foreach my $proto ('DICT',
2931                       'FTP', 'FTP6', 'FTPS',
2932                       'GOPHER', 'GOPHER6', 'GOPHERS',
2933                       'HTTP', 'HTTP6', 'HTTPS',
2934                       'HTTPSPROXY', 'HTTPTLS', 'HTTPTLS6',
2935                       'HTTP2', 'HTTP2TLS',
2936                       'HTTP3',
2937                       'IMAP', 'IMAP6', 'IMAPS',
2938                       'MQTT',
2939                       'NOLISTEN',
2940                       'POP3', 'POP36', 'POP3S',
2941                       'RTSP', 'RTSP6',
2942                       'SMB', 'SMBS',
2943                       'SMTP', 'SMTP6', 'SMTPS',
2944                       'SOCKS',
2945                       'SSH',
2946                       'TELNET',
2947                       'TFTP', 'TFTP6') {
2948        $port = protoport(lc $proto);
2949        $$thing =~ s/${prefix}(?:$proto)PORT/$port/g;
2950    }
2951    # Special case: for PROXYPORT substitution, use httpproxy.
2952    $port = protoport('httpproxy');
2953    $$thing =~ s/${prefix}PROXYPORT/$port/g;
2954
2955    # server Unix domain socket paths
2956    $$thing =~ s/${prefix}HTTPUNIXPATH/$HTTPUNIXPATH/g;
2957    $$thing =~ s/${prefix}SOCKSUNIXPATH/$SOCKSUNIXPATH/g;
2958
2959    # client IP addresses
2960    $$thing =~ s/${prefix}CLIENT6IP/$CLIENT6IP/g;
2961    $$thing =~ s/${prefix}CLIENTIP/$CLIENTIP/g;
2962
2963    # server IP addresses
2964    $$thing =~ s/${prefix}HOST6IP/$HOST6IP/g;
2965    $$thing =~ s/${prefix}HOSTIP/$HOSTIP/g;
2966
2967    # misc
2968    $$thing =~ s/${prefix}CURL/$CURL/g;
2969    $$thing =~ s/${prefix}LOGDIR/$LOGDIR/g;
2970    $$thing =~ s/${prefix}PWD/$pwd/g;
2971    $$thing =~ s/${prefix}POSIX_PWD/$posix_pwd/g;
2972    $$thing =~ s/${prefix}VERSION/$CURLVERSION/g;
2973    $$thing =~ s/${prefix}TESTNUMBER/$testnum/g;
2974
2975    my $file_pwd = $pwd;
2976    if($file_pwd !~ /^\//) {
2977        $file_pwd = "/$file_pwd";
2978    }
2979    my $ssh_pwd = $posix_pwd;
2980    # this only works after the SSH server has been started
2981    # TODO: call sshversioninfo early and store $sshdid so this substitution
2982    # always works
2983    if ($sshdid && $sshdid =~ /OpenSSH-Windows/) {
2984        $ssh_pwd = $file_pwd;
2985    }
2986
2987    $$thing =~ s/${prefix}FILE_PWD/$file_pwd/g;
2988    $$thing =~ s/${prefix}SSH_PWD/$ssh_pwd/g;
2989    $$thing =~ s/${prefix}SRCDIR/$srcdir/g;
2990    $$thing =~ s/${prefix}USER/$USER/g;
2991
2992    $$thing =~ s/${prefix}SSHSRVMD5/$SSHSRVMD5/g;
2993    $$thing =~ s/${prefix}SSHSRVSHA256/$SSHSRVSHA256/g;
2994
2995    # The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be
2996    # used for time-out tests and that would work on most hosts as these
2997    # adjust for the startup/check time for this particular host. We needed to
2998    # do this to make the test suite run better on very slow hosts.
2999    my $ftp2 = $ftpchecktime * 8;
3000    my $ftp3 = $ftpchecktime * 12;
3001
3002    $$thing =~ s/${prefix}FTPTIME2/$ftp2/g;
3003    $$thing =~ s/${prefix}FTPTIME3/$ftp3/g;
3004
3005    # HTTP2
3006    $$thing =~ s/${prefix}H2CVER/$h2cver/g;
3007}
3008
3009
30101;
3011