Changeset 527321c for fedkit/splitter.pl


Ignore:
Timestamp:
Sep 22, 2007 8:47:59 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:
5f1cd41
Parents:
b814529
Message:

remove global hashes

File:
1 edited

Legend:

Unmodified
Added
Removed

  • fedkit/splitter.pl

    rb814529 r527321c  
    99use File::Copy;
    1010
    11 my(@scripts) = ("federate.sh", "smbmount.pl", "make_hosts", "fed-tun.pl");
    12 my($local_script_dir) = ".";
     11my @scripts = ("federate.sh", "smbmount.pl", "make_hosts", "fed-tun.pl");
     12my $local_script_dir = ".";
    1313my($pid, $gid);                 # Process and group IDs for calling parse.tcl
    14 my($splitter_config);           # Configuration file
    15 my($debug);                     # True if thecalled in debug mode
    16 my($verbose);                   # True for extra progress reports
    17 my($startem);                   # If true, start the sub-experiments
    18 my($eid);                       # Experiment ID
    19 my($tcl);                       # The experiment description (topology file)
    20 my($master);                    # Master testbed
    21 my($tmpdir);                    # tmp files
    22 my($tb_config);                 # testbed configurations
    23 my($smb_share);                 # Share to mount from the master
    24 my($project_user);              # User to mount project dirs as
     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
    2525my($gw_pubkey, $gw_pubkey_base);# Connector pubkey (full path & basename)
    2626my($gw_secretkey, $gw_secretkey_base);# Connector secret key (full path &
    2727                                # basename)
    28 my($tcl_splitter);              # tcl program to split experiments
     28my $tcl_splitter;               # tcl program to split experiments
    2929                                # (changed during devel)
    30 my($tclsh);                     # tclsh to call directly (changed during devel)
    31 my(@tarfiles);                  # Tarfiles in use by this experiment
    32 my(%opts);                      # Parsed options
    33 
    34 # Per testbed parameters parsed from testbeds file
    35 my(%host);                      # ops node of the testbed
    36 my(%user);                      # User to operate as
    37 my(%domain);                    # testbed DNS domain
    38 my(%project);                   # Remote project to instantiate undere
    39 my(%gwtype);                    # Node type for connector
    40 my(%expstart);                  # startcmd for experimental nodes (slave)
    41 my(%gwstart);                   # startcmd for connector nodes (slave)
    42 my(%mexpstart);                 # startcmd for experimental nodes (master)
    43 my(%mgwstart);                  # startcmd for connector nodes (master)
    44 my(%gwimage);                   # connector image name
    45 my(%fs);                        # testbed fs node
    46 my(%boss);                      # testbed boss node
    47 my(%tun);                       # XXX: should disappear configure tunnel?
    48 
     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. 
    4942
    5043# Parse the config file.  The format is a colon-separated parameter name
    … …  
    8578
    8679sub parse_testbeds {
    87     my($file) = @_;                 # Testbeds file
    88     my($fh) = new IO::File($file);  # Testbeds filehandle
    89     my($tb);                        # Current testbed
     80    my($file, $tbparams) = @_;      # Testbeds file and parameter hash
     81    my $fh = new IO::File($file);  # Testbeds filehandle
     82    my $tb;                         # Current testbed
    9083    # Convert attribute in the file to global variable name.  XXX: Again, this
    9184    # needs to be a 2-level hash
    92     my(%attr_to_hash) = (
     85    my %attr_to_hash = (
    9386        "opsnode" => "host",
    9487        "user" => "user",
    … …  
    117110        /^\s*\[(.*)\]/ && do {
    118111            $tb = $1;
     112            $tbparams->{$tb} = {} unless $tbparams->{$tb};
    119113            next;
    120114        };
    … …  
    126120                next;
    127121            }
    128             my($key) = $1;
     122            my $key = $1;
    129123            $key =~ tr/A-Z/a-z/;
    130             my($var) = $attr_to_hash{$key};
    131 
    132             # XXX: The eval is scary.  This will become a 2-level hash.
    133             if ($var) { eval "\$$var\{$tb\} = \"$2\";"; }
     124            my $var = $attr_to_hash{$key};
     125
     126            if ($var) { $tbparams->{$tb}->{$var} = $2; }
    134127            else { warn "Unknown keyword $key in $file\n"; }
    135128
    … …  
    218211}
    219212
    220 
    221 
    222 
    223213# Start a sub section of the experiment on a given testbed.  The testbed and
    224214# the user to start the experiment as are pulled from the global per-testbed
    225 # hash, as is the project name on the remote testbed.  Parameters are the
    226 # testbed and the experiment id.  Configuration files are scp-ed over to the
    227 # target testbed from the global $tmpdir/$tb directory.  Then the current state
    228 # of the experiment determined using expinfo.  From that state, the experiment
    229 # is either created, modified or spapped in.  If everything succeeds, true is
    230 # returned.  If the global verbose is set progress messages are printed.
     215# hash, passed in as $tbparams, as is the project name on the remote testbed.
     216# Parameters are the testbed and the experiment id.  Configuration files are
     217# scp-ed over to the target testbed from the global $tmpdir/$tb directory.
     218# Then the current state of the experiment determined using expinfo.  From that
     219# state, the experiment is either created, modified or spapped in.  If
     220# everything succeeds, true is returned.  If the global verbose is set progress
     221# messages are printed.
    231222sub start_segment {
    232     my($tb, $eid) = @_;                     # testbed and experiment ID
    233     my($host) = "$host{$tb}$domain{$tb}";   # Host name of remote ops (FQDN)
    234     my($user) = $user{$tb};                 # user to pass to ssh
    235     my($pid) = $project{$tb};               # remote project to start the
     223    my($tb, $eid, $tbparams) = @_;          # testbed, experiment ID, and
     224                                            # per-testbed parameters
     225    my $host =                              # Host name of remote ops (FQDN)
     226        $tbparams->{$tb}->{'host'} . $tbparams->{$tb}->{'domain'};
     227    my $user = $tbparams->{$tb}->{'user'};  # user to pass to ssh
     228    my $pid = $tbparams->{$tb}->{'project'};# remote project to start the
    236229                                            # experiment under
    237     my($tclfile) = "./$eid.$tb.tcl";        # Local tcl file with the
     230    my $tclfile = "./$eid.$tb.tcl";         # Local tcl file with the
    238231                                            # sub-experiment
    239     my($proj_dir) = "/proj/$pid/exp/$eid/tmp";  # Where to stash federation stuff
    240     my($tarfiles_dir) = "/proj/$pid/tarfiles/$eid";  # Where to stash tarfiles
    241     my($to_hostname) = "$proj_dir/hosts";   # remote hostnames file
    242     my($state);                             # State of remote experiment
    243     my($status) = new IO::Pipe;             # The pipe to get status
     232    my $proj_dir = "/proj/$pid/exp/$eid/tmp";  # Where to stash federation stuff
     233    my $tarfiles_dir = "/proj/$pid/tarfiles/$eid";  # Where to stash tarfiles
     234    my $to_hostname = "$proj_dir/hosts";    # remote hostnames file
     235    my $state;                              # State of remote experiment
     236    my $status = new IO::Pipe;              # The pipe to get status
    244237
    245238    # Determine the status of the remote experiment
    … …  
    352345# start_segment, though much simpler.
    353346sub stop_segment {
    354     my($tb, $eid) = @_;
    355     my($user) = "$user{$tb}";
    356     my($host) = "$host{$tb}$domain{$tb}";
    357     my($pid) = $project{$tb};
     347    my($tb, $eid, $tbparams) = @_;          # testbed, experiment ID and
     348                                            # per-testbed parameters
     349    my $user = $tbparams->{$tb}->{'user'};  # testbed user
     350    my $host =                              # Ops node
     351        $tbparams->{$tb}->{'host'} . $tbparams->{$tb}->{'domain'};
     352    my $pid = $tbparams->{$tb}->{'project'};# testbed project
    358353
    359354    print "Stopping $eid on $tb\n" if $verbose;
    … …  
    421416
    422417if ($opts{'N'} ) {
    423     &parse_testbeds($tb_config) ||
     418    &parse_testbeds($tb_config, $tbparams) ||
    424419        die "Cannot testbed congfigurations from $tb_config: $!\n";
    425420}
    … …  
    433428        my($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss,
    434429            $tun) = split(":", $_);
    435         $host{$tb} = $h;
    436         $user{$tb} = $u;
    437         $domain{$tb} = $d;
    438         $project{$tb} = $p;
    439         $gwtype{$tb} = $t;
    440         $expstart{$tb} = $es;
    441         $gwstart{$tb} = $gs;
    442         $mexpstart{$tb} = $mes;
    443         $mgwstart{$tb} = $mgs;
    444         $gwimage{$tb} = $i;
    445         $fs{$tb} = $fs;
    446         $boss{$tb} = $boss;
    447         $tun{$tb} = $tun;
     430        $tbparams->{$tb}->{'host'} = $h;
     431        $tbparams->{$tb}->{'user'} = $u;
     432        $tbparams->{$tb}->{'domain'} = $d;
     433        $tbparams->{$tb}->{'project'} = $p;
     434        $tbparams->{$tb}->{'gwtype'} = $t;
     435        $tbparams->{$tb}->{'expstart'} = $es;
     436        $tbparams->{$tb}->{'gwstart'} = $gs;
     437        $tbparams->{$tb}->{'mexpstart'} = $mes;
     438        $tbparams->{$tb}->{'mgwstart'} = $mgs;
     439        $tbparams->{$tb}->{'gwimage'} = $i;
     440        $tbparams->{$tb}->{'fs'} = $fs;
     441        $tbparams->{$tb}->{'boss'} = $boss;
     442        $tbparams->{$tb}->{'tun'} = $tun;
    448443
    449444        # Make sure the domain starts with a period
    450         $domain{$tb} = ".$domain{$tb}" unless $domain{$tb} =~ /^\./;
     445        $tbparams->{$tb}->{'domain'} = "." . $tbparams->{$tb}->{'domain'}
     446            unless $tbparams->{$tb}->{'domain'} =~ /^\./;
    451447    }
    452448    $conf->close();
    … …  
    460456
    461457# Parsing variables
    462 my($ctb);                       # Current testbed
    463 my(%allocated);                 # If allocated{$tb} > 0, $tb is in use
    464 my($destfile);                  # File that the sub-experiment tcl file is
     458my $ctb;                        # Current testbed
     459my %allocated;                  # If allocated{$tb} > 0, $tb is in use
     460my $destfile;                   # File that the sub-experiment tcl file is
    465461                                # being written to, or "" if none.  Also used
    466462                                # for hostnames file.
    467 my($gateways);                  # when gateway lists are being processed this
     463my $gateways;                   # when gateway lists are being processed this
    468464                                # is the testbed whose gateways are being
    469465                                # gathered.
    470 my($control_gateway);           # Control net gateway for the current testbed
    471 my(%active_end);                # If active_end{"a-b"} > 0 then a is the active
     466my $control_gateway;            # Control net gateway for the current testbed
     467my %active_end;                 # If active_end{"a-b"} > 0 then a is the active
    472468                                # end of the a <-> b connector pair.
    473469
    … …  
    482478        # description.  If not, warn the caller and ignore the configuration of
    483479        # this testbed.
    484         if ($host{$ctb}) {
     480        if ($tbparams->{$ctb}) {
    485481            $allocated{$ctb}++; # Keep track of the testbeds allocated
    486482
    … …  
    535531        if ($control_gateway ) {
    536532            # Client config
    537             my($cc) = new IO::File(">$tmpdir/$gateways/client.conf");
     533            my $cc = new IO::File(">$tmpdir/$gateways/client.conf");
    538534            die "Can't open $tmpdir/$gateways/client.conf: $!\n" unless $cc;
    539535            print $cc "ControlGateway: $control_gateway\n";
    … …  
    565561        chomp;
    566562        my($dtb, $myname, $desthost, $type) = split(" ", $_);
    567         my($sdomain) = $domain{$gateways};      # domain for the source
    568         my($ddomain) = $domain{$dtb};           # domain for the destination
    569         my($sproject) = $project{$gateways};    # Project of the destination
    570         my($active);                            # Is this the active side of
     563
     564        # Many of these are to simplify print statements
     565        my $sdomain =                           # domain for the source
     566            $tbparams->{$gateways}->{'domain'};
     567        my $ddomain =                           # domain for the destination
     568            $tbparams->{$dtb}->{'domain'};
     569        my $sproject =                          # Project of the destination
     570            $tbparams->{$gateways}->{'project'};
     571        my $fs =                                # Master fs node (FQDN)
     572            $tbparams->{$master}->{'fs'} .  $tbparams->{$master}->{'domain'};
     573        my $boss =                              # Master boss node (FQDN)
     574            $tbparams->{$master}->{'boss'} .  $tbparams->{$master}->{'domain'};
     575        my $remote_script_dir =                 # Remote fed script location
     576            "/proj/" . $tbparams->{$dtb}->{'project'} . "/exp/$eid/tmp";
     577        my $active;                             # Is this the active side of
    571578                                                # the connector?
    572579
    573         $sdomain = ".$eid.$project{$gateways}$sdomain";
    574         $ddomain = ".$eid.$project{$dtb}$ddomain";
    575 
    576         my($conf_file) = "$myname$sdomain.gw.conf";
     580        $sdomain = ".$eid." . $tbparams->{$gateways}->{'project'} . "$sdomain";
     581        $ddomain = ".$eid." . $tbparams->{$dtb}->{'project'} . "$ddomain";
     582
     583        my $conf_file = "$myname$sdomain.gw.conf";
    577584        # translate to lower case so the `hostname` hack for specifying
    578585        # configuration files works.
    … …  
    597604
    598605        print $gwconfig "Active: $active\n";
    599         print $gwconfig "TunnelCfg: $tun{$gateways}\n";
    600         print $gwconfig "BossName: $boss{$master}$domain{$master}\n";
    601         print $gwconfig "FsName: $fs{$master}$domain{$master}\n";
     606        print $gwconfig "TunnelCfg: " . $tbparams->{$gateways}->{'tun'} . "\n";
     607        print $gwconfig "BossName: $boss\n";
     608        print $gwconfig "FsName: $fs\n";
    602609        print $gwconfig "Type: $type\n";
    603         print $gwconfig "RemoteScriptDir: /proj/$project{$dtb}/exp/$eid/tmp\n";
     610        print $gwconfig "RemoteScriptDir: $remote_script_dir\n";
    604611        print $gwconfig "Peer: $desthost$ddomain\n";
    605612        print $gwconfig "Pubkeys: " .
    … …  
    636643
    637644    next unless $destfile;  # Unidentified testbed, ignore config
     645    # local copies that can be used in the substitutions below
     646    my $gwtype = $tbparams->{$ctb}->{'gwtype'};
     647    my $gwimage = $tbparams->{$ctb}->{'gwimage'};
     648    my $mgwstart = $tbparams->{$ctb}->{'mgwstart'};
     649    my $mexpstart = $tbparams->{$ctb}->{'mexpstart'};
     650    my $gwstart = $tbparams->{$ctb}->{'gwstart'};
     651    my $expstart = $tbparams->{$ctb}->{'expstart'};
     652    my $project = $tbparams->{$ctb}->{'project'};
    638653
    639654    # Substitute variables
    640     s/GWTYPE/$gwtype{$ctb}/g;
    641     s/GWIMAGE/$gwimage{$ctb}/g;
     655    s/GWTYPE/$gwtype/g;
     656    s/GWIMAGE/$gwimage/g;
    642657    if ($ctb eq $master ) {
    643         s/GWSTART/$mgwstart{$ctb}/g;
    644         s/EXPSTART/$mexpstart{$ctb}/g;
     658        s/GWSTART/$mgwstart/g;
     659        s/EXPSTART/$mexpstart/g;
    645660    }
    646661    else {
    647         s/GWSTART/$gwstart{$ctb}/g;
    648         s/EXPSTART/$expstart{$ctb}/g;
     662        s/GWSTART/$gwstart/g;
     663        s/EXPSTART/$expstart/g;
    649664    }
    650665    # XXX: oh is this bad
    651666    s#GWCONF#FEDDIR\`hostname\`.gw.conf#g;
    652     s#PROJDIR#/proj/$project{$ctb}/#g;
     667    s#PROJDIR#/proj/$project/#g;
    653668    s#EID#$eid#g;
    654     s#FEDDIR#/proj/$project{$ctb}/exp/$eid/tmp/#g;
     669    s#FEDDIR#/proj/$project/exp/$eid/tmp/#g;
    655670    print FILE;
    656671}
    … …  
    670685exit(0) unless $startem;
    671686
    672 my(%started);               # If $started{$tb} then $tb successfully started
     687my %started;                # If $started{$tb} then $tb successfully started
    673688
    674689# Start up the slave sub-experiments first
    … …  
    676691for my $tb  (keys %allocated) {
    677692    if ($tb ne $master) {
    678         if (&start_segment($tb, $eid)) { $started{$tb}++; }
     693        if (&start_segment($tb, $eid, $tbparams)) { $started{$tb}++; }
    679694        else { last TESTBED; }
    680695    }
    … …  
    682697
    683698# Now the master
    684 if (&start_segment($master, $eid)) {
     699if (&start_segment($master, $eid, $tbparams)) {
    685700    $started{$master}++;
    686701}
    … …  
    688703# If any testbed failed, swap the rest out.
    689704if ( scalar(keys %started) != scalar(keys %allocated)) {
    690     for my $tb (keys %started) { &stop_segment($tb, $eid); }
     705    for my $tb (keys %started) { &stop_segment($tb, $eid, $tbparams); }
    691706    print "Error starting experiment\n";
    692707    exit(1);
Note: See TracChangeset for help on using the changeset viewer.