Test harness process control enhancements

4 files changed, 166 insertions, 93 deletions

diff --git a/tests/ftp.pm b/tests/ftp.pm
index eed64903e..28bbb4ea6 100644
--- a/tests/ftp.pm
+++ b/tests/ftp.pm
@@ -48,7 +48,7 @@ sub pidfromfile {
 # 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
@@ -61,7 +61,7 @@ sub processexists {
         }
         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
@@ -70,36 +70,125 @@ sub processexists {
     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);
+    }
 }
 
 
diff --git a/tests/ftpserver.pl b/tests/ftpserver.pl
index bf76f65de..b15237fa7 100644
--- a/tests/ftpserver.pl
+++ b/tests/ftpserver.pl
@@ -39,25 +39,55 @@
 
 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 {
@@ -138,7 +168,7 @@ if($proto !~ /^(ftp|imap|pop3|smtp)\z/) {
 
 sub catch_zap {
     my $signame = shift;
-    ftpkillslaves(1);
+    ftpkillslaves($verbose);
     unlink($pidfile);
     if($serverlogslocked) {
         $serverlogslocked = 0;
@@ -167,8 +197,7 @@ sub sysread_or_die {
         ($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);
@@ -182,8 +211,7 @@ sub sysread_or_die {
         ($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);
@@ -209,8 +237,7 @@ sub startsf {
 
     if($pong !~ /^PONG/) {
         logmsg "Failed sockfilt command: $cmd\n";
-        kill(9, $sfpid);
-        waitpid($sfpid, 0);
+        killpid($verbose, $sfpid);
         unlink($pidfile);
         if($serverlogslocked) {
             $serverlogslocked = 0;
@@ -220,6 +247,8 @@ sub startsf {
     }
 }
 
+$logfilename = getlogfilename();
+
 startsf();
 
 logmsg sprintf("%s server listens on port IPv%d/$port\n", uc($proto),
@@ -716,8 +745,7 @@ sub PASV_command {
     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.
@@ -730,8 +758,7 @@ sub PASV_command {
     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;
@@ -865,8 +892,7 @@ sub PORT_command {
 
     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";
@@ -986,8 +1012,7 @@ while(1) {
     # flush data:
     $| = 1;
 
-    kill(9, $slavepid) if($slavepid);
-    waitpid($slavepid, 0) if($slavepid);
+    killpid($verbose, $slavepid);
     $slavepid=0;
         
     &customize(); # read test control instructions
diff --git a/tests/runtests.pl b/tests/runtests.pl
index 067d277f4..ace609f72 100755
--- a/tests/runtests.pl
+++ b/tests/runtests.pl
@@ -61,7 +61,6 @@ BEGIN {
 }
 
 use strict;
-#use Time::HiRes qw( gettimeofday );
 #use warnings;
 use Cwd;
 
@@ -240,19 +239,12 @@ my $torture;
 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 "$_";
     }
 }
 
@@ -272,7 +264,7 @@ $ENV{'HOME'}=$pwd;
 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;
@@ -550,45 +542,9 @@ sub torture {
 # 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);
 }
 
 #######################################################################
@@ -2554,23 +2510,26 @@ sub singletest {
 # 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);
 }
 
diff --git a/tests/server/util.c b/tests/server/util.c
index 7b00159ee..9db735d4c 100644
--- a/tests/server/util.c
+++ b/tests/server/util.c
@@ -86,7 +86,7 @@ void logmsg(const char *msg, ...)
   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);
@@ -221,7 +221,7 @@ int write_pidfile(const char *filename)
   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 */