source: fedkit/splitter.pl @ e4436a6

axis_examplecompt_changesinfo-opsversion-1.30version-2.00version-3.01version-3.02
Last change on this file since e4436a6 was e4436a6, checked in by Ted Faber <faber@…>, 17 years ago

learn to spell. Or use strict.

  • Property mode set to 100644
File size: 26.9 KB
RevLine 
[1a8a08a]1#!/usr/bin/perl
2
3use Getopt::Std;
[9c00d41]4use IO::File;
5use IO::Dir;
6use IO::Pipe;
7use File::Copy;
[1a8a08a]8
[f70f9c8]9@scripts = ("federate.sh", "smbmount.pl", "make_hosts", "fed-tun.pl");
[63f7c7e]10$local_script_dir = ".";
11
[9c00d41]12# Parse the config file.  The format is a colon-separated parameter name
13# followed by the value of that parameter to the end of the line.  This parses
14# that format and puts the parameters into the referenced hash.  Parameter
15# names are mapped to lower case, parameter values are unchanged.  Returns 0 on
16# failure (e.g. file open) and 1 on success.
17sub parse_config {
18    my($file, $href) = @_;
19    my($fh) = new IO::File($file);
20       
21    unless ($fh) {
22        warn "Can't open $file: $!\n";
23        return 0;
24    }
25
26    while (<$fh>) {
27        next if /^\s*#/ || /^\s*$/;     # Skip comments & blanks
28        chomp;
29        /^([^:]+):\s*(.*)/ && do {
30            my($key) = $1; 
31
32            $key =~ tr/A-Z/a-z/;
33            $href->{$key} = $2;
34            next;
35        };
36        warn "Unparasble line in $file: $_\n";
37    }
38    $fh->close();   # It will close when it goes out of scope, but...
39    return 1;
40}
41
[fe459d0]42# Parse an easier-to-read testbeds file (the original was comma-separated
43# unadorned strings).  The format is a testbed scope as [testbed] followed by
44# the colon-separated attribute-value pairs for the testbed.  Right now these
45# go into a set of global hashes indexed by testbed, but that should probably
46# change.
47
48sub parse_testbeds {
49    my($file) = @_;                 # Testbeds file
50    my($fh) = new IO::File($file);  # Testbeds filehandle
51    my($tb);                        # Current testbed
52    # Convert attribute in the file to global variable name.  XXX: Again, this
53    # needs to be a 2-level hash
54    my(%attr_to_hash) = (
55        "opsnode" => "host",
56        "user" => "user",
57        "domain" => "domain",
58        "project" => "project",
59        "connectortype" => "gwtype",
60        "slavenodestartcmd" => "expstart",
61        "slaveconnectorstartcmd" => "gwstart",
62        "masternodestartcmd" => "mexpstart",
63        "masterconnectorstartcmd" => "mgwstart",
64        "connectorimage" => "gwimage",
65        "fileserver" => "fs",
66        "boss" => "boss",
67        "tunnelcfg" => "tun"
68    );
69
70
71    unless ($fh) {
72        warn "Can't open $file: $!\n";
73        return 0;
74    }
75
76    while (<$fh>) {
77        next if /^\s*#/ || /^\s*$/;     # Skip comments & blanks
78        chomp;
79        /^\s*\[(.*)\]/ && do {
80            $tb = $1;
81            next;
82        };
83
84        /^([^:]+):\s*(.*)/ && do {
85            unless ($tb) {
86                warn "Ignored attribute definition before testbed " .
87                    "defined in $file: $_\n";
88                next;
89            }
90            my($key) = $1; 
91            $key =~ tr/A-Z/a-z/;
92            my($var) = $attr_to_hash{$key};
93
94            # XXX: The eval is scary.  This will become a 2-level hash.
95            if ($var) { eval "\$$var\{$tb\} = \"$2\";"; }
96            else { warn "Unknown keyword $key in $file\n"; }
97
98            next;
99        };
100        warn "Unparasble line in $file: $_\n";
101    }
102    $fh->close();   # It will close when it goes out of scope, but...
103    return 1;
104}
105
[9c00d41]106
[1a8a08a]107# use scp to transfer a file, reporting true if successful and false otherwise.
108# Parameters are the local file name, the ssh host destination (either hostname
109# oe user@host), and an optional destination file name or directory.  If no
110# destination is given, the file is transferred to the given user's home
111# directory.  If only a machine is given in the ssh host destination, the
112# current user is used.
113sub scp_file {
[b68f597]114    my($file, $user, $host, $dest) = @_;
[1a8a08a]115
116    # XXX system with a relative pathname is sort of gross
[b68f597]117    system("scp $file $user\@$host:$dest");
[1a8a08a]118    if ($?) {
119        warn "scp failed $?\n";
120        return 0;
121    }
122    else { return 1; }
123}
124
125# use ssh to execute the given command on the machine (and as the user) in
126# $where.  Parameters are the ssh destination directive ($where) and the
127# command to execute, and a prefix to be placed on a message generated if the
128# command fails.   On failure print a warning if a warning prefix was given and
129# return false.
130sub ssh_cmd {
131    my($user, $host, $cmd, $wname) = @_;
132
133    # XXX system with a relative pathname is sort of gross
[c23025e]134    system ("ssh $user\@$host $cmd");
[1a8a08a]135    if ($?) {
136        warn "$wname failed $?\n" if $wname;
137        return 0;
138    }
139    else { return 1; }
140}
141
[63f7c7e]142# Ship local copies of the federation scripts out to the given host.  If any of
143# the script transfers fails, return 0.  The scripts to transfer are from the
144# global @scripts and are found locally in $local_script_dir (another global).
145sub ship_scripts {
146    my($host, $user, $dest_dir) = @_;       # Where, who, where remotely
147    my($s);
148
[2ef2c5b]149    &ssh_cmd($user, $host, "mkdir -p $dest_dir");
[63f7c7e]150    for $s (@scripts) {
[b68f597]151        &scp_file("$local_script_dir/$s", $user, $host, $dest_dir) || 
[63f7c7e]152            return 0;
153    }
154    return 1;
155}
156
[9c00d41]157# Ship per-testbed configuration generated by this script to the remote /proj
158# directories on the remote testbeds
159sub ship_configs {
160    my($host, $user, $src_dir, $dest_dir) = @_;     # Where, who, where remotely
161    my($d, $f);
162
[2ef2c5b]163
[9c00d41]164    $d = IO::Dir->new($src_dir) || return 0;
165
[3529a90]166    # All directories under $tmpdir are 770 so we can delete them later.
167    &ssh_cmd($user, $host, "mkdir -p $dest_dir") || return 0;
168    &ssh_cmd($user, $host, "chmod 770 $dest_dir") || return 0;
[9c00d41]169    while ( $f = $d->read()) {
170        next if $f =~ /^\./;
[2ef2c5b]171        if ( -d "$src_dir/$f" ) {
[3529a90]172            &ship_configs($host, $user, "$src_dir/$f", "$dest_dir/$f") || 
173                return 0;
[2ef2c5b]174        }
175        else {
[b68f597]176            &scp_file("$src_dir/$f", $user, $host, $dest_dir) || return 0;
[2ef2c5b]177        }
[9c00d41]178    }
179    return 1;
180}
181
182
[1a8a08a]183
184
185# Start a sub section of the experiment on a given testbed.  The testbed and
186# the user to start the experiment as are pulled from the global per-testbed
187# hash, as is the project name on the remote testbed.  Parameters are the
188# testbed and the experiment id.  Configuration files are scp-ed over to the
[c23025e]189# target testbed from the global $tmpdir/$tb directory.  Then the current state
190# of the experiment determined using expinfo.  From that state, the experiment
191# is either created, modified or spapped in.  If everything succeeds, true is
[a835df7]192# returned.  If the global verbose is set progress messages are printed.
[1a8a08a]193sub start_segment {
194    my($tb, $eid) = @_;                     # testbed and experiment ID
[c23025e]195    my($host) = "$host{$tb}$domain{$tb}";   # Host name of remote ops (FQDN)
[1a8a08a]196    my($user) = $user{$tb};                 # user to pass to ssh
197    my($pid) = $project{$tb};               # remote project to start the
198                                            # experiment under
199    my($tclfile) = "./$eid.$tb.tcl";        # Local tcl file with the
200                                            # sub-experiment
[63f7c7e]201    my($proj_dir) = "/proj/$pid/exp/$eid/tmp";  # Where to stash federation stuff
[b68f597]202    my($tarfiles_dir) = "/proj/$pid/tarfiles/$eid";  # Where to stash tarfiles
[63f7c7e]203    my($to_hostname) = "$proj_dir/hosts";   # remote hostnames file
[9c00d41]204    my($status) = new IO::Pipe;             # The pipe to get status
[1a8a08a]205
206    # Determine the status of the remote experiment
[9c00d41]207    $status->reader("ssh $user\@$host /usr/testbed/bin/expinfo $pid $eid") || 
[c23025e]208        die "Can't ssh to $user\@$host:$!\n";
[9c00d41]209
[1a8a08a]210    # XXX: this is simple now.  Parsing may become more complex
[9c00d41]211    while (<$status>) {
[1a8a08a]212        /State: (\w+)/ && ($state = $1);
213        /No\s+such\s+experiment/ && ($state = "none");
214    }
[9c00d41]215    $status->close();
[1a8a08a]216    print "$tb: $state\n";
217
[3529a90]218    # Copy the experiment definition data over
[a835df7]219    print "transferring subexperiment to $tb\n" if $verbose;
[b68f597]220    &scp_file("$tmpdir/$tb/$tclfile", $user, $host) || return 0;
[3529a90]221    # Clear out any old experiment data; if not deleted, copies over it by
222    # different users will fail.
[0e23fdb]223    # (O /bin/csh, how evil thou art.  The -c and the escaped single quotes
224    # force the /bin/sh interpretation of the trailing * (which we need to keep
225    # tmp around))  Again, this needs to be done more properly once we have a
226    # non-ssh interface here.)
[a835df7]227    print "clearing experiment subdirs on $tb\n" if $verbose;
[0e23fdb]228    &ssh_cmd($user, $host, "/bin/sh -c \\'/bin/rm -rf $proj_dir/*\\'") || 
229        return 0;
[b68f597]230    print "clearing experiment tarfiles subdirs on $tb\n" if $verbose;
231    &ssh_cmd($user, $host, "/bin/rm -rf $tarfiles_dir/") || 
232        return 0;
233    print "creating tarfiles subdir $tarfiles_dir on $tb\n" if $verbose;
234    &ssh_cmd($user, $host, "mkdir -p $tarfiles_dir", "create tarfiles") || 
235        return 0;
[1a8a08a]236    # Remote experiment is active.  Modify it.
237    if ($state eq "active") {
[a835df7]238        print "Transferring federation support files to $tb\n" if $verbose;
[63f7c7e]239        # First copy new scripts and hostinfo into the remote /proj
[b68f597]240        &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
[c23025e]241            return 0;
[63f7c7e]242        &ship_scripts($host, $user, $proj_dir) || return 0;
[9c00d41]243        &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
[b68f597]244        if ( -d "$tmpdir/tarfiles") {
245            &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
246                return 0;
247        }
[a835df7]248
249        print "Modifying $eid in place on $tb\n" if $verbose;
[1a8a08a]250        &ssh_cmd($user, $host, "/usr/testbed/bin/modexp -r -s -w $pid " . 
251            "$eid $tclfile", "modexp") || return 0;
252        return 1;
253    }
254
255    # Remote experiment is swapped out, modify it and swap it in.
256    if ($state eq "swapped") {
[a835df7]257        print "Transferring federation support files to $tb\n" if $verbose;
[2ef2c5b]258        # First copy new scripts and hostinfo into the remote /proj (because
259        # the experiment exists, the directory tree should be there.
[b68f597]260        &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
[838fb6a]261            return 0;
[63f7c7e]262        &ship_scripts($host, $user, $proj_dir) || return 0;
[9c00d41]263        &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
[b68f597]264        if ( -d "$tmpdir/tarfiles") {
265            &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
266                return 0;
267        }
[a835df7]268
269        print "Modifying $eid on $tb\n" if $verbose;
[2ef2c5b]270        &ssh_cmd($user, $host, "/usr/testbed/bin/modexp -w $pid $eid $tclfile", 
271            "modexp") || return 0;
[a835df7]272        print "Swapping $eid in on $tb\n" if $verbose;
[63f7c7e]273        # Now start up
[1a8a08a]274        &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
275            "swapexp") || return 0;
276        return 1;
277    }
278
[63f7c7e]279    # No remote experiment.  Create one.  We do this in 2 steps so we can put
280    # the configuration files and scripts into the new experiment directories.
[1a8a08a]281    if ($state eq "none") {
[b68f597]282
283        if ( -d "$tmpdir/tarfiles") {
284            # Tarfiles have to exist for the creation to work
285            print "copying tarfiles to $tb\n";
286            &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
287                return 0;
288        }
[fe459d0]289        print "Creating $eid on $tb\n" if $verbose;
290        &ssh_cmd($user, $host, "/usr/testbed/bin/startexp -i -f -w -p " . 
[1a8a08a]291            "$pid -e $eid $tclfile", "startexp") || return 0;
[a835df7]292        print "Transferring federation support files to $tb\n" if $verbose;
[63f7c7e]293        # First copy new scripts and hostinfo into the remote /proj
[b68f597]294        &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
[838fb6a]295            return 0;
[63f7c7e]296        &ship_scripts($host, $user, $proj_dir) || return 0;
[9c00d41]297        &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
[63f7c7e]298        # Now start up
[a835df7]299        print "Swapping $eid in on $tb\n" if $verbose;
[63f7c7e]300        &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
301            "swapexp") || return 0;
[1a8a08a]302        return 1;
303    }
304
305    # Every branch for a known state returns.  If execution gets here, the
306    # state is unknown.
307    warn "unknown state: $state\n";
308    return 0;
309}
310
311# Swap out a sub-experiment - probably because another has failed.  Arguments
312# are testbed and experiment.  Most of the control flow is similar to
313# start_segment, though much simpler.
314sub stop_segment {
315    my($tb, $eid) = @_;
316    my($user) = "$user{$tb}";
[c23025e]317    my($host) = "$host{$tb}$domain{$tb}";
[1a8a08a]318    my($pid) = $project{$tb};
319
[a835df7]320    print "Stopping $eid on $tb\n" if $verbose;
[1a8a08a]321    &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid out", 
322        "swapexp (out)") || return 0;
323    return 1;
324}
325
326
327$pid = $gid = "dummy";              # Default project and group to pass to
328                                    # $tcl_splitter above.  These are total
329                                    # dummy arguments;  the splitter doesn't
330                                    # use them at all, but we supply them to
331                                    # keep our changes to the parser minimal.
332# Argument processing.
[fe459d0]333getopts('c:f:ndvN', \%opts);
[9c00d41]334$splitter_config = $opts{'c'} || "./splitter.conf";
335$debug = $opts{'d'};
[a835df7]336$verbose = $opts{'v'} || $opts{'d'};
337
[9c00d41]338&parse_config("$splitter_config", \%opts) || 
339    die "Cannot read config file $splitter_conf: $!\n";
340
341
342$startem = $opts{'n'} ? 0 : 1;          # If true, start the sub-experiments
343$eid = $opts{'experiment'};             # Experiment ID
344$tcl = $opts{'f'} || shift;             # The experiment description
345$master = $opts{'master'};              # Master testbed
346$tmpdir = $opts{'tmpdir'} || $opts{'tempdir'}|| "/tmp"; # tmp files
347$tb_config = $opts{'testbeds'} || "./testbeds"; # testbed configurations
348$local_script_dir = $opts{'scriptdir'}; # Local scripts
[3c7da22]349
350$smb_share = $opts{'smbshare'} ||       # Share to mount from the master
351    die "Must give an SMB share\n";
352$project_user = $opts{'smbuser'} ||     # User to mount project dirs as
353    die "Must give an SMB user\n";
354
[9c00d41]355# For now specify these.  We may want to generate them later.
356$gw_pubkey = $opts{'gatewaypubkey'};
357($gw_pubkey_base = $gw_pubkey) =~ s#.*/##;
358$gw_secretkey = $opts{'gatewaysecretkey'};
359($gw_secretkey_base = $gw_secretkey) =~ s#.*/##;
360
361# tcl program to split experiments (changed during devel)
362$tcl_splitter = $opts{'tclparse'} || "/usr/testbed/lib/ns2ir/parse.tcl";
363# tclsh to call directly (changed during devel)
364$tclsh = $opts{'tclsh'} || "/usr/local/bin/otclsh";
365
366# Prefix to avoid collisions
[c23025e]367$tmpdir .= "/split$$";
368
[a835df7]369print "Temp files are in $tmpdir\n" if $verbose;
[9c00d41]370# Create a workspace
[c23025e]371unless (-d "$tmpdir") {
372    mkdir("$tmpdir") || die "Can't create $tmpdir: $!";
373}
374
[9c00d41]375# Validate scripts directory
[63f7c7e]376for $s (@scripts) {
377    die "$local_script_dir/$s not in local script directory. Try -d\n"
378        unless -r "$local_script_dir/$s";
379}
[1a8a08a]380
381die "Must supply file, master and experiment" unless $master && $tcl && $eid;
382
[fe459d0]383if ($opts{'N'} ) {
384    &parse_testbeds($tb_config) ||
385        die "Cannot testbed congfigurations from $tb_config: $!\n";
386}
387else {
388    # Read a hash of per-testbed parameters from the local configurations.
389    $conf = new IO::File($tb_config) || 
390        die "can't read testbed configutions from $tb_config: $!\n";
391    while (<$conf>) {
392        next if /^#/;
393        chomp;
394        ($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss, $tun) = 
395            split(":", $_);
396        $host{$tb} = $h;
397        $user{$tb} = $u;
398        $domain{$tb} = $d;
399        $project{$tb} = $p;
400        $gwtype{$tb} = $t;
401        $expstart{$tb} = $es;
402        $gwstart{$tb} = $gs;
403        $mexpstart{$tb} = $mes;
404        $mgwstart{$tb} = $mgs;
405        $gwimage{$tb} = $i;
406        $fs{$tb} = $fs;
407        $boss{$tb} = $boss;
408        $tun{$tb} = $tun;
409
410        # Make sure the domain starts with a period
411        $domain{$tb} = ".$domain{$tb}" unless $domain{$tb} =~ /^\./;
412    }
413    $conf->close();
[1a8a08a]414}
415
416# Open a pipe to the splitter program and start it parsing the experiments
[9c00d41]417$pipe = new IO::Pipe;
[2ef2c5b]418# NB no more -p call on parse call.
419$pipe->reader("$tclsh $tcl_splitter -s -m $master  $pid $gid $eid $tcl") || 
420    die "Cannot execute $tclsh $tcl_splitter -s -m $master $pid $gid $eid $tcl:$!\n";
[1a8a08a]421
[9c00d41]422# Parse the splitter output.  This loop creates the sub experiments, gateway
423# configurations and hostnames file
424while (<$pipe>) {
[1a8a08a]425    # Start of a sub-experiment
426    /^#\s+Begin\s+Testbed\s+\((\w+)\)/ && do {
427        $ctb = $1;
428
429        # If we know the testbed, start collecting its sub experiment tcl
430        # description.  If not, warn the caller and ignore the configuration of
431        # this testbed.
432        if ($host{$ctb}) {
433            $allocated{$ctb}++; # Keep track of the testbeds allocated
[c23025e]434
435            unless (-d "$tmpdir/$ctb") {
436                mkdir("$tmpdir/$ctb") || die "Can't create $tmpdir/$ctb: $!";
437            }
438            $destfile = "$tmpdir/$ctb/$eid.$ctb.tcl";
[1a8a08a]439
440            open(FILE, ">$destfile") || die "Cannot open $destfile:$!\n";
441        }
442        else { 
443            warn "No such testbed $ctb\n";
444            $destfile = "";
445        }
446        next;
447    };
[c23025e]448
[1a8a08a]449    # End of that experiment
450    /^#\s+End\s+Testbed\s+\((\w+)\)/ && do {
451        # Simple syntax check and close out this experiment's tcl description
452        die "Mismatched testbed markers ($1, $ctb)\n" unless ($1 eq $ctb);
453        close(FILE);
454        $destfile = $ctb = "";
455        next;
456    };
[c23025e]457
458    # Beginning of a gateway set
459    /^#\s+Begin\s+gateways\s+\((\w+)\)/ && do {
460        $gateways = $1;
461        # If we've heard of this tb, create the config lines for it one at a
462        # time.
463        if ($allocated{$gateways}) {
464            # Just in case.  This directory should already have been created
465            # above.
466            unless (-d "$tmpdir/$gateways") {
467                mkdir("$tmpdir/$gateways") || 
468                    die "Can't create $tmpdir/$gateways: $!";
469            }
470        }
471        else {
472            warn "Gateways given (and ignored) for testbed not in use: " .
473                "$gateways\n";
474            $gateways = 0;
475        }
476        next;
477    };
[3c7da22]478    # End of the gateways section.  Output the client config for this testbed
[c23025e]479    /^#\s+End\s+gateways\s+\((\w+)\)/ && do {
480        die "Mismatched gateway markers ($1, $gateways)\n" 
481            unless !$gateways || $gateways == $1;
[3c7da22]482
[e4436a6]483        if ($control_gateway ) {
[fe459d0]484            # Client config
485            $cc = new IO::File(">$tmpdir/$gateways/client.conf");
486            die "Can't open $tmpdir/$gateways/client.conf: $!\n" unless $cc;
487            print $cc "ControlGateway: $control_gateway\n";
488            print $cc "SMBShare: $smb_share\n";
489            print $cc "ProjectUser: $project_user\n";
490            $cc->close();
491        }
[e4436a6]492        else { warn "No control gateway for $gateways?"; }
[fe459d0]493           
[c23025e]494        $gateways = 0;
495        next;
496    };
[1a8a08a]497    # Beginning of the hostnames list.  Collection is always in the hostnames
498    # file.
499    /^#\s+Begin\s+hostnames/ && do {
[c23025e]500        $destfile = "$tmpdir/hostnames";
[1a8a08a]501        open(FILE, ">$destfile") || die "Can't open $destfile:$!\n";
502        next;
503    };
504    # end of the hostnames list.
505    /^#\s+End\s+hostnames/ && do {
506        close(FILE);
507        $destfile = "";
508        next;
509    };
510
[c23025e]511    # Generate gateway configuration info, one file per line
512    $gateways && do {
513        chomp;
514        my($dtb, $myname, $desthost, $type) = split(" ", $_);
515        my($sdomain) = $domain{$gateways};      # domain for the source
516        my($ddomain) = $domain{$dtb};           # domain for the destination
[9c00d41]517        my($sproject) = $project{$gateways};    # Project of the destination
[c23025e]518
[4addf9d]519        $sdomain = ".$eid.$project{$gateways}$sdomain";
520        $ddomain = ".$eid.$project{$dtb}$ddomain";
521
[a835df7]522        my($conf_file) = "$myname$sdomain.gw.conf";
523        # translate to lower case so the `hostname` hack for specifying
524        # configuration files works.
525        $conf_file =~ tr/A-Z/a-z/;
526
[c23025e]527        # If either end of this link is in the master side of the testbed, that
528        # side is the active end. Otherwise the first testbed encountered in
529        # the file will be the active end.  The $active_end variable keeps
530        # track of those decisions
531        if ( $dtb eq $master ) { $active = "false"; }
532        elsif ($gateways eq $master ) { $active = "true"; }
533        elsif ( $active_end{"$dtb-$gateways"} ) { $active="false"; }
534        else { $active_end{"$gateways-$dtb"}++; $active = "true"; }
535
[3c7da22]536        # This is used to create the client configuration.
537        $control_gateway = "$myname$sdomain"
538            if $type =~ /(control|both)/;
539
[c23025e]540        # Write out the file
[a835df7]541        $gwconfig= new IO::File(">$tmpdir/$gateways/$conf_file")|| 
542            die "can't open $tmpdir/$gateways/$conf_file: $!\n";
[321c0cb]543
[f70f9c8]544        print $gwconfig "Active: $active\n";
545        print $gwconfig "TunnelCfg: $tun{$gateways}\n";
546        print $gwconfig "BossName: $boss{$master}$domain{$master}\n";
547        print $gwconfig "FsName: $fs{$master}$domain{$master}\n";
548        print $gwconfig "Type: $type\n";
[c8c45ee]549        print $gwconfig "RemoteScriptDir: /proj/$project{$dtb}/exp/$eid/tmp\n";
[f70f9c8]550        print $gwconfig "Peer: $desthost$ddomain\n";
551        print $gwconfig "Pubkeys: " . 
[9c00d41]552            "/proj/$sproject/exp/$eid/tmp/$gw_pubkey_base\n";
[f70f9c8]553        print $gwconfig "Privkeys: " .
[9c00d41]554            "/proj/$sproject/exp/$eid/tmp/$gw_secretkey_base\n";
[f70f9c8]555        $gwconfig->close();
[c23025e]556
[9c00d41]557        # This testbed has a gateway (most will) so make a copy of the keys it
558        # needs in this testbed's subdirectory.  start_segment will transfer
559        # them.
560        unless (-r "$tmpdir/$gateways/$gw_pubkey_base" ) {
561            copy($gw_pubkey, "$tmpdir/$gateways/$gw_pubkey_base") ||
562                die "Can't copy pubkeys ($gw_pubkey to " . 
563                    "$tmpdir/$gateways/$gw_pubkey_base): $!\n";
564        }
565        if ($active eq "true" ) {
566            unless (-r "$tmpdir/$gateways/$gw_secretkey_base" ) {
567                copy($gw_secretkey, "$tmpdir/$gateways/$gw_secretkey_base") ||
568                    die "Can't copy secret keys ($gw_secretkey to " . 
569                        "$tmpdir/$gateways/$gw_secretkey_base): $!\n";
570            }
571        }
572
[c23025e]573        #done processing gateway entry, ready for next line
574        next; 
575    };
[2ef2c5b]576    (/^#\s+Begin\s+tarfiles/../^#\s+End\s+tarfiles/) && do {
577        next if /^#/;
578        chomp;
579        push(@tarfiles, $_);
580        next;
581    };
[c23025e]582
[1a8a08a]583    next unless $destfile;  # Unidentified testbed, ignore config
584
585    # Substitute variables
586    s/GWTYPE/$gwtype{$ctb}/g;
587    s/GWIMAGE/$gwimage{$ctb}/g;
588    if ($ctb eq $master ) {
589        s/GWSTART/$mgwstart{$ctb}/g;
590        s/EXPSTART/$mexpstart{$ctb}/g;
591    }
592    else {
593        s/GWSTART/$gwstart{$ctb}/g;
594        s/EXPSTART/$expstart{$ctb}/g;
595    }
[4addf9d]596    # XXX: oh is this bad
597    s#GWCONF#FEDDIR\`hostname\`.gw.conf#g;
[b68f597]598    s#PROJDIR#/proj/$project{$ctb}/#g;
599    s#EID#$eid#g;
[4addf9d]600    s#FEDDIR#/proj/$project{$ctb}/exp/$eid/tmp/#g;
[1a8a08a]601    print FILE;
602}
[9c00d41]603$pipe->close();
[1a8a08a]604die "No nodes in master testbed ($master)\n" unless $allocated{$master};
605
[2ef2c5b]606for $t (@tarfiles) {
607    die "tarfile '$t' unreadable: $!\n" unless -r $t;
[b68f597]608    unless (-d "$tmpdir/tarfiles") {
609        mkdir("$tmpdir/tarfiles") || 
610            die "Can't create $tmpdir/tarfiles:$!\n";
[2ef2c5b]611    }
[b68f597]612    copy($t, "$tmpdir/tarfiles") || 
613        die "Can't copy $t to  $tmpdir/tarfiles:$!\n";
[2ef2c5b]614}
615
[1a8a08a]616exit(0) unless $startem;
617
618# Start up the slave sub-experiments first
619TESTBED:
620for $tb (keys %allocated) {
621    if ($tb ne $master) {
622        if (&start_segment($tb, $eid)) { $started{$tb}++; }
623        else { last TESTBED; }
624    }
625}
626
627# Now the master
628if (&start_segment($master, $eid)) { 
629    $started{$master}++;
630}
631
632# If any testbed failed, swap the rest out.
633if ( scalar(keys %started) != scalar(keys %allocated)) {
634    for $tb (keys %started) { &stop_segment($tb, $eid); }
635    print "Error starting experiment\n";
636    exit(1);
637}
638print "Experiment started\n";
[a835df7]639print "Deleting $tmpdir (-d to leave them in place)\n" if $verbose && !$debug;
[9c00d41]640system("rm -rf $tmpdir") unless $debug;
[1a8a08a]641exit(0);    # set the exit value
642
643=pod
644
645=head1 NAME
646
647B<splitter.pl>
648
649=head1 SYNOPSIS
650
[9c00d41]651B<splitter.pl> [B<-nd>] [B<-c> F<config_file>] [B<-f> F<experiment_tcl>]
[63f7c7e]652    [F<experiment_tcl>]
[1a8a08a]653
654=head1 DESCRIPTION
655
656B<splitter.pl> invokes the DETER experiment parser to split an annotated
657experiment into multiple sub-experments and instantiates the sub-experiments on
658their intended testbeds.  Annotation is accomplished using the
659tb-set-node-testbed command, added to the parser.
660
661The testbed labels are meaningful based on their presence in the testbeds file.
[9c00d41]662that file can be specified in the configuration file using the B<Testbeds>
663directive, and defaults to F<./testbeds>.  The syntax is described below.
664
665Most of the intermediate files are staged in a sub-directory of a temporary
666files directory and deleted at the end of the script.  Specifying the B<-d>
667flag on the command line avoids the deletion for debbugging.  By default the
668temporary files directory is directory is F</tmp> and can be reset in the
669configuration file using the B<Tmpdir> directive.  Intermediate files are
670stored under a subdirectory formed by adding the process ID of the splitter
671process.  For example, if the temporary files directory is F</tmp> and the
672B<splitter.pl> process ID is 2323, the temporary files will be stored in
673F</tmp/split2323/>.
[1a8a08a]674
675The expreriment is split out into one experiment description per testbed in the
[9c00d41]676temporary directory named as F<experiment.testbed.tcl> where the experiment is
677the experiment ID given in the configuration file, and the testbed is the
678tb-set-node-testbed parameter for the nodes in the file.
[1a8a08a]679
680If the B<-n> option is absent the sub-experiments are then instantiated on
681their testbeds.  (Here B<-n> is analogous to its use in L<make(1)>).
[9c00d41]682Per-testbed parameters are set in the testbeds file.  Sub-experiments on
[1a8a08a]683slave testbeds are instantiated in a random order, but the master testbed is
684currently instantiated last.
685
[9c00d41]686Scripts to start federation (the federation kit) are copied into the local
687experiment's tmp file - e.g., F</proj/DETER/exp/simple-split/tmp>.  These are
688taken from the directory given by the B<ScriptDir> directive in the
689configuration file.
[63f7c7e]690
[1a8a08a]691If any sub-experiment fails to instantiate, the other sub-exeriments are
692swapped out.
693
[9c00d41]694=head2 Configuration File
695
696The configuration file is a simple attribute-value pair set of colon-separated
697parameters and values.  A configuration file must be present, either specified
698in the B<-c> flag or the default F<./splitter.conf>.  All the parameter names
699are case insensitive, but should not include any whitespace.  Parameter values
700may include whitespace, but no newlines.
701
702Possible parameters are:
703
704=over 5
705
706=item Experiment
707
708The name of the experiment on the various testbeds
709
710=item Master
711
712The master testbed label from the testbeds file, described below.
713
714=item Testbeds
715
716The testbeds file described below, giving per-testbed parameters.  If this
717directive is absent the testbeds file defaults to F<./testbeds>
718
719=item ScriptDir
720
721Location of the default federation scripts, i.e. the federation kit.
722
723=item GatewayPubkey
724
725=item GatewaySecretKey
726
727The names of the files containing secret and public keys to use in setting up
728tunnels between testbeds.  These will eventually be automatically generated.
729
730=item TmpDir
731
732=item TempDir
733
734The directory where temporary files are created.  These are synonyms, but
735should both be specified, B<TmpDir> has priority.  If neither is specified,
736F</tmp> is used.
737
[3c7da22]738=item SMBShare
739
740The SMB share on the master testbed that will be exported to remote clients.
741
742=item SMBUser
743
744The experiment user to mount project directories as.  This user needs to be a
745member of the exported experiment - that is one of the users in the project
746containing this experiment on the master testbed.
747
[9c00d41]748=item Tclparse
749
750The pathname to the experiment parsing program.  Only developers should set
751this.
752
753=item Tclsh
754
755The pathname to the local oTcl shell.  Only developers should set
756this.
757
758=back
759
760=head2 Testbeds file
[1a8a08a]761
762The configuration file (F<./testbeds> unless overridden by B<-c>) is a
763colon-separated set of parameters keyed by testbed name.  The fields, in order,
764are:
765
766=over 5
767
768=item name
769
770The testbed to which this line of parameters applies.
771
772=item user
773
774The user under which to make requests to this testbed.  The user running
775B<splitter.pl> must be able to authenicate as this user under L<ssh(1)> to this
776testbed.
777
[c23025e]778=item host
779
780The host name of the testbed's ops node.  The user calling B<splitter.pl> must
781be able to execute commands on this host via L<ssh(1)>.
782
783=item domain
784
785The domain of nodes in this testbed (including the ops host).
786
[1a8a08a]787=item project
788
789The project under which to instantiate sub-experiments on this testbed.
790
791=item gateway type
792
793The node type for inter-testbed gateway nodes on this testbed.
794
795=item experiment start (slave)
796
797The start command to run on experimental nodes when this testbed is used as a
[9c00d41]798slave.  In all the start commands the string FEDDIR will be replaced by the
799local experiment's federation scripts directory and the string GWCONF replaced
800by the gatway configuration file.
[1a8a08a]801
802=item gateway start (slave)
803
[9c00d41]804The start command to run on gateway nodes when this testbed is used as a slave.
805The same string substitutions are made in this command as in experiment start.
[1a8a08a]806
807=item experiment start (master)
808
809The start command to run on experimental nodes when this testbed is used as a
[9c00d41]810master.  The same string substitutions are made in this command as in
811experiment start.
[1a8a08a]812
813=item gateway start (master)
814
815The start command to run on gateway nodes when this testbed is used as a
[9c00d41]816master.  The same string substitutions are made in this command as in
817experiment start.
[1a8a08a]818
819=item gateway image
820
821The disk image to be loaded on a gateway node on this testbed.
822
823=back
824
[9c00d41]825The parsing of the testbeds is extremely simple.  Colons separate each
[1a8a08a]826field and there is n provision for escaping them at this time.
827
828=head1 ENVIRONMENT
829
830B<splitter.pl> does not directly make use of environment variables, but calls
831out to L<ssh(1)> and (indirectly) to L<sh(1)>, which may be influenced by the
832environment.
833
834=head1 SEE ALSO
835
836L<sh(1)>, L<ssh(1)>
837
838=cut
Note: See TracBrowser for help on using the repository browser.