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