pjs/mstone/bin/mailmaster.pl

577 строки
19 KiB
Perl
Executable File

#!/usr/bin/perl
# The contents of this file are subject to the Netscape Public
# License Version 1.1 (the "License"); you may not use this file
# except in compliance with the License. You may obtain a copy of
# the License at http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS
# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
# implied. See the License for the specific language governing
# rights and limitations under the License.
#
# The Original Code is the Netscape Mailstone utility,
# released March 17, 2000.
#
# The Initial Developer of the Original Code is Netscape
# Communications Corporation. Portions created by Netscape are
# Copyright (C) 1997-2000 Netscape Communications Corporation. All
# Rights Reserved.
#
# Contributor(s): Dan Christian <robodan@netscape.com>
# Marcel DePaolis <marcel@netcape.com>
# Mike Blakely
#
# Alternatively, the contents of this file may be used under the
# terms of the GNU Public License (the "GPL"), in which case the
# provisions of the GPL are applicable instead of those above.
# If you wish to allow use of your version of this file only
# under the terms of the GPL and not to allow others to use your
# version of this file under the NPL, indicate your decision by
# deleting the provisions above and replace them with the notice
# and other provisions required by the GPL. If you do not delete
# the provisions above, a recipient may use your version of this
# file under either the NPL or the GPL.
#####################################################
# see setup.pl for full usage
# mailmaster [-d] [-c <config file>] ...
# This script reads in the client configuration files and will
# fork children to rsh the mailclient process on network clients,
# each child will write test results to /mailstone directory before
# dying. The parent will the read and combine the results.
#
# Make sure the user running this script has rsh privilege across
# all client machines
print "Netscape Mailstone version 4.2\n";
print "Copyright (c) Netscape Communications Corp. 1997-2000\n";
# this parses the command line and config file
do 'args.pl'|| die "$@\n";
parseArgs(); # parse command line
{ # get unique date string
my ($sec, $min, $hour, $mday, $mon, $year) = localtime;
my $tstamp = sprintf ("%04d%02d%02d.%02d%02d",
1900+$year, 1+$mon, $mday, $hour, $min);
if ( -d "$resultbase/$tstamp") { # check for runs within a minute
my $tail = 'a';
while ( -d "$resultbase/$tstamp$tail" ) { $tail++; }
$tstamp .= $tail;
}
$params{TSTAMP} = $tstamp;
}
$resultdir = "$resultbase/$params{TSTAMP}";
$tmpdir = "$tmpbase/$params{TSTAMP}";
$resultstxt = "$resultdir/results.txt";
$resultshtml = "$resultdir/results.html";
mkdir ("$resultbase", 0775);
mkdir ("$tmpbase", 0775);
mkdir ("$resultdir", 0775);
mkdir ("$tmpdir", 0775);
# Make sure we have everything
die "Must specify the test time" unless $params{TIME};
die "Must specify a workload file" unless $params{WORKLOAD};
if ($params{TESTBED}) { # BACK COMPATIBILITY
readTestbedFile ($params{TESTBED}) || die "Error reading testbed: $@\n";
}
$testsecs = figureTimeSeconds ($params{TIME}, "seconds");
# figure out the processes and thread, given the desired number
# takes into account all the constraints. todo can be a float.
sub figurePT {
my $sec = shift;
my $todo = shift;
my $p = 1; # first guess
my $t = 1;
my $start = 1; # initial process guess
my $end = 250; # highest process guess
if ($todo < 1) { # mark this client as inactive
$sec->{PROCESSES} = 0;
$sec->{THREADS} = 0;
return 0;
}
if (($section->{MAXCLIENTS}) && ($todo > $section->{MAXCLIENTS})) {
$todo = $section->{MAXCLIENTS}; # trim to max client per host
}
if ($section->{PROCESSES}) { # they set this part already
$start = int ($section->{PROCESSES});
$end = $start;
$p = $start;
my $slist = $section->{sectionParams};
$slist =~ s/HOSTS=\s*//; # strip off initial bit
print "Using specified $p processes for clients $slist\n";
}
$end = int ($section->{MAXPROCESSES})
if ($section->{MAXPROCESSES}); # they set a max
if (($params{NT}) || ($section->{ARCH} eq "NT4.0")) {
$end = 1; # # NT is currently limited to 1 process
$start = 1;
$p = 1;
}
# step through some process counts
# it should first reduce errors due to MAXTHREADS,
# the it will reduce errors due to integer math.
# not optimal, just good enough
my $misses = 0;
for (my $n = $start; $n <= $end; $n++) { # try some process counts
my $tryt = int ($todo / $n);
if (($sec->{MAXTHREADS}) && ($tryt > $sec->{MAXTHREADS})) {
$tryt = $sec->{MAXTHREADS};
}
# see if this is a better match than the last one
if (abs ($todo - ($n * $tryt)) < abs ($todo - ($p * $t))) {
$p = $n;
$t = $tryt;
$misses = 0;
} else {
$misses++;
last if ($misses > 1); # getting worse
}
}
$sec->{PROCESSES} = $p;
$sec->{THREADS} = $t;
return $p * $t;
}
# Allocate CLIENTCOUNT to the client machines
# try NOT to turn this into a massive linear programming project
# works best to put bigger machines last
if ($params{CLIENTCOUNT}) {
my $todo = $params{CLIENTCOUNT};
my $softcli = 0; # how many can we play with
foreach $section (@workload) { # see which are already fixed
next unless ($section->{sectionTitle} =~ /CLIENT/o);
unless (($section->{PROCESSES}) && ($section->{THREADS})) {
$softcli++;
next;
}
my $slist = $section->{sectionParams};
$slist =~ s/HOSTS=\s*//; # strip off initial bit
my @hlist = split /[\s,]/, $slist;
my $hcnt = (1 + $#hlist);
# subtract fixed entries
my $tcount = ($section->{THREADS}) ? $section->{THREADS} : 1;
$todo -= $tcount * $section->{PROCESSES} * $hcnt;
$clientProcCount += $section->{PROCESSES} * $hcnt; # total processes
$params{DEBUG} &&
print "Fixed load group with $hcnt hosts: $section->{PROCESSES} x $tcount\n";
}
$params{DEBUG} &&
print "Allocating $todo clients over $softcli groups\n";
if ($softcli) {
foreach $section (@workload) {
next unless ($section->{sectionTitle} =~ /CLIENT/o);
next if (($section->{PROCESSES}) && ($section->{THREADS}));
my $slist = $section->{sectionParams};
$slist =~ s/HOSTS=\s*//; # strip off initial bit
my @hlist = split /[\s,]/, $slist;
my $hcnt = (1 + $#hlist);
#print "todo=$todo softcli=$softcli hcnt=$hcnt\n";
$todo -= $hcnt * figurePT ($section, $todo / ($softcli * $hcnt));
$clientProcCount += $hcnt * $section->{PROCESSES}; # total procs
$softcli--;
last if ($softcli <= 0); # should not happen
}
}
if ($todo) {
print "Warning: Could not allocate $todo of $params{CLIENTCOUNT} clients.\n";
$params{CLIENTCOUNT} -= $todo;
}
} else { # figure out the client count
my $cnt = 0;
foreach $section (@workload) { # see which are already fixed
next unless ($section->{sectionTitle} =~ /CLIENT/o);
next unless ($section->{PROCESSES});
my $slist = $section->{sectionParams};
$slist =~ s/HOSTS=\s*//; # strip off initial bit
my @hlist = split /[\s,]/, $slist;
my $hcnt = (1 + $#hlist);
# subtract fixed entries
my $tcount = ($section->{THREADS}) ? $section->{THREADS} : 1;
$cnt += $tcount * $section->{PROCESSES} * $hcnt;
$clientProcCount += $section->{PROCESSES} * $hcnt; # total processes
}
$params{CLIENTCOUNT} = $cnt;
die "No clients configured!\n" unless ($cnt > 0);
}
# This has to be written into save workload file for later processing
unless ($params{FREQUENCY}) { # unless frequency set on command line
my $chartp = ($params{CHARTPOINTS}) ? $params{CHARTPOINTS} : 464;
# approximate data points for good graphs (up to 2 times this)
$params{FREQUENCY} = int ($testsecs / $chartp);
if ($params{FREQUENCY} < 2) { # fastest is every 2 seconds
$params{FREQUENCY} = 2;
} elsif ($params{FREQUENCY} > 60) { # slowest is every minute
$params{FREQUENCY} = 60;
}
}
{ # set a unique block id on every section
my $id = 0;
my $configSeen = 0;
my $defaultSeen = 0;
foreach $section (@workload) {
if ($section->{"sectionTitle"} =~ /^CONFIG$/) {
next if $configSeen;
$configSeen++;
}
if ($section->{"sectionTitle"} =~ /^DEFAULT$/) {
next if $defaultSeen;
$defaultSeen++;
}
$id++; # number 1, 2, ...
if ($section->{"sectionTitle"} =~ /^(CONFIG|CLIENT)$/) {
$section->{BLOCKID} = $id;
} else {
push @{$section->{"lineList"}}, "blockID\t$id\n";
}
}
}
# Write the version we pass to mailclient
writeWorkloadFile ("$resultdir/work.wld", \@workload,
\@scriptWorkloadSections);
# Write the complete inclusive version
writeWorkloadFile ("$resultdir/all.wld", \@workload);
setConfigDefaults(); # pick up any missing defaults
unless ($#protocolsAll > 0) {
die "No protocols found. Test Failed!\n";
}
print "Starting: ", scalar(localtime), "\n";
# redirect STDERR
open SAVEERR, ">&STDERR";
open(STDERR, ">$resultdir/stderr") || warn "Can't redirect STDERR:$!\n";
$totalProcs = 0; # number of clients started
# iterate over every client in the testbed, complete the cmd and rsh
if ($params{NT}) { # single client on local host
pathprint ("Starting clients (errors logged to $resultdir/stderr)\n");
foreach $section (@workload) {
next unless ($section->{sectionTitle} =~ /CLIENT/o);
my $tcount = ($section->{THREADS}) ? $section->{THREADS} : 1;
# Build the initial Mailclient command line
my $preCmd = ($section->{COMMAND})
? $section->{COMMAND} : $params{CLIENTCOMMAND};
$preCmd .= " -s -t $params{TIME} -f $params{FREQUENCY}";
$preCmd .= " -d" if ($params{DEBUG});
$preCmd .= " -r" if ($params{TELEMETRY});
$preCmd .= " -R $params{RAMPTIME}" if ($params{RAMPTIME});
$preCmd .= " -m $params{MAXERRORS}" if ($params{MAXERRORS});
$preCmd .= " -M $params{MAXBLOCKS}" if ($params{MAXBLOCKS});
$preCmd .= " -n 1 -N $tcount";
$preCmd .= ($params{USEGROUPS} && $section->{GROUP})
? " -H $section->{GROUP}" : " -H $cli";
my $stdout = "$tmpdir/localhost.out";
$totalProcs += $tcount;
do 'makeindex.pl' || warn "$@\n"; # html index
printf "\nTest duration: %d %s. Rampup time: %d %s. Number of clients: %d\n",
figureTimeNumber ($params{TIME}),
figureTimeUnits ($params{TIME}, "seconds"),
figureTimeNumber ($params{RAMPTIME}),
figureTimeUnits ($params{RAMPTIME}, "seconds"),
$totalProcs;
print STDERR "localhost: cd $params{TEMPDIR}; $preCmd\n";
# Redirect STDIN, and STDOUT
#open SAVEIN, "<STDIN";
open STDIN, "<$resultdir/work.wld"
|| die "Coundn't open $resultdir/work.wld for input\n";
open SAVEOUT, ">&STDOUT";
open STDOUT, ">$stdout"
|| die "Couldnt open $stdout for output\n";
chdir $params{TEMPDIR} || die "Could not cd $params{TEMPDIR}: $!\n";
system $preCmd;
close STDOUT;
open STDOUT, ">&SAVEOUT";
printf "Test done.\n";
chdir $cwd || die "Could not cd $cwd: $!\n";
last; # only do the first one
}
} else { # not NT (forking works)
foreach $section (@workload) { # do pre run commands
next unless ($section->{sectionTitle} =~ /PRETEST/o);
unless ($section->{COMMAND}) {
print "PreTest with no Command for $section->{sectionParams}\n";
next;
}
my $slist = $section->{sectionParams};
$slist =~ s/HOSTS=\s*//; # strip off initial bit
my $myCmd = $section->{COMMAND};
$myCmd =~ s/%f/$params{FREQUENCY}/; # fill in frequency variable
if ($myCmd =~ m/%c/o) { # dont force down if count is used
$count = $testsecs / $params{FREQUENCY};
$myCmd =~ s/%c/$count/; # fill in count variable
}
my $rsh = ($section->{RSH}) ? $section->{RSH} : $params{RSH};
foreach $cli (split /[\s,]/, $slist) {
print "Running pre test command on $cli\n";
open PRE, ">>$resultdir/$cli-pre.log";
print PRE "========\n";
print PRE "$myCmd\n";
print PRE "========\n";
close PRE;
print STDERR "$cli: $myCmd\n"; # log the actual command
forkproc ($rsh, $cli, $myCmd,
"/dev/null", "$resultdir/$cli-pre.log");
}
foreach $cli (split /[\s,]/, $slist) {
wait(); # run multiple PRETEST section sequentially
}
}
foreach $section (@workload) { # start monitors
next unless ($section->{sectionTitle} =~ /MONITOR/o);
my $slist = $section->{sectionParams};
$slist =~ s/HOSTS=\s*//; # strip off initial bit
my $myCmd = ($section->{COMMAND})
? $section->{COMMAND} : $params{MONITORCOMMAND};
my $forceDown = 0;
$myCmd =~ s/,/ /g; # turn commas into spaces BACK COMPATIBIILITY
$myCmd =~ s/%f/$params{FREQUENCY}/; # fill in frequency variable
if ($myCmd =~ m/%c/o) { # dont force down if count is used
$count = $testsecs / $params{FREQUENCY};
$myCmd =~ s/%c/$count/; # fill in count variable
} else {
$forceDown = 1;
}
my $rsh = ($section->{RSH}) ? $section->{RSH} : $params{RSH};
foreach $cli (split /[\s,]/, $slist) {
printf "Monitoring on $cli\n";
open PRE, ">>$resultdir/$cli-run.log";
print PRE "========\n";
print PRE "$myCmd\n";
print PRE "========\n";
close PRE;
print STDERR "$cli: $myCmd\n"; # log the actual command
$pid = forkproc ($rsh, $cli, $myCmd,
"/dev/null", "$resultdir/$cli-run.log");
push @forceDownPids, $pid if ($forceDown); # save PID for shutdown
}
}
print "Starting clients (errors logged to $resultdir/stderr)\n";
foreach $section (@workload) {
next unless ($section->{sectionTitle} =~ /CLIENT/o);
next unless ($section->{PROCESSES}); # unused client
my $slist = $section->{sectionParams};
$slist =~ s/HOSTS=\s*//; # strip off initial bit
my $rsh = ($section->{RSH}) ? $section->{RSH} : $params{RSH};
my $pcount = $section->{PROCESSES};
my $tcount = ($section->{THREADS}) ? $section->{THREADS} : 0;
my $tempdir;
if ($section->{TEMPDIR}) {
$tempdir = $section->{TEMPDIR};
} elsif ($params{TEMPDIR}) {
$tempdir = $params{TEMPDIR};
}
my $preCmd = "./" . (($section->{COMMAND})
? $section->{COMMAND} : $params{CLIENTCOMMAND});
$preCmd .= " -s -t $params{TIME} -f $params{FREQUENCY}";
$preCmd .= " -d" if ($params{DEBUG});
$preCmd .= " -r" if ($params{TELEMETRY});
$preCmd .= " -R $params{RAMPTIME}" if ($params{RAMPTIME});
if ($params{MAXERRORS}) {
# distribute error count over processes, rounding up
my $n = int (($params{MAXERRORS} + $clientProcCount - 1)
/ $clientProcCount);
$n = 1 if ($n < 1);
$preCmd .= " -m $n";
}
if ($params{MAXBLOCKS}) {
# distribute block count over processes, rounding up
my $n = int (($params{MAXBLOCKS} + $clientProcCount - 1)
/ $clientProcCount);
$n = 1 if ($n < 1);
$preCmd .= " -M $n";
}
$preCmd = "cd $tempdir; " . $preCmd if ($tempdir);
$preCmd .= " -n $pcount";
$preCmd =~ s!/!\\!g if ($section->{ARCH} eq "NT4.0");
$preCmd =~ s/;/&&/g if ($section->{ARCH} eq "NT4.0");
foreach $cli (split /[\s,]/, $slist) {
my $stdout = getClientFilename ($cli, $section);
my $myCmd = $preCmd;
$myCmd .= ($params{USEGROUPS} && $section->{GROUP})
? " -H $section->{GROUP}" : " -H $cli";
if ($tcount) {
$myCmd .= " -N $tcount";
printf "Starting %d x %d on $cli\n", $pcount, $tcount;
$totalProcs += $pcount * $tcount;
} else {
printf "Starting %d processes on $cli\n", $pcount;
$totalProcs += $pcount;
}
print STDERR "$cli: $myCmd\n"; # log the actual command
$pid = forkproc ($rsh, $cli, $myCmd,
"$resultdir/work.wld", $stdout);
push @localPids, $pid if ($cli =~ /^localhost$/i);
}
}
if (@localPids) {
# print "Trapping extraneous local signals\n";
# This doesnt trap quite right. We dont die, but shell returns...
$SIG{ALRM} = 'IGNORE'; # in case we get an ALRM from the mailclient
}
printf "\nTest duration: %d %s. Rampup time: %d %s. Number of clients: %d\n",
figureTimeNumber ($params{TIME}),
figureTimeUnits ($params{TIME}, "seconds"),
figureTimeNumber ($params{RAMPTIME}),
figureTimeUnits ($params{RAMPTIME}, "seconds"),
$totalProcs;
do 'makeindex.pl' || warn "$@\n"; # html index
print "Waiting for test to finish.\n";
print "Waiting: ", scalar(localtime), "\n";
# wait for children to finish
$pid = wait();
if (@forceDownPids) { # shut down after the first return.
print "Shutting down @forceDownPids\n";
kill 1 => @forceDownPids; # sigHUP
# kill 9 => @forceDownPids; # sigTERM
}
while ($pid != -1) { # wait for all children
$pid = wait();
}
foreach $section (@workload) { # do post test commands
next unless ($section->{sectionTitle} =~ /POSTTEST/o);
unless ($section->{COMMAND}) {
print "PostTest with no command for $section->{sectionParams}\n";
next;
}
my $slist = $section->{sectionParams};
$slist =~ s/HOSTS=\s*//; # strip off initial bit
my $myCmd = $section->{COMMAND};
$myCmd =~ s/%f/$params{FREQUENCY}/; # fill in frequency variable
if ($myCmd =~ m/%c/o) { # dont force down if count is used
$count = $testsecs / $params{FREQUENCY};
$myCmd =~ s/%c/$count/; # fill in count variable
}
my $rsh = ($section->{RSH}) ? $section->{RSH} : $params{RSH};
foreach $cli (split /[\s,]/, $slist) {
printf "Running post test command on $cli\n";
open PRE, ">>$resultdir/$cli-post.log";
print PRE "========\n";
print PRE "$myCmd\n";
print PRE "========\n";
close PRE;
print STDERR "$cli: $myCmd\n"; # log the actual command
forkproc ($rsh, $cli, $myCmd,
"/dev/null", "$resultdir/$cli-post.log");
}
foreach $cli (split /[\s,]/, $slist) {
wait(); # run multiple POSTTEST section sequentially
}
}
}
print STDERR "\nDone.\n";
close(STDERR);
open STDERR, ">&SAVEERR";
print "\nClients done: ", scalar(localtime), "\n";
print "Collecting results\n";
do 'reduce.pl' || die "$@\n"; # generate graphs and sums
print "Generating results pages\n";
do 'report.pl' || die "$@\n";
# Now display that data to console
if ($params{VERBOSE}) {
fileShow ($resultstxt);
print "\n";
}
print "Processing done: ", scalar (localtime), "\n";
pathprint ("\nResults (text):\t$resultstxt\n");
pathprint ( "Results (HTML):\t$resultshtml\n");
print "Index of runs: \tfile://$cwd/$resultbase/index.html\n";
# Now check for major problems in the stderr file
if (open(RESULTSTXT, "$resultdir/stderr")) {
$ERRCNT=0;
while (<RESULTSTXT>) { $ERRCNT++; }
close(RESULTSTXT);
pathprint ("Error log ($ERRCNT lines):\t$resultdir/stderr\n");
}
{ # list user requested logging
my @logfiles = <$resultdir/*-pre.log>;
if (@logfiles) {
foreach $f (@logfiles) {
print "Pre test log: \t$f\n";
}
}
@logfiles = <$resultdir/*-run.log>;
if (@logfiles) {
foreach $f (@logfiles) {
print "Monitoring log: \t$f\n";
}
}
@logfiles = <$resultdir/*-post.log>;
if (@logfiles) {
foreach $f (@logfiles) {
print "Post test log: \t$f\n";
}
}
}
print "Mailmaster done: ", scalar(localtime), "\n"; exit 0;