GeniSliver.pm.in

#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2008 University of Utah and the Flux Group.
# All rights reserved.
#
package GeniSliver;

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

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

# Must come after package declaration
use lib '@prefix@/lib';
use GeniDB;
use GeniComponent;
use GeniCredential;
use GeniCertificate;
use GeniAggregate;
# Hate to import all this crap; need a utility library.
use libdb qw(TBGetUniqueIndex);
use libtestbed;
use Experiment;
use Node;
use English;
use Data::Dumper;
use File::Temp qw(tempfile);
use overload ('""' => 'Stringify');

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
my $SIGNCRED	   = "$TB/sbin/signgenicred";
my $AVAIL	   = "$TB/sbin/avail";
my $NALLOC	   = "$TB/bin/nalloc";
my $NFREE	   = "$TB/bin/nfree";
my $NODEREBOOT	   = "$TB/bin/node_reboot";

# Cache of instances to avoid regenerating them.
my %slivers      = ();

#
# Lookup by idx, or uuid.
#
sub Lookup($$)
{
    my ($class, $token) = @_;
    my $query_result;
    my $idx;

    if ($token =~ /^\d+$/) {
	$idx = $token;
    }
    elsif ($token =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
	$query_result =
	    DBQueryWarn("select idx from geni_slivers ".
			"where uuid='$token'");
	    return undef
		if (! $query_result || !$query_result->numrows);

	    ($idx) = $query_result->fetchrow_array();
    }
    else {
	return undef;
    }

    # Look in cache first
    return $slivers{"$idx"}
        if (exists($slivers{"$idx"}));

    $query_result = DBQueryWarn("select * from geni_slivers ".
				"where idx='$idx'");

    return undef
	if (!$query_result || !$query_result->numrows);

    my $self              = {};
    $self->{'SLIVER'}     = $query_result->fetchrow_hashref();
    $self->{'COMPONENT'}  = undef;	# Client side.
    $self->{'CREDENTIAL'} = undef;	# Client side.
    $self->{'AGGREGATE'}  = undef;	# server side.

    #
    # Grab the certificate, since we will probably want it.
    #
    my $uuid = $self->{'SLIVER'}->{'uuid'};
    my $certificate = GeniCertificate->Lookup($uuid);
    if (!defined($certificate)) {
	print STDERR "Could not find certificate for sliver $idx ($uuid)\n";
	return undef;
    }
    $self->{'CERTIFICATE'} = $certificate;
    bless($self, $class);
    
    # Add to cache. 
    $slivers{$self->{'SLIVER'}->{'idx'}} = $self;
    
    return $self;
}

#
# Stringify for output.
#
sub Stringify($)
{
    my ($self) = @_;
    
    my $uuid = $self->uuid();
    my $idx  = $self->idx();

    return "[GeniSliver: $uuid, IDX: $idx]";
}

#
# Create a sliver record in the DB. On the client side we save the credential
# that allows control of it, for later operations.
#
sub Create($$$;$$)
{
    my ($class, $slice, $user, $resource_uuid, $credential, $component) = @_;
    my @insert_data = ();
    my $uuid;
    my $certificate;

    # Every sliver gets a new unique index.
    my $idx = TBGetUniqueIndex('next_sliver', 1);
    if (defined($credential)) {
	# Store the certificate for later use.
	$certificate = GeniCertificate->StorePublic($credential->this_cert());
	if (!defined($certificate)) {
	    print STDERR "Could not store certificate\n";
	    return undef;
	}
	$uuid = $credential->this_uuid();

	# Store the credential
	return undef
	    if ($credential->Store() != 0);
    }
    else {
	# Create a cert pair, which gives us a new uuid.
	$certificate = GeniCertificate->Create("sliver");
	if (!defined($certificate)) {
	    print STDERR "Could not generate new certificate and UUID!\n";
	    return undef;
	}
	$uuid = $certificate->uuid();
    }
    my $slice_uuid     = $slice->uuid();
    my $owner_uuid     = $user->uuid();

    # Now tack on other stuff we need.
    push(@insert_data, "created=now()");
    push(@insert_data, "idx='$idx'");
    push(@insert_data, "uuid='$uuid'");
    push(@insert_data, "resource_uuid='$resource_uuid'")
	if (defined($resource_uuid));
    push(@insert_data, "creator_uuid='$owner_uuid'");
    push(@insert_data, "slice_uuid='$slice_uuid'");

    # Only on the client side.
    push(@insert_data, "credential_idx=" . $credential->idx())
	if (defined($credential));
    # Only on the client side.
    push(@insert_data, "component_idx=" . $component->idx())
	if (defined($component));

    # Insert into DB.
    if (!DBQueryWarn("insert into geni_slivers set " .
		     join(",", @insert_data))) {
	$certificate->Delete();
	return undef;
    }

    my $sliver = GeniSliver->Lookup($idx);
    return undef
	if (!defined($sliver));
    
    $sliver->{'CREDENTIAL'} = $credential
	if (defined($credential));
    $sliver->{'COMPONENT'} = $component
	if (defined($component));
    $sliver->{'AGGREGATE'} = undef;

    return $sliver;
}
# accessors
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'SLIVER'}->{$_[1]}); }
sub idx($)		{ return field($_[0], "idx"); }
sub uuid($)		{ return field($_[0], "uuid"); }
sub slice_uuid($)	{ return field($_[0], "slice_uuid"); }
sub creator_uuid($)	{ return field($_[0], "creator_uuid"); }
sub created($)		{ return field($_[0], "created"); }
sub credential_idx($)	{ return field($_[0], "credential_idx"); }
sub resource_uuid($)	{ return field($_[0], "resource_uuid"); }
sub ticket_idx($)	{ return field($_[0], "ticket_idx"); }
sub component_idx($)	{ return field($_[0], "component_idx"); }
sub aggregate_idx($)	{ return field($_[0], "aggregate_idx"); }
sub status($)		{ return field($_[0], "status"); }
sub cert($)		{ return $_[0]->{'CERTIFICATE'}->cert(); }
sub GetCertificate($)   { return $_[0]->{'CERTIFICATE'}; }

#
# Delete the sliver. The sliver should not be provisioned when this done.
#
sub Delete($)
{
    my ($self) = @_;

    return -1
	if (! ref($self));

    my $idx  = $self->idx();
    my $uuid = $self->uuid();

    DBQueryWarn("delete from geni_credentials where this_uuid='$uuid'")
	or return -1;
    DBQueryWarn("delete from geni_certificates where uuid='$uuid'")
	or return -1;
    DBQueryWarn("delete from geni_slivers where idx='$idx'")
	or return -1;
    
    return 0;
}

#
# Set the aggregate for a sliver.
#
sub SetAggregate($$)
{
    my ($self, $aggregate) = @_;

    return -1
	if (! (ref($self) && ref($aggregate)));

    my $idx     = $self->idx();
    my $agg_idx = $aggregate->idx();

    return -1
	if (!DBQueryWarn("update geni_slivers set ".
			 "  aggregate_idx='$agg_idx' ".
			 "where idx='$idx'"));
    
    $self->{'SLIVER'}->{'aggregate_idx'} = $agg_idx;
    $self->{'AGGREGATE'} = $aggregate;
    return 0;
}

#
# Get the aggregate for a sliver.
#
sub GetAggregate($)
{
    my ($self) = @_;

    return undef
	if (! ref($self));

    return $self->{'AGGREGATE'} if (defined($self->{'AGGREGATE'}));
    return undef
	if (!defined($self->aggregate_idx()));

    my $aggregate = GeniAggregate->Lookup($self->aggregate_idx());
    if (!defined($aggregate)) {
	print STDERR "Could not get aggregate object associated with $self\n";
	return undef;
    }
    $self->{'AGGREGATE'} = $aggregate;
    return $aggregate;
}

#
# Get the experiment for the slice this sliver belongs to.
#
sub GetExperiment($)
{
    my ($self) = @_;

    return undef
	if (! ref($self));

    return Experiment->Lookup($self->slice_uuid());
}

#
# Get the credential for the sliver.
#
sub GetCredential($)
{
    my ($self) = @_;

    return undef
	if (! ref($self));

    return $self->{'CREDENTIAL'} if (defined($self->{'CREDENTIAL'}));

    if (!defined($self->credential_idx())) {
	print STDERR "No credential associated with $self\n";
	return undef;
    }
    my $credential = GeniCredential->Lookup($self->credential_idx());
    if (!defined($credential)) {
	print STDERR "Could not get credential object associated with $self\n";
	return undef;
    }
    $self->{'CREDENTIAL'} = $credential;
    return $credential;
}

#
# Get the component for the sliver.
#
sub GetComponent($)
{
    my ($self) = @_;

    return undef
	if (! ref($self));

    return $self->{'COMPONENT'} if (defined($self->{'COMPONENT'}));

    if (!defined($self->component_idx())) {
	print STDERR "No component associated with $self\n";
	return undef;
    }
    my $component = GeniComponent->Lookup($self->component_idx());
    if (!defined($component)) {
	print STDERR "Could not get component object associated with $self\n";
	return undef;
    }
    $self->{'COMPONENT'} = $component;
    return $component;
}

#
# Client side method to contact the sliver component and destroy it.
#
sub Destroy($$)
{
    my ($self, $user) = @_;

    return -1
	if (! ref($self));

    my $component = $self->GetComponent();
    return -1
	if (!defined($component));

    return -1
	if ($component->DestroySliver($self, $user) != 0);

    # Delete the local object from the DB.
    $self->Delete() == 0
	or return -1;

    return 0;
}

#
# Client side method to contact the sliver component and start it.
#
sub Start($$)
{
    my ($self, $user) = @_;

    return -1
	if (! ref($self));

    my $component = $self->GetComponent();
    return -1
	if (!defined($component));

    return -1
	if ($component->StartSliver($self, $user) != 0);

    return 0;
}

#
# Provision a slice. We actually did this when the ticket was requested.
#
sub Provision($)
{
    my ($self) = @_;

    return -1
	if (! ref($self));

    #
    # the node is already allocated to the sliver, but still need to enter
    # a virt_nodes entry, and possibly more virt table entries, so that the
    # node will boot properly, and is otherwie controllable.
    #
    my $experiment = Experiment->Lookup($self->slice_uuid());
    if (!defined($experiment)) {
	print STDERR "Could not map $self to its experiment\n";
	return -1;
    }
    my $resource_uuid = $self->resource_uuid();
    return 0
	if (!defined($resource_uuid));
    my $node       = Node->Lookup($resource_uuid);
    if (!defined($node)) {
	print STDERR "Could not map node $resource_uuid to its object\n";
	return -1;
    }
    my $reservation = $node->Reservation();
    if (!defined($reservation)) {
	print STDERR "$node was already released from $self\n";
	return -1;
    }
    if ($reservation->SameExperiment($experiment)) {
	if ($experiment->InsertVirtNode($node) != 0) {
	    print STDERR "Could not add virtnode entry for $node to $self\n";
	    return -1;
	}
	# Set sliver_idx in the reservation so that Emulab knows.
	if ($node->ModifyReservation({"genisliver_idx" => $self->idx()}) != 0){
	    return -1;
	}
    }
    else {
	print STDERR "$node is reserved to another, not $self\n";
	# Signal error so we can look at what happened.
	return -1;
    }
    return 0;
}

#
# Create a signed credential for this sliver, issued to the provided user.
# The credential will grant all permissions for now.
#
# Should we store these credentials in the DB, recording what we hand out?
#
sub NewCredential($$)
{
    my ($self, $owner) = @_;

    return undef
	if (! (ref($self) && ref($owner)));

    my $credential = GeniCredential->Create($self, $owner);
    if (!defined($credential)) {
	print STDERR "Could not create credential for $self, $owner\n";
	return undef;
    }
    if ($credential->Sign($self->GetCertificate()) != 0) {
	print STDERR "Could not sign credential for $self, $owner\n";
	return undef;
    }
    return $credential;
}

#
# Unprovision a sliver. 
#
sub UnProvision($)
{
    my ($self) = @_;

    return -1
	if (! ref($self));

    my $experiment = Experiment->Lookup($self->slice_uuid());
    if (!defined($experiment)) {
	print STDERR "Could not map $self to its experiment\n";
	return -1;
    }
    my $resource_uuid = $self->resource_uuid();
    return 0
	if (!defined($resource_uuid));
    my $node       = Node->Lookup($resource_uuid);
    if (!defined($node)) {
	print STDERR "Could not map node $resource_uuid to its object\n";
	return -1;
    }
    my $reservation = $node->Reservation();
    if (!defined($reservation)) {
	print STDERR "$node was already released from $self\n";
	return 0;
    }
    if ($reservation->SameExperiment($experiment)) {
	my $node_id = $node->node_id();
	my $pid = $experiment->pid();
	my $eid = $experiment->eid();

	if ($experiment->DeleteVirtNode($node) != 0) {
	    print STDERR "Could remove virtnode entry for $node from $self\n";
	    return -1;
	}
	
	system("export NORELOAD=1; $NFREE -q $pid $eid $node_id");
	if ($?) {
	    print STDERR "Could not deallocate $node from $self\n";
	    return -1;
	}
    }
    else {
	print STDERR "$node is reserved to another, not $self\n";
	# Signal error so we can look at what happened.
	return -1;
    }
    return 0;
}

#
# Start a sliver, which roughly translates to reboot the node.
#
sub StartUp($)
{
    my ($self) = @_;

    return -1
	if (! ref($self));

    my $experiment = Experiment->Lookup($self->slice_uuid());
    if (!defined($experiment)) {
	print STDERR "Could not map $self to its experiment\n";
	return -1;
    }
    my $resource_uuid = $self->resource_uuid();
    return 0
	if (!defined($resource_uuid));
    my $node       = Node->Lookup($resource_uuid);
    if (!defined($node)) {
	print STDERR "Could not map node $resource_uuid to its object\n";
	return -1;
    }
    my $reservation = $node->Reservation();
    if (!defined($reservation)) {
	print STDERR "$node was already released from $self\n";
	return -1;
    }
    if ($reservation->SameExperiment($experiment)) {
	my $node_id = $node->node_id();
	#
	# Reboot and wait?
	#
	system("$NODEREBOOT $node_id");
    }
    else {
	print STDERR "$node is reserved to another, not $self\n";
	# Signal error so we can look at what happened.
	return -1;
    }
    return 0;
}


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