Changeset b814529 for fedkit


Ignore:
Timestamp:
Sep 21, 2007 10:11:21 PM (17 years ago)
Author:
Ted Faber <faber@…>
Branches:
axis_example, compt_changes, info-ops, master, version-1.30, version-2.00, version-3.01, version-3.02
Children:
527321c
Parents:
e4436a6
Message:

use strict in splitter. Thank God I won't need to learn to spell.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • fedkit/splitter.pl

    re4436a6 rb814529  
    11#!/usr/bin/perl
     2
     3use strict;
    24
    35use Getopt::Std;
     
    79use File::Copy;
    810
    9 @scripts = ("federate.sh", "smbmount.pl", "make_hosts", "fed-tun.pl");
    10 $local_script_dir = ".";
     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
     34# Per testbed parameters parsed from testbeds file
     35my(%host);                      # ops node of the testbed
     36my(%user);                      # User to operate as
     37my(%domain);                    # testbed DNS domain
     38my(%project);                   # Remote project to instantiate undere
     39my(%gwtype);                    # Node type for connector
     40my(%expstart);                  # startcmd for experimental nodes (slave)
     41my(%gwstart);                   # startcmd for connector nodes (slave)
     42my(%mexpstart);                 # startcmd for experimental nodes (master)
     43my(%mgwstart);                  # startcmd for connector nodes (master)
     44my(%gwimage);                   # connector image name
     45my(%fs);                        # testbed fs node
     46my(%boss);                      # testbed boss node
     47my(%tun);                       # XXX: should disappear configure tunnel?
     48
    1149
    1250# Parse the config file.  The format is a colon-separated parameter name
     
    202240    my($tarfiles_dir) = "/proj/$pid/tarfiles/$eid";  # Where to stash tarfiles
    203241    my($to_hostname) = "$proj_dir/hosts";   # remote hostnames file
     242    my($state);                             # State of remote experiment
    204243    my($status) = new IO::Pipe;             # The pipe to get status
    205244
     
    337376
    338377&parse_config("$splitter_config", \%opts) ||
    339     die "Cannot read config file $splitter_conf: $!\n";
     378    die "Cannot read config file $splitter_config: $!\n";
    340379
    341380
     
    374413
    375414# Validate scripts directory
    376 for $s (@scripts) {
     415for my $s (@scripts) {
    377416    die "$local_script_dir/$s not in local script directory. Try -d\n"
    378417        unless -r "$local_script_dir/$s";
     
    387426else {
    388427    # Read a hash of per-testbed parameters from the local configurations.
    389     $conf = new IO::File($tb_config) ||
     428    my($conf) = new IO::File($tb_config) ||
    390429        die "can't read testbed configutions from $tb_config: $!\n";
    391430    while (<$conf>) {
    392431        next if /^#/;
    393432        chomp;
    394         ($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss, $tun) =
    395             split(":", $_);
     433        my($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss,
     434            $tun) = split(":", $_);
    396435        $host{$tb} = $h;
    397436        $user{$tb} = $u;
     
    415454
    416455# Open a pipe to the splitter program and start it parsing the experiments
    417 $pipe = new IO::Pipe;
     456my($pipe) = new IO::Pipe;
    418457# NB no more -p call on parse call.
    419458$pipe->reader("$tclsh $tcl_splitter -s -m $master  $pid $gid $eid $tcl") ||
    420459    die "Cannot execute $tclsh $tcl_splitter -s -m $master $pid $gid $eid $tcl:$!\n";
     460
     461# Parsing variables
     462my($ctb);                       # Current testbed
     463my(%allocated);                 # If allocated{$tb} > 0, $tb is in use
     464my($destfile);                  # File that the sub-experiment tcl file is
     465                                # being written to, or "" if none.  Also used
     466                                # for hostnames file.
     467my($gateways);                  # when gateway lists are being processed this
     468                                # is the testbed whose gateways are being
     469                                # gathered.
     470my($control_gateway);           # Control net gateway for the current testbed
     471my(%active_end);                # If active_end{"a-b"} > 0 then a is the active
     472                                # end of the a <-> b connector pair.
    421473
    422474# Parse the splitter output.  This loop creates the sub experiments, gateway
     
    483535        if ($control_gateway ) {
    484536            # Client config
    485             $cc = new IO::File(">$tmpdir/$gateways/client.conf");
     537            my($cc) = new IO::File(">$tmpdir/$gateways/client.conf");
    486538            die "Can't open $tmpdir/$gateways/client.conf: $!\n" unless $cc;
    487539            print $cc "ControlGateway: $control_gateway\n";
     
    516568        my($ddomain) = $domain{$dtb};           # domain for the destination
    517569        my($sproject) = $project{$gateways};    # Project of the destination
     570        my($active);                            # Is this the active side of
     571                                                # the connector?
    518572
    519573        $sdomain = ".$eid.$project{$gateways}$sdomain";
     
    539593
    540594        # Write out the file
    541         $gwconfig= new IO::File(">$tmpdir/$gateways/$conf_file")||
     595        my($gwconfig) = new IO::File(">$tmpdir/$gateways/$conf_file")||
    542596            die "can't open $tmpdir/$gateways/$conf_file: $!\n";
    543597
     
    604658die "No nodes in master testbed ($master)\n" unless $allocated{$master};
    605659
    606 for $t (@tarfiles) {
     660for my $t (@tarfiles) {
    607661    die "tarfile '$t' unreadable: $!\n" unless -r $t;
    608662    unless (-d "$tmpdir/tarfiles") {
     
    616670exit(0) unless $startem;
    617671
     672my(%started);               # If $started{$tb} then $tb successfully started
     673
    618674# Start up the slave sub-experiments first
    619675TESTBED:
    620 for $tb (keys %allocated) {
     676for my $tb (keys %allocated) {
    621677    if ($tb ne $master) {
    622678        if (&start_segment($tb, $eid)) { $started{$tb}++; }
     
    632688# If any testbed failed, swap the rest out.
    633689if ( scalar(keys %started) != scalar(keys %allocated)) {
    634     for $tb (keys %started) { &stop_segment($tb, $eid); }
     690    for my $tb (keys %started) { &stop_segment($tb, $eid); }
    635691    print "Error starting experiment\n";
    636692    exit(1);
Note: See TracChangeset for help on using the changeset viewer.