luna - curl/tests/servers.pm

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