2
0

servers.pm 103 KB

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