- Timestamp:
- Sep 21, 2007 10:11:21 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:
- 527321c
- Parents:
- e4436a6
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
fedkit/splitter.pl
re4436a6 rb814529 1 1 #!/usr/bin/perl 2 3 use strict; 2 4 3 5 use Getopt::Std; … … 7 9 use File::Copy; 8 10 9 @scripts = ("federate.sh", "smbmount.pl", "make_hosts", "fed-tun.pl"); 10 $local_script_dir = "."; 11 my(@scripts) = ("federate.sh", "smbmount.pl", "make_hosts", "fed-tun.pl"); 12 my($local_script_dir) = "."; 13 my($pid, $gid); # Process and group IDs for calling parse.tcl 14 my($splitter_config); # Configuration file 15 my($debug); # True if thecalled in debug mode 16 my($verbose); # True for extra progress reports 17 my($startem); # If true, start the sub-experiments 18 my($eid); # Experiment ID 19 my($tcl); # The experiment description (topology file) 20 my($master); # Master testbed 21 my($tmpdir); # tmp files 22 my($tb_config); # testbed configurations 23 my($smb_share); # Share to mount from the master 24 my($project_user); # User to mount project dirs as 25 my($gw_pubkey, $gw_pubkey_base);# Connector pubkey (full path & basename) 26 my($gw_secretkey, $gw_secretkey_base);# Connector secret key (full path & 27 # basename) 28 my($tcl_splitter); # tcl program to split experiments 29 # (changed during devel) 30 my($tclsh); # tclsh to call directly (changed during devel) 31 my(@tarfiles); # Tarfiles in use by this experiment 32 my(%opts); # Parsed options 33 34 # Per testbed parameters parsed from testbeds file 35 my(%host); # ops node of the testbed 36 my(%user); # User to operate as 37 my(%domain); # testbed DNS domain 38 my(%project); # Remote project to instantiate undere 39 my(%gwtype); # Node type for connector 40 my(%expstart); # startcmd for experimental nodes (slave) 41 my(%gwstart); # startcmd for connector nodes (slave) 42 my(%mexpstart); # startcmd for experimental nodes (master) 43 my(%mgwstart); # startcmd for connector nodes (master) 44 my(%gwimage); # connector image name 45 my(%fs); # testbed fs node 46 my(%boss); # testbed boss node 47 my(%tun); # XXX: should disappear configure tunnel? 48 11 49 12 50 # Parse the config file. The format is a colon-separated parameter name … … 202 240 my($tarfiles_dir) = "/proj/$pid/tarfiles/$eid"; # Where to stash tarfiles 203 241 my($to_hostname) = "$proj_dir/hosts"; # remote hostnames file 242 my($state); # State of remote experiment 204 243 my($status) = new IO::Pipe; # The pipe to get status 205 244 … … 337 376 338 377 &parse_config("$splitter_config", \%opts) || 339 die "Cannot read config file $splitter_conf : $!\n";378 die "Cannot read config file $splitter_config: $!\n"; 340 379 341 380 … … 374 413 375 414 # Validate scripts directory 376 for $s (@scripts) {415 for my $s (@scripts) { 377 416 die "$local_script_dir/$s not in local script directory. Try -d\n" 378 417 unless -r "$local_script_dir/$s"; … … 387 426 else { 388 427 # Read a hash of per-testbed parameters from the local configurations. 389 $conf= new IO::File($tb_config) ||428 my($conf) = new IO::File($tb_config) || 390 429 die "can't read testbed configutions from $tb_config: $!\n"; 391 430 while (<$conf>) { 392 431 next if /^#/; 393 432 chomp; 394 ($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss, $tun) =395 split(":", $_);433 my($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss, 434 $tun) = split(":", $_); 396 435 $host{$tb} = $h; 397 436 $user{$tb} = $u; … … 415 454 416 455 # Open a pipe to the splitter program and start it parsing the experiments 417 $pipe= new IO::Pipe;456 my($pipe) = new IO::Pipe; 418 457 # NB no more -p call on parse call. 419 458 $pipe->reader("$tclsh $tcl_splitter -s -m $master $pid $gid $eid $tcl") || 420 459 die "Cannot execute $tclsh $tcl_splitter -s -m $master $pid $gid $eid $tcl:$!\n"; 460 461 # Parsing variables 462 my($ctb); # Current testbed 463 my(%allocated); # If allocated{$tb} > 0, $tb is in use 464 my($destfile); # File that the sub-experiment tcl file is 465 # being written to, or "" if none. Also used 466 # for hostnames file. 467 my($gateways); # when gateway lists are being processed this 468 # is the testbed whose gateways are being 469 # gathered. 470 my($control_gateway); # Control net gateway for the current testbed 471 my(%active_end); # If active_end{"a-b"} > 0 then a is the active 472 # end of the a <-> b connector pair. 421 473 422 474 # Parse the splitter output. This loop creates the sub experiments, gateway … … 483 535 if ($control_gateway ) { 484 536 # Client config 485 $cc= new IO::File(">$tmpdir/$gateways/client.conf");537 my($cc) = new IO::File(">$tmpdir/$gateways/client.conf"); 486 538 die "Can't open $tmpdir/$gateways/client.conf: $!\n" unless $cc; 487 539 print $cc "ControlGateway: $control_gateway\n"; … … 516 568 my($ddomain) = $domain{$dtb}; # domain for the destination 517 569 my($sproject) = $project{$gateways}; # Project of the destination 570 my($active); # Is this the active side of 571 # the connector? 518 572 519 573 $sdomain = ".$eid.$project{$gateways}$sdomain"; … … 539 593 540 594 # Write out the file 541 $gwconfig= new IO::File(">$tmpdir/$gateways/$conf_file")||595 my($gwconfig) = new IO::File(">$tmpdir/$gateways/$conf_file")|| 542 596 die "can't open $tmpdir/$gateways/$conf_file: $!\n"; 543 597 … … 604 658 die "No nodes in master testbed ($master)\n" unless $allocated{$master}; 605 659 606 for $t(@tarfiles) {660 for my $t (@tarfiles) { 607 661 die "tarfile '$t' unreadable: $!\n" unless -r $t; 608 662 unless (-d "$tmpdir/tarfiles") { … … 616 670 exit(0) unless $startem; 617 671 672 my(%started); # If $started{$tb} then $tb successfully started 673 618 674 # Start up the slave sub-experiments first 619 675 TESTBED: 620 for $tb(keys %allocated) {676 for my $tb (keys %allocated) { 621 677 if ($tb ne $master) { 622 678 if (&start_segment($tb, $eid)) { $started{$tb}++; } … … 632 688 # If any testbed failed, swap the rest out. 633 689 if ( scalar(keys %started) != scalar(keys %allocated)) { 634 for $tb (keys %started) { &stop_segment($tb, $eid); }690 for my $tb (keys %started) { &stop_segment($tb, $eid); } 635 691 print "Error starting experiment\n"; 636 692 exit(1);
Note: See TracChangeset
for help on using the changeset viewer.