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
Line 
1#!/usr/bin/perl
2
3use Getopt::Std;
4use IO::File;
5use IO::Dir;
6use IO::Pipe;
7use File::Copy;
8
9@scripts = ("federate.sh", "smbmount.pl", "make_hosts", "fed-tun.pl");
10$local_script_dir = ".";
11
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
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
106
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 {
114    my($file, $user, $host, $dest) = @_;
115
116    # XXX system with a relative pathname is sort of gross
117    system("scp $file $user\@$host:$dest");
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
134    system ("ssh $user\@$host $cmd");
135    if ($?) {
136        warn "$wname failed $?\n" if $wname;
137        return 0;
138    }
139    else { return 1; }
140}
141
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
149    &ssh_cmd($user, $host, "mkdir -p $dest_dir");
150    for $s (@scripts) {
151        &scp_file("$local_script_dir/$s", $user, $host, $dest_dir) || 
152            return 0;
153    }
154    return 1;
155}
156
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
163
164    $d = IO::Dir->new($src_dir) || return 0;
165
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;
169    while ( $f = $d->read()) {
170        next if $f =~ /^\./;
171        if ( -d "$src_dir/$f" ) {
172            &ship_configs($host, $user, "$src_dir/$f", "$dest_dir/$f") || 
173                return 0;
174        }
175        else {
176            &scp_file("$src_dir/$f", $user, $host, $dest_dir) || return 0;
177        }
178    }
179    return 1;
180}
181
182
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
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
192# returned.  If the global verbose is set progress messages are printed.
193sub start_segment {
194    my($tb, $eid) = @_;                     # testbed and experiment ID
195    my($host) = "$host{$tb}$domain{$tb}";   # Host name of remote ops (FQDN)
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
201    my($proj_dir) = "/proj/$pid/exp/$eid/tmp";  # Where to stash federation stuff
202    my($tarfiles_dir) = "/proj/$pid/tarfiles/$eid";  # Where to stash tarfiles
203    my($to_hostname) = "$proj_dir/hosts";   # remote hostnames file
204    my($status) = new IO::Pipe;             # The pipe to get status
205
206    # Determine the status of the remote experiment
207    $status->reader("ssh $user\@$host /usr/testbed/bin/expinfo $pid $eid") || 
208        die "Can't ssh to $user\@$host:$!\n";
209
210    # XXX: this is simple now.  Parsing may become more complex
211    while (<$status>) {
212        /State: (\w+)/ && ($state = $1);
213        /No\s+such\s+experiment/ && ($state = "none");
214    }
215    $status->close();
216    print "$tb: $state\n";
217
218    # Copy the experiment definition data over
219    print "transferring subexperiment to $tb\n" if $verbose;
220    &scp_file("$tmpdir/$tb/$tclfile", $user, $host) || return 0;
221    # Clear out any old experiment data; if not deleted, copies over it by
222    # different users will fail.
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.)
227    print "clearing experiment subdirs on $tb\n" if $verbose;
228    &ssh_cmd($user, $host, "/bin/sh -c \\'/bin/rm -rf $proj_dir/*\\'") || 
229        return 0;
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;
236    # Remote experiment is active.  Modify it.
237    if ($state eq "active") {
238        print "Transferring federation support files to $tb\n" if $verbose;
239        # First copy new scripts and hostinfo into the remote /proj
240        &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
241            return 0;
242        &ship_scripts($host, $user, $proj_dir) || return 0;
243        &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
244        if ( -d "$tmpdir/tarfiles") {
245            &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
246                return 0;
247        }
248
249        print "Modifying $eid in place on $tb\n" if $verbose;
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") {
257        print "Transferring federation support files to $tb\n" if $verbose;
258        # First copy new scripts and hostinfo into the remote /proj (because
259        # the experiment exists, the directory tree should be there.
260        &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
261            return 0;
262        &ship_scripts($host, $user, $proj_dir) || return 0;
263        &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
264        if ( -d "$tmpdir/tarfiles") {
265            &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
266                return 0;
267        }
268
269        print "Modifying $eid on $tb\n" if $verbose;
270        &ssh_cmd($user, $host, "/usr/testbed/bin/modexp -w $pid $eid $tclfile", 
271            "modexp") || return 0;
272        print "Swapping $eid in on $tb\n" if $verbose;
273        # Now start up
274        &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
275            "swapexp") || return 0;
276        return 1;
277    }
278
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.
281    if ($state eq "none") {
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        }
289        print "Creating $eid on $tb\n" if $verbose;
290        &ssh_cmd($user, $host, "/usr/testbed/bin/startexp -i -f -w -p " . 
291            "$pid -e $eid $tclfile", "startexp") || return 0;
292        print "Transferring federation support files to $tb\n" if $verbose;
293        # First copy new scripts and hostinfo into the remote /proj
294        &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
295            return 0;
296        &ship_scripts($host, $user, $proj_dir) || return 0;
297        &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
298        # Now start up
299        print "Swapping $eid in on $tb\n" if $verbose;
300        &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
301            "swapexp") || return 0;
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}";
317    my($host) = "$host{$tb}$domain{$tb}";
318    my($pid) = $project{$tb};
319
320    print "Stopping $eid on $tb\n" if $verbose;
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.
333getopts('c:f:ndvN', \%opts);
334$splitter_config = $opts{'c'} || "./splitter.conf";
335$debug = $opts{'d'};
336$verbose = $opts{'v'} || $opts{'d'};
337
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
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
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
367$tmpdir .= "/split$$";
368
369print "Temp files are in $tmpdir\n" if $verbose;
370# Create a workspace
371unless (-d "$tmpdir") {
372    mkdir("$tmpdir") || die "Can't create $tmpdir: $!";
373}
374
375# Validate scripts directory
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}
380
381die "Must supply file, master and experiment" unless $master && $tcl && $eid;
382
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();
414}
415
416# Open a pipe to the splitter program and start it parsing the experiments
417$pipe = new IO::Pipe;
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";
421
422# Parse the splitter output.  This loop creates the sub experiments, gateway
423# configurations and hostnames file
424while (<$pipe>) {
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
434
435            unless (-d "$tmpdir/$ctb") {
436                mkdir("$tmpdir/$ctb") || die "Can't create $tmpdir/$ctb: $!";
437            }
438            $destfile = "$tmpdir/$ctb/$eid.$ctb.tcl";
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    };
448
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    };
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    };
478    # End of the gateways section.  Output the client config for this testbed
479    /^#\s+End\s+gateways\s+\((\w+)\)/ && do {
480        die "Mismatched gateway markers ($1, $gateways)\n" 
481            unless !$gateways || $gateways == $1;
482
483        if ($control_gateway ) {
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        }
492        else { warn "No control gateway for $gateways?"; }
493           
494        $gateways = 0;
495        next;
496    };
497    # Beginning of the hostnames list.  Collection is always in the hostnames
498    # file.
499    /^#\s+Begin\s+hostnames/ && do {
500        $destfile = "$tmpdir/hostnames";
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
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
517        my($sproject) = $project{$gateways};    # Project of the destination
518
519        $sdomain = ".$eid.$project{$gateways}$sdomain";
520        $ddomain = ".$eid.$project{$dtb}$ddomain";
521
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
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
536        # This is used to create the client configuration.
537        $control_gateway = "$myname$sdomain"
538            if $type =~ /(control|both)/;
539
540        # Write out the file
541        $gwconfig= new IO::File(">$tmpdir/$gateways/$conf_file")|| 
542            die "can't open $tmpdir/$gateways/$conf_file: $!\n";
543
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";
549        print $gwconfig "RemoteScriptDir: /proj/$project{$dtb}/exp/$eid/tmp\n";
550        print $gwconfig "Peer: $desthost$ddomain\n";
551        print $gwconfig "Pubkeys: " . 
552            "/proj/$sproject/exp/$eid/tmp/$gw_pubkey_base\n";
553        print $gwconfig "Privkeys: " .
554            "/proj/$sproject/exp/$eid/tmp/$gw_secretkey_base\n";
555        $gwconfig->close();
556
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
573        #done processing gateway entry, ready for next line
574        next; 
575    };
576    (/^#\s+Begin\s+tarfiles/../^#\s+End\s+tarfiles/) && do {
577        next if /^#/;
578        chomp;
579        push(@tarfiles, $_);
580        next;
581    };
582
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    }
596    # XXX: oh is this bad
597    s#GWCONF#FEDDIR\`hostname\`.gw.conf#g;
598    s#PROJDIR#/proj/$project{$ctb}/#g;
599    s#EID#$eid#g;
600    s#FEDDIR#/proj/$project{$ctb}/exp/$eid/tmp/#g;
601    print FILE;
602}
603$pipe->close();
604die "No nodes in master testbed ($master)\n" unless $allocated{$master};
605
606for $t (@tarfiles) {
607    die "tarfile '$t' unreadable: $!\n" unless -r $t;
608    unless (-d "$tmpdir/tarfiles") {
609        mkdir("$tmpdir/tarfiles") || 
610            die "Can't create $tmpdir/tarfiles:$!\n";
611    }
612    copy($t, "$tmpdir/tarfiles") || 
613        die "Can't copy $t to  $tmpdir/tarfiles:$!\n";
614}
615
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";
639print "Deleting $tmpdir (-d to leave them in place)\n" if $verbose && !$debug;
640system("rm -rf $tmpdir") unless $debug;
641exit(0);    # set the exit value
642
643=pod
644
645=head1 NAME
646
647B<splitter.pl>
648
649=head1 SYNOPSIS
650
651B<splitter.pl> [B<-nd>] [B<-c> F<config_file>] [B<-f> F<experiment_tcl>]
652    [F<experiment_tcl>]
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.
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/>.
674
675The expreriment is split out into one experiment description per testbed in the
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.
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)>).
682Per-testbed parameters are set in the testbeds file.  Sub-experiments on
683slave testbeds are instantiated in a random order, but the master testbed is
684currently instantiated last.
685
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.
690
691If any sub-experiment fails to instantiate, the other sub-exeriments are
692swapped out.
693
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
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
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
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
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
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
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.
801
802=item gateway start (slave)
803
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.
806
807=item experiment start (master)
808
809The start command to run on experimental nodes when this testbed is used as a
810master.  The same string substitutions are made in this command as in
811experiment start.
812
813=item gateway start (master)
814
815The start command to run on gateway nodes when this testbed is used as a
816master.  The same string substitutions are made in this command as in
817experiment start.
818
819=item gateway image
820
821The disk image to be loaded on a gateway node on this testbed.
822
823=back
824
825The parsing of the testbeds is extremely simple.  Colons separate each
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.