Changeset 7c3008e for fedkit/splitter.pl
- Timestamp:
- May 22, 2008 7:09:10 AM (16 years ago)
- Branches:
- axis_example, compt_changes, info-ops, master, version-1.30, version-2.00, version-3.01, version-3.02
- Children:
- 2aeb39e
- Parents:
- f778038
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
fedkit/splitter.pl
rf778038 r7c3008e 8 8 use IO::Pipe; 9 9 use File::Copy; 10 use XML::Parser; 10 11 11 12 my @scripts = ("fed_bootstrap", "federate.sh", "smbmount.FreeBSD.pl", … … 352 353 &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) || 353 354 return 0; 355 # Copy the virtual topology out as well 356 &scp_file("$tmpdir/vtopo.xml", $user, $host, "$proj_dir/vtopo.xml") || 357 return 0; 358 &scp_file("$tmpdir/viz.xml", $user, $host, "$proj_dir/viz.xml") || 359 return 0; 354 360 &ship_scripts($host, $user, $proj_dir) || return 0; 355 361 &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0; … … 378 384 &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) || 379 385 return 0; 386 # Copy the virtual topology out as well 387 &scp_file("$tmpdir/vtopo.xml", $user, $host, "$proj_dir/vtopo.xml") || 388 return 0; 389 &scp_file("$tmpdir/viz.xml", $user, $host, "$proj_dir/viz.xml") || 390 return 0; 391 &ship_scripts($host, $user, $proj_dir) || return 0; 380 392 &ship_scripts($host, $user, $proj_dir) || return 0; 381 393 &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0; … … 425 437 &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) || 426 438 return 0; 439 # Copy the virtual topology out as well 440 &scp_file("$tmpdir/vtopo.xml", $user, $host, "$proj_dir/vtopo.xml") || 441 return 0; 442 &scp_file("$tmpdir/viz.xml", $user, $host, "$proj_dir/viz.xml") || 443 return 0; 444 &ship_scripts($host, $user, $proj_dir) || return 0; 427 445 &ship_scripts($host, $user, $proj_dir) || return 0; 428 446 &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0; … … 477 495 unlink("/tmp/splitter.$$", "/tmp/splitter.err.$$"); 478 496 return $rv; 497 } 498 499 # Generate visualization info from the topo file. 500 sub genviz { 501 my($file, $outfile)= @_; 502 my %nodes; 503 my $chars; 504 my $in_node; 505 my $in_lan; 506 my $lan; 507 my %links; 508 my %lans; 509 my $rv; 510 my $dotfile = "/tmp/split$$.dot"; 511 my $neato = "/usr/local/bin/neato"; 512 my $g = new IO::File(">$dotfile") || return; 513 my $p = new IO::Pipe() || return; 514 my $out = new IO::File(">$outfile") || die "open $!\n"; 515 516 sub start_element { 517 my($expat, $element) = @_; 518 $in_node++ if $element eq "node"; 519 if ( $element eq "lan" ) { 520 $in_lan++; 521 $lan = {}; 522 } 523 } 524 525 sub end_element { 526 my($expat, $element) = @_; 527 528 $in_node = 0 if $element eq "node"; 529 $nodes{$chars} = "node" if $in_node && $element eq "vname"; 530 if ($in_lan) { 531 if ( $element ne "lan") { 532 $lan->{$element} = $chars if $element =~/(vname|vnode)/; 533 } 534 else { 535 $in_lan = 0; 536 my $vname = $lan->{'vname'}; 537 if ( $links{$vname} && @{$links{$vname}} ==2 ) { 538 # this link needs to be a lan 539 $nodes{$vname} = "lan"; 540 $lans{$lan->{'vname'}} = (); 541 foreach my $l (@{$links{$vname}}) { 542 push(@{$lans{$vname}}, $l); 543 } 544 push(@{$lans{$vname}}, $lan->{'vnode'}); 545 delete $links{$vname}; 546 $lan={}; 547 return; 548 } 549 if ( $lans{$vname} && @{$lans{$vname}}) { 550 push(@{$lans{$vname}}, $lan->{'vnode'}); 551 $lan = {}; 552 return; 553 } 554 $links{$vname} = () unless $links{$vname}; 555 push(@{$links{$vname}}, $lan->{'vnode'}); 556 $lan = {}; 557 return; 558 } 559 } 560 } 561 sub found_chars { 562 my($expat, $data) = @_; 563 $chars = $data; 564 } 565 566 my $parser = new XML::Parser(Handlers => { 567 Start => \&start_element, 568 End => \&end_element, 569 Char => \&found_chars 570 }); 571 572 print "$file\n"; 573 $parser->parsefile($file); 574 575 print $g "graph G {\n"; 576 foreach my $n (keys %nodes) { 577 print $g "\t\"$n\"\n"; 578 } 579 foreach my $l (keys %links) { 580 print $g "\t", join(" -- ", @{$links{$l}}), "\n"; 581 } 582 foreach my $l (keys %lans) { 583 foreach my $n (@{$lans{$l}}) { 584 print $g "\t \"$n\" -- \"$l\"\n"; 585 } 586 } 587 print $g "}\n"; 588 $g->close(); 589 $p->reader("$neato -Gstart=rand -Gepsilon=0.005 -Gmaxiter=20000 " . 590 "-Gpack=true $dotfile"); 591 print $out "<vis>\n"; 592 while (<$p>) { 593 /^\s*"?([\w\-]+)"?\s+\[.*pos=\"(\d+),(\d+)\"/ && do { 594 my ($n, $x, $y) = ($1, $2, $3); 595 596 print $out "<node><name>$n</name><x>$x</x><y>$y</y><type>" . 597 "$nodes{$n}</type></node>\n" if $nodes{$n}; 598 }; 599 } 600 print $out "</vis>\n"; 601 $p->close(); 602 unlink("$dotfile"); 479 603 } 480 604 … … 583 707 my %active_end; # If active_end{"a-b"} > 0 then a is the active 584 708 # end of the a <-> b connector pair. 709 my $vtopo; # IO::File for virtual topology info 585 710 586 711 # Parse the splitter output. This loop creates the sub experiments, gateway 587 712 # configurations and hostnames file 588 713 while (<$pipe>) { 589 # Vtopo is virtual topology about the entire experiment. Right now ignore590 # it. We'll pass it to SEER soon.714 # Vtopo is virtual topology about the entire experiment. Copy it to the 715 # $tmpdir for distribution far and wide. 591 716 (/^#\s+Begin\s+Vtopo/../^#\s+End\s+Vtopo/) && do { 717 /^#\s+Begin/ && do { 718 $vtopo = new IO::File(">$tmpdir/vtopo.xml"); 719 warn "Can't open $tmpdir/vtopo.xml:$!\n" unless $vtopo; 720 next; 721 }; 722 /^#\s+End/ && do { 723 $vtopo->close() if $vtopo; 724 undef $vtopo; 725 genviz("$tmpdir/vtopo.xml", "$tmpdir/viz.xml"); 726 next; 727 }; 728 print $vtopo $_ if $vtopo; 592 729 next; 593 730 };
Note: See TracChangeset
for help on using the changeset viewer.