runtests.pl: Modularization of MinGW/Msys compatibility functions (a03d0c5b) · Commits · CYBER - Cyber Security / TS 103 523 MSP / TLMSP / TLMSP curl

tests/ftp.pm

+77 −56

Original line number	Diff line number	Diff line
		@@ -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);

tests/runtests.pl

+14 −14

Original line number	Diff line number	Diff line
		@@ -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();