#!/usr/bin/perl -w
#
# Copyright (c) 2014 University of Utah and the Flux Group.
# 
# {{{GENIPUBLIC-LICENSE
# 
# GENI Public License
# 
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and/or hardware specification (the "Work") to
# deal in the Work without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Work, and to permit persons to whom the Work
# is furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Work.
# 
# THE WORK IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE WORK OR THE USE OR OTHER DEALINGS
# IN THE WORK.
# 
# }}}
#
use strict;
use English;
use Getopt::Std;

#
# Populate the monitoring database.
# 

sub usage()
{
    print "Usage: mondbd [-d] [-i]\n";
    exit(1);
}
my $optlist   = "d";
my $debug     = 0;

#
# Configure variables
#
my $TB		 = "@prefix@";
my $TBOPS        = "@TBOPSEMAIL@";
my $DBNAME	 = "@TBDBNAME@";
my $DOMAIN       = "@OURDOMAIN@";
my $URL          = "https://www.$DOMAIN:5001";
my $PGENISUPPORT = @PROTOGENI_SUPPORT@;
my $NICKNAME	 = "@PROTOGENI_NICKNAME@";
my $LOGFILE      = "$TB/log/expire_daemon.log";
my $PORTSTATS    = "$TB/bin/portstats";

my $INTERVAL     = 120;

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

# Protos
sub fatal($);
	  
#
# Turn off line buffering on output
#
$| = 1; 

if ($UID != 0) {
    fatal("Must be root to run this script\n");
}

#
# Exit if not a protogeni site.
#
if (! $PGENISUPPORT) {
    exit(0);
}

my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug++;
}

# Load the Testbed support stuff.
use lib "@prefix@/lib";
use libaudit;
use libdb;
use libtestbed;
use emdbi;
use emutil;
use Experiment;
use Interface;
use Lan;
use Node;
use OSinfo;
use GeniHRN;

# Connect to the monitoring DB.
my $db = emdbi::NewTBDBHandle( "monitoring" );
my $tbdb = emdbi::NewTBDBHandle( $DBNAME );

if (CheckDaemonRunning("mondbd")) {
    fatal("Not starting another monitoring daemon!");
}

if( !$debug) {
    # Go to background.
    if (TBBackGround($LOGFILE)) {
	exit(0);
    }
}

if (MarkDaemonRunning("mondbd")) {
    fatal("Could not mark daemon as running!");
}

#
# Setup a signal handler for newsyslog.
#
sub handler()
{
    my $SAVEEUID = $EUID;
    
    $EUID = 0;
    ReOpenLog($LOGFILE);
    $EUID = $SAVEEUID;
}
$SIG{HUP} = \&handler;

sub AddInterfaces($$$) {

    my ($n, $node, $ts) = @_;
    my @interfaces;

    Interface->LookupAll( $node, \@interfaces );

    foreach my $interface( @interfaces ) {
	my $i = $interface->iface();
	my $addr = $interface->IP();
	my $role = $interface->role();
	my $speed;
	my $packets;

	if( $interface->TypeCapability( "ethernet_defspeed", \$speed ) < 0 ) {
	    $speed = 1000000;
	}

	$speed *= 100;
	$packets = $speed / 80;

	emdbi::DBQueryWarnN( $db, "INSERT INTO ops_interface SET " .
			     "\$schema='http://www.gpolab.bbn.com/monitoring/schema/20140828/port#', " .
			     "id='${DOMAIN}_interface_$n:$i'," .
			     "selfRef='$URL/info/interface/${DOMAIN}_interface_$n:$i'," .
			     "urn='urn:publicid:IDN+$DOMAIN+interface+$n:$i'," .
			     "ts='$ts'," .
			     "properties\$role='$role'," .
			     "properties\$max_bps='$speed'," .
			     "properties\$max_pps='$packets'" );

	emdbi::DBQueryWarnN( $db, "INSERT INTO ops_interface_addresses SET " .
			     "interface_id='${DOMAIN}_interface_$n:$i'," .
			     "addrtype='ipv4'," .
			     "address='$addr'" );

	emdbi::DBQueryWarnN( $db, "INSERT INTO ops_node_interface SET " .
			     "id='${DOMAIN}_interface_$n:$i'," .
			     "node_id='${DOMAIN}_node_$n'," .
			     "urn='urn:publicid:IDN+$DOMAIN+interface+$n:$i'," .
			     "selfRef='$URL/info/interface/${DOMAIN}_interface_$n:$i'" );
    }
}

sub AddLink($$) {

    my ($name, $ts) = @_;

    # FIXME would be nice to set layer, too
    emdbi::DBQueryWarnN( $db, "REPLACE INTO ops_link SET " .
			 "\$schema='http://www.gpolab.bbn.com/monitoring/schema/20140828/link#', " .
			 "id='${DOMAIN}_link_$name', " .
			 "selfRef='$URL/info/link/${DOMAIN}_link_$name'," .
			 "urn='urn:publicid:IDN+$DOMAIN+link+$name'," .
			 "ts='$ts'" );

    emdbi::DBQueryWarnN( $db, "REPLACE INTO ops_aggregate_resource SET " .
			 "id='${DOMAIN}_link_$name'," .
			 "aggregate_id='$NICKNAME'," .
			 "urn='urn:publicid:IDN+$DOMAIN+link+$name'," .
			 "selfRef='$URL/info/link/${DOMAIN}_link_$name'" );
}

sub AddInterfaceVlan($$$$$) {

    my ($linkid,$idomain,$iface,$tag,$ts) = @_;
    my $url;

    if( $idomain eq $DOMAIN ) {
	$url = "$URL/info/interfacevlan/${idomain}_interface_${iface}:${tag}";
    } else {
	$url = "none";
    }

    # FIXME would be nice to give interface_href, but in general we don't know
    emdbi::DBQueryWarnN( $db, "REPLACE INTO ops_interfacevlan SET " .
			 "\$schema='http://www.gpolab.bbn.com/monitoring/schema/20140828/port-vlan#', " .
			 "id='${idomain}_interface_${iface}:${tag}', " .
			 "selfRef='$url', " .
			 "urn='urn:publicid:IDN+$idomain+interfacevlan+$iface:$tag', " .
			 "ts='$ts', " .
			 "tag=$tag," .
			 "interface_urn='urn:publicid:IDN+$idomain+interface+$iface'" )
	unless( $url eq "none" );

    emdbi::DBQueryWarnN( $db, "INSERT INTO ops_link_interfacevlan SET " .
			 "id='${idomain}_interface_${iface}:${tag}', " .
			 "link_id='${DOMAIN}_link_$linkid'" );
}

my %portcounters;

while (1) {
    my $ts = time() . "000000";
    my $expire = ( time() - 24 * 60 * 60 ) . "000000";

    # Add the local CM.
    # FIXME would be nice to add routable_ip_poolsize
    emdbi::DBQueryWarnN( $db, "LOCK TABLES ops_aggregate WRITE" );
    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_aggregate" );
    emdbi::DBQueryWarnN( $db, "INSERT INTO ops_aggregate SET " .
			 "\$schema='http://www.gpolab.bbn.com/monitoring/schema/20140828/aggregate#', " .
			 "id='$NICKNAME'," .
			 "selfRef='$URL/info/aggregate/$NICKNAME'," .
			 "urn='urn:publicid:IDN+$DOMAIN+authority+cm'," .
			 "ts='$ts'," .
			 "measRef='$URL/data/'," .
			 "operational_status='development'" );
    emdbi::DBQueryWarnN( $db, "UNLOCK TABLES" );

    # Add local XEN nodes and interfaces from the shared pool.
    # NB: it would be nice to delete only very old entries from timestamped
    # tables (to retain some historical data), but ts is not part of the
    # primary key for them so we must discard the old state before we're
    # permitted to update with the current.
#    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_node WHERE ts < $expire" );
#    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_interface WHERE ts < $expire" );
#    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_link WHERE ts < $expire" );
#    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_interfacevlan WHERE ts < $expire" );
    emdbi::DBQueryWarnN( $db, "LOCK TABLES ops_node WRITE, " .
			 "ops_interface WRITE, " .
			 "ops_interfacevlan WRITE, " .
			 "ops_interface_addresses WRITE, " .
			 "ops_link WRITE, " .
			 "ops_aggregate_resource WRITE, " .
			 "ops_node_interface WRITE" );
    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_node" );
    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_interface" );
    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_link" );
    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_interfacevlan" );
    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_interface_addresses" );
    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_aggregate_resource" );
    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_node_interface" );
    # The shared pool experiment isn't named consistently across sites.
    # Rather than fixing it, let's just grab everything we can find and
    # hope for the best.
    my @nodes = ExpNodes( "emulab-ops", "shared-node", 1, 1 );
    my @morenodes = ExpNodes( "emulab-ops", "shared-nodes", 1, 1 );
    push( @nodes, @morenodes );

    foreach my $n ( @nodes ) {
	my $node = Node->Lookup( $n );
	my $os = OSinfo->Lookup( $node->def_boot_osid(),
				 $node->def_boot_osid_vers() );

	next unless $os->osname =~ /XEN/;

	my $mem = $node->memory() * 1024;

	emdbi::DBQueryWarnN( $db, "INSERT INTO ops_node SET " .
			     "\$schema='http://www.gpolab.bbn.com/monitoring/schema/20140828/node#', " .
			     "id='${DOMAIN}_node_$n'," .
			     "selfRef='$URL/info/node/${DOMAIN}_node_$n'," .
			     "urn='urn:publicid:IDN+$DOMAIN+node+$n'," .
			     "ts='$ts'," .
			     "node_type='server'," .
			     "properties\$mem_total_kb='$mem'," .
			     "virtualization_type='xen'" );

	emdbi::DBQueryWarnN( $db, "INSERT INTO ops_aggregate_resource SET " .
			     "id='${DOMAIN}_node_$n'," .
			     "aggregate_id='$NICKNAME'," .
			     "urn='urn:publicid:IDN+$DOMAIN+node+$n'," .
			     "selfRef='$URL/info/node/${DOMAIN}_node_$n'" );

	AddInterfaces( $n, $node, $ts );
    }

    my @fakenodenames = ();
    my $query_result = emdbi::DBQueryWarnN( $tbdb, "SELECT DISTINCT node_id FROM external_networks" );
    if( $query_result && $query_result->numrows) {
	my @fakenodes;

	while( @fakenodes = $query_result->fetchrow_array() ) {
	    my ($n) = @fakenodes;
	    push( @fakenodenames, @fakenodes );
	    my $node = Node->Lookup( $n );

	    emdbi::DBQueryWarnN( $db, "INSERT INTO ops_node SET " .
				 "\$schema='http://www.gpolab.bbn.com/monitoring/schema/20140828/node#', " .
				 "id='${DOMAIN}_node_$n'," .
				 "selfRef='$URL/info/node/${DOMAIN}_node_$n'," .
				 "urn='urn:publicid:IDN+$DOMAIN+node+$n'," .
				 "ts='$ts'," .
				 "node_type='switch'" );

	    emdbi::DBQueryWarnN( $db, "INSERT INTO ops_aggregate_resource SET " .
				 "id='${DOMAIN}_node_$n'," .
				 "aggregate_id='$NICKNAME'," .
				 "urn='urn:publicid:IDN+$DOMAIN+node+$n'," .
				 "selfRef='$URL/info/node/${DOMAIN}_node_$n'" );
	    
	    AddInterfaces( $n, $node, $ts );
	}
    }

    emdbi::DBQueryWarnN( $db, "UNLOCK TABLES" );

    emdbi::DBQueryWarnN( $db, "LOCK TABLES ops_link WRITE, " .
			 "ops_interfacevlan WRITE, " .
			 "ops_link_interfacevlan WRITE, " .
			 "ops_aggregate_resource WRITE" );
    emdbi::DBQueryWarnN( $db, "DELETE FROM ops_link_interfacevlan" );

    $query_result = emdbi::DBQueryWarnN( $tbdb, "SELECT DISTINCT lanid " .
					    "FROM lan_members AS l, " .
					    "external_networks AS e WHERE " .
					    "l.node_id=e.node_id" );
    if( $query_result && $query_result->numrows ) {
	my @lanids;

	while( @lanids = $query_result->fetchrow_array() ) {
	    my ($lanid) = @lanids;
	    
	    my $lan = VLan->Lookup( $lanid );

	    next if( !defined( $lan ) );

	    my $tag = $lan->GetTag();

	    next if( !defined( $tag ) || $tag <= 0 );

	    my @members;

	    next if( $lan->MemberList( \@members ) != 0 );

	    next if( ( scalar @members ) < 2 );

	    my $edomain;
	    my $enode;
	    my $inode;
	    my $snode;

	    foreach my $member ( @members ) {
		my $noderef;
		my $nodeid;
		my $iface;

		next if( $member->GetNodeIface( \$noderef, \$iface ) != 0 );
		$nodeid = $noderef->node_id();		

		if( !defined( $enode ) &&
		    grep { $_ eq $nodeid } @fakenodenames ) {

		    my $peer;
		    # Figuring out the other end of an external interface of
		    # a fake node seems to be inconsistent.  Sometimes it's
		    # in the external_interface column of the wires table.
		    # Sometimes it's in the external_interface of the
		    # external_networks table.  So we try both...
		    my $pquery_result = emdbi::DBQueryWarnN(
			$tbdb, "SELECT external_interface FROM " .
			"external_networks WHERE node_id='$nodeid' AND " .
			"external_interface IS NOT NULL" );
		    if( $pquery_result && $pquery_result->numrows ) {
			($peer) = $pquery_result->fetchrow_array();
		    } else {
			$pquery_result = emdbi::DBQueryWarnN(
			    $tbdb, "SELECT external_interface FROM " .
			    "wires AS w, interfaces AS i WHERE " .
			    "( ( w.node_id1='$nodeid' AND w.card1=i.card " .
			    "AND w.port1=i.port ) OR " .
			    "( w.node_id2='$nodeid' AND w.card2=i.card " .
			    "AND w.port2=i.port ) ) AND " .
			    "i.node_id='$nodeid' AND i.iface='$iface'" );

			if( $pquery_result && $pquery_result->numrows ) {
			    ($peer) = $pquery_result->fetchrow_array();
			} else {
			    next;
			}
		    }

		    my $type;
		    ( $edomain, $type, $enode ) = GeniHRN::Parse( $peer );
		    $enode = GeniHRN::Transcribe( $enode );
		    $snode = "$nodeid:$iface";
		} else {
		    $inode = "$nodeid:$iface";
		}
	    }

	    next if( !defined( $enode ) || !defined( $inode ) );

	    AddLink( "${lanid}e", $ts );
	    AddLink( "${lanid}i", $ts );

	    AddInterfaceVlan( "${lanid}e", $DOMAIN, $snode, $tag, $ts );
	    AddInterfaceVlan( "${lanid}e", $edomain, $enode, $tag, $ts );

	    AddInterfaceVlan( "${lanid}i", $DOMAIN, $snode, $tag, $ts );
	    AddInterfaceVlan( "${lanid}i", $DOMAIN, $inode, $tag, $ts );
	}
    }

    emdbi::DBQueryWarnN( $db, "UNLOCK TABLES" );

    # Add traffic counters for the (fake) switch nodes.  Do this after
    # unlocking the database, because we invoke portstats, which is slow.
    # We lose atomicity, but since we're only doing appends, it doesn't
    # really matter.
    foreach my $n ( @fakenodenames ) {
	open( P, "$PORTSTATS -s $n:eth0|" );
	# ignore 3 lines of headers
	<P>;
	<P>;
	<P>;
	# Do any fake nodes we care about have more than one interface?  Let's
	# assume not.
	if( <P> =~ /(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/ ) {
	    my @counts = ( $2, $3 + $4, $5, $6 + $7 );

	    if( exists( $portcounters{$n} ) ) {
		my $oldcounts = $portcounters{$n};

		my $rx_b = ( $counts[ 0 ] - $$oldcounts[ 0 ] ) / $INTERVAL;
		my $rx_p = ( $counts[ 1 ] - $$oldcounts[ 1 ] ) / $INTERVAL;
		my $tx_b = ( $counts[ 2 ] - $$oldcounts[ 2 ] ) / $INTERVAL;
		my $tx_p = ( $counts[ 3 ] - $$oldcounts[ 3 ] ) / $INTERVAL;

		if( ( $rx_b >= 0 ) && ( $rx_p >= 0 ) &&
		    ( $rx_b >= 0 ) && ( $rx_p >= 0 ) ) {
		    emdbi::DBQueryWarnN( $db, "INSERT INTO " .
					 "ops_interface_rx_bps SET " .
					 "id='${DOMAIN}_interface_$n:eth0'," .
					 "ts='$ts'," .
					 "v=$rx_b;" );
		    emdbi::DBQueryWarnN( $db, "INSERT INTO " .
					 "ops_interface_rx_pps SET " .
					 "id='${DOMAIN}_interface_$n:eth0'," .
					 "ts='$ts'," .
					 "v=$rx_p;" );
		    emdbi::DBQueryWarnN( $db, "INSERT INTO " .
					 "ops_interface_tx_bps SET " .
					 "id='${DOMAIN}_interface_$n:eth0'," .
					 "ts='$ts'," .
					 "v=$tx_b;" );
		    emdbi::DBQueryWarnN( $db, "INSERT INTO " .
					 "ops_interface_tx_pps SET " .
					 "id='${DOMAIN}_interface_$n:eth0'," .
					 "ts='$ts'," .
					 "v=$tx_p;" );
		    # We don't count errors.  Does anybody care?  If they
		    # do, we could insert rows of zeroes.
		}
	    }

	    $portcounters{$n} = \@counts;
	}
	close( P );
    }

    sleep( $INTERVAL );

    # FIXME add slice, sliver, user information
}

sub fatal($)
{
    my ($msg) = @_;

    #
    # Send a message to the testbed list. 
    #
    SENDMAIL($TBOPS,
	     "ProtoGENI monitoring daemon died",
	     $msg,
	     $TBOPS);
    MarkDaemonStopped("mondbd");
    die("*** $0:\n".
	"    $msg\n");
}