use MIME::Base64;
use List::Util 'sum';
-# Subs imported from serverhelp module
-use serverhelp qw(
- serverfactors
- servername_id
- servername_str
- servername_canon
- server_pidfilename
- server_portfilename
- server_logfilename
+use pathhelp qw(
+ exe_ext
+ sys_native_current_path
);
-
-# Variables and subs imported from sshhelp module
-use sshhelp qw(
- $hstpubmd5f
- $hstpubsha256f
- $sshexe
- $sftpexe
- $sftpconfig
- $sshdlog
- $sftplog
- $sftpcmds
- display_sshdconfig
- display_sftpconfig
- display_sshdlog
- display_sftplog
- find_sshd
- find_ssh
- find_sftp
- find_httptlssrv
- sshversioninfo
+use processhelp qw(
+ portable_sleep
);
use appveyor;
use azure;
use getpart; # array functions
-use pathhelp;
-use processhelp;
+use servers;
use valgrind; # valgrind report parser
+use globalconfig;
-my $HOSTIP="127.0.0.1"; # address on which the test server listens
-my $HOST6IP="[::1]"; # address on which the test server listens
my $CLIENTIP="127.0.0.1"; # address which curl uses for incoming connections
my $CLIENT6IP="[::1]"; # address which curl uses for incoming connections
-my %PORT = (nolisten => 47); # port we use for a local non-listening service
-my $HTTPUNIXPATH; # HTTP server Unix domain socket path
-my $SOCKSUNIXPATH; # socks server Unix domain socket path
-
my $use_external_proxy = 0;
-my $proxy_address;
my %custom_skip_reasons;
-my $SSHSRVMD5 = "[uninitialized]"; # MD5 of ssh server public key
-my $SSHSRVSHA256 = "[uninitialized]"; # SHA256 of ssh server public key
my $CURLVERSION=""; # curl's reported version number
-my $srcdir = $ENV{'srcdir'} || '.';
-my $CURL="../src/curl".exe_ext('TOOL'); # what curl binary to run on the tests
-my $VCURL=$CURL; # what curl binary to use to verify the servers with
- # VCURL is handy to set to the system one when the one you
- # just built hangs or crashes and thus prevent verification
my $ACURL=$VCURL; # what curl binary to use to talk to APIs (relevant for CI)
# ACURL is handy to set to the system one for reliability
my $DBGCURL=$CURL; #"../src/.libs/curl"; # alternative for debugging
my $TESTDIR="$srcdir/data";
my $LIBDIR="./libtest";
my $UNITDIR="./unit";
-my $LOGDIR="log";
# TODO: $LOGDIR could eventually change later on, so must regenerate all the
# paths depending on it after $LOGDIR itself changes.
-my $PIDDIR = "$LOGDIR/server";
# TODO: change this to use server_inputfilename()
my $SERVERIN="$LOGDIR/server.input"; # what curl sent the server
my $SERVER2IN="$LOGDIR/server2.input"; # what curl sent the second server
my $PROXYIN="$LOGDIR/proxy.input"; # what curl sent the proxy
-my $SOCKSIN="$LOGDIR/socksd-request.log"; # what curl sent to the SOCKS proxy
my $CURLLOG="$LOGDIR/commands.log"; # all command lines run
-my $FTPDCMD="$LOGDIR/ftpserver.cmd"; # copy server instructions here
my $SERVERLOGS_LOCK="$LOGDIR/serverlogs.lock"; # server logs advisor read lock
my $CURLCONFIG="../curl-config"; # curl-config from current build
# No variables below this point should need to be modified
#
-# invoke perl like this:
-my $perl="perl -I$srcdir";
-my $server_response_maxtime=13;
-
my $libtool;
my $repeat = 0;
my $posix_pwd = $pwd;
my $start; # time at which testing started
-my $ftpchecktime=1; # time it took to verify our test FTP server
-my $stunnel = checkcmd("stunnel4") || checkcmd("tstunnel") || checkcmd("stunnel");
my $valgrind = checktestcmd("valgrind");
my $valgrind_logfile="--logfile"; # the option name for valgrind 2.X
my $valgrind_tool;
my $gdb = checktestcmd("gdb");
-my $httptlssrv = find_httptlssrv();
my $uname_release = `uname -r`;
my $is_wsl = $uname_release =~ /Microsoft$/;
my $has_textaware; # set if running on a system that has a text mode concept
# on files. Windows for example
-my @protocols; # array of lowercase supported protocol servers
my %skipped; # skipped{reason}=counter, reasons for skip
my @teststat; # teststat[testnum]=reason, reasons for skip
my %enabled_keywords; # key words of tests to run
my %disabled; # disabled test cases
my %ignored; # ignored results of test cases
-my $sshdid; # for socks server, ssh daemon version id
-my $sshdvernum; # for socks server, ssh daemon version number
-my $sshdverstr; # for socks server, ssh daemon version string
-my $sshderror; # for socks server, ssh daemon version error
my $defserverlogslocktimeout = 2; # timeout to await server logs lock removal
my $defpostcommanddelay = 0; # delay between command and postcheck sections
my %timesrvrlog; # timestamp for each test server logs lock removal
my %timevrfyend; # timestamp for each test result verification end
-my $testnumcheck; # test number, set in singletest sub.
my %oldenv; # environment variables before test is started
my %feature; # array of enabled features
my %keywords; # array of keywords from the test spec
my $short;
my $automakestyle;
-my $verbose;
-my $debugprotocol;
my $no_debuginfod;
my $anyway;
my $gdbthis; # run test case with gdb debugger
my $clearlocks; # force removal of files by killing locking processes
my $listonly; # only list the tests
my $postmortem; # display detailed info about failed tests
-my $err_unexpected; # error instead of warning on server unexpectedly alive
my $run_event_based; # run curl with --test-event to test the event API
my $run_disabled; # run the specific tests even if listed in DISABLED
my $scrambleorder;
-my %run; # running server
-my %doesntrun; # servers that don't work, identified by pidfile
-my %serverpidfile;# all server pid file names, identified by server id
-my %serverportfile;# all server port file names, identified by server id
-my %runcert; # cert file currently in use by an ssl running server
-
# torture test variables
-my $torture;
my $tortalloc;
my $shallow;
my $randseed = 0;
}
}
-# get the name of the current user
-my $USER = $ENV{USER}; # Linux
-if (!$USER) {
- $USER = $ENV{USERNAME}; # Windows
- if (!$USER) {
- $USER = $ENV{LOGNAME}; # Some Unix (I think)
- }
-}
-
# enable memory debugging if curl is compiled with it
$ENV{'CURL_MEMDEBUG'} = $memdump;
$ENV{'CURL_ENTROPY'}="12345678";
}
-#######################################################################
-# Load serverpidfile and serverportfile hashes with file names for all
-# possible servers.
-#
-sub init_serverpidfile_hash {
- for my $proto (('ftp', 'gopher', 'http', 'imap', 'pop3', 'smtp', 'http/2', 'http/3')) {
- for my $ssl (('', 's')) {
- for my $ipvnum ((4, 6)) {
- for my $idnum ((1, 2, 3)) {
- my $serv = servername_id("$proto$ssl", $ipvnum, $idnum);
- my $pidf = server_pidfilename($PIDDIR, "$proto$ssl", $ipvnum, $idnum);
- $serverpidfile{$serv} = $pidf;
- my $portf = server_portfilename($PIDDIR, "$proto$ssl", $ipvnum, $idnum);
- $serverportfile{$serv} = $portf;
- }
- }
- }
- }
- for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'httptls',
- 'dict', 'smb', 'smbs', 'telnet', 'mqtt')) {
- for my $ipvnum ((4, 6)) {
- for my $idnum ((1, 2)) {
- my $serv = servername_id($proto, $ipvnum, $idnum);
- my $pidf = server_pidfilename($PIDDIR, $proto, $ipvnum, $idnum);
- $serverpidfile{$serv} = $pidf;
- my $portf = server_portfilename($PIDDIR, $proto, $ipvnum, $idnum);
- $serverportfile{$serv} = $portf;
- }
- }
- }
- for my $proto (('http', 'imap', 'pop3', 'smtp', 'http/2', 'http/3')) {
- for my $ssl (('', 's')) {
- my $serv = servername_id("$proto$ssl", "unix", 1);
- my $pidf = server_pidfilename($PIDDIR, "$proto$ssl", "unix", 1);
- $serverpidfile{$serv} = $pidf;
- my $portf = server_portfilename($PIDDIR, "$proto$ssl", "unix", 1);
- $serverportfile{$serv} = $portf;
- }
- }
-}
-
-#######################################################################
-# Check if a given child process has just died. Reaps it if so.
-#
-sub checkdied {
- my $pid = $_[0];
- if((not defined $pid) || $pid <= 0) {
- return 0;
- }
- use POSIX ":sys_wait_h";
- my $rc = pidwait($pid, &WNOHANG);
- return ($rc == $pid)?1:0;
-}
-
-#######################################################################
-# Start a new thread/process and run the given command line in there.
-# Return the pids (yes plural) of the new child process to the parent.
-#
-sub startnew {
- my ($cmd, $pidfile, $timeout, $fakepidfile)=@_;
-
- logmsg "startnew: $cmd\n" if ($verbose);
-
- my $child = fork();
-
- if(not defined $child) {
- logmsg "startnew: fork() failure detected\n";
- return (-1,-1);
- }
-
- if(0 == $child) {
- # Here we are the child. Run the given command.
-
- # Flush output.
- $| = 1;
-
- # Put an "exec" in front of the command so that the child process
- # keeps this child's process ID.
- exec("exec $cmd") || die "Can't exec() $cmd: $!";
-
- # exec() should never return back here to this process. We protect
- # ourselves by calling die() just in case something goes really bad.
- die "error: exec() has returned";
- }
-
- # Ugly hack but ssh client and gnutls-serv don't support pid files
- if ($fakepidfile) {
- if(open(my $out, ">", "$pidfile")) {
- print $out $child . "\n";
- close($out) || die "Failure writing pidfile";
- logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose);
- }
- else {
- logmsg "startnew: failed to write fake $pidfile with pid=$child\n";
- }
- # could/should do a while connect fails sleep a bit and loop
- portable_sleep($timeout);
- if (checkdied($child)) {
- logmsg "startnew: child process has failed to start\n" if($verbose);
- return (-1,-1);
- }
- }
-
- my $pid2 = 0;
- my $count = $timeout;
- while($count--) {
- $pid2 = pidfromfile($pidfile);
- if(($pid2 > 0) && pidexists($pid2)) {
- # if $pid2 is valid, then make sure this pid is alive, as
- # otherwise it is just likely to be the _previous_ pidfile or
- # similar!
- last;
- }
- if (checkdied($child)) {
- logmsg "startnew: child process has died, server might start up\n"
- if($verbose);
- # We can't just abort waiting for the server with a
- # return (-1,-1);
- # because the server might have forked and could still start
- # up normally. Instead, just reduce the amount of time we remain
- # waiting.
- $count >>= 2;
- }
- sleep(1);
- }
-
- # Return two PIDs, the one for the child process we spawned and the one
- # reported by the server itself (in case it forked again on its own).
- # Both (potentially) need to be killed at the end of the test.
- return ($child, $pid2);
-}
-
-
-#######################################################################
-# Check for a command in the PATH of the test server.
-#
-sub checkcmd {
- my ($cmd, @extrapaths)=@_;
- my @paths=(split(m/[:]/, $ENV{'PATH'}), "/usr/sbin", "/usr/local/sbin",
- "/sbin", "/usr/bin", "/usr/local/bin", @extrapaths);
- for(@paths) {
- if( -x "$_/$cmd" && ! -d "$_/$cmd") {
- # executable bit but not a directory!
- return "$_/$cmd";
- }
- }
- return "";
-}
-
#######################################################################
# Get the list of tests that the tests/data/Makefile.am knows about!
#
}
$fail = 1;
}
- }
-
- # verify that it returns a proper error code, doesn't leak memory
- # and doesn't core dump
- if(($ret & 255) || ($ret >> 8) >= 128) {
- logmsg " system() returned $ret\n";
- $fail=1;
- }
- else {
- my @memdata=`$memanalyze $memdump`;
- my $leak=0;
- for(@memdata) {
- if($_ ne "") {
- # well it could be other memory problems as well, but
- # we call it leak for short here
- $leak=1;
- }
- }
- if($leak) {
- logmsg "** MEMORY FAILURE\n";
- logmsg @memdata;
- logmsg `$memanalyze -l $memdump`;
- $fail = 1;
- }
- }
- if($fail) {
- logmsg " Failed on function number $limit in test.\n",
- " invoke with \"-t$limit\" to repeat this single case.\n";
- stopservers($verbose);
- return 1;
- }
- }
-
- logmsg "torture OK\n";
- return 0;
-}
-
-#######################################################################
-# Return the port to use for the given protocol.
-#
-sub protoport {
- my ($proto) = @_;
- return $PORT{$proto} || "[not running]";
-}
-
-#######################################################################
-# Stop a test server along with pids which aren't in the %run hash yet.
-# This also stops all servers which are relative to the given one.
-#
-sub stopserver {
- my ($server, $pidlist) = @_;
-
- #
- # kill sockfilter processes for pingpong relative server
- #
- if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
- my $proto = $1;
- my $idnum = ($2 && ($2 > 1)) ? $2 : 1;
- my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
- killsockfilters($PIDDIR, $proto, $ipvnum, $idnum, $verbose);
- }
- #
- # All servers relative to the given one must be stopped also
- #
- my @killservers;
- if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
- # given a stunnel based ssl server, also kill non-ssl underlying one
- push @killservers, "${1}${2}";
- }
- elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|-unix|))$/) {
- # given a non-ssl server, also kill stunnel based ssl piggybacking one
- push @killservers, "${1}s${2}";
- }
- elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
- # given a socks server, also kill ssh underlying one
- push @killservers, "ssh${2}";
- }
- elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
- # given a ssh server, also kill socks piggybacking one
- push @killservers, "socks${2}";
- }
- if($server eq "http" or $server eq "https") {
- # since the http2+3 server is a proxy that needs to know about the
- # dynamic http port it too needs to get restarted when the http server
- # is killed
- push @killservers, "http/2";
- push @killservers, "http/3";
- }
- push @killservers, $server;
- #
- # kill given pids and server relative ones clearing them in %run hash
- #
- foreach my $server (@killservers) {
- if($run{$server}) {
- # we must prepend a space since $pidlist may already contain a pid
- $pidlist .= " $run{$server}";
- $run{$server} = 0;
- }
- $runcert{$server} = 0 if($runcert{$server});
- }
- killpid($verbose, $pidlist);
- #
- # cleanup server pid files
- #
- my $result = 0;
- foreach my $server (@killservers) {
- my $pidfile = $serverpidfile{$server};
- my $pid = processexists($pidfile);
- if($pid > 0) {
- if($err_unexpected) {
- logmsg "ERROR: ";
- $result = -1;
- }
- else {
- logmsg "Warning: ";
- }
- logmsg "$server server unexpectedly alive\n";
- killpid($verbose, $pid);
- }
- unlink($pidfile) if(-f $pidfile);
- }
-
- return $result;
-}
-
-#######################################################################
-# Return flags to let curl use an external HTTP proxy
-#
-sub getexternalproxyflags {
- return " --proxy $proxy_address ";
-}
-
-#######################################################################
-# Verify that the server that runs on $ip, $port is our server. This also
-# implies that we can speak with it, as there might be occasions when the
-# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
-# assign requested address")
-#
-sub verifyhttp {
- my ($proto, $ipvnum, $idnum, $ip, $port_or_path) = @_;
- my $server = servername_id($proto, $ipvnum, $idnum);
- my $bonus="";
- # $port_or_path contains a path for Unix sockets, sws ignores the port
- my $port = ($ipvnum eq "unix") ? 80 : $port_or_path;
-
- my $verifyout = "$LOGDIR/".
- servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
- unlink($verifyout) if(-f $verifyout);
-
- my $verifylog = "$LOGDIR/".
- servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
- unlink($verifylog) if(-f $verifylog);
-
- if($proto eq "gopher") {
- # gopher is funny
- $bonus="1/";
- }
-
- my $flags = "--max-time $server_response_maxtime ";
- $flags .= "--output $verifyout ";
- $flags .= "--silent ";
- $flags .= "--verbose ";
- $flags .= "--globoff ";
- $flags .= "--unix-socket '$port_or_path' " if $ipvnum eq "unix";
- $flags .= "--insecure " if($proto eq 'https');
- if($use_external_proxy) {
- $flags .= getexternalproxyflags();
- }
- $flags .= "\"$proto://$ip:$port/${bonus}verifiedserver\"";
-
- my $cmd = "$VCURL $flags 2>$verifylog";
-
- # verify if our/any server is running on this port
- logmsg "RUN: $cmd\n" if($verbose);
- my $res = runclient($cmd);
-
- $res >>= 8; # rotate the result
- if($res & 128) {
- logmsg "RUN: curl command died with a coredump\n";
- return -1;
- }
-
- if($res && $verbose) {
- logmsg "RUN: curl command returned $res\n";
- if(open(my $file, "<", "$verifylog")) {
- while(my $string = <$file>) {
- logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
- }
- close($file);
- }
- }
-
- my $data;
- if(open(my $file, "<", "$verifyout")) {
- while(my $string = <$file>) {
- $data = $string;
- last; # only want first line
- }
- close($file);
- }
-
- my $pid = 0;
- if($data && ($data =~ /WE ROOLZ: (\d+)/)) {
- $pid = 0+$1;
- }
- elsif($res == 6) {
- # curl: (6) Couldn't resolve host '::1'
- logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
- return -1;
- }
- elsif($data || ($res && ($res != 7))) {
- logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
- return -1;
- }
- return $pid;
-}
-
-#######################################################################
-# Verify that the server that runs on $ip, $port is our server. This also
-# implies that we can speak with it, as there might be occasions when the
-# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
-# assign requested address")
-#
-sub verifyftp {
- my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
- my $server = servername_id($proto, $ipvnum, $idnum);
- my $time=time();
- my $extra="";
-
- my $verifylog = "$LOGDIR/".
- servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
- unlink($verifylog) if(-f $verifylog);
-
- if($proto eq "ftps") {
- $extra .= "--insecure --ftp-ssl-control ";
- }
-
- my $flags = "--max-time $server_response_maxtime ";
- $flags .= "--silent ";
- $flags .= "--verbose ";
- $flags .= "--globoff ";
- $flags .= $extra;
- if($use_external_proxy) {
- $flags .= getexternalproxyflags();
- }
- $flags .= "\"$proto://$ip:$port/verifiedserver\"";
-
- my $cmd = "$VCURL $flags 2>$verifylog";
-
- # check if this is our server running on this port:
- logmsg "RUN: $cmd\n" if($verbose);
- my @data = runclientoutput($cmd);
-
- my $res = $? >> 8; # rotate the result
- if($res & 128) {
- logmsg "RUN: curl command died with a coredump\n";
- return -1;
- }
-
- my $pid = 0;
- foreach my $line (@data) {
- if($line =~ /WE ROOLZ: (\d+)/) {
- # this is our test server with a known pid!
- $pid = 0+$1;
- last;
- }
- }
- if($pid <= 0 && @data && $data[0]) {
- # this is not a known server
- logmsg "RUN: Unknown server on our $server port: $port\n";
- return 0;
- }
- # we can/should use the time it took to verify the FTP server as a measure
- # on how fast/slow this host/FTP is.
- my $took = int(0.5+time()-$time);
-
- if($verbose) {
- logmsg "RUN: Verifying our test $server server took $took seconds\n";
- }
- $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
-
- return $pid;
-}
-
-#######################################################################
-# Verify that the server that runs on $ip, $port is our server. This also
-# implies that we can speak with it, as there might be occasions when the
-# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
-# assign requested address")
-#
-sub verifyrtsp {
- my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $verifyout = "$LOGDIR/".
- servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
- unlink($verifyout) if(-f $verifyout);
-
- my $verifylog = "$LOGDIR/".
- servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
- unlink($verifylog) if(-f $verifylog);
-
- my $flags = "--max-time $server_response_maxtime ";
- $flags .= "--output $verifyout ";
- $flags .= "--silent ";
- $flags .= "--verbose ";
- $flags .= "--globoff ";
- if($use_external_proxy) {
- $flags .= getexternalproxyflags();
- }
- # currently verification is done using http
- $flags .= "\"http://$ip:$port/verifiedserver\"";
-
- my $cmd = "$VCURL $flags 2>$verifylog";
-
- # verify if our/any server is running on this port
- logmsg "RUN: $cmd\n" if($verbose);
- my $res = runclient($cmd);
-
- $res >>= 8; # rotate the result
- if($res & 128) {
- logmsg "RUN: curl command died with a coredump\n";
- return -1;
- }
-
- if($res && $verbose) {
- logmsg "RUN: curl command returned $res\n";
- if(open(my $file, "<", "$verifylog")) {
- while(my $string = <$file>) {
- logmsg "RUN: $string" if($string !~ /^[ \t]*$/);
- }
- close($file);
- }
- }
-
- my $data;
- if(open(my $file, "<", "$verifyout")) {
- while(my $string = <$file>) {
- $data = $string;
- last; # only want first line
- }
- close($file);
- }
-
- my $pid = 0;
- if($data && ($data =~ /RTSP_SERVER WE ROOLZ: (\d+)/)) {
- $pid = 0+$1;
- }
- elsif($res == 6) {
- # curl: (6) Couldn't resolve host '::1'
- logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
- return -1;
- }
- elsif($data || ($res != 7)) {
- logmsg "RUN: Unknown server on our $server port: $port\n";
- return -1;
- }
- return $pid;
-}
-
-#######################################################################
-# Verify that the ssh server has written out its pidfile, recovering
-# the pid from the file and returning it if a process with that pid is
-# actually alive, or a negative value if the process is dead.
-#
-sub verifyssh {
- my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
- my $pidfile = server_pidfilename($PIDDIR, $proto, $ipvnum, $idnum);
- my $pid = processexists($pidfile);
- if($pid < 0) {
- logmsg "RUN: SSH server has died after starting up\n";
- }
- return $pid;
-}
-
-#######################################################################
-# Verify that we can connect to the sftp server, properly authenticate
-# with generated config and key files and run a simple remote pwd.
-#
-sub verifysftp {
- my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
- my $server = servername_id($proto, $ipvnum, $idnum);
- my $verified = 0;
- # Find out sftp client canonical file name
- my $sftp = find_sftp();
- if(!$sftp) {
- logmsg "RUN: SFTP server cannot find $sftpexe\n";
- return -1;
- }
- # Find out ssh client canonical file name
- my $ssh = find_ssh();
- if(!$ssh) {
- logmsg "RUN: SFTP server cannot find $sshexe\n";
- return -1;
- }
- # Connect to sftp server, authenticate and run a remote pwd
- # command using our generated configuration and key files
- my $cmd = "\"$sftp\" -b $PIDDIR/$sftpcmds -F $PIDDIR/$sftpconfig -S \"$ssh\" $ip > $sftplog 2>&1";
- my $res = runclient($cmd);
- # Search for pwd command response in log file
- if(open(my $sftplogfile, "<", "$sftplog")) {
- while(<$sftplogfile>) {
- if(/^Remote working directory: /) {
- $verified = 1;
- last;
- }
- }
- close($sftplogfile);
- }
- return $verified;
-}
-
-#######################################################################
-# Verify that the non-stunnel HTTP TLS extensions capable server that runs
-# on $ip, $port is our server. This also implies that we can speak with it,
-# as there might be occasions when the server runs fine but we cannot talk
-# to it ("Failed to connect to ::1: Can't assign requested address")
-#
-sub verifyhttptls {
- my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
- my $server = servername_id($proto, $ipvnum, $idnum);
- my $pidfile = server_pidfilename($PIDDIR, $proto, $ipvnum, $idnum);
-
- my $verifyout = "$LOGDIR/".
- servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
- unlink($verifyout) if(-f $verifyout);
-
- my $verifylog = "$LOGDIR/".
- servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
- unlink($verifylog) if(-f $verifylog);
-
- my $flags = "--max-time $server_response_maxtime ";
- $flags .= "--output $verifyout ";
- $flags .= "--verbose ";
- $flags .= "--globoff ";
- $flags .= "--insecure ";
- $flags .= "--tlsauthtype SRP ";
- $flags .= "--tlsuser jsmith ";
- $flags .= "--tlspassword abc ";
- if($use_external_proxy) {
- $flags .= getexternalproxyflags();
- }
- $flags .= "\"https://$ip:$port/verifiedserver\"";
-
- my $cmd = "$VCURL $flags 2>$verifylog";
-
- # verify if our/any server is running on this port
- logmsg "RUN: $cmd\n" if($verbose);
- my $res = runclient($cmd);
-
- $res >>= 8; # rotate the result
- if($res & 128) {
- logmsg "RUN: curl command died with a coredump\n";
- return -1;
- }
-
- if($res && $verbose) {
- logmsg "RUN: curl command returned $res\n";
- if(open(my $file, "<", "$verifylog")) {
- while(my $string = <$file>) {
- logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
- }
- close($file);
- }
- }
-
- my $data;
- if(open(my $file, "<", "$verifyout")) {
- while(my $string = <$file>) {
- $data .= $string;
- }
- close($file);
- }
-
- my $pid = 0;
- if($data && ($data =~ /(GNUTLS|GnuTLS)/) && ($pid = processexists($pidfile))) {
- if($pid < 0) {
- logmsg "RUN: $server server has died after starting up\n";
- }
- return $pid;
- }
- elsif($res == 6) {
- # curl: (6) Couldn't resolve host '::1'
- logmsg "RUN: failed to resolve host (https://$ip:$port/verifiedserver)\n";
- return -1;
- }
- elsif($data || ($res && ($res != 7))) {
- logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
- return -1;
- }
- return $pid;
-}
-
-#######################################################################
-# STUB for verifying socks
-#
-sub verifysocks {
- my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
- my $pidfile = server_pidfilename($PIDDIR, $proto, $ipvnum, $idnum);
- my $pid = processexists($pidfile);
- if($pid < 0) {
- logmsg "RUN: SOCKS server has died after starting up\n";
- }
- return $pid;
-}
-
-#######################################################################
-# Verify that the server that runs on $ip, $port is our server. This also
-# implies that we can speak with it, as there might be occasions when the
-# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
-# assign requested address")
-#
-sub verifysmb {
- my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
- my $server = servername_id($proto, $ipvnum, $idnum);
- my $time=time();
- my $extra="";
-
- my $verifylog = "$LOGDIR/".
- servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
- unlink($verifylog) if(-f $verifylog);
-
- my $flags = "--max-time $server_response_maxtime ";
- $flags .= "--silent ";
- $flags .= "--verbose ";
- $flags .= "--globoff ";
- $flags .= "-u 'curltest:curltest' ";
- $flags .= $extra;
- $flags .= "\"$proto://$ip:$port/SERVER/verifiedserver\"";
-
- my $cmd = "$VCURL $flags 2>$verifylog";
-
- # check if this is our server running on this port:
- logmsg "RUN: $cmd\n" if($verbose);
- my @data = runclientoutput($cmd);
-
- my $res = $? >> 8; # rotate the result
- if($res & 128) {
- logmsg "RUN: curl command died with a coredump\n";
- return -1;
- }
-
- my $pid = 0;
- foreach my $line (@data) {
- if($line =~ /WE ROOLZ: (\d+)/) {
- # this is our test server with a known pid!
- $pid = 0+$1;
- last;
- }
- }
- if($pid <= 0 && @data && $data[0]) {
- # this is not a known server
- logmsg "RUN: Unknown server on our $server port: $port\n";
- return 0;
- }
- # we can/should use the time it took to verify the server as a measure
- # on how fast/slow this host is.
- my $took = int(0.5+time()-$time);
-
- if($verbose) {
- logmsg "RUN: Verifying our test $server server took $took seconds\n";
- }
- $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
-
- return $pid;
-}
-
-#######################################################################
-# Verify that the server that runs on $ip, $port is our server. This also
-# implies that we can speak with it, as there might be occasions when the
-# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
-# assign requested address")
-#
-sub verifytelnet {
- my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
- my $server = servername_id($proto, $ipvnum, $idnum);
- my $time=time();
- my $extra="";
-
- my $verifylog = "$LOGDIR/".
- servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
- unlink($verifylog) if(-f $verifylog);
-
- my $flags = "--max-time $server_response_maxtime ";
- $flags .= "--silent ";
- $flags .= "--verbose ";
- $flags .= "--globoff ";
- $flags .= "--upload-file - ";
- $flags .= $extra;
- $flags .= "\"$proto://$ip:$port\"";
-
- my $cmd = "echo 'verifiedserver' | $VCURL $flags 2>$verifylog";
-
- # check if this is our server running on this port:
- logmsg "RUN: $cmd\n" if($verbose);
- my @data = runclientoutput($cmd);
-
- my $res = $? >> 8; # rotate the result
- if($res & 128) {
- logmsg "RUN: curl command died with a coredump\n";
- return -1;
- }
-
- my $pid = 0;
- foreach my $line (@data) {
- if($line =~ /WE ROOLZ: (\d+)/) {
- # this is our test server with a known pid!
- $pid = 0+$1;
- last;
- }
- }
- if($pid <= 0 && @data && $data[0]) {
- # this is not a known server
- logmsg "RUN: Unknown server on our $server port: $port\n";
- return 0;
- }
- # we can/should use the time it took to verify the server as a measure
- # on how fast/slow this host is.
- my $took = int(0.5+time()-$time);
-
- if($verbose) {
- logmsg "RUN: Verifying our test $server server took $took seconds\n";
- }
-
- return $pid;
-}
-
-
-#######################################################################
-# Verify that the server that runs on $ip, $port is our server.
-# Retry over several seconds before giving up. The ssh server in
-# particular can take a long time to start if it needs to generate
-# keys on a slow or loaded host.
-#
-# Just for convenience, test harness uses 'https' and 'httptls' literals
-# as values for 'proto' variable in order to differentiate different
-# servers. 'https' literal is used for stunnel based https test servers,
-# and 'httptls' is used for non-stunnel https test servers.
-#
-
-my %protofunc = ('http' => \&verifyhttp,
- 'https' => \&verifyhttp,
- 'rtsp' => \&verifyrtsp,
- 'ftp' => \&verifyftp,
- 'pop3' => \&verifyftp,
- 'imap' => \&verifyftp,
- 'smtp' => \&verifyftp,
- 'ftps' => \&verifyftp,
- 'pop3s' => \&verifyftp,
- 'imaps' => \&verifyftp,
- 'smtps' => \&verifyftp,
- 'tftp' => \&verifyftp,
- 'ssh' => \&verifyssh,
- 'socks' => \&verifysocks,
- 'socks5unix' => \&verifysocks,
- 'gopher' => \&verifyhttp,
- 'httptls' => \&verifyhttptls,
- 'dict' => \&verifyftp,
- 'smb' => \&verifysmb,
- 'telnet' => \&verifytelnet);
-
-sub verifyserver {
- my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
-
- my $count = 30; # try for this many seconds
- my $pid;
-
- while($count--) {
- my $fun = $protofunc{$proto};
-
- $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
-
- if($pid > 0) {
- last;
- }
- elsif($pid < 0) {
- # a real failure, stop trying and bail out
- return 0;
- }
- sleep(1);
- }
- return $pid;
-}
-
-#######################################################################
-# Single shot server responsiveness test. This should only be used
-# to verify that a server present in %run hash is still functional
-#
-sub responsiveserver {
- my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
- my $prev_verbose = $verbose;
-
- $verbose = 0;
- my $fun = $protofunc{$proto};
- my $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
- $verbose = $prev_verbose;
-
- if($pid > 0) {
- return 1; # responsive
- }
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- logmsg " server precheck FAILED (unresponsive $srvrname server)\n";
- return 0;
-}
-
-#######################################################################
-# start the http2 server
-#
-sub runhttp2server {
- my ($verb) = @_;
- my $proto="http/2";
- my $ipvnum = 4;
- my $idnum = 0;
- my $exe = "$perl $srcdir/http2-server.pl";
- my $verbose_flag = "--verbose ";
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0, 0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--nghttpx \"$ENV{'NGHTTPX'}\" ";
- $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
- $flags .= "--logdir \"$LOGDIR\" ";
- $flags .= "--connect $HOSTIP:" . protoport("http") . " ";
- $flags .= $verbose_flag if($debugprotocol);
-
- my ($http2pid, $pid2);
- my $port = 23113;
- my $port2 = 23114;
- for(1 .. 10) {
- $port += int(rand(900));
- $port2 += int(rand(900));
- my $aflags = "--port $port --port2 $port2 $flags";
-
- my $cmd = "$exe $aflags";
- ($http2pid, $pid2) = startnew($cmd, $pidfile, 15, 0);
-
- if($http2pid <= 0 || !pidexists($http2pid)) {
- # it is NOT alive
- stopserver($server, "$pid2");
- $doesntrun{$pidfile} = 1;
- $http2pid = $pid2 = 0;
- next;
- }
- $doesntrun{$pidfile} = 0;
-
- if($verb) {
- logmsg "RUN: $srvrname server PID $http2pid ".
- "http-port $port https-port $port2 ".
- "backend $HOSTIP:" . protoport("http") . "\n";
- }
- last;
- }
-
- logmsg "RUN: failed to start the $srvrname server\n" if(!$http2pid);
-
- return ($http2pid, $pid2, $port, $port2);
-}
-
-#######################################################################
-# start the http3 server
-#
-sub runhttp3server {
- my ($verb, $cert) = @_;
- my $proto="http/3";
- my $ipvnum = 4;
- my $idnum = 0;
- my $exe = "$perl $srcdir/http3-server.pl";
- my $verbose_flag = "--verbose ";
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--nghttpx \"$ENV{'NGHTTPX'}\" ";
- $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
- $flags .= "--logdir \"$LOGDIR\" ";
- $flags .= "--connect $HOSTIP:" . protoport("http") . " ";
- $flags .= "--cert \"$cert\" " if($cert);
- $flags .= $verbose_flag if($debugprotocol);
-
- my ($http3pid, $pid3);
- my $port = 24113;
- for(1 .. 10) {
- $port += int(rand(900));
- my $aflags = "--port $port $flags";
-
- my $cmd = "$exe $aflags";
- ($http3pid, $pid3) = startnew($cmd, $pidfile, 15, 0);
-
- if($http3pid <= 0 || !pidexists($http3pid)) {
- # it is NOT alive
- stopserver($server, "$pid3");
- $doesntrun{$pidfile} = 1;
- $http3pid = $pid3 = 0;
- next;
- }
- $doesntrun{$pidfile} = 0;
-
- if($verb) {
- logmsg "RUN: $srvrname server PID $http3pid port $port\n";
- }
- last;
- }
-
- logmsg "RUN: failed to start the $srvrname server\n" if(!$http3pid);
-
- return ($http3pid, $pid3, $port);
-}
-
-#######################################################################
-# start the http server
-#
-sub runhttpserver {
- my ($proto, $verb, $alt, $port_or_path) = @_;
- my $ip = $HOSTIP;
- my $ipvnum = 4;
- my $idnum = 1;
- my $exe = "$perl $srcdir/http-server.pl";
- my $verbose_flag = "--verbose ";
- my $keepalive_secs = 30; # forwarded to sws, was 5 by default which
- # led to pukes in CI jobs
-
- if($alt eq "ipv6") {
- # if IPv6, use a different setup
- $ipvnum = 6;
- $ip = $HOST6IP;
- }
- elsif($alt eq "proxy") {
- # basically the same, but another ID
- $idnum = 2;
- }
- elsif($alt eq "unix") {
- # IP (protocol) is mutually exclusive with Unix sockets
- $ipvnum = "unix";
- }
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $portfile = $serverportfile{$server};
-
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--gopher " if($proto eq "gopher");
- $flags .= "--connect $HOSTIP " if($alt eq "proxy");
- $flags .= "--keepalive $keepalive_secs ";
- $flags .= $verbose_flag if($debugprotocol);
- $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
- $flags .= "--logdir \"$LOGDIR\" ";
- $flags .= "--portfile $portfile ";
- $flags .= "--config $FTPDCMD ";
- $flags .= "--id $idnum " if($idnum > 1);
- if($ipvnum eq "unix") {
- $flags .= "--unix-socket '$port_or_path' ";
- } else {
- $flags .= "--ipv$ipvnum --port 0 ";
- }
- $flags .= "--srcdir \"$TESTDIR/..\"";
-
- my $cmd = "$exe $flags";
- my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
-
- if($httppid <= 0 || !pidexists($httppid)) {
- # it is NOT alive
- logmsg "RUN: failed to start the $srvrname server\n";
- stopserver($server, "$pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- return (0, 0, 0);
- }
-
- # where is it?
- my $port = 0;
- if(!$port_or_path) {
- $port = $port_or_path = pidfromfile($portfile);
- }
-
- # Server is up. Verify that we can speak to it.
- my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
- if(!$pid3) {
- logmsg "RUN: $srvrname server failed verification\n";
- # failed to talk to it properly. Kill the server and return failure
- stopserver($server, "$httppid $pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- return (0, 0, 0);
- }
- $pid2 = $pid3;
-
- if($verb) {
- logmsg "RUN: $srvrname server is on PID $httppid port $port_or_path\n";
- }
-
- return ($httppid, $pid2, $port);
-}
-
-#######################################################################
-# start the https stunnel based server
-#
-sub runhttpsserver {
- my ($verb, $proto, $proxy, $certfile) = @_;
- my $ip = $HOSTIP;
- my $ipvnum = 4;
- my $idnum = 1;
-
- if($proxy eq "proxy") {
- # the https-proxy runs as https2
- $idnum = 2;
- }
-
- if(!$stunnel) {
- return (0, 0, 0);
- }
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- $certfile = 'stunnel.pem' unless($certfile);
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--verbose " if($debugprotocol);
- $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
- $flags .= "--logdir \"$LOGDIR\" ";
- $flags .= "--id $idnum " if($idnum > 1);
- $flags .= "--ipv$ipvnum --proto $proto ";
- $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
- $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
- if($proto eq "gophers") {
- $flags .= "--connect " . protoport("gopher");
- }
- elsif(!$proxy) {
- $flags .= "--connect " . protoport("http");
- }
- else {
- # for HTTPS-proxy we connect to the HTTP proxy
- $flags .= "--connect " . protoport("httpproxy");
- }
-
- my $pid2;
- my $httpspid;
- my $port = 24512; # start attempt
- for (1 .. 10) {
- $port += int(rand(600));
- my $options = "$flags --accept $port";
-
- my $cmd = "$perl $srcdir/secureserver.pl $options";
- ($httpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
-
- if($httpspid <= 0 || !pidexists($httpspid)) {
- # it is NOT alive
- stopserver($server, "$pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- $httpspid = $pid2 = 0;
- next;
- }
- # we have a server!
- if($verb) {
- logmsg "RUN: $srvrname server is PID $httpspid port $port\n";
- }
- last;
- }
- $runcert{$server} = $certfile;
- logmsg "RUN: failed to start the $srvrname server\n" if(!$httpspid);
-
- return ($httpspid, $pid2, $port);
-}
-
-#######################################################################
-# start the non-stunnel HTTP TLS extensions capable server
-#
-sub runhttptlsserver {
- my ($verb, $ipv6) = @_;
- my $proto = "httptls";
- my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
- my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
- my $idnum = 1;
-
- if(!$httptlssrv) {
- return (0,0);
- }
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--http ";
- $flags .= "--debug 1 " if($debugprotocol);
- $flags .= "--priority NORMAL:+SRP ";
- $flags .= "--srppasswd $srcdir/certs/srp-verifier-db ";
- $flags .= "--srppasswdconf $srcdir/certs/srp-verifier-conf";
-
- my $port = 24367;
- my ($httptlspid, $pid2);
- for (1 .. 10) {
- $port += int(rand(800));
- my $allflags = "--port $port $flags";
-
- my $cmd = "$httptlssrv $allflags > $logfile 2>&1";
- ($httptlspid, $pid2) = startnew($cmd, $pidfile, 10, 1);
-
- if($httptlspid <= 0 || !pidexists($httptlspid)) {
- # it is NOT alive
- stopserver($server, "$pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- $httptlspid = $pid2 = 0;
- next;
- }
- $doesntrun{$pidfile} = 0;
-
- if($verb) {
- logmsg "RUN: $srvrname server PID $httptlspid port $port\n";
- }
- last;
- }
- logmsg "RUN: failed to start the $srvrname server\n" if(!$httptlspid);
- return ($httptlspid, $pid2, $port);
-}
-
-#######################################################################
-# start the pingpong server (FTP, POP3, IMAP, SMTP)
-#
-sub runpingpongserver {
- my ($proto, $id, $verb, $ipv6) = @_;
- my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
- my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
- my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
- my $portfile = $serverportfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0,0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--verbose " if($debugprotocol);
- $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
- $flags .= "--logdir \"$LOGDIR\" ";
- $flags .= "--portfile \"$portfile\" ";
- $flags .= "--srcdir \"$srcdir\" --proto $proto ";
- $flags .= "--id $idnum " if($idnum > 1);
- $flags .= "--ipv$ipvnum --port 0 --addr \"$ip\"";
-
- my $cmd = "$perl $srcdir/ftpserver.pl $flags";
- my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
-
- if($ftppid <= 0 || !pidexists($ftppid)) {
- # it is NOT alive
- logmsg "RUN: failed to start the $srvrname server\n";
- stopserver($server, "$pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- return (0,0);
- }
-
- # where is it?
- my $port = pidfromfile($portfile);
-
- logmsg "PINGPONG runs on port $port ($portfile)\n" if($verb);
-
- # Server is up. Verify that we can speak to it.
- my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
- if(!$pid3) {
- logmsg "RUN: $srvrname server failed verification\n";
- # failed to talk to it properly. Kill the server and return failure
- stopserver($server, "$ftppid $pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- return (0,0);
- }
- $pid2 = $pid3;
-
- logmsg "RUN: $srvrname server is PID $ftppid port $port\n" if($verb);
-
- # Assign the correct port variable!
- if($proto =~ /^(?:ftp|imap|pop3|smtp)$/) {
- $PORT{$proto . ($ipvnum == 6? '6': '')} = $port;
- }
- else {
- print STDERR "Unsupported protocol $proto!!\n";
- return (0,0);
- }
-
- return ($pid2, $ftppid);
-}
-
-#######################################################################
-# start the ftps/imaps/pop3s/smtps server (or rather, tunnel)
-#
-sub runsecureserver {
- my ($verb, $ipv6, $certfile, $proto, $clearport) = @_;
- my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
- my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
- my $idnum = 1;
-
- if(!$stunnel) {
- return (0,0);
- }
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- $certfile = 'stunnel.pem' unless($certfile);
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--verbose " if($debugprotocol);
- $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
- $flags .= "--logdir \"$LOGDIR\" ";
- $flags .= "--id $idnum " if($idnum > 1);
- $flags .= "--ipv$ipvnum --proto $proto ";
- $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
- $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
- $flags .= "--connect $clearport";
-
- my $protospid;
- my $pid2;
- my $port = 26713 + ord $proto;
- my %usedports = reverse %PORT;
- for (1 .. 10) {
- $port += int(rand(700));
- next if exists $usedports{$port};
- my $options = "$flags --accept $port";
- my $cmd = "$perl $srcdir/secureserver.pl $options";
- ($protospid, $pid2) = startnew($cmd, $pidfile, 15, 0);
-
- if($protospid <= 0 || !pidexists($protospid)) {
- # it is NOT alive
- stopserver($server, "$pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- $protospid = $pid2 = 0;
- next;
- }
-
- $doesntrun{$pidfile} = 0;
- $runcert{$server} = $certfile;
-
- if($verb) {
- logmsg "RUN: $srvrname server is PID $protospid port $port\n";
- }
- last;
- }
-
- logmsg "RUN: failed to start the $srvrname server\n" if(!$protospid);
-
- return ($protospid, $pid2, $port);
-}
-
-#######################################################################
-# start the tftp server
-#
-sub runtftpserver {
- my ($id, $verb, $ipv6) = @_;
- my $ip = $HOSTIP;
- my $proto = 'tftp';
- my $ipvnum = 4;
- my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
-
- if($ipv6) {
- # if IPv6, use a different setup
- $ipvnum = 6;
- $ip = $HOST6IP;
- }
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $portfile = $serverportfile{$server};
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--verbose " if($debugprotocol);
- $flags .= "--pidfile \"$pidfile\" ";
- $flags .= "--portfile \"$portfile\" ";
- $flags .= "--logfile \"$logfile\" ";
- $flags .= "--logdir \"$LOGDIR\" ";
- $flags .= "--id $idnum " if($idnum > 1);
- $flags .= "--ipv$ipvnum --port 0 --srcdir \"$srcdir\"";
-
- my $cmd = "$perl $srcdir/tftpserver.pl $flags";
- my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
-
- if($tftppid <= 0 || !pidexists($tftppid)) {
- # it is NOT alive
- logmsg "RUN: failed to start the $srvrname server\n";
- stopserver($server, "$pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- return (0, 0, 0);
- }
-
- my $port = pidfromfile($portfile);
-
- # Server is up. Verify that we can speak to it.
- my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
- if(!$pid3) {
- logmsg "RUN: $srvrname server failed verification\n";
- # failed to talk to it properly. Kill the server and return failure
- stopserver($server, "$tftppid $pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- return (0, 0, 0);
- }
- $pid2 = $pid3;
-
- if($verb) {
- logmsg "RUN: $srvrname server on PID $tftppid port $port\n";
- }
-
- return ($pid2, $tftppid, $port);
-}
-
-
-#######################################################################
-# start the rtsp server
-#
-sub runrtspserver {
- my ($verb, $ipv6) = @_;
- my $ip = $HOSTIP;
- my $proto = 'rtsp';
- my $ipvnum = 4;
- my $idnum = 1;
-
- if($ipv6) {
- # if IPv6, use a different setup
- $ipvnum = 6;
- $ip = $HOST6IP;
- }
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
- my $portfile = $serverportfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--verbose " if($debugprotocol);
- $flags .= "--pidfile \"$pidfile\" ";
- $flags .= "--portfile \"$portfile\" ";
- $flags .= "--logfile \"$logfile\" ";
- $flags .= "--logdir \"$LOGDIR\" ";
- $flags .= "--id $idnum " if($idnum > 1);
- $flags .= "--ipv$ipvnum --port 0 --srcdir \"$srcdir\"";
-
- my $cmd = "$perl $srcdir/rtspserver.pl $flags";
- my ($rtsppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
-
- if($rtsppid <= 0 || !pidexists($rtsppid)) {
- # it is NOT alive
- logmsg "RUN: failed to start the $srvrname server\n";
- stopserver($server, "$pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- return (0, 0, 0);
- }
-
- my $port = pidfromfile($portfile);
-
- # Server is up. Verify that we can speak to it.
- my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
- if(!$pid3) {
- logmsg "RUN: $srvrname server failed verification\n";
- # failed to talk to it properly. Kill the server and return failure
- stopserver($server, "$rtsppid $pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- return (0, 0, 0);
- }
- $pid2 = $pid3;
-
- if($verb) {
- logmsg "RUN: $srvrname server PID $rtsppid port $port\n";
- }
-
- return ($rtsppid, $pid2, $port);
-}
-
-
-#######################################################################
-# Start the ssh (scp/sftp) server
-#
-sub runsshserver {
- my ($id, $verb, $ipv6) = @_;
- my $ip=$HOSTIP;
- my $proto = 'ssh';
- my $ipvnum = 4;
- my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
- my $port = 20000; # no lower port
-
- if(!$USER) {
- logmsg "Can't start ssh server due to lack of USER name";
- return (0,0,0);
- }
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0);
- }
-
- my $sshd = find_sshd();
- if($sshd) {
- ($sshdid,$sshdvernum,$sshdverstr,$sshderror) = sshversioninfo($sshd);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--verbose " if($verb);
- $flags .= "--debugprotocol " if($debugprotocol);
- $flags .= "--pidfile \"$pidfile\" ";
- $flags .= "--logdir \"$LOGDIR\" ";
- $flags .= "--id $idnum " if($idnum > 1);
- $flags .= "--ipv$ipvnum --addr \"$ip\" ";
- $flags .= "--user \"$USER\"";
-
- my $sshpid;
- my $pid2;
-
- my $wport = 0,
- my @tports;
- for(1 .. 10) {
-
- # sshd doesn't have a way to pick an unused random port number, so
- # instead we iterate over possible port numbers to use until we find
- # one that works
- $port += int(rand(500));
- push @tports, $port;
-
- my $options = "$flags --sshport $port";
-
- my $cmd = "$perl $srcdir/sshserver.pl $options";
- ($sshpid, $pid2) = startnew($cmd, $pidfile, 60, 0);
-
- # on loaded systems sshserver start up can take longer than the
- # timeout passed to startnew, when this happens startnew completes
- # without being able to read the pidfile and consequently returns a
- # zero pid2 above.
- if($sshpid <= 0 || !pidexists($sshpid)) {
- # it is NOT alive
- stopserver($server, "$pid2");
- $doesntrun{$pidfile} = 1;
- $sshpid = $pid2 = 0;
- next;
- }
-
- # once it is known that the ssh server is alive, sftp server
- # verification is performed actually connecting to it, authenticating
- # and performing a very simple remote command. This verification is
- # tried only one time.
-
- $sshdlog = server_logfilename($LOGDIR, 'ssh', $ipvnum, $idnum);
- $sftplog = server_logfilename($LOGDIR, 'sftp', $ipvnum, $idnum);
-
- if(verifysftp('sftp', $ipvnum, $idnum, $ip, $port) < 1) {
- logmsg "RUN: SFTP server failed verification\n";
- # failed to talk to it properly. Kill the server and return failure
- display_sftplog();
- display_sftpconfig();
- display_sshdlog();
- display_sshdconfig();
- stopserver($server, "$sshpid $pid2");
- $doesntrun{$pidfile} = 1;
- $sshpid = $pid2 = 0;
- next;
- }
- # we're happy, no need to loop anymore!
- $doesntrun{$pidfile} = 0;
- $wport = $port;
- last;
- }
- logmsg "RUN: failed to start the $srvrname server on $port\n" if(!$sshpid);
-
- if(!$wport) {
- logmsg "RUN: couldn't start $srvrname. Tried these ports:";
- logmsg "RUN: ".join(", ", @tports)."\n";
- return (0,0,0);
- }
-
- my $hostfile;
- if(!open($hostfile, "<", $PIDDIR . "/" . $hstpubmd5f) ||
- (read($hostfile, $SSHSRVMD5, 32) != 32) ||
- !close($hostfile) ||
- ($SSHSRVMD5 !~ /^[a-f0-9]{32}$/i))
- {
- my $msg = "Fatal: $srvrname pubkey md5 missing : \"$hstpubmd5f\" : $!";
- logmsg "$msg\n";
- stopservers($verb);
- die $msg;
- }
-
- if(!open($hostfile, "<", $PIDDIR . "/" . $hstpubsha256f) ||
- (read($hostfile, $SSHSRVSHA256, 48) == 0) ||
- !close($hostfile))
- {
- my $msg = "Fatal: $srvrname pubkey sha256 missing : \"$hstpubsha256f\" : $!";
- logmsg "$msg\n";
- stopservers($verb);
- die $msg;
- }
-
- logmsg "RUN: $srvrname on PID $pid2 port $wport\n" if($verb);
-
- return ($pid2, $sshpid, $wport);
-}
-
-#######################################################################
-# Start the MQTT server
-#
-sub runmqttserver {
- my ($id, $verb, $ipv6) = @_;
- my $ip=$HOSTIP;
- my $proto = 'mqtt';
- my $port = protoport($proto);
- my $ipvnum = 4;
- my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
-
- my $server = servername_id($proto, $ipvnum, $idnum);
- my $pidfile = $serverpidfile{$server};
- my $portfile = $serverportfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0,0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- # start our MQTT server - on a random port!
- my $cmd="server/mqttd".exe_ext('SRV').
- " --port 0 ".
- " --pidfile $pidfile".
- " --portfile $portfile".
- " --config $FTPDCMD".
- " --logfile $logfile".
- " --logdir $LOGDIR";
- my ($sockspid, $pid2) = startnew($cmd, $pidfile, 30, 0);
-
- if($sockspid <= 0 || !pidexists($sockspid)) {
- # it is NOT alive
- logmsg "RUN: failed to start the $srvrname server\n";
- stopserver($server, "$pid2");
- $doesntrun{$pidfile} = 1;
- return (0,0);
- }
-
- my $mqttport = pidfromfile($portfile);
- $PORT{"mqtt"} = $mqttport;
-
- if($verb) {
- logmsg "RUN: $srvrname server is now running PID $pid2 on PORT $mqttport\n";
- }
-
- return ($pid2, $sockspid);
-}
-
-#######################################################################
-# Start the socks server
-#
-sub runsocksserver {
- my ($id, $verb, $ipv6, $is_unix) = @_;
- my $ip=$HOSTIP;
- my $proto = 'socks';
- my $ipvnum = 4;
- my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $portfile = $serverportfile{$server};
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- # start our socks server, get commands from the FTP cmd file
- my $cmd="";
- if($is_unix) {
- $cmd="server/socksd".exe_ext('SRV').
- " --pidfile $pidfile".
- " --reqfile $SOCKSIN".
- " --logfile $logfile".
- " --unix-socket $SOCKSUNIXPATH".
- " --backend $HOSTIP".
- " --config $FTPDCMD";
- } else {
- $cmd="server/socksd".exe_ext('SRV').
- " --port 0 ".
- " --pidfile $pidfile".
- " --portfile $portfile".
- " --reqfile $SOCKSIN".
- " --logfile $logfile".
- " --backend $HOSTIP".
- " --config $FTPDCMD";
- }
- my ($sockspid, $pid2) = startnew($cmd, $pidfile, 30, 0);
-
- if($sockspid <= 0 || !pidexists($sockspid)) {
- # it is NOT alive
- logmsg "RUN: failed to start the $srvrname server\n";
- stopserver($server, "$pid2");
- $doesntrun{$pidfile} = 1;
- return (0, 0, 0);
- }
-
- my $port = pidfromfile($portfile);
-
- if($verb) {
- logmsg "RUN: $srvrname server is now running PID $pid2\n";
- }
-
- return ($pid2, $sockspid, $port);
-}
-
-#######################################################################
-# start the dict server
-#
-sub rundictserver {
- my ($verb, $alt) = @_;
- my $proto = "dict";
- my $ip = $HOSTIP;
- my $ipvnum = 4;
- my $idnum = 1;
-
- if($alt eq "ipv6") {
- # No IPv6
- }
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--verbose 1 " if($debugprotocol);
- $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
- $flags .= "--id $idnum " if($idnum > 1);
- $flags .= "--srcdir \"$srcdir\" ";
- $flags .= "--host $HOSTIP";
-
- my $port = 29000;
- my ($dictpid, $pid2);
- for(1 .. 10) {
- $port += int(rand(900));
- my $aflags = "--port $port $flags";
- my $cmd = "$srcdir/dictserver.py $aflags";
- ($dictpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
-
- if($dictpid <= 0 || !pidexists($dictpid)) {
- # it is NOT alive
- stopserver($server, "$pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- $dictpid = $pid2 = 0;
- next;
- }
- $doesntrun{$pidfile} = 0;
-
- if($verb) {
- logmsg "RUN: $srvrname server PID $dictpid port $port\n";
- }
- last;
- }
- logmsg "RUN: failed to start the $srvrname server\n" if(!$dictpid);
-
- return ($dictpid, $pid2, $port);
-}
-
-#######################################################################
-# start the SMB server
-#
-sub runsmbserver {
- my ($verb, $alt) = @_;
- my $proto = "smb";
- my $ip = $HOSTIP;
- my $ipvnum = 4;
- my $idnum = 1;
-
- if($alt eq "ipv6") {
- # No IPv6
- }
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--verbose 1 " if($debugprotocol);
- $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
- $flags .= "--id $idnum " if($idnum > 1);
- $flags .= "--srcdir \"$srcdir\" ";
- $flags .= "--host $HOSTIP";
-
- my ($smbpid, $pid2);
- my $port = 31923;
- for(1 .. 10) {
- $port += int(rand(760));
- my $aflags = "--port $port $flags";
- my $cmd = "$srcdir/smbserver.py $aflags";
- ($smbpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
-
- if($smbpid <= 0 || !pidexists($smbpid)) {
- # it is NOT alive
- stopserver($server, "$pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- $smbpid = $pid2 = 0;
- next;
- }
- $doesntrun{$pidfile} = 0;
-
- if($verb) {
- logmsg "RUN: $srvrname server PID $smbpid port $port\n";
- }
- last;
- }
- logmsg "RUN: failed to start the $srvrname server\n" if(!$smbpid);
-
- return ($smbpid, $pid2, $port);
-}
-
-#######################################################################
-# start the telnet server
-#
-sub runnegtelnetserver {
- my ($verb, $alt) = @_;
- my $proto = "telnet";
- my $ip = $HOSTIP;
- my $ipvnum = 4;
- my $idnum = 1;
-
- if($alt eq "ipv6") {
- # No IPv6
- }
-
- my $server = servername_id($proto, $ipvnum, $idnum);
-
- my $pidfile = $serverpidfile{$server};
-
- # don't retry if the server doesn't work
- if ($doesntrun{$pidfile}) {
- return (0, 0, 0);
- }
-
- my $pid = processexists($pidfile);
- if($pid > 0) {
- stopserver($server, "$pid");
- }
- unlink($pidfile) if(-f $pidfile);
-
- my $srvrname = servername_str($proto, $ipvnum, $idnum);
- my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
-
- my $flags = "";
- $flags .= "--verbose 1 " if($debugprotocol);
- $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
- $flags .= "--id $idnum " if($idnum > 1);
- $flags .= "--srcdir \"$srcdir\"";
-
- my ($ntelpid, $pid2);
- my $port = 32000;
- for(1 .. 10) {
- $port += int(rand(800));
- my $aflags = "--port $port $flags";
- my $cmd = "$srcdir/negtelnetserver.py $aflags";
- ($ntelpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
-
- if($ntelpid <= 0 || !pidexists($ntelpid)) {
- # it is NOT alive
- stopserver($server, "$pid2");
- displaylogs($testnumcheck);
- $doesntrun{$pidfile} = 1;
- $ntelpid = $pid2 = 0;
- next;
- }
- $doesntrun{$pidfile} = 0;
-
- if($verb) {
- logmsg "RUN: $srvrname server PID $ntelpid port $port\n";
- }
- last;
- }
- logmsg "RUN: failed to start the $srvrname server\n" if(!$ntelpid);
-
- return ($ntelpid, $pid2, $port);
-}
-
-
-#######################################################################
-# Single shot http and gopher server responsiveness test. This should only
-# be used to verify that a server present in %run hash is still functional
-#
-sub responsive_http_server {
- my ($proto, $verb, $alt, $port_or_path) = @_;
- my $ip = $HOSTIP;
- my $ipvnum = 4;
- my $idnum = 1;
-
- if($alt eq "ipv6") {
- # if IPv6, use a different setup
- $ipvnum = 6;
- $ip = $HOST6IP;
- }
- elsif($alt eq "proxy") {
- $idnum = 2;
- }
- elsif($alt eq "unix") {
- # IP (protocol) is mutually exclusive with Unix sockets
- $ipvnum = "unix";
- }
-
- return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
-}
-
-#######################################################################
-# Single shot pingpong server responsiveness test. This should only be
-# used to verify that a server present in %run hash is still functional
-#
-sub responsive_pingpong_server {
- my ($proto, $id, $verb, $ipv6) = @_;
- my $port;
- my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
- my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
- my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
- my $protoip = $proto . ($ipvnum == 6? '6': '');
-
- if($proto =~ /^(?:ftp|imap|pop3|smtp)$/) {
- $port = protoport($protoip);
- }
- else {
- print STDERR "Unsupported protocol $proto!!\n";
- return 0;
- }
-
- return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
-}
-
-#######################################################################
-# Single shot rtsp server responsiveness test. This should only be
-# used to verify that a server present in %run hash is still functional
-#
-sub responsive_rtsp_server {
- my ($verb, $ipv6) = @_;
- my $proto = 'rtsp';
- my $port = protoport($proto);
- my $ip = $HOSTIP;
- my $ipvnum = 4;
- my $idnum = 1;
-
- if($ipv6) {
- # if IPv6, use a different setup
- $ipvnum = 6;
- $port = protoport('rtsp6');
- $ip = $HOST6IP;
- }
-
- return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
-}
-
-#######################################################################
-# Single shot tftp server responsiveness test. This should only be
-# used to verify that a server present in %run hash is still functional
-#
-sub responsive_tftp_server {
- my ($id, $verb, $ipv6) = @_;
- my $proto = 'tftp';
- my $port = protoport($proto);
- my $ip = $HOSTIP;
- my $ipvnum = 4;
- my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
-
- if($ipv6) {
- # if IPv6, use a different setup
- $ipvnum = 6;
- $port = protoport('tftp6');
- $ip = $HOST6IP;
- }
-
- return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
-}
-
-#######################################################################
-# Single shot non-stunnel HTTP TLS extensions capable server
-# responsiveness test. This should only be used to verify that a
-# server present in %run hash is still functional
-#
-sub responsive_httptls_server {
- my ($verb, $ipv6) = @_;
- my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
- my $proto = "httptls";
- my $port = protoport($proto);
- my $ip = "$HOSTIP";
- my $idnum = 1;
-
- if ($ipvnum == 6) {
- $port = protoport("httptls6");
- $ip = "$HOST6IP";
- }
-
- return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
-}
-
-#######################################################################
-# Kill the processes that still lock files in a directory
-#
-sub clearlocks {
- my $dir = $_[0];
- my $done = 0;
-
- if(pathhelp::os_is_win()) {
- $dir = pathhelp::sys_native_abs_path($dir);
- $dir =~ s/\//\\\\/g;
- my $handle = "handle.exe";
- if($ENV{"PROCESSOR_ARCHITECTURE"} =~ /64$/) {
- $handle = "handle64.exe";
- }
- my @handles = `$handle $dir -accepteula -nobanner`;
- for my $tryhandle (@handles) {
- if($tryhandle =~ /^(\S+)\s+pid:\s+(\d+)\s+type:\s+(\w+)\s+([0-9A-F]+):\s+(.+)\r\r/) {
- logmsg "Found $3 lock of '$5' ($4) by $1 ($2)\n";
- # Ignore stunnel since we cannot do anything about its locks
- if("$3" eq "File" && "$1" ne "tstunnel.exe") {
- logmsg "Killing IMAGENAME eq $1 and PID eq $2\n";
- system("taskkill.exe -f -fi \"IMAGENAME eq $1\" -fi \"PID eq $2\" >nul 2>&1");
- $done = 1;
+ }
+
+ # verify that it returns a proper error code, doesn't leak memory
+ # and doesn't core dump
+ if(($ret & 255) || ($ret >> 8) >= 128) {
+ logmsg " system() returned $ret\n";
+ $fail=1;
+ }
+ else {
+ my @memdata=`$memanalyze $memdump`;
+ my $leak=0;
+ for(@memdata) {
+ if($_ ne "") {
+ # well it could be other memory problems as well, but
+ # we call it leak for short here
+ $leak=1;
}
}
+ if($leak) {
+ logmsg "** MEMORY FAILURE\n";
+ logmsg @memdata;
+ logmsg `$memanalyze -l $memdump`;
+ $fail = 1;
+ }
+ }
+ if($fail) {
+ logmsg " Failed on function number $limit in test.\n",
+ " invoke with \"-t$limit\" to repeat this single case.\n";
+ stopservers($verbose);
+ return 1;
}
}
- return $done;
+
+ logmsg "torture OK\n";
+ return 0;
}
+
#######################################################################
# Remove all files in the specified directory
#
}
#######################################################################
-# display information about curl and the host the test suite runs on
-#
+# Check & display information about curl and the host the test suite runs on.
+# Information to do with servers is displayed in displayserverfeatures, after
+# the server initialization is performed.
sub checksystemfeatures {
my $feat;
my $curl;
if($curl =~ /win32|Windows|mingw(32|64)/) {
# This is a Windows MinGW build or native build, we need to use
# Win32-style path.
- $pwd = pathhelp::sys_native_current_path();
+ $pwd = sys_native_current_path();
$has_textaware = 1;
$feature{"win32"} = 1;
# set if built with MinGW (as opposed to MinGW-w64)
my $hosttype=join(' ', runclientoutput("uname -a"));
my $hostos=$^O;
+ # display summary information about curl and the test host
logmsg ("********* System characteristics ******** \n",
"* $curl\n",
"* $libcurl\n",
"* OS: $hostos\n");
if($feature{"TrackMemory"} && $feature{"threaded-resolver"}) {
- $feature{"TrackMemory"} = 0;
logmsg("*\n",
"*** DISABLES memory tracking when using threaded resolver\n",
"*\n");
}
- logmsg sprintf("* Servers: %s", $stunnel?"SSL ":"");
- logmsg sprintf("%s", $http_ipv6?"HTTP-IPv6 ":"");
- logmsg sprintf("%s", $http_unix?"HTTP-unix ":"");
- logmsg sprintf("%s\n", $ftp_ipv6?"FTP-IPv6 ":"");
-
logmsg sprintf("* Env: %s%s%s", $valgrind?"Valgrind ":"",
$run_event_based?"event-based ":"",
$nghttpx_h3);
logmsg sprintf("%s\n", $libtool?"Libtool ":"");
logmsg ("* Seed: $randseed\n");
+ # Disable memory tracking when using threaded resolver
+ $feature{"TrackMemory"} = $feature{"TrackMemory"} && !$feature{"threaded-resolver"};
+
+ # toggle off the features that were disabled in the build
+ for my $d(@disabled) {
+ $feature{$d} = 0;
+ }
+}
+
+#######################################################################
+# display information about server features
+#
+sub displayserverfeatures {
+ logmsg sprintf("* Servers: %s", $stunnel?"SSL ":"");
+ logmsg sprintf("%s", $http_ipv6?"HTTP-IPv6 ":"");
+ logmsg sprintf("%s", $http_unix?"HTTP-unix ":"");
+ logmsg sprintf("%s\n", $ftp_ipv6?"FTP-IPv6 ":"");
+
if($verbose) {
if($feature{"unix-sockets"}) {
logmsg "* Unix socket paths:\n";
}
logmsg "***************************************** \n";
-
- # toggle off the features that were disabled in the build
- for my $d(@disabled) {
- $feature{$d} = 0;
- }
}
#######################################################################
$file_pwd = "/$file_pwd";
}
my $ssh_pwd = $posix_pwd;
+ # this only works after the SSH server has been started
+ # TODO: call sshversioninfo early and store $sshdid so this substitution
+ # always works
if ($sshdid && $sshdid =~ /OpenSSH-Windows/) {
$ssh_pwd = $file_pwd;
}
$timesrvrini{$testnum} = Time::HiRes::time();
if (!$why && !$listonly) {
- $why = serverfortest($testnum);
+ my @what = getpart("client", "server");
+ if(!$what[0]) {
+ warn "Test case $testnum has no server(s) specified";
+ $why = "no server specified";
+ } else {
+ $why = serverfortest(@what);
+ }
}
# timestamp required servers verification end
return 0;
}
-#######################################################################
-# Stop all running test servers
-#
-sub stopservers {
- my $verb = $_[0];
- #
- # kill sockfilter processes for all pingpong servers
- #
- killallsockfilters($PIDDIR, $verb);
- #
- # kill all server pids from %run hash clearing them
- #
- my $pidlist;
- foreach my $server (keys %run) {
- if($run{$server}) {
- if($verb) {
- my $prev = 0;
- my $pids = $run{$server};
- foreach my $pid (split(' ', $pids)) {
- if($pid != $prev) {
- logmsg sprintf("* kill pid for %s => %d\n",
- $server, $pid);
- $prev = $pid;
- }
- }
- }
- $pidlist .= "$run{$server} ";
- $run{$server} = 0;
- }
- $runcert{$server} = 0 if($runcert{$server});
- }
- killpid($verb, $pidlist);
- #
- # cleanup all server pid files
- #
- my $result = 0;
- foreach my $server (keys %serverpidfile) {
- my $pidfile = $serverpidfile{$server};
- my $pid = processexists($pidfile);
- if($pid > 0) {
- if($err_unexpected) {
- logmsg "ERROR: ";
- $result = -1;
- }
- else {
- logmsg "Warning: ";
- }
- logmsg "$server server unexpectedly alive\n";
- killpid($verb, $pid);
- }
- unlink($pidfile) if(-f $pidfile);
- }
-
- return $result;
-}
-
-#######################################################################
-# startservers() starts all the named servers
-#
-# Returns: string with error reason or blank for success
-#
-sub startservers {
- my @what = @_;
- my ($pid, $pid2);
- for(@what) {
- my (@whatlist) = split(/\s+/,$_);
- my $what = lc($whatlist[0]);
- $what =~ s/[^a-z0-9\/-]//g;
-
- my $certfile;
- if($what =~ /^(ftp|gopher|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
- $certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem';
- }
-
- if(($what eq "pop3") ||
- ($what eq "ftp") ||
- ($what eq "imap") ||
- ($what eq "smtp")) {
- if($torture && $run{$what} &&
- !responsive_pingpong_server($what, "", $verbose)) {
- if(stopserver($what)) {
- return "failed stopping unresponsive ".uc($what)." server";
- }
- }
- if(!$run{$what}) {
- ($pid, $pid2) = runpingpongserver($what, "", $verbose);
- if($pid <= 0) {
- return "failed starting ". uc($what) ." server";
- }
- printf ("* pid $what => %d %d\n", $pid, $pid2) if($verbose);
- $run{$what}="$pid $pid2";
- }
- }
- elsif($what eq "ftp-ipv6") {
- if($torture && $run{'ftp-ipv6'} &&
- !responsive_pingpong_server("ftp", "", $verbose, "ipv6")) {
- if(stopserver('ftp-ipv6')) {
- return "failed stopping unresponsive FTP-IPv6 server";
- }
- }
- if(!$run{'ftp-ipv6'}) {
- ($pid, $pid2) = runpingpongserver("ftp", "", $verbose, "ipv6");
- if($pid <= 0) {
- return "failed starting FTP-IPv6 server";
- }
- logmsg sprintf("* pid ftp-ipv6 => %d %d\n", $pid,
- $pid2) if($verbose);
- $run{'ftp-ipv6'}="$pid $pid2";
- }
- }
- elsif($what eq "gopher") {
- if($torture && $run{'gopher'} &&
- !responsive_http_server("gopher", $verbose, 0,
- protoport("gopher"))) {
- if(stopserver('gopher')) {
- return "failed stopping unresponsive GOPHER server";
- }
- }
- if(!$run{'gopher'}) {
- ($pid, $pid2, $PORT{'gopher'}) =
- runhttpserver("gopher", $verbose, 0);
- if($pid <= 0) {
- return "failed starting GOPHER server";
- }
- logmsg sprintf ("* pid gopher => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'gopher'}="$pid $pid2";
- }
- }
- elsif($what eq "gopher-ipv6") {
- if($torture && $run{'gopher-ipv6'} &&
- !responsive_http_server("gopher", $verbose, "ipv6",
- protoport("gopher"))) {
- if(stopserver('gopher-ipv6')) {
- return "failed stopping unresponsive GOPHER-IPv6 server";
- }
- }
- if(!$run{'gopher-ipv6'}) {
- ($pid, $pid2, $PORT{"gopher6"}) =
- runhttpserver("gopher", $verbose, "ipv6");
- if($pid <= 0) {
- return "failed starting GOPHER-IPv6 server";
- }
- logmsg sprintf("* pid gopher-ipv6 => %d %d\n", $pid,
- $pid2) if($verbose);
- $run{'gopher-ipv6'}="$pid $pid2";
- }
- }
- elsif($what eq "http/3") {
- if(!$run{'http/3'}) {
- ($pid, $pid2, $PORT{"http3"}) = runhttp3server($verbose);
- if($pid <= 0) {
- return "failed starting HTTP/3 server";
- }
- logmsg sprintf ("* pid http/3 => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'http/3'}="$pid $pid2";
- }
- }
- elsif($what eq "http/2") {
- if(!$run{'http/2'}) {
- ($pid, $pid2, $PORT{"http2"}, $PORT{"http2tls"}) =
- runhttp2server($verbose);
- if($pid <= 0) {
- return "failed starting HTTP/2 server";
- }
- logmsg sprintf ("* pid http/2 => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'http/2'}="$pid $pid2";
- }
- }
- elsif($what eq "http") {
- if($torture && $run{'http'} &&
- !responsive_http_server("http", $verbose, 0, protoport('http'))) {
- if(stopserver('http')) {
- return "failed stopping unresponsive HTTP server";
- }
- }
- if(!$run{'http'}) {
- ($pid, $pid2, $PORT{'http'}) =
- runhttpserver("http", $verbose, 0);
- if($pid <= 0) {
- return "failed starting HTTP server";
- }
- logmsg sprintf ("* pid http => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'http'}="$pid $pid2";
- }
- }
- elsif($what eq "http-proxy") {
- if($torture && $run{'http-proxy'} &&
- !responsive_http_server("http", $verbose, "proxy",
- protoport("httpproxy"))) {
- if(stopserver('http-proxy')) {
- return "failed stopping unresponsive HTTP-proxy server";
- }
- }
- if(!$run{'http-proxy'}) {
- ($pid, $pid2, $PORT{"httpproxy"}) =
- runhttpserver("http", $verbose, "proxy");
- if($pid <= 0) {
- return "failed starting HTTP-proxy server";
- }
- logmsg sprintf ("* pid http-proxy => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'http-proxy'}="$pid $pid2";
- }
- }
- elsif($what eq "http-ipv6") {
- if($torture && $run{'http-ipv6'} &&
- !responsive_http_server("http", $verbose, "ipv6",
- protoport("http6"))) {
- if(stopserver('http-ipv6')) {
- return "failed stopping unresponsive HTTP-IPv6 server";
- }
- }
- if(!$run{'http-ipv6'}) {
- ($pid, $pid2, $PORT{"http6"}) =
- runhttpserver("http", $verbose, "ipv6");
- if($pid <= 0) {
- return "failed starting HTTP-IPv6 server";
- }
- logmsg sprintf("* pid http-ipv6 => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'http-ipv6'}="$pid $pid2";
- }
- }
- elsif($what eq "rtsp") {
- if($torture && $run{'rtsp'} &&
- !responsive_rtsp_server($verbose)) {
- if(stopserver('rtsp')) {
- return "failed stopping unresponsive RTSP server";
- }
- }
- if(!$run{'rtsp'}) {
- ($pid, $pid2, $PORT{'rtsp'}) = runrtspserver($verbose);
- if($pid <= 0) {
- return "failed starting RTSP server";
- }
- printf ("* pid rtsp => %d %d\n", $pid, $pid2) if($verbose);
- $run{'rtsp'}="$pid $pid2";
- }
- }
- elsif($what eq "rtsp-ipv6") {
- if($torture && $run{'rtsp-ipv6'} &&
- !responsive_rtsp_server($verbose, "ipv6")) {
- if(stopserver('rtsp-ipv6')) {
- return "failed stopping unresponsive RTSP-IPv6 server";
- }
- }
- if(!$run{'rtsp-ipv6'}) {
- ($pid, $pid2, $PORT{'rtsp6'}) = runrtspserver($verbose, "ipv6");
- if($pid <= 0) {
- return "failed starting RTSP-IPv6 server";
- }
- logmsg sprintf("* pid rtsp-ipv6 => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'rtsp-ipv6'}="$pid $pid2";
- }
- }
- elsif($what =~ /^(ftp|imap|pop3|smtp)s$/) {
- my $cproto = $1;
- if(!$stunnel) {
- # we can't run ftps tests without stunnel
- return "no stunnel";
- }
- if($runcert{$what} && ($runcert{$what} ne $certfile)) {
- # stop server when running and using a different cert
- if(stopserver($what)) {
- return "failed stopping $what server with different cert";
- }
- }
- if($torture && $run{$cproto} &&
- !responsive_pingpong_server($cproto, "", $verbose)) {
- if(stopserver($cproto)) {
- return "failed stopping unresponsive $cproto server";
- }
- }
- if(!$run{$cproto}) {
- ($pid, $pid2) = runpingpongserver($cproto, "", $verbose);
- if($pid <= 0) {
- return "failed starting $cproto server";
- }
- printf ("* pid $cproto => %d %d\n", $pid, $pid2) if($verbose);
- $run{$cproto}="$pid $pid2";
- }
- if(!$run{$what}) {
- ($pid, $pid2, $PORT{$what}) =
- runsecureserver($verbose, "", $certfile, $what,
- protoport($cproto));
- if($pid <= 0) {
- return "failed starting $what server (stunnel)";
- }
- logmsg sprintf("* pid $what => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{$what}="$pid $pid2";
- }
- }
- elsif($what eq "file") {
- # we support it but have no server!
- }
- elsif($what eq "https") {
- if(!$stunnel) {
- # we can't run https tests without stunnel
- return "no stunnel";
- }
- if($runcert{'https'} && ($runcert{'https'} ne $certfile)) {
- # stop server when running and using a different cert
- if(stopserver('https')) {
- return "failed stopping HTTPS server with different cert";
- }
- }
- if($torture && $run{'http'} &&
- !responsive_http_server("http", $verbose, 0,
- protoport('http'))) {
- if(stopserver('http')) {
- return "failed stopping unresponsive HTTP server";
- }
- }
- if(!$run{'http'}) {
- ($pid, $pid2, $PORT{'http'}) =
- runhttpserver("http", $verbose, 0);
- if($pid <= 0) {
- return "failed starting HTTP server";
- }
- printf ("* pid http => %d %d\n", $pid, $pid2) if($verbose);
- $run{'http'}="$pid $pid2";
- }
- if(!$run{'https'}) {
- ($pid, $pid2, $PORT{'https'}) =
- runhttpsserver($verbose, "https", "", $certfile);
- if($pid <= 0) {
- return "failed starting HTTPS server (stunnel)";
- }
- logmsg sprintf("* pid https => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'https'}="$pid $pid2";
- }
- }
- elsif($what eq "gophers") {
- if(!$stunnel) {
- # we can't run TLS tests without stunnel
- return "no stunnel";
- }
- if($runcert{'gophers'} && ($runcert{'gophers'} ne $certfile)) {
- # stop server when running and using a different cert
- if(stopserver('gophers')) {
- return "failed stopping GOPHERS server with different crt";
- }
- }
- if($torture && $run{'gopher'} &&
- !responsive_http_server("gopher", $verbose, 0,
- protoport('gopher'))) {
- if(stopserver('gopher')) {
- return "failed stopping unresponsive GOPHER server";
- }
- }
- if(!$run{'gopher'}) {
- my $port;
- ($pid, $pid2, $port) =
- runhttpserver("gopher", $verbose, 0);
- $PORT{'gopher'} = $port;
- if($pid <= 0) {
- return "failed starting GOPHER server";
- }
- printf ("* pid gopher => %d %d\n", $pid, $pid2) if($verbose);
- print "GOPHERPORT => $port\n" if($verbose);
- $run{'gopher'}="$pid $pid2";
- }
- if(!$run{'gophers'}) {
- my $port;
- ($pid, $pid2, $port) =
- runhttpsserver($verbose, "gophers", "", $certfile);
- $PORT{'gophers'} = $port;
- if($pid <= 0) {
- return "failed starting GOPHERS server (stunnel)";
- }
- logmsg sprintf("* pid gophers => %d %d\n", $pid, $pid2)
- if($verbose);
- print "GOPHERSPORT => $port\n" if($verbose);
- $run{'gophers'}="$pid $pid2";
- }
- }
- elsif($what eq "https-proxy") {
- if(!$stunnel) {
- # we can't run https-proxy tests without stunnel
- return "no stunnel";
- }
- if($runcert{'https-proxy'} &&
- ($runcert{'https-proxy'} ne $certfile)) {
- # stop server when running and using a different cert
- if(stopserver('https-proxy')) {
- return "failed stopping HTTPS-proxy with different cert";
- }
- }
-
- # we front the http-proxy with stunnel so we need to make sure the
- # proxy runs as well
- my $f = startservers("http-proxy");
- if($f) {
- return $f;
- }
-
- if(!$run{'https-proxy'}) {
- ($pid, $pid2, $PORT{"httpsproxy"}) =
- runhttpsserver($verbose, "https", "proxy", $certfile);
- if($pid <= 0) {
- return "failed starting HTTPS-proxy (stunnel)";
- }
- logmsg sprintf("* pid https-proxy => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'https-proxy'}="$pid $pid2";
- }
- }
- elsif($what eq "httptls") {
- if(!$httptlssrv) {
- # for now, we can't run http TLS-EXT tests without gnutls-serv
- return "no gnutls-serv (with SRP support)";
- }
- if($torture && $run{'httptls'} &&
- !responsive_httptls_server($verbose, "IPv4")) {
- if(stopserver('httptls')) {
- return "failed stopping unresponsive HTTPTLS server";
- }
- }
- if(!$run{'httptls'}) {
- ($pid, $pid2, $PORT{'httptls'}) =
- runhttptlsserver($verbose, "IPv4");
- if($pid <= 0) {
- return "failed starting HTTPTLS server (gnutls-serv)";
- }
- logmsg sprintf("* pid httptls => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'httptls'}="$pid $pid2";
- }
- }
- elsif($what eq "httptls-ipv6") {
- if(!$httptlssrv) {
- # for now, we can't run http TLS-EXT tests without gnutls-serv
- return "no gnutls-serv";
- }
- if($torture && $run{'httptls-ipv6'} &&
- !responsive_httptls_server($verbose, "ipv6")) {
- if(stopserver('httptls-ipv6')) {
- return "failed stopping unresponsive HTTPTLS-IPv6 server";
- }
- }
- if(!$run{'httptls-ipv6'}) {
- ($pid, $pid2, $PORT{"httptls6"}) =
- runhttptlsserver($verbose, "ipv6");
- if($pid <= 0) {
- return "failed starting HTTPTLS-IPv6 server (gnutls-serv)";
- }
- logmsg sprintf("* pid httptls-ipv6 => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'httptls-ipv6'}="$pid $pid2";
- }
- }
- elsif($what eq "tftp") {
- if($torture && $run{'tftp'} &&
- !responsive_tftp_server("", $verbose)) {
- if(stopserver('tftp')) {
- return "failed stopping unresponsive TFTP server";
- }
- }
- if(!$run{'tftp'}) {
- ($pid, $pid2, $PORT{'tftp'}) =
- runtftpserver("", $verbose);
- if($pid <= 0) {
- return "failed starting TFTP server";
- }
- printf ("* pid tftp => %d %d\n", $pid, $pid2) if($verbose);
- $run{'tftp'}="$pid $pid2";
- }
- }
- elsif($what eq "tftp-ipv6") {
- if($torture && $run{'tftp-ipv6'} &&
- !responsive_tftp_server("", $verbose, "ipv6")) {
- if(stopserver('tftp-ipv6')) {
- return "failed stopping unresponsive TFTP-IPv6 server";
- }
- }
- if(!$run{'tftp-ipv6'}) {
- ($pid, $pid2, $PORT{'tftp6'}) =
- runtftpserver("", $verbose, "ipv6");
- if($pid <= 0) {
- return "failed starting TFTP-IPv6 server";
- }
- printf("* pid tftp-ipv6 => %d %d\n", $pid, $pid2) if($verbose);
- $run{'tftp-ipv6'}="$pid $pid2";
- }
- }
- elsif($what eq "sftp" || $what eq "scp") {
- if(!$run{'ssh'}) {
- ($pid, $pid2, $PORT{'ssh'}) = runsshserver("", $verbose);
- if($pid <= 0) {
- return "failed starting SSH server";
- }
- printf ("* pid ssh => %d %d\n", $pid, $pid2) if($verbose);
- $run{'ssh'}="$pid $pid2";
- }
- }
- elsif($what eq "socks4" || $what eq "socks5" ) {
- if(!$run{'socks'}) {
- ($pid, $pid2, $PORT{"socks"}) = runsocksserver("", $verbose);
- if($pid <= 0) {
- return "failed starting socks server";
- }
- printf ("* pid socks => %d %d\n", $pid, $pid2) if($verbose);
- $run{'socks'}="$pid $pid2";
- }
- }
- elsif($what eq "socks5unix") {
- if(!$run{'socks5unix'}) {
- ($pid, $pid2) = runsocksserver("2", $verbose, "", "unix");
- if($pid <= 0) {
- return "failed starting socks5unix server";
- }
- printf ("* pid socks5unix => %d %d\n", $pid, $pid2) if($verbose);
- $run{'socks5unix'}="$pid $pid2";
- }
- }
- elsif($what eq "mqtt" ) {
- if(!$run{'mqtt'}) {
- ($pid, $pid2) = runmqttserver("", $verbose);
- if($pid <= 0) {
- return "failed starting mqtt server";
- }
- printf ("* pid mqtt => %d %d\n", $pid, $pid2) if($verbose);
- $run{'mqtt'}="$pid $pid2";
- }
- }
- elsif($what eq "http-unix") {
- if($torture && $run{'http-unix'} &&
- !responsive_http_server("http", $verbose, "unix", $HTTPUNIXPATH)) {
- if(stopserver('http-unix')) {
- return "failed stopping unresponsive HTTP-unix server";
- }
- }
- if(!$run{'http-unix'}) {
- my $unused;
- ($pid, $pid2, $unused) =
- runhttpserver("http", $verbose, "unix", $HTTPUNIXPATH);
- if($pid <= 0) {
- return "failed starting HTTP-unix server";
- }
- logmsg sprintf("* pid http-unix => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'http-unix'}="$pid $pid2";
- }
- }
- elsif($what eq "dict") {
- if(!$run{'dict'}) {
- ($pid, $pid2, $PORT{"dict"}) = rundictserver($verbose, "");
- if($pid <= 0) {
- return "failed starting DICT server";
- }
- logmsg sprintf ("* pid DICT => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'dict'}="$pid $pid2";
- }
- }
- elsif($what eq "smb") {
- if(!$run{'smb'}) {
- ($pid, $pid2, $PORT{"smb"}) = runsmbserver($verbose, "");
- if($pid <= 0) {
- return "failed starting SMB server";
- }
- logmsg sprintf ("* pid SMB => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'smb'}="$pid $pid2";
- }
- }
- elsif($what eq "telnet") {
- if(!$run{'telnet'}) {
- ($pid, $pid2, $PORT{"telnet"}) =
- runnegtelnetserver($verbose, "");
- if($pid <= 0) {
- return "failed starting neg TELNET server";
- }
- logmsg sprintf ("* pid neg TELNET => %d %d\n", $pid, $pid2)
- if($verbose);
- $run{'telnet'}="$pid $pid2";
- }
- }
- elsif($what eq "none") {
- logmsg "* starts no server\n" if ($verbose);
- }
- else {
- warn "we don't support a server for $what";
- return "no server for $what";
- }
- }
- return 0;
-}
-
-##############################################################################
-# This function makes sure the right set of server is running for the
-# specified test case. This is a useful design when we run single tests as not
-# all servers need to run then!
-#
-# Returns: a string, blank if everything is fine or a reason why it failed
-#
-sub serverfortest {
- my ($testnum)=@_;
-
- my @what = getpart("client", "server");
-
- if(!$what[0]) {
- warn "Test case $testnum has no server(s) specified";
- return "no server specified";
- }
-
- for(my $i = scalar(@what) - 1; $i >= 0; $i--) {
- my $srvrline = $what[$i];
- chomp $srvrline if($srvrline);
- if($srvrline =~ /^(\S+)((\s*)(.*))/) {
- my $server = "${1}";
- my $lnrest = "${2}";
- my $tlsext;
- if($server =~ /^(httptls)(\+)(ext|srp)(\d*)(-ipv6|)$/) {
- $server = "${1}${4}${5}";
- $tlsext = uc("TLS-${3}");
- }
- if(! grep /^\Q$server\E$/, @protocols) {
- if(substr($server,0,5) ne "socks") {
- if($tlsext) {
- return "curl lacks $tlsext support";
- }
- else {
- return "curl lacks $server server support";
- }
- }
- }
- $what[$i] = "$server$lnrest" if($tlsext);
- }
- }
-
- return &startservers(@what);
-}
-
#######################################################################
# runtimestats displays test-suite run time statistics
#
}
}
-$HTTPUNIXPATH = "$PIDDIR/http.sock"; # HTTP server Unix domain socket path
-$SOCKSUNIXPATH = "$PIDDIR/socks.sock"; # SOCKS server Unix domain socket path
-
#######################################################################
# clear and create logging directory:
#
#
get_disttests();
-init_serverpidfile_hash();
#######################################################################
# Output curl version and host info being tested
if(!$listonly) {
unlink($memdump); # remove this if there was one left
checksystemfeatures();
+}
+
+#######################################################################
+# initialize configuration needed to set up servers
+#
+initserverconfig();
+
+if(!$listonly) {
+ # these can only be displayed after initserverconfig() has been called
+ displayserverfeatures();
# globally disabled tests
disabledtests("$TESTDIR/DISABLED");
--- /dev/null
+#***************************************************************************
+# _ _ ____ _
+# Project ___| | | | _ \| |
+# / __| | | | |_) | |
+# | (__| |_| | _ <| |___
+# \___|\___/|_| \_\_____|
+#
+# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
+#
+# This software is licensed as described in the file COPYING, which
+# you should have received as part of this distribution. The terms
+# are also available at https://curl.se/docs/copyright.html.
+#
+# You may opt to use, copy, modify, merge, publish, distribute and/or sell
+# copies of the Software, and permit persons to whom the Software is
+# furnished to do so, under the terms of the COPYING file.
+#
+# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
+# KIND, either express or implied.
+#
+# SPDX-License-Identifier: curl
+#
+###########################################################################
+
+# This module contains functions that are useful for managing the lifecycle of
+# test servers required when running tests. It is not intended for use within
+# those servers, but rather for starting and stopping them.
+
+package servers;
+
+use strict;
+use warnings;
+
+BEGIN {
+ use base qw(Exporter);
+
+ our @EXPORT = (
+ # variables
+ qw(
+ $HOSTIP
+ $HOST6IP
+ $HTTPUNIXPATH
+ $testnumcheck
+ $sshdid
+ $SSHSRVMD5
+ $SSHSRVSHA256
+ $SOCKSUNIXPATH
+ $SOCKSIN
+ $USER
+ $ftpchecktime
+ $err_unexpected
+ $debugprotocol
+ $stunnel
+ ),
+
+ # functions
+ qw(
+ initserverconfig
+ checkcmd
+ clearlocks
+ protoport
+ serverfortest
+ stopserver
+ stopservers
+ )
+ );
+}
+
+use serverhelp qw(
+ serverfactors
+ servername_id
+ servername_str
+ servername_canon
+ server_pidfilename
+ server_portfilename
+ server_logfilename
+ );
+
+use sshhelp qw(
+ $hstpubmd5f
+ $hstpubsha256f
+ $sshexe
+ $sftpexe
+ $sftpconfig
+ $sshdlog
+ $sftplog
+ $sftpcmds
+ display_sshdconfig
+ display_sftpconfig
+ display_sshdlog
+ display_sftplog
+ find_sshd
+ find_ssh
+ find_sftp
+ find_httptlssrv
+ sshversioninfo
+ );
+
+use pathhelp qw(
+ exe_ext
+ os_is_win
+ sys_native_abs_path
+ );
+
+use processhelp;
+use globalconfig;
+
+
+my %serverpidfile; # all server pid file names, identified by server id
+my %serverportfile;# all server port file names, identified by server id
+my $sshdvernum; # for socks server, ssh daemon version number
+my $sshdverstr; # for socks server, ssh daemon version string
+my $sshderror; # for socks server, ssh daemon version error
+my %doesntrun; # servers that don't work, identified by pidfile
+my %PORT = (nolisten => 47); # port we use for a local non-listening service
+my $server_response_maxtime=13;
+my $httptlssrv = find_httptlssrv();
+my %run; # running server
+my %runcert; # cert file currently in use by an ssl running server
+
+# Variables shared with runtests.pl
+our $HOSTIP="127.0.0.1"; # address on which the test server listens
+our $HOST6IP="[::1]"; # address on which the test server listens
+our $HTTPUNIXPATH; # HTTP server Unix domain socket path
+our $testnumcheck; # test number, set in singletest sub.
+our $sshdid; # for socks server, ssh daemon version id
+our $SSHSRVMD5 = "[uninitialized]"; # MD5 of ssh server public key
+our $SSHSRVSHA256 = "[uninitialized]"; # SHA256 of ssh server public key
+our $SOCKSUNIXPATH; # socks server Unix domain socket path
+our $SOCKSIN; # what curl sent to the SOCKS proxy
+our $USER; # name of the current user
+our $ftpchecktime=1; # time it took to verify our test FTP server
+our $err_unexpected; # error instead of warning on server unexpectedly alive
+our $debugprotocol; # nonzero for verbose server logs
+our $stunnel; # path to stunnel command
+
+#######################################################################
+# Log an informational message
+# This just calls main's logmsg for now.
+
+sub logmsg {
+ return main::logmsg(@_);
+}
+
+#######################################################################
+# Call main's runclient
+# TODO: move this into a helper package
+sub runclient {
+ return main::runclient(@_);
+}
+
+#######################################################################
+# Call main's runclientoutput
+# TODO: move this into a helper package
+sub runclientoutput {
+ return main::runclientoutput(@_);
+}
+
+#######################################################################
+# Check for a command in the PATH of the test server.
+#
+sub checkcmd {
+ my ($cmd, @extrapaths)=@_;
+ my @paths=(split(m/[:]/, $ENV{'PATH'}), "/usr/sbin", "/usr/local/sbin",
+ "/sbin", "/usr/bin", "/usr/local/bin", @extrapaths);
+ for(@paths) {
+ if( -x "$_/$cmd" && ! -d "$_/$cmd") {
+ # executable bit but not a directory!
+ return "$_/$cmd";
+ }
+ }
+ return "";
+}
+
+
+#######################################################################
+# Initialize configuration variables
+sub initserverconfig {
+ $SOCKSIN="$LOGDIR/socksd-request.log"; # what curl sent to the SOCKS proxy
+ $SOCKSUNIXPATH = "$PIDDIR/socks.sock"; # SOCKS server Unix domain socket path
+ $HTTPUNIXPATH = "$PIDDIR/http.sock"; # HTTP server Unix domain socket path
+ $stunnel = checkcmd("stunnel4") || checkcmd("tstunnel") || checkcmd("stunnel");
+
+ # get the name of the current user
+ $USER = $ENV{USER}; # Linux
+ if (!$USER) {
+ $USER = $ENV{USERNAME}; # Windows
+ if (!$USER) {
+ $USER = $ENV{LOGNAME}; # Some Unix (I think)
+ }
+ }
+ init_serverpidfile_hash();
+}
+
+#######################################################################
+# Call main's displaylogs
+# TODO: instead, make the caller call displaylogs() in case of error
+sub displaylogs {
+ return main::displaylogs(@_);
+}
+
+#######################################################################
+# Load serverpidfile and serverportfile hashes with file names for all
+# possible servers.
+#
+sub init_serverpidfile_hash {
+ for my $proto (('ftp', 'gopher', 'http', 'imap', 'pop3', 'smtp', 'http/2', 'http/3')) {
+ for my $ssl (('', 's')) {
+ for my $ipvnum ((4, 6)) {
+ for my $idnum ((1, 2, 3)) {
+ my $serv = servername_id("$proto$ssl", $ipvnum, $idnum);
+ my $pidf = server_pidfilename($PIDDIR, "$proto$ssl", $ipvnum, $idnum);
+ $serverpidfile{$serv} = $pidf;
+ my $portf = server_portfilename($PIDDIR, "$proto$ssl", $ipvnum, $idnum);
+ $serverportfile{$serv} = $portf;
+ }
+ }
+ }
+ }
+ for my $proto (('tftp', 'sftp', 'socks', 'ssh', 'rtsp', 'httptls',
+ 'dict', 'smb', 'smbs', 'telnet', 'mqtt')) {
+ for my $ipvnum ((4, 6)) {
+ for my $idnum ((1, 2)) {
+ my $serv = servername_id($proto, $ipvnum, $idnum);
+ my $pidf = server_pidfilename($PIDDIR, $proto, $ipvnum, $idnum);
+ $serverpidfile{$serv} = $pidf;
+ my $portf = server_portfilename($PIDDIR, $proto, $ipvnum, $idnum);
+ $serverportfile{$serv} = $portf;
+ }
+ }
+ }
+ for my $proto (('http', 'imap', 'pop3', 'smtp', 'http/2', 'http/3')) {
+ for my $ssl (('', 's')) {
+ my $serv = servername_id("$proto$ssl", "unix", 1);
+ my $pidf = server_pidfilename($PIDDIR, "$proto$ssl", "unix", 1);
+ $serverpidfile{$serv} = $pidf;
+ my $portf = server_portfilename($PIDDIR, "$proto$ssl", "unix", 1);
+ $serverportfile{$serv} = $portf;
+ }
+ }
+}
+
+
+#######################################################################
+# Kill the processes that still have lock files in a directory
+#
+sub clearlocks {
+ my $dir = $_[0];
+ my $done = 0;
+
+ if(os_is_win()) {
+ $dir = sys_native_abs_path($dir);
+ $dir =~ s/\//\\\\/g;
+ my $handle = "handle.exe";
+ if($ENV{"PROCESSOR_ARCHITECTURE"} =~ /64$/) {
+ $handle = "handle64.exe";
+ }
+ my @handles = `$handle $dir -accepteula -nobanner`;
+ for my $tryhandle (@handles) {
+ if($tryhandle =~ /^(\S+)\s+pid:\s+(\d+)\s+type:\s+(\w+)\s+([0-9A-F]+):\s+(.+)\r\r/) {
+ logmsg "Found $3 lock of '$5' ($4) by $1 ($2)\n";
+ # Ignore stunnel since we cannot do anything about its locks
+ if("$3" eq "File" && "$1" ne "tstunnel.exe") {
+ logmsg "Killing IMAGENAME eq $1 and PID eq $2\n";
+ system("taskkill.exe -f -fi \"IMAGENAME eq $1\" -fi \"PID eq $2\" >nul 2>&1");
+ $done = 1;
+ }
+ }
+ }
+ }
+ return $done;
+}
+
+#######################################################################
+# Check if a given child process has just died. Reaps it if so.
+#
+sub checkdied {
+ my $pid = $_[0];
+ if((not defined $pid) || $pid <= 0) {
+ return 0;
+ }
+ use POSIX ":sys_wait_h";
+ my $rc = pidwait($pid, &WNOHANG);
+ return ($rc == $pid)?1:0;
+}
+
+
+##############################################################################
+# This function makes sure the right set of server is running for the
+# specified test case. This is a useful design when we run single tests as not
+# all servers need to run then!
+#
+# Returns: a string, blank if everything is fine or a reason why it failed
+#
+sub serverfortest {
+ my (@what)=@_;
+
+ for(my $i = scalar(@what) - 1; $i >= 0; $i--) {
+ my $srvrline = $what[$i];
+ chomp $srvrline if($srvrline);
+ if($srvrline =~ /^(\S+)((\s*)(.*))/) {
+ my $server = "${1}";
+ my $lnrest = "${2}";
+ my $tlsext;
+ if($server =~ /^(httptls)(\+)(ext|srp)(\d*)(-ipv6|)$/) {
+ $server = "${1}${4}${5}";
+ $tlsext = uc("TLS-${3}");
+ }
+ if(! grep /^\Q$server\E$/, @protocols) {
+ if(substr($server,0,5) ne "socks") {
+ if($tlsext) {
+ return "curl lacks $tlsext support";
+ }
+ else {
+ return "curl lacks $server server support";
+ }
+ }
+ }
+ $what[$i] = "$server$lnrest" if($tlsext);
+ }
+ }
+
+ return &startservers(@what);
+}
+
+
+#######################################################################
+# Start a new thread/process and run the given command line in there.
+# Return the pids (yes plural) of the new child process to the parent.
+#
+sub startnew {
+ my ($cmd, $pidfile, $timeout, $fakepidfile)=@_;
+
+ logmsg "startnew: $cmd\n" if ($verbose);
+
+ my $child = fork();
+
+ if(not defined $child) {
+ logmsg "startnew: fork() failure detected\n";
+ return (-1,-1);
+ }
+
+ if(0 == $child) {
+ # Here we are the child. Run the given command.
+
+ # Flush output.
+ $| = 1;
+
+ # Put an "exec" in front of the command so that the child process
+ # keeps this child's process ID.
+ exec("exec $cmd") || die "Can't exec() $cmd: $!";
+
+ # exec() should never return back here to this process. We protect
+ # ourselves by calling die() just in case something goes really bad.
+ die "error: exec() has returned";
+ }
+
+ # Ugly hack but ssh client and gnutls-serv don't support pid files
+ if ($fakepidfile) {
+ if(open(my $out, ">", "$pidfile")) {
+ print $out $child . "\n";
+ close($out) || die "Failure writing pidfile";
+ logmsg "startnew: $pidfile faked with pid=$child\n" if($verbose);
+ }
+ else {
+ logmsg "startnew: failed to write fake $pidfile with pid=$child\n";
+ }
+ # could/should do a while connect fails sleep a bit and loop
+ portable_sleep($timeout);
+ if (checkdied($child)) {
+ logmsg "startnew: child process has failed to start\n" if($verbose);
+ return (-1,-1);
+ }
+ }
+
+ my $pid2 = 0;
+ my $count = $timeout;
+ while($count--) {
+ $pid2 = pidfromfile($pidfile);
+ if(($pid2 > 0) && pidexists($pid2)) {
+ # if $pid2 is valid, then make sure this pid is alive, as
+ # otherwise it is just likely to be the _previous_ pidfile or
+ # similar!
+ last;
+ }
+ if (checkdied($child)) {
+ logmsg "startnew: child process has died, server might start up\n"
+ if($verbose);
+ # We can't just abort waiting for the server with a
+ # return (-1,-1);
+ # because the server might have forked and could still start
+ # up normally. Instead, just reduce the amount of time we remain
+ # waiting.
+ $count >>= 2;
+ }
+ sleep(1);
+ }
+
+ # Return two PIDs, the one for the child process we spawned and the one
+ # reported by the server itself (in case it forked again on its own).
+ # Both (potentially) need to be killed at the end of the test.
+ return ($child, $pid2);
+}
+
+
+#######################################################################
+# Return the port to use for the given protocol.
+#
+sub protoport {
+ my ($proto) = @_;
+ return $PORT{$proto} || "[not running]";
+}
+
+
+#######################################################################
+# Stop a test server along with pids which aren't in the %run hash yet.
+# This also stops all servers which are relative to the given one.
+#
+sub stopserver {
+ my ($server, $pidlist) = @_;
+
+ #
+ # kill sockfilter processes for pingpong relative server
+ #
+ if($server =~ /^(ftp|imap|pop3|smtp)s?(\d*)(-ipv6|)$/) {
+ my $proto = $1;
+ my $idnum = ($2 && ($2 > 1)) ? $2 : 1;
+ my $ipvnum = ($3 && ($3 =~ /6$/)) ? 6 : 4;
+ killsockfilters($PIDDIR, $proto, $ipvnum, $idnum, $verbose);
+ }
+ #
+ # All servers relative to the given one must be stopped also
+ #
+ my @killservers;
+ if($server =~ /^(ftp|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
+ # given a stunnel based ssl server, also kill non-ssl underlying one
+ push @killservers, "${1}${2}";
+ }
+ elsif($server =~ /^(ftp|http|imap|pop3|smtp)((\d*)(-ipv6|-unix|))$/) {
+ # given a non-ssl server, also kill stunnel based ssl piggybacking one
+ push @killservers, "${1}s${2}";
+ }
+ elsif($server =~ /^(socks)((\d*)(-ipv6|))$/) {
+ # given a socks server, also kill ssh underlying one
+ push @killservers, "ssh${2}";
+ }
+ elsif($server =~ /^(ssh)((\d*)(-ipv6|))$/) {
+ # given a ssh server, also kill socks piggybacking one
+ push @killservers, "socks${2}";
+ }
+ if($server eq "http" or $server eq "https") {
+ # since the http2+3 server is a proxy that needs to know about the
+ # dynamic http port it too needs to get restarted when the http server
+ # is killed
+ push @killservers, "http/2";
+ push @killservers, "http/3";
+ }
+ push @killservers, $server;
+ #
+ # kill given pids and server relative ones clearing them in %run hash
+ #
+ foreach my $server (@killservers) {
+ if($run{$server}) {
+ # we must prepend a space since $pidlist may already contain a pid
+ $pidlist .= " $run{$server}";
+ $run{$server} = 0;
+ }
+ $runcert{$server} = 0 if($runcert{$server});
+ }
+ killpid($verbose, $pidlist);
+ #
+ # cleanup server pid files
+ #
+ my $result = 0;
+ foreach my $server (@killservers) {
+ my $pidfile = $serverpidfile{$server};
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ if($err_unexpected) {
+ logmsg "ERROR: ";
+ $result = -1;
+ }
+ else {
+ logmsg "Warning: ";
+ }
+ logmsg "$server server unexpectedly alive\n";
+ killpid($verbose, $pid);
+ }
+ unlink($pidfile) if(-f $pidfile);
+ }
+
+ return $result;
+}
+
+
+#######################################################################
+# Return flags to let curl use an external HTTP proxy
+#
+sub getexternalproxyflags {
+ return " --proxy $proxy_address ";
+}
+
+#######################################################################
+# Verify that the server that runs on $ip, $port is our server. This also
+# implies that we can speak with it, as there might be occasions when the
+# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
+# assign requested address")
+#
+sub verifyhttp {
+ my ($proto, $ipvnum, $idnum, $ip, $port_or_path) = @_;
+ my $server = servername_id($proto, $ipvnum, $idnum);
+ my $bonus="";
+ # $port_or_path contains a path for Unix sockets, sws ignores the port
+ my $port = ($ipvnum eq "unix") ? 80 : $port_or_path;
+
+ my $verifyout = "$LOGDIR/".
+ servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
+ unlink($verifyout) if(-f $verifyout);
+
+ my $verifylog = "$LOGDIR/".
+ servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
+ unlink($verifylog) if(-f $verifylog);
+
+ if($proto eq "gopher") {
+ # gopher is funny
+ $bonus="1/";
+ }
+
+ my $flags = "--max-time $server_response_maxtime ";
+ $flags .= "--output $verifyout ";
+ $flags .= "--silent ";
+ $flags .= "--verbose ";
+ $flags .= "--globoff ";
+ $flags .= "--unix-socket '$port_or_path' " if $ipvnum eq "unix";
+ $flags .= "--insecure " if($proto eq 'https');
+ if($proxy_address) {
+ $flags .= getexternalproxyflags();
+ }
+ $flags .= "\"$proto://$ip:$port/${bonus}verifiedserver\"";
+
+ my $cmd = "$VCURL $flags 2>$verifylog";
+
+ # verify if our/any server is running on this port
+ logmsg "RUN: $cmd\n" if($verbose);
+ my $res = runclient($cmd);
+
+ $res >>= 8; # rotate the result
+ if($res & 128) {
+ logmsg "RUN: curl command died with a coredump\n";
+ return -1;
+ }
+
+ if($res && $verbose) {
+ logmsg "RUN: curl command returned $res\n";
+ if(open(my $file, "<", "$verifylog")) {
+ while(my $string = <$file>) {
+ logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
+ }
+ close($file);
+ }
+ }
+
+ my $data;
+ if(open(my $file, "<", "$verifyout")) {
+ while(my $string = <$file>) {
+ $data = $string;
+ last; # only want first line
+ }
+ close($file);
+ }
+
+ my $pid = 0;
+ if($data && ($data =~ /WE ROOLZ: (\d+)/)) {
+ $pid = 0+$1;
+ }
+ elsif($res == 6) {
+ # curl: (6) Couldn't resolve host '::1'
+ logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
+ return -1;
+ }
+ elsif($data || ($res && ($res != 7))) {
+ logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
+ return -1;
+ }
+ return $pid;
+}
+
+#######################################################################
+# Verify that the server that runs on $ip, $port is our server. This also
+# implies that we can speak with it, as there might be occasions when the
+# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
+# assign requested address")
+#
+sub verifyftp {
+ my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
+ my $server = servername_id($proto, $ipvnum, $idnum);
+ my $time=time();
+ my $extra="";
+
+ my $verifylog = "$LOGDIR/".
+ servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
+ unlink($verifylog) if(-f $verifylog);
+
+ if($proto eq "ftps") {
+ $extra .= "--insecure --ftp-ssl-control ";
+ }
+
+ my $flags = "--max-time $server_response_maxtime ";
+ $flags .= "--silent ";
+ $flags .= "--verbose ";
+ $flags .= "--globoff ";
+ $flags .= $extra;
+ if($proxy_address) {
+ $flags .= getexternalproxyflags();
+ }
+ $flags .= "\"$proto://$ip:$port/verifiedserver\"";
+
+ my $cmd = "$VCURL $flags 2>$verifylog";
+
+ # check if this is our server running on this port:
+ logmsg "RUN: $cmd\n" if($verbose);
+ my @data = runclientoutput($cmd);
+
+ my $res = $? >> 8; # rotate the result
+ if($res & 128) {
+ logmsg "RUN: curl command died with a coredump\n";
+ return -1;
+ }
+
+ my $pid = 0;
+ foreach my $line (@data) {
+ if($line =~ /WE ROOLZ: (\d+)/) {
+ # this is our test server with a known pid!
+ $pid = 0+$1;
+ last;
+ }
+ }
+ if($pid <= 0 && @data && $data[0]) {
+ # this is not a known server
+ logmsg "RUN: Unknown server on our $server port: $port\n";
+ return 0;
+ }
+ # we can/should use the time it took to verify the FTP server as a measure
+ # on how fast/slow this host/FTP is.
+ my $took = int(0.5+time()-$time);
+
+ if($verbose) {
+ logmsg "RUN: Verifying our test $server server took $took seconds\n";
+ }
+ $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
+
+ return $pid;
+}
+
+#######################################################################
+# Verify that the server that runs on $ip, $port is our server. This also
+# implies that we can speak with it, as there might be occasions when the
+# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
+# assign requested address")
+#
+sub verifyrtsp {
+ my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $verifyout = "$LOGDIR/".
+ servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
+ unlink($verifyout) if(-f $verifyout);
+
+ my $verifylog = "$LOGDIR/".
+ servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
+ unlink($verifylog) if(-f $verifylog);
+
+ my $flags = "--max-time $server_response_maxtime ";
+ $flags .= "--output $verifyout ";
+ $flags .= "--silent ";
+ $flags .= "--verbose ";
+ $flags .= "--globoff ";
+ if($proxy_address) {
+ $flags .= getexternalproxyflags();
+ }
+ # currently verification is done using http
+ $flags .= "\"http://$ip:$port/verifiedserver\"";
+
+ my $cmd = "$VCURL $flags 2>$verifylog";
+
+ # verify if our/any server is running on this port
+ logmsg "RUN: $cmd\n" if($verbose);
+ my $res = runclient($cmd);
+
+ $res >>= 8; # rotate the result
+ if($res & 128) {
+ logmsg "RUN: curl command died with a coredump\n";
+ return -1;
+ }
+
+ if($res && $verbose) {
+ logmsg "RUN: curl command returned $res\n";
+ if(open(my $file, "<", "$verifylog")) {
+ while(my $string = <$file>) {
+ logmsg "RUN: $string" if($string !~ /^[ \t]*$/);
+ }
+ close($file);
+ }
+ }
+
+ my $data;
+ if(open(my $file, "<", "$verifyout")) {
+ while(my $string = <$file>) {
+ $data = $string;
+ last; # only want first line
+ }
+ close($file);
+ }
+
+ my $pid = 0;
+ if($data && ($data =~ /RTSP_SERVER WE ROOLZ: (\d+)/)) {
+ $pid = 0+$1;
+ }
+ elsif($res == 6) {
+ # curl: (6) Couldn't resolve host '::1'
+ logmsg "RUN: failed to resolve host ($proto://$ip:$port/verifiedserver)\n";
+ return -1;
+ }
+ elsif($data || ($res != 7)) {
+ logmsg "RUN: Unknown server on our $server port: $port\n";
+ return -1;
+ }
+ return $pid;
+}
+
+#######################################################################
+# Verify that the ssh server has written out its pidfile, recovering
+# the pid from the file and returning it if a process with that pid is
+# actually alive, or a negative value if the process is dead.
+#
+sub verifyssh {
+ my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
+ my $pidfile = server_pidfilename($PIDDIR, $proto, $ipvnum, $idnum);
+ my $pid = processexists($pidfile);
+ if($pid < 0) {
+ logmsg "RUN: SSH server has died after starting up\n";
+ }
+ return $pid;
+}
+
+#######################################################################
+# Verify that we can connect to the sftp server, properly authenticate
+# with generated config and key files and run a simple remote pwd.
+#
+sub verifysftp {
+ my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
+ my $server = servername_id($proto, $ipvnum, $idnum);
+ my $verified = 0;
+ # Find out sftp client canonical file name
+ my $sftp = find_sftp();
+ if(!$sftp) {
+ logmsg "RUN: SFTP server cannot find $sftpexe\n";
+ return -1;
+ }
+ # Find out ssh client canonical file name
+ my $ssh = find_ssh();
+ if(!$ssh) {
+ logmsg "RUN: SFTP server cannot find $sshexe\n";
+ return -1;
+ }
+ # Connect to sftp server, authenticate and run a remote pwd
+ # command using our generated configuration and key files
+ my $cmd = "\"$sftp\" -b $PIDDIR/$sftpcmds -F $PIDDIR/$sftpconfig -S \"$ssh\" $ip > $sftplog 2>&1";
+ my $res = runclient($cmd);
+ # Search for pwd command response in log file
+ if(open(my $sftplogfile, "<", "$sftplog")) {
+ while(<$sftplogfile>) {
+ if(/^Remote working directory: /) {
+ $verified = 1;
+ last;
+ }
+ }
+ close($sftplogfile);
+ }
+ return $verified;
+}
+
+#######################################################################
+# Verify that the non-stunnel HTTP TLS extensions capable server that runs
+# on $ip, $port is our server. This also implies that we can speak with it,
+# as there might be occasions when the server runs fine but we cannot talk
+# to it ("Failed to connect to ::1: Can't assign requested address")
+#
+sub verifyhttptls {
+ my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
+ my $server = servername_id($proto, $ipvnum, $idnum);
+ my $pidfile = server_pidfilename($PIDDIR, $proto, $ipvnum, $idnum);
+
+ my $verifyout = "$LOGDIR/".
+ servername_canon($proto, $ipvnum, $idnum) .'_verify.out';
+ unlink($verifyout) if(-f $verifyout);
+
+ my $verifylog = "$LOGDIR/".
+ servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
+ unlink($verifylog) if(-f $verifylog);
+
+ my $flags = "--max-time $server_response_maxtime ";
+ $flags .= "--output $verifyout ";
+ $flags .= "--verbose ";
+ $flags .= "--globoff ";
+ $flags .= "--insecure ";
+ $flags .= "--tlsauthtype SRP ";
+ $flags .= "--tlsuser jsmith ";
+ $flags .= "--tlspassword abc ";
+ if($proxy_address) {
+ $flags .= getexternalproxyflags();
+ }
+ $flags .= "\"https://$ip:$port/verifiedserver\"";
+
+ my $cmd = "$VCURL $flags 2>$verifylog";
+
+ # verify if our/any server is running on this port
+ logmsg "RUN: $cmd\n" if($verbose);
+ my $res = runclient($cmd);
+
+ $res >>= 8; # rotate the result
+ if($res & 128) {
+ logmsg "RUN: curl command died with a coredump\n";
+ return -1;
+ }
+
+ if($res && $verbose) {
+ logmsg "RUN: curl command returned $res\n";
+ if(open(my $file, "<", "$verifylog")) {
+ while(my $string = <$file>) {
+ logmsg "RUN: $string" if($string !~ /^([ \t]*)$/);
+ }
+ close($file);
+ }
+ }
+
+ my $data;
+ if(open(my $file, "<", "$verifyout")) {
+ while(my $string = <$file>) {
+ $data .= $string;
+ }
+ close($file);
+ }
+
+ my $pid = 0;
+ if($data && ($data =~ /(GNUTLS|GnuTLS)/) && ($pid = processexists($pidfile))) {
+ if($pid < 0) {
+ logmsg "RUN: $server server has died after starting up\n";
+ }
+ return $pid;
+ }
+ elsif($res == 6) {
+ # curl: (6) Couldn't resolve host '::1'
+ logmsg "RUN: failed to resolve host (https://$ip:$port/verifiedserver)\n";
+ return -1;
+ }
+ elsif($data || ($res && ($res != 7))) {
+ logmsg "RUN: Unknown server on our $server port: $port ($res)\n";
+ return -1;
+ }
+ return $pid;
+}
+
+#######################################################################
+# STUB for verifying socks
+#
+sub verifysocks {
+ my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
+ my $pidfile = server_pidfilename($PIDDIR, $proto, $ipvnum, $idnum);
+ my $pid = processexists($pidfile);
+ if($pid < 0) {
+ logmsg "RUN: SOCKS server has died after starting up\n";
+ }
+ return $pid;
+}
+
+#######################################################################
+# Verify that the server that runs on $ip, $port is our server. This also
+# implies that we can speak with it, as there might be occasions when the
+# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
+# assign requested address")
+#
+sub verifysmb {
+ my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
+ my $server = servername_id($proto, $ipvnum, $idnum);
+ my $time=time();
+ my $extra="";
+
+ my $verifylog = "$LOGDIR/".
+ servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
+ unlink($verifylog) if(-f $verifylog);
+
+ my $flags = "--max-time $server_response_maxtime ";
+ $flags .= "--silent ";
+ $flags .= "--verbose ";
+ $flags .= "--globoff ";
+ $flags .= "-u 'curltest:curltest' ";
+ $flags .= $extra;
+ $flags .= "\"$proto://$ip:$port/SERVER/verifiedserver\"";
+
+ my $cmd = "$VCURL $flags 2>$verifylog";
+
+ # check if this is our server running on this port:
+ logmsg "RUN: $cmd\n" if($verbose);
+ my @data = runclientoutput($cmd);
+
+ my $res = $? >> 8; # rotate the result
+ if($res & 128) {
+ logmsg "RUN: curl command died with a coredump\n";
+ return -1;
+ }
+
+ my $pid = 0;
+ foreach my $line (@data) {
+ if($line =~ /WE ROOLZ: (\d+)/) {
+ # this is our test server with a known pid!
+ $pid = 0+$1;
+ last;
+ }
+ }
+ if($pid <= 0 && @data && $data[0]) {
+ # this is not a known server
+ logmsg "RUN: Unknown server on our $server port: $port\n";
+ return 0;
+ }
+ # we can/should use the time it took to verify the server as a measure
+ # on how fast/slow this host is.
+ my $took = int(0.5+time()-$time);
+
+ if($verbose) {
+ logmsg "RUN: Verifying our test $server server took $took seconds\n";
+ }
+ $ftpchecktime = $took>=1?$took:1; # make sure it never is below 1
+
+ return $pid;
+}
+
+#######################################################################
+# Verify that the server that runs on $ip, $port is our server. This also
+# implies that we can speak with it, as there might be occasions when the
+# server runs fine but we cannot talk to it ("Failed to connect to ::1: Can't
+# assign requested address")
+#
+sub verifytelnet {
+ my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
+ my $server = servername_id($proto, $ipvnum, $idnum);
+ my $time=time();
+ my $extra="";
+
+ my $verifylog = "$LOGDIR/".
+ servername_canon($proto, $ipvnum, $idnum) .'_verify.log';
+ unlink($verifylog) if(-f $verifylog);
+
+ my $flags = "--max-time $server_response_maxtime ";
+ $flags .= "--silent ";
+ $flags .= "--verbose ";
+ $flags .= "--globoff ";
+ $flags .= "--upload-file - ";
+ $flags .= $extra;
+ $flags .= "\"$proto://$ip:$port\"";
+
+ my $cmd = "echo 'verifiedserver' | $VCURL $flags 2>$verifylog";
+
+ # check if this is our server running on this port:
+ logmsg "RUN: $cmd\n" if($verbose);
+ my @data = runclientoutput($cmd);
+
+ my $res = $? >> 8; # rotate the result
+ if($res & 128) {
+ logmsg "RUN: curl command died with a coredump\n";
+ return -1;
+ }
+
+ my $pid = 0;
+ foreach my $line (@data) {
+ if($line =~ /WE ROOLZ: (\d+)/) {
+ # this is our test server with a known pid!
+ $pid = 0+$1;
+ last;
+ }
+ }
+ if($pid <= 0 && @data && $data[0]) {
+ # this is not a known server
+ logmsg "RUN: Unknown server on our $server port: $port\n";
+ return 0;
+ }
+ # we can/should use the time it took to verify the server as a measure
+ # on how fast/slow this host is.
+ my $took = int(0.5+time()-$time);
+
+ if($verbose) {
+ logmsg "RUN: Verifying our test $server server took $took seconds\n";
+ }
+
+ return $pid;
+}
+
+#######################################################################
+# Verify that the server that runs on $ip, $port is our server.
+# Retry over several seconds before giving up. The ssh server in
+# particular can take a long time to start if it needs to generate
+# keys on a slow or loaded host.
+#
+# Just for convenience, test harness uses 'https' and 'httptls' literals
+# as values for 'proto' variable in order to differentiate different
+# servers. 'https' literal is used for stunnel based https test servers,
+# and 'httptls' is used for non-stunnel https test servers.
+#
+
+my %protofunc = ('http' => \&verifyhttp,
+ 'https' => \&verifyhttp,
+ 'rtsp' => \&verifyrtsp,
+ 'ftp' => \&verifyftp,
+ 'pop3' => \&verifyftp,
+ 'imap' => \&verifyftp,
+ 'smtp' => \&verifyftp,
+ 'ftps' => \&verifyftp,
+ 'pop3s' => \&verifyftp,
+ 'imaps' => \&verifyftp,
+ 'smtps' => \&verifyftp,
+ 'tftp' => \&verifyftp,
+ 'ssh' => \&verifyssh,
+ 'socks' => \&verifysocks,
+ 'socks5unix' => \&verifysocks,
+ 'gopher' => \&verifyhttp,
+ 'httptls' => \&verifyhttptls,
+ 'dict' => \&verifyftp,
+ 'smb' => \&verifysmb,
+ 'telnet' => \&verifytelnet);
+
+sub verifyserver {
+ my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
+
+ my $count = 30; # try for this many seconds
+ my $pid;
+
+ while($count--) {
+ my $fun = $protofunc{$proto};
+
+ $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
+
+ if($pid > 0) {
+ last;
+ }
+ elsif($pid < 0) {
+ # a real failure, stop trying and bail out
+ return 0;
+ }
+ sleep(1);
+ }
+ return $pid;
+}
+
+#######################################################################
+# Single shot server responsiveness test. This should only be used
+# to verify that a server present in %run hash is still functional
+#
+sub responsiveserver {
+ my ($proto, $ipvnum, $idnum, $ip, $port) = @_;
+ my $prev_verbose = $verbose;
+
+ $verbose = 0;
+ my $fun = $protofunc{$proto};
+ my $pid = &$fun($proto, $ipvnum, $idnum, $ip, $port);
+ $verbose = $prev_verbose;
+
+ if($pid > 0) {
+ return 1; # responsive
+ }
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ logmsg " server precheck FAILED (unresponsive $srvrname server)\n";
+ return 0;
+}
+
+
+#######################################################################
+# start the http server
+#
+sub runhttpserver {
+ my ($proto, $verb, $alt, $port_or_path) = @_;
+ my $ip = $HOSTIP;
+ my $ipvnum = 4;
+ my $idnum = 1;
+ my $exe = "$perl $srcdir/http-server.pl";
+ my $verbose_flag = "--verbose ";
+ my $keepalive_secs = 30; # forwarded to sws, was 5 by default which
+ # led to pukes in CI jobs
+
+ if($alt eq "ipv6") {
+ # if IPv6, use a different setup
+ $ipvnum = 6;
+ $ip = $HOST6IP;
+ }
+ elsif($alt eq "proxy") {
+ # basically the same, but another ID
+ $idnum = 2;
+ }
+ elsif($alt eq "unix") {
+ # IP (protocol) is mutually exclusive with Unix sockets
+ $ipvnum = "unix";
+ }
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $portfile = $serverportfile{$server};
+
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--gopher " if($proto eq "gopher");
+ $flags .= "--connect $HOSTIP " if($alt eq "proxy");
+ $flags .= "--keepalive $keepalive_secs ";
+ $flags .= $verbose_flag if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
+ $flags .= "--logdir \"$LOGDIR\" ";
+ $flags .= "--portfile $portfile ";
+ $flags .= "--config $FTPDCMD ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ if($ipvnum eq "unix") {
+ $flags .= "--unix-socket '$port_or_path' ";
+ } else {
+ $flags .= "--ipv$ipvnum --port 0 ";
+ }
+ $flags .= "--srcdir \"$srcdir\"";
+
+ my $cmd = "$exe $flags";
+ my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($httppid <= 0 || !pidexists($httppid)) {
+ # it is NOT alive
+ logmsg "RUN: failed to start the $srvrname server\n";
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0, 0, 0);
+ }
+
+ # where is it?
+ my $port = 0;
+ if(!$port_or_path) {
+ $port = $port_or_path = pidfromfile($portfile);
+ }
+
+ # Server is up. Verify that we can speak to it.
+ my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
+ if(!$pid3) {
+ logmsg "RUN: $srvrname server failed verification\n";
+ # failed to talk to it properly. Kill the server and return failure
+ stopserver($server, "$httppid $pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0, 0, 0);
+ }
+ $pid2 = $pid3;
+
+ if($verb) {
+ logmsg "RUN: $srvrname server is on PID $httppid port $port_or_path\n";
+ }
+
+ return ($httppid, $pid2, $port);
+}
+
+
+#######################################################################
+# start the http2 server
+#
+sub runhttp2server {
+ my ($verb) = @_;
+ my $proto="http/2";
+ my $ipvnum = 4;
+ my $idnum = 0;
+ my $exe = "$perl $srcdir/http2-server.pl";
+ my $verbose_flag = "--verbose ";
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0, 0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--nghttpx \"$ENV{'NGHTTPX'}\" ";
+ $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
+ $flags .= "--logdir \"$LOGDIR\" ";
+ $flags .= "--connect $HOSTIP:" . protoport("http") . " ";
+ $flags .= $verbose_flag if($debugprotocol);
+
+ my ($http2pid, $pid2);
+ my $port = 23113;
+ my $port2 = 23114;
+ for(1 .. 10) {
+ $port += int(rand(900));
+ $port2 += int(rand(900));
+ my $aflags = "--port $port --port2 $port2 $flags";
+
+ my $cmd = "$exe $aflags";
+ ($http2pid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($http2pid <= 0 || !pidexists($http2pid)) {
+ # it is NOT alive
+ stopserver($server, "$pid2");
+ $doesntrun{$pidfile} = 1;
+ $http2pid = $pid2 = 0;
+ next;
+ }
+ $doesntrun{$pidfile} = 0;
+
+ if($verb) {
+ logmsg "RUN: $srvrname server PID $http2pid ".
+ "http-port $port https-port $port2 ".
+ "backend $HOSTIP:" . protoport("http") . "\n";
+ }
+ last;
+ }
+
+ logmsg "RUN: failed to start the $srvrname server\n" if(!$http2pid);
+
+ return ($http2pid, $pid2, $port, $port2);
+}
+
+#######################################################################
+# start the http3 server
+#
+sub runhttp3server {
+ my ($verb, $cert) = @_;
+ my $proto="http/3";
+ my $ipvnum = 4;
+ my $idnum = 0;
+ my $exe = "$perl $srcdir/http3-server.pl";
+ my $verbose_flag = "--verbose ";
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--nghttpx \"$ENV{'NGHTTPX'}\" ";
+ $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
+ $flags .= "--logdir \"$LOGDIR\" ";
+ $flags .= "--connect $HOSTIP:" . protoport("http") . " ";
+ $flags .= "--cert \"$cert\" " if($cert);
+ $flags .= $verbose_flag if($debugprotocol);
+
+ my ($http3pid, $pid3);
+ my $port = 24113;
+ for(1 .. 10) {
+ $port += int(rand(900));
+ my $aflags = "--port $port $flags";
+
+ my $cmd = "$exe $aflags";
+ ($http3pid, $pid3) = startnew($cmd, $pidfile, 15, 0);
+
+ if($http3pid <= 0 || !pidexists($http3pid)) {
+ # it is NOT alive
+ stopserver($server, "$pid3");
+ $doesntrun{$pidfile} = 1;
+ $http3pid = $pid3 = 0;
+ next;
+ }
+ $doesntrun{$pidfile} = 0;
+
+ if($verb) {
+ logmsg "RUN: $srvrname server PID $http3pid port $port\n";
+ }
+ last;
+ }
+
+ logmsg "RUN: failed to start the $srvrname server\n" if(!$http3pid);
+
+ return ($http3pid, $pid3, $port);
+}
+
+#######################################################################
+# start the https stunnel based server
+#
+sub runhttpsserver {
+ my ($verb, $proto, $proxy, $certfile) = @_;
+ my $ip = $HOSTIP;
+ my $ipvnum = 4;
+ my $idnum = 1;
+
+ if($proxy eq "proxy") {
+ # the https-proxy runs as https2
+ $idnum = 2;
+ }
+
+ if(!$stunnel) {
+ return (0, 0, 0);
+ }
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ $certfile = 'stunnel.pem' unless($certfile);
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--verbose " if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
+ $flags .= "--logdir \"$LOGDIR\" ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ $flags .= "--ipv$ipvnum --proto $proto ";
+ $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
+ $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
+ if($proto eq "gophers") {
+ $flags .= "--connect " . protoport("gopher");
+ }
+ elsif(!$proxy) {
+ $flags .= "--connect " . protoport("http");
+ }
+ else {
+ # for HTTPS-proxy we connect to the HTTP proxy
+ $flags .= "--connect " . protoport("httpproxy");
+ }
+
+ my $pid2;
+ my $httpspid;
+ my $port = 24512; # start attempt
+ for (1 .. 10) {
+ $port += int(rand(600));
+ my $options = "$flags --accept $port";
+
+ my $cmd = "$perl $srcdir/secureserver.pl $options";
+ ($httpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($httpspid <= 0 || !pidexists($httpspid)) {
+ # it is NOT alive
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ $httpspid = $pid2 = 0;
+ next;
+ }
+ # we have a server!
+ if($verb) {
+ logmsg "RUN: $srvrname server is PID $httpspid port $port\n";
+ }
+ last;
+ }
+ $runcert{$server} = $certfile;
+ logmsg "RUN: failed to start the $srvrname server\n" if(!$httpspid);
+
+ return ($httpspid, $pid2, $port);
+}
+
+#######################################################################
+# start the non-stunnel HTTP TLS extensions capable server
+#
+sub runhttptlsserver {
+ my ($verb, $ipv6) = @_;
+ my $proto = "httptls";
+ my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
+ my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
+ my $idnum = 1;
+
+ if(!$httptlssrv) {
+ return (0,0);
+ }
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--http ";
+ $flags .= "--debug 1 " if($debugprotocol);
+ $flags .= "--priority NORMAL:+SRP ";
+ $flags .= "--srppasswd $srcdir/certs/srp-verifier-db ";
+ $flags .= "--srppasswdconf $srcdir/certs/srp-verifier-conf";
+
+ my $port = 24367;
+ my ($httptlspid, $pid2);
+ for (1 .. 10) {
+ $port += int(rand(800));
+ my $allflags = "--port $port $flags";
+
+ my $cmd = "$httptlssrv $allflags > $logfile 2>&1";
+ ($httptlspid, $pid2) = startnew($cmd, $pidfile, 10, 1);
+
+ if($httptlspid <= 0 || !pidexists($httptlspid)) {
+ # it is NOT alive
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ $httptlspid = $pid2 = 0;
+ next;
+ }
+ $doesntrun{$pidfile} = 0;
+
+ if($verb) {
+ logmsg "RUN: $srvrname server PID $httptlspid port $port\n";
+ }
+ last;
+ }
+ logmsg "RUN: failed to start the $srvrname server\n" if(!$httptlspid);
+ return ($httptlspid, $pid2, $port);
+}
+
+#######################################################################
+# start the pingpong server (FTP, POP3, IMAP, SMTP)
+#
+sub runpingpongserver {
+ my ($proto, $id, $verb, $ipv6) = @_;
+ my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
+ my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
+ my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+ my $portfile = $serverportfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0,0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--verbose " if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
+ $flags .= "--logdir \"$LOGDIR\" ";
+ $flags .= "--portfile \"$portfile\" ";
+ $flags .= "--srcdir \"$srcdir\" --proto $proto ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ $flags .= "--ipv$ipvnum --port 0 --addr \"$ip\"";
+
+ my $cmd = "$perl $srcdir/ftpserver.pl $flags";
+ my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($ftppid <= 0 || !pidexists($ftppid)) {
+ # it is NOT alive
+ logmsg "RUN: failed to start the $srvrname server\n";
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0,0);
+ }
+
+ # where is it?
+ my $port = pidfromfile($portfile);
+
+ logmsg "PINGPONG runs on port $port ($portfile)\n" if($verb);
+
+ # Server is up. Verify that we can speak to it.
+ my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
+ if(!$pid3) {
+ logmsg "RUN: $srvrname server failed verification\n";
+ # failed to talk to it properly. Kill the server and return failure
+ stopserver($server, "$ftppid $pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0,0);
+ }
+ $pid2 = $pid3;
+
+ logmsg "RUN: $srvrname server is PID $ftppid port $port\n" if($verb);
+
+ # Assign the correct port variable!
+ if($proto =~ /^(?:ftp|imap|pop3|smtp)$/) {
+ $PORT{$proto . ($ipvnum == 6? '6': '')} = $port;
+ }
+ else {
+ print STDERR "Unsupported protocol $proto!!\n";
+ return (0,0);
+ }
+
+ return ($pid2, $ftppid);
+}
+
+#######################################################################
+# start the ftps/imaps/pop3s/smtps server (or rather, tunnel)
+#
+sub runsecureserver {
+ my ($verb, $ipv6, $certfile, $proto, $clearport) = @_;
+ my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
+ my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
+ my $idnum = 1;
+
+ if(!$stunnel) {
+ return (0,0);
+ }
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ $certfile = 'stunnel.pem' unless($certfile);
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--verbose " if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
+ $flags .= "--logdir \"$LOGDIR\" ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ $flags .= "--ipv$ipvnum --proto $proto ";
+ $flags .= "--certfile \"$certfile\" " if($certfile ne 'stunnel.pem');
+ $flags .= "--stunnel \"$stunnel\" --srcdir \"$srcdir\" ";
+ $flags .= "--connect $clearport";
+
+ my $protospid;
+ my $pid2;
+ my $port = 26713 + ord $proto;
+ my %usedports = reverse %PORT;
+ for (1 .. 10) {
+ $port += int(rand(700));
+ next if exists $usedports{$port};
+ my $options = "$flags --accept $port";
+ my $cmd = "$perl $srcdir/secureserver.pl $options";
+ ($protospid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($protospid <= 0 || !pidexists($protospid)) {
+ # it is NOT alive
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ $protospid = $pid2 = 0;
+ next;
+ }
+
+ $doesntrun{$pidfile} = 0;
+ $runcert{$server} = $certfile;
+
+ if($verb) {
+ logmsg "RUN: $srvrname server is PID $protospid port $port\n";
+ }
+ last;
+ }
+
+ logmsg "RUN: failed to start the $srvrname server\n" if(!$protospid);
+
+ return ($protospid, $pid2, $port);
+}
+
+#######################################################################
+# start the tftp server
+#
+sub runtftpserver {
+ my ($id, $verb, $ipv6) = @_;
+ my $ip = $HOSTIP;
+ my $proto = 'tftp';
+ my $ipvnum = 4;
+ my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
+
+ if($ipv6) {
+ # if IPv6, use a different setup
+ $ipvnum = 6;
+ $ip = $HOST6IP;
+ }
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $portfile = $serverportfile{$server};
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--verbose " if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" ";
+ $flags .= "--portfile \"$portfile\" ";
+ $flags .= "--logfile \"$logfile\" ";
+ $flags .= "--logdir \"$LOGDIR\" ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ $flags .= "--ipv$ipvnum --port 0 --srcdir \"$srcdir\"";
+
+ my $cmd = "$perl $srcdir/tftpserver.pl $flags";
+ my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($tftppid <= 0 || !pidexists($tftppid)) {
+ # it is NOT alive
+ logmsg "RUN: failed to start the $srvrname server\n";
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0, 0, 0);
+ }
+
+ my $port = pidfromfile($portfile);
+
+ # Server is up. Verify that we can speak to it.
+ my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
+ if(!$pid3) {
+ logmsg "RUN: $srvrname server failed verification\n";
+ # failed to talk to it properly. Kill the server and return failure
+ stopserver($server, "$tftppid $pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0, 0, 0);
+ }
+ $pid2 = $pid3;
+
+ if($verb) {
+ logmsg "RUN: $srvrname server on PID $tftppid port $port\n";
+ }
+
+ return ($pid2, $tftppid, $port);
+}
+
+
+#######################################################################
+# start the rtsp server
+#
+sub runrtspserver {
+ my ($verb, $ipv6) = @_;
+ my $ip = $HOSTIP;
+ my $proto = 'rtsp';
+ my $ipvnum = 4;
+ my $idnum = 1;
+
+ if($ipv6) {
+ # if IPv6, use a different setup
+ $ipvnum = 6;
+ $ip = $HOST6IP;
+ }
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+ my $portfile = $serverportfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--verbose " if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" ";
+ $flags .= "--portfile \"$portfile\" ";
+ $flags .= "--logfile \"$logfile\" ";
+ $flags .= "--logdir \"$LOGDIR\" ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ $flags .= "--ipv$ipvnum --port 0 --srcdir \"$srcdir\"";
+
+ my $cmd = "$perl $srcdir/rtspserver.pl $flags";
+ my ($rtsppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($rtsppid <= 0 || !pidexists($rtsppid)) {
+ # it is NOT alive
+ logmsg "RUN: failed to start the $srvrname server\n";
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0, 0, 0);
+ }
+
+ my $port = pidfromfile($portfile);
+
+ # Server is up. Verify that we can speak to it.
+ my $pid3 = verifyserver($proto, $ipvnum, $idnum, $ip, $port);
+ if(!$pid3) {
+ logmsg "RUN: $srvrname server failed verification\n";
+ # failed to talk to it properly. Kill the server and return failure
+ stopserver($server, "$rtsppid $pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ return (0, 0, 0);
+ }
+ $pid2 = $pid3;
+
+ if($verb) {
+ logmsg "RUN: $srvrname server PID $rtsppid port $port\n";
+ }
+
+ return ($rtsppid, $pid2, $port);
+}
+
+
+#######################################################################
+# Start the ssh (scp/sftp) server
+#
+sub runsshserver {
+ my ($id, $verb, $ipv6) = @_;
+ my $ip=$HOSTIP;
+ my $proto = 'ssh';
+ my $ipvnum = 4;
+ my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
+ my $port = 20000; # no lower port
+
+ if(!$USER) {
+ logmsg "Can't start ssh server due to lack of USER name";
+ return (0,0,0);
+ }
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0);
+ }
+
+ my $sshd = find_sshd();
+ if($sshd) {
+ ($sshdid,$sshdvernum,$sshdverstr,$sshderror) = sshversioninfo($sshd);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--verbose " if($verb);
+ $flags .= "--debugprotocol " if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" ";
+ $flags .= "--logdir \"$LOGDIR\" ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ $flags .= "--ipv$ipvnum --addr \"$ip\" ";
+ $flags .= "--user \"$USER\"";
+
+ my $sshpid;
+ my $pid2;
+
+ my $wport = 0,
+ my @tports;
+ for(1 .. 10) {
+
+ # sshd doesn't have a way to pick an unused random port number, so
+ # instead we iterate over possible port numbers to use until we find
+ # one that works
+ $port += int(rand(500));
+ push @tports, $port;
+
+ my $options = "$flags --sshport $port";
+
+ my $cmd = "$perl $srcdir/sshserver.pl $options";
+ ($sshpid, $pid2) = startnew($cmd, $pidfile, 60, 0);
+
+ # on loaded systems sshserver start up can take longer than the
+ # timeout passed to startnew, when this happens startnew completes
+ # without being able to read the pidfile and consequently returns a
+ # zero pid2 above.
+ if($sshpid <= 0 || !pidexists($sshpid)) {
+ # it is NOT alive
+ stopserver($server, "$pid2");
+ $doesntrun{$pidfile} = 1;
+ $sshpid = $pid2 = 0;
+ next;
+ }
+
+ # once it is known that the ssh server is alive, sftp server
+ # verification is performed actually connecting to it, authenticating
+ # and performing a very simple remote command. This verification is
+ # tried only one time.
+
+ $sshdlog = server_logfilename($LOGDIR, 'ssh', $ipvnum, $idnum);
+ $sftplog = server_logfilename($LOGDIR, 'sftp', $ipvnum, $idnum);
+
+ if(verifysftp('sftp', $ipvnum, $idnum, $ip, $port) < 1) {
+ logmsg "RUN: SFTP server failed verification\n";
+ # failed to talk to it properly. Kill the server and return failure
+ display_sftplog();
+ display_sftpconfig();
+ display_sshdlog();
+ display_sshdconfig();
+ stopserver($server, "$sshpid $pid2");
+ $doesntrun{$pidfile} = 1;
+ $sshpid = $pid2 = 0;
+ next;
+ }
+ # we're happy, no need to loop anymore!
+ $doesntrun{$pidfile} = 0;
+ $wport = $port;
+ last;
+ }
+ logmsg "RUN: failed to start the $srvrname server on $port\n" if(!$sshpid);
+
+ if(!$wport) {
+ logmsg "RUN: couldn't start $srvrname. Tried these ports:";
+ logmsg "RUN: ".join(", ", @tports)."\n";
+ return (0,0,0);
+ }
+
+ my $hostfile;
+ if(!open($hostfile, "<", $PIDDIR . "/" . $hstpubmd5f) ||
+ (read($hostfile, $SSHSRVMD5, 32) != 32) ||
+ !close($hostfile) ||
+ ($SSHSRVMD5 !~ /^[a-f0-9]{32}$/i))
+ {
+ my $msg = "Fatal: $srvrname pubkey md5 missing : \"$hstpubmd5f\" : $!";
+ logmsg "$msg\n";
+ stopservers($verb);
+ die $msg;
+ }
+
+ if(!open($hostfile, "<", $PIDDIR . "/" . $hstpubsha256f) ||
+ (read($hostfile, $SSHSRVSHA256, 48) == 0) ||
+ !close($hostfile))
+ {
+ my $msg = "Fatal: $srvrname pubkey sha256 missing : \"$hstpubsha256f\" : $!";
+ logmsg "$msg\n";
+ stopservers($verb);
+ die $msg;
+ }
+
+ logmsg "RUN: $srvrname on PID $pid2 port $wport\n" if($verb);
+
+ return ($pid2, $sshpid, $wport);
+}
+
+#######################################################################
+# Start the MQTT server
+#
+sub runmqttserver {
+ my ($id, $verb, $ipv6) = @_;
+ my $ip=$HOSTIP;
+ my $proto = 'mqtt';
+ my $port = protoport($proto);
+ my $ipvnum = 4;
+ my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+ my $pidfile = $serverpidfile{$server};
+ my $portfile = $serverportfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0,0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ # start our MQTT server - on a random port!
+ my $cmd="server/mqttd".exe_ext('SRV').
+ " --port 0 ".
+ " --pidfile $pidfile".
+ " --portfile $portfile".
+ " --config $FTPDCMD".
+ " --logfile $logfile".
+ " --logdir $LOGDIR";
+ my ($sockspid, $pid2) = startnew($cmd, $pidfile, 30, 0);
+
+ if($sockspid <= 0 || !pidexists($sockspid)) {
+ # it is NOT alive
+ logmsg "RUN: failed to start the $srvrname server\n";
+ stopserver($server, "$pid2");
+ $doesntrun{$pidfile} = 1;
+ return (0,0);
+ }
+
+ my $mqttport = pidfromfile($portfile);
+ $PORT{"mqtt"} = $mqttport;
+
+ if($verb) {
+ logmsg "RUN: $srvrname server is now running PID $pid2 on PORT $mqttport\n";
+ }
+
+ return ($pid2, $sockspid);
+}
+
+#######################################################################
+# Start the socks server
+#
+sub runsocksserver {
+ my ($id, $verb, $ipv6, $is_unix) = @_;
+ my $ip=$HOSTIP;
+ my $proto = 'socks';
+ my $ipvnum = 4;
+ my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $portfile = $serverportfile{$server};
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ # start our socks server, get commands from the FTP cmd file
+ my $cmd="";
+ if($is_unix) {
+ $cmd="server/socksd".exe_ext('SRV').
+ " --pidfile $pidfile".
+ " --reqfile $SOCKSIN".
+ " --logfile $logfile".
+ " --unix-socket $SOCKSUNIXPATH".
+ " --backend $HOSTIP".
+ " --config $FTPDCMD";
+ } else {
+ $cmd="server/socksd".exe_ext('SRV').
+ " --port 0 ".
+ " --pidfile $pidfile".
+ " --portfile $portfile".
+ " --reqfile $SOCKSIN".
+ " --logfile $logfile".
+ " --backend $HOSTIP".
+ " --config $FTPDCMD";
+ }
+ my ($sockspid, $pid2) = startnew($cmd, $pidfile, 30, 0);
+
+ if($sockspid <= 0 || !pidexists($sockspid)) {
+ # it is NOT alive
+ logmsg "RUN: failed to start the $srvrname server\n";
+ stopserver($server, "$pid2");
+ $doesntrun{$pidfile} = 1;
+ return (0, 0, 0);
+ }
+
+ my $port = pidfromfile($portfile);
+
+ if($verb) {
+ logmsg "RUN: $srvrname server is now running PID $pid2\n";
+ }
+
+ return ($pid2, $sockspid, $port);
+}
+
+#######################################################################
+# start the dict server
+#
+sub rundictserver {
+ my ($verb, $alt) = @_;
+ my $proto = "dict";
+ my $ip = $HOSTIP;
+ my $ipvnum = 4;
+ my $idnum = 1;
+
+ if($alt eq "ipv6") {
+ # No IPv6
+ }
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--verbose 1 " if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ $flags .= "--srcdir \"$srcdir\" ";
+ $flags .= "--host $HOSTIP";
+
+ my $port = 29000;
+ my ($dictpid, $pid2);
+ for(1 .. 10) {
+ $port += int(rand(900));
+ my $aflags = "--port $port $flags";
+ my $cmd = "$srcdir/dictserver.py $aflags";
+ ($dictpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($dictpid <= 0 || !pidexists($dictpid)) {
+ # it is NOT alive
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ $dictpid = $pid2 = 0;
+ next;
+ }
+ $doesntrun{$pidfile} = 0;
+
+ if($verb) {
+ logmsg "RUN: $srvrname server PID $dictpid port $port\n";
+ }
+ last;
+ }
+ logmsg "RUN: failed to start the $srvrname server\n" if(!$dictpid);
+
+ return ($dictpid, $pid2, $port);
+}
+
+#######################################################################
+# start the SMB server
+#
+sub runsmbserver {
+ my ($verb, $alt) = @_;
+ my $proto = "smb";
+ my $ip = $HOSTIP;
+ my $ipvnum = 4;
+ my $idnum = 1;
+
+ if($alt eq "ipv6") {
+ # No IPv6
+ }
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--verbose 1 " if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ $flags .= "--srcdir \"$srcdir\" ";
+ $flags .= "--host $HOSTIP";
+
+ my ($smbpid, $pid2);
+ my $port = 31923;
+ for(1 .. 10) {
+ $port += int(rand(760));
+ my $aflags = "--port $port $flags";
+ my $cmd = "$srcdir/smbserver.py $aflags";
+ ($smbpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($smbpid <= 0 || !pidexists($smbpid)) {
+ # it is NOT alive
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ $smbpid = $pid2 = 0;
+ next;
+ }
+ $doesntrun{$pidfile} = 0;
+
+ if($verb) {
+ logmsg "RUN: $srvrname server PID $smbpid port $port\n";
+ }
+ last;
+ }
+ logmsg "RUN: failed to start the $srvrname server\n" if(!$smbpid);
+
+ return ($smbpid, $pid2, $port);
+}
+
+#######################################################################
+# start the telnet server
+#
+sub runnegtelnetserver {
+ my ($verb, $alt) = @_;
+ my $proto = "telnet";
+ my $ip = $HOSTIP;
+ my $ipvnum = 4;
+ my $idnum = 1;
+
+ if($alt eq "ipv6") {
+ # No IPv6
+ }
+
+ my $server = servername_id($proto, $ipvnum, $idnum);
+
+ my $pidfile = $serverpidfile{$server};
+
+ # don't retry if the server doesn't work
+ if ($doesntrun{$pidfile}) {
+ return (0, 0, 0);
+ }
+
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ stopserver($server, "$pid");
+ }
+ unlink($pidfile) if(-f $pidfile);
+
+ my $srvrname = servername_str($proto, $ipvnum, $idnum);
+ my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
+
+ my $flags = "";
+ $flags .= "--verbose 1 " if($debugprotocol);
+ $flags .= "--pidfile \"$pidfile\" --logfile \"$logfile\" ";
+ $flags .= "--id $idnum " if($idnum > 1);
+ $flags .= "--srcdir \"$srcdir\"";
+
+ my ($ntelpid, $pid2);
+ my $port = 32000;
+ for(1 .. 10) {
+ $port += int(rand(800));
+ my $aflags = "--port $port $flags";
+ my $cmd = "$srcdir/negtelnetserver.py $aflags";
+ ($ntelpid, $pid2) = startnew($cmd, $pidfile, 15, 0);
+
+ if($ntelpid <= 0 || !pidexists($ntelpid)) {
+ # it is NOT alive
+ stopserver($server, "$pid2");
+ displaylogs($testnumcheck);
+ $doesntrun{$pidfile} = 1;
+ $ntelpid = $pid2 = 0;
+ next;
+ }
+ $doesntrun{$pidfile} = 0;
+
+ if($verb) {
+ logmsg "RUN: $srvrname server PID $ntelpid port $port\n";
+ }
+ last;
+ }
+ logmsg "RUN: failed to start the $srvrname server\n" if(!$ntelpid);
+
+ return ($ntelpid, $pid2, $port);
+}
+
+
+
+
+#######################################################################
+# Single shot http and gopher server responsiveness test. This should only
+# be used to verify that a server present in %run hash is still functional
+#
+sub responsive_http_server {
+ my ($proto, $verb, $alt, $port_or_path) = @_;
+ my $ip = $HOSTIP;
+ my $ipvnum = 4;
+ my $idnum = 1;
+
+ if($alt eq "ipv6") {
+ # if IPv6, use a different setup
+ $ipvnum = 6;
+ $ip = $HOST6IP;
+ }
+ elsif($alt eq "proxy") {
+ $idnum = 2;
+ }
+ elsif($alt eq "unix") {
+ # IP (protocol) is mutually exclusive with Unix sockets
+ $ipvnum = "unix";
+ }
+
+ return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port_or_path);
+}
+
+#######################################################################
+# Single shot pingpong server responsiveness test. This should only be
+# used to verify that a server present in %run hash is still functional
+#
+sub responsive_pingpong_server {
+ my ($proto, $id, $verb, $ipv6) = @_;
+ my $port;
+ my $ip = ($ipv6 && ($ipv6 =~ /6$/)) ? "$HOST6IP" : "$HOSTIP";
+ my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
+ my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
+ my $protoip = $proto . ($ipvnum == 6? '6': '');
+
+ if($proto =~ /^(?:ftp|imap|pop3|smtp)$/) {
+ $port = protoport($protoip);
+ }
+ else {
+ print STDERR "Unsupported protocol $proto!!\n";
+ return 0;
+ }
+
+ return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
+}
+
+#######################################################################
+# Single shot rtsp server responsiveness test. This should only be
+# used to verify that a server present in %run hash is still functional
+#
+sub responsive_rtsp_server {
+ my ($verb, $ipv6) = @_;
+ my $proto = 'rtsp';
+ my $port = protoport($proto);
+ my $ip = $HOSTIP;
+ my $ipvnum = 4;
+ my $idnum = 1;
+
+ if($ipv6) {
+ # if IPv6, use a different setup
+ $ipvnum = 6;
+ $port = protoport('rtsp6');
+ $ip = $HOST6IP;
+ }
+
+ return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
+}
+
+#######################################################################
+# Single shot tftp server responsiveness test. This should only be
+# used to verify that a server present in %run hash is still functional
+#
+sub responsive_tftp_server {
+ my ($id, $verb, $ipv6) = @_;
+ my $proto = 'tftp';
+ my $port = protoport($proto);
+ my $ip = $HOSTIP;
+ my $ipvnum = 4;
+ my $idnum = ($id && ($id =~ /^(\d+)$/) && ($id > 1)) ? $id : 1;
+
+ if($ipv6) {
+ # if IPv6, use a different setup
+ $ipvnum = 6;
+ $port = protoport('tftp6');
+ $ip = $HOST6IP;
+ }
+
+ return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
+}
+
+#######################################################################
+# Single shot non-stunnel HTTP TLS extensions capable server
+# responsiveness test. This should only be used to verify that a
+# server present in %run hash is still functional
+#
+sub responsive_httptls_server {
+ my ($verb, $ipv6) = @_;
+ my $ipvnum = ($ipv6 && ($ipv6 =~ /6$/)) ? 6 : 4;
+ my $proto = "httptls";
+ my $port = protoport($proto);
+ my $ip = "$HOSTIP";
+ my $idnum = 1;
+
+ if ($ipvnum == 6) {
+ $port = protoport("httptls6");
+ $ip = "$HOST6IP";
+ }
+
+ return &responsiveserver($proto, $ipvnum, $idnum, $ip, $port);
+}
+
+#######################################################################
+# startservers() starts all the named servers
+#
+# Returns: string with error reason or blank for success
+#
+sub startservers {
+ my @what = @_;
+ my ($pid, $pid2);
+ for(@what) {
+ my (@whatlist) = split(/\s+/,$_);
+ my $what = lc($whatlist[0]);
+ $what =~ s/[^a-z0-9\/-]//g;
+
+ my $certfile;
+ if($what =~ /^(ftp|gopher|http|imap|pop3|smtp)s((\d*)(-ipv6|-unix|))$/) {
+ $certfile = ($whatlist[1]) ? $whatlist[1] : 'stunnel.pem';
+ }
+
+ if(($what eq "pop3") ||
+ ($what eq "ftp") ||
+ ($what eq "imap") ||
+ ($what eq "smtp")) {
+ if($torture && $run{$what} &&
+ !responsive_pingpong_server($what, "", $verbose)) {
+ if(stopserver($what)) {
+ return "failed stopping unresponsive ".uc($what)." server";
+ }
+ }
+ if(!$run{$what}) {
+ ($pid, $pid2) = runpingpongserver($what, "", $verbose);
+ if($pid <= 0) {
+ return "failed starting ". uc($what) ." server";
+ }
+ printf ("* pid $what => %d %d\n", $pid, $pid2) if($verbose);
+ $run{$what}="$pid $pid2";
+ }
+ }
+ elsif($what eq "ftp-ipv6") {
+ if($torture && $run{'ftp-ipv6'} &&
+ !responsive_pingpong_server("ftp", "", $verbose, "ipv6")) {
+ if(stopserver('ftp-ipv6')) {
+ return "failed stopping unresponsive FTP-IPv6 server";
+ }
+ }
+ if(!$run{'ftp-ipv6'}) {
+ ($pid, $pid2) = runpingpongserver("ftp", "", $verbose, "ipv6");
+ if($pid <= 0) {
+ return "failed starting FTP-IPv6 server";
+ }
+ logmsg sprintf("* pid ftp-ipv6 => %d %d\n", $pid,
+ $pid2) if($verbose);
+ $run{'ftp-ipv6'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "gopher") {
+ if($torture && $run{'gopher'} &&
+ !responsive_http_server("gopher", $verbose, 0,
+ protoport("gopher"))) {
+ if(stopserver('gopher')) {
+ return "failed stopping unresponsive GOPHER server";
+ }
+ }
+ if(!$run{'gopher'}) {
+ ($pid, $pid2, $PORT{'gopher'}) =
+ runhttpserver("gopher", $verbose, 0);
+ if($pid <= 0) {
+ return "failed starting GOPHER server";
+ }
+ logmsg sprintf ("* pid gopher => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'gopher'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "gopher-ipv6") {
+ if($torture && $run{'gopher-ipv6'} &&
+ !responsive_http_server("gopher", $verbose, "ipv6",
+ protoport("gopher"))) {
+ if(stopserver('gopher-ipv6')) {
+ return "failed stopping unresponsive GOPHER-IPv6 server";
+ }
+ }
+ if(!$run{'gopher-ipv6'}) {
+ ($pid, $pid2, $PORT{"gopher6"}) =
+ runhttpserver("gopher", $verbose, "ipv6");
+ if($pid <= 0) {
+ return "failed starting GOPHER-IPv6 server";
+ }
+ logmsg sprintf("* pid gopher-ipv6 => %d %d\n", $pid,
+ $pid2) if($verbose);
+ $run{'gopher-ipv6'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "http/3") {
+ if(!$run{'http/3'}) {
+ ($pid, $pid2, $PORT{"http3"}) = runhttp3server($verbose);
+ if($pid <= 0) {
+ return "failed starting HTTP/3 server";
+ }
+ logmsg sprintf ("* pid http/3 => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'http/3'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "http/2") {
+ if(!$run{'http/2'}) {
+ ($pid, $pid2, $PORT{"http2"}, $PORT{"http2tls"}) =
+ runhttp2server($verbose);
+ if($pid <= 0) {
+ return "failed starting HTTP/2 server";
+ }
+ logmsg sprintf ("* pid http/2 => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'http/2'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "http") {
+ if($torture && $run{'http'} &&
+ !responsive_http_server("http", $verbose, 0, protoport('http'))) {
+ if(stopserver('http')) {
+ return "failed stopping unresponsive HTTP server";
+ }
+ }
+ if(!$run{'http'}) {
+ ($pid, $pid2, $PORT{'http'}) =
+ runhttpserver("http", $verbose, 0);
+ if($pid <= 0) {
+ return "failed starting HTTP server";
+ }
+ logmsg sprintf ("* pid http => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'http'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "http-proxy") {
+ if($torture && $run{'http-proxy'} &&
+ !responsive_http_server("http", $verbose, "proxy",
+ protoport("httpproxy"))) {
+ if(stopserver('http-proxy')) {
+ return "failed stopping unresponsive HTTP-proxy server";
+ }
+ }
+ if(!$run{'http-proxy'}) {
+ ($pid, $pid2, $PORT{"httpproxy"}) =
+ runhttpserver("http", $verbose, "proxy");
+ if($pid <= 0) {
+ return "failed starting HTTP-proxy server";
+ }
+ logmsg sprintf ("* pid http-proxy => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'http-proxy'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "http-ipv6") {
+ if($torture && $run{'http-ipv6'} &&
+ !responsive_http_server("http", $verbose, "ipv6",
+ protoport("http6"))) {
+ if(stopserver('http-ipv6')) {
+ return "failed stopping unresponsive HTTP-IPv6 server";
+ }
+ }
+ if(!$run{'http-ipv6'}) {
+ ($pid, $pid2, $PORT{"http6"}) =
+ runhttpserver("http", $verbose, "ipv6");
+ if($pid <= 0) {
+ return "failed starting HTTP-IPv6 server";
+ }
+ logmsg sprintf("* pid http-ipv6 => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'http-ipv6'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "rtsp") {
+ if($torture && $run{'rtsp'} &&
+ !responsive_rtsp_server($verbose)) {
+ if(stopserver('rtsp')) {
+ return "failed stopping unresponsive RTSP server";
+ }
+ }
+ if(!$run{'rtsp'}) {
+ ($pid, $pid2, $PORT{'rtsp'}) = runrtspserver($verbose);
+ if($pid <= 0) {
+ return "failed starting RTSP server";
+ }
+ printf ("* pid rtsp => %d %d\n", $pid, $pid2) if($verbose);
+ $run{'rtsp'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "rtsp-ipv6") {
+ if($torture && $run{'rtsp-ipv6'} &&
+ !responsive_rtsp_server($verbose, "ipv6")) {
+ if(stopserver('rtsp-ipv6')) {
+ return "failed stopping unresponsive RTSP-IPv6 server";
+ }
+ }
+ if(!$run{'rtsp-ipv6'}) {
+ ($pid, $pid2, $PORT{'rtsp6'}) = runrtspserver($verbose, "ipv6");
+ if($pid <= 0) {
+ return "failed starting RTSP-IPv6 server";
+ }
+ logmsg sprintf("* pid rtsp-ipv6 => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'rtsp-ipv6'}="$pid $pid2";
+ }
+ }
+ elsif($what =~ /^(ftp|imap|pop3|smtp)s$/) {
+ my $cproto = $1;
+ if(!$stunnel) {
+ # we can't run ftps tests without stunnel
+ return "no stunnel";
+ }
+ if($runcert{$what} && ($runcert{$what} ne $certfile)) {
+ # stop server when running and using a different cert
+ if(stopserver($what)) {
+ return "failed stopping $what server with different cert";
+ }
+ }
+ if($torture && $run{$cproto} &&
+ !responsive_pingpong_server($cproto, "", $verbose)) {
+ if(stopserver($cproto)) {
+ return "failed stopping unresponsive $cproto server";
+ }
+ }
+ if(!$run{$cproto}) {
+ ($pid, $pid2) = runpingpongserver($cproto, "", $verbose);
+ if($pid <= 0) {
+ return "failed starting $cproto server";
+ }
+ printf ("* pid $cproto => %d %d\n", $pid, $pid2) if($verbose);
+ $run{$cproto}="$pid $pid2";
+ }
+ if(!$run{$what}) {
+ ($pid, $pid2, $PORT{$what}) =
+ runsecureserver($verbose, "", $certfile, $what,
+ protoport($cproto));
+ if($pid <= 0) {
+ return "failed starting $what server (stunnel)";
+ }
+ logmsg sprintf("* pid $what => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{$what}="$pid $pid2";
+ }
+ }
+ elsif($what eq "file") {
+ # we support it but have no server!
+ }
+ elsif($what eq "https") {
+ if(!$stunnel) {
+ # we can't run https tests without stunnel
+ return "no stunnel";
+ }
+ if($runcert{'https'} && ($runcert{'https'} ne $certfile)) {
+ # stop server when running and using a different cert
+ if(stopserver('https')) {
+ return "failed stopping HTTPS server with different cert";
+ }
+ }
+ if($torture && $run{'http'} &&
+ !responsive_http_server("http", $verbose, 0,
+ protoport('http'))) {
+ if(stopserver('http')) {
+ return "failed stopping unresponsive HTTP server";
+ }
+ }
+ if(!$run{'http'}) {
+ ($pid, $pid2, $PORT{'http'}) =
+ runhttpserver("http", $verbose, 0);
+ if($pid <= 0) {
+ return "failed starting HTTP server";
+ }
+ printf ("* pid http => %d %d\n", $pid, $pid2) if($verbose);
+ $run{'http'}="$pid $pid2";
+ }
+ if(!$run{'https'}) {
+ ($pid, $pid2, $PORT{'https'}) =
+ runhttpsserver($verbose, "https", "", $certfile);
+ if($pid <= 0) {
+ return "failed starting HTTPS server (stunnel)";
+ }
+ logmsg sprintf("* pid https => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'https'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "gophers") {
+ if(!$stunnel) {
+ # we can't run TLS tests without stunnel
+ return "no stunnel";
+ }
+ if($runcert{'gophers'} && ($runcert{'gophers'} ne $certfile)) {
+ # stop server when running and using a different cert
+ if(stopserver('gophers')) {
+ return "failed stopping GOPHERS server with different crt";
+ }
+ }
+ if($torture && $run{'gopher'} &&
+ !responsive_http_server("gopher", $verbose, 0,
+ protoport('gopher'))) {
+ if(stopserver('gopher')) {
+ return "failed stopping unresponsive GOPHER server";
+ }
+ }
+ if(!$run{'gopher'}) {
+ my $port;
+ ($pid, $pid2, $port) =
+ runhttpserver("gopher", $verbose, 0);
+ $PORT{'gopher'} = $port;
+ if($pid <= 0) {
+ return "failed starting GOPHER server";
+ }
+ printf ("* pid gopher => %d %d\n", $pid, $pid2) if($verbose);
+ print "GOPHERPORT => $port\n" if($verbose);
+ $run{'gopher'}="$pid $pid2";
+ }
+ if(!$run{'gophers'}) {
+ my $port;
+ ($pid, $pid2, $port) =
+ runhttpsserver($verbose, "gophers", "", $certfile);
+ $PORT{'gophers'} = $port;
+ if($pid <= 0) {
+ return "failed starting GOPHERS server (stunnel)";
+ }
+ logmsg sprintf("* pid gophers => %d %d\n", $pid, $pid2)
+ if($verbose);
+ print "GOPHERSPORT => $port\n" if($verbose);
+ $run{'gophers'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "https-proxy") {
+ if(!$stunnel) {
+ # we can't run https-proxy tests without stunnel
+ return "no stunnel";
+ }
+ if($runcert{'https-proxy'} &&
+ ($runcert{'https-proxy'} ne $certfile)) {
+ # stop server when running and using a different cert
+ if(stopserver('https-proxy')) {
+ return "failed stopping HTTPS-proxy with different cert";
+ }
+ }
+
+ # we front the http-proxy with stunnel so we need to make sure the
+ # proxy runs as well
+ my $f = startservers("http-proxy");
+ if($f) {
+ return $f;
+ }
+
+ if(!$run{'https-proxy'}) {
+ ($pid, $pid2, $PORT{"httpsproxy"}) =
+ runhttpsserver($verbose, "https", "proxy", $certfile);
+ if($pid <= 0) {
+ return "failed starting HTTPS-proxy (stunnel)";
+ }
+ logmsg sprintf("* pid https-proxy => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'https-proxy'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "httptls") {
+ if(!$httptlssrv) {
+ # for now, we can't run http TLS-EXT tests without gnutls-serv
+ return "no gnutls-serv (with SRP support)";
+ }
+ if($torture && $run{'httptls'} &&
+ !responsive_httptls_server($verbose, "IPv4")) {
+ if(stopserver('httptls')) {
+ return "failed stopping unresponsive HTTPTLS server";
+ }
+ }
+ if(!$run{'httptls'}) {
+ ($pid, $pid2, $PORT{'httptls'}) =
+ runhttptlsserver($verbose, "IPv4");
+ if($pid <= 0) {
+ return "failed starting HTTPTLS server (gnutls-serv)";
+ }
+ logmsg sprintf("* pid httptls => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'httptls'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "httptls-ipv6") {
+ if(!$httptlssrv) {
+ # for now, we can't run http TLS-EXT tests without gnutls-serv
+ return "no gnutls-serv";
+ }
+ if($torture && $run{'httptls-ipv6'} &&
+ !responsive_httptls_server($verbose, "ipv6")) {
+ if(stopserver('httptls-ipv6')) {
+ return "failed stopping unresponsive HTTPTLS-IPv6 server";
+ }
+ }
+ if(!$run{'httptls-ipv6'}) {
+ ($pid, $pid2, $PORT{"httptls6"}) =
+ runhttptlsserver($verbose, "ipv6");
+ if($pid <= 0) {
+ return "failed starting HTTPTLS-IPv6 server (gnutls-serv)";
+ }
+ logmsg sprintf("* pid httptls-ipv6 => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'httptls-ipv6'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "tftp") {
+ if($torture && $run{'tftp'} &&
+ !responsive_tftp_server("", $verbose)) {
+ if(stopserver('tftp')) {
+ return "failed stopping unresponsive TFTP server";
+ }
+ }
+ if(!$run{'tftp'}) {
+ ($pid, $pid2, $PORT{'tftp'}) =
+ runtftpserver("", $verbose);
+ if($pid <= 0) {
+ return "failed starting TFTP server";
+ }
+ printf ("* pid tftp => %d %d\n", $pid, $pid2) if($verbose);
+ $run{'tftp'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "tftp-ipv6") {
+ if($torture && $run{'tftp-ipv6'} &&
+ !responsive_tftp_server("", $verbose, "ipv6")) {
+ if(stopserver('tftp-ipv6')) {
+ return "failed stopping unresponsive TFTP-IPv6 server";
+ }
+ }
+ if(!$run{'tftp-ipv6'}) {
+ ($pid, $pid2, $PORT{'tftp6'}) =
+ runtftpserver("", $verbose, "ipv6");
+ if($pid <= 0) {
+ return "failed starting TFTP-IPv6 server";
+ }
+ printf("* pid tftp-ipv6 => %d %d\n", $pid, $pid2) if($verbose);
+ $run{'tftp-ipv6'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "sftp" || $what eq "scp") {
+ if(!$run{'ssh'}) {
+ ($pid, $pid2, $PORT{'ssh'}) = runsshserver("", $verbose);
+ if($pid <= 0) {
+ return "failed starting SSH server";
+ }
+ printf ("* pid ssh => %d %d\n", $pid, $pid2) if($verbose);
+ $run{'ssh'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "socks4" || $what eq "socks5" ) {
+ if(!$run{'socks'}) {
+ ($pid, $pid2, $PORT{"socks"}) = runsocksserver("", $verbose);
+ if($pid <= 0) {
+ return "failed starting socks server";
+ }
+ printf ("* pid socks => %d %d\n", $pid, $pid2) if($verbose);
+ $run{'socks'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "socks5unix") {
+ if(!$run{'socks5unix'}) {
+ ($pid, $pid2) = runsocksserver("2", $verbose, "", "unix");
+ if($pid <= 0) {
+ return "failed starting socks5unix server";
+ }
+ printf ("* pid socks5unix => %d %d\n", $pid, $pid2) if($verbose);
+ $run{'socks5unix'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "mqtt" ) {
+ if(!$run{'mqtt'}) {
+ ($pid, $pid2) = runmqttserver("", $verbose);
+ if($pid <= 0) {
+ return "failed starting mqtt server";
+ }
+ printf ("* pid mqtt => %d %d\n", $pid, $pid2) if($verbose);
+ $run{'mqtt'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "http-unix") {
+ if($torture && $run{'http-unix'} &&
+ !responsive_http_server("http", $verbose, "unix", $HTTPUNIXPATH)) {
+ if(stopserver('http-unix')) {
+ return "failed stopping unresponsive HTTP-unix server";
+ }
+ }
+ if(!$run{'http-unix'}) {
+ my $unused;
+ ($pid, $pid2, $unused) =
+ runhttpserver("http", $verbose, "unix", $HTTPUNIXPATH);
+ if($pid <= 0) {
+ return "failed starting HTTP-unix server";
+ }
+ logmsg sprintf("* pid http-unix => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'http-unix'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "dict") {
+ if(!$run{'dict'}) {
+ ($pid, $pid2, $PORT{"dict"}) = rundictserver($verbose, "");
+ if($pid <= 0) {
+ return "failed starting DICT server";
+ }
+ logmsg sprintf ("* pid DICT => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'dict'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "smb") {
+ if(!$run{'smb'}) {
+ ($pid, $pid2, $PORT{"smb"}) = runsmbserver($verbose, "");
+ if($pid <= 0) {
+ return "failed starting SMB server";
+ }
+ logmsg sprintf ("* pid SMB => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'smb'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "telnet") {
+ if(!$run{'telnet'}) {
+ ($pid, $pid2, $PORT{"telnet"}) =
+ runnegtelnetserver($verbose, "");
+ if($pid <= 0) {
+ return "failed starting neg TELNET server";
+ }
+ logmsg sprintf ("* pid neg TELNET => %d %d\n", $pid, $pid2)
+ if($verbose);
+ $run{'telnet'}="$pid $pid2";
+ }
+ }
+ elsif($what eq "none") {
+ logmsg "* starts no server\n" if ($verbose);
+ }
+ else {
+ warn "we don't support a server for $what";
+ return "no server for $what";
+ }
+ }
+ return 0;
+}
+
+#######################################################################
+# Stop all running test servers
+#
+sub stopservers {
+ my $verb = $_[0];
+ #
+ # kill sockfilter processes for all pingpong servers
+ #
+ killallsockfilters($PIDDIR, $verb);
+ #
+ # kill all server pids from %run hash clearing them
+ #
+ my $pidlist;
+ foreach my $server (keys %run) {
+ if($run{$server}) {
+ if($verb) {
+ my $prev = 0;
+ my $pids = $run{$server};
+ foreach my $pid (split(' ', $pids)) {
+ if($pid != $prev) {
+ logmsg sprintf("* kill pid for %s => %d\n",
+ $server, $pid);
+ $prev = $pid;
+ }
+ }
+ }
+ $pidlist .= "$run{$server} ";
+ $run{$server} = 0;
+ }
+ $runcert{$server} = 0 if($runcert{$server});
+ }
+ killpid($verb, $pidlist);
+ #
+ # cleanup all server pid files
+ #
+ my $result = 0;
+ foreach my $server (keys %serverpidfile) {
+ my $pidfile = $serverpidfile{$server};
+ my $pid = processexists($pidfile);
+ if($pid > 0) {
+ if($err_unexpected) {
+ logmsg "ERROR: ";
+ $result = -1;
+ }
+ else {
+ logmsg "Warning: ";
+ }
+ logmsg "$server server unexpectedly alive\n";
+ killpid($verb, $pid);
+ }
+ unlink($pidfile) if(-f $pidfile);
+ }
+
+ return $result;
+}
+
+
+1;
projects / thirdparty / curl.git / commitdiff
