#!/usr/bin/perl -wT
#
# Copyright (c) 2008-2016 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.
# 
# }}}
#
package GeniCluster;

#
# Portal stuff.
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

@ISA    = "Exporter";
@EXPORT = qw ( );

# Must come after package declaration!
use emdb;
use emutil;
use libtestbed;
use libEmulab;
use GeniResponse;
use GeniSlice;
use GeniHRN;
use GeniUtil;
use Reservation;
use English;
use Data::Dumper;
use Date::Parse;
use POSIX qw(strftime);
use Time::Local;
use Project;
use NodeType;

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $MAINSITE 	   = @TBMAINSITE@;
my $OURDOMAIN      = "@OURDOMAIN@";
my $IDLESTATS      = "$TB/bin/idlestats";
my $SUDO           = "/usr/local/bin/sudo";
my $SSH            = "/usr/bin/ssh";
my $WAP            = "$TB/sbin/withadminprivs";
my $API_VERSION    = 1.0;

#
# Check permission. At the moment, only the Mothership can issue requests
# and only the Cloudlab clusters will accept them.
#
sub CheckPermission()
{
    my $myurn = $ENV{"MYURN"};

    my $hrn = GeniHRN->new($ENV{"GENIURN"});
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"Could not parse GENIURN")
	if (!defined($hrn));
    
    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				"Only the Mothership or local cluster ".
				"can access this interface")
	if (! ($hrn->IsAuthority() && $hrn->IsRoot() &&
	       ($hrn->authority() eq "emulab.net" ||
		$hrn->authority() eq $OURDOMAIN)));

    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
			"Only Cloudlab clusters permit this interface")
	if (! ($OURDOMAIN eq "emulab.net" ||
	       $OURDOMAIN eq "apt.emulab.net" ||
	       $OURDOMAIN eq "utah.cloudlab.us" ||
	       $OURDOMAIN eq "wisc.cloudlab.us" ||
	       $OURDOMAIN eq "clemson.cloudlab.us" ||
	       $OURDOMAIN eq "lab.onelab.eu"));

    return 0;
}

#
# Tell the client what API revision we support.  The correspondence
# between revision numbers and API features is to be specified elsewhere.
# No credentials are required.
#
sub GetVersion()
{
    my $hasperm = CheckPermission();
    return $hasperm
	if (GeniResponse::IsError($hasperm));
	    
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $API_VERSION);
}

#
# Return the InUse info, which includes the pre-reserve info.
#
sub InUse()
{
    my $hasperm = CheckPermission();
    return $hasperm
	if (GeniResponse::IsError($hasperm));
    my $autoswap_max;
    if (!GetSiteVar("general/autoswap_max", \$autoswap_max)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    # sitevar in hours, convert to seconds
    $autoswap_max *= 3600;

    my @blob = ();

    my $query_result =
	DBQueryWarn("select n.node_id,n.type,r.pid,r.eid,n.reserved_pid,".
		    "  unix_timestamp(s.expires),e.autoswap, ".
		    "  (e.autoswap_timeout - ".
		    "   ((unix_timestamp(now()) - ".
		    "     unix_timestamp(stats.swapin_last))/60)) as ttl, ".
		    "  u.uid,stats.slice_uuid,cert.urn,e.swappable, ".
		    "  s.lockdown,unix_timestamp(stats.swapin_last) ".
		    "  from nodes as n ".
		    "left join reserved as r on r.node_id=n.node_id ".
		    "left join node_types as t on t.type=n.type ".
		    "left join experiments as e on e.idx=r.exptidx ".
		    "left join experiment_stats as stats on ".
		    "     stats.exptidx=e.idx ".
		    "left join `geni-cm`.geni_slices as s on ".
		    "     s.uuid=stats.slice_uuid ".
		    "left join `geni-cm`.geni_certificates as cert on ".
		    "     cert.uuid=stats.slice_uuid ".
		    "left join users as u on u.uid_idx=e.swapper_idx ".
		    "where n.role='testnode' and t.class='pc' ".
		    "order by n.node_id");
    while (my ($node_id,$type,$pid,$eid,$reserved_pid,$expires,
	       $autoswap,$ttl,$uid,$slice_uuid,$slice_urn,
	       $swappable,$slice_lockdown,$swapin_time) =
	   $query_result->fetchrow_array()) {
	my $maxttl;
	
	#
	# Try and compute a time the node will be released. This is a guess
	# at best, lots of things can change as soon as we calculate it.
	#
	if (defined($expires)) {
	    if ($slice_lockdown) {
		$ttl = "";
	    }
	    else {
		$ttl = $expires - time();
	    }
	}
	elsif (defined($eid)) {
	    if (!$swappable) {
		$ttl = "";
	    }
	    elsif ($autoswap && defined($ttl)) {
		$ttl = $ttl * 60;
		$maxttl = $autoswap_max - (time() - $swapin_time);
		if ($ttl > $maxttl) {
		    # Admin override.
		    $maxttl = $ttl;
		}
	    }
	    else {
		$ttl = "";
	    }
	}
	else {
	    $ttl = "";
	}
	push(@blob, {"node_id"      => $node_id,
		     "type"         => $type,
		     "pid"          => $pid || "",
		     "eid"          => $eid || "",
		     "uid"          => $uid || "",
		     "ttl"          => $ttl,
		     "maxttl"       => $maxttl || "",
		     "slice_urn"    => $slice_urn || "",
		     "slice_uuid"   => $slice_uuid || "",
		     "reserved_pid" => $reserved_pid || ""});
    }
    my $results = {"api_version"  => $API_VERSION,
		   "details"      => \@blob};
		  
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $results);
}

#
# Return pre-reservation details.
#
sub PreReservations()
{
    my @blob = ();
    my $hasperm = CheckPermission();
    return $hasperm
	if (GeniResponse::IsError($hasperm));

    my $query_result =
	DBQueryWarn("select p.*,nr.node_id,n.type as node_type".
		    "  from project_reservations as p ".
		    "left join node_reservations as nr on ".
		    "     nr.pid_idx=p.pid_idx and ".
		    "     nr.reservation_name=p.name ".
		    "left join nodes as n on n.node_id=nr.node_id ".
		    "order by p.pid,p.name,n.node_id");

    return GeniResponse->Create(GENIRESPONSE_ERROR)
	if (!$query_result);

    while (my $row = $query_result->fetchrow_hashref()) {
      nextpid:
	my @nodes    = ();
	my $pid      = $row->{'pid'};
	my $name     = $row->{'name'};
	my $count    = $row->{'count'};
	my $priority = $row->{'priority'};
	my $active   = $row->{'active'};
	my $terminal = $row->{'terminal'};
	my $types    = $row->{'types'};
	my $creator  = $row->{'creator'};
	my $created  = TBDateStringGMT($row->{'created'});
	my $start    = TBDateStringGMT($row->{'start'})
	    if (defined($row->{'start'}));
	my $end      = TBDateStringGMT($row->{'end'})
	    if (defined($row->{'end'}));
	my @prereserved = ();

	# Which nodes have actually been pre-reserved.
	my $current_result =
	    DBQueryWarn("select node_id,type from nodes ".
			"where reserved_pid='$pid'");
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!$current_result);
	while (my ($node_id, $ntype) = $current_result->fetchrow_array()) {
	    push(@prereserved,
		 {"node_id" => $node_id, "type" => $ntype});
	}
	#
	# If this is a reservation for specific node(s), eat those rows.
	#
	while (defined($row->{'node_id'}) &&
	       $row->{'pid'} eq $pid && $row->{'name'} eq $name) {
	    push(@nodes,
		 {"node_id" => $row->{'node_id'},
		  "type"    => $row->{'node_type'}});
	    
	    $row = $query_result->fetchrow_hashref();
	    last
		if (!defined($row));
	}
	push(@blob, {"nodes"        => \@nodes,
		     "pid"          => $pid,
		     "name"         => $name,
		     "count"        => $count,
		     "prereserved"  => \@prereserved,
		     "types"        => $types || "",
		     "priority"     => $priority,
		     "created"      => $created,
		     "creator"      => $creator,
		     "start"        => $start || "",
		     "end"          => $end || "",
		     "active"       => $active,
		     "terminal"     => $terminal,
	     });
	# We ate the last row.
	last
	    if (!defined($row));
	# We ate the first row of the next reservation.
	goto nextpid
	    if (! ($row->{'pid'} eq $pid && $row->{'name'} eq $name));
    }
    my $results = {"api_version"  => $API_VERSION,
		   "details"      => \@blob};
		  
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $results);
}

#
# Return utilization data for the nodes in a slice.
#
sub SliceUtilizationData($)
{
    my ($argref)  = @_;
    my $slice_urn = $argref->{'slice_urn'};
    my %blob      = ();
    
    my $hasperm = CheckPermission();
    return $hasperm
	if (GeniResponse::IsError($hasperm));

    my $slice = GeniSlice->Lookup($slice_urn);    
    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED)
	if (!defined($slice));
    
    my $experiment = $slice->GetExperiment();
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"No experiment for $slice")
	if (!defined($experiment));

    my @nodes = $experiment->NodeList(0, 1);
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"No nodes is $slice")
	if (!@nodes);

    #
    # Build up a per-type summary count, to which we will add the
    # current total/free counts. 
    #
    my %typelist = ();
    
    foreach my $node (@nodes) {
	my %stats = ();
	$stats{"nodetype"} = $node->type();

	# Type counts.
	if (!exists($typelist{$node->type()})) {
	    $typelist{$node->type()} = {"count" => 0};
	}
	$typelist{$node->type()}->{"count"}++;
	
	my ($idletime, $staleness, $stale) = $node->IdleData();
	if (defined($idletime)) {
	    $stats{"idledata"} = {
		"idletime"   => $idletime,
		"staleness"  => $staleness,
		"stale"      => $stale,
	    };
	}
	$stats{"eventstate"} = $node->eventstate();

	my $rusage = $node->RusageData();
	if (defined($rusage)) {
	    $stats{"rusage"} = $rusage;
	}
	my ($status,$status_stamp) = $node->GetStatus();
	if (defined($status)) {
	    $stats{"status"} = {
		"status"    => $status,
		"timestamp" => $status_stamp,
	    };
	}
	$blob{$node->node_id()} = \%stats;
    }
    #
    # Finish up the per-type info, adding total/inuse/preserved.
    #
    foreach my $type (keys(%typelist)) {
	my $typeinfo = NodeType->Lookup($type);
	next
	    if (!defined($typeinfo));

	if ($typeinfo->isvirtnode()) {
	    $typelist{$typeinfo->type()}->{"total"} = 0;
	    $typelist{$typeinfo->type()}->{"free"}  = 0;
	    next;
	}
	
	my $counts = $typeinfo->Counts();
	if (defined($counts)) {
	    $typelist{$typeinfo->type()}->{"total"} = $counts->{"total"};
	    $typelist{$typeinfo->type()}->{"free"}  = $counts->{"free"};
	}
    }
    my $results = {"api_version"  => $API_VERSION,
		   "typeinfo"     => \%typelist,
		   "details"      => {
		       "nodes" => \%blob,
		   }};
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $results);
}

#
# Return utilization data for the nodes in a slice.
#
sub SliceIdleData($)
{
    my ($argref)  = @_;
    my $slice_urn = $argref->{'slice_urn'};
    my %blob      = ();
    
    my $hasperm = CheckPermission();
    return $hasperm
	if (GeniResponse::IsError($hasperm));

    my $slice = GeniSlice->Lookup($slice_urn);    
    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED)
	if (!defined($slice));
    
    my $experiment = $slice->GetExperiment();
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"No experiment for $slice")
	if (!defined($experiment));

    my $pid  = $experiment->pid();
    my $eid  = $experiment->eid();
    my $swapped = str2time($experiment->swapin_last());
    my $limit   = time() - (3600 * 24 * 3);
    if ($limit < $swapped) {
	$limit = $swapped;
    }
    $limit = emutil::TBDateStringLocal($limit);

    GeniUtil::FlipToElabMan();
    if (! open(IDLE, "$WAP $IDLESTATS -s -R -B -S '$limit' -e $pid,$eid |")) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not start idlestats")
    }
    my $output = "";
    while (<IDLE>) {
	$output .= $_;
    }
    if (! close(IDLE)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    ($! ? "Pipe error running idlestats: $!" :
				     "idlestats exited with $?") .
				    "\n" . $output);
    }
    #
    # We get a giant json encoded string back.
    #
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $output);
}

#
# Return openstack data for the nodes in a slice.
#
sub SliceOpenstackData($)
{
    my ($argref)  = @_;
    my $slice_urn = $argref->{'slice_urn'};
    my $client_id = $argref->{'client_id'};
    my %blob      = ();

    my $hasperm = CheckPermission();
    return $hasperm
	if (GeniResponse::IsError($hasperm));

    if ($client_id !~ /^[-\w]+$/) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS)
    }

    my $slice = GeniSlice->Lookup($slice_urn);    
    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED)
	if (!defined($slice));
    
    my $experiment = $slice->GetExperiment();
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"No experiment for $slice")
	if (!defined($experiment));
    my $node = $experiment->VnameToNode($client_id);
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"No such controller node for $slice")
	if (!defined($node));
    my $node_id = $node->node_id();

    my $sshopts  = "-o ServerAliveInterval=10 -o ServerAliveCountMax=1 ";
    $sshopts    .= "-o ConnectTimeout=10 ";
    $sshopts    .= "-o BatchMode=yes -o StrictHostKeyChecking=no ";
    my $sshcmd   = "cat /root/setup/cloudlab-openstack-stats.json";

    $EUID = $UID = 0;
    my $output = GeniUtil::ExecQuiet("$SUDO $SSH $sshopts $node_id '$sshcmd'");
    if ($?) {
	GeniUtil::FlipToGeniUser();
	print STDERR "Error getting json from $node_id: $output\n";
	#
	# See if it is cause the file does not exist, we want to tell
	# the caller so it does not keep asking.
	#
	if ($output =~ /No such file/im) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					"No json file on $node_id");
	}
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
			    "Error getting json from $node_id: $output");
    }
    GeniUtil::FlipToGeniUser();    
    #
    # We get a json encoded string back.
    #
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $output);
}

#
# Check Reservation request for a slice. 
#
sub SliceCheckReservation($)
{
    my ($argref)  = @_;
    my $slice_urn = $argref->{'slice_urn'};
    my $expiration= $argref->{'expiration'};
    my %blob      = ();
    my $reserror;

    my $hasperm = CheckPermission();
    return $hasperm
	if (GeniResponse::IsError($hasperm));

    # Gack, why does Frontier do this. It is stupid.
    if (ref($expiration) eq 'Frontier::RPC2::DateTime::ISO8601') {
	$expiration = $expiration->value;
    }
    # Convert to a localtime.
    $expiration = eval { timegm(strptime($expiration)); };
    if ($@) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, $@);
    }
    if (!defined($expiration)) {
	GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
			     "Could not parse expiration");
    }
    my $slice = GeniSlice->Lookup($slice_urn);    
    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED)
	if (!defined($slice));

    if (Reservation->ExtendSlice($slice, $expiration, \$reserror, 1)) {
	Reservation->FlushAll();
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef, $reserror);
    }
    Reservation->FlushAll();
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

#
# Get maximum allowed extension for a slice.
#
sub SliceMaxExtension($)
{
    my ($argref)  = @_;
    my $slice_urn = $argref->{'slice_urn'};
    my %blob      = ();
    my $max;
    my $reserror;

    my $hasperm = CheckPermission();
    return $hasperm
	if (GeniResponse::IsError($hasperm));

    my $slice = GeniSlice->Lookup($slice_urn);    
    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED)
	if (!defined($slice));

    if (Reservation->MaxSliceExtension($slice, \$max, \$reserror)) {
	Reservation->FlushAll();
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef, $reserror);
    }
    Reservation->FlushAll();
    $max = TBDateStringGMT($max);
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $max);
}

# _Always_ make sure that this 1 is at the end of the file...
1;