source: fedkit/splitter.pl @ f64fa81

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

event stuff

  • Property mode set to 100644
File size: 37.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 = ("fed_bootstrap", "federate.sh", "smbmount.pl", 
12    "make_hosts", "fed-tun.pl");
13my $local_script_dir = ".";
14my($pid, $gid);                 # Process and group IDs for calling parse.tcl
15my $splitter_config;            # Configuration file
16my $debug;                      # True if thecalled in debug mode
17my $verbose;                    # True for extra progress reports
18my $startem;                    # If true, start the sub-experiments
19my $eid;                        # Experiment ID
20my $tcl;                        # The experiment description (topology file)
21my $master;                     # Master testbed
22my $tmpdir;                     # tmp files
23my $tb_config;                  # testbed configurations
24my $smb_share;                  # Share to mount from the master
25my $project_user;               # User to mount project dirs as
26my($gw_pubkey, $gw_pubkey_base);# Connector pubkey (full path & basename)
27my($gw_secretkey, $gw_secretkey_base);# Connector secret key (full path &
28                                # basename)
29my($keytype);                   # Type (DSA or RSA) of generated gateway keys
30my $tcl_splitter;               # tcl program to split experiments
31                                # (changed during devel)
32my $tclsh;                      # tclsh to call directly (changed during devel)
33my $muxmax;                     # Maximum number of links/lans over 1 gw pair
34my @tarfiles;                   # Tarfiles in use by this experiment
35my @rpms;                       # Rpms in use by this experiment
36my $timeout;                    # The timeout to use for experiment swap ins
37my %opts;                       # Parsed options
38
39my $tbparams = {};              # Map of the per-testbed parameters from the
40                                # testbeds file.  It is a reference to a hash
41                                # of hashes (because it's passed around a bunch
42                                # and it's nicer to have one access pattern
43                                # throughout the script, in the main loop and
44                                # the subroutines).  That access is exemplified
45                                # by  $tbparams->{'deter'}->{'domain'} which is
46                                # the domain parameter of the DETER testbed. 
47my $fail_soft;                  # Do not swap failed sub-experiments out
48my $max_children=1;             # Maximum number of simultaneous swap-ins
49
50# Parse the config file.  The format is a colon-separated parameter name
51# followed by the value of that parameter to the end of the line.  This parses
52# that format and puts the parameters into the referenced hash.  Parameter
53# names are mapped to lower case, parameter values are unchanged.  Returns 0 on
54# failure (e.g. file open) and 1 on success.
55sub parse_config {
56    my($file, $href) = @_;
57    my $fh = new IO::File($file);
58       
59    unless ($fh) {
60        warn "Can't open $file: $!\n";
61        return 0;
62    }
63
64    while (<$fh>) {
65        next if /^\s*#/ || /^\s*$/;     # Skip comments & blanks
66        chomp;
67        /^([^:]+):\s*(.*)/ && do {
68            my $key = $1; 
69
70            $key =~ tr/A-Z/a-z/;
71            $href->{$key} = $2;
72            next;
73        };
74        warn "Unparasble line in $file: $_\n";
75    }
76    $fh->close();   # It will close when it goes out of scope, but...
77    return 1;
78}
79
80# Parse an easier-to-read testbeds file (the original was comma-separated
81# unadorned strings).  The format is a testbed scope as [testbed] followed by
82# the colon-separated attribute-value pairs for the testbed.  Right now these
83# go into a set of global hashes indexed by testbed, but that should probably
84# change.
85
86sub parse_testbeds {
87    my($file, $tbparams) = @_;      # Testbeds file and parameter hash
88    my $fh = new IO::File($file);  # Testbeds filehandle
89    my $tb;                         # Current testbed
90    # Convert attribute in the file to tbparams hash key
91    my %attr_to_hash = (
92        "opsnode" => "host",
93        "user" => "user",
94        "domain" => "domain",
95        "project" => "project",
96        "connectortype" => "gwtype",
97        "slavenodestartcmd" => "expstart",
98        "slaveconnectorstartcmd" => "gwstart",
99        "masternodestartcmd" => "mexpstart",
100        "masterconnectorstartcmd" => "mgwstart",
101        "connectorimage" => "gwimage",
102        "fileserver" => "fs",
103        "boss" => "boss",
104        "eventserver" => "eventserver",
105        "tunnelcfg" => "tun"
106    );
107
108
109    unless ($fh) {
110        warn "Can't open $file: $!\n";
111        return 0;
112    }
113
114    while (<$fh>) {
115        next if /^\s*#/ || /^\s*$/;     # Skip comments & blanks
116        chomp;
117        /^\s*\[(.*)\]/ && do {
118            $tb = $1;
119            $tbparams->{$tb} = {} unless $tbparams->{$tb};
120            next;
121        };
122
123        /^([^:]+):\s*(.*)/ && do {
124            unless ($tb) {
125                warn "Ignored attribute definition before testbed " .
126                    "defined in $file: $_\n";
127                next;
128            }
129            my $key = $1; 
130            $key =~ tr/A-Z/a-z/;
131            my $var = $attr_to_hash{$key};
132
133            if ($var) { $tbparams->{$tb}->{$var} = $2; }
134            else { warn "Unknown keyword $key in $file\n"; }
135
136            next;
137        };
138        warn "Unparasble line in $file: $_\n";
139    }
140    $fh->close();   # It will close when it goes out of scope, but...
141    return 1;
142}
143
144# Generate SSH keys for use by the gateways.  The parameters are the type and
145# the filename for the private key.  The pubkey will be stored in a filename
146# with the same name as the private key but with .pub appended.  Type can be
147# dsa or rsa.
148
149sub generate_ssh_keys {
150    my($type, $dest) = @_;
151
152    $type =~ tr/A-Z/a-z/;
153    return 0 if $type !~ /(rsa|dsa)/;
154    system("/usr/bin/ssh-keygen -t $type -N \"\" -f $dest");
155    return $@ ? 0 : 1;
156}
157
158# use scp to transfer a file, reporting true if successful and false otherwise.
159# Parameters are the local file name, the ssh host destination (either hostname
160# oe user@host), and an optional destination file name or directory.  If no
161# destination is given, the file is transferred to the given user's home
162# directory.  If only a machine is given in the ssh host destination, the
163# current user is used.
164sub scp_file {
165    my($file, $user, $host, $dest) = @_;
166
167    # XXX system with a relative pathname is sort of gross
168    system("scp $file $user\@$host:$dest");
169    if ($?) {
170        warn "scp failed $?\n";
171        return 0;
172    }
173    else { return 1; }
174}
175
176# use ssh to execute the given command on the machine (and as the user) in
177# $where.  Parameters are the ssh destination directive ($where) and the
178# command to execute, and a prefix to be placed on a message generated if the
179# command fails.   On failure print a warning if a warning prefix was given and
180# return false.  If timeout is given fork a process and set an alarm of that
181# many seconds.  Timeouts also return 0;
182sub ssh_cmd {
183    my($user, $host, $cmd, $wname, $timeout) = @_;
184    my $pid;                # Child pid
185
186    $timeout = 0 unless $timeout;   # Force default timeout
187
188    if ( $pid = fork () ) {
189        # Parent process
190        # The eval acts as a signal catcher.  If the alarm goes off inside
191        # the eval, the die will put "alarm\n" into $@, otherwise the
192        # return value of the execution in the child process will be used.
193        my $rv = eval {
194            local $SIG{'ALRM'} = sub{ die "alarm\n"; };
195            my $rv;
196
197            alarm $timeout;
198            $rv = waitpid($pid, 0);
199            alarm 0;
200            $rv;
201        };
202
203        # If the eval succeeded, $@ will be null and we can use $rv, which
204        # is the return code from the subprocess.  If the eval timed out,
205        # print a warning and assume the best.
206        if ($@ eq "alarm\n" ) {
207            warn "$wname timed out - pid $pid still live\n";
208            return 1;
209        }
210        else {
211            return $rv;
212        }
213    }
214    else {
215        # Child process
216        exec("ssh $user\@$host $cmd");
217        exit 0;
218    }
219}
220
221# Ship local copies of the federation scripts out to the given host.  If any of
222# the script transfers fails, return 0.  The scripts to transfer are from the
223# global @scripts and are found locally in $local_script_dir (another global).
224sub ship_scripts {
225    my($host, $user, $dest_dir) = @_;       # Where, who, where remotely
226    my $s;
227
228    &ssh_cmd($user, $host, "mkdir -p $dest_dir");
229    for $s (@scripts) {
230        &scp_file("$local_script_dir/$s", $user, $host, $dest_dir) || 
231            return 0;
232    }
233    return 1;
234}
235
236# Ship per-testbed configuration generated by this script to the remote /proj
237# directories on the remote testbeds
238sub ship_configs {
239    my($host, $user, $src_dir, $dest_dir) = @_;     # Where, who, where remotely
240    my($d, $f);
241
242    $d = IO::Dir->new($src_dir) || return 0;
243
244    # All directories under $tmpdir are 770 so we can delete them later.
245    &ssh_cmd($user, $host, "mkdir -p $dest_dir") || return 0;
246    &ssh_cmd($user, $host, "chmod 770 $dest_dir") || return 0;
247    while ( $f = $d->read()) {
248        next if $f =~ /^\./;
249        if ( -d "$src_dir/$f" ) {
250            &ship_configs($host, $user, "$src_dir/$f", "$dest_dir/$f") || 
251                return 0;
252        }
253        else {
254            &scp_file("$src_dir/$f", $user, $host, $dest_dir) || return 0;
255        }
256    }
257    return 1;
258}
259
260# Start a sub section of the experiment on a given testbed.  The testbed and
261# the user to start the experiment as are pulled from the global per-testbed
262# hash, passed in as $tbparams, as is the project name on the remote testbed.
263# Parameters are the testbed and the experiment id.  Configuration files are
264# scp-ed over to the target testbed from the global $tmpdir/$tb directory.
265# Then the current state of the experiment determined using expinfo.  From that
266# state, the experiment is either created, modified or spapped in.  If
267# everything succeeds, true is returned.  If the global verbose is set progress
268# messages are printed.
269sub start_segment {
270    my($tb, $eid, $tbparams, $timeout) = @_;# testbed, experiment ID,
271                                            # per-testbed parameters and remote
272                                            # swap-in timeout
273    my $host =                              # Host name of remote ops (FQDN)
274        $tbparams->{$tb}->{'host'} . $tbparams->{$tb}->{'domain'};
275    my $user = $tbparams->{$tb}->{'user'};  # user to pass to ssh
276    my $pid = $tbparams->{$tb}->{'project'};# remote project to start the
277                                            # experiment under
278    my $tclfile = "./$eid.$tb.tcl";         # Local tcl file with the
279                                            # sub-experiment
280    my $proj_dir = "/proj/$pid/exp/$eid/tmp";  # Where to stash federation stuff
281    my $tarfiles_dir = "/proj/$pid/tarfiles/$eid";  # Where to stash tarfiles
282    my $rpms_dir = "/proj/$pid/rpms/$eid";  # Where to stash rpms
283    my $to_hostname = "$proj_dir/hosts";    # remote hostnames file
284    my $state;                              # State of remote experiment
285    my $status = new IO::Pipe;              # The pipe to get status
286
287    # Determine the status of the remote experiment
288    $status->reader("ssh $user\@$host /usr/testbed/bin/expinfo $pid $eid") || 
289        die "Can't ssh to $user\@$host:$!\n";
290
291    # XXX: this is simple now.  Parsing may become more complex
292    while (<$status>) {
293        /State: (\w+)/ && ($state = $1);
294        /No\s+such\s+experiment/ && ($state = "none");
295    }
296    $status->close();
297    print "$tb: $state\n";
298
299    # Copy the experiment definition data over
300    print "transferring subexperiment to $tb\n" if $verbose;
301    &scp_file("$tmpdir/$tb/$tclfile", $user, $host) || return 0;
302    # Clear out any old experiment data; if not deleted, copies over it by
303    # different users will fail.
304    # (O /bin/csh, how evil thou art.  The -c and the escaped single quotes
305    # force the /bin/sh interpretation of the trailing * (which we need to keep
306    # tmp around))  Again, this needs to be done more properly once we have a
307    # non-ssh interface here.)
308    print "clearing experiment subdirs on $tb\n" if $verbose;
309    &ssh_cmd($user, $host, "/bin/sh -c \\'/bin/rm -rf $proj_dir/*\\'") || 
310        return 0;
311    print "clearing experiment tarfiles subdirs on $tb\n" if $verbose;
312    &ssh_cmd($user, $host, "/bin/rm -rf $tarfiles_dir/") || 
313        return 0;
314    print "creating tarfiles subdir $tarfiles_dir on $tb\n" if $verbose;
315    &ssh_cmd($user, $host, "mkdir -p $tarfiles_dir", "create tarfiles") || 
316        return 0;
317    print "clearing experiment rpms subdirs on $tb\n" if $verbose;
318    &ssh_cmd($user, $host, "/bin/rm -rf $rpms_dir/") || 
319        return 0;
320    print "creating rpms subdir $rpms_dir on $tb\n" if $verbose;
321    &ssh_cmd($user, $host, "mkdir -p $rpms_dir", "create rpms") || 
322        return 0;
323    # Remote experiment is active.  Modify it.
324    if ($state eq "active") {
325        print "Transferring federation support files to $tb\n" if $verbose;
326        # First copy new scripts and hostinfo into the remote /proj
327        &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
328            return 0;
329        &ship_scripts($host, $user, $proj_dir) || return 0;
330        &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
331
332        if ( -d "$tmpdir/tarfiles") {
333            &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
334                return 0;
335        }
336
337        if ( -d "$tmpdir/rpms") {
338            &ship_configs($host, $user, "$tmpdir/rpms", $rpms_dir) || 
339                return 0;
340        }
341
342        print "Modifying $eid in place on $tb\n" if $verbose;
343        &ssh_cmd($user, $host, "/usr/testbed/bin/modexp -r -s -w $pid " . 
344            "$eid $tclfile", "modexp", $timeout) || return 0;
345        return 1;
346    }
347
348    # Remote experiment is swapped out, modify it and swap it in.
349    if ($state eq "swapped") {
350        print "Transferring federation support files to $tb\n" if $verbose;
351        # First copy new scripts and hostinfo into the remote /proj (because
352        # the experiment exists, the directory tree should be there.
353        &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
354            return 0;
355        &ship_scripts($host, $user, $proj_dir) || return 0;
356        &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
357        if ( -d "$tmpdir/tarfiles") {
358            &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
359                return 0;
360        }
361
362        if ( -d "$tmpdir/rpms") {
363            &ship_configs($host, $user, "$tmpdir/rpms", $rpms_dir) || 
364                return 0;
365        }
366
367        print "Modifying $eid on $tb\n" if $verbose;
368        &ssh_cmd($user, $host, "/usr/testbed/bin/modexp -w $pid $eid $tclfile", 
369            "modexp") || return 0;
370        print "Swapping $eid in on $tb\n" if $verbose;
371        # Now start up
372        &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
373            "swapexp", $timeout) || return 0;
374        return 1;
375    }
376
377    # No remote experiment.  Create one.  We do this in 2 steps so we can put
378    # the configuration files and scripts into the new experiment directories.
379    if ($state eq "none") {
380
381        if ( -d "$tmpdir/tarfiles") {
382            # Tarfiles have to exist for the creation to work
383            print "copying tarfiles to $tb\n";
384            &ship_configs($host, $user, "$tmpdir/tarfiles", $tarfiles_dir) || 
385                return 0;
386        }
387
388        if ( -d "$tmpdir/rpms") {
389            &ship_configs($host, $user, "$tmpdir/rpms", $rpms_dir) || 
390                return 0;
391        }
392
393        print "Creating $eid on $tb\n" if $verbose;
394        &ssh_cmd($user, $host, "/usr/testbed/bin/startexp -i -f -w -p " . 
395            "$pid -e $eid $tclfile", "startexp") || return 0;
396        # After startexp succeeds, the per-experiment directories exist on the
397        # remote testbed.
398        print "Transferring federation support files to $tb\n" if $verbose;
399        # First copy new scripts and hostinfo into the remote /proj
400        &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
401            return 0;
402        &ship_scripts($host, $user, $proj_dir) || return 0;
403        &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
404        # Now start up
405        print "Swapping $eid in on $tb\n" if $verbose;
406        &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
407            "swapexp", $timeout) || return 0;
408        return 1;
409    }
410
411    # Every branch for a known state returns.  If execution gets here, the
412    # state is unknown.
413    warn "unknown state: $state\n";
414    return 0;
415}
416
417# Swap out a sub-experiment - probably because another has failed.  Arguments
418# are testbed and experiment.  Most of the control flow is similar to
419# start_segment, though much simpler.
420sub stop_segment {
421    my($tb, $eid, $tbparams) = @_;          # testbed, experiment ID and
422                                            # per-testbed parameters
423    my $user = $tbparams->{$tb}->{'user'};  # testbed user
424    my $host =                              # Ops node
425        $tbparams->{$tb}->{'host'} . $tbparams->{$tb}->{'domain'};
426    my $pid = $tbparams->{$tb}->{'project'};# testbed project
427
428    print "Stopping $eid on $tb\n" if $verbose;
429    &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid out", 
430        "swapexp (out)") || return 0;
431    return 1;
432}
433
434
435$pid = $gid = "dummy";              # Default project and group to pass to
436                                    # $tcl_splitter above.  These are total
437                                    # dummy arguments;  the splitter doesn't
438                                    # use them at all, but we supply them to
439                                    # keep our changes to the parser minimal.
440# Argument processing.
441getopts('Ft:c:p:f:ndvN', \%opts);
442$splitter_config = $opts{'c'} || "./splitter.conf";
443$debug = $opts{'d'};
444$verbose = $opts{'v'} || $opts{'d'};
445
446&parse_config("$splitter_config", \%opts) || 
447    die "Cannot read config file $splitter_config: $!\n";
448
449warn "-N does nothing now.  Only one testbeds format supported.\n"
450    if $opts{'N'};
451$fail_soft = $opts{'F'} || $opts{'failsoft'};
452$startem = $opts{'n'} ? 0 : 1;          # If true, start the sub-experiments
453$timeout = $opts{'t'} || $opts{'timeout'};
454$eid = $opts{'experiment'};             # Experiment ID
455$tcl = $opts{'f'} || shift;             # The experiment description
456$master = $opts{'master'};              # Master testbed
457$tmpdir = $opts{'tmpdir'} || $opts{'tempdir'}|| "/tmp"; # tmp files
458$tb_config = $opts{'testbeds'} || "./testbeds"; # testbed configurations
459$local_script_dir = $opts{'scriptdir'}; # Local scripts
460$muxmax  = $opts{'muxlimit'} || 3;      # Number of connections muxed on one
461                                        # gateway
462
463$max_children = $opts{'p'} || $opts{'maxchildren'} 
464    if $opts{'p'} || $opts{'maxchildren'};
465
466$smb_share = $opts{'smbshare'} ||       # Share to mount from the master
467    die "Must give an SMB share\n";
468$project_user = $opts{'smbuser'} ||     # User to mount project dirs as
469    die "Must give an SMB user\n";
470
471# tcl program to split experiments (changed during devel)
472$tcl_splitter = $opts{'tclparse'} || "/usr/testbed/lib/ns2ir/parse.tcl";
473# tclsh to call directly (changed during devel)
474$tclsh = $opts{'tclsh'} || "/usr/local/bin/otclsh";
475
476# Prefix to avoid collisions
477$tmpdir .= "/split$$";
478
479print "Temp files are in $tmpdir\n" if $verbose;
480# Create a workspace
481unless (-d "$tmpdir") {
482    mkdir("$tmpdir") || die "Can't create $tmpdir: $!";
483}
484
485# If the keys are given, use them.  Otherwise create a set under $tmpdir
486
487if ( $opts{'gatewatpubkey'} && $opts{'gatewaysecretkey'}) {
488    $gw_pubkey = $opts{'gatewaypubkey'};
489    $gw_secretkey = $opts{'gatewaysecretkey'};
490}
491else {
492    $keytype = $opts{'gatewaykeytype'} || "rsa";
493    mkdir("$tmpdir/keys") || die "Can't create temoprary key dir: $!\n";
494    $gw_pubkey = "$tmpdir/keys/fed.$keytype.pub";
495    $gw_secretkey = "$tmpdir/keys/fed.$keytype";
496    print "Generating $keytype keys\n" if $verbose;
497    generate_ssh_keys($keytype, $gw_secretkey) || 
498        die "Cannot generate kets:$@\n";
499}
500# Generate the basenames
501($gw_pubkey_base = $gw_pubkey) =~ s#.*/##;
502($gw_secretkey_base = $gw_secretkey) =~ s#.*/##;
503
504
505
506# Validate scripts directory
507for my $s (@scripts) {
508    die "$local_script_dir/$s not in local script directory. Try -d\n"
509        unless -r "$local_script_dir/$s";
510}
511
512die "Must supply file, master and experiment" unless $master && $tcl && $eid;
513
514&parse_testbeds($tb_config, $tbparams) ||
515    die "Cannot testbed congfigurations from $tb_config: $!\n";
516
517# Open a pipe to the splitter program and start it parsing the experiments
518my $pipe = new IO::Pipe;
519# NB no more -p call on parse call.
520$pipe->reader("$tclsh $tcl_splitter -s -x $muxmax -m $master  $pid $gid $eid $tcl") || 
521    die "Cannot execute $tclsh $tcl_splitter -s -x $muxmax -m $master $pid $gid $eid $tcl:$!\n";
522
523# Parsing variables
524my $ctb;                        # Current testbed
525my %allocated;                  # If allocated{$tb} > 0, $tb is in use
526my $destfile;                   # File that the sub-experiment tcl file is
527                                # being written to, or "" if none.  Also used
528                                # for hostnames file.
529my $desthandle;                 # File handle for distfile
530my $gateways;                   # when gateway lists are being processed this
531                                # is the testbed whose gateways are being
532                                # gathered.
533my $control_gateway;            # Control net gateway for the current testbed
534my %active_end;                 # If active_end{"a-b"} > 0 then a is the active
535                                # end of the a <-> b connector pair.
536
537# Parse the splitter output.  This loop creates the sub experiments, gateway
538# configurations and hostnames file
539while (<$pipe>) {
540    # Start of a sub-experiment
541    /^#\s+Begin\s+Testbed\s+\((\w+)\)/ && do {
542        $ctb = $1;
543
544        # If we know the testbed, start collecting its sub experiment tcl
545        # description.  If not, warn the caller and ignore the configuration of
546        # this testbed.
547        if ($tbparams->{$ctb}) {
548            $allocated{$ctb}++; # Keep track of the testbeds allocated
549
550            unless (-d "$tmpdir/$ctb") {
551                mkdir("$tmpdir/$ctb") || die "Can't create $tmpdir/$ctb: $!";
552            }
553            $destfile = "$tmpdir/$ctb/$eid.$ctb.tcl";
554
555            $desthandle = new IO::File(">$destfile") || 
556                die "Cannot open $destfile:$!\n";
557        }
558        else { 
559            warn "No such testbed $ctb\n";
560            $destfile = "";
561        }
562        next;
563    };
564
565    # End of that experiment
566    /^#\s+End\s+Testbed\s+\((\w+)\)/ && do {
567        # Simple syntax check and close out this experiment's tcl description
568        die "Mismatched testbed markers ($1, $ctb)\n" unless ($1 eq $ctb);
569        $desthandle->close();
570        $destfile = $ctb = "";
571        next;
572    };
573
574    # Beginning of a gateway set
575    /^#\s+Begin\s+gateways\s+\((\w+)\)/ && do {
576        $gateways = $1;
577        # If we've heard of this tb, create the config lines for it one at a
578        # time.
579        if ($allocated{$gateways}) {
580            # Just in case.  This directory should already have been created
581            # above.
582            unless (-d "$tmpdir/$gateways") {
583                mkdir("$tmpdir/$gateways") || 
584                    die "Can't create $tmpdir/$gateways: $!";
585            }
586        }
587        else {
588            warn "Gateways given (and ignored) for testbed not in use: " .
589                "$gateways\n";
590            $gateways = 0;
591        }
592        next;
593    };
594    # End of the gateways section.  Output the client config for this testbed
595    /^#\s+End\s+gateways\s+\((\w+)\)/ && do {
596        die "Mismatched gateway markers ($1, $gateways)\n" 
597            unless !$gateways || $gateways == $1;
598
599        if ($control_gateway ) {
600            # Client config
601            my $cc = new IO::File(">$tmpdir/$gateways/client.conf");
602            my $master_project = $tbparams->{$master}->{'project'};
603            die "Can't open $tmpdir/$gateways/client.conf: $!\n" unless $cc;
604            print $cc "ControlGateway: $control_gateway\n";
605            print $cc "SMBShare: $smb_share\n";
606            print $cc "ProjectUser: $project_user\n";
607            print $cc "ProjectName: $master_project\n";
608            $cc->close();
609        }
610        else { warn "No control gateway for $gateways?\n"; }
611           
612        $gateways = 0;
613        next;
614    };
615    # Beginning of the hostnames list.  Collection is always in the hostnames
616    # file.
617    /^#\s+Begin\s+hostnames/ && do {
618        $destfile = "$tmpdir/hostnames";
619        $desthandle = new IO::File(">$destfile") || 
620            die "Can't open $destfile:$!\n";
621        next;
622    };
623    # end of the hostnames list.
624    /^#\s+End\s+hostnames/ && do {
625        $desthandle->close();
626        $destfile = "";
627        next;
628    };
629
630    # Generate gateway configuration info, one file per line
631    $gateways && do {
632        chomp;
633        my($dtb, $myname, $desthost, $type) = split(" ", $_);
634
635        # Many of these are to simplify print statements
636        my $sdomain =                           # domain for the source
637            $tbparams->{$gateways}->{'domain'};
638        my $ddomain =                           # domain for the destination
639            $tbparams->{$dtb}->{'domain'};
640        my $sproject =                          # Project of the destination
641            $tbparams->{$gateways}->{'project'};
642        my $fs =                                # Master fs node (FQDN)
643            $tbparams->{$master}->{'fs'} .  $tbparams->{$master}->{'domain'};
644        my $boss =                              # Master boss node (FQDN)
645            $tbparams->{$master}->{'boss'} .  $tbparams->{$master}->{'domain'};
646        my $event_server =                      # Master event-server (FQDN)
647            $tbparams->{$master}->{'eventserver'} . 
648            $tbparams->{$master}->{'domain'};
649        my $remote_script_dir =                 # Remote fed script location
650            "/proj/" . $tbparams->{$dtb}->{'project'} . "/exp/$eid/tmp";
651        my $active;                             # Is this the active side of
652                                                # the connector?
653
654        $sdomain = ".$eid." . $tbparams->{$gateways}->{'project'} . "$sdomain";
655        $ddomain = ".$eid." . $tbparams->{$dtb}->{'project'} . "$ddomain";
656
657        my $conf_file = "$myname$sdomain.gw.conf";
658        # translate to lower case so the `hostname` hack for specifying
659        # configuration files works.
660        $conf_file =~ tr/A-Z/a-z/;
661
662        # If either end of this link is in the master side of the testbed, that
663        # side is the active end. Otherwise the first testbed encountered in
664        # the file will be the active end.  The $active_end variable keeps
665        # track of those decisions
666        if ( $dtb eq $master ) { $active = "false"; }
667        elsif ($gateways eq $master ) { $active = "true"; }
668        elsif ( $active_end{"$dtb-$gateways"} ) { $active="false"; }
669        else { $active_end{"$gateways-$dtb"}++; $active = "true"; }
670
671        # This is used to create the client configuration.
672        $control_gateway = "$myname$sdomain"
673            if $type =~ /(control|both)/;
674
675        # Write out the file
676        my $gwconfig = new IO::File(">$tmpdir/$gateways/$conf_file")|| 
677            die "can't open $tmpdir/$gateways/$conf_file: $!\n";
678
679        print $gwconfig "Active: $active\n";
680        print $gwconfig "TunnelCfg: " . $tbparams->{$gateways}->{'tun'} . "\n";
681        print $gwconfig "BossName: $boss\n";
682        print $gwconfig "FsName: $fs\n";
683        print $gwconfig "EventServerName: $event_server\n";
684        print $gwconfig "Type: $type\n";
685        print $gwconfig "RemoteScriptDir: $remote_script_dir\n";
686        print $gwconfig "Peer: $desthost$ddomain\n";
687        print $gwconfig "Pubkeys: " . 
688            "/proj/$sproject/exp/$eid/tmp/$gw_pubkey_base\n";
689        print $gwconfig "Privkeys: " .
690            "/proj/$sproject/exp/$eid/tmp/$gw_secretkey_base\n";
691        $gwconfig->close();
692
693        # This testbed has a gateway (most will) so make a copy of the keys it
694        # needs in this testbed's subdirectory.  start_segment will transfer
695        # them.
696        unless (-r "$tmpdir/$gateways/$gw_pubkey_base" ) {
697            copy($gw_pubkey, "$tmpdir/$gateways/$gw_pubkey_base") ||
698                die "Can't copy pubkeys ($gw_pubkey to " . 
699                    "$tmpdir/$gateways/$gw_pubkey_base): $!\n";
700        }
701        if ($active eq "true" ) {
702            unless (-r "$tmpdir/$gateways/$gw_secretkey_base" ) {
703                copy($gw_secretkey, "$tmpdir/$gateways/$gw_secretkey_base") ||
704                    die "Can't copy secret keys ($gw_secretkey to " . 
705                        "$tmpdir/$gateways/$gw_secretkey_base): $!\n";
706            }
707        }
708
709        #done processing gateway entry, ready for next line
710        next; 
711    };
712    (/^#\s+Begin\s+tarfiles/../^#\s+End\s+tarfiles/) && do {
713        next if /^#/;
714        chomp;
715        push(@tarfiles, $_);
716        next;
717    };
718    (/^#\s+Begin\s+rpms/../^#\s+End\s+rpms/) && do {
719        next if /^#/;
720        chomp;
721        push(@rpms, $_);
722        next;
723    };
724
725    next unless $destfile;  # Unidentified testbed, ignore config
726    # local copies that can be used in the substitutions below
727    my $gwtype = $tbparams->{$ctb}->{'gwtype'};
728    my $gwimage = $tbparams->{$ctb}->{'gwimage'};
729    my $mgwstart = $tbparams->{$ctb}->{'mgwstart'};
730    my $mexpstart = $tbparams->{$ctb}->{'mexpstart'};
731    my $gwstart = $tbparams->{$ctb}->{'gwstart'};
732    my $expstart = $tbparams->{$ctb}->{'expstart'};
733    my $project = $tbparams->{$ctb}->{'project'};
734
735    # Substitute variables
736    s/GWTYPE/$gwtype/g;
737    s/GWIMAGE/$gwimage/g;
738    if ($ctb eq $master ) {
739        s/GWSTART/$mgwstart/g;
740        s/EXPSTART/$mexpstart/g;
741    }
742    else {
743        s/GWSTART/$gwstart/g;
744        s/EXPSTART/$expstart/g;
745    }
746    # XXX: oh is this bad
747    s#GWCONF#FEDDIR\`hostname\`.gw.conf#g;
748    s#PROJDIR#/proj/$project/#g;
749    s#EID#$eid#g;
750    s#FEDDIR#/proj/$project/exp/$eid/tmp/#g;
751    print $desthandle $_;
752}
753$pipe->close();
754die "No nodes in master testbed ($master)\n" unless $allocated{$master};
755
756# Copy tarfiles and rpms needed at remote sites to the staging directories.
757# Start_segment will distribute them
758for my $t  (@tarfiles) {
759    die "tarfile '$t' unreadable: $!\n" unless -r $t;
760    unless (-d "$tmpdir/tarfiles") {
761        mkdir("$tmpdir/tarfiles") || 
762            die "Can't create $tmpdir/tarfiles:$!\n";
763    }
764    copy($t, "$tmpdir/tarfiles") || 
765        die "Can't copy $t to  $tmpdir/tarfiles:$!\n";
766}
767
768for my $r  (@rpms) {
769    die "rpm '$r' unreadable: $!\n" unless -r $r;
770    unless (-d "$tmpdir/rpms") {
771        mkdir("$tmpdir/rpms") || 
772            die "Can't create $tmpdir/rpms:$!\n";
773    }
774    copy($r, "$tmpdir/rpms") || 
775        die "Can't copy $r to  $tmpdir/rpms:$!\n";
776}
777
778exit(0) unless $startem;
779
780my %started;                # If $started{$tb} then $tb successfully started
781my %child;                  # If $child{$pid} then a process with that pid is
782                            # working on a starting a segment
783my $nworking = 0;           # Number of children working on swapin
784my $pid;                    # Scratch variable for pids
785
786# Start up the slave sub-experiments first
787TESTBED:
788for my $tb  (keys %allocated) {
789    if ( $tb ne $master ) {
790        while ( $nworking == $max_children ) {
791            print "Waiting for a child process to complete\n" if $verbose;
792            if (($pid = wait()) != -1 ) {
793                # The $? >> 8 is the exit code of the subprocess, which is
794                # non-zero if the &start_segment routine failed.
795                my $exit_code = ($? >> 8);
796
797                print "Child $pid completed exit code ($exit_code)\n"
798                    if $verbose;
799                $nworking--;
800                $started{$child{$pid}}++ unless $exit_code;
801                if ($child{$pid} ) { delete $child{$pid}; }
802                else { warn "Reaped a pid we did not start?? ($pid)\n"; }
803                last TESTBED if $exit_code;
804            }
805            else { warn "wait returned without reaping: $!\n"; }
806        }
807        if ( $pid = fork() ) {
808            # Parent process
809            $nworking ++;
810            $child{$pid} = $tb;
811            print "Started process $pid to start testbed $tb\n"
812                if $verbose;
813        }
814        else {
815            # Child.  Note that we reverse the sense of the return code when it
816            # becomes an exit value.  Zero exit values indicate success.
817            exit(!&start_segment($tb, $eid, $tbparams, $timeout));
818        }
819    }
820}
821
822# Now wait for any still running processes.
823while ( $nworking ) {
824    print "Waiting for a child process to complete ($nworking running)\n" 
825        if $verbose;
826    if (($pid = wait()) != -1 ) {
827        # The $? >> 8 is the exit code of the subprocess, which is
828        # non-zero if the &start_segment routine failed.
829        my $exit_code = ($? >> 8);
830
831        print "Child $pid completed exit code ($exit_code)\n"
832            if $verbose;
833        $nworking--;
834        $started{$child{$pid}}++ unless $exit_code;
835        if ($child{$pid} ) { delete $child{$pid}; }
836        else { warn "Reaped a pid we did not start?? ($pid)\n"; }
837    }
838    else { warn "wait returned without reaping: $!\n"; }
839}
840
841# Now the master
842if (&start_segment($master, $eid, $tbparams, $timeout)) { 
843    $started{$master}++;
844}
845
846# If any testbed failed, swap the rest out.
847if ( !$fail_soft && scalar(keys %started) != scalar(keys %allocated)) {
848    for my $tb (keys %started) { &stop_segment($tb, $eid, $tbparams); }
849    print "Error starting experiment\n";
850    exit(1);
851}
852print "Experiment started\n";
853print "Deleting $tmpdir (-d to leave them in place)\n" if $verbose && !$debug;
854system("rm -rf $tmpdir") unless $debug;
855exit(0);    # set the exit value
856
857=pod
858
859=head1 NAME
860
861B<splitter.pl>
862
863=head1 SYNOPSIS
864
865B<splitter.pl> [B<-ndF>] [B<-t> I<secs>] [B<-c> F<config_file>]
866    [B<-f> F<experiment_tcl>] [B<-p> I<max_procs>] [F<experiment_tcl>]
867
868=head1 DESCRIPTION
869
870B<splitter.pl> invokes the DETER experiment parser to split an annotated
871experiment into multiple sub-experments and instantiates the sub-experiments on
872their intended testbeds.  Annotation is accomplished using the
873tb-set-node-testbed command, added to the parser.
874
875Much of the script's behavior depends on the configuration file, specified with
876the B<-c> flag and defaulting to F<./splitter.conf>.
877
878The testbed labels supplied in the B<tb-set-node-testbed> command are
879meaningful based on their presence in the testbeds file.  that file can be
880specified in the configuration file using the B<Testbeds> directive, and
881defaults to F<./testbeds>.  The syntax is described below.
882
883Most of the intermediate files are staged in a sub-directory of a temporary
884files directory and deleted at the end of the script.  Specifying the B<-d>
885flag on the command line avoids the deletion for debbugging.  By default the
886temporary files directory is directory is F</tmp> and can be reset in the
887configuration file using the B<Tmpdir> directive.  Intermediate files are
888stored under a subdirectory formed by adding the process ID of the splitter
889process.  For example, if the temporary files directory is F</tmp> and the
890B<splitter.pl> process ID is 2323, the temporary files will be stored in
891F</tmp/split2323/>.
892
893The expreriment is split out into one experiment description per testbed in the
894temporary directory named as F<experiment.testbed.tcl> where the experiment is
895the experiment ID given in the configuration file, and the testbed is the
896tb-set-node-testbed parameter for the nodes in the file.
897
898If the B<-n> option is absent the sub-experiments are then instantiated on
899their testbeds.  (Here B<-n> is analogous to its use in L<make(1)>).
900Per-testbed parameters are set in the testbeds file.  Sub-experiments on
901slave testbeds are instantiated in a random order, but the master testbed is
902currently instantiated last.
903
904Slave testbeds can be swapped in in parallel by specifying the B<-p> parameter
905and the maximum number of simultaneous processes to start.
906
907Scripts to start federation (the federation kit) are copied into the local
908experiment's tmp file - e.g., F</proj/DETER/exp/simple-split/tmp>.  These are
909taken from the directory given by the B<ScriptDir> directive in the
910configuration file.
911
912If B<-t> is given the parameter is treated as a parameter to B<Timeout> in
913F<splitter.conf>.
914
915If any sub-experiment fails to instantiate, the other sub-exeriments are
916swapped out.  B<-F> avoids this swap out, which can also be specified as
917B<SoftFail: true> in F<splitter.conf>
918
919=head2 Configuration File
920
921The configuration file is a simple set of colon-separated parameters and
922values.  A configuration file must be present, either specified in the B<-c>
923flag or the default F<./splitter.conf>.  All the parameter names are case
924insensitive, but should not include any whitespace.  Parameter values may
925include whitespace, but no newlines.
926
927Possible parameters are:
928
929=over 5
930
931=item Experiment
932
933The name of the experiment on the various testbeds
934
935=item Master
936
937The master testbed label from the testbeds file, described below.
938
939=item Testbeds
940
941The testbeds file described below, giving per-testbed parameters.  If this
942directive is absent the testbeds file defaults to F<./testbeds>
943
944=item ScriptDir
945
946Location of the default federation scripts, i.e. the federation kit.
947
948=item GatewayPubkey
949
950=item GatewaySecretKey
951
952The names of the files containing secret and public keys to use in setting up
953tunnels between testbeds.  If given they are used, otherwise keys are generated.
954
955=item GatewayKeyType
956
957This controls the kind of SSH keys generated to configure the geatways.  If
958given this must be B<dsa> or B<rsa>, and it defaults to B<rsa>.  The parameter
959is csase insensitive.
960
961=item TmpDir
962
963=item TempDir
964
965The directory where temporary files are created.  These are synonyms, but
966should both be specified, B<TmpDir> has priority.  If neither is specified,
967F</tmp> is used.
968
969=item SMBShare
970
971The SMB share on the master testbed that will be exported to remote clients.
972
973=item SMBUser
974
975The experiment user to mount project directories as.  This user needs to be a
976member of the exported experiment - that is one of the users in the project
977containing this experiment on the master testbed.
978
979=item Timeout
980
981Value in seconds after which a swap-in operatioin will be considered a success.
982Often long swap-ins will hang when there are partial failures.  This works
983around this issue.  (This behavior can be requested on the command line by
984specifying B<-t> I<secs>.)
985
986=item FailSoft
987
988If not set, failure of any sub experiment swaps the rest out.  Setting this to
989any value avoids this swap out.  (This behavior can be requested on the command
990line by specifying B<-F>.)
991
992=item MuxLimit
993
994The maximum bumber of links/lans carried by one gateway pair
995
996=item Tclparse
997
998The pathname to the experiment parsing program.  Only developers should set
999this.
1000
1001=item Tclsh
1002
1003The pathname to the local oTcl shell.  Only developers should set
1004this.
1005
1006=back
1007
1008=head2 Testbeds file
1009
1010The configuration file (F<./testbeds> unless overridden by B<-c>) is a file of
1011scoped attribute-value pairs where each attribute is specified on a separate
1012line of the configuration file.  Each testbed's parameters are preceeded by the
1013testbed label in brackets ([]) on a line by itself.  After that the parameters
1014are specified as parameter: value.  This is essentially the same format as the
1015configuration file.  Parameters are:
1016
1017=over 4
1018
1019=item User
1020
1021The user under which to make requests to this testbed.  The user running
1022B<splitter.pl> must be able to authenicate as this user under L<ssh(1)> to this
1023testbed.
1024
1025=item OpsNode
1026
1027The host name of the testbed's ops node.  The user calling B<splitter.pl> must
1028be able to execute commands on this host via L<ssh(1)>.
1029
1030=item Domain
1031
1032The domain of nodes in this testbed (including the ops host).  This parameter
1033should always start with a period.
1034
1035=item Project
1036
1037The project under which to instantiate sub-experiments on this testbed.
1038
1039=item ConnectorType
1040
1041The node type for inter-testbed connector nodes on this testbed.
1042
1043=item SlaveNodeStartCmd
1044
1045The start command to run on experimental nodes when this testbed is used as a
1046slave.  In all the start commands the following string substitutions are made:
1047
1048=over 10
1049
1050=item FEDDIR
1051
1052The local experiment's federation scripts directory.  Each local experiment
1053will have this replaced by the scripts directory on its local boss.
1054
1055=item GWCONF
1056
1057The full pathname of the gateway configuration file.  As with FEDDIR, this is
1058on the local boss.
1059
1060=item PROJDIR
1061
1062The project directory on the local boss.
1063
1064=item EID
1065
1066The local experiment name.
1067
1068=back
1069
1070All startcmds specified in F<testbeds> undergo these expansions.
1071
1072=item SlaveConnectorStartCmd
1073
1074The start command to run on gateway nodes when this testbed is used as a slave.
1075The same string substitutions are made in this command as in SlaveNodeStartCmd.
1076
1077=item MasterNodeStartCmd
1078
1079The start command to run on experimental nodes when this testbed is used as a
1080master.  The same string substitutions are made in this command as in
1081SlaveNodeStartCmd.
1082
1083=item MasterConnectorStartCmd
1084
1085The start command to run on gateway nodes when this testbed is used as a
1086master.  The same string substitutions are made in this command as in
1087SlaveNodeStartCmd.
1088
1089=item ConnectorImage
1090
1091The disk image to be loaded on a gateway node on this testbed.
1092
1093=item FileServer
1094
1095The node in the master testbed from which filesystems are mounted.
1096
1097=item Boss
1098
1099The node in the master testbed that controls the testbed.
1100
1101=item TunnelCfg
1102
1103True if the connector needs to do DETER federation.  This parameter will
1104probably be removed.
1105
1106
1107=back
1108
1109=head1 ENVIRONMENT
1110
1111B<splitter.pl> does not directly make use of environment variables, but calls
1112out to L<ssh(1)> and (indirectly) to L<sh(1)>, which may be influenced by the
1113environment.
1114
1115=head1 BUGS
1116
1117A deprecated B<-N> flag was used to select testbeds file format.  Only one
1118format is supported now, and B<-N> generates a warning, but otherwise does not
1119affect B<splitter.pl>.
1120
1121=head1 SEE ALSO
1122
1123L<sh(1)>, L<ssh(1)>
1124
1125=cut
Note: See TracBrowser for help on using the repository browser.