Changeset 2396559e for fedkit


Ignore:
Timestamp:
May 6, 2008 5:15:38 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:
f3691ff
Parents:
33e3537
Message:

fedd integration

File:
1 edited

Legend:

Unmodified
Added
Removed
  • fedkit/splitter.pl

    r33e3537 r2396559e  
    2424my $smb_share;                  # Share to mount from the master
    2525my $project_user;               # User to mount project dirs as
     26my $auth_proj;                  # Local project for resource access
    2627my($gw_pubkey, $gw_pubkey_base);# Connector pubkey (full path & basename)
    2728my($gw_secretkey, $gw_secretkey_base);# Connector secret key (full path &
     
    3132                                # (changed during devel)
    3233my $tclsh;                      # tclsh to call directly (changed during devel)
     34my $fedd_client;                # Program to call for testbed access params
    3335my $muxmax;                     # Maximum number of links/lans over 1 gw pair
    3436my @tarfiles;                   # Tarfiles in use by this experiment
     
    4749my $fail_soft;                  # Do not swap failed sub-experiments out
    4850my $max_children=1;             # Maximum number of simultaneous swap-ins
     51
     52# Default commands for starting experiment and gateway nodes.  Testbeds can
     53# override these.  (The 'm' prefixed commands are for operating as the master
     54# testbed.)
     55my $def_expstart = "sudo -H /bin/sh FEDDIR/fed_bootstrap >& /tmp/federate";
     56my $def_mexpstart = "sudo -H FEDDIR/make_hosts FEDDIR/hosts";
     57my $def_gwstart = "sudo -H FEDDIR/fed-tun.pl -f GWCONF>& /tmp/bridge.log";
     58my $def_mgwstart = "sudo -H FEDDIR/fed-tun.pl -f GWCONF >& /tmp/bridge.log";
     59my $def_gwimage = "FBSD61-TUNNEL2";
     60my $def_gwtype = "pc";
    4961
    5062# Parse the config file.  The format is a colon-separated parameter name
     
    8294# the colon-separated attribute-value pairs for the testbed.  Right now these
    8395# go into a set of global hashes indexed by testbed, but that should probably
    84 # change.
    85 
     96# change.  The file parameter is an open IO::Handle.  &parse_testbeds_filename
     97# opens the file and calls this.  Parse_testbeds can be used on pipes as well,
     98# e.g. fedd_client output.
    8699sub parse_testbeds {
    87     my($file, $tbparams) = @_;      # Testbeds file and parameter hash
    88     my $fh = new IO::File($file);  # Testbeds filehandle
     100    my($fh, $tbparams) = @_;        # Testbeds file and parameter hash
    89101    my $tb;                         # Current testbed
    90102    # Convert attribute in the file to tbparams hash key
     
    103115        "boss" => "boss",
    104116        "eventserver" => "eventserver",
    105         "tunnelcfg" => "tun"
     117        "tunnelcfg" => "tun",
     118        "uri" => "uri",
     119        "access" => "access"
    106120    );
    107 
    108 
    109     unless ($fh) {
    110         warn "Can't open $file: $!\n";
    111         return 0;
    112     }
    113121
    114122    while (<$fh>) {
    115123        next if /^\s*#/ || /^\s*$/;     # Skip comments & blanks
     124        print STDERR "testbeds: $_";
    116125        chomp;
    117126        /^\s*\[(.*)\]/ && do {
     
    123132        /^([^:]+):\s*(.*)/ && do {
    124133            unless ($tb) {
    125                 warn "Ignored attribute definition before testbed " .
    126                     "defined in $file: $_\n";
     134                warn "Ignored attribute definition before testbed: $_\n ";
    127135                next;
    128136            }
     
    132140
    133141            if ($var) { $tbparams->{$tb}->{$var} = $2; }
    134             else { warn "Unknown keyword $key in $file\n"; }
     142            else { warn "Unknown keyword $key\n"; }
    135143
    136144            next;
    137145        };
    138         warn "Unparasble line in $file: $_\n";
    139     }
    140     $fh->close();   # It will close when it goes out of scope, but...
     146        warn "Unparasble line: $_\n";
     147    }
    141148    return 1;
     149}
     150
     151
     152# Open the given file name and parse the testbeds file it contains by calling
     153# &parse_testbeds.
     154sub parse_testbeds_filename {
     155    my($file, $tbparams) = @_;      # Testbeds file and parameter hash
     156    my $fh = new IO::File($file);   # Testbeds filehandle
     157
     158    if ($fh) {
     159        my $rv = &parse_testbeds($fh, $tbparams);
     160        $fh->close();   # It will close when it goes out of scope, but...
     161        $rv;
     162    }
     163    else {
     164        warn "Can't open $file: $!\n";
     165        return 0;
     166    }
    142167}
    143168
     
    288313    $status->reader("ssh $user\@$host /usr/testbed/bin/expinfo $pid $eid") ||
    289314        die "Can't ssh to $user\@$host:$!\n";
    290 
    291315    # XXX: this is simple now.  Parsing may become more complex
    292316    while (<$status>) {
     
    439463                                    # keep our changes to the parser minimal.
    440464# Argument processing.
    441 getopts('Ft:c:p:f:ndvN', \%opts);
     465getopts('Ft:c:p:f:ndvNP:', \%opts);
    442466$splitter_config = $opts{'c'} || "./splitter.conf";
    443467$debug = $opts{'d'};
     
    468492$project_user = $opts{'smbuser'} ||     # User to mount project dirs as
    469493    die "Must give an SMB user\n";
     494$auth_proj = $opts{'P'} || die "Must give an authentication project (-P)\n";
    470495
    471496# tcl program to split experiments (changed during devel)
     
    473498# tclsh to call directly (changed during devel)
    474499$tclsh = $opts{'tclsh'} || "/usr/local/bin/otclsh";
     500# fedd_client to get testbed access parameters
     501$fedd_client = $opts{'feddclient'} || "fedd_client";
    475502
    476503# Prefix to avoid collisions
     
    512539die "Must supply file, master and experiment" unless $master && $tcl && $eid;
    513540
    514 &parse_testbeds($tb_config, $tbparams) ||
     541&parse_testbeds_filename($tb_config, $tbparams) ||
    515542    die "Cannot testbed congfigurations from $tb_config: $!\n";
    516543
     
    538565# configurations and hostnames file
    539566while (<$pipe>) {
     567    # Allbeds lists all the testbeds that this experiment accesses.  This code
     568    # acquires access to them and pulls in their access parameters from fedd.
     569    (/^#\s+Begin\s+Allbeds/../^#\s+End\s+Allbeds/) && do {
     570        next if /^#/;
     571        chomp;
     572
     573        my $tb = $_;            # Current testbed
     574        # If this testbed has not had its access parameters read from fedd, try
     575        # to read them, if we have a way to talk to fedd
     576        unless ($tbparams->{$tb}->{'access'} && $fedd_client) {
     577            my $access_pipe = new IO::Pipe ||
     578                die "Can't open pipe to fedd:$!\n";
     579
     580            print("Checking access to $tb using " . $tbparams->{$tb}->{'uri'}
     581                . "\n") if $verbose;
     582
     583            my $cmd = "$fedd_client -t " .
     584                $tbparams->{$tb}->{'uri'} .  " -T $ENV{HOME}/cacert.pem ".
     585                "-l $tb -p $auth_proj | /usr/bin/tee fedd.$tb ";
     586            print "$cmd\n" if $verbose;
     587
     588            $access_pipe->reader($cmd) ||
     589                    die "Can't exec fedd_client: $!\n";
     590
     591            &parse_testbeds($access_pipe, $tbparams) ||
     592                warn("Error reading fedd output: $!\n");
     593            $access_pipe->close();
     594        }
     595        next;
     596    };
     597
    540598    # Start of a sub-experiment
    541599    /^#\s+Begin\s+Testbed\s+\((\w+)\)/ && do {
     
    543601
    544602        # If we know the testbed, start collecting its sub experiment tcl
    545         # description.  If not, warn the caller and ignore the configuration of
    546         # this testbed.
    547         if ($tbparams->{$ctb}) {
     603        # description.  If not, warn the user.
     604        if ($tbparams->{$ctb}->{'access'}) {
    548605            $allocated{$ctb}++; # Keep track of the testbeds allocated
    549606
     
    556613                die "Cannot open $destfile:$!\n";
    557614        }
    558         else {
     615        else{
    559616            warn "No such testbed $ctb\n";
    560617            $destfile = "";
     
    567624        # Simple syntax check and close out this experiment's tcl description
    568625        die "Mismatched testbed markers ($1, $ctb)\n" unless ($1 eq $ctb);
    569         $desthandle->close();
     626        $desthandle->close() if $desthandle;
    570627        $destfile = $ctb = "";
    571628        next;
     
    658715        my $active;                             # Is this the active side of
    659716                                                # the connector?
     717        my $tunnel_cfg =                        # Use DETER's config stuff
     718            $tbparams->{$gateways}->{'tun'} || "false";
     719                                   
    660720
    661721        $sdomain = ".$eid." . $tbparams->{$gateways}->{'project'} . "$sdomain";
     
    687747
    688748        print $gwconfig "Active: $active\n";
    689         print $gwconfig "TunnelCfg: " . $tbparams->{$gateways}->{'tun'} . "\n";
     749        print $gwconfig "TunnelCfg: $tunnel_cfg\n";
    690750        print $gwconfig "BossName: $boss\n";
    691751        print $gwconfig "FsName: $fs\n";
     
    740800    next unless $destfile;  # Unidentified testbed, ignore config
    741801    # local copies that can be used in the substitutions below
    742     my $gwtype = $tbparams->{$ctb}->{'gwtype'};
    743     my $gwimage = $tbparams->{$ctb}->{'gwimage'};
    744     my $mgwstart = $tbparams->{$ctb}->{'mgwstart'};
    745     my $mexpstart = $tbparams->{$ctb}->{'mexpstart'};
    746     my $gwstart = $tbparams->{$ctb}->{'gwstart'};
    747     my $expstart = $tbparams->{$ctb}->{'expstart'};
     802    my $gwtype = $tbparams->{$ctb}->{'gwtype'} || $def_gwtype;
     803    my $gwimage = $tbparams->{$ctb}->{'gwimage'} || $def_gwimage;
     804    my $mgwstart = $tbparams->{$ctb}->{'mgwstart'} || $def_mgwstart;
     805    my $mexpstart = $tbparams->{$ctb}->{'mexpstart'} || $def_mexpstart;
     806    my $gwstart = $tbparams->{$ctb}->{'gwstart'} || $def_gwstart;
     807    my $expstart = $tbparams->{$ctb}->{'expstart'} || $def_expstart;
    748808    my $project = $tbparams->{$ctb}->{'project'};
    749809
Note: See TracChangeset for help on using the changeset viewer.