Changeset 7c3008e for fedkit

Timestamp:

May 22, 2008 7:09:10 AM (16 years ago)

Author:

Ted Faber <faber@…>

Branches:

axis_example, compt_changes, info-ops, master, version-1.30, version-2.00, version-3.01, version-3.02

Children:

2aeb39e

Parents:

f778038

Message:

checkpoint

Location:

fedkit

Files:

• fed_bootstrap (modified) (1 diff)
• federate.sh (modified) (1 diff)
• genviz.pl (added)
• make_hosts (modified) (1 diff)
• parsevis.py (added)
• parsevt.py (added)
• splitter.pl (modified) (6 diffs)

fedkit/fed_bootstrap

@@ -29 +29 @@
 # federation script, and run it.
 cd /tmp
-exec /tmp/federate.sh
+exec /tmp/federate.sh "$1" "$2"

fedkit/federate.sh

@@ -166 +166 @@
 /usr/local/etc/emulab/rc/rc.route boot
 
+# And restore the ifconfig information because SEER wants it. (SEER pulls this
+# from tmcc now
+# "$EMUDIR/tmcc" ifconfig > /var/emulab/boot/tmcc/ifconfig
+
+# SEER feels pain and confusion if times are wrong.  This lays a big lick on
+# ntp sets the time directly and then restarts it.  XXX FreeBSD incantation is
+# untested.
+
+case `uname` in 
+        "FreeBSD")
+                /etc/rc.d/ntpd stop
+                /usr/sbin/ntpdate boss
+                /etc/rc.d/ntpd start
+                ;;
+        "Linux")
+                /etc/rc.d/init.d/ntpd stop
+                /usr/sbin/ntpdate boss
+                /etc/rc.d/init.d/ntpd start
+                ;;
+esac
+
 # Execute any command passed in as a startcmd.  This basically daisy chains the
-# startcmd.
+# startcmd.  This needs to become a perl script to have uniform behavior here.
+echo "*$1* *$2*"
 if [ ! -z "$1" ]; then 
-        su -l "$1" -c "$2"
-fi
+        echo "calling *$1* *$2*"
+        case `uname` in
+                "FreeBSD")
+                        su -l "$1" -c "$2"
+                        ;;
+                "Linux")
+                        su "$1" --command="$2"
+                        ;;
+        esac
+fi

fedkit/make_hosts

@@ -18 +18 @@
 /usr/local/etc/emulab/rc/rc.route 
 
+# SEER feels pain and confusion if times are wrong.  This lays a big lick on
+# ntp sets the time directly and then restarts it.  XXX FreeBSD incantation is
+# untested.
+
+case `uname` in 
+        "FreeBSD")
+                /etc/rc.d/ntpd stop
+                /usr/sbin/ntpdate boss
+                /etc/rc.d/ntpd start
+                ;;
+        "Linux")
+                /etc/rc.d/init.d/ntpd stop
+                /usr/sbin/ntpdate boss
+                /etc/rc.d/init.d/ntpd start
+                ;;
+esac
+
+# Execute any command passed in as a startcmd.  This basically daisy chains the
+# startcmd.  This needs to become a perl script to have uniform behavior here.
+echo "*$2* *$3*"
 if [ ! -z "$2" ]; then 
-        su -l "$2" -c "$3"
+        echo "calling *$2* *$3*"
+        case `uname` in
+                "FreeBSD")
+                        su -l "$2" -c "$3"
+                        ;;
+                "Linux")
+                        su "$2" --command="$3"
+                        ;;
+        esac
 fi

fedkit/splitter.pl

@@ -8 +8 @@
 use IO::Pipe;
 use File::Copy;
+use XML::Parser;
 
 my @scripts = ("fed_bootstrap", "federate.sh", "smbmount.FreeBSD.pl", 
@@ -352 +353 @@
         &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
             return 0;
+        # Copy the virtual topology out as well
+        &scp_file("$tmpdir/vtopo.xml", $user, $host, "$proj_dir/vtopo.xml") ||
+            return 0;
+        &scp_file("$tmpdir/viz.xml", $user, $host, "$proj_dir/viz.xml") ||
+            return 0;
         &ship_scripts($host, $user, $proj_dir) || return 0;
         &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
@@ -378 +384 @@
         &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
             return 0;
+        # Copy the virtual topology out as well
+        &scp_file("$tmpdir/vtopo.xml", $user, $host, "$proj_dir/vtopo.xml") ||
+            return 0;
+        &scp_file("$tmpdir/viz.xml", $user, $host, "$proj_dir/viz.xml") ||
+            return 0;
+        &ship_scripts($host, $user, $proj_dir) || return 0;
         &ship_scripts($host, $user, $proj_dir) || return 0;
         &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
@@ -425 +437 @@
         &scp_file("$tmpdir/hostnames", $user, $host, $to_hostname) ||
             return 0;
+        # Copy the virtual topology out as well
+        &scp_file("$tmpdir/vtopo.xml", $user, $host, "$proj_dir/vtopo.xml") ||
+            return 0;
+        &scp_file("$tmpdir/viz.xml", $user, $host, "$proj_dir/viz.xml") ||
+            return 0;
+        &ship_scripts($host, $user, $proj_dir) || return 0;
         &ship_scripts($host, $user, $proj_dir) || return 0;
         &ship_configs($host, $user, "$tmpdir/$tb", $proj_dir) || return 0;
@@ -477 +495 @@
     unlink("/tmp/splitter.$$", "/tmp/splitter.err.$$");
     return $rv;
+}
+
+# Generate visualization info from the topo file.
+sub genviz {
+    my($file, $outfile)= @_;
+    my %nodes;
+    my $chars;
+    my $in_node;
+    my $in_lan;
+    my $lan;
+    my %links;
+    my %lans;
+    my $rv;
+    my $dotfile = "/tmp/split$$.dot";
+    my $neato = "/usr/local/bin/neato";
+    my $g = new IO::File(">$dotfile") || return;
+    my $p = new IO::Pipe() || return;
+    my $out = new IO::File(">$outfile") || die "open $!\n";
+
+    sub start_element { 
+        my($expat, $element) = @_;
+        $in_node++ if $element eq "node";
+        if ( $element eq "lan" ) {
+            $in_lan++;
+            $lan = {};
+        }
+    }
+
+    sub end_element {
+        my($expat, $element) = @_;
+
+        $in_node = 0 if $element eq "node";
+        $nodes{$chars} = "node" if $in_node && $element eq "vname";
+        if ($in_lan) {
+            if ( $element ne "lan") {
+                $lan->{$element} = $chars if $element =~/(vname|vnode)/;
+            }
+            else {
+                $in_lan = 0;
+                my $vname = $lan->{'vname'};
+                if ( $links{$vname} && @{$links{$vname}} ==2 ) {
+                    # this link needs to be a lan
+                    $nodes{$vname} = "lan";
+                    $lans{$lan->{'vname'}} = ();
+                    foreach my $l (@{$links{$vname}}) {
+                        push(@{$lans{$vname}}, $l);
+                    }
+                    push(@{$lans{$vname}}, $lan->{'vnode'});
+                    delete $links{$vname};
+                    $lan={};
+                    return;
+                }
+                if ( $lans{$vname} && @{$lans{$vname}}) {
+                    push(@{$lans{$vname}}, $lan->{'vnode'});
+                    $lan = {};
+                    return;
+                }
+                $links{$vname} = () unless $links{$vname};
+                push(@{$links{$vname}}, $lan->{'vnode'});
+                $lan = {};
+                return;
+            }
+        }
+    }
+    sub found_chars { 
+        my($expat, $data) = @_;
+        $chars = $data;
+    }
+
+    my $parser = new XML::Parser(Handlers => { 
+            Start => \&start_element, 
+            End => \&end_element,
+            Char => \&found_chars
+        });
+
+    print "$file\n";
+    $parser->parsefile($file);
+
+    print $g "graph G {\n";
+    foreach my $n (keys %nodes) {
+        print $g "\t\"$n\"\n";
+    }
+    foreach my $l (keys %links) {
+        print $g "\t", join(" -- ", @{$links{$l}}), "\n";
+    }
+    foreach my $l (keys %lans) {
+        foreach my $n (@{$lans{$l}}) {
+            print $g "\t \"$n\" -- \"$l\"\n";
+        }
+    }
+    print $g "}\n";
+    $g->close();
+    $p->reader("$neato  -Gstart=rand -Gepsilon=0.005 -Gmaxiter=20000 " .
+        "-Gpack=true $dotfile");
+    print $out "<vis>\n";
+    while (<$p>) {
+        /^\s*"?([\w\-]+)"?\s+\[.*pos=\"(\d+),(\d+)\"/ && do {
+            my ($n, $x, $y) = ($1, $2, $3);
+
+            print $out "<node><name>$n</name><x>$x</x><y>$y</y><type>" . 
+                "$nodes{$n}</type></node>\n" if $nodes{$n};
+        };
+    }
+    print $out "</vis>\n";
+    $p->close();
+    unlink("$dotfile");
 }
 
@@ -583 +707 @@
 my %active_end;                 # If active_end{"a-b"} > 0 then a is the active
                                 # end of the a <-> b connector pair.
+my $vtopo;                      # IO::File for virtual topology info
 
 # Parse the splitter output.  This loop creates the sub experiments, gateway
 # configurations and hostnames file
 while (<$pipe>) {
-    # Vtopo is virtual topology about the entire experiment.  Right now ignore
-    # it.  We'll pass it to SEER soon.
+    # Vtopo is virtual topology about the entire experiment. Copy it to the
+    # $tmpdir for distribution far and wide.
     (/^#\s+Begin\s+Vtopo/../^#\s+End\s+Vtopo/) && do {
+        /^#\s+Begin/ && do {
+            $vtopo = new IO::File(">$tmpdir/vtopo.xml");
+            warn "Can't open $tmpdir/vtopo.xml:$!\n" unless $vtopo;
+            next;
+        };
+        /^#\s+End/ && do {
+            $vtopo->close() if $vtopo;
+            undef $vtopo;
+            genviz("$tmpdir/vtopo.xml", "$tmpdir/viz.xml");
+            next;
+        };
+        print $vtopo $_  if $vtopo;
         next;
     };