Changeset fe459d0 for fedkit

Timestamp:

Sep 20, 2007 6:38:28 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:

b68f597

Parents:

d501c38

Message:

better startup beginnings of new testbeds format (off for now)

File:

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

fedkit/splitter.pl

@@ -32 +32 @@
             $key =~ tr/A-Z/a-z/;
             $href->{$key} = $2;
+            next;
+        };
+        warn "Unparasble line in $file: $_\n";
+    }
+    $fh->close();   # It will close when it goes out of scope, but...
+    return 1;
+}
+
+# Parse an easier-to-read testbeds file (the original was comma-separated
+# unadorned strings).  The format is a testbed scope as [testbed] followed by
+# the colon-separated attribute-value pairs for the testbed.  Right now these
+# go into a set of global hashes indexed by testbed, but that should probably
+# change.
+
+sub parse_testbeds {
+    my($file) = @_;                 # Testbeds file
+    my($fh) = new IO::File($file);  # Testbeds filehandle
+    my($tb);                        # Current testbed
+    # Convert attribute in the file to global variable name.  XXX: Again, this
+    # needs to be a 2-level hash
+    my(%attr_to_hash) = (
+        "opsnode" => "host",
+        "user" => "user",
+        "domain" => "domain",
+        "project" => "project",
+        "connectortype" => "gwtype",
+        "slavenodestartcmd" => "expstart",
+        "slaveconnectorstartcmd" => "gwstart",
+        "masternodestartcmd" => "mexpstart",
+        "masterconnectorstartcmd" => "mgwstart",
+        "connectorimage" => "gwimage",
+        "fileserver" => "fs",
+        "boss" => "boss",
+        "tunnelcfg" => "tun"
+    );
+
+
+    unless ($fh) {
+        warn "Can't open $file: $!\n";
+        return 0;
+    }
+
+    while (<$fh>) {
+        next if /^\s*#/ || /^\s*$/;     # Skip comments & blanks
+        chomp;
+        /^\s*\[(.*)\]/ && do {
+            $tb = $1;
+            next;
+        };
+
+        /^([^:]+):\s*(.*)/ && do {
+            unless ($tb) {
+                warn "Ignored attribute definition before testbed " .
+                    "defined in $file: $_\n";
+                next;
+            }
+            my($key) = $1; 
+            $key =~ tr/A-Z/a-z/;
+            my($var) = $attr_to_hash{$key};
+
+            # XXX: The eval is scary.  This will become a 2-level hash.
+            if ($var) { eval "\$$var\{$tb\} = \"$2\";"; }
+            else { warn "Unknown keyword $key in $file\n"; }
+
             next;
         };
@@ -201 +265 @@
     # the configuration files and scripts into the new experiment directories.
     if ($state eq "none") {
-        print "Creating $exp on $tb\n" if $verbose;
-        &ssh_cmd($user, $host, "/usr/testbed/bin/startexp -f -w -p " . 
+        print "Creating $eid on $tb\n" if $verbose;
+        &ssh_cmd($user, $host, "/usr/testbed/bin/startexp -i -f -w -p " . 
             "$pid -e $eid $tclfile", "startexp") || return 0;
         print "Transferring federation support files to $tb\n" if $verbose;
@@ -245 +309 @@
                                     # keep our changes to the parser minimal.
 # Argument processing.
-getopts('c:f:ndv', \%opts);
+getopts('c:f:ndvN', \%opts);
 $splitter_config = $opts{'c'} || "./splitter.conf";
 $debug = $opts{'d'};
@@ -295 +359 @@
 die "Must supply file, master and experiment" unless $master && $tcl && $eid;
 
-# Read a hash of per-testbed parameters from the local configurations.
-$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(":", $_);
-    $host{$tb} = $h;
-    $user{$tb} = $u;
-    $domain{$tb} = $d;
-    $project{$tb} = $p;
-    $gwtype{$tb} = $t;
-    $expstart{$tb} = $es;
-    $gwstart{$tb} = $gs;
-    $mexpstart{$tb} = $mes;
-    $mgwstart{$tb} = $mgs;
-    $gwimage{$tb} = $i;
-    $fs{$tb} = $fs;
-    $boss{$tb} = $boss;
-    $tun{$tb} = $tun;
-
-    # Make sure the domain starts with a period
-    $domain{$tb} = ".$domain{$tb}" unless $domain{$tb} =~ /^\./;
-}
-$conf->close();
+if ($opts{'N'} ) {
+    &parse_testbeds($tb_config) ||
+        die "Cannot testbed congfigurations from $tb_config: $!\n";
+}
+else {
+    # Read a hash of per-testbed parameters from the local configurations.
+    $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(":", $_);
+        $host{$tb} = $h;
+        $user{$tb} = $u;
+        $domain{$tb} = $d;
+        $project{$tb} = $p;
+        $gwtype{$tb} = $t;
+        $expstart{$tb} = $es;
+        $gwstart{$tb} = $gs;
+        $mexpstart{$tb} = $mes;
+        $mgwstart{$tb} = $mgs;
+        $gwimage{$tb} = $i;
+        $fs{$tb} = $fs;
+        $boss{$tb} = $boss;
+        $tun{$tb} = $tun;
+
+        # Make sure the domain starts with a period
+        $domain{$tb} = ".$domain{$tb}" unless $domain{$tb} =~ /^\./;
+    }
+    $conf->close();
+}
 
 # Open a pipe to the splitter program and start it parsing the experiments
@@ -389 +459 @@
             unless !$gateways || $gateways == $1;
 
-        die "No control gateway for $gateways?" unless $control_gateway;
-        # Client config
-        $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";
-        print $cc "SMBShare: $smb_share\n";
-        print $cc "ProjectUser: $project_user\n";
-        $cc->close();
-        
+        warn "No control gateway for $gateways?" unless $control_gateway;
+        if ($contol_gateway ) {
+            # Client config
+            $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";
+            print $cc "SMBShare: $smb_share\n";
+            print $cc "ProjectUser: $project_user\n";
+            $cc->close();
+        }
+            
         $gateways = 0;
         next;