runtests.pl: Modularization of MinGW/Msys compatibility functions

diff --git a/tests/ftp.pm b/tests/ftp.pm
index b38745120adb988650df82df01f3853fa9254ac5..76c6d5746abe1ffdcac413ca2a6552c0a876c4fd 100644 (file)
--- a/tests/ftp.pm
+++ b/tests/ftp.pm
@@ -47,6 +47,76 @@ sub pidfromfile {
     return $pid;
 }
 
+#######################################################################
+# pidexists checks if a process with a given pid exists and is alive.
+# This will return the positive pid if the process exists and is alive.
+# This will return the negative pid if the process exists differently.
+# This will return 0 if the process could not be found.
+#
+sub pidexists {
+    my $pid = $_[0];
+
+    if($pid > 0) {
+        # verify if currently existing and alive
+        if(kill(0, $pid)) {
+            return $pid;
+        }
+
+        # verify if currently existing Windows process
+        if($^O eq "msys") {
+            my $filter = "PID eq $pid";
+            my $result = `tasklist -fi \"$filter\" 2>nul`;
+            if(index($result, "$pid") != -1) {
+                return -$pid;
+            }
+        }
+    }
+
+    return 0;
+}
+
+#######################################################################
+# pidterm asks the process with a given pid to terminate gracefully.
+#
+sub pidterm {
+    my $pid = $_[0];
+
+    if($pid > 0) {
+        # signal the process to terminate
+        kill("TERM", $pid);
+
+        # request the process to quit
+        if($^O eq "msys") {
+            my $filter = "PID eq $pid";
+            my $result = `tasklist -fi \"$filter\" 2>nul`;
+            if(index($result, "$pid") != -1) {
+                system("taskkill -fi \"$filter\" >nul 2>&1");
+            }
+        }
+    }
+}
+
+#######################################################################
+# pidkill kills the process with a given pid mercilessly andforcefully.
+#
+sub pidkill {
+    my $pid = $_[0];
+
+    if($pid > 0) {
+        # signal the process to terminate
+        kill("KILL", $pid);
+
+        # request the process to quit
+        if($^O eq "msys") {
+            my $filter = "PID eq $pid";
+            my $result = `tasklist -fi \"$filter\" 2>nul`;
+            if(index($result, "$pid") != -1) {
+                system("taskkill -f -fi \"$filter\" >nul 2>&1");
+            }
+        }
+    }
+}
+
 #######################################################################
 # processexists checks if a process with the pid stored in the given
 # pidfile exists and is alive. This will return 0 on any file related
@@ -63,16 +133,8 @@ sub processexists {
     my $pid = pidfromfile($pidfile);
 
     if($pid > 0) {
-        # verify if currently existing Windows process
-        if($^O eq "msys") {
-            my $filter = "-fi \"PID eq $pid\"";
-            my $result = `tasklist $filter 2>nul`;
-            if(index($result, "$pid") != -1) {
-                return $pid;
-            }
-        }
         # verify if currently alive
-        if(kill(0, $pid)) {
+        if(pidexists($pid)) {
             return $pid;
         }
         else {
@@ -119,21 +181,10 @@ sub killpid {
         if($tmp =~ /^(\d+)$/) {
             my $pid = $1;
             if($pid > 0) {
-                if($^O eq "msys") {
-                    my $filter = "-fi \"PID eq $pid\"";
-                    my $result = `tasklist $filter 2>nul`;
-                    if(index($result, "$pid") != -1) {
-                        print("RUN: Process with pid $pid requested to quit\n")
-                            if($verbose);
-                        system("taskkill $filter >nul 2>&1");
-                        push @signalled, $pid;
-                        next; # it is a Windows PID
-                    }
-                }
-                if(kill(0, $pid)) {
+                if(pidexists($pid)) {
                     print("RUN: Process with pid $pid signalled to die\n")
                         if($verbose);
-                    kill("TERM", $pid);
+                    pidterm($pid);
                     push @signalled, $pid;
                 }
                 else {
@@ -153,14 +204,7 @@ sub killpid {
         while($twentieths--) {
             for(my $i = scalar(@signalled) - 1; $i >= 0; $i--) {
                 my $pid = $signalled[$i];
-                if($^O eq "msys") {
-                    my $filter = "-fi \"PID eq $pid\"";
-                    my $result = `tasklist $filter 2>nul`;
-                    if(index($result, "$pid") != -1) {
-                        next; # the Windows PID still exists
-                    }
-                }
-                if(!kill(0, $pid)) {
+                if(!pidexists($pid)) {
                     print("RUN: Process with pid $pid gracefully died\n")
                         if($verbose);
                     splice @signalled, $i, 1;
@@ -180,16 +224,7 @@ sub killpid {
             if($pid > 0) {
                 print("RUN: Process with pid $pid forced to die with SIGKILL\n")
                     if($verbose);
-                kill("KILL", $pid);
-                if($^O eq "msys") {
-                    my $filter = "-fi \"PID eq $pid\"";
-                    my $result = `tasklist $filter 2>nul`;
-                    if(index($result, "$pid") != -1) {
-                        print("RUN: Process with pid $pid forced to quit\n")
-                            if($verbose);
-                        system("taskkill -f $filter >nul 2>&1");
-                    }
-                }
+                pidkill($pid);
                 # if possible reap its dead children
                 waitpid($pid, &WNOHANG);
                 push @reapchild, $pid;
@@ -229,14 +264,7 @@ sub killsockfilters {
         if($pid > 0) {
             printf("* kill pid for %s-%s => %d\n", $server,
                 ($proto eq 'ftp')?'ctrl':'filt', $pid) if($verbose);
-            kill("KILL", $pid);
-            if($^O eq "msys") {
-                my $filter = "-fi \"PID eq $pid\"";
-                my $result = `tasklist $filter 2>nul`;
-                if(index($result, "$pid") != -1) {
-                    system("taskkill -f $filter >nul 2>&1");
-                }
-            }
+            pidkill($pid);
             waitpid($pid, 0);
         }
         unlink($pidfile) if(-f $pidfile);
@@ -250,14 +278,7 @@ sub killsockfilters {
         if($pid > 0) {
             printf("* kill pid for %s-data => %d\n", $server,
                 $pid) if($verbose);
-            kill("KILL", $pid);
-            if($^O eq "msys") {
-                my $filter = "-fi \"PID eq $pid\"";
-                my $result = `tasklist $filter 2>nul`;
-                if(index($result, "$pid") != -1) {
-                    system("taskkill -f $filter >nul 2>&1");
-                }
-            }
+            pidkill($pid);
             waitpid($pid, 0);
         }
         unlink($pidfile) if(-f $pidfile);

diff --git a/tests/runtests.pl b/tests/runtests.pl
index 2c577e98fc037d57780759e429abb2d61fbe13dd..1cbf76441fc68fd6e8a9245e09f496fb797d3fc4 100755 (executable)
--- a/tests/runtests.pl
+++ b/tests/runtests.pl
@@ -427,7 +427,7 @@ sub startnew {
         if(-f $pidfile && -s $pidfile && open(PID, "<$pidfile")) {
             $pid2 = 0 + <PID>;
             close(PID);
-            if(($pid2 > 0) && kill(0, $pid2)) {
+            if(($pid2 > 0) && pidexists($pid2)) {
                 # if $pid2 is valid, then make sure this pid is alive, as
                 # otherwise it is just likely to be the _previous_ pidfile or
                 # similar!
@@ -928,7 +928,7 @@ sub verifyssh {
     if($pid > 0) {
         # if we have a pid it is actually our ssh server,
         # since runsshserver() unlinks previous pidfile
-        if(!kill(0, $pid)) {
+        if(!pidexists($pid)) {
             logmsg "RUN: SSH server has died after starting up\n";
             checkdied($pid);
             unlink($pidfile);
@@ -1041,7 +1041,7 @@ sub verifyhttptls {
         if($pid > 0) {
             # if we have a pid it is actually our httptls server,
             # since runhttptlsserver() unlinks previous pidfile
-            if(!kill(0, $pid)) {
+            if(!pidexists($pid)) {
                 logmsg "RUN: $server server has died after starting up\n";
                 checkdied($pid);
                 unlink($pidfile);
@@ -1077,7 +1077,7 @@ sub verifysocks {
     if($pid > 0) {
         # if we have a pid it is actually our socks server,
         # since runsocksserver() unlinks previous pidfile
-        if(!kill(0, $pid)) {
+        if(!pidexists($pid)) {
             logmsg "RUN: SOCKS server has died after starting up\n";
             checkdied($pid);
             unlink($pidfile);
@@ -1218,7 +1218,7 @@ sub runhttpserver {
     my $cmd = "$exe $flags";
     my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
 
-    if($httppid <= 0 || !kill(0, $httppid)) {
+    if($httppid <= 0 || !pidexists($httppid)) {
         # it is NOT alive
         logmsg "RUN: failed to start the $srvrname server\n";
         stopserver($server, "$pid2");
@@ -1293,7 +1293,7 @@ sub runhttp_pipeserver {
     my $cmd = "$srcdir/http_pipe.py $flags";
     my ($httppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
 
-    if($httppid <= 0 || !kill(0, $httppid)) {
+    if($httppid <= 0 || !pidexists($httppid)) {
         # it is NOT alive
         logmsg "RUN: failed to start the $srvrname server\n";
         stopserver($server, "$pid2");
@@ -1374,7 +1374,7 @@ sub runhttpsserver {
     my $cmd = "$perl $srcdir/secureserver.pl $flags";
     my ($httpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
 
-    if($httpspid <= 0 || !kill(0, $httpspid)) {
+    if($httpspid <= 0 || !pidexists($httpspid)) {
         # it is NOT alive
         logmsg "RUN: failed to start the $srvrname server\n";
         stopserver($server, "$pid2");
@@ -1454,7 +1454,7 @@ sub runhttptlsserver {
     my $cmd = "$httptlssrv $flags > $logfile 2>&1";
     my ($httptlspid, $pid2) = startnew($cmd, $pidfile, 10, 1); # fake pidfile
 
-    if($httptlspid <= 0 || !kill(0, $httptlspid)) {
+    if($httptlspid <= 0 || !pidexists($httptlspid)) {
         # it is NOT alive
         logmsg "RUN: failed to start the $srvrname server\n";
         stopserver($server, "$pid2");
@@ -1549,7 +1549,7 @@ sub runpingpongserver {
     my $cmd = "$perl $srcdir/ftpserver.pl $flags";
     my ($ftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
 
-    if($ftppid <= 0 || !kill(0, $ftppid)) {
+    if($ftppid <= 0 || !pidexists($ftppid)) {
         # it is NOT alive
         logmsg "RUN: failed to start the $srvrname server\n";
         stopserver($server, "$pid2");
@@ -1631,7 +1631,7 @@ sub runftpsserver {
     my $cmd = "$perl $srcdir/secureserver.pl $flags";
     my ($ftpspid, $pid2) = startnew($cmd, $pidfile, 15, 0);
 
-    if($ftpspid <= 0 || !kill(0, $ftpspid)) {
+    if($ftpspid <= 0 || !pidexists($ftpspid)) {
         # it is NOT alive
         logmsg "RUN: failed to start the $srvrname server\n";
         stopserver($server, "$pid2");
@@ -1713,7 +1713,7 @@ sub runtftpserver {
     my $cmd = "$perl $srcdir/tftpserver.pl $flags";
     my ($tftppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
 
-    if($tftppid <= 0 || !kill(0, $tftppid)) {
+    if($tftppid <= 0 || !pidexists($tftppid)) {
         # it is NOT alive
         logmsg "RUN: failed to start the $srvrname server\n";
         stopserver($server, "$pid2");
@@ -1794,7 +1794,7 @@ sub runrtspserver {
     my $cmd = "$perl $srcdir/rtspserver.pl $flags";
     my ($rtsppid, $pid2) = startnew($cmd, $pidfile, 15, 0);
 
-    if($rtsppid <= 0 || !kill(0, $rtsppid)) {
+    if($rtsppid <= 0 || !pidexists($rtsppid)) {
         # it is NOT alive
         logmsg "RUN: failed to start the $srvrname server\n";
         stopserver($server, "$pid2");
@@ -1876,7 +1876,7 @@ sub runsshserver {
     # passed to startnew, when this happens startnew completes without being
     # able to read the pidfile and consequently returns a zero pid2 above.
 
-    if($sshpid <= 0 || !kill(0, $sshpid)) {
+    if($sshpid <= 0 || !pidexists($sshpid)) {
         # it is NOT alive
         logmsg "RUN: failed to start the $srvrname server\n";
         stopserver($server, "$pid2");
@@ -2033,7 +2033,7 @@ sub runsocksserver {
     my $cmd="$ssh -N -F $sshconfig $ip > $sshlog 2>&1";
     my ($sshpid, $pid2) = startnew($cmd, $pidfile, 30, 1); # fake pidfile
 
-    if($sshpid <= 0 || !kill(0, $sshpid)) {
+    if($sshpid <= 0 || !pidexists($sshpid)) {
         # it is NOT alive
         logmsg "RUN: failed to start the $srvrname server\n";
         display_sshlog();