зеркало из https://github.com/mozilla/pjs.git
577 строки
19 KiB
Perl
577 строки
19 KiB
Perl
|
#!/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;
|