source: fedkit/fed-tun.pl @ c9f5490

#!/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");
}