Changeset fe459d0
- Timestamp:
- Sep 20, 2007 6:38:28 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:
- b68f597
- Parents:
- d501c38
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
fedkit/splitter.pl
rd501c38 rfe459d0 32 32 $key =~ tr/A-Z/a-z/; 33 33 $href->{$key} = $2; 34 next; 35 }; 36 warn "Unparasble line in $file: $_\n"; 37 } 38 $fh->close(); # It will close when it goes out of scope, but... 39 return 1; 40 } 41 42 # Parse an easier-to-read testbeds file (the original was comma-separated 43 # unadorned strings). The format is a testbed scope as [testbed] followed by 44 # the colon-separated attribute-value pairs for the testbed. Right now these 45 # go into a set of global hashes indexed by testbed, but that should probably 46 # change. 47 48 sub parse_testbeds { 49 my($file) = @_; # Testbeds file 50 my($fh) = new IO::File($file); # Testbeds filehandle 51 my($tb); # Current testbed 52 # Convert attribute in the file to global variable name. XXX: Again, this 53 # needs to be a 2-level hash 54 my(%attr_to_hash) = ( 55 "opsnode" => "host", 56 "user" => "user", 57 "domain" => "domain", 58 "project" => "project", 59 "connectortype" => "gwtype", 60 "slavenodestartcmd" => "expstart", 61 "slaveconnectorstartcmd" => "gwstart", 62 "masternodestartcmd" => "mexpstart", 63 "masterconnectorstartcmd" => "mgwstart", 64 "connectorimage" => "gwimage", 65 "fileserver" => "fs", 66 "boss" => "boss", 67 "tunnelcfg" => "tun" 68 ); 69 70 71 unless ($fh) { 72 warn "Can't open $file: $!\n"; 73 return 0; 74 } 75 76 while (<$fh>) { 77 next if /^\s*#/ || /^\s*$/; # Skip comments & blanks 78 chomp; 79 /^\s*\[(.*)\]/ && do { 80 $tb = $1; 81 next; 82 }; 83 84 /^([^:]+):\s*(.*)/ && do { 85 unless ($tb) { 86 warn "Ignored attribute definition before testbed " . 87 "defined in $file: $_\n"; 88 next; 89 } 90 my($key) = $1; 91 $key =~ tr/A-Z/a-z/; 92 my($var) = $attr_to_hash{$key}; 93 94 # XXX: The eval is scary. This will become a 2-level hash. 95 if ($var) { eval "\$$var\{$tb\} = \"$2\";"; } 96 else { warn "Unknown keyword $key in $file\n"; } 97 34 98 next; 35 99 }; … … 201 265 # the configuration files and scripts into the new experiment directories. 202 266 if ($state eq "none") { 203 print "Creating $e xpon $tb\n" if $verbose;204 &ssh_cmd($user, $host, "/usr/testbed/bin/startexp - f -w -p " .267 print "Creating $eid on $tb\n" if $verbose; 268 &ssh_cmd($user, $host, "/usr/testbed/bin/startexp -i -f -w -p " . 205 269 "$pid -e $eid $tclfile", "startexp") || return 0; 206 270 print "Transferring federation support files to $tb\n" if $verbose; … … 245 309 # keep our changes to the parser minimal. 246 310 # Argument processing. 247 getopts('c:f:ndv ', \%opts);311 getopts('c:f:ndvN', \%opts); 248 312 $splitter_config = $opts{'c'} || "./splitter.conf"; 249 313 $debug = $opts{'d'}; … … 295 359 die "Must supply file, master and experiment" unless $master && $tcl && $eid; 296 360 297 # Read a hash of per-testbed parameters from the local configurations. 298 $conf = new IO::File($tb_config) || 299 die "can't read testbed configutions from $tb_config: $!\n"; 300 while (<$conf>) { 301 next if /^#/; 302 chomp; 303 ($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss, $tun) = 304 split(":", $_); 305 $host{$tb} = $h; 306 $user{$tb} = $u; 307 $domain{$tb} = $d; 308 $project{$tb} = $p; 309 $gwtype{$tb} = $t; 310 $expstart{$tb} = $es; 311 $gwstart{$tb} = $gs; 312 $mexpstart{$tb} = $mes; 313 $mgwstart{$tb} = $mgs; 314 $gwimage{$tb} = $i; 315 $fs{$tb} = $fs; 316 $boss{$tb} = $boss; 317 $tun{$tb} = $tun; 318 319 # Make sure the domain starts with a period 320 $domain{$tb} = ".$domain{$tb}" unless $domain{$tb} =~ /^\./; 321 } 322 $conf->close(); 361 if ($opts{'N'} ) { 362 &parse_testbeds($tb_config) || 363 die "Cannot testbed congfigurations from $tb_config: $!\n"; 364 } 365 else { 366 # Read a hash of per-testbed parameters from the local configurations. 367 $conf = new IO::File($tb_config) || 368 die "can't read testbed configutions from $tb_config: $!\n"; 369 while (<$conf>) { 370 next if /^#/; 371 chomp; 372 ($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss, $tun) = 373 split(":", $_); 374 $host{$tb} = $h; 375 $user{$tb} = $u; 376 $domain{$tb} = $d; 377 $project{$tb} = $p; 378 $gwtype{$tb} = $t; 379 $expstart{$tb} = $es; 380 $gwstart{$tb} = $gs; 381 $mexpstart{$tb} = $mes; 382 $mgwstart{$tb} = $mgs; 383 $gwimage{$tb} = $i; 384 $fs{$tb} = $fs; 385 $boss{$tb} = $boss; 386 $tun{$tb} = $tun; 387 388 # Make sure the domain starts with a period 389 $domain{$tb} = ".$domain{$tb}" unless $domain{$tb} =~ /^\./; 390 } 391 $conf->close(); 392 } 323 393 324 394 # Open a pipe to the splitter program and start it parsing the experiments … … 389 459 unless !$gateways || $gateways == $1; 390 460 391 die "No control gateway for $gateways?" unless $control_gateway; 392 # Client config 393 $cc = new IO::File(">$tmpdir/$gateways/client.conf"); 394 die "Can't open $tmpdir/$gateways/client.conf: $!\n" unless $cc; 395 print $cc "ControlGateway: $control_gateway\n"; 396 print $cc "SMBShare: $smb_share\n"; 397 print $cc "ProjectUser: $project_user\n"; 398 $cc->close(); 399 461 warn "No control gateway for $gateways?" unless $control_gateway; 462 if ($contol_gateway ) { 463 # Client config 464 $cc = new IO::File(">$tmpdir/$gateways/client.conf"); 465 die "Can't open $tmpdir/$gateways/client.conf: $!\n" unless $cc; 466 print $cc "ControlGateway: $control_gateway\n"; 467 print $cc "SMBShare: $smb_share\n"; 468 print $cc "ProjectUser: $project_user\n"; 469 $cc->close(); 470 } 471 400 472 $gateways = 0; 401 473 next;
Note: See TracChangeset
for help on using the changeset viewer.