#!/usr/bin/perl -w
require 5.003;
use strict;

use lib '/usr/local/polygraph/BB';

require Command;
require Blob;
require Executer;
require Tools;
use Logger;

# Client -> Server Names 
# note: these are host names/ips, not necessarily poly-robot/server ips
my @Hosts = (
	'10.10.1.1' => '10.10.129.1', # hard coded pairs
	#&importHostNames(),  # or use shell environment variables
);

my $Proxy = '10.10.1.1:3128'; # one for all
my $Master = '10.10.0.1';     # monitoring machine
my $Take = time()-940000000;  # to avoid new logs overwriting old ones
my %HostPairs = @Hosts;


# executed before each run
my @HeadCmds = (
	Cmd('date'),
	Pairs(
		'ssh $clt killall polyclt',
		'ssh $srv killall polysrv',
	),
	All('ssh $host mkdir logs'),
	All('ssh $host /usr/sbin/ntpdate -b $Master'),
	Cmd('sleep 600'),
);

# executed after each run
my @TailCmds = (
	Pairs(
		'ssh $clt killall -INT polyclt',
		'ssh $srv killall -INT polysrv',
	),
	Pairs(
		'scp -p $clt:logs/clt.\* logs.archive/',
		'scp -p $srv:logs/srv.\* logs.archive/',
	),
	All('ssh $host mv logs logs.local/$name'),
	Cmd('exprep.pl logs.archive/clt.$exp_mask.*.log'),
	Cmd('date'),
);

my @BlobCfgs  = (
	{
		# this is a no-proxy run for Polygraph 1.x
		# for Polygraph 2.x, see pmix2 workload and
		# remove --proxy option

		name => 'no-proxy.rr$rr.take$Take',
		exp_mask => 'no-proxy.rr:*:.take$Take',

		body => [ Pairs(
			'ssh $clt sleep 10\;
			bin/polyclt
				--ports 1024:30000
				--verb_lvl 4
				--origin $srv:80
				--rng_seed $cmd_id
				--rep_cachable 80p
				--pconn_use_lmt zipf:64
				--nagle off
				--robots 1
				--req_rate $rr/sec
				--dhr 55p
				--pop_model unif
				--tmp_loc none
				--cool_phase 1min
				--goal -1:1hr:0.30
				--log_size 15MB
				--log logs/clt.$name.$clt.log
				--console logs/clt.$name.$clt.con
				--notify $Master:18256
				--label np$rr
				',
			'ssh $srv bin/polysrv
				--port 80
				--verb_lvl 4
				--rng_seed $cmd_id
				--idle_tout 135sec
				--pconn_use_lmt zipf:16
				--nagle off
				--xact_think norm:3s,1.5s
				--obj_bday const:-1year
				--obj_with_lmt 100p
				--obj_life_cycle const:2year 
				--obj_expire 100p=lmt+const:1
				--goal 4.1hr
				--log_size 15MB
				--log logs/srv.$name.$srv.log
				--console logs/srv.$name.$srv.con
				--notify $Master:18256
				--label np$rr
				',
			),
		],

		runs => [ Runs('rr', 500) ],
	},

	{
		name => 'fill.cl$cl.take$Take',
		exp_mask => 'fill.cl:*:.take$Take',

		body => [ Pairs(
			'ssh $clt bin/polyclt 
				--ports 1024:30000
				--verb_lvl 4
				--proxy $Proxy --origin $srv:80
				--rng_seed $cmd_id
				--unique_urls 1
				--rep_cachable 100p 
				--pconn_use_lmt const:1000
				--nagle off
				--robots $cl
				--launch_win 30sec
				--cool_phase 1min
				--goal -1:8hr:.30
				--log_size 35MB
				--log logs/clt.$name.$clt.log
				--console logs/clt.$name.$clt.con
				--notify $Master:18256
				--label fl$cl
				',
			'ssh $srv bin/polysrv 
				--port 80 
				--verb_lvl 4
				--rng_seed $cmd_id
				--pconn_use_lmt const:1000
				--nagle off
				--obj_bday const:-1year
				--obj_with_lmt 100p
				--obj_life_cycle const:2year 
				--obj_expire 100p=lmt+const:1
				--idle_tout 5min
				--log_size 35MB
				--log logs/srv.$name.$srv.log
				--console logs/srv.$name.$srv.con
				--notify $Master:18256
				--label fl$cl
				',
			),
		],

		runs => [ Runs('cl', 10) ],
	},

	{
		name => 'dcomm.rr$rr.take$Take',
		exp_mask => 'dcomm.rr:*:.take$Take',

		body => [ Pairs(
			'ssh $clt sleep 10\;
			bin/polyclt
				--ports 1024:30000
				--verb_lvl 4
				--proxy $Proxy --origin $srv:80
				--launch_win 1min
				--rng_seed $cmd_id
				--rep_cachable 80p
				--pconn_use_lmt zipf:64
				--nagle off
				--robots 1
				--req_rate $rr/sec
				--dhr 55p
				--pop_model unif
				--tmp_loc none
				--cool_phase 1min
				--goal -1:4hr:0.30
				--log_size 15MB
				--log logs/clt.$name.$clt.log
				--console logs/clt.$name.$clt.con
				--notify $Master:18256
				--label dc$rr
				',
			'ssh $srv bin/polysrv
				--port 80
				--verb_lvl 4
				--rng_seed $cmd_id
				--pconn_use_lmt zipf:16
				--nagle off
				--idle_tout 135sec
				--xact_think norm:3s,1.5s
				--obj_bday const:-1year
				--obj_with_lmt 100p
				--obj_life_cycle const:2year 
				--obj_expire 100p=lmt+const:1
				--goal 4.1hr
				--log_size 15MB
				--log logs/srv.$name.$srv.log
				--console logs/srv.$name.$srv.con
				--notify $Master:18256
				--label dc$rr
				',
			),
		],

		runs => [ Runs('rr', 100, 150) ],
	},
	{
		# these specs assume that all PGL files
		# are in pgs/ and pgs/include remote directories
		# you may want to adjust @HeadCmds to sync those
		# directories automatically before each run

		# remove --proxy option for transparent setups
		# and no-proxy tests

		name => 'pmix2.take$Take',
		exp_mask => 'pmix2.take:*:ip',

		body => [ Pairs(
			'ssh $clt sleep 10\;
			bin/polyclt
				--proxy $Proxy
				--config pgs/polymix-2.pg
				--cfg_dirs pgs/include
				--verb_lvl 10
				--rng_seed $cmd_id
				--log logs/clt.$name.ip$clt.log
				--console logs/clt.$name.ip$clt.con
				--notify $Master:18256
				--label pm2
				',
			'ssh $srv bin/polysrv
				--config pgs/polymix-2.pg
				--cfg_dirs pgs/include
				--verb_lvl 10
				--rng_seed $cmd_id
				--idle_tout 5min
				--log logs/srv.$name.ip$srv.log
				--console logs/srv.$name.ip$srv.con
				--notify $Master:18256
				--label pm2
				',
			),
		],

		# this is left for backwards compatability, not used
		runs => [ Runs('rr', map { sprintf('%.2f', $_/1.) }
			1
		) ],
	},
	{
		# warning: this workload specs comes from the first 
		# bake-off tests and may need adjustments with later
		# version of Polygraph
		name => 'pmix1.rr$rr.take$Take',
		exp_mask => 'pmix1.rr:*:.take$Take',

		body => [ Pairs(
			'ssh $clt polyclt
				--ports 1024:30000
				--verb_lvl 4
				--proxy $Proxy --origin $srv:80
				--launch_win 1min
				--rng_seed $cmd_id
				--rep_cachable 80p
				--robots 1
				--req_rate $rr/sec
				--dhr 55p
				--pop_model unif
				--tmp_loc none
				--cool_phase 1min
				--goal -1:1hr:0.30
				--log logs/clt.$name.$clt.log
				--console logs/clt.$name.$clt.con
				',
			'ssh $srv polysrv
				--port 80
				--verb_lvl 4
				--rng_seed $cmd_id
				--idle_tout 135sec
				--xact_think norm:3s,1.5s
				--goal 1.1hr
				--log logs/srv.$name.$srv.log
				--console logs/srv.$name.$srv.con
				',
			),
		],

		runs => [ Runs('rr', 10, 100) ],
	},
);


$| = 1;

my @BlobPlan = ();

my @ActiveBlobNames = @ARGV;
my $FilterNames = scalar @ActiveBlobNames;
my @PossibleBlobNames = ();

foreach my $blob_cfg (@BlobCfgs) {
	my $blob = new BB::Blob($blob_cfg->{name});
	die() unless $blob_cfg->{body};
	die() unless $blob_cfg->{runs};

	$blob->exp_mask($blob_cfg->{exp_mask});

	$blob->head($blob_cfg->{head} || [@HeadCmds]);
	$blob->body($blob_cfg->{body});
	$blob->tail($blob_cfg->{tail} || [@TailCmds]);

	foreach (@{$blob_cfg->{runs}}) {
		my $b = $blob->clone($_);

		push @PossibleBlobNames, $b->name();

		# filter out extras
		if ($FilterNames) {
			next if ! grep { $b->name() =~ m/$_/; } @ActiveBlobNames;
		}

		push @BlobPlan, $b;
	}
}

if (!@BlobPlan) {
	die("No blobs!\n") unless $FilterNames;
	die(sprintf("No matching blobs among: %s\n",
		join(' ', @PossibleBlobNames)));
}

&Log("pid: $$");
&printRoutes(@Hosts);

&Log("starting...");
&Log("plan: ", join(' ', map { $_->name() } @BlobPlan));

&startNext(); # start the sequence

while (defined &BB::Executer::Step(60)) { ; }

&Log("terminating...");

exit 0;


sub startNext {
	my $blob = shift @BlobPlan;
	return &Log("no more blobs") unless $blob;

	$blob->run(\&blobDone);
}

sub blobDone {
	&startNext();
}


sub Cmd {
	my ($tmpl, $label) = @_;
	return new BB::Command($tmpl, $label || 'local');
}

sub All {
	my $tmpl = shift;
	my $cmd = Cmd($tmpl, '$host');

	my @cfgs = Cfgs('host', @Hosts);
	return BB::Tools::Breed($cmd, @cfgs);
}

sub Pairs {
	my ($tmpl_clt, $tmpl_srv) = @_;

	my $cmd_clt = Cmd($tmpl_clt, '$clt');
	my $cmd_srv = Cmd($tmpl_srv, '$srv');

	# these are actually the same
	my @cfgs_clt = Cfgs2(\%HostPairs);
	my @cfgs_srv = Cfgs2(\%HostPairs);

	# note the order!
	return 
		BB::Tools::Breed($cmd_srv, @cfgs_srv),
		BB::Tools::Breed($cmd_clt, @cfgs_clt);
}

sub Runs {
	my $var_name = shift;

	return Cfgs($var_name, @_);
}

sub Cfgs {
	my $var_name = shift;

	my @cfgs = ();

	foreach (@_) {
		push @cfgs, {
			$var_name => $_,
			Proxy => $Proxy,
			Take => $Take,
			Master => $Master,
		};
	}

	return @cfgs;
}

sub Cfgs2 {
	my $hosts = shift;

	my @cfgs = ();

	my ($clt, $srv);
	while (($clt, $srv) = each %{$hosts}) {
		push @cfgs, { clt => $clt, srv => $srv, 
			Proxy => $Proxy,
			Take => $Take,
			Master => $Master,
			};
	}

	return @cfgs;
}

# read well-known environment variables for clt/srv addresses
sub importHostNames {
	my $err = sprintf("bad \$clients or \$servers env vars!\nclt: %s\nsrv: %s;\nstopped",
		$ENV{'clients'} || '<none>',
		$ENV{'servers'} || '<none>');

	die($err) if !$ENV{'clients'} || !$ENV{'servers'};

	my @clts = split(/\s+/, $ENV{'clients'});
	my @srvs = split(/\s+/, $ENV{'servers'});

	die($err) if !@clts || !@srvs;
	die($err) if (scalar @clts) != (scalar @srvs);
	die($err) if grep { !&hostAddr('[13579]$', $_) } @clts;
	die($err) if grep { !&hostAddr('[02468]$', $_) } @srvs;

	my @res = ();
	while (@clts && @srvs) {
		push @res, pop @clts, pop @srvs;
	}

	return @res;
}

sub printRoutes {
	my @routes = @_;

	my $table = '';
	for (my $i = 0; $i <= $#routes; $i += 2) {
		$table .= sprintf("%s => %s\n", $routes[$i], $routes[$i+1]);
	}
	&Log("routing table:\n", ButifyBuf($table));
}

sub hostAddr {
	my $pattern = shift;
	for (shift) {
		return undef unless $_;
		my @comps = split /\./;
		return undef if !@comps;
		return undef if $comps[$#comps] !~ /$pattern/;
	}
	return 1;
}