- Timestamp:
- Sep 22, 2007 8:47:59 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:
- 5f1cd41
- Parents:
- b814529
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
fedkit/splitter.pl
rb814529 r527321c 9 9 use File::Copy; 10 10 11 my (@scripts)= ("federate.sh", "smbmount.pl", "make_hosts", "fed-tun.pl");12 my ($local_script_dir)= ".";11 my @scripts = ("federate.sh", "smbmount.pl", "make_hosts", "fed-tun.pl"); 12 my $local_script_dir = "."; 13 13 my($pid, $gid); # Process and group IDs for calling parse.tcl 14 my ($splitter_config); # Configuration file15 my ($debug); # True if thecalled in debug mode16 my ($verbose); # True for extra progress reports17 my ($startem); # If true, start the sub-experiments18 my ($eid); # Experiment ID19 my ($tcl); # The experiment description (topology file)20 my ($master); # Master testbed21 my ($tmpdir); # tmp files22 my ($tb_config); # testbed configurations23 my ($smb_share); # Share to mount from the master24 my ($project_user); # User to mount project dirs as14 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 25 my($gw_pubkey, $gw_pubkey_base);# Connector pubkey (full path & basename) 26 26 my($gw_secretkey, $gw_secretkey_base);# Connector secret key (full path & 27 27 # basename) 28 my ($tcl_splitter); # tcl program to split experiments28 my $tcl_splitter; # tcl program to split experiments 29 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 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 my $tbparams = {}; # Map of the per-testbed parameters from the 35 # testbeds file. It is a reference to a hash 36 # of hashes (because it's passed around a bunch 37 # and it's nicer to have one access pattern 38 # throughout the script, in the main loop and 39 # the subroutines). That access is exemplified 40 # by $tbparams->{'deter'}->{'domain'} which is 41 # the domain parameter of the DETER testbed. 49 42 50 43 # Parse the config file. The format is a colon-separated parameter name … … 85 78 86 79 sub parse_testbeds { 87 my($file ) = @_; # Testbeds file88 my ($fh)= new IO::File($file); # Testbeds filehandle89 my ($tb); # Current testbed80 my($file, $tbparams) = @_; # Testbeds file and parameter hash 81 my $fh = new IO::File($file); # Testbeds filehandle 82 my $tb; # Current testbed 90 83 # Convert attribute in the file to global variable name. XXX: Again, this 91 84 # needs to be a 2-level hash 92 my (%attr_to_hash)= (85 my %attr_to_hash = ( 93 86 "opsnode" => "host", 94 87 "user" => "user", … … 117 110 /^\s*\[(.*)\]/ && do { 118 111 $tb = $1; 112 $tbparams->{$tb} = {} unless $tbparams->{$tb}; 119 113 next; 120 114 }; … … 126 120 next; 127 121 } 128 my ($key)= $1;122 my $key = $1; 129 123 $key =~ tr/A-Z/a-z/; 130 my($var) = $attr_to_hash{$key}; 131 132 # XXX: The eval is scary. This will become a 2-level hash. 133 if ($var) { eval "\$$var\{$tb\} = \"$2\";"; } 124 my $var = $attr_to_hash{$key}; 125 126 if ($var) { $tbparams->{$tb}->{$var} = $2; } 134 127 else { warn "Unknown keyword $key in $file\n"; } 135 128 … … 218 211 } 219 212 220 221 222 223 213 # Start a sub section of the experiment on a given testbed. The testbed and 224 214 # the user to start the experiment as are pulled from the global per-testbed 225 # hash, as is the project name on the remote testbed. Parameters are the 226 # testbed and the experiment id. Configuration files are scp-ed over to the 227 # target testbed from the global $tmpdir/$tb directory. Then the current state 228 # of the experiment determined using expinfo. From that state, the experiment 229 # is either created, modified or spapped in. If everything succeeds, true is 230 # returned. If the global verbose is set progress messages are printed. 215 # hash, passed in as $tbparams, as is the project name on the remote testbed. 216 # Parameters are the testbed and the experiment id. Configuration files are 217 # scp-ed over to the target testbed from the global $tmpdir/$tb directory. 218 # Then the current state of the experiment determined using expinfo. From that 219 # state, the experiment is either created, modified or spapped in. If 220 # everything succeeds, true is returned. If the global verbose is set progress 221 # messages are printed. 231 222 sub start_segment { 232 my($tb, $eid) = @_; # testbed and experiment ID 233 my($host) = "$host{$tb}$domain{$tb}"; # Host name of remote ops (FQDN) 234 my($user) = $user{$tb}; # user to pass to ssh 235 my($pid) = $project{$tb}; # remote project to start the 223 my($tb, $eid, $tbparams) = @_; # testbed, experiment ID, and 224 # per-testbed parameters 225 my $host = # Host name of remote ops (FQDN) 226 $tbparams->{$tb}->{'host'} . $tbparams->{$tb}->{'domain'}; 227 my $user = $tbparams->{$tb}->{'user'}; # user to pass to ssh 228 my $pid = $tbparams->{$tb}->{'project'};# remote project to start the 236 229 # experiment under 237 my ($tclfile)= "./$eid.$tb.tcl"; # Local tcl file with the230 my $tclfile = "./$eid.$tb.tcl"; # Local tcl file with the 238 231 # sub-experiment 239 my ($proj_dir)= "/proj/$pid/exp/$eid/tmp"; # Where to stash federation stuff240 my ($tarfiles_dir)= "/proj/$pid/tarfiles/$eid"; # Where to stash tarfiles241 my ($to_hostname) = "$proj_dir/hosts";# remote hostnames file242 my ($state); # State of remote experiment243 my ($status)= new IO::Pipe; # The pipe to get status232 my $proj_dir = "/proj/$pid/exp/$eid/tmp"; # Where to stash federation stuff 233 my $tarfiles_dir = "/proj/$pid/tarfiles/$eid"; # Where to stash tarfiles 234 my $to_hostname = "$proj_dir/hosts"; # remote hostnames file 235 my $state; # State of remote experiment 236 my $status = new IO::Pipe; # The pipe to get status 244 237 245 238 # Determine the status of the remote experiment … … 352 345 # start_segment, though much simpler. 353 346 sub stop_segment { 354 my($tb, $eid) = @_; 355 my($user) = "$user{$tb}"; 356 my($host) = "$host{$tb}$domain{$tb}"; 357 my($pid) = $project{$tb}; 347 my($tb, $eid, $tbparams) = @_; # testbed, experiment ID and 348 # per-testbed parameters 349 my $user = $tbparams->{$tb}->{'user'}; # testbed user 350 my $host = # Ops node 351 $tbparams->{$tb}->{'host'} . $tbparams->{$tb}->{'domain'}; 352 my $pid = $tbparams->{$tb}->{'project'};# testbed project 358 353 359 354 print "Stopping $eid on $tb\n" if $verbose; … … 421 416 422 417 if ($opts{'N'} ) { 423 &parse_testbeds($tb_config ) ||418 &parse_testbeds($tb_config, $tbparams) || 424 419 die "Cannot testbed congfigurations from $tb_config: $!\n"; 425 420 } … … 433 428 my($tb, $h, $d, $u, $p, $es, $gs, $mes, $mgs, $t, $i, $fs, $boss, 434 429 $tun) = split(":", $_); 435 $ host{$tb} = $h;436 $ user{$tb} = $u;437 $ domain{$tb} = $d;438 $ project{$tb} = $p;439 $ gwtype{$tb} = $t;440 $ expstart{$tb} = $es;441 $ gwstart{$tb} = $gs;442 $ mexpstart{$tb} = $mes;443 $ mgwstart{$tb} = $mgs;444 $ gwimage{$tb} = $i;445 $ fs{$tb} = $fs;446 $ boss{$tb} = $boss;447 $t un{$tb} = $tun;430 $tbparams->{$tb}->{'host'} = $h; 431 $tbparams->{$tb}->{'user'} = $u; 432 $tbparams->{$tb}->{'domain'} = $d; 433 $tbparams->{$tb}->{'project'} = $p; 434 $tbparams->{$tb}->{'gwtype'} = $t; 435 $tbparams->{$tb}->{'expstart'} = $es; 436 $tbparams->{$tb}->{'gwstart'} = $gs; 437 $tbparams->{$tb}->{'mexpstart'} = $mes; 438 $tbparams->{$tb}->{'mgwstart'} = $mgs; 439 $tbparams->{$tb}->{'gwimage'} = $i; 440 $tbparams->{$tb}->{'fs'} = $fs; 441 $tbparams->{$tb}->{'boss'} = $boss; 442 $tbparams->{$tb}->{'tun'} = $tun; 448 443 449 444 # Make sure the domain starts with a period 450 $domain{$tb} = ".$domain{$tb}" unless $domain{$tb} =~ /^\./; 445 $tbparams->{$tb}->{'domain'} = "." . $tbparams->{$tb}->{'domain'} 446 unless $tbparams->{$tb}->{'domain'} =~ /^\./; 451 447 } 452 448 $conf->close(); … … 460 456 461 457 # Parsing variables 462 my ($ctb); # Current testbed463 my (%allocated); # If allocated{$tb} > 0, $tb is in use464 my ($destfile); # File that the sub-experiment tcl file is458 my $ctb; # Current testbed 459 my %allocated; # If allocated{$tb} > 0, $tb is in use 460 my $destfile; # File that the sub-experiment tcl file is 465 461 # being written to, or "" if none. Also used 466 462 # for hostnames file. 467 my ($gateways); # when gateway lists are being processed this463 my $gateways; # when gateway lists are being processed this 468 464 # is the testbed whose gateways are being 469 465 # gathered. 470 my ($control_gateway); # Control net gateway for the current testbed471 my (%active_end);# If active_end{"a-b"} > 0 then a is the active466 my $control_gateway; # Control net gateway for the current testbed 467 my %active_end; # If active_end{"a-b"} > 0 then a is the active 472 468 # end of the a <-> b connector pair. 473 469 … … 482 478 # description. If not, warn the caller and ignore the configuration of 483 479 # this testbed. 484 if ($ host{$ctb}) {480 if ($tbparams->{$ctb}) { 485 481 $allocated{$ctb}++; # Keep track of the testbeds allocated 486 482 … … 535 531 if ($control_gateway ) { 536 532 # Client config 537 my ($cc)= new IO::File(">$tmpdir/$gateways/client.conf");533 my $cc = new IO::File(">$tmpdir/$gateways/client.conf"); 538 534 die "Can't open $tmpdir/$gateways/client.conf: $!\n" unless $cc; 539 535 print $cc "ControlGateway: $control_gateway\n"; … … 565 561 chomp; 566 562 my($dtb, $myname, $desthost, $type) = split(" ", $_); 567 my($sdomain) = $domain{$gateways}; # domain for the source 568 my($ddomain) = $domain{$dtb}; # domain for the destination 569 my($sproject) = $project{$gateways}; # Project of the destination 570 my($active); # Is this the active side of 563 564 # Many of these are to simplify print statements 565 my $sdomain = # domain for the source 566 $tbparams->{$gateways}->{'domain'}; 567 my $ddomain = # domain for the destination 568 $tbparams->{$dtb}->{'domain'}; 569 my $sproject = # Project of the destination 570 $tbparams->{$gateways}->{'project'}; 571 my $fs = # Master fs node (FQDN) 572 $tbparams->{$master}->{'fs'} . $tbparams->{$master}->{'domain'}; 573 my $boss = # Master boss node (FQDN) 574 $tbparams->{$master}->{'boss'} . $tbparams->{$master}->{'domain'}; 575 my $remote_script_dir = # Remote fed script location 576 "/proj/" . $tbparams->{$dtb}->{'project'} . "/exp/$eid/tmp"; 577 my $active; # Is this the active side of 571 578 # the connector? 572 579 573 $sdomain = ".$eid. $project{$gateways}$sdomain";574 $ddomain = ".$eid. $project{$dtb}$ddomain";575 576 my ($conf_file)= "$myname$sdomain.gw.conf";580 $sdomain = ".$eid." . $tbparams->{$gateways}->{'project'} . "$sdomain"; 581 $ddomain = ".$eid." . $tbparams->{$dtb}->{'project'} . "$ddomain"; 582 583 my $conf_file = "$myname$sdomain.gw.conf"; 577 584 # translate to lower case so the `hostname` hack for specifying 578 585 # configuration files works. … … 597 604 598 605 print $gwconfig "Active: $active\n"; 599 print $gwconfig "TunnelCfg: $tun{$gateways}\n";600 print $gwconfig "BossName: $boss {$master}$domain{$master}\n";601 print $gwconfig "FsName: $fs {$master}$domain{$master}\n";606 print $gwconfig "TunnelCfg: " . $tbparams->{$gateways}->{'tun'} . "\n"; 607 print $gwconfig "BossName: $boss\n"; 608 print $gwconfig "FsName: $fs\n"; 602 609 print $gwconfig "Type: $type\n"; 603 print $gwconfig "RemoteScriptDir: /proj/$project{$dtb}/exp/$eid/tmp\n";610 print $gwconfig "RemoteScriptDir: $remote_script_dir\n"; 604 611 print $gwconfig "Peer: $desthost$ddomain\n"; 605 612 print $gwconfig "Pubkeys: " . … … 636 643 637 644 next unless $destfile; # Unidentified testbed, ignore config 645 # local copies that can be used in the substitutions below 646 my $gwtype = $tbparams->{$ctb}->{'gwtype'}; 647 my $gwimage = $tbparams->{$ctb}->{'gwimage'}; 648 my $mgwstart = $tbparams->{$ctb}->{'mgwstart'}; 649 my $mexpstart = $tbparams->{$ctb}->{'mexpstart'}; 650 my $gwstart = $tbparams->{$ctb}->{'gwstart'}; 651 my $expstart = $tbparams->{$ctb}->{'expstart'}; 652 my $project = $tbparams->{$ctb}->{'project'}; 638 653 639 654 # Substitute variables 640 s/GWTYPE/$gwtype {$ctb}/g;641 s/GWIMAGE/$gwimage {$ctb}/g;655 s/GWTYPE/$gwtype/g; 656 s/GWIMAGE/$gwimage/g; 642 657 if ($ctb eq $master ) { 643 s/GWSTART/$mgwstart {$ctb}/g;644 s/EXPSTART/$mexpstart {$ctb}/g;658 s/GWSTART/$mgwstart/g; 659 s/EXPSTART/$mexpstart/g; 645 660 } 646 661 else { 647 s/GWSTART/$gwstart {$ctb}/g;648 s/EXPSTART/$expstart {$ctb}/g;662 s/GWSTART/$gwstart/g; 663 s/EXPSTART/$expstart/g; 649 664 } 650 665 # XXX: oh is this bad 651 666 s#GWCONF#FEDDIR\`hostname\`.gw.conf#g; 652 s#PROJDIR#/proj/$project {$ctb}/#g;667 s#PROJDIR#/proj/$project/#g; 653 668 s#EID#$eid#g; 654 s#FEDDIR#/proj/$project {$ctb}/exp/$eid/tmp/#g;669 s#FEDDIR#/proj/$project/exp/$eid/tmp/#g; 655 670 print FILE; 656 671 } … … 670 685 exit(0) unless $startem; 671 686 672 my (%started); # If $started{$tb} then $tb successfully started687 my %started; # If $started{$tb} then $tb successfully started 673 688 674 689 # Start up the slave sub-experiments first … … 676 691 for my $tb (keys %allocated) { 677 692 if ($tb ne $master) { 678 if (&start_segment($tb, $eid )) { $started{$tb}++; }693 if (&start_segment($tb, $eid, $tbparams)) { $started{$tb}++; } 679 694 else { last TESTBED; } 680 695 } … … 682 697 683 698 # Now the master 684 if (&start_segment($master, $eid )) {699 if (&start_segment($master, $eid, $tbparams)) { 685 700 $started{$master}++; 686 701 } … … 688 703 # If any testbed failed, swap the rest out. 689 704 if ( scalar(keys %started) != scalar(keys %allocated)) { 690 for my $tb (keys %started) { &stop_segment($tb, $eid ); }705 for my $tb (keys %started) { &stop_segment($tb, $eid, $tbparams); } 691 706 print "Error starting experiment\n"; 692 707 exit(1);
Note: See TracChangeset
for help on using the changeset viewer.