#!/usr/bin/perl -wT
#
# Copyright (c) 2003-2009 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/>.
# 
# }}}
#
use strict;
use English;
use Getopt::Std;

#
# Notes on the dongle boot:
#
#  * Check /boot/loader.conf for comconsole or vga.
#  * Need SSL version of tmcc, emulab.pem and pcwa.pem file.
#  * Root public ssh key from boss.
#  * New version of libtmcc with bootwhat def.
#  * Create /etc/emulab/emulab-privkey to match what is in widearea_nodeinfo 
#    for each node (per node dongles).
#  * Created /etc/emulab/bossnode pointing to boss.
#  * touch /etc/emulab/isrem
#

#
# Widearea Node checkin. 
#
# Note that the exit code from this script is propogated via the web
# interface to the remote node.
# 
sub usage()
{
    print(STDERR "Usage: wanodecheckin [-h <hostname>] <privkey> <IP>\n");
    exit(-1);
}
my $optlist = "dh:";
my $debug   = 0;
my $hostname;

#
# Configure variables
#
my $TB       = "@prefix@";
my $TBOPS    = "@TBOPSEMAIL@";
my $TBLOGS   = "@TBLOGSEMAIL@";
my $TBBASE   = "@TBBASE@";
my $NAMED    = "$TB/sbin/named_setup";
my $NALLOC   = "$TB/bin/nalloc";

# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

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

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use Experiment;
use Node;

# Protos
sub notify($);
sub fatal($$$);

# These error codes must match whats in the client, but of course.
my $WASTATUS_OKAY		= 0;
my $WASTATUS_MISSINGARGS	= 100;
my $WASTATUS_INVALIDARGS	= 101;
my $WASTATUS_BADPRIVKEY		= 102;
my $WASTATUS_BADIPADDR		= 103;
my $WASTATUS_BADREMOTEIP	= 104;
my $WASTATUS_IPADDRINUSE	= 105;
my $WASTATUS_MUSTUSESSL		= 106;
my $WASTATUS_OTHER		= 199;

# Default initial experiment unless overridden.
my $PID_HWDOWN = NODEDEAD_PID();
my $EID_HWDOWN = NODEDEAD_EID();

# Parse options.
my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
if (defined($options{"h"})) {
    $hostname = $options{"h"};

    if ($hostname =~ /^([-\w\.]+)$/) {
	$hostname = $1;
    }
    else {
	fatal($WASTATUS_INVALIDARGS, "Bad data in hostname", 0);
    }
}
usage
    if (@ARGV != 2);

my $privkey = $ARGV[0];
my $IP      = $ARGV[1];

# untaint args.
if ($IP =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
    $IP = $1;
}
else {
    fatal($WASTATUS_INVALIDARGS, "Bad data in IP address", 0);
}
if ($privkey =~ /^([\w]+)$/) {
    $privkey = $1;
}
else {
    fatal($WASTATUS_INVALIDARGS, "Bad data in private key", 1);
}

#
# Lookup and see if privkey is valid and matches the IP. If so, all is
# good.
#
my $query_result = DBQueryWarn("select node_id,IP,machine_type ".
			       "  from widearea_nodeinfo ".
			       "where privkey='$privkey'");
if (!$query_result) {
    fatal($WASTATUS_OTHER, "DB Error getting widearea_nodeinfo table", 0);
}
if (!$query_result->numrows) {
    #
    # We are not going to do dynamic widearea nodes yet. If the privkey
    # is not in the table, it is not a node we know/care about.
    #
    fatal($WASTATUS_BADPRIVKEY, "Unknown private key", 1);
}
my ($node_id, $known_IP, $machine_type) = $query_result->fetchrow_array();

$query_result = DBQueryWarn("SELECT n.node_id FROM nodes AS n LEFT ".
			    "JOIN widearea_nodeinfo AS w ON n.node_id=w.node_id ".
			    "WHERE w.node_id='$node_id'");
if (! $query_result->numrows) {
    my $experiment = Experiment->Lookup($PID_HWDOWN, $EID_HWDOWN);

    #
    # This is the first time we have heard from a partially-initialised node. Create it.
    #
    my $node = Node->Create($node_id, $experiment,
			    {'type' => $machine_type,
			     'role' => $Node::NODEROLE_TESTNODE});
    if (!defined($node)) {
	fatal($WASTATUS_OTHER, "Could not create new node: $node_id", 0);
    }

    # Initialize the control interface.
    my $control_iface = $node->control_iface();
    if (!defined($control_iface)) {
	$control_iface = "eth0";
    }
    if (! DBQueryWarn("replace into interfaces set ".
		      "    node_id='$node_id', ".
		      "    card=0, port=1, ".
		      "    interface_type='fxp', ".
		      "    iface='$control_iface', ".
		      "    role='" . TBDB_IFACEROLE_CONTROL() . "', ".
		      "    IP='$IP'")) {
	fatal($WASTATUS_OTHER,
	      "Failed to insert new WA node into interfaces table", 0);
    }

    if (! DBQueryWarn("update widearea_nodeinfo set IP='$IP' ".
		      (defined($hostname) ? ",hostname='$hostname' " : "") .
		      "where node_id='$node_id'")) {
	fatal($WASTATUS_OTHER, "Failed to update IP in widearea_nodeinfo", 0);
    }
    notify("Widearea node $node_id has checked in for the firstime ".
	   "with IP $IP");
}
elsif ($known_IP eq $IP) {
    #
    # If the IP has not changed, nothing to do unless the hostname changed.
    #
    if (defined($hostname)) {
	DBQueryWarn("update widearea_nodeinfo set hostname='$hostname' ".
		    "where node_id='$node_id'");
    }
    exit($WASTATUS_OKAY);
}
else {
    #
    # IP has changed, probably cause of dynamic DHCP. We have to
    # change various tables and then regen the nameserver config.
    #
    if (! (DBQueryWarn("update interfaces set IP='$IP' ".
		       "where node_id='$node_id' and card=0 and port=1") &&
	   DBQueryWarn("update widearea_nodeinfo set IP='$IP' ".
		       (defined($hostname) ? ",hostname='$hostname' " : "") .
		       "where node_id='$node_id'"))) {
	fatal($WASTATUS_OTHER, "Failed to update IP in DB", 0);
    }
    notify("Widearea node $node_id has changed its IP address from $known_IP ".
	   "to $IP");
}

# Now regen nameserver.
if (system($NAMED) != 0) {
    fatal($WASTATUS_OTHER, "Failed to regenerate named files and restart", 0);
}
exit($WASTATUS_OKAY);

# Notify TBOPS
sub notify($)
{
    my ($message) = @_;
    
    print "$message\n";
    
    SENDMAIL($TBOPS,
	     "Widearea Node Checkin",
	     "\n".
	     "Widearea Node Checkin.\n".
	     "IP: $IP, Privkey: XXXX\n\n".
	     "$message",
	     "$TBOPS");
}

# Return Error code and send email;
sub fatal($$$)
{
    my ($status, $message, $reportkey) = @_;
    print STDERR "*** $0:\n".
	         "    $message\n";
    
    SENDMAIL($TBOPS,
	     "Failure in Widearea Node Checkin",
	     "\n".
	     "Failure in Widearea Node Checkin. Exited with $status.\n".
	     "IP: $IP, Privkey: ".
	     ($reportkey ? $privkey : "XXXX").
	     "\n\n".
	     "$message",
	     "$TBOPS");

    exit($status);
}