moparisthebest
/
curl
mirror of https://github.com/moparisthebest/curl
1
0
Fork 0
Code Issues Releases Wiki Activity

runtests.pl: Modularization of MinGW/Msys compatibility functions

This commit is contained in:
Marc Hoersken 2013-04-06 12:45:05 +02:00
parent ac09b5a92b
commit a03d0c5b88
2 changed files with 91 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

133
tests/ftp.pm
View File

@ -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);

28
tests/runtests.pl
View File

@ -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();