Changeset 2396559e for fedkit

Timestamp:

May 6, 2008 5:15:38 PM (16 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:

f3691ff

Parents:

33e3537

Message:

fedd integration

File:

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

fedkit/splitter.pl

@@ -24 +24 @@
 my $smb_share;                  # Share to mount from the master
 my $project_user;               # User to mount project dirs as
+my $auth_proj;                  # Local project for resource access
 my($gw_pubkey, $gw_pubkey_base);# Connector pubkey (full path & basename)
 my($gw_secretkey, $gw_secretkey_base);# Connector secret key (full path & 
@@ -31 +32 @@
                                 # (changed during devel)
 my $tclsh;                      # tclsh to call directly (changed during devel)
+my $fedd_client;                # Program to call for testbed access params
 my $muxmax;                     # Maximum number of links/lans over 1 gw pair
 my @tarfiles;                   # Tarfiles in use by this experiment
@@ -47 +49 @@
 my $fail_soft;                  # Do not swap failed sub-experiments out
 my $max_children=1;             # Maximum number of simultaneous swap-ins
+
+# Default commands for starting experiment and gateway nodes.  Testbeds can
+# override these.  (The 'm' prefixed commands are for operating as the master
+# testbed.)
+my $def_expstart = "sudo -H /bin/sh FEDDIR/fed_bootstrap >& /tmp/federate";
+my $def_mexpstart = "sudo -H FEDDIR/make_hosts FEDDIR/hosts";
+my $def_gwstart = "sudo -H FEDDIR/fed-tun.pl -f GWCONF>& /tmp/bridge.log";
+my $def_mgwstart = "sudo -H FEDDIR/fed-tun.pl -f GWCONF >& /tmp/bridge.log";
+my $def_gwimage = "FBSD61-TUNNEL2";
+my $def_gwtype = "pc";
 
 # Parse the config file.  The format is a colon-separated parameter name
@@ -82 +94 @@
 # 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.
-
+# change.  The file parameter is an open IO::Handle.  &parse_testbeds_filename
+# opens the file and calls this.  Parse_testbeds can be used on pipes as well,
+# e.g. fedd_client output.
 sub parse_testbeds {
-    my($file, $tbparams) = @_;      # Testbeds file and parameter hash
-    my $fh = new IO::File($file);  # Testbeds filehandle
+    my($fh, $tbparams) = @_;        # Testbeds file and parameter hash
     my $tb;                         # Current testbed
     # Convert attribute in the file to tbparams hash key
@@ -103 +115 @@
         "boss" => "boss",
         "eventserver" => "eventserver",
-        "tunnelcfg" => "tun"
+        "tunnelcfg" => "tun",
+        "uri" => "uri",
+        "access" => "access"
     );
-
-
-    unless ($fh) {
-        warn "Can't open $file: $!\n";
-        return 0;
-    }
 
     while (<$fh>) {
         next if /^\s*#/ || /^\s*$/;     # Skip comments & blanks
+        print STDERR "testbeds: $_";
         chomp;
         /^\s*\[(.*)\]/ && do {
@@ -123 +132 @@
         /^([^:]+):\s*(.*)/ && do {
             unless ($tb) {
-                warn "Ignored attribute definition before testbed " .
-                    "defined in $file: $_\n";
+                warn "Ignored attribute definition before testbed: $_\n ";
                 next;
             }
@@ -132 +140 @@
 
             if ($var) { $tbparams->{$tb}->{$var} = $2; }
-            else { warn "Unknown keyword $key in $file\n"; }
+            else { warn "Unknown keyword $key\n"; }
 
             next;
         };
-        warn "Unparasble line in $file: $_\n";
-    }
-    $fh->close();   # It will close when it goes out of scope, but...
+        warn "Unparasble line: $_\n";
+    }
     return 1;
+}
+
+
+# Open the given file name and parse the testbeds file it contains by calling
+# &parse_testbeds.
+sub parse_testbeds_filename {
+    my($file, $tbparams) = @_;      # Testbeds file and parameter hash
+    my $fh = new IO::File($file);   # Testbeds filehandle
+
+    if ($fh) {
+        my $rv = &parse_testbeds($fh, $tbparams);
+        $fh->close();   # It will close when it goes out of scope, but...
+        $rv;
+    }
+    else {
+        warn "Can't open $file: $!\n";
+        return 0;
+    }
 }
 
@@ -288 +313 @@
     $status->reader("ssh $user\@$host /usr/testbed/bin/expinfo $pid $eid") || 
         die "Can't ssh to $user\@$host:$!\n";
-
     # XXX: this is simple now.  Parsing may become more complex
     while (<$status>) {
@@ -439 +463 @@
                                     # keep our changes to the parser minimal.
 # Argument processing.
-getopts('Ft:c:p:f:ndvN', \%opts);
+getopts('Ft:c:p:f:ndvNP:', \%opts);
 $splitter_config = $opts{'c'} || "./splitter.conf";
 $debug = $opts{'d'};
@@ -468 +492 @@
 $project_user = $opts{'smbuser'} ||     # User to mount project dirs as
     die "Must give an SMB user\n";
+$auth_proj = $opts{'P'} || die "Must give an authentication project (-P)\n";
 
 # tcl program to split experiments (changed during devel)
@@ -473 +498 @@
 # tclsh to call directly (changed during devel)
 $tclsh = $opts{'tclsh'} || "/usr/local/bin/otclsh";
+# fedd_client to get testbed access parameters
+$fedd_client = $opts{'feddclient'} || "fedd_client";
 
 # Prefix to avoid collisions
@@ -512 +539 @@
 die "Must supply file, master and experiment" unless $master && $tcl && $eid;
 
-&parse_testbeds($tb_config, $tbparams) ||
+&parse_testbeds_filename($tb_config, $tbparams) ||
     die "Cannot testbed congfigurations from $tb_config: $!\n";
 
@@ -538 +565 @@
 # configurations and hostnames file
 while (<$pipe>) {
+    # Allbeds lists all the testbeds that this experiment accesses.  This code
+    # acquires access to them and pulls in their access parameters from fedd.
+    (/^#\s+Begin\s+Allbeds/../^#\s+End\s+Allbeds/) && do {
+        next if /^#/;
+        chomp;
+
+        my $tb = $_;            # Current testbed
+        # If this testbed has not had its access parameters read from fedd, try
+        # to read them, if we have a way to talk to fedd
+        unless ($tbparams->{$tb}->{'access'} && $fedd_client) { 
+            my $access_pipe = new IO::Pipe || 
+                die "Can't open pipe to fedd:$!\n";
+
+            print("Checking access to $tb using " . $tbparams->{$tb}->{'uri'}
+                . "\n") if $verbose;
+
+            my $cmd = "$fedd_client -t " . 
+                $tbparams->{$tb}->{'uri'} .  " -T $ENV{HOME}/cacert.pem ".
+                "-l $tb -p $auth_proj | /usr/bin/tee fedd.$tb ";
+            print "$cmd\n" if $verbose;
+
+            $access_pipe->reader($cmd) || 
+                    die "Can't exec fedd_client: $!\n";
+
+            &parse_testbeds($access_pipe, $tbparams) || 
+                warn("Error reading fedd output: $!\n");
+            $access_pipe->close();
+        }
+        next;
+    };
+
     # Start of a sub-experiment
     /^#\s+Begin\s+Testbed\s+\((\w+)\)/ && do {
@@ -543 +601 @@
 
         # If we know the testbed, start collecting its sub experiment tcl
-        # description.  If not, warn the caller and ignore the configuration of
-        # this testbed.
-        if ($tbparams->{$ctb}) {
+        # description.  If not, warn the user.
+        if ($tbparams->{$ctb}->{'access'}) {
             $allocated{$ctb}++; # Keep track of the testbeds allocated
 
@@ -556 +613 @@
                 die "Cannot open $destfile:$!\n";
         }
-        else { 
+        else{
             warn "No such testbed $ctb\n";
             $destfile = "";
@@ -567 +624 @@
         # Simple syntax check and close out this experiment's tcl description
         die "Mismatched testbed markers ($1, $ctb)\n" unless ($1 eq $ctb);
-        $desthandle->close();
+        $desthandle->close() if $desthandle;
         $destfile = $ctb = "";
         next;
@@ -658 +715 @@
         my $active;                             # Is this the active side of
                                                 # the connector?
+        my $tunnel_cfg =                        # Use DETER's config stuff
+            $tbparams->{$gateways}->{'tun'} || "false";
+                                    
 
         $sdomain = ".$eid." . $tbparams->{$gateways}->{'project'} . "$sdomain";
@@ -687 +747 @@
 
         print $gwconfig "Active: $active\n";
-        print $gwconfig "TunnelCfg: " . $tbparams->{$gateways}->{'tun'} . "\n";
+        print $gwconfig "TunnelCfg: $tunnel_cfg\n";
         print $gwconfig "BossName: $boss\n";
         print $gwconfig "FsName: $fs\n";
@@ -740 +800 @@
     next unless $destfile;  # Unidentified testbed, ignore config
     # local copies that can be used in the substitutions below
-    my $gwtype = $tbparams->{$ctb}->{'gwtype'};
-    my $gwimage = $tbparams->{$ctb}->{'gwimage'};
-    my $mgwstart = $tbparams->{$ctb}->{'mgwstart'};
-    my $mexpstart = $tbparams->{$ctb}->{'mexpstart'};
-    my $gwstart = $tbparams->{$ctb}->{'gwstart'};
-    my $expstart = $tbparams->{$ctb}->{'expstart'};
+    my $gwtype = $tbparams->{$ctb}->{'gwtype'} || $def_gwtype;
+    my $gwimage = $tbparams->{$ctb}->{'gwimage'} || $def_gwimage;
+    my $mgwstart = $tbparams->{$ctb}->{'mgwstart'} || $def_mgwstart;
+    my $mexpstart = $tbparams->{$ctb}->{'mexpstart'} || $def_mexpstart;
+    my $gwstart = $tbparams->{$ctb}->{'gwstart'} || $def_gwstart;
+    my $expstart = $tbparams->{$ctb}->{'expstart'} || $def_expstart;
     my $project = $tbparams->{$ctb}->{'project'};