From a03d0c5b8804cd6d6ce91a167ad3c2b85eac1f85 Mon Sep 17 00:00:00 2001 From: Marc Hoersken Date: Sat, 6 Apr 2013 12:45:05 +0200 Subject: [PATCH] runtests.pl: Modularization of MinGW/Msys compatibility functions --- tests/ftp.pm | 133 +++++++++++++++++++++++++++------------------- tests/runtests.pl | 28 +++++----- 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 @@ -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 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 + ; 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();