- Timestamp:
- May 6, 2008 5:15:38 PM (17 years ago)
- Branches:
- axis_example, compt_changes, info-ops, master, version-1.30, version-2.00, version-3.01, version-3.02
- Children:
- f3691ff
- Parents:
- 33e3537
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
fedkit/splitter.pl
r33e3537 r2396559e 24 24 my $smb_share; # Share to mount from the master 25 25 my $project_user; # User to mount project dirs as 26 my $auth_proj; # Local project for resource access 26 27 my($gw_pubkey, $gw_pubkey_base);# Connector pubkey (full path & basename) 27 28 my($gw_secretkey, $gw_secretkey_base);# Connector secret key (full path & … … 31 32 # (changed during devel) 32 33 my $tclsh; # tclsh to call directly (changed during devel) 34 my $fedd_client; # Program to call for testbed access params 33 35 my $muxmax; # Maximum number of links/lans over 1 gw pair 34 36 my @tarfiles; # Tarfiles in use by this experiment … … 47 49 my $fail_soft; # Do not swap failed sub-experiments out 48 50 my $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.) 55 my $def_expstart = "sudo -H /bin/sh FEDDIR/fed_bootstrap >& /tmp/federate"; 56 my $def_mexpstart = "sudo -H FEDDIR/make_hosts FEDDIR/hosts"; 57 my $def_gwstart = "sudo -H FEDDIR/fed-tun.pl -f GWCONF>& /tmp/bridge.log"; 58 my $def_mgwstart = "sudo -H FEDDIR/fed-tun.pl -f GWCONF >& /tmp/bridge.log"; 59 my $def_gwimage = "FBSD61-TUNNEL2"; 60 my $def_gwtype = "pc"; 49 61 50 62 # 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 83 95 # 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. 86 99 sub 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 89 101 my $tb; # Current testbed 90 102 # Convert attribute in the file to tbparams hash key … … 103 115 "boss" => "boss", 104 116 "eventserver" => "eventserver", 105 "tunnelcfg" => "tun" 117 "tunnelcfg" => "tun", 118 "uri" => "uri", 119 "access" => "access" 106 120 ); 107 108 109 unless ($fh) {110 warn "Can't open $file: $!\n";111 return 0;112 }113 121 114 122 while (<$fh>) { 115 123 next if /^\s*#/ || /^\s*$/; # Skip comments & blanks 124 print STDERR "testbeds: $_"; 116 125 chomp; 117 126 /^\s*\[(.*)\]/ && do { … … 123 132 /^([^:]+):\s*(.*)/ && do { 124 133 unless ($tb) { 125 warn "Ignored attribute definition before testbed " . 126 "defined in $file: $_\n"; 134 warn "Ignored attribute definition before testbed: $_\n "; 127 135 next; 128 136 } … … 132 140 133 141 if ($var) { $tbparams->{$tb}->{$var} = $2; } 134 else { warn "Unknown keyword $key in $file\n"; }142 else { warn "Unknown keyword $key\n"; } 135 143 136 144 next; 137 145 }; 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 } 141 148 return 1; 149 } 150 151 152 # Open the given file name and parse the testbeds file it contains by calling 153 # &parse_testbeds. 154 sub 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 } 142 167 } 143 168 … … 288 313 $status->reader("ssh $user\@$host /usr/testbed/bin/expinfo $pid $eid") || 289 314 die "Can't ssh to $user\@$host:$!\n"; 290 291 315 # XXX: this is simple now. Parsing may become more complex 292 316 while (<$status>) { … … 439 463 # keep our changes to the parser minimal. 440 464 # Argument processing. 441 getopts('Ft:c:p:f:ndvN ', \%opts);465 getopts('Ft:c:p:f:ndvNP:', \%opts); 442 466 $splitter_config = $opts{'c'} || "./splitter.conf"; 443 467 $debug = $opts{'d'}; … … 468 492 $project_user = $opts{'smbuser'} || # User to mount project dirs as 469 493 die "Must give an SMB user\n"; 494 $auth_proj = $opts{'P'} || die "Must give an authentication project (-P)\n"; 470 495 471 496 # tcl program to split experiments (changed during devel) … … 473 498 # tclsh to call directly (changed during devel) 474 499 $tclsh = $opts{'tclsh'} || "/usr/local/bin/otclsh"; 500 # fedd_client to get testbed access parameters 501 $fedd_client = $opts{'feddclient'} || "fedd_client"; 475 502 476 503 # Prefix to avoid collisions … … 512 539 die "Must supply file, master and experiment" unless $master && $tcl && $eid; 513 540 514 &parse_testbeds ($tb_config, $tbparams) ||541 &parse_testbeds_filename($tb_config, $tbparams) || 515 542 die "Cannot testbed congfigurations from $tb_config: $!\n"; 516 543 … … 538 565 # configurations and hostnames file 539 566 while (<$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 540 598 # Start of a sub-experiment 541 599 /^#\s+Begin\s+Testbed\s+\((\w+)\)/ && do { … … 543 601 544 602 # 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'}) { 548 605 $allocated{$ctb}++; # Keep track of the testbeds allocated 549 606 … … 556 613 die "Cannot open $destfile:$!\n"; 557 614 } 558 else {615 else{ 559 616 warn "No such testbed $ctb\n"; 560 617 $destfile = ""; … … 567 624 # Simple syntax check and close out this experiment's tcl description 568 625 die "Mismatched testbed markers ($1, $ctb)\n" unless ($1 eq $ctb); 569 $desthandle->close() ;626 $desthandle->close() if $desthandle; 570 627 $destfile = $ctb = ""; 571 628 next; … … 658 715 my $active; # Is this the active side of 659 716 # the connector? 717 my $tunnel_cfg = # Use DETER's config stuff 718 $tbparams->{$gateways}->{'tun'} || "false"; 719 660 720 661 721 $sdomain = ".$eid." . $tbparams->{$gateways}->{'project'} . "$sdomain"; … … 687 747 688 748 print $gwconfig "Active: $active\n"; 689 print $gwconfig "TunnelCfg: " . $tbparams->{$gateways}->{'tun'} . "\n";749 print $gwconfig "TunnelCfg: $tunnel_cfg\n"; 690 750 print $gwconfig "BossName: $boss\n"; 691 751 print $gwconfig "FsName: $fs\n"; … … 740 800 next unless $destfile; # Unidentified testbed, ignore config 741 801 # 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; 748 808 my $project = $tbparams->{$ctb}->{'project'}; 749 809
Note: See TracChangeset
for help on using the changeset viewer.