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