Commit 3802d027 authored by Yang Tse's avatar Yang Tse
Browse files

Test harness process control enhancements

parent 3111701c

tests/ftp.pm

+100 −11
Original line number Diff line number Diff line
@@ -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,38 +70,127 @@ 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);

        }

        unlink($f);

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

    }

}



#############################################################################

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

    }

}





sub set_advisor_read_lock {

    my ($filename) = @_;

tests/ftpserver.pl

+51 −26
Original line number Diff line number Diff line
@@ -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 $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);

    open(FTPLOG, ">>log/ftpd$ftpdnum.log");

    printf FTPLOG ("%02d:%02d:%02d ", $hour, $min, $sec);

    print FTPLOG @_;

    close(FTPLOG);

        $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

tests/runtests.pl

+13 −54
Original line number Diff line number Diff line
@@ -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) = @_;

    my ($pidlist) = @_;



    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;

            }

        }

    }



    # 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;

            }

        }

        delete $run{$server};

    }

    killpid($verbose, $pidlist);

    ftpkillslaves($verbose);

}

tests/server/util.c

+2 −2
Original line number Diff line number Diff line
@@ -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 */