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