source: fedkit/splitter.pl @ 5f1cd41

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

remove last old-style filehandle, documentation update

  • Property mode set to 100644
File size: 33.3 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    $d = IO::Dir->new($src_dir) || return 0;
195
196    # All directories under $tmpdir are 770 so we can delete them later.
197    &ssh_cmd($user, $host, "mkdir -p $dest_dir") || return 0;
198    &ssh_cmd($user, $host, "chmod 770 $dest_dir") || return 0;
199    while ( $f = $d->read()) {
200        next if $f =~ /^\./;
201        if ( -d "$src_dir/$f" ) {
202            &ship_configs($host, $user, "$src_dir/$f", "$dest_dir/$f") || 
203                return 0;
204        }
205        else {
206            &scp_file("$src_dir/$f", $user, $host, $dest_dir) || return 0;
207        }
208    }
209    return 1;
210}
211
212# Start a sub section of the experiment on a given testbed.  The testbed and
213# the user to start the experiment as are pulled from the global per-testbed
214# hash, passed in as $tbparams, as is the project name on the remote testbed.
215# Parameters are the testbed and the experiment id.  Configuration files are
216# scp-ed over to the target testbed from the global $tmpdir/$tb directory.
217# Then the current state of the experiment determined using expinfo.  From that
218# state, the experiment is either created, modified or spapped in.  If
219# everything succeeds, true is returned.  If the global verbose is set progress
220# messages are printed.
221sub start_segment {
222    my($tb, $eid, $tbparams) = @_;          # testbed, experiment ID, and
223                                            # per-testbed parameters
224    my $host =                              # Host name of remote ops (FQDN)
225        $tbparams->{$tb}->{'host'} . $tbparams->{$tb}->{'domain'};
226    my $user = $tbparams->{$tb}->{'user'};  # user to pass to ssh
227    my $pid = $tbparams->{$tb}->{'project'};# remote project to start the
228                                            # experiment under
229    my $tclfile = "./$eid.$tb.tcl";         # Local tcl file with the
230                                            # sub-experiment
231    my $proj_dir = "/proj/$pid/exp/$eid/tmp";  # Where to stash federation stuff
232    my $tarfiles_dir = "/proj/$pid/tarfiles/$eid";  # Where to stash tarfiles
233    my $to_hostname = "$proj_dir/hosts";    # remote hostnames file
234    my $state;                              # State of remote experiment
235    my $status = new IO::Pipe;              # The pipe to get status
236
237    # Determine the status of the remote experiment
238    $status->reader("ssh $user\@$host /usr/testbed/bin/expinfo $pid $eid") || 
239        die "Can't ssh to $user\@$host:$!\n";
240
241    # XXX: this is simple now.  Parsing may become more complex
242    while (<$status>) {
243        /State: (\w+)/ && ($state = $1);
244        /No\s+such\s+experiment/ && ($state = "none");
245    }
246    $status->close();
247    print "$tb: $state\n";
248
249    # Copy the experiment definition data over
250    print "transferring subexperiment to $tb\n" if $verbose;
251    &scp_file("$tmpdir/$tb/$tclfile", $user, $host) || return 0;
252    # Clear out any old experiment data; if not deleted, copies over it by
253    # different users will fail.
254    # (O /bin/csh, how evil thou art.  The -c and the escaped single quotes
255    # force the /bin/sh interpretation of the trailing * (which we need to keep
256    # tmp around))  Again, this needs to be done more properly once we have a
257    # non-ssh interface here.)
258    print "clearing experiment subdirs on $tb\n" if $verbose;
259    &ssh_cmd($user, $host, "/bin/sh -c \\'/bin/rm -rf $proj_dir/*\\'") || 
260        return 0;
261    print "clearing experiment tarfiles subdirs on $tb\n" if $verbose;
262    &ssh_cmd($user, $host, "/bin/rm -rf $tarfiles_dir/") || 
263        return 0;
264    print "creating tarfiles subdir $tarfiles_dir on $tb\n" if $verbose;
265    &ssh_cmd($user, $host, "mkdir -p $tarfiles_dir", "create tarfiles") || 
266        return 0;
267    # Remote experiment is active.  Modify it.
268    if ($state eq "active") {
269        print "Transferring federation support files to $tb\n" if $verbose;
270        # First copy new scripts and hostinfo into the remote /proj
271        &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
272            return 0;
273        &ship_scripts($host, $user, $proj_dir) || return 0;
274        &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
275        if ( -d "$tmpdir/tarfiles") {
276            &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
277                return 0;
278        }
279
280        print "Modifying $eid in place on $tb\n" if $verbose;
281        &ssh_cmd($user, $host, "/usr/testbed/bin/modexp -r -s -w $pid " . 
282            "$eid $tclfile", "modexp") || return 0;
283        return 1;
284    }
285
286    # Remote experiment is swapped out, modify it and swap it in.
287    if ($state eq "swapped") {
288        print "Transferring federation support files to $tb\n" if $verbose;
289        # First copy new scripts and hostinfo into the remote /proj (because
290        # the experiment exists, the directory tree should be there.
291        &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
292            return 0;
293        &ship_scripts($host, $user, $proj_dir) || return 0;
294        &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
295        if ( -d "$tmpdir/tarfiles") {
296            &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
297                return 0;
298        }
299
300        print "Modifying $eid on $tb\n" if $verbose;
301        &ssh_cmd($user, $host, "/usr/testbed/bin/modexp -w $pid $eid $tclfile", 
302            "modexp") || return 0;
303        print "Swapping $eid in on $tb\n" if $verbose;
304        # Now start up
305        &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
306            "swapexp") || return 0;
307        return 1;
308    }
309
310    # No remote experiment.  Create one.  We do this in 2 steps so we can put
311    # the configuration files and scripts into the new experiment directories.
312    if ($state eq "none") {
313
314        if ( -d "$tmpdir/tarfiles") {
315            # Tarfiles have to exist for the creation to work
316            print "copying tarfiles to $tb\n";
317            &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
318                return 0;
319        }
320        print "Creating $eid on $tb\n" if $verbose;
321        &ssh_cmd($user, $host, "/usr/testbed/bin/startexp -i -f -w -p " . 
322            "$pid -e $eid $tclfile", "startexp") || return 0;
323        print "Transferring federation support files to $tb\n" if $verbose;
324        # First copy new scripts and hostinfo into the remote /proj
325        &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
326            return 0;
327        &ship_scripts($host, $user, $proj_dir) || return 0;
328        &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
329        # Now start up
330        print "Swapping $eid in on $tb\n" if $verbose;
331        &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
332            "swapexp") || return 0;
333        return 1;
334    }
335
336    # Every branch for a known state returns.  If execution gets here, the
337    # state is unknown.
338    warn "unknown state: $state\n";
339    return 0;
340}
341
342# Swap out a sub-experiment - probably because another has failed.  Arguments
343# are testbed and experiment.  Most of the control flow is similar to
344# start_segment, though much simpler.
345sub stop_segment {
346    my($tb, $eid, $tbparams) = @_;          # testbed, experiment ID and
347                                            # per-testbed parameters
348    my $user = $tbparams->{$tb}->{'user'};  # testbed user
349    my $host =                              # Ops node
350        $tbparams->{$tb}->{'host'} . $tbparams->{$tb}->{'domain'};
351    my $pid = $tbparams->{$tb}->{'project'};# testbed project
352
353    print "Stopping $eid on $tb\n" if $verbose;
354    &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid out", 
355        "swapexp (out)") || return 0;
356    return 1;
357}
358
359
360$pid = $gid = "dummy";              # Default project and group to pass to
361                                    # $tcl_splitter above.  These are total
362                                    # dummy arguments;  the splitter doesn't
363                                    # use them at all, but we supply them to
364                                    # keep our changes to the parser minimal.
365# Argument processing.
366getopts('c:f:ndvN', \%opts);
367$splitter_config = $opts{'c'} || "./splitter.conf";
368$debug = $opts{'d'};
369$verbose = $opts{'v'} || $opts{'d'};
370
371&parse_config("$splitter_config", \%opts) || 
372    die "Cannot read config file $splitter_config: $!\n";
373
374
375$startem = $opts{'n'} ? 0 : 1;          # If true, start the sub-experiments
376$eid = $opts{'experiment'};             # Experiment ID
377$tcl = $opts{'f'} || shift;             # The experiment description
378$master = $opts{'master'};              # Master testbed
379$tmpdir = $opts{'tmpdir'} || $opts{'tempdir'}|| "/tmp"; # tmp files
380$tb_config = $opts{'testbeds'} || "./testbeds"; # testbed configurations
381$local_script_dir = $opts{'scriptdir'}; # Local scripts
382
383$smb_share = $opts{'smbshare'} ||       # Share to mount from the master
384    die "Must give an SMB share\n";
385$project_user = $opts{'smbuser'} ||     # User to mount project dirs as
386    die "Must give an SMB user\n";
387
388# For now specify these.  We may want to generate them later.
389$gw_pubkey = $opts{'gatewaypubkey'};
390($gw_pubkey_base = $gw_pubkey) =~ s#.*/##;
391$gw_secretkey = $opts{'gatewaysecretkey'};
392($gw_secretkey_base = $gw_secretkey) =~ s#.*/##;
393
394# tcl program to split experiments (changed during devel)
395$tcl_splitter = $opts{'tclparse'} || "/usr/testbed/lib/ns2ir/parse.tcl";
396# tclsh to call directly (changed during devel)
397$tclsh = $opts{'tclsh'} || "/usr/local/bin/otclsh";
398
399# Prefix to avoid collisions
400$tmpdir .= "/split$$";
401
402print "Temp files are in $tmpdir\n" if $verbose;
403# Create a workspace
404unless (-d "$tmpdir") {
405    mkdir("$tmpdir") || die "Can't create $tmpdir: $!";
406}
407
408# Validate scripts directory
409for my $s (@scripts) {
410    die "$local_script_dir/$s not in local script directory. Try -d\n"
411        unless -r "$local_script_dir/$s";
412}
413
414die "Must supply file, master and experiment" unless $master && $tcl && $eid;
415
416if ($opts{'N'} ) {
417    &parse_testbeds($tb_config, $tbparams) ||
418        die "Cannot testbed congfigurations from $tb_config: $!\n";
419}
420else {
421    # Read a hash of per-testbed parameters from the local configurations.
422    my $conf = new IO::File($tb_config) || 
423        die "can't read testbed configutions from $tb_config: $!\n";
424    while (<$conf>) {
425        next if /^#/;
426        chomp;
427        my($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss,
428            $tun) = split(":", $_);
429        $tbparams->{$tb}->{'host'} = $h;
430        $tbparams->{$tb}->{'user'} = $u;
431        $tbparams->{$tb}->{'domain'} = $d;
432        $tbparams->{$tb}->{'project'} = $p;
433        $tbparams->{$tb}->{'gwtype'} = $t;
434        $tbparams->{$tb}->{'expstart'} = $es;
435        $tbparams->{$tb}->{'gwstart'} = $gs;
436        $tbparams->{$tb}->{'mexpstart'} = $mes;
437        $tbparams->{$tb}->{'mgwstart'} = $mgs;
438        $tbparams->{$tb}->{'gwimage'} = $i;
439        $tbparams->{$tb}->{'fs'} = $fs;
440        $tbparams->{$tb}->{'boss'} = $boss;
441        $tbparams->{$tb}->{'tun'} = $tun;
442
443        # Make sure the domain starts with a period
444        $tbparams->{$tb}->{'domain'} = "." . $tbparams->{$tb}->{'domain'}
445            unless $tbparams->{$tb}->{'domain'} =~ /^\./;
446    }
447    $conf->close();
448}
449
450# Open a pipe to the splitter program and start it parsing the experiments
451my $pipe = new IO::Pipe;
452# NB no more -p call on parse call.
453$pipe->reader("$tclsh $tcl_splitter -s -m $master  $pid $gid $eid $tcl") || 
454    die "Cannot execute $tclsh $tcl_splitter -s -m $master $pid $gid $eid $tcl:$!\n";
455
456# Parsing variables
457my $ctb;                        # Current testbed
458my %allocated;                  # If allocated{$tb} > 0, $tb is in use
459my $destfile;                   # File that the sub-experiment tcl file is
460                                # being written to, or "" if none.  Also used
461                                # for hostnames file.
462my $desthandle;                 # File handle for distfile
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            $desthandle = new IO::File(">$destfile") || 
489                die "Cannot open $destfile:$!\n";
490        }
491        else { 
492            warn "No such testbed $ctb\n";
493            $destfile = "";
494        }
495        next;
496    };
497
498    # End of that experiment
499    /^#\s+End\s+Testbed\s+\((\w+)\)/ && do {
500        # Simple syntax check and close out this experiment's tcl description
501        die "Mismatched testbed markers ($1, $ctb)\n" unless ($1 eq $ctb);
502        $desthandle->close();
503        $destfile = $ctb = "";
504        next;
505    };
506
507    # Beginning of a gateway set
508    /^#\s+Begin\s+gateways\s+\((\w+)\)/ && do {
509        $gateways = $1;
510        # If we've heard of this tb, create the config lines for it one at a
511        # time.
512        if ($allocated{$gateways}) {
513            # Just in case.  This directory should already have been created
514            # above.
515            unless (-d "$tmpdir/$gateways") {
516                mkdir("$tmpdir/$gateways") || 
517                    die "Can't create $tmpdir/$gateways: $!";
518            }
519        }
520        else {
521            warn "Gateways given (and ignored) for testbed not in use: " .
522                "$gateways\n";
523            $gateways = 0;
524        }
525        next;
526    };
527    # End of the gateways section.  Output the client config for this testbed
528    /^#\s+End\s+gateways\s+\((\w+)\)/ && do {
529        die "Mismatched gateway markers ($1, $gateways)\n" 
530            unless !$gateways || $gateways == $1;
531
532        if ($control_gateway ) {
533            # Client config
534            my $cc = new IO::File(">$tmpdir/$gateways/client.conf");
535            die "Can't open $tmpdir/$gateways/client.conf: $!\n" unless $cc;
536            print $cc "ControlGateway: $control_gateway\n";
537            print $cc "SMBShare: $smb_share\n";
538            print $cc "ProjectUser: $project_user\n";
539            $cc->close();
540        }
541        else { warn "No control gateway for $gateways?"; }
542           
543        $gateways = 0;
544        next;
545    };
546    # Beginning of the hostnames list.  Collection is always in the hostnames
547    # file.
548    /^#\s+Begin\s+hostnames/ && do {
549        $destfile = "$tmpdir/hostnames";
550        $desthandle = new IO::File(">$destfile") || 
551            die "Can't open $destfile:$!\n";
552        next;
553    };
554    # end of the hostnames list.
555    /^#\s+End\s+hostnames/ && do {
556        $desthandle->close();
557        $destfile = "";
558        next;
559    };
560
561    # Generate gateway configuration info, one file per line
562    $gateways && do {
563        chomp;
564        my($dtb, $myname, $desthost, $type) = split(" ", $_);
565
566        # Many of these are to simplify print statements
567        my $sdomain =                           # domain for the source
568            $tbparams->{$gateways}->{'domain'};
569        my $ddomain =                           # domain for the destination
570            $tbparams->{$dtb}->{'domain'};
571        my $sproject =                          # Project of the destination
572            $tbparams->{$gateways}->{'project'};
573        my $fs =                                # Master fs node (FQDN)
574            $tbparams->{$master}->{'fs'} .  $tbparams->{$master}->{'domain'};
575        my $boss =                              # Master boss node (FQDN)
576            $tbparams->{$master}->{'boss'} .  $tbparams->{$master}->{'domain'};
577        my $remote_script_dir =                 # Remote fed script location
578            "/proj/" . $tbparams->{$dtb}->{'project'} . "/exp/$eid/tmp";
579        my $active;                             # Is this the active side of
580                                                # the connector?
581
582        $sdomain = ".$eid." . $tbparams->{$gateways}->{'project'} . "$sdomain";
583        $ddomain = ".$eid." . $tbparams->{$dtb}->{'project'} . "$ddomain";
584
585        my $conf_file = "$myname$sdomain.gw.conf";
586        # translate to lower case so the `hostname` hack for specifying
587        # configuration files works.
588        $conf_file =~ tr/A-Z/a-z/;
589
590        # If either end of this link is in the master side of the testbed, that
591        # side is the active end. Otherwise the first testbed encountered in
592        # the file will be the active end.  The $active_end variable keeps
593        # track of those decisions
594        if ( $dtb eq $master ) { $active = "false"; }
595        elsif ($gateways eq $master ) { $active = "true"; }
596        elsif ( $active_end{"$dtb-$gateways"} ) { $active="false"; }
597        else { $active_end{"$gateways-$dtb"}++; $active = "true"; }
598
599        # This is used to create the client configuration.
600        $control_gateway = "$myname$sdomain"
601            if $type =~ /(control|both)/;
602
603        # Write out the file
604        my $gwconfig = new IO::File(">$tmpdir/$gateways/$conf_file")|| 
605            die "can't open $tmpdir/$gateways/$conf_file: $!\n";
606
607        print $gwconfig "Active: $active\n";
608        print $gwconfig "TunnelCfg: " . $tbparams->{$gateways}->{'tun'} . "\n";
609        print $gwconfig "BossName: $boss\n";
610        print $gwconfig "FsName: $fs\n";
611        print $gwconfig "Type: $type\n";
612        print $gwconfig "RemoteScriptDir: $remote_script_dir\n";
613        print $gwconfig "Peer: $desthost$ddomain\n";
614        print $gwconfig "Pubkeys: " . 
615            "/proj/$sproject/exp/$eid/tmp/$gw_pubkey_base\n";
616        print $gwconfig "Privkeys: " .
617            "/proj/$sproject/exp/$eid/tmp/$gw_secretkey_base\n";
618        $gwconfig->close();
619
620        # This testbed has a gateway (most will) so make a copy of the keys it
621        # needs in this testbed's subdirectory.  start_segment will transfer
622        # them.
623        unless (-r "$tmpdir/$gateways/$gw_pubkey_base" ) {
624            copy($gw_pubkey, "$tmpdir/$gateways/$gw_pubkey_base") ||
625                die "Can't copy pubkeys ($gw_pubkey to " . 
626                    "$tmpdir/$gateways/$gw_pubkey_base): $!\n";
627        }
628        if ($active eq "true" ) {
629            unless (-r "$tmpdir/$gateways/$gw_secretkey_base" ) {
630                copy($gw_secretkey, "$tmpdir/$gateways/$gw_secretkey_base") ||
631                    die "Can't copy secret keys ($gw_secretkey to " . 
632                        "$tmpdir/$gateways/$gw_secretkey_base): $!\n";
633            }
634        }
635
636        #done processing gateway entry, ready for next line
637        next; 
638    };
639    (/^#\s+Begin\s+tarfiles/../^#\s+End\s+tarfiles/) && do {
640        next if /^#/;
641        chomp;
642        push(@tarfiles, $_);
643        next;
644    };
645
646    next unless $destfile;  # Unidentified testbed, ignore config
647    # local copies that can be used in the substitutions below
648    my $gwtype = $tbparams->{$ctb}->{'gwtype'};
649    my $gwimage = $tbparams->{$ctb}->{'gwimage'};
650    my $mgwstart = $tbparams->{$ctb}->{'mgwstart'};
651    my $mexpstart = $tbparams->{$ctb}->{'mexpstart'};
652    my $gwstart = $tbparams->{$ctb}->{'gwstart'};
653    my $expstart = $tbparams->{$ctb}->{'expstart'};
654    my $project = $tbparams->{$ctb}->{'project'};
655
656    # Substitute variables
657    s/GWTYPE/$gwtype/g;
658    s/GWIMAGE/$gwimage/g;
659    if ($ctb eq $master ) {
660        s/GWSTART/$mgwstart/g;
661        s/EXPSTART/$mexpstart/g;
662    }
663    else {
664        s/GWSTART/$gwstart/g;
665        s/EXPSTART/$expstart/g;
666    }
667    # XXX: oh is this bad
668    s#GWCONF#FEDDIR\`hostname\`.gw.conf#g;
669    s#PROJDIR#/proj/$project/#g;
670    s#EID#$eid#g;
671    s#FEDDIR#/proj/$project/exp/$eid/tmp/#g;
672    print $desthandle $_;
673}
674$pipe->close();
675die "No nodes in master testbed ($master)\n" unless $allocated{$master};
676
677for my $t  (@tarfiles) {
678    die "tarfile '$t' unreadable: $!\n" unless -r $t;
679    unless (-d "$tmpdir/tarfiles") {
680        mkdir("$tmpdir/tarfiles") || 
681            die "Can't create $tmpdir/tarfiles:$!\n";
682    }
683    copy($t, "$tmpdir/tarfiles") || 
684        die "Can't copy $t to  $tmpdir/tarfiles:$!\n";
685}
686
687exit(0) unless $startem;
688
689my %started;                # If $started{$tb} then $tb successfully started
690
691# Start up the slave sub-experiments first
692TESTBED:
693for my $tb  (keys %allocated) {
694    if ($tb ne $master) {
695        if (&start_segment($tb, $eid, $tbparams)) { $started{$tb}++; }
696        else { last TESTBED; }
697    }
698}
699
700# Now the master
701if (&start_segment($master, $eid, $tbparams)) { 
702    $started{$master}++;
703}
704
705# If any testbed failed, swap the rest out.
706if ( scalar(keys %started) != scalar(keys %allocated)) {
707    for my $tb (keys %started) { &stop_segment($tb, $eid, $tbparams); }
708    print "Error starting experiment\n";
709    exit(1);
710}
711print "Experiment started\n";
712print "Deleting $tmpdir (-d to leave them in place)\n" if $verbose && !$debug;
713system("rm -rf $tmpdir") unless $debug;
714exit(0);    # set the exit value
715
716=pod
717
718=head1 NAME
719
720B<splitter.pl>
721
722=head1 SYNOPSIS
723
724B<splitter.pl> [B<-nd>] [B<-c> F<config_file>] [B<-f> F<experiment_tcl>]
725    [F<experiment_tcl>]
726
727=head1 DESCRIPTION
728
729B<splitter.pl> invokes the DETER experiment parser to split an annotated
730experiment into multiple sub-experments and instantiates the sub-experiments on
731their intended testbeds.  Annotation is accomplished using the
732tb-set-node-testbed command, added to the parser.
733
734Much of the script's behavior depends on the configuration file, specified with
735the B<-c> flag and defaulting to F<./splitter.conf>.
736
737The testbed labels supplied in the B<tb-set-node-testbed> command are
738meaningful based on their presence in the testbeds file.  that file can be
739specified in the configuration file using the B<Testbeds> directive, and
740defaults to F<./testbeds>.  The syntax is described below.
741
742Most of the intermediate files are staged in a sub-directory of a temporary
743files directory and deleted at the end of the script.  Specifying the B<-d>
744flag on the command line avoids the deletion for debbugging.  By default the
745temporary files directory is directory is F</tmp> and can be reset in the
746configuration file using the B<Tmpdir> directive.  Intermediate files are
747stored under a subdirectory formed by adding the process ID of the splitter
748process.  For example, if the temporary files directory is F</tmp> and the
749B<splitter.pl> process ID is 2323, the temporary files will be stored in
750F</tmp/split2323/>.
751
752The expreriment is split out into one experiment description per testbed in the
753temporary directory named as F<experiment.testbed.tcl> where the experiment is
754the experiment ID given in the configuration file, and the testbed is the
755tb-set-node-testbed parameter for the nodes in the file.
756
757If the B<-n> option is absent the sub-experiments are then instantiated on
758their testbeds.  (Here B<-n> is analogous to its use in L<make(1)>).
759Per-testbed parameters are set in the testbeds file.  Sub-experiments on
760slave testbeds are instantiated in a random order, but the master testbed is
761currently instantiated last.
762
763Scripts to start federation (the federation kit) are copied into the local
764experiment's tmp file - e.g., F</proj/DETER/exp/simple-split/tmp>.  These are
765taken from the directory given by the B<ScriptDir> directive in the
766configuration file.
767
768If any sub-experiment fails to instantiate, the other sub-exeriments are
769swapped out.
770
771=head2 Configuration File
772
773The configuration file is a simple set of colon-separated parameters and
774values.  A configuration file must be present, either specified in the B<-c>
775flag or the default F<./splitter.conf>.  All the parameter names are case
776insensitive, but should not include any whitespace.  Parameter values may
777include whitespace, but no newlines.
778
779Possible parameters are:
780
781=over 5
782
783=item Experiment
784
785The name of the experiment on the various testbeds
786
787=item Master
788
789The master testbed label from the testbeds file, described below.
790
791=item Testbeds
792
793The testbeds file described below, giving per-testbed parameters.  If this
794directive is absent the testbeds file defaults to F<./testbeds>
795
796=item ScriptDir
797
798Location of the default federation scripts, i.e. the federation kit.
799
800=item GatewayPubkey
801
802=item GatewaySecretKey
803
804The names of the files containing secret and public keys to use in setting up
805tunnels between testbeds.  These will eventually be automatically generated.
806
807=item TmpDir
808
809=item TempDir
810
811The directory where temporary files are created.  These are synonyms, but
812should both be specified, B<TmpDir> has priority.  If neither is specified,
813F</tmp> is used.
814
815=item SMBShare
816
817The SMB share on the master testbed that will be exported to remote clients.
818
819=item SMBUser
820
821The experiment user to mount project directories as.  This user needs to be a
822member of the exported experiment - that is one of the users in the project
823containing this experiment on the master testbed.
824
825=item Tclparse
826
827The pathname to the experiment parsing program.  Only developers should set
828this.
829
830=item Tclsh
831
832The pathname to the local oTcl shell.  Only developers should set
833this.
834
835=back
836
837=head2 Testbeds file
838
839The configuration file (F<./testbeds> unless overridden by B<-c>) is a
840colon-separated set of parameters keyed by testbed name.  The fields, in order,
841are:
842
843=over 5
844
845=item name
846
847The testbed to which this line of parameters applies.
848
849=item user
850
851The user under which to make requests to this testbed.  The user running
852B<splitter.pl> must be able to authenicate as this user under L<ssh(1)> to this
853testbed.
854
855=item host
856
857The host name of the testbed's ops node.  The user calling B<splitter.pl> must
858be able to execute commands on this host via L<ssh(1)>.
859
860=item domain
861
862The domain of nodes in this testbed (including the ops host).  This parameter
863should always start with a period.
864
865=item project
866
867The project under which to instantiate sub-experiments on this testbed.
868
869=item gateway type
870
871The node type for inter-testbed gateway nodes on this testbed.
872
873=item experiment start (slave)
874
875The start command to run on experimental nodes when this testbed is used as a
876slave.  In all the start commands the string FEDDIR will be replaced by the
877local experiment's federation scripts directory and the string GWCONF replaced
878by the gatway configuration file.
879
880=item gateway start (slave)
881
882The start command to run on gateway nodes when this testbed is used as a slave.
883The same string substitutions are made in this command as in experiment start.
884
885=item experiment start (master)
886
887The start command to run on experimental nodes when this testbed is used as a
888master.  The same string substitutions are made in this command as in
889experiment start.
890
891=item gateway start (master)
892
893The start command to run on gateway nodes when this testbed is used as a
894master.  The same string substitutions are made in this command as in
895experiment start.
896
897=item gateway image
898
899The disk image to be loaded on a gateway node on this testbed.
900
901=item filesystem node
902
903The node in the master testbed from which filesystems are mounted.
904
905=item boss node
906
907The node in the master testbed that controls the testbed.
908
909=item tunnel configuration
910
911True if the connector needs to do DETER federation.  This parameter will
912probably be removed.
913
914=back
915
916The parsing of the testbeds is extremely simple.  Colons separate each
917field and there is n provision for escaping them at this time.
918
919=head2 New Testbeds File Format
920
921The testbeds file has ben revamped to make it more human readable.  The
922parameters are now named and specified on separate lines of the configuration
923file.  Each testbed's parameters are preceeded by the testbed label in brackets
924([]) on a line by itself.  After that the parameters are specified as
925parameter: value.  This is essentially the same format as the configuration
926file.  Parameters are:
927
928=over 4
929
930=item User
931
932The user under which to make requests to this testbed.  The user running
933B<splitter.pl> must be able to authenicate as this user under L<ssh(1)> to this
934testbed.
935
936=item OpsNode
937
938The host name of the testbed's ops node.  The user calling B<splitter.pl> must
939be able to execute commands on this host via L<ssh(1)>.
940
941=item Domain
942
943The domain of nodes in this testbed (including the ops host).  This parameter
944should always start with a period.
945
946=item Project
947
948The project under which to instantiate sub-experiments on this testbed.
949
950=item ConnectorType
951
952The node type for inter-testbed connector nodes on this testbed.
953
954=item SlaveNodeStartCmd
955
956The start command to run on experimental nodes when this testbed is used as a
957slave.  In all the start commands the string FEDDIR will be replaced by the
958local experiment's federation scripts directory and the string GWCONF replaced
959by the gatway configuration file.
960
961=item SlaveConnectorStartCmd
962
963The start command to run on gateway nodes when this testbed is used as a slave.
964The same string substitutions are made in this command as in experiment start.
965
966=item MasterNodeStartCmd
967
968The start command to run on experimental nodes when this testbed is used as a
969master.  The same string substitutions are made in this command as in
970experiment start.
971
972=item MasterConnectorStartCmd
973
974The start command to run on gateway nodes when this testbed is used as a
975master.  The same string substitutions are made in this command as in
976experiment start.
977
978=item ConnectorImage
979
980The disk image to be loaded on a gateway node on this testbed.
981
982=item FileServer
983
984The node in the master testbed from which filesystems are mounted.
985
986=item Boss
987
988The node in the master testbed that controls the testbed.
989
990=item TunnelCfg
991
992True if the connector needs to do DETER federation.  This parameter will
993probably be removed.
994
995
996=back
997
998
999=head1 ENVIRONMENT
1000
1001B<splitter.pl> does not directly make use of environment variables, but calls
1002out to L<ssh(1)> and (indirectly) to L<sh(1)>, which may be influenced by the
1003environment.
1004
1005=head1 SEE ALSO
1006
1007L<sh(1)>, L<ssh(1)>
1008
1009=cut
Note: See TracBrowser for help on using the repository browser.