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