source: fedkit/splitter.pl @ 527321c

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

remove global hashes

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