#!/usr/bin/perl

use strict;

use Getopt::Std;
use IO::File;
use IO::Dir;
use IO::Pipe;
use File::Copy;

my @scripts = ("federate.sh", "smbmount.pl", "make_hosts", "fed-tun.pl");
my $local_script_dir = ".";
my($pid, $gid);			# Process and group IDs for calling parse.tcl
my $splitter_config;		# Configuration file
my $debug;			# True if thecalled in debug mode
my $verbose;			# True for extra progress reports
my $startem;			# If true, start the sub-experiments
my $eid;			# Experiment ID
my $tcl;			# The experiment description (topology file)
my $master;			# Master testbed
my $tmpdir;			# tmp files
my $tb_config;			# testbed configurations
my $smb_share;			# Share to mount from the master
my $project_user;		# User to mount project dirs as
my($gw_pubkey, $gw_pubkey_base);# Connector pubkey (full path & basename)
my($gw_secretkey, $gw_secretkey_base);# Connector secret key (full path & 
				# basename)
my $tcl_splitter;		# tcl program to split experiments
				# (changed during devel)
my $tclsh;			# tclsh to call directly (changed during devel)
my @tarfiles;			# Tarfiles in use by this experiment
my $timeout;			# The timeout to use for experiment swap ins
my %opts;			# Parsed options

my $tbparams = {};		# Map of the per-testbed parameters from the
				# testbeds file.  It is a reference to a hash
				# of hashes (because it's passed around a bunch
				# and it's nicer to have one access pattern
				# throughout the script, in the main loop and
				# the subroutines).  That access is exemplified
				# by  $tbparams->{'deter'}->{'domain'} which is
				# the domain parameter of the DETER testbed.  
my $fail_soft;			# Do not swap failed sub-experiments out

# Parse the config file.  The format is a colon-separated parameter name
# followed by the value of that parameter to the end of the line.  This parses
# that format and puts the parameters into the referenced hash.  Parameter
# names are mapped to lower case, parameter values are unchanged.  Returns 0 on
# failure (e.g. file open) and 1 on success.
sub parse_config {
    my($file, $href) = @_;
    my $fh = new IO::File($file);
	
    unless ($fh) {
	warn "Can't open $file: $!\n";
	return 0;
    }

    while (<$fh>) {
	next if /^\s*#/ || /^\s*$/;	# Skip comments & blanks
	chomp;
	/^([^:]+):\s*(.*)/ && do {
	    my $key = $1; 

	    $key =~ tr/A-Z/a-z/;
	    $href->{$key} = $2;
	    next;
	};
	warn "Unparasble line in $file: $_\n";
    }
    $fh->close();   # It will close when it goes out of scope, but...
    return 1;
}

# Parse an easier-to-read testbeds file (the original was comma-separated
# unadorned strings).  The format is a testbed scope as [testbed] followed by
# the colon-separated attribute-value pairs for the testbed.  Right now these
# go into a set of global hashes indexed by testbed, but that should probably
# change.

sub parse_testbeds {
    my($file, $tbparams) = @_;	    # Testbeds file and parameter hash
    my $fh = new IO::File($file);  # Testbeds filehandle
    my $tb;			    # Current testbed
    # Convert attribute in the file to global variable name.  XXX: Again, this
    # needs to be a 2-level hash
    my %attr_to_hash = (
	"opsnode" => "host",
	"user" => "user",
	"domain" => "domain",
	"project" => "project",
	"connectortype" => "gwtype",
	"slavenodestartcmd" => "expstart",
	"slaveconnectorstartcmd" => "gwstart",
	"masternodestartcmd" => "mexpstart",
	"masterconnectorstartcmd" => "mgwstart",
	"connectorimage" => "gwimage",
	"fileserver" => "fs",
	"boss" => "boss",
	"tunnelcfg" => "tun"
    );


    unless ($fh) {
	warn "Can't open $file: $!\n";
	return 0;
    }

    while (<$fh>) {
	next if /^\s*#/ || /^\s*$/;	# Skip comments & blanks
	chomp;
	/^\s*\[(.*)\]/ && do {
	    $tb = $1;
	    $tbparams->{$tb} = {} unless $tbparams->{$tb};
	    next;
	};

	/^([^:]+):\s*(.*)/ && do {
	    unless ($tb) {
		warn "Ignored attribute definition before testbed " .
		    "defined in $file: $_\n";
		next;
	    }
	    my $key = $1; 
	    $key =~ tr/A-Z/a-z/;
	    my $var = $attr_to_hash{$key};

	    if ($var) { $tbparams->{$tb}->{$var} = $2; }
	    else { warn "Unknown keyword $key in $file\n"; }

	    next;
	};
	warn "Unparasble line in $file: $_\n";
    }
    $fh->close();   # It will close when it goes out of scope, but...
    return 1;
}


# use scp to transfer a file, reporting true if successful and false otherwise.
# Parameters are the local file name, the ssh host destination (either hostname
# oe user@host), and an optional destination file name or directory.  If no
# destination is given, the file is transferred to the given user's home
# directory.  If only a machine is given in the ssh host destination, the
# current user is used.
sub scp_file {
    my($file, $user, $host, $dest) = @_;

    # XXX system with a relative pathname is sort of gross
    system("scp $file $user\@$host:$dest");
    if ($?) {
	warn "scp failed $?\n";
	return 0;
    }
    else { return 1; }
}

# use ssh to execute the given command on the machine (and as the user) in
# $where.  Parameters are the ssh destination directive ($where) and the
# command to execute, and a prefix to be placed on a message generated if the
# command fails.   On failure print a warning if a warning prefix was given and
# return false.  If timeout is given fork a process and set an alarm of that
# many seconds.  Timeouts also return 0;
sub ssh_cmd {
    my($user, $host, $cmd, $wname, $timeout) = @_;
    my $pid;		    # Child pid

    if ( $timeout ) {
	if ( $pid = fork () ) {
	    # Parent process
	    # The eval acts as a signal catcher.  If the alarm goes off inside
	    # the eval, the die will put "alarm\n" into $@, otherwise the
	    # return value of the execution in the child process will be used.
	    my $rv = eval {
		local $SIG{'ALRM'} = sub{ die "alarm\n"; };
		my $rv;

		alarm $timeout;
		$rv = waitpid($pid, 0);
		alarm 0;
		$rv;
	    };

	    # If the eval succeeded, $@ will be null and we can use $rv, which
	    # is the return code from the subprocess.  If the eval timed out,
	    # print a warning and assume the best.
	    if ($@ eq "alarm\n" ) {
		warn "$wname timed out - pid $pid still live\n";
		return 1;
	    }
	    else {
		return $rv;
	    }
	}
	else {
	    # Child process
	    # XXX system with a relative pathname is sort of gross
	    exec("ssh $user\@$host $cmd");
	    exit 0;
	}
    }
    else {
	# No timeout, do all the work here.
	# XXX system with a relative pathname is sort of gross
	system ("ssh $user\@$host $cmd");
	if ($?) {
	    warn "$wname failed $?\n" if $wname;
	    return 0;
	}
	else { return 1; }
    }
}

# Ship local copies of the federation scripts out to the given host.  If any of
# the script transfers fails, return 0.  The scripts to transfer are from the
# global @scripts and are found locally in $local_script_dir (another global).
sub ship_scripts {
    my($host, $user, $dest_dir) = @_;	    # Where, who, where remotely
    my $s;

    &ssh_cmd($user, $host, "mkdir -p $dest_dir");
    for $s (@scripts) {
	&scp_file("$local_script_dir/$s", $user, $host, $dest_dir) || 
	    return 0;
    }
    return 1;
}

# Ship per-testbed configuration generated by this script to the remote /proj
# directories on the remote testbeds
sub ship_configs {
    my($host, $user, $src_dir, $dest_dir) = @_;	    # Where, who, where remotely
    my($d, $f);

    $d = IO::Dir->new($src_dir) || return 0;

    # All directories under $tmpdir are 770 so we can delete them later.
    &ssh_cmd($user, $host, "mkdir -p $dest_dir") || return 0;
    &ssh_cmd($user, $host, "chmod 770 $dest_dir") || return 0;
    while ( $f = $d->read()) {
	next if $f =~ /^\./;
	if ( -d "$src_dir/$f" ) {
	    &ship_configs($host, $user, "$src_dir/$f", "$dest_dir/$f") || 
		return 0;
	}
	else {
	    &scp_file("$src_dir/$f", $user, $host, $dest_dir) || return 0;
	}
    }
    return 1;
}

# Start a sub section of the experiment on a given testbed.  The testbed and
# the user to start the experiment as are pulled from the global per-testbed
# hash, passed in as $tbparams, as is the project name on the remote testbed.
# Parameters are the testbed and the experiment id.  Configuration files are
# scp-ed over to the target testbed from the global $tmpdir/$tb directory.
# Then the current state of the experiment determined using expinfo.  From that
# state, the experiment is either created, modified or spapped in.  If
# everything succeeds, true is returned.  If the global verbose is set progress
# messages are printed.
sub start_segment {
    my($tb, $eid, $tbparams, $timeout) = @_;# testbed, experiment ID, 
					    # per-testbed parameters and remote
					    # swap-in timeout
    my $host =				    # Host name of remote ops (FQDN)
	$tbparams->{$tb}->{'host'} . $tbparams->{$tb}->{'domain'};
    my $user = $tbparams->{$tb}->{'user'};  # user to pass to ssh
    my $pid = $tbparams->{$tb}->{'project'};# remote project to start the
					    # experiment under
    my $tclfile = "./$eid.$tb.tcl";	    # Local tcl file with the
					    # sub-experiment
    my $proj_dir = "/proj/$pid/exp/$eid/tmp";  # Where to stash federation stuff
    my $tarfiles_dir = "/proj/$pid/tarfiles/$eid";  # Where to stash tarfiles
    my $to_hostname = "$proj_dir/hosts";    # remote hostnames file
    my $state;				    # State of remote experiment
    my $status = new IO::Pipe;		    # The pipe to get status

    # Determine the status of the remote experiment
    $status->reader("ssh $user\@$host /usr/testbed/bin/expinfo $pid $eid") || 
	die "Can't ssh to $user\@$host:$!\n";

    # XXX: this is simple now.  Parsing may become more complex
    while (<$status>) {
	/State: (\w+)/ && ($state = $1);
	/No\s+such\s+experiment/ && ($state = "none");
    }
    $status->close();
    print "$tb: $state\n";

    # Copy the experiment definition data over 
    print "transferring subexperiment to $tb\n" if $verbose;
    &scp_file("$tmpdir/$tb/$tclfile", $user, $host) || return 0;
    # Clear out any old experiment data; if not deleted, copies over it by
    # different users will fail.
    # (O /bin/csh, how evil thou art.  The -c and the escaped single quotes
    # force the /bin/sh interpretation of the trailing * (which we need to keep
    # tmp around))  Again, this needs to be done more properly once we have a
    # non-ssh interface here.)
    print "clearing experiment subdirs on $tb\n" if $verbose;
    &ssh_cmd($user, $host, "/bin/sh -c \\'/bin/rm -rf $proj_dir/*\\'") || 
	return 0;
    print "clearing experiment tarfiles subdirs on $tb\n" if $verbose;
    &ssh_cmd($user, $host, "/bin/rm -rf $tarfiles_dir/") || 
	return 0;
    print "creating tarfiles subdir $tarfiles_dir on $tb\n" if $verbose;
    &ssh_cmd($user, $host, "mkdir -p $tarfiles_dir", "create tarfiles") || 
	return 0;
    # Remote experiment is active.  Modify it.
    if ($state eq "active") {
	print "Transferring federation support files to $tb\n" if $verbose;
	# First copy new scripts and hostinfo into the remote /proj
	&scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
	    return 0;
	&ship_scripts($host, $user, $proj_dir) || return 0;
	&ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
	if ( -d "$tmpdir/tarfiles") {
	    &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
		return 0;
	}

	print "Modifying $eid in place on $tb\n" if $verbose;
	&ssh_cmd($user, $host, "/usr/testbed/bin/modexp -r -s -w $pid " . 
	    "$eid $tclfile", "modexp", $timeout) || return 0;
	return 1;
    }

    # Remote experiment is swapped out, modify it and swap it in.
    if ($state eq "swapped") {
	print "Transferring federation support files to $tb\n" if $verbose;
	# First copy new scripts and hostinfo into the remote /proj (because
	# the experiment exists, the directory tree should be there.
	&scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
	    return 0;
	&ship_scripts($host, $user, $proj_dir) || return 0;
	&ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
	if ( -d "$tmpdir/tarfiles") {
	    &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
		return 0;
	}

	print "Modifying $eid on $tb\n" if $verbose;
	&ssh_cmd($user, $host, "/usr/testbed/bin/modexp -w $pid $eid $tclfile", 
	    "modexp") || return 0;
	print "Swapping $eid in on $tb\n" if $verbose;
	# Now start up
	&ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
	    "swapexp", $timeout) || return 0;
	return 1;
    }

    # No remote experiment.  Create one.  We do this in 2 steps so we can put
    # the configuration files and scripts into the new experiment directories.
    if ($state eq "none") {

	if ( -d "$tmpdir/tarfiles") {
	    # Tarfiles have to exist for the creation to work
	    print "copying tarfiles to $tb\n";
	    &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
		return 0;
	}
	print "Creating $eid on $tb\n" if $verbose;
	&ssh_cmd($user, $host, "/usr/testbed/bin/startexp -i -f -w -p " . 
	    "$pid -e $eid $tclfile", "startexp") || return 0;
	print "Transferring federation support files to $tb\n" if $verbose;
	# First copy new scripts and hostinfo into the remote /proj
	&scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
	    return 0;
	&ship_scripts($host, $user, $proj_dir) || return 0;
	&ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
	# Now start up
	print "Swapping $eid in on $tb\n" if $verbose;
	&ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
	    "swapexp", $timeout) || return 0;
	return 1;
    }

    # Every branch for a known state returns.  If execution gets here, the
    # state is unknown.
    warn "unknown state: $state\n";
    return 0;
}

# Swap out a sub-experiment - probably because another has failed.  Arguments
# are testbed and experiment.  Most of the control flow is similar to
# start_segment, though much simpler.
sub stop_segment {
    my($tb, $eid, $tbparams) = @_;	    # testbed, experiment ID and 
					    # per-testbed parameters
    my $user = $tbparams->{$tb}->{'user'};  # testbed user
    my $host =				    # Ops node
	$tbparams->{$tb}->{'host'} . $tbparams->{$tb}->{'domain'};
    my $pid = $tbparams->{$tb}->{'project'};# testbed project

    print "Stopping $eid on $tb\n" if $verbose;
    &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid out", 
	"swapexp (out)") || return 0;
    return 1;
}


$pid = $gid = "dummy";		    # Default project and group to pass to
				    # $tcl_splitter above.  These are total
				    # dummy arguments;  the splitter doesn't
				    # use them at all, but we supply them to
				    # keep our changes to the parser minimal.
# Argument processing.
getopts('Ft:c:f:ndvN', \%opts);
$splitter_config = $opts{'c'} || "./splitter.conf";
$debug = $opts{'d'};
$verbose = $opts{'v'} || $opts{'d'};

&parse_config("$splitter_config", \%opts) || 
    die "Cannot read config file $splitter_config: $!\n";
$fail_soft = $opts{'F'} || $opts{'failsoft'};

$startem = $opts{'n'} ? 0 : 1;		# If true, start the sub-experiments
$timeout = $opts{'t'} || $opts{'timeout'};
$eid = $opts{'experiment'};		# Experiment ID
$tcl = $opts{'f'} || shift;		# The experiment description
$master = $opts{'master'};		# Master testbed
$tmpdir = $opts{'tmpdir'} || $opts{'tempdir'}|| "/tmp"; # tmp files
$tb_config = $opts{'testbeds'} || "./testbeds";	# testbed configurations
$local_script_dir = $opts{'scriptdir'};	# Local scripts

$smb_share = $opts{'smbshare'} ||	# Share to mount from the master
    die "Must give an SMB share\n";
$project_user = $opts{'smbuser'} ||	# User to mount project dirs as
    die "Must give an SMB user\n";

# For now specify these.  We may want to generate them later.
$gw_pubkey = $opts{'gatewaypubkey'};
($gw_pubkey_base = $gw_pubkey) =~ s#.*/##;
$gw_secretkey = $opts{'gatewaysecretkey'};
($gw_secretkey_base = $gw_secretkey) =~ s#.*/##;

# tcl program to split experiments (changed during devel)
$tcl_splitter = $opts{'tclparse'} || "/usr/testbed/lib/ns2ir/parse.tcl";
# tclsh to call directly (changed during devel)
$tclsh = $opts{'tclsh'} || "/usr/local/bin/otclsh";

# Prefix to avoid collisions
$tmpdir .= "/split$$";

print "Temp files are in $tmpdir\n" if $verbose;
# Create a workspace
unless (-d "$tmpdir") {
    mkdir("$tmpdir") || die "Can't create $tmpdir: $!";
}

# Validate scripts directory
for my $s (@scripts) {
    die "$local_script_dir/$s not in local script directory. Try -d\n"
	unless -r "$local_script_dir/$s";
}

die "Must supply file, master and experiment" unless $master && $tcl && $eid;

if ($opts{'N'} ) {
    &parse_testbeds($tb_config, $tbparams) ||
	die "Cannot testbed congfigurations from $tb_config: $!\n";
}
else {
    # Read a hash of per-testbed parameters from the local configurations.
    my $conf = new IO::File($tb_config) || 
	die "can't read testbed configutions from $tb_config: $!\n";
    while (<$conf>) {
	next if /^#/;
	chomp;
	my($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss,
	    $tun) = split(":", $_);
	$tbparams->{$tb}->{'host'} = $h;
	$tbparams->{$tb}->{'user'} = $u;
	$tbparams->{$tb}->{'domain'} = $d;
	$tbparams->{$tb}->{'project'} = $p;
	$tbparams->{$tb}->{'gwtype'} = $t;
	$tbparams->{$tb}->{'expstart'} = $es;
	$tbparams->{$tb}->{'gwstart'} = $gs;
	$tbparams->{$tb}->{'mexpstart'} = $mes;
	$tbparams->{$tb}->{'mgwstart'} = $mgs;
	$tbparams->{$tb}->{'gwimage'} = $i;
	$tbparams->{$tb}->{'fs'} = $fs;
	$tbparams->{$tb}->{'boss'} = $boss;
	$tbparams->{$tb}->{'tun'} = $tun;

	# Make sure the domain starts with a period
	$tbparams->{$tb}->{'domain'} = "." . $tbparams->{$tb}->{'domain'}
	    unless $tbparams->{$tb}->{'domain'} =~ /^\./;
    }
    $conf->close();
}

# Open a pipe to the splitter program and start it parsing the experiments
my $pipe = new IO::Pipe;
# NB no more -p call on parse call.
$pipe->reader("$tclsh $tcl_splitter -s -m $master  $pid $gid $eid $tcl") || 
    die "Cannot execute $tclsh $tcl_splitter -s -m $master $pid $gid $eid $tcl:$!\n";

# Parsing variables
my $ctb;			# Current testbed
my %allocated;			# If allocated{$tb} > 0, $tb is in use
my $destfile;			# File that the sub-experiment tcl file is
				# being written to, or "" if none.  Also used
				# for hostnames file.
my $desthandle;			# File handle for distfile
my $gateways;			# when gateway lists are being processed this
				# is the testbed whose gateways are being
				# gathered.
my $control_gateway;		# Control net gateway for the current testbed
my %active_end;			# If active_end{"a-b"} > 0 then a is the active
				# end of the a <-> b connector pair.

# Parse the splitter output.  This loop creates the sub experiments, gateway
# configurations and hostnames file
while (<$pipe>) {
    # Start of a sub-experiment
    /^#\s+Begin\s+Testbed\s+\((\w+)\)/ && do {
	$ctb = $1;

	# If we know the testbed, start collecting its sub experiment tcl
	# description.  If not, warn the caller and ignore the configuration of
	# this testbed.
	if ($tbparams->{$ctb}) {
	    $allocated{$ctb}++;	# Keep track of the testbeds allocated

	    unless (-d "$tmpdir/$ctb") {
		mkdir("$tmpdir/$ctb") || die "Can't create $tmpdir/$ctb: $!";
	    }
	    $destfile = "$tmpdir/$ctb/$eid.$ctb.tcl";

	    $desthandle = new IO::File(">$destfile") || 
		die "Cannot open $destfile:$!\n";
	}
	else { 
	    warn "No such testbed $ctb\n";
	    $destfile = "";
	}
	next;
    };

    # End of that experiment
    /^#\s+End\s+Testbed\s+\((\w+)\)/ && do {
	# Simple syntax check and close out this experiment's tcl description
	die "Mismatched testbed markers ($1, $ctb)\n" unless ($1 eq $ctb);
	$desthandle->close();
	$destfile = $ctb = "";
	next;
    };

    # Beginning of a gateway set
    /^#\s+Begin\s+gateways\s+\((\w+)\)/ && do {
	$gateways = $1;
	# If we've heard of this tb, create the config lines for it one at a
	# time.
	if ($allocated{$gateways}) {
	    # Just in case.  This directory should already have been created
	    # above.
	    unless (-d "$tmpdir/$gateways") {
		mkdir("$tmpdir/$gateways") || 
		    die "Can't create $tmpdir/$gateways: $!";
	    }
	}
	else {
	    warn "Gateways given (and ignored) for testbed not in use: " .
		"$gateways\n";
	    $gateways = 0;
	}
	next;
    };
    # End of the gateways section.  Output the client config for this testbed
    /^#\s+End\s+gateways\s+\((\w+)\)/ && do {
	die "Mismatched gateway markers ($1, $gateways)\n" 
	    unless !$gateways || $gateways == $1;

	if ($control_gateway ) {
	    # Client config
	    my $cc = new IO::File(">$tmpdir/$gateways/client.conf");
	    my $master_project = $tbparams->{$master}->{'project'};
	    die "Can't open $tmpdir/$gateways/client.conf: $!\n" unless $cc;
	    print $cc "ControlGateway: $control_gateway\n";
	    print $cc "SMBShare: $smb_share\n";
	    print $cc "ProjectUser: $project_user\n";
	    print $cc "ProjectName: $master_project\n";
	    $cc->close();
	}
	else { warn "No control gateway for $gateways?\n"; }
	    
	$gateways = 0;
	next;
    };
    # Beginning of the hostnames list.  Collection is always in the hostnames
    # file.
    /^#\s+Begin\s+hostnames/ && do {
	$destfile = "$tmpdir/hostnames";
	$desthandle = new IO::File(">$destfile") || 
	    die "Can't open $destfile:$!\n";
	next;
    };
    # end of the hostnames list.
    /^#\s+End\s+hostnames/ && do {
	$desthandle->close();
	$destfile = "";
	next;
    };

    # Generate gateway configuration info, one file per line
    $gateways && do {
	chomp;
	my($dtb, $myname, $desthost, $type) = split(" ", $_);

	# Many of these are to simplify print statements
	my $sdomain =				# domain for the source
	    $tbparams->{$gateways}->{'domain'};
	my $ddomain =				# domain for the destination
	    $tbparams->{$dtb}->{'domain'};
	my $sproject =				# Project of the destination
	    $tbparams->{$gateways}->{'project'};
	my $fs =				# Master fs node (FQDN)
	    $tbparams->{$master}->{'fs'} .  $tbparams->{$master}->{'domain'};
	my $boss =				# Master boss node (FQDN)
	    $tbparams->{$master}->{'boss'} .  $tbparams->{$master}->{'domain'};
	my $remote_script_dir =			# Remote fed script location
	    "/proj/" . $tbparams->{$dtb}->{'project'} . "/exp/$eid/tmp";
	my $active;				# Is this the active side of
						# the connector?

	$sdomain = ".$eid." . $tbparams->{$gateways}->{'project'} . "$sdomain";
	$ddomain = ".$eid." . $tbparams->{$dtb}->{'project'} . "$ddomain";

	my $conf_file = "$myname$sdomain.gw.conf";
	# translate to lower case so the `hostname` hack for specifying
	# configuration files works.
	$conf_file =~ tr/A-Z/a-z/;

	# If either end of this link is in the master side of the testbed, that
	# side is the active end. Otherwise the first testbed encountered in
	# the file will be the active end.  The $active_end variable keeps
	# track of those decisions
	if ( $dtb eq $master ) { $active = "false"; }
	elsif ($gateways eq $master ) { $active = "true"; }
	elsif ( $active_end{"$dtb-$gateways"} ) { $active="false"; }
	else { $active_end{"$gateways-$dtb"}++; $active = "true"; }

	# This is used to create the client configuration.
	$control_gateway = "$myname$sdomain"
	    if $type =~ /(control|both)/;

	# Write out the file
	my $gwconfig = new IO::File(">$tmpdir/$gateways/$conf_file")|| 
	    die "can't open $tmpdir/$gateways/$conf_file: $!\n";

	print $gwconfig "Active: $active\n";
	print $gwconfig "TunnelCfg: " . $tbparams->{$gateways}->{'tun'} . "\n";
	print $gwconfig "BossName: $boss\n";
	print $gwconfig "FsName: $fs\n";
	print $gwconfig "Type: $type\n";
	print $gwconfig "RemoteScriptDir: $remote_script_dir\n";
	print $gwconfig "Peer: $desthost$ddomain\n";
	print $gwconfig "Pubkeys: " . 
	    "/proj/$sproject/exp/$eid/tmp/$gw_pubkey_base\n";
	print $gwconfig "Privkeys: " .
	    "/proj/$sproject/exp/$eid/tmp/$gw_secretkey_base\n";
	$gwconfig->close();

	# This testbed has a gateway (most will) so make a copy of the keys it
	# needs in this testbed's subdirectory.  start_segment will transfer
	# them.
	unless (-r "$tmpdir/$gateways/$gw_pubkey_base" ) {
	    copy($gw_pubkey, "$tmpdir/$gateways/$gw_pubkey_base") ||
		die "Can't copy pubkeys ($gw_pubkey to " . 
		    "$tmpdir/$gateways/$gw_pubkey_base): $!\n";
	}
	if ($active eq "true" ) {
	    unless (-r "$tmpdir/$gateways/$gw_secretkey_base" ) {
		copy($gw_secretkey, "$tmpdir/$gateways/$gw_secretkey_base") ||
		    die "Can't copy secret keys ($gw_secretkey to " . 
			"$tmpdir/$gateways/$gw_secretkey_base): $!\n";
	    }
	}

	#done processing gateway entry, ready for next line
	next; 
    };
    (/^#\s+Begin\s+tarfiles/../^#\s+End\s+tarfiles/) && do {
	next if /^#/;
	chomp;
	push(@tarfiles, $_);
	next;
    };

    next unless $destfile;  # Unidentified testbed, ignore config
    # local copies that can be used in the substitutions below
    my $gwtype = $tbparams->{$ctb}->{'gwtype'};
    my $gwimage = $tbparams->{$ctb}->{'gwimage'};
    my $mgwstart = $tbparams->{$ctb}->{'mgwstart'};
    my $mexpstart = $tbparams->{$ctb}->{'mexpstart'};
    my $gwstart = $tbparams->{$ctb}->{'gwstart'};
    my $expstart = $tbparams->{$ctb}->{'expstart'};
    my $project = $tbparams->{$ctb}->{'project'};

    # Substitute variables
    s/GWTYPE/$gwtype/g;
    s/GWIMAGE/$gwimage/g;
    if ($ctb eq $master ) {
	s/GWSTART/$mgwstart/g;
	s/EXPSTART/$mexpstart/g;
    }
    else {
	s/GWSTART/$gwstart/g;
	s/EXPSTART/$expstart/g;
    }
    # XXX: oh is this bad
    s#GWCONF#FEDDIR\`hostname\`.gw.conf#g;
    s#PROJDIR#/proj/$project/#g;
    s#EID#$eid#g;
    s#FEDDIR#/proj/$project/exp/$eid/tmp/#g;
    print $desthandle $_;
}
$pipe->close();
die "No nodes in master testbed ($master)\n" unless $allocated{$master};

for my $t  (@tarfiles) {
    die "tarfile '$t' unreadable: $!\n" unless -r $t;
    unless (-d "$tmpdir/tarfiles") {
	mkdir("$tmpdir/tarfiles") || 
	    die "Can't create $tmpdir/tarfiles:$!\n";
    }
    copy($t, "$tmpdir/tarfiles") || 
	die "Can't copy $t to  $tmpdir/tarfiles:$!\n";
}

exit(0) unless $startem;

my %started;		    # If $started{$tb} then $tb successfully started

# Start up the slave sub-experiments first
TESTBED:
for my $tb  (keys %allocated) {
    if ($tb ne $master) {
	if (&start_segment($tb, $eid, $tbparams, $timeout)) { $started{$tb}++; }
	else { last TESTBED; }
    }
}

# Now the master
if (&start_segment($master, $eid, $tbparams, $timeout)) { 
    $started{$master}++;
}

# If any testbed failed, swap the rest out.
if ( !$fail_soft && scalar(keys %started) != scalar(keys %allocated)) {
    for my $tb (keys %started) { &stop_segment($tb, $eid, $tbparams); }
    print "Error starting experiment\n";
    exit(1);
}
print "Experiment started\n";
print "Deleting $tmpdir (-d to leave them in place)\n" if $verbose && !$debug;
system("rm -rf $tmpdir") unless $debug;
exit(0);    # set the exit value

=pod

=head1 NAME

B<splitter.pl>

=head1 SYNOPSIS

B<splitter.pl> [B<-ndF>] [B<-t> I<secs>] [B<-c> F<config_file>]
    [B<-f> F<experiment_tcl>] [F<experiment_tcl>]

=head1 DESCRIPTION

B<splitter.pl> invokes the DETER experiment parser to split an annotated
experiment into multiple sub-experments and instantiates the sub-experiments on
their intended testbeds.  Annotation is accomplished using the
tb-set-node-testbed command, added to the parser.

Much of the script's behavior depends on the configuration file, specified with
the B<-c> flag and defaulting to F<./splitter.conf>.

The testbed labels supplied in the B<tb-set-node-testbed> command are
meaningful based on their presence in the testbeds file.  that file can be
specified in the configuration file using the B<Testbeds> directive, and
defaults to F<./testbeds>.  The syntax is described below.

Most of the intermediate files are staged in a sub-directory of a temporary
files directory and deleted at the end of the script.  Specifying the B<-d>
flag on the command line avoids the deletion for debbugging.  By default the
temporary files directory is directory is F</tmp> and can be reset in the
configuration file using the B<Tmpdir> directive.  Intermediate files are
stored under a subdirectory formed by adding the process ID of the splitter
process.  For example, if the temporary files directory is F</tmp> and the
B<splitter.pl> process ID is 2323, the temporary files will be stored in
F</tmp/split2323/>.

The expreriment is split out into one experiment description per testbed in the
temporary directory named as F<experiment.testbed.tcl> where the experiment is
the experiment ID given in the configuration file, and the testbed is the
tb-set-node-testbed parameter for the nodes in the file.

If the B<-n> option is absent the sub-experiments are then instantiated on
their testbeds.  (Here B<-n> is analogous to its use in L<make(1)>).
Per-testbed parameters are set in the testbeds file.  Sub-experiments on
slave testbeds are instantiated in a random order, but the master testbed is
currently instantiated last.

Scripts to start federation (the federation kit) are copied into the local
experiment's tmp file - e.g., F</proj/DETER/exp/simple-split/tmp>.  These are
taken from the directory given by the B<ScriptDir> directive in the
configuration file.

If B<-t> is given the parameter is treated as a parameter to B<Timeout> in 
F<splitter.conf>.

If any sub-experiment fails to instantiate, the other sub-exeriments are
swapped out.  B<-F> avoids this swap out, which can also be specified as 
B<SoftFail: true> in F<splitter.conf>

=head2 Configuration File

The configuration file is a simple set of colon-separated parameters and
values.  A configuration file must be present, either specified in the B<-c>
flag or the default F<./splitter.conf>.  All the parameter names are case
insensitive, but should not include any whitespace.  Parameter values may
include whitespace, but no newlines.

Possible parameters are:

=over 5

=item Experiment

The name of the experiment on the various testbeds

=item Master

The master testbed label from the testbeds file, described below.

=item Testbeds

The testbeds file described below, giving per-testbed parameters.  If this
directive is absent the testbeds file defaults to F<./testbeds>

=item ScriptDir

Location of the default federation scripts, i.e. the federation kit.

=item GatewayPubkey

=item GatewaySecretKey

The names of the files containing secret and public keys to use in setting up
tunnels between testbeds.  These will eventually be automatically generated.

=item TmpDir

=item TempDir

The directory where temporary files are created.  These are synonyms, but
should both be specified, B<TmpDir> has priority.  If neither is specified,
F</tmp> is used.

=item SMBShare

The SMB share on the master testbed that will be exported to remote clients.

=item SMBUser

The experiment user to mount project directories as.  This user needs to be a
member of the exported experiment - that is one of the users in the project
containing this experiment on the master testbed.

=item Tclparse

The pathname to the experiment parsing program.  Only developers should set
this.

=item Tclsh

The pathname to the local oTcl shell.  Only developers should set
this.

=item Timeout

Value in seconds after which a swap-in operatioin will be considered a success.
Often long swap-ins will hang when there are partial failures.  This works
around this issue.

=item FailSoft

If not set, failure of any sub experiment swaps the rest out.  Setting this to any value avoids this swap out.  (Also B<-F>.)

=back

=head2 Testbeds file

The configuration file (F<./testbeds> unless overridden by B<-c>) is a
colon-separated set of parameters keyed by testbed name.  The fields, in order,
are:

=over 5

=item name

The testbed to which this line of parameters applies.

=item user

The user under which to make requests to this testbed.  The user running
B<splitter.pl> must be able to authenicate as this user under L<ssh(1)> to this
testbed.

=item host

The host name of the testbed's ops node.  The user calling B<splitter.pl> must
be able to execute commands on this host via L<ssh(1)>.

=item domain

The domain of nodes in this testbed (including the ops host).  This parameter
should always start with a period.

=item project

The project under which to instantiate sub-experiments on this testbed.

=item gateway type

The node type for inter-testbed gateway nodes on this testbed.

=item experiment start (slave)

The start command to run on experimental nodes when this testbed is used as a
slave.  In all the start commands the string FEDDIR will be replaced by the
local experiment's federation scripts directory and the string GWCONF replaced
by the gatway configuration file.

=item gateway start (slave)

The start command to run on gateway nodes when this testbed is used as a slave.
The same string substitutions are made in this command as in experiment start.

=item experiment start (master)

The start command to run on experimental nodes when this testbed is used as a
master.  The same string substitutions are made in this command as in
experiment start.

=item gateway start (master)

The start command to run on gateway nodes when this testbed is used as a
master.  The same string substitutions are made in this command as in
experiment start.

=item gateway image

The disk image to be loaded on a gateway node on this testbed.

=item filesystem node

The node in the master testbed from which filesystems are mounted.

=item boss node

The node in the master testbed that controls the testbed.

=item tunnel configuration

True if the connector needs to do DETER federation.  This parameter will
probably be removed.

=back

The parsing of the testbeds is extremely simple.  Colons separate each
field and there is n provision for escaping them at this time.

=head2 New Testbeds File Format

The testbeds file has ben revamped to make it more human readable.  The
parameters are now named and specified on separate lines of the configuration
file.  Each testbed's parameters are preceeded by the testbed label in brackets
([]) on a line by itself.  After that the parameters are specified as
parameter: value.  This is essentially the same format as the configuration
file.  Parameters are:

=over 4

=item User

The user under which to make requests to this testbed.  The user running
B<splitter.pl> must be able to authenicate as this user under L<ssh(1)> to this
testbed.

=item OpsNode

The host name of the testbed's ops node.  The user calling B<splitter.pl> must
be able to execute commands on this host via L<ssh(1)>.

=item Domain

The domain of nodes in this testbed (including the ops host).  This parameter
should always start with a period.

=item Project

The project under which to instantiate sub-experiments on this testbed.

=item ConnectorType

The node type for inter-testbed connector nodes on this testbed.

=item SlaveNodeStartCmd

The start command to run on experimental nodes when this testbed is used as a
slave.  In all the start commands the string FEDDIR will be replaced by the
local experiment's federation scripts directory and the string GWCONF replaced
by the gatway configuration file.

=item SlaveConnectorStartCmd

The start command to run on gateway nodes when this testbed is used as a slave.
The same string substitutions are made in this command as in experiment start.

=item MasterNodeStartCmd

The start command to run on experimental nodes when this testbed is used as a
master.  The same string substitutions are made in this command as in
experiment start.

=item MasterConnectorStartCmd

The start command to run on gateway nodes when this testbed is used as a
master.  The same string substitutions are made in this command as in
experiment start.

=item ConnectorImage

The disk image to be loaded on a gateway node on this testbed.

=item FileServer

The node in the master testbed from which filesystems are mounted.

=item Boss

The node in the master testbed that controls the testbed.

=item TunnelCfg

True if the connector needs to do DETER federation.  This parameter will
probably be removed.


=back


=head1 ENVIRONMENT

B<splitter.pl> does not directly make use of environment variables, but calls
out to L<ssh(1)> and (indirectly) to L<sh(1)>, which may be influenced by the
environment.

=head1 SEE ALSO

L<sh(1)>, L<ssh(1)> 

=cut
