source: fedkit/splitter.pl @ 4addf9d

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

remove special case for localhost
  • Property mode set to 100644
File size: 15.1 KB
Line 
1#!/usr/bin/perl
2
3use Getopt::Std;
4
5@scripts = ("federate.sh", "smbmount.pl");
6$local_script_dir = ".";
7
8# use scp to transfer a file, reporting true if successful and false otherwise.
9# Parameters are the local file name, the ssh host destination (either hostname
10# oe user@host), and an optional destination file name or directory.  If no
11# destination is given, the file is transferred to the given user's home
12# directory.  If only a machine is given in the ssh host destination, the
13# current user is used.
14sub scp_file {
15    my($file, $where, $dest) = @_;
16
17    # XXX system with a relative pathname is sort of gross
18    system("scp $file $where:$dest");
19    if ($?) {
20        warn "scp failed $?\n";
21        return 0;
22    }
23    else { return 1; }
24}
25
26# use ssh to execute the given command on the machine (and as the user) in
27# $where.  Parameters are the ssh destination directive ($where) and the
28# command to execute, and a prefix to be placed on a message generated if the
29# command fails.   On failure print a warning if a warning prefix was given and
30# return false.
31sub ssh_cmd {
32    my($user, $host, $cmd, $wname) = @_;
33
34    # XXX system with a relative pathname is sort of gross
35    system ("ssh $user\@$host $cmd");
36    if ($?) {
37        warn "$wname failed $?\n" if $wname;
38        return 0;
39    }
40    else { return 1; }
41}
42
43# Ship local copies of the federation scripts out to the given host.  If any of
44# the script transfers fails, return 0.  The scripts to transfer are from the
45# global @scripts and are found locally in $local_script_dir (another global).
46sub ship_scripts {
47    my($host, $user, $dest_dir) = @_;       # Where, who, where remotely
48    my($s);
49
50    for $s (@scripts) {
51        &scp_file("$local_script_dir/$s", "$user\@$host", $dest_dir) || 
52            return 0;
53    }
54    return 1;
55}
56
57
58
59# Start a sub section of the experiment on a given testbed.  The testbed and
60# the user to start the experiment as are pulled from the global per-testbed
61# hash, as is the project name on the remote testbed.  Parameters are the
62# testbed and the experiment id.  Configuration files are scp-ed over to the
63# target testbed from the global $tmpdir/$tb directory.  Then the current state
64# of the experiment determined using expinfo.  From that state, the experiment
65# is either created, modified or spapped in.  If everything succeeds, true is
66# returned.
67sub start_segment {
68    my($tb, $eid) = @_;                     # testbed and experiment ID
69    my($host) = "$host{$tb}$domain{$tb}";   # Host name of remote ops (FQDN)
70    my($user) = $user{$tb};                 # user to pass to ssh
71    my($pid) = $project{$tb};               # remote project to start the
72                                            # experiment under
73    my($tclfile) = "./$eid.$tb.tcl";        # Local tcl file with the
74                                            # sub-experiment
75    my($proj_dir) = "/proj/$pid/exp/$eid/tmp";  # Where to stash federation stuff
76    my($to_hostname) = "$proj_dir/hosts";   # remote hostnames file
77
78    # Determine the status of the remote experiment
79    open(STATUS, "ssh $user\@$host /usr/testbed/bin/expinfo $pid $eid|") || 
80        die "Can't ssh to $user\@$host:$!\n";
81    # XXX: this is simple now.  Parsing may become more complex
82    while (<STATUS>) {
83        /State: (\w+)/ && ($state = $1);
84        /No\s+such\s+experiment/ && ($state = "none");
85    }
86    close(STATUS);
87    print "$tb: $state\n";
88
89    # Copy the experiment definition data over (unless the host is local)
90    &scp_file("$tmpdir/$tb/$tclfile", "$user\@$host") || return 0;
91    # Remote experiment is active.  Modify it.
92    if ($state eq "active") {
93        # First copy new scripts and hostinfo into the remote /proj
94        &scp_file("$tmpdir/$tb/hostnames", "$user\@$host", $to_hostname) ||
95            return 0;
96        &ship_scripts($host, $user, $proj_dir) || return 0;
97        &ssh_cmd($user, $host, "/usr/testbed/bin/modexp -r -s -w $pid " . 
98            "$eid $tclfile", "modexp") || return 0;
99        return 1;
100    }
101
102    # Remote experiment is swapped out, modify it and swap it in.
103    if ($state eq "swapped") {
104        &ssh_cmd($user, $host, "/usr/testbed/bin/modexp -w $pid $eid $tclfile", 
105            "modexp") || return 0;
106        # First copy new scripts and hostinfo into the remote /proj
107        &scp_file("./hostnames", "$user\@$host", $to_hostname) || return 0;
108        &ship_scripts($host, $user, $proj_dir) || return 0;
109        # Now start up
110        &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
111            "swapexp") || return 0;
112        return 1;
113    }
114
115    # No remote experiment.  Create one.  We do this in 2 steps so we can put
116    # the configuration files and scripts into the new experiment directories.
117    if ($state eq "none") {
118        &ssh_cmd($user, $host, "/usr/testbed/bin/startexp -f -w -p " . 
119            "$pid -e $eid $tclfile", "startexp") || return 0;
120        # First copy new scripts and hostinfo into the remote /proj
121        &scp_file("./hostnames", "$user\@$host", $to_hostname) || return 0;
122        &ship_scripts($host, $user, $proj_dir) || return 0;
123        # Now start up
124        &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid in", 
125            "swapexp") || return 0;
126        return 1;
127    }
128
129    # Every branch for a known state returns.  If execution gets here, the
130    # state is unknown.
131    warn "unknown state: $state\n";
132    return 0;
133}
134
135# Swap out a sub-experiment - probably because another has failed.  Arguments
136# are testbed and experiment.  Most of the control flow is similar to
137# start_segment, though much simpler.
138sub stop_segment {
139    my($tb, $eid) = @_;
140    my($user) = "$user{$tb}";
141    my($host) = "$host{$tb}$domain{$tb}";
142    my($pid) = $project{$tb};
143
144    &ssh_cmd($user, $host, "/usr/testbed/bin/swapexp -w $pid $eid out", 
145        "swapexp (out)") || return 0;
146    return 1;
147}
148
149# tcl program to split experiments
150# $tcl_splitter = "/usr/testbed/lib/ns2ir/parse.tcl";
151$tcl_splitter = "/users/faber/testbed/tbsetup/ns2ir/parse.tcl";
152$tclsh = "/usr/local/bin/otclsh";   # tclsh to call directly
153
154$pid = $gid = "dummy";              # Default project and group to pass to
155                                    # $tcl_splitter above.  These are total
156                                    # dummy arguments;  the splitter doesn't
157                                    # use them at all, but we supply them to
158                                    # keep our changes to the parser minimal.
159
160# Argument processing.
161getopts('d:c:m:e:f:nt:', \%opts);
162
163$eid = $opts{'e'};                  # Experiment ID
164$tcl = $opts{'f'} || shift;         # The experiment description
165$master = $opts{'m'};               # Master testbed
166$startem = $opts{'n'} ? 0 : 1;      # If true, start the sub-experiments
167$tmpdir = $opts{'t'} || "/tmp";             # where to collect tmp files
168$config = $opts{'c'} || "./testbeds";
169$local_script_dir = $opts{'d'};     # Local scripts
170
171$tmpdir .= "/split$$";
172
173unless (-d "$tmpdir") {
174    mkdir("$tmpdir") || die "Can't create $tmpdir: $!";
175}
176
177
178for $s (@scripts) {
179    die "$local_script_dir/$s not in local script directory. Try -d\n"
180        unless -r "$local_script_dir/$s";
181}
182
183die "Must supply file, master and experiment" unless $master && $tcl && $eid;
184
185# Read a hash of per-testbed parameters from the local configurations.
186open(CONF, $config) || die "can't read testbed configutions from $config: $!\n";
187while (<CONF>) {
188    next if /^#/;
189    chomp;
190    ($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i) = split(":", $_);
191    $host{$tb} = $h;
192    $user{$tb} = $u;
193    $domain{$tb} = $d;
194    $project{$tb} = $p;
195    $gwtype{$tb} = $t;
196    $expstart{$tb} = $es;
197    $gwstart{$tb} = $gs;
198    $mexpstart{$tb} = $mes;
199    $mgwstart{$tb} = $mgs;
200    $gwimage{$tb} = $i;
201
202    # Make sure the domain starts with a period
203    $domain{$tb} = ".$domain{$tb}" unless $domain{$tb} =~ /^\./;
204}
205close(CONF);
206
207# Open a pipe to the splitter program and start it parsing the experiments
208open(PIPE, "$tclsh $tcl_splitter -s -m $master -p $pid $gid $eid $tcl|") || 
209    die "Cannot execute $tclsh $tcl_splitter -s -p $pid $gid $eid $tcl:$!\n";
210
211# Parse the splitter output.
212while (<PIPE>) {
213    # Start of a sub-experiment
214    /^#\s+Begin\s+Testbed\s+\((\w+)\)/ && do {
215        $ctb = $1;
216
217        # If we know the testbed, start collecting its sub experiment tcl
218        # description.  If not, warn the caller and ignore the configuration of
219        # this testbed.
220        if ($host{$ctb}) {
221            $allocated{$ctb}++; # Keep track of the testbeds allocated
222
223            unless (-d "$tmpdir/$ctb") {
224                mkdir("$tmpdir/$ctb") || die "Can't create $tmpdir/$ctb: $!";
225            }
226            $destfile = "$tmpdir/$ctb/$eid.$ctb.tcl";
227
228            open(FILE, ">$destfile") || die "Cannot open $destfile:$!\n";
229        }
230        else { 
231            warn "No such testbed $ctb\n";
232            $destfile = "";
233        }
234        next;
235    };
236
237    # End of that experiment
238    /^#\s+End\s+Testbed\s+\((\w+)\)/ && do {
239        # Simple syntax check and close out this experiment's tcl description
240        die "Mismatched testbed markers ($1, $ctb)\n" unless ($1 eq $ctb);
241        close(FILE);
242        $destfile = $ctb = "";
243        next;
244    };
245
246    # Beginning of a gateway set
247    /^#\s+Begin\s+gateways\s+\((\w+)\)/ && do {
248        $gateways = $1;
249        # If we've heard of this tb, create the config lines for it one at a
250        # time.
251        if ($allocated{$gateways}) {
252            # Just in case.  This directory should already have been created
253            # above.
254            unless (-d "$tmpdir/$gateways") {
255                mkdir("$tmpdir/$gateways") || 
256                    die "Can't create $tmpdir/$gateways: $!";
257            }
258        }
259        else {
260            warn "Gateways given (and ignored) for testbed not in use: " .
261                "$gateways\n";
262            $gateways = 0;
263        }
264        next;
265    };
266    /^#\s+End\s+gateways\s+\((\w+)\)/ && do {
267        die "Mismatched gateway markers ($1, $gateways)\n" 
268            unless !$gateways || $gateways == $1;
269        $gateways = 0;
270        next;
271    };
272    # Beginning of the hostnames list.  Collection is always in the hostnames
273    # file.
274    /^#\s+Begin\s+hostnames/ && do {
275        $destfile = "$tmpdir/hostnames";
276        open(FILE, ">$destfile") || die "Can't open $destfile:$!\n";
277        next;
278    };
279    # end of the hostnames list.
280    /^#\s+End\s+hostnames/ && do {
281        close(FILE);
282        $destfile = "";
283        next;
284    };
285
286    # Generate gateway configuration info, one file per line
287    $gateways && do {
288        chomp;
289        my($dtb, $myname, $desthost, $type) = split(" ", $_);
290        my($sdomain) = $domain{$gateways};      # domain for the source
291        my($ddomain) = $domain{$dtb};           # domain for the destination
292
293        $sdomain = ".$eid.$project{$gateways}$sdomain";
294        $ddomain = ".$eid.$project{$dtb}$ddomain";
295
296        # If either end of this link is in the master side of the testbed, that
297        # side is the active end. Otherwise the first testbed encountered in
298        # the file will be the active end.  The $active_end variable keeps
299        # track of those decisions
300        if ( $dtb eq $master ) { $active = "false"; }
301        elsif ($gateways eq $master ) { $active = "true"; }
302        elsif ( $active_end{"$dtb-$gateways"} ) { $active="false"; }
303        else { $active_end{"$gateways-$dtb"}++; $active = "true"; }
304
305        # Write out the file
306        open(GWCONFIG, ">$tmpdir/$gateways/$myname$sdomain.gw.conf") || 
307            die "can't open $tmpdir/%gateways/$myname$sdomain.gw.conf: $!\n";
308        print GWCONFIG "Active: $active\n";
309        print GWCONFIG "Type: $type\n";
310        print GWCONFIG "Peer: $desthost$ddomain\n";
311        print GWCONFIG "Pubkeys: /placeholder\n";
312        print GWCONFIG "Privkeys: /placeholder\n";
313        close(GWCONFIG);
314
315        #done processing gateway entry, ready for next line
316        next; 
317    };
318
319
320    next unless $destfile;  # Unidentified testbed, ignore config
321
322    # Substitute variables
323    s/GWTYPE/$gwtype{$ctb}/g;
324    s/GWIMAGE/$gwimage{$ctb}/g;
325    if ($ctb eq $master ) {
326        s/GWSTART/$mgwstart{$ctb}/g;
327        s/EXPSTART/$mexpstart{$ctb}/g;
328    }
329    else {
330        s/GWSTART/$gwstart{$ctb}/g;
331        s/EXPSTART/$expstart{$ctb}/g;
332    }
333    # XXX: oh is this bad
334    s#GWCONF#FEDDIR\`hostname\`.gw.conf#g;
335    s#FEDDIR#/proj/$project{$ctb}/exp/$eid/tmp/#g;
336    print FILE;
337}
338close(PIPE);
339die "No nodes in master testbed ($master)\n" unless $allocated{$master};
340
341exit(0) unless $startem;
342
343# Start up the slave sub-experiments first
344TESTBED:
345for $tb (keys %allocated) {
346    if ($tb ne $master) {
347        if (&start_segment($tb, $eid)) { $started{$tb}++; }
348        else { last TESTBED; }
349    }
350}
351
352# Now the master
353if (&start_segment($master, $eid)) { 
354    $started{$master}++;
355}
356
357# If any testbed failed, swap the rest out.
358if ( scalar(keys %started) != scalar(keys %allocated)) {
359    for $tb (keys %started) { &stop_segment($tb, $eid); }
360    print "Error starting experiment\n";
361    exit(1);
362}
363print "Experiment started\n";
364exit(0);    # set the exit value
365
366=pod
367
368=head1 NAME
369
370B<splitter.pl>
371
372=head1 SYNOPSIS
373
374B<splitter.pl> B<-e> I<experiment> B<-m> I<master_testbed> [B<-n>]
375    [B<-d> F<script_dir>] [B<-c> F<config_file>] [B<-f> F<experiment_tcl>]
376    [F<experiment_tcl>]
377
378=head1 DESCRIPTION
379
380B<splitter.pl> invokes the DETER experiment parser to split an annotated
381experiment into multiple sub-experments and instantiates the sub-experiments on
382their intended testbeds.  Annotation is accomplished using the
383tb-set-node-testbed command, added to the parser.
384
385The testbed labels are meaningful based on their presence in the testbeds file.
386that file can be specified with the B<-c> option, and defaults to
387F<./testbeds>.  The syntax is described below.
388
389The expreriment is split out into one experiment description per testbed in the
390current directory named as F<experiment.testbed.tcl> where the experiment is
391the argument to B<-e> and the testbed is the tb-set-node-testbed parameter for
392the nodes in the file.
393
394If the B<-n> option is absent the sub-experiments are then instantiated on
395their testbeds.  (Here B<-n> is analogous to its use in L<make(1)>).
396Per-testbed parameters are set in the configuration file.  Sub-experiments on
397slave testbeds are instantiated in a random order, but the master testbed is
398currently instantiated last.
399
400Scripts to start federation are copied into the local experiment's tmp file -
401e.g., F</proj/DETER/exp/simple-split/tmp>.  These are taken from the directory
402given by the B<-d> option.
403
404If any sub-experiment fails to instantiate, the other sub-exeriments are
405swapped out.
406
407=head2 Configuration file
408
409The configuration file (F<./testbeds> unless overridden by B<-c>) is a
410colon-separated set of parameters keyed by testbed name.  The fields, in order,
411are:
412
413=over 5
414
415=item name
416
417The testbed to which this line of parameters applies.
418
419=item user
420
421The user under which to make requests to this testbed.  The user running
422B<splitter.pl> must be able to authenicate as this user under L<ssh(1)> to this
423testbed.
424
425=item host
426
427The host name of the testbed's ops node.  The user calling B<splitter.pl> must
428be able to execute commands on this host via L<ssh(1)>.
429
430=item domain
431
432The domain of nodes in this testbed (including the ops host).
433
434=item project
435
436The project under which to instantiate sub-experiments on this testbed.
437
438=item gateway type
439
440The node type for inter-testbed gateway nodes on this testbed.
441
442=item experiment start (slave)
443
444The start command to run on experimental nodes when this testbed is used as a
445slave.
446
447=item gateway start (slave)
448
449The start command to run on gateway nodes when this testbed is used as a
450slave.
451
452=item experiment start (master)
453
454The start command to run on experimental nodes when this testbed is used as a
455master.
456
457=item gateway start (master)
458
459The start command to run on gateway nodes when this testbed is used as a
460master.
461
462=item gateway image
463
464The disk image to be loaded on a gateway node on this testbed.
465
466=back
467
468The parsing of the configuration is extremely simple.  Colons separate each
469field and there is n provision for escaping them at this time.
470
471=head1 ENVIRONMENT
472
473B<splitter.pl> does not directly make use of environment variables, but calls
474out to L<ssh(1)> and (indirectly) to L<sh(1)>, which may be influenced by the
475environment.
476
477=head1 SEE ALSO
478
479L<sh(1)>, L<ssh(1)>
480
481=cut
Note: See TracBrowser for help on using the repository browser.