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