source: fedkit/splitter.pl @ bc01820

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

Add ProjectName?: to client.conf

  • Property mode set to 100644
File size: 33.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    $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            my $master_project = $tbparams->{$master}->{'project'};
536            die "Can't open $tmpdir/$gateways/client.conf: $!\n" unless $cc;
537            print $cc "ControlGateway: $control_gateway\n";
538            print $cc "SMBShare: $smb_share\n";
539            print $cc "ProjectUser: $project_user\n";
540            print $cc "ProjectName: $master_project\n";
541            $cc->close();
542        }
543        else { warn "No control gateway for $gateways?"; }
544           
545        $gateways = 0;
546        next;
547    };
548    # Beginning of the hostnames list.  Collection is always in the hostnames
549    # file.
550    /^#\s+Begin\s+hostnames/ && do {
551        $destfile = "$tmpdir/hostnames";
552        $desthandle = new IO::File(">$destfile") || 
553            die "Can't open $destfile:$!\n";
554        next;
555    };
556    # end of the hostnames list.
557    /^#\s+End\s+hostnames/ && do {
558        $desthandle->close();
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
568        # Many of these are to simplify print statements
569        my $sdomain =                           # domain for the source
570            $tbparams->{$gateways}->{'domain'};
571        my $ddomain =                           # domain for the destination
572            $tbparams->{$dtb}->{'domain'};
573        my $sproject =                          # Project of the destination
574            $tbparams->{$gateways}->{'project'};
575        my $fs =                                # Master fs node (FQDN)
576            $tbparams->{$master}->{'fs'} .  $tbparams->{$master}->{'domain'};
577        my $boss =                              # Master boss node (FQDN)
578            $tbparams->{$master}->{'boss'} .  $tbparams->{$master}->{'domain'};
579        my $remote_script_dir =                 # Remote fed script location
580            "/proj/" . $tbparams->{$dtb}->{'project'} . "/exp/$eid/tmp";
581        my $active;                             # Is this the active side of
582                                                # the connector?
583
584        $sdomain = ".$eid." . $tbparams->{$gateways}->{'project'} . "$sdomain";
585        $ddomain = ".$eid." . $tbparams->{$dtb}->{'project'} . "$ddomain";
586
587        my $conf_file = "$myname$sdomain.gw.conf";
588        # translate to lower case so the `hostname` hack for specifying
589        # configuration files works.
590        $conf_file =~ tr/A-Z/a-z/;
591
592        # If either end of this link is in the master side of the testbed, that
593        # side is the active end. Otherwise the first testbed encountered in
594        # the file will be the active end.  The $active_end variable keeps
595        # track of those decisions
596        if ( $dtb eq $master ) { $active = "false"; }
597        elsif ($gateways eq $master ) { $active = "true"; }
598        elsif ( $active_end{"$dtb-$gateways"} ) { $active="false"; }
599        else { $active_end{"$gateways-$dtb"}++; $active = "true"; }
600
601        # This is used to create the client configuration.
602        $control_gateway = "$myname$sdomain"
603            if $type =~ /(control|both)/;
604
605        # Write out the file
606        my $gwconfig = new IO::File(">$tmpdir/$gateways/$conf_file")|| 
607            die "can't open $tmpdir/$gateways/$conf_file: $!\n";
608
609        print $gwconfig "Active: $active\n";
610        print $gwconfig "TunnelCfg: " . $tbparams->{$gateways}->{'tun'} . "\n";
611        print $gwconfig "BossName: $boss\n";
612        print $gwconfig "FsName: $fs\n";
613        print $gwconfig "Type: $type\n";
614        print $gwconfig "RemoteScriptDir: $remote_script_dir\n";
615        print $gwconfig "Peer: $desthost$ddomain\n";
616        print $gwconfig "Pubkeys: " . 
617            "/proj/$sproject/exp/$eid/tmp/$gw_pubkey_base\n";
618        print $gwconfig "Privkeys: " .
619            "/proj/$sproject/exp/$eid/tmp/$gw_secretkey_base\n";
620        $gwconfig->close();
621
622        # This testbed has a gateway (most will) so make a copy of the keys it
623        # needs in this testbed's subdirectory.  start_segment will transfer
624        # them.
625        unless (-r "$tmpdir/$gateways/$gw_pubkey_base" ) {
626            copy($gw_pubkey, "$tmpdir/$gateways/$gw_pubkey_base") ||
627                die "Can't copy pubkeys ($gw_pubkey to " . 
628                    "$tmpdir/$gateways/$gw_pubkey_base): $!\n";
629        }
630        if ($active eq "true" ) {
631            unless (-r "$tmpdir/$gateways/$gw_secretkey_base" ) {
632                copy($gw_secretkey, "$tmpdir/$gateways/$gw_secretkey_base") ||
633                    die "Can't copy secret keys ($gw_secretkey to " . 
634                        "$tmpdir/$gateways/$gw_secretkey_base): $!\n";
635            }
636        }
637
638        #done processing gateway entry, ready for next line
639        next; 
640    };
641    (/^#\s+Begin\s+tarfiles/../^#\s+End\s+tarfiles/) && do {
642        next if /^#/;
643        chomp;
644        push(@tarfiles, $_);
645        next;
646    };
647
648    next unless $destfile;  # Unidentified testbed, ignore config
649    # local copies that can be used in the substitutions below
650    my $gwtype = $tbparams->{$ctb}->{'gwtype'};
651    my $gwimage = $tbparams->{$ctb}->{'gwimage'};
652    my $mgwstart = $tbparams->{$ctb}->{'mgwstart'};
653    my $mexpstart = $tbparams->{$ctb}->{'mexpstart'};
654    my $gwstart = $tbparams->{$ctb}->{'gwstart'};
655    my $expstart = $tbparams->{$ctb}->{'expstart'};
656    my $project = $tbparams->{$ctb}->{'project'};
657
658    # Substitute variables
659    s/GWTYPE/$gwtype/g;
660    s/GWIMAGE/$gwimage/g;
661    if ($ctb eq $master ) {
662        s/GWSTART/$mgwstart/g;
663        s/EXPSTART/$mexpstart/g;
664    }
665    else {
666        s/GWSTART/$gwstart/g;
667        s/EXPSTART/$expstart/g;
668    }
669    # XXX: oh is this bad
670    s#GWCONF#FEDDIR\`hostname\`.gw.conf#g;
671    s#PROJDIR#/proj/$project/#g;
672    s#EID#$eid#g;
673    s#FEDDIR#/proj/$project/exp/$eid/tmp/#g;
674    print $desthandle $_;
675}
676$pipe->close();
677die "No nodes in master testbed ($master)\n" unless $allocated{$master};
678
679for my $t  (@tarfiles) {
680    die "tarfile '$t' unreadable: $!\n" unless -r $t;
681    unless (-d "$tmpdir/tarfiles") {
682        mkdir("$tmpdir/tarfiles") || 
683            die "Can't create $tmpdir/tarfiles:$!\n";
684    }
685    copy($t, "$tmpdir/tarfiles") || 
686        die "Can't copy $t to  $tmpdir/tarfiles:$!\n";
687}
688
689exit(0) unless $startem;
690
691my %started;                # If $started{$tb} then $tb successfully started
692
693# Start up the slave sub-experiments first
694TESTBED:
695for my $tb  (keys %allocated) {
696    if ($tb ne $master) {
697        if (&start_segment($tb, $eid, $tbparams)) { $started{$tb}++; }
698        else { last TESTBED; }
699    }
700}
701
702# Now the master
703if (&start_segment($master, $eid, $tbparams)) { 
704    $started{$master}++;
705}
706
707# If any testbed failed, swap the rest out.
708if ( scalar(keys %started) != scalar(keys %allocated)) {
709    for my $tb (keys %started) { &stop_segment($tb, $eid, $tbparams); }
710    print "Error starting experiment\n";
711    exit(1);
712}
713print "Experiment started\n";
714print "Deleting $tmpdir (-d to leave them in place)\n" if $verbose && !$debug;
715system("rm -rf $tmpdir") unless $debug;
716exit(0);    # set the exit value
717
718=pod
719
720=head1 NAME
721
722B<splitter.pl>
723
724=head1 SYNOPSIS
725
726B<splitter.pl> [B<-nd>] [B<-c> F<config_file>] [B<-f> F<experiment_tcl>]
727    [F<experiment_tcl>]
728
729=head1 DESCRIPTION
730
731B<splitter.pl> invokes the DETER experiment parser to split an annotated
732experiment into multiple sub-experments and instantiates the sub-experiments on
733their intended testbeds.  Annotation is accomplished using the
734tb-set-node-testbed command, added to the parser.
735
736Much of the script's behavior depends on the configuration file, specified with
737the B<-c> flag and defaulting to F<./splitter.conf>.
738
739The testbed labels supplied in the B<tb-set-node-testbed> command are
740meaningful based on their presence in the testbeds file.  that file can be
741specified in the configuration file using the B<Testbeds> directive, and
742defaults to F<./testbeds>.  The syntax is described below.
743
744Most of the intermediate files are staged in a sub-directory of a temporary
745files directory and deleted at the end of the script.  Specifying the B<-d>
746flag on the command line avoids the deletion for debbugging.  By default the
747temporary files directory is directory is F</tmp> and can be reset in the
748configuration file using the B<Tmpdir> directive.  Intermediate files are
749stored under a subdirectory formed by adding the process ID of the splitter
750process.  For example, if the temporary files directory is F</tmp> and the
751B<splitter.pl> process ID is 2323, the temporary files will be stored in
752F</tmp/split2323/>.
753
754The expreriment is split out into one experiment description per testbed in the
755temporary directory named as F<experiment.testbed.tcl> where the experiment is
756the experiment ID given in the configuration file, and the testbed is the
757tb-set-node-testbed parameter for the nodes in the file.
758
759If the B<-n> option is absent the sub-experiments are then instantiated on
760their testbeds.  (Here B<-n> is analogous to its use in L<make(1)>).
761Per-testbed parameters are set in the testbeds file.  Sub-experiments on
762slave testbeds are instantiated in a random order, but the master testbed is
763currently instantiated last.
764
765Scripts to start federation (the federation kit) are copied into the local
766experiment's tmp file - e.g., F</proj/DETER/exp/simple-split/tmp>.  These are
767taken from the directory given by the B<ScriptDir> directive in the
768configuration file.
769
770If any sub-experiment fails to instantiate, the other sub-exeriments are
771swapped out.
772
773=head2 Configuration File
774
775The configuration file is a simple set of colon-separated parameters and
776values.  A configuration file must be present, either specified in the B<-c>
777flag or the default F<./splitter.conf>.  All the parameter names are case
778insensitive, but should not include any whitespace.  Parameter values may
779include whitespace, but no newlines.
780
781Possible parameters are:
782
783=over 5
784
785=item Experiment
786
787The name of the experiment on the various testbeds
788
789=item Master
790
791The master testbed label from the testbeds file, described below.
792
793=item Testbeds
794
795The testbeds file described below, giving per-testbed parameters.  If this
796directive is absent the testbeds file defaults to F<./testbeds>
797
798=item ScriptDir
799
800Location of the default federation scripts, i.e. the federation kit.
801
802=item GatewayPubkey
803
804=item GatewaySecretKey
805
806The names of the files containing secret and public keys to use in setting up
807tunnels between testbeds.  These will eventually be automatically generated.
808
809=item TmpDir
810
811=item TempDir
812
813The directory where temporary files are created.  These are synonyms, but
814should both be specified, B<TmpDir> has priority.  If neither is specified,
815F</tmp> is used.
816
817=item SMBShare
818
819The SMB share on the master testbed that will be exported to remote clients.
820
821=item SMBUser
822
823The experiment user to mount project directories as.  This user needs to be a
824member of the exported experiment - that is one of the users in the project
825containing this experiment on the master testbed.
826
827=item Tclparse
828
829The pathname to the experiment parsing program.  Only developers should set
830this.
831
832=item Tclsh
833
834The pathname to the local oTcl shell.  Only developers should set
835this.
836
837=back
838
839=head2 Testbeds file
840
841The configuration file (F<./testbeds> unless overridden by B<-c>) is a
842colon-separated set of parameters keyed by testbed name.  The fields, in order,
843are:
844
845=over 5
846
847=item name
848
849The testbed to which this line of parameters applies.
850
851=item user
852
853The user under which to make requests to this testbed.  The user running
854B<splitter.pl> must be able to authenicate as this user under L<ssh(1)> to this
855testbed.
856
857=item host
858
859The host name of the testbed's ops node.  The user calling B<splitter.pl> must
860be able to execute commands on this host via L<ssh(1)>.
861
862=item domain
863
864The domain of nodes in this testbed (including the ops host).  This parameter
865should always start with a period.
866
867=item project
868
869The project under which to instantiate sub-experiments on this testbed.
870
871=item gateway type
872
873The node type for inter-testbed gateway nodes on this testbed.
874
875=item experiment start (slave)
876
877The start command to run on experimental nodes when this testbed is used as a
878slave.  In all the start commands the string FEDDIR will be replaced by the
879local experiment's federation scripts directory and the string GWCONF replaced
880by the gatway configuration file.
881
882=item gateway start (slave)
883
884The start command to run on gateway nodes when this testbed is used as a slave.
885The same string substitutions are made in this command as in experiment start.
886
887=item experiment start (master)
888
889The start command to run on experimental nodes when this testbed is used as a
890master.  The same string substitutions are made in this command as in
891experiment start.
892
893=item gateway start (master)
894
895The start command to run on gateway nodes when this testbed is used as a
896master.  The same string substitutions are made in this command as in
897experiment start.
898
899=item gateway image
900
901The disk image to be loaded on a gateway node on this testbed.
902
903=item filesystem node
904
905The node in the master testbed from which filesystems are mounted.
906
907=item boss node
908
909The node in the master testbed that controls the testbed.
910
911=item tunnel configuration
912
913True if the connector needs to do DETER federation.  This parameter will
914probably be removed.
915
916=back
917
918The parsing of the testbeds is extremely simple.  Colons separate each
919field and there is n provision for escaping them at this time.
920
921=head2 New Testbeds File Format
922
923The testbeds file has ben revamped to make it more human readable.  The
924parameters are now named and specified on separate lines of the configuration
925file.  Each testbed's parameters are preceeded by the testbed label in brackets
926([]) on a line by itself.  After that the parameters are specified as
927parameter: value.  This is essentially the same format as the configuration
928file.  Parameters are:
929
930=over 4
931
932=item User
933
934The user under which to make requests to this testbed.  The user running
935B<splitter.pl> must be able to authenicate as this user under L<ssh(1)> to this
936testbed.
937
938=item OpsNode
939
940The host name of the testbed's ops node.  The user calling B<splitter.pl> must
941be able to execute commands on this host via L<ssh(1)>.
942
943=item Domain
944
945The domain of nodes in this testbed (including the ops host).  This parameter
946should always start with a period.
947
948=item Project
949
950The project under which to instantiate sub-experiments on this testbed.
951
952=item ConnectorType
953
954The node type for inter-testbed connector nodes on this testbed.
955
956=item SlaveNodeStartCmd
957
958The start command to run on experimental nodes when this testbed is used as a
959slave.  In all the start commands the string FEDDIR will be replaced by the
960local experiment's federation scripts directory and the string GWCONF replaced
961by the gatway configuration file.
962
963=item SlaveConnectorStartCmd
964
965The start command to run on gateway nodes when this testbed is used as a slave.
966The same string substitutions are made in this command as in experiment start.
967
968=item MasterNodeStartCmd
969
970The start command to run on experimental nodes when this testbed is used as a
971master.  The same string substitutions are made in this command as in
972experiment start.
973
974=item MasterConnectorStartCmd
975
976The start command to run on gateway nodes when this testbed is used as a
977master.  The same string substitutions are made in this command as in
978experiment start.
979
980=item ConnectorImage
981
982The disk image to be loaded on a gateway node on this testbed.
983
984=item FileServer
985
986The node in the master testbed from which filesystems are mounted.
987
988=item Boss
989
990The node in the master testbed that controls the testbed.
991
992=item TunnelCfg
993
994True if the connector needs to do DETER federation.  This parameter will
995probably be removed.
996
997
998=back
999
1000
1001=head1 ENVIRONMENT
1002
1003B<splitter.pl> does not directly make use of environment variables, but calls
1004out to L<ssh(1)> and (indirectly) to L<sh(1)>, which may be influenced by the
1005environment.
1006
1007=head1 SEE ALSO
1008
1009L<sh(1)>, L<ssh(1)>
1010
1011=cut
Note: See TracBrowser for help on using the repository browser.