# the process is not alive, will return the negative value of the pid.
#
sub processexists {
-# use POSIX ":sys_wait_h";
+ use POSIX ":sys_wait_h";
my $pidfile = $_[0];
# fetch pid from pidfile
}
else {
# reap it if this has not already been done
- # waitpid($pid, &WNOHANG);
+ waitpid($pid, &WNOHANG);
# get rid of the certainly invalid pidfile
unlink($pidfile) if($pid == pidfromfile($pidfile));
return -$pid; # negative means dead process
return 0;
}
+#######################################################################
+# killpid attempts to gracefully stop processes in the given pid list
+# with a SIGTERM signal and SIGKILLs those which haven't died on time.
+#
+sub killpid {
+ use POSIX ":sys_wait_h";
+ my ($verbose, $pidlist) = @_;
+
+ # The 'pidlist' argument is a string of whitespace separated pids.
+ return if(not defined $pidlist);
+
+ # For each pid which is alive send it a SIGTERM to gracefully
+ # stop it, otherwise reap it if this has not been done yet.
+ my @signalled;
+ my $prev = 0;
+ my @pids = sort({$a <=> $b} split(/\s+/, $pidlist));
+ foreach my $tmp (@pids) {
+ chomp $tmp;
+ if($tmp =~ /^(\d+)$/) {
+ my $pid = $1;
+ if(($pid > 0) && ($prev != $pid)) {
+ $prev = $pid;
+ if(kill(0, $pid)) {
+ print("RUN: Process with pid $pid signalled to die\n")
+ if($verbose);
+ kill("TERM", $pid);
+ push @signalled, $pid;
+ }
+ else {
+ print("RUN: Process with pid $pid already dead\n")
+ if($verbose);
+ waitpid($pid, &WNOHANG);
+ }
+ }
+ }
+ }
+ return if(not scalar(@signalled));
+
+ # Allow all signalled processes five seconds to gracefully die.
+ my $quarters = 20;
+ while($quarters--) {
+ for(my $i = scalar(@signalled) - 1; $i >= 0; $i--) {
+ my $pid = $signalled[$i];
+ if(!kill(0, $pid)) {
+ print("RUN: Process with pid $pid gracefully died\n")
+ if($verbose);
+ waitpid($pid, &WNOHANG);
+ splice @signalled, $i, 1;
+ }
+ }
+ return if(not scalar(@signalled));
+ select(undef, undef, undef, 0.25);
+ }
+
+ # Mercilessly SIGKILL processes still alive.
+ foreach my $pid (@signalled) {
+ print("RUN: Process with pid $pid forced to die with SIGKILL\n")
+ if($verbose);
+ kill("KILL", $pid);
+ waitpid($pid, 0);
+ }
+}
+
#############################################################################
# Kill a specific slave
#
sub ftpkillslave {
my ($id, $ext, $verbose)=@_;
my $base;
+ my $pidlist;
+ my @pidfiles;
+
for $base (('filt', 'data')) {
my $f = ".sock$base$id$ext.pid";
my $pid = processexists($f);
if($pid > 0) {
- printf ("* kill pid for %s => %d\n", "ftp-$base$id$ext", $pid) if($verbose);
- kill (9, $pid); # die!
- waitpid($pid, 0);
+ printf ("* kill pid for %s => %d\n", "ftp-$base$id$ext", $pid)
+ if($verbose);
+ $pidlist .= "$pid ";
}
- unlink($f);
+ push @pidfiles, $f;
}
-}
+ killpid($verbose, $pidlist);
+
+ foreach my $pidfile (@pidfiles) {
+ unlink($pidfile);
+ }
+}
#############################################################################
# Make sure no FTP leftovers are still running. Kill all slave processes.
# This uses pidfiles since it might be used by other processes.
#
sub ftpkillslaves {
- my ($versbose) = @_;
- for $ext (("", "ipv6")) {
- for $id (("", "2")) {
- ftpkillslave ($id, $ext, $verbose);
+ my ($verbose) = @_;
+ my $pidlist;
+ my @pidfiles;
+
+ for $ext (('', 'ipv6')) {
+ for $id (('', '2')) {
+ for $base (('filt', 'data')) {
+ my $f = ".sock$base$id$ext.pid";
+ my $pid = processexists($f);
+ if($pid > 0) {
+ printf ("* kill pid for %s => %d\n", "ftp-$base$id$ext",
+ $pid) if($verbose);
+ $pidlist .= "$pid ";
+ }
+ push @pidfiles, $f;
+ }
}
}
+
+ killpid($verbose, $pidlist);
+
+ foreach my $pidfile (@pidfiles) {
+ unlink($pidfile);
+ }
}
use strict;
use IPC::Open2;
-#use Time::HiRes qw( gettimeofday ); # not available in perl 5.6
require "getpart.pm";
require "ftp.pm";
+BEGIN {
+ if($] >= 5.006) {
+ use Time::HiRes qw( gettimeofday );
+ }
+}
my $ftpdnum="";
-# open and close each time to allow removal at any time
+my $logfilename = 'log/logfile.log'; # Override this for each test server
+
+#######################################################################
+# getlogfilename returns a log file name depending on given arguments.
+#
+sub getlogfilename {
+ my ($proto, $ipversion, $ssl, $instance, $sockfilter) = @_;
+ my $filename;
+
+ # For now, simply mimic old behavior.
+ $filename = "log/ftpd$ftpdnum.log";
+
+ return $filename;
+}
+
+#######################################################################
+# logmsg is general message logging subroutine for our test servers.
+#
sub logmsg {
- # if later than perl 5.6 is used
- # my ($seconds, $microseconds) = gettimeofday;
- my $seconds = time();
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
- localtime($seconds);
- open(FTPLOG, ">>log/ftpd$ftpdnum.log");
- printf FTPLOG ("%02d:%02d:%02d ", $hour, $min, $sec);
- print FTPLOG @_;
- close(FTPLOG);
+ my $now;
+ if($] >= 5.006) {
+ my ($seconds, $usec) = gettimeofday();
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+ localtime($seconds);
+ $now = sprintf("%02d:%02d:%02d.%06d ", $hour, $min, $sec, $usec);
+ }
+ else {
+ my $seconds = time();
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
+ localtime($seconds);
+ $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec);
+ }
+ if(open(LOGFILEFH, ">>$logfilename")) {
+ print LOGFILEFH $now;
+ print LOGFILEFH @_;
+ close(LOGFILEFH);
+ }
}
sub ftpmsg {
sub catch_zap {
my $signame = shift;
- ftpkillslaves(1);
+ ftpkillslaves($verbose);
unlink($pidfile);
if($serverlogslocked) {
$serverlogslocked = 0;
($fcaller, $lcaller) = (caller)[1,2];
logmsg "Failed to read input\n";
logmsg "Error: ftp$ftpdnum$ext sysread error: $!\n";
- kill(9, $sfpid);
- waitpid($sfpid, 0);
+ killpid($verbose, $sfpid);
logmsg "Exited from sysread_or_die() at $fcaller " .
"line $lcaller. ftp$ftpdnum$ext sysread error: $!\n";
unlink($pidfile);
($fcaller, $lcaller) = (caller)[1,2];
logmsg "Failed to read input\n";
logmsg "Error: ftp$ftpdnum$ext read zero\n";
- kill(9, $sfpid);
- waitpid($sfpid, 0);
+ killpid($verbose, $sfpid);
logmsg "Exited from sysread_or_die() at $fcaller " .
"line $lcaller. ftp$ftpdnum$ext read zero\n";
unlink($pidfile);
if($pong !~ /^PONG/) {
logmsg "Failed sockfilt command: $cmd\n";
- kill(9, $sfpid);
- waitpid($sfpid, 0);
+ killpid($verbose, $sfpid);
unlink($pidfile);
if($serverlogslocked) {
$serverlogslocked = 0;
}
}
+$logfilename = getlogfilename();
+
startsf();
logmsg sprintf("%s server listens on port IPv%d/$port\n", uc($proto),
my $prev = processexists($pidf);
if($prev > 0) {
print "kill existing server: $prev\n" if($verbose);
- kill(9, $prev);
- waitpid($prev, 0);
+ killpid($verbose, $prev);
}
# We fire up a new sockfilt to do the data transfer for us.
sysread_or_die(\*DREAD, \$pong, 5);
if($pong !~ /^PONG/) {
- kill(9, $slavepid);
- waitpid($slavepid, 0);
+ killpid($verbose, $slavepid);
sendcontrol "500 no free ports!\r\n";
logmsg "failed to run sockfilt for data connection\n";
return 0;
if($pong !~ /^PONG/) {
logmsg "Failed sockfilt for data connection\n";
- kill(9, $slavepid);
- waitpid($slavepid, 0);
+ killpid($verbose, $slavepid);
}
logmsg "====> Client DATA connect to port $port\n";
# flush data:
$| = 1;
- kill(9, $slavepid) if($slavepid);
- waitpid($slavepid, 0) if($slavepid);
+ killpid($verbose, $slavepid);
$slavepid=0;
&customize(); # read test control instructions
}
use strict;
-#use Time::HiRes qw( gettimeofday );
#use warnings;
use Cwd;
my $tortnum;
my $tortalloc;
-# open and close each time to allow removal at any time
+#######################################################################
+# logmsg is our general message logging subroutine.
+#
sub logmsg {
-# uncomment the Time::HiRes usage for this
-# my ($seconds, $microseconds) = gettimeofday;
-# my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
-# localtime($seconds);
- my $t;
- if(1) {
-# $t = sprintf ("%02d:%02d:%02d.%06d ", $hour, $min, $sec,
-# $microseconds);
- }
for(@_) {
- print "${t}$_";
+ print "$_";
}
}
sub catch_zap {
my $signame = shift;
logmsg "runtests.pl received SIG$signame, exiting\n";
- stopservers(1);
+ stopservers($verbose);
die "Somebody sent me a SIG$signame";
}
$SIG{INT} = \&catch_zap;
# stop the given test server (pid)
#
sub stopserver {
- my ($pid) = @_;
-
- if(not defined $pid || $pid <= 0) {
- return; # whad'da'ya wanna'da with no pid ?
- }
-
- # It might be more than one pid
- # Send each one a SIGTERM to gracefully kill it
-
- my @killed;
- my @pids = split(/\s+/, $pid);
- for (@pids) {
- chomp($_);
- if($_ =~ /^(\d+)$/) {
- if(($1 > 0) && kill(0, $1)) {
- if($verbose) {
- logmsg "RUN: Test server pid $1 signalled to die\n";
- }
- kill(15, $1); # die!
- push @killed, $1;
- }
- }
- }
+ my ($pidlist) = @_;
- # Give each process killed up to a few seconds to die, then send
- # a SIGKILL to finish it off for good.
- for (@killed) {
- my $count = 5; # wait for this many seconds for server to die
- while($count--) {
- if (!kill(0, $_) || checkdied($_)) {
- last;
- }
- sleep(1);
- }
- if ($count < 0) {
- logmsg "RUN: forcing pid $_ to die with SIGKILL\n";
- kill(9, $_); # die!
- }
- }
+ killpid($verbose, $pidlist);
}
#######################################################################
# Stop all running test servers
sub stopservers {
my ($verbose)=@_;
+ my $pidlist;
+
for(keys %run) {
my $server = $_;
my $pids=$run{$server};
my $pid;
my $prev;
- foreach $pid (split(" ", $pids)) {
+ foreach $pid (split(/\s+/, $pids)) {
if($pid != $prev) {
# no need to kill same pid twice!
logmsg sprintf("* kill pid for %s => %d\n",
$server, $pid) if($verbose);
- stopserver($pid);
+ $pidlist .= "$pid ";
+ $prev = $pid;
}
- $prev = $pid;
}
delete $run{$server};
}
+ killpid($verbose, $pidlist);
ftpkillslaves($verbose);
}
vsnprintf(buffer, sizeof(buffer), msg, ap);
va_end(ap);
- logfp = fopen(serverlogfile, "a");
+ logfp = fopen(serverlogfile, "ab");
if(logfp) {
fprintf(logfp, "%s %s\n", timebuf, buffer);
fclose(logfp);
long pid;
pid = (long)getpid();
- pidfile = fopen(filename, "w");
+ pidfile = fopen(filename, "wb");
if(!pidfile) {
logmsg("Couldn't write pid file: %s %s", filename, strerror(ERRNO));
return 0; /* fail */
projects / platform / upstream / curl.git / commitdiff