source: fedkit/splitter.pl @ b814529

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

use strict in splitter. Thank God I won't need to learn to spell.

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