Index: fedkit/fed-tun.pl
===================================================================
--- fedkit/fed-tun.pl	(revision c9f5490de9955aea5c32a72e90eaa8df37c1130a)
+++ fedkit/fed-tun.pl	(revision c9f5490de9955aea5c32a72e90eaa8df37c1130a)
@@ -0,0 +1,231 @@
+#!/usr/bin/perl -w
+
+# Kevin Lahey, lahey@isi.edu
+# July 11, 2007
+
+# Set up ssh tunnel infrastructure for federation:
+# 
+# * Set up the synchronization system
+# 
+# * Figure out our location.
+#   From DETER:
+# 	+ bring up em0 and assign the appropriate address (with only one
+#         tunnel node, this'll be static)
+# 	+ ssh out to WAIL node using the experiment name, creating a tunnel
+# 	for each of the experimental interfaces that is up (one, for now)
+# 
+#   From WAIL:
+#       + exit and wait for the ssh from DETER, which'll trigger the
+#	setup of everything else
+# 
+# * pick out the experimental interface, remove the IP address
+# 
+# * identify the tun interface created, and bridge it to the 
+#   experimental interface
+
+use strict;
+use Getopt::Std;
+use POSIX qw(strftime);
+use Sys::Hostname;
+
+my $TMCC = "/usr/local/etc/emulab/tmcc";
+my $SSH = "/usr/local/bin/ssh";
+my $HOME = "/users/lahey";
+
+# Where are we gonna get this info from!?  Hardcoding is definitely not
+# gonna happen!
+
+my $tunnel_ip = "206.117.25.26";
+my $tunnel_iface = "em0";
+my $remote_node = "detertunnel.";
+my $remote_node_domain = ".deter.emulab.net";
+my $ssh_port_fwds = "-R :139:users.isi.deterlab.net:139 -R :7777:boss.isi.deterlab.net:7777";
+
+my $debug = 1;
+my $remote;
+
+my $count;
+my $addr;
+
+sub find_new_tun;
+sub setup_network($; $; $; $);
+
+# Option use is as follows:
+#    -r         remote execution on WAIL;  set up as appropriate
+
+my $usage = "Usage: fed-tun.pl [-t remote-testbed-fqdn] [-r hostname count]\n";
+
+my %opts;
+if ($#ARGV != 0 && !getopts('rt:', \%opts)) {
+    die "$usage";
+}
+
+
+if (defined($opts{'t'})) {
+    $remote_node_domain = $opts{'t'};
+}
+
+if (defined($opts{'r'})) {
+    $remote = 1;
+    die "$usage" if ($#ARGV != 1);
+    
+    $count = pop @ARGV;
+    $addr = pop @ARGV;
+}
+
+# Set up synchronization, so that the various user machines won't try to
+# contact boss before the tunnels are set up.
+
+# XXX:  put off for now
+
+# Need these to make the Ethernet tap and bridge to work...
+
+system("kldload /boot/kernel/if_bridge.ko");
+system("kldload /boot/kernel/if_tap.ko");
+
+# Ask tmcd to figure out experiment and project;  these should
+# be available as environment variables (PID, EID, and NODE) for
+# a startup script, but if run explicitly, we might not have 'em.
+
+my $project;
+my $experiment;
+my $node_id;
+
+open(TMCD, "$TMCC status |") || die "tmcc failed\n";
+while (<TMCD>) {
+    print if ($debug);
+    if (/ALLOCATED=([\w\-]+)\/([\w\-]+) NICKNAME=([\w\-]+)/) {
+	$project = $1;
+	$experiment = $2;
+	$node_id = $3;
+    }
+}
+close(TMCD);
+
+die "Didn't find experiment or project name\n" if (!$project || !$experiment);
+
+print "project $project experiment $experiment node $node_id\n" if ($debug);
+
+
+# Figure out whether we're sourcing the tunnel or sinking it.  For now
+# I'll do something ugly and use the hostname.
+
+my $hostname = hostname();
+my @names = split(/\./, $hostname);
+
+if ($#names > 1) {
+    my $domain = $names[$#names - 1];
+    if (!$remote && $domain ne "deterlab") {
+	# Fix up ssh (ugh!)
+	system("sed 's/tunnel.simplefed/wailtunnel.$experiment/' $HOME/root-id_rsa.pub >> /root/.ssh/authorized_keys");
+	die "Not on DETER;  exiting for now\n";
+    }
+} else {
+    die "Failed to find a name for this host;  exiting\n";
+}
+
+if (!$remote) {
+    # If we're at DETER, open up a separate tunnel to the remote host for
+    # each of the different experiment net interfaces on this machine.
+    # Execute this startup script on the far end, but with the -r option 
+    # to indicate that it's getting invoked remotely and should start 
+    # setting up.
+
+    # Lame DETER setup hacks:
+
+    system("ifconfig $tunnel_iface $tunnel_ip");
+    system("route add -net 198.133.225.59 -netmask 0xffffff00 206.117.25.1");
+    system("route add -net 155.98.33.0 -netmask 0xfffff000 206.117.25.1");
+    system("route add 128.9.160.161 206.117.25.1");
+
+    # XXX:  fix up ssh.  Ugh.
+
+    system("cp $HOME/root-id_rsa /root/.ssh/id_rsa");
+    system("cp $HOME/root-id_rsa.pub /root/.ssh/id_rsa.pub");
+
+    # XXX:  Do we need to clear out previously created bridge interfaces?
+
+    my $remote_name = $remote_node . $experiment . $remote_node_domain;
+    my $count = 0;
+
+    open(IFFILE, "/var/emulab/boot/ifmap") || die "couldn't open ifmap\n";
+    while (<IFFILE>) {
+	my @a = split(' ');
+	my $iface = $a[0];
+	my $addr = $a[1];
+	my $bridge = "bridge" . $count;
+	my $tun = "tap" . $count;
+
+	print "Found $iface, $addr, to bridge on $bridge\n" if ($debug);
+
+	system("$SSH -w $count:$count $ssh_port_fwds $remote_name \"$HOME/fed-tun.pl -r $addr $count\" &");
+
+	# XXX:  Ack, ssh will never return, since it's doing tunneling.
+	#       Unfortunately, though, it also could take quite a few seconds
+	#       to do the DNS lookup and actually run the command on the
+	#       other side.  Hence, the delay.  Shudder:
+
+	sleep 10;
+
+	setup_network($tun, $bridge, $iface, $addr);
+	$count++;
+    }
+    close(IFFILE);
+} else {
+    # We're on the remote system;  for now, we just grab and use
+    # the one experimental interface.  Later, we'll actually look
+    # at the address passed to match up the appropriate interfaces.
+
+    my $iter = 0;
+
+    open(IFFILE, "/var/emulab/boot/ifmap") || die "couldn't open ifmap\n";
+    while (<IFFILE>) {
+	die "Argh, too many experimental interfaces!" if ($iter > 0);
+	my @a = split(' ');
+	my $iface = $a[0];
+	my $addr = $a[1];
+	my $bridge = "bridge" . $count;
+	my $tun = "tap" . $count;
+
+	setup_network($tun, $bridge, $iface, $addr);
+	$iter++;
+    }
+    close(IFFILE);
+}
+
+print "all done!\n" if ($debug);
+exit;
+
+# XXX:  Unused.  Find the name of the new tunnel interface
+
+my %tuns_used;
+
+sub find_new_tun {
+    my @tuns = split(/ /, `ifconfig -l`);
+    my $tun;
+
+    print @tuns . "\n";
+
+    foreach my $tun (@tuns) {
+	print "Looking at $tun\n";
+	if (!$tuns_used{$tun}) {
+	    $tuns_used{$tun} = 1;
+	    print "Found $tun\n";
+	    return $tun;
+	}
+    }
+}
+
+# Set up the bridging for the new stuff...
+
+sub setup_network($; $; $; $) {
+    my ($tun, $bridge, $iface, $addr) = @_;
+
+    print "Got new $tun\n" if ($debug);
+    print "setting up $bridge with $iface and nuking $addr\n" if ($debug);
+
+    system("ifconfig $bridge create");
+    system("ifconfig $iface delete $addr");
+    system("ifconfig $bridge addm $iface up");
+    system("ifconfig $bridge addm $tun");
+}
