#!/usr/bin/perl -wT
#
# Copyright (c) 2000-2011 University of Utah and the Flux Group.
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
#
# TODO: Startup command in rc.ixp. Use old version.

use English;
use Getopt::Std;
use Socket;
use IO::Handle;
use POSIX qw(strftime);

sub ddijkstra($);

#
# Boot an ixp.
#
sub usage()
{
    print "Usage: ixpboot [-d] <ixp>\n";
    exit(1);
}
my $optlist	= "d";
my $debug       = 0;
my $ipxid;
my $success     = 0;

# Drag in path stuff so we can find emulab stuff.
BEGIN { require "/etc/emulab/paths.pm"; import emulabpaths; }

# Turn off line buffering on output
$| = 1;

#
# Load the OS independent support library. It will load the OS dependent
# library and initialize itself. 
# 
use libsetup;
use libtmcc;
use libtestbed qw(TBBackGround);

# Need this below
my ($pid, $eid) = check_nickname();

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
if (!@ARGV) {
    usage();
}
$ixpid = $ARGV[0];

if ($ixpid =~ /^([-\w]+)$/) {
    $ixpid = $1;
}
else {
    die("Bad data in ixpid: $ixpid.");
}

#
# All of the goop is located here. I am using it just as Abhijeet left it.
#
my %config	= ();
my $logname     = "$LOGDIR/subnode-${ixpid}.log";
my $RCDIR	= "$BINDIR/rc";
my $ixpdir	= "/opt/ixasdk/enp-2505/bootixp";
my $armdir	= "/opt/ixasdk/bin/arm-be";
my $confdir	= "/opt/config";
my $ixtemplate  = "ixsys.l3fwdr.template";
my $ixconfig    = "ixsys.l3fwdr";
my $ixroute     = "route.l3fwdr";
my $bootscript  = "$confdir/bootscript";
my $userconfig  = "$confdir/emulab-config";
my @tmccresults;

#
# Okay, lets background so we can redirect all the output. We wait for the
# child to exit though so we can return status to caller. 
#
if (!$debug && (my $childpid = TBBackGround($logname))) {
    #
    # Wait for child and return status.
    #
    waitpid($childpid, 0);
    exit($? >> 8);
}
print "Starting IXP bootup at " .
  POSIX::strftime("20%y/%m/%d %H:%M:%S", localtime()) . "\n";

# Tell the library what vnode we are messing with.
libsetup_setvnodeid($ixpid);
# Tell tmcc library too, although thats already been done with previous call.
configtmcc("subnode", $ixpid);

#
# Tell the testbed the node is booting.
#
tmcc(TMCCCMD_STATE, "BOOTING");

#
# Create the config directory. 
# 
if (! -e CONFDIR()) {
    mkdir(CONFDIR(), 0755) or
	die("*** $0:\n".
	    "    Could not mkdir ".CONFDIR().": $!\n");
}

#
# Get the config.
# 
if (! ixpsetup($ixpid)) {
    exit(0);
}

die("*** $0:\n".
    "    Could not chdir to $ixpdir\n")
    if (! -d $ixpdir ||
	! chdir($ixpdir));

#
# Gen up a hostnames in the config dir.
#
system("$RCDIR/rc.hostnames -j $ixpid -f $confdir/hosts boot");

#
# Copy resolv.conf
#
system("cp -f /etc/resolv.conf $confdir") == 0
    or die("*** $0:\n".
	   "    Could not cp resolv.conf!\n");

#
# Startup command (old style).
# 
tmcc(TMCCCMD_STARTUP, undef, \@tmccresults) == 0
    or die("*** $0:\n".
	   "    Could not get startupcmd from server!\n");

if (scalar(@tmccresults)) {
    my $startcmd = $tmccresults[0];
    
    open(RUN, "> $bootscript")
	or die("Could not open $bootscript: $!");
    
    if ($startcmd =~ /CMD=\'(.+)\' UID=([0-9A-Za-z]+)/) {
	print RUN "#!/bin/sh\n";
	print RUN "\n";
	print RUN "$1\n";
    }
    else {
	warn "*** WARNING: Bad startupcmd line: $startcmd";
    }

    close(RUN);
    chmod(0755, $bootscript);
} else {
    unlink($bootscript);
}

#
# Ask tmcd for the configuration data. Create the file and store into
# the directory.
#
tmcc(TMCCCMD_SUBCONFIG, undef, \@tmccresults) == 0
    or die("*** $0:\n".
	   "    Could not get subnode config from server!\n");

foreach my $str (@tmccresults) {
    chomp($str);
    SWITCH1: for ($str) {
	/^IXP_IP="(.*)"$/ && do {
	    $config{"IXP1200_IP"} = $1;
	    last SWITCH1;
	};
	/^IXP_IFACE="(.*)"$/ && do {
	    $config{"IXP1200_IFACE"} = $1;
	    last SWITCH1;
	};
	/^IXP_BCAST="(.*)"$/ && do {
	    $config{"IXP1200_BCAST"} = $1;
	    last SWITCH1;
	};
	/^IXP_HOSTNAME="(.*)"$/ && do {
	    $config{"IXP1200_HOSTNAME"} = "$1.$eid.$pid";
	    last SWITCH1;
	};
	/^HOST_IP="(.*)"$/ && do {
	    $config{"IXP1200_GW"} = $1;
	    $config{"HOST_IP"}    = $1;
	    last SWITCH1;
	};
	/^HOST_IFACE="(.*)"$/ && do {
	    $config{"HOST_I"} = $1;
	    last SWITCH1;
	};
	/^NETMASK="(.*)"$/ && do {
	    $config{"IXP1200_MASK"} = $1;
	    $config{"HOST_MASK"}    = $1;
	    last SWITCH1;
	};
	print STDERR "Invalid Directive: $str\n";
    }
}

#
# Generate the file the way Abhijeet wants it.
#
open(RC, ">create_environment.rc.new")
    or die("*** $0:\n".
	   "    Could not open environment rc file for writing!\n");

print RC "#!/bin/bash\n";
print RC "#\n";
print RC "# This file is auto generated by ixpboot.\n";
print RC "#\n";
print RC "\n";

#
# Also create a seprarate config script.
#
open(UC, "> $userconfig")
    or die("*** $0:\n".
	   "    Could not open $userconfig for writing!\n");

foreach my $conf (keys(%config)) {
    my $val = $config{$conf};

    print RC "export $conf=$val\n";
    print UC "$conf=$val\n";
}
# Need this one too.
print RC "export HOST_CNTL_I=" . `$BINDIR/control_interface`;
print UC "HOST_CNTL_I=" . `$BINDIR/control_interface`;
# And this. Could be done elsewhere ...
my (undef,undef,undef,undef,@ipaddrs) = gethostbyname("fs");
$FSIP = inet_ntoa($ipaddrs[0]);
print RC "export FS_IP=$FSIP\n";
print UC "FS_IP=$FSIP\n";
print RC "export PROJECT=$pid\n";
print UC "PROJECT=$pid\n";
print RC "export USERCONFIG=$userconfig\n";
    
print RC "\n";
print RC "./.create_environment\n";
close(RC);
chmod(0755, "create_environment.rc.new");

if (-e "create_environment.rc") {
    system("mv -f create_environment.rc create_environment.rc.old") == 0
	or die("*** $0:\n".
	       "    Could not backup environment rc file!\n");
}
system("mv -f create_environment.rc.new create_environment.rc") == 0
    or die("*** $0:\n".
	   "    Could not mv new environment rc file!\n");

#
# Now deal with the interface config. This is totally bogus. We do this
# outside. Someday it will happen inside (on the card), but that requires
# building a lot of stuff for the arm.
#
# Ask tmcd (via libsetup) for the list of interfaces. We get back a list
# hashes (poor mans data structure). We generate a set of directives to
# put in the template file, which is in some format that is beyond me.
#
my @ifacelist = ();

if (getifconfig(\@ifacelist) != 0) {
    die("Could not get ifconfig from libsetup!\n");
}

#
# Copy the template to the config file, replace the TAG with the
# interfaces we got above. When the card boots its little linux,
# it will run a script that reads this new file (the directory
# we write it to is NFS mounted by the card). 
#
open(TEMPL, "$confdir/$ixtemplate") or
    die("Could not open $confdir/$ixtemplate: $!\n");
open(CONF, ">$confdir/$ixconfig") or
    die("Could not open $confdir/$ixconfig: $!\n");

while (<TEMPL>) {
    print CONF $_;
	
    if ($_ =~ /^\# IXPINTERFACES:$/) {
	foreach my $iface (@ifacelist) {
		
	    my $inet  = $iface->{"IPADDR"};
	    my $mask  = $iface->{"IPMASK"};
	    my $mac   = $iface->{"MAC"};
	    my ($ifaceno) = ($iface->{"IFACE"} =~ /^[a-zA-Z]*(\d*)/);
	    my $bcast = inet_ntoa((inet_aton($inet) & inet_aton($mask)) |
				  ~(inet_aton($mask)));
		
	    if ($mac =~ /^(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})$/) {
		$mac = "$1:$2:$3:$4:$5:$6";
	    }
	    $ifaceno--;
	    
	    print CONF "interface $ifaceno $inet $bcast $mask $mac 0\n";
	    print UC   "interface $ifaceno $inet $bcast $mask $mac\n";
	}

	# Give the rest of the interfaces a stub setup. Otherwise the
	# card wedges. Amazing. Something to do with arp. 
	for ($i = scalar(@ifacelist) + 1; $i <=4; $i++) {
	    my $ifaceno = $i - 1;
	    my $mac     = "00:23:45:67:89:0${i}";
	    my $mask    = "255.255.255.0";
	    my $inet    = "10.254.$i.0";
	    my $bcast   = "10.254.$i.255";
	    
	    print CONF "interface $ifaceno $inet $bcast $mask $mac 0\n";
	    print UC   "interface $ifaceno $inet $bcast $mask $mac\n";
	}
    }
}
close(TEMPL);
close(CONF);

#
# Now set up the routes file. 
#
open(CONF, ">$confdir/$ixroute") or
    die("Could not open $confdir/$ixroute: $!\n");

#
# First put in the default routes for the interfaces above.
#
foreach my $iface (@ifacelist) {
    my $inet  = $iface->{"IPADDR"};
    my $mask  = $iface->{"IPMASK"};
    my ($ifaceno) = ($iface->{"IFACE"} =~ /^[a-zA-Z]*(\d*)/);
    $ifaceno--;

    print CONF "routeadd $inet $mask 0.0.0.0 $ifaceno\n";
    print UC   "route    $inet $mask 0.0.0.0 $ifaceno\n";
}

#
# Then put in the standard routes from libsetup, if any.
#
my @routelist = ();
my $type      = "";

if (getrouterconfig(\@routelist, \$type)) {
    die("Could not get router configuration from libsetup!\n");
}
if ($type eq "gated" || $type eq "ospf") {
	die("Cannot do session routing on IXP!\n");
}

if (@routelist) {
    foreach my $route (@routelist) {
	my $inet  = $route->{"IPADDR"};
	my $mask  = $route->{"IPMASK"};
	my $gate  = $route->{"GATEWAY"};
	my $type  = $route->{"TYPE"};
	my $ifaceno;

	#
	# Need to find the port by matching gw against the interface list.
	#
	foreach my $iface (@ifacelist) {
	    my $ifaceip   = $iface->{"IPADDR"};
	    my $ifacemask = $iface->{"IPMASK"};
	    
	    if (inet_ntoa((inet_aton($ifacemask) & inet_aton($ifaceip))) eq
		inet_ntoa((inet_aton($ifacemask) & inet_aton($gate)))) {
		($ifaceno) = ($iface->{"IFACE"} =~ /^[a-zA-Z]*(\d*)/);
		$ifaceno--;
		last;
	    }
	}

	if ($type eq "host") {
	    $mask = "255.255.255.255";
	}
    
	print CONF "routeadd $inet $mask $gate $ifaceno\n";
	print UC   "route    $inet $mask $gate $ifaceno\n";
    }
}
close(CONF);
close(UC);

#
# Export the root filesystem to the IXP.
#
system("exportfs -o rw,no_root_squash " . $config{"IXP1200_IP"} . ":/opt") == 0
    or die("*** $0:\n".
	   "    Could not exportfs / to IXP!\n");

#
# Fire off the boot.
#
# We use perl IPC goo to create a child we can both write to and read from
# (normal perl I/O provides just unidirectional I/O to a process).
# 
if (! socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)) {
    die("*** $0:\n".
	"    socketpair failed: $!\n");
}

CHILD->autoflush(1);
PARENT->autoflush(1);

my $childpid = fork();
if (! $childpid) {
    close CHILD;

    #
    # Dup our descriptors to the parent, and exec the program.
    # The parent then talks to it read/write.
    #
    open(STDIN,  "<&PARENT") || die "Can't redirect stdin";
    open(STDOUT, ">&PARENT") || die "Can't redirect stdout";
    open(STDERR, ">&PARENT") || die "Can't redirect stderr";

    exec("minicom -S ./.ixstart ixp");
    die("*** $0:\n".
	"    exec failed: $!\n");
}
close PARENT;

#
# Read from the child.
#
while (<CHILD>) {
    print $_;
    if ($_ =~ /IXP Booted/) {
	$success = 1;
	last;
    }
}
#
# Kill the child off.
#
kill('TERM', $childpid);

# Flush the rest of the output before waitpid.
while (<CHILD>) {
    ;
}
waitpid($childpid, 0);

if (!$success) {
    die("*** $0:\n".
	"    Could not boot IXP $ixpid\n");
}
print "IXP $ixpid booted okay\n";

#
# Tell the testbed the node booted okay
#
tmcc(TMCCCMD_STATE, "ISUP");

exit(0);
