Changeset b814529 for fedkit/splitter.pl

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:

• fedkit/splitter.pl (modified) (13 diffs)

fedkit/splitter.pl

@@ -1 +1 @@
 #!/usr/bin/perl
+
+use strict;
 
 use Getopt::Std;
@@ -7 +9 @@
 use File::Copy;
 
-@scripts = ("federate.sh", "smbmount.pl", "make_hosts", "fed-tun.pl");
-$local_script_dir = ".";
+my(@scripts) = ("federate.sh", "smbmount.pl", "make_hosts", "fed-tun.pl");
+my($local_script_dir) = ".";
+my($pid, $gid);                 # Process and group IDs for calling parse.tcl
+my($splitter_config);           # Configuration file
+my($debug);                     # True if thecalled in debug mode
+my($verbose);                   # True for extra progress reports
+my($startem);                   # If true, start the sub-experiments
+my($eid);                       # Experiment ID
+my($tcl);                       # The experiment description (topology file)
+my($master);                    # Master testbed
+my($tmpdir);                    # tmp files
+my($tb_config);                 # testbed configurations
+my($smb_share);                 # Share to mount from the master
+my($project_user);              # User to mount project dirs as
+my($gw_pubkey, $gw_pubkey_base);# Connector pubkey (full path & basename)
+my($gw_secretkey, $gw_secretkey_base);# Connector secret key (full path & 
+                                # basename)
+my($tcl_splitter);              # tcl program to split experiments
+                                # (changed during devel)
+my($tclsh);                     # tclsh to call directly (changed during devel)
+my(@tarfiles);                  # Tarfiles in use by this experiment
+my(%opts);                      # Parsed options
+
+# Per testbed parameters parsed from testbeds file
+my(%host);                      # ops node of the testbed
+my(%user);                      # User to operate as 
+my(%domain);                    # testbed DNS domain
+my(%project);                   # Remote project to instantiate undere
+my(%gwtype);                    # Node type for connector
+my(%expstart);                  # startcmd for experimental nodes (slave)
+my(%gwstart);                   # startcmd for connector nodes (slave)
+my(%mexpstart);                 # startcmd for experimental nodes (master)
+my(%mgwstart);                  # startcmd for connector nodes (master)
+my(%gwimage);                   # connector image name
+my(%fs);                        # testbed fs node
+my(%boss);                      # testbed boss node
+my(%tun);                       # XXX: should disappear configure tunnel?
+
 
 # Parse the config file.  The format is a colon-separated parameter name
@@ -202 +240 @@
     my($tarfiles_dir) = "/proj/$pid/tarfiles/$eid";  # Where to stash tarfiles
     my($to_hostname) = "$proj_dir/hosts";   # remote hostnames file
+    my($state);                             # State of remote experiment
     my($status) = new IO::Pipe;             # The pipe to get status
 
@@ -337 +376 @@
 
 &parse_config("$splitter_config", \%opts) || 
-    die "Cannot read config file $splitter_conf: $!\n";
+    die "Cannot read config file $splitter_config: $!\n";
 
 
@@ -374 +413 @@
 
 # Validate scripts directory
-for $s (@scripts) {
+for my $s (@scripts) {
     die "$local_script_dir/$s not in local script directory. Try -d\n"
         unless -r "$local_script_dir/$s";
@@ -387 +426 @@
 else {
     # Read a hash of per-testbed parameters from the local configurations.
-    $conf = new IO::File($tb_config) || 
+    my($conf) = new IO::File($tb_config) || 
         die "can't read testbed configutions from $tb_config: $!\n";
     while (<$conf>) {
         next if /^#/;
         chomp;
-        ($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss, $tun) = 
-            split(":", $_);
+        my($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss,
+            $tun) = split(":", $_);
         $host{$tb} = $h;
         $user{$tb} = $u;
@@ -415 +454 @@
 
 # Open a pipe to the splitter program and start it parsing the experiments
-$pipe = new IO::Pipe;
+my($pipe) = new IO::Pipe;
 # NB no more -p call on parse call.
 $pipe->reader("$tclsh $tcl_splitter -s -m $master  $pid $gid $eid $tcl") || 
     die "Cannot execute $tclsh $tcl_splitter -s -m $master $pid $gid $eid $tcl:$!\n";
+
+# Parsing variables
+my($ctb);                       # Current testbed
+my(%allocated);                 # If allocated{$tb} > 0, $tb is in use
+my($destfile);                  # File that the sub-experiment tcl file is
+                                # being written to, or "" if none.  Also used
+                                # for hostnames file.
+my($gateways);                  # when gateway lists are being processed this
+                                # is the testbed whose gateways are being
+                                # gathered.
+my($control_gateway);           # Control net gateway for the current testbed
+my(%active_end);                # If active_end{"a-b"} > 0 then a is the active
+                                # end of the a <-> b connector pair.
 
 # Parse the splitter output.  This loop creates the sub experiments, gateway
@@ -483 +535 @@
         if ($control_gateway ) {
             # Client config
-            $cc = new IO::File(">$tmpdir/$gateways/client.conf");
+            my($cc) = new IO::File(">$tmpdir/$gateways/client.conf");
             die "Can't open $tmpdir/$gateways/client.conf: $!\n" unless $cc;
             print $cc "ControlGateway: $control_gateway\n";
@@ -516 +568 @@
         my($ddomain) = $domain{$dtb};           # domain for the destination
         my($sproject) = $project{$gateways};    # Project of the destination
+        my($active);                            # Is this the active side of
+                                                # the connector?
 
         $sdomain = ".$eid.$project{$gateways}$sdomain";
@@ -539 +593 @@
 
         # Write out the file
-        $gwconfig= new IO::File(">$tmpdir/$gateways/$conf_file")|| 
+        my($gwconfig) = new IO::File(">$tmpdir/$gateways/$conf_file")|| 
             die "can't open $tmpdir/$gateways/$conf_file: $!\n";
 
@@ -604 +658 @@
 die "No nodes in master testbed ($master)\n" unless $allocated{$master};
 
-for $t (@tarfiles) {
+for my $t  (@tarfiles) {
     die "tarfile '$t' unreadable: $!\n" unless -r $t;
     unless (-d "$tmpdir/tarfiles") {
@@ -616 +670 @@
 exit(0) unless $startem;
 
+my(%started);               # If $started{$tb} then $tb successfully started
+
 # Start up the slave sub-experiments first
 TESTBED:
-for $tb (keys %allocated) {
+for my $tb  (keys %allocated) {
     if ($tb ne $master) {
         if (&start_segment($tb, $eid)) { $started{$tb}++; }
@@ -632 +688 @@
 # If any testbed failed, swap the rest out.
 if ( scalar(keys %started) != scalar(keys %allocated)) {
-    for $tb (keys %started) { &stop_segment($tb, $eid); }
+    for my $tb (keys %started) { &stop_segment($tb, $eid); }
     print "Error starting experiment\n";
     exit(1);