aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorMarc Hoersken <info@marc-hoersken.de>2013-04-06 12:45:05 +0200
committerMarc Hoersken <info@marc-hoersken.de>2013-04-06 12:45:05 +0200
commita03d0c5b8804cd6d6ce91a167ad3c2b85eac1f85 (patch)
tree42b99684ef902b6366fe37cd8f9da75b78ddfed0 /tests
parentac09b5a92bec0da6109b58856094229a77df5eb8 (diff)
runtests.pl: Modularization of MinGW/Msys compatibility functions
Diffstat (limited to 'tests')
-rw-r--r--tests/ftp.pm133
-rwxr-xr-xtests/runtests.pl28
2 files changed, 91 insertions, 70 deletions
diff --git a/tests/ftp.pm b/tests/ftp.pm
index b38745120..76c6d5746 100644
--- a/tests/ftp.pm
+++ b/tests/ftp.pm
@@ -48,6 +48,76 @@ sub pidfromfile {
}
#######################################################################
+# 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
# error or if a pid can not be extracted from the given file. When a
@@ -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 2c577e98f..1cbf76441 100755
--- 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();