tests: improve server start reliability

Fix all lookups of the port a server is using by
- unlinking the portfile before the start
- waiting `timeout` seconds for the port file to exist
  and contain a positive number
- check results and fail server start when port could
  not be determined

Closes #17516

tests/processhelp.pm

@@ -94,12 +94,18 @@ sub portable_sleep {
 #
 sub pidfromfile {
     my $pidfile = $_[0];
+    my $timeout_sec = $_[1];
     my $pid = 0;
-
+    my $waits = 0;
-    if(-f $pidfile && -s $pidfile && open(my $pidfh, "<", "$pidfile")) {
+    # wait at max 15 seconds for the file to exist and have valid content
-        $pid = 0 + <$pidfh>;
+    while(!$pid && ($waits <= ($timeout_sec * 10))) {
-        close($pidfh);
+        if(-f $pidfile && -s $pidfile && open(my $pidfh, "<", "$pidfile")) {
-        $pid = 0 if($pid < 0);
+            $pid = 0 + <$pidfh>;
+            close($pidfh);
+            $pid = 0 if($pid < 0);
+        }
+        Time::HiRes::sleep(0.1) unless $pid || !$timeout_sec;
+        ++$waits;
     }
     return $pid;
 }
@@ -250,7 +256,7 @@ sub processexists {
     my $pidfile = $_[0];
 
     # fetch pid from pidfile
-    my $pid = pidfromfile($pidfile);
+    my $pid = pidfromfile($pidfile, 0);
 
     if($pid > 0) {
         # verify if currently alive
@@ -259,7 +265,7 @@ sub processexists {
         }
         else {
             # get rid of the certainly invalid pidfile
-            unlink($pidfile) if($pid == pidfromfile($pidfile));
+            unlink($pidfile) if($pid == pidfromfile($pidfile, 0));
             # reap its dead children, if not done yet
             pidwait($pid, &WNOHANG);
             # negative return value means dead process

tests/servers.pm

@@ -142,6 +142,7 @@ my $SSHSRVSHA256 = "[uninitialized]"; # SHA256 of ssh server public key
 my $USER;                  # name of the current user
 my $sshdid;                # for socks server, ssh daemon version id
 my $ftpchecktime=1;        # time it took to verify our test FTP server
+my $SERVER_TIMEOUT_SEC = 15; # time for a server to spin up
 
 # Variables shared with runtests.pl
 our $SOCKSIN="socksd-request.log"; # what curl sent to the SOCKS proxy
@@ -381,7 +382,7 @@ sub startnew {
     my $pid2 = 0;
     my $count = $timeout;
     while($count--) {
-        $pid2 = pidfromfile($pidfile);
+        $pid2 = pidfromfile($pidfile, 0);
         if(($pid2 > 0) && pidexists($pid2)) {
             # if $pid2 is valid, then make sure this pid is alive, as
             # otherwise it is just likely to be the _previous_ pidfile or
@@ -1135,6 +1136,8 @@ sub runhttpserver {
     $flags .= "--srcdir \"$srcdir\"";
 
     my $cmd = "$exe $flags";
+
+    unlink($portfile); # need to see a new one
     my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
 
     if($httppid <= 0 || !pidexists($httppid)) {
@@ -1147,15 +1150,11 @@ sub runhttpserver {
 
     # where is it?
     my $port = 0;
-    my $waits = 0;
+    $port = $port_or_path = pidfromfile($portfile, $SERVER_TIMEOUT_SEC);
-    # wait at max 15 seconds to the port file to become valid
-    while(!$port_or_path && ($waits < (15 * 10))) {
-        $port = $port_or_path = pidfromfile($portfile);
-        Time::HiRes::sleep(0.1) unless $port_or_path;
-        ++$waits;
-    }
     if(!$port) {
-        logmsg "RUN: failed waiting for server to produce port file $portfile\n";
+        logmsg "RUN: timeout for $srvrname to produce port file $portfile\n";
+        stopserver($server, "$pid2");
+        $doesntrun{$pidfile} = 1;
         return (1, 0, 0, 0);
     }
 
@@ -1476,6 +1475,7 @@ sub runpingpongserver {
     $flags .= "--id $idnum " if($idnum > 1);
     $flags .= "--ipv$ipvnum --port 0 --addr \"$ip\"";
 
+    unlink($portfile); # need to see a new one
     my $cmd = "$perl " . shell_quote("$srcdir/ftpserver.pl") . " " . $flags;
     my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
 
@@ -1488,7 +1488,13 @@ sub runpingpongserver {
     }
 
     # where is it?
-    my $port = pidfromfile($portfile);
+    my $port = pidfromfile($portfile, $SERVER_TIMEOUT_SEC);
+    if(!$port) {
+        logmsg "RUN: timeout for $srvrname to produce port file $portfile\n";
+        stopserver($server, "$pid2");
+        $doesntrun{$pidfile} = 1;
+        return (1, 0, 0, 0);
+    }
 
     logmsg "PINGPONG runs on port $port ($portfile)\n" if($verb);
 
@@ -1612,6 +1618,7 @@ sub runtftpserver {
     $flags .= "--id $idnum " if($idnum > 1);
     $flags .= "--ipv$ipvnum --port 0 --srcdir \"$srcdir\"";
 
+    unlink($portfile); # need to see a new one
     my $cmd = "$perl " . shell_quote("$srcdir/tftpserver.pl") . " " . $flags;
     my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
 
@@ -1623,7 +1630,13 @@ sub runtftpserver {
         return (1, 0, 0, 0);
     }
 
-    my $port = pidfromfile($portfile);
+    my $port = pidfromfile($portfile, $SERVER_TIMEOUT_SEC);
+    if(!$port) {
+        logmsg "RUN: timeout for $srvrname to produce port file $portfile\n";
+        stopserver($server, "$pid2");
+        $doesntrun{$pidfile} = 1;
+        return (1, 0, 0, 0);
+    }
 
     if($verb) {
         logmsg "RUN: $srvrname server on PID $tftppid port $port\n";
@@ -1677,6 +1690,7 @@ sub rundnsserver {
     $cmd .= " --id $idnum" if($idnum > 1);
     $cmd .= " --ipv$ipvnum";
 
+    unlink($portfile); # need to see a new one
     # start DNS server on a random port
     my ($dnspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
 
@@ -1688,7 +1702,13 @@ sub rundnsserver {
         return (1, 0, 0, 0);
     }
 
-    my $port = pidfromfile($portfile);
+    my $port = pidfromfile($portfile, $SERVER_TIMEOUT_SEC);
+    if(!$port) {
+        logmsg "RUN: timeout for $srvrname to produce port file $portfile\n";
+        stopserver($server, "$pid2");
+        $doesntrun{$pidfile} = 1;
+        return (1, 0, 0, 0);
+    }
 
     if($verb) {
         logmsg "RUN: $srvrname server on PID $dnspid port $port\n";
@@ -1741,6 +1761,7 @@ sub runrtspserver {
     $flags .= "--id $idnum " if($idnum > 1);
     $flags .= "--ipv$ipvnum --port 0 --srcdir \"$srcdir\"";
 
+    unlink($portfile); # need to see a new one
     my $cmd = "$perl " . shell_quote("$srcdir/rtspserver.pl") . " " . $flags;
     my ($rtsppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
 
@@ -1752,7 +1773,13 @@ sub runrtspserver {
         return (1, 0, 0, 0);
     }
 
-    my $port = pidfromfile($portfile);
+    my $port = pidfromfile($portfile, $SERVER_TIMEOUT_SEC);
+    if(!$port) {
+        logmsg "RUN: timeout for $srvrname to produce port file $portfile\n";
+        stopserver($server, "$pid2");
+        $doesntrun{$pidfile} = 1;
+        return (1, 0, 0, 0);
+    }
 
     if($verb) {
         logmsg "RUN: $srvrname server PID $rtsppid port $port\n";
@@ -1913,6 +1940,7 @@ sub runmqttserver {
     my $srvrname = servername_str($proto, $ipvnum, $idnum);
     my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
 
+    unlink($portfile); # need to see a new one
     # start our MQTT server - on a random port!
     my $cmd=server_exe('mqttd').
         " --port 0".
@@ -1931,7 +1959,13 @@ sub runmqttserver {
         return (1, 0, 0);
     }
 
-    my $mqttport = pidfromfile($portfile);
+    my $mqttport = pidfromfile($portfile, $SERVER_TIMEOUT_SEC);
+    if(!$mqttport) {
+        logmsg "RUN: timeout for $srvrname to produce port file $portfile\n";
+        stopserver($server, "$pid2");
+        $doesntrun{$pidfile} = 1;
+        return (1, 0, 0, 0);
+    }
 
     if($verb) {
         logmsg "RUN: $srvrname server is now running PID $pid2 on PORT $mqttport\n";
@@ -1969,6 +2003,7 @@ sub runsocksserver {
     my $portfile = $serverportfile{$server};
     my $logfile = server_logfilename($LOGDIR, $proto, $ipvnum, $idnum);
 
+    unlink($portfile); # need to see a new one
     # start our socks server, get commands from the FTP cmd file
     my $cmd="";
     if($is_unix) {
@@ -1979,6 +2014,7 @@ sub runsocksserver {
             " --unix-socket $SOCKSUNIXPATH".
             " --backend $HOSTIP".
             " --config $LOGDIR/$SERVERCMD";
+        $portfile = "none";
     } else {
         $cmd=server_exe('socksd').
             " --port 0".
@@ -1999,7 +2035,16 @@ sub runsocksserver {
         return (1, 0, 0, 0);
     }
 
-    my $port = pidfromfile($portfile);
+    my $port = 0;
+    if($portfile ne "none") {
+        $port = pidfromfile($portfile, $SERVER_TIMEOUT_SEC);
+        if(!$port) {
+            logmsg "RUN: timeout for $srvrname to produce port file $portfile\n";
+            stopserver($server, "$pid2");
+            $doesntrun{$pidfile} = 1;
+            return (1, 0, 0, 0);
+        }
+    }
 
     if($verb) {
         logmsg "RUN: $srvrname server is now running PID $pid2\n";