GeniCMV2.pm.in

#!/usr/bin/perl -wT
#
# Copyright (c) 2008-2015 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 GeniCMV2;

#
# The server side of the CM interface on remote sites. Also communicates
# with the GMC interface at Geni Central as a client.
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

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

# Must come after package declaration!
use GeniDB;
use GeniResponse;
use GeniTicket;
use GeniCredential;
use GeniCertificate;
use GeniComponent;
use GeniSlice;
use GeniAggregate;
use GeniSliver;
use GeniUtil;
use GeniCM;
use GeniHRN;
use GeniXML;
use GeniStitch;
use GeniStd;
use emutil;
use English;
use Data::Dumper;
use XML::Simple;
use Date::Parse;
use POSIX qw(strftime tmpnam);
use Time::Local;
use Compress::Zlib;
use File::Temp qw(tempfile);
use MIME::Base64;
use Errno;

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
my $ELABINELAB     = "@ELABINELAB@";
my $TBBASE         = "@TBBASE@";
my $TBDOCBASE      = "@TBDOCBASE@";
my $CREATEEXPT     = "$TB/bin/batchexp";
my $ENDEXPT        = "$TB/bin/endexp";
my $NALLOC	   = "$TB/bin/nalloc";
my $NFREE	   = "$TB/bin/nfree";
my $TEVC	   = "$TB/bin/tevc";
my $AVAIL	   = "$TB/sbin/avail";
my $PTOPGEN	   = "$TB/libexec/ptopgen";
my $TBSWAP	   = "$TB/bin/tbswap";
my $SWAPEXP	   = "$TB/bin/swapexp";
my $PLABSLICE	   = "$TB/sbin/plabslicewrapper";
my $NAMEDSETUP     = "$TB/sbin/named_setup";
my $VNODESETUP     = "$TB/sbin/vnode_setup";
my $GENTOPOFILE    = "$TB/libexec/gentopofile";
my $TARFILES_SETUP = "$TB/bin/tarfiles_setup";
my $MAPPER         = "$TB/bin/mapper";
my $VTOPGEN        = "$TB/bin/vtopgen";
my $SNMPIT         = "$TB/bin/snmpit";
my $CLONEIMAGE     = "$TB/sbin/clone_image";
my $CREATEIMAGE    = "$TB/bin/create_image";
my $DELETEIMAGE    = "$TB/sbin/delete_image";
my $WAP            = "$TB/sbin/withadminprivs";
my $SHAREVLAN      = "$TB/sbin/sharevlan";
my $XMLLINT	   = "/usr/local/bin/xmllint";
my $PRERENDER      = "$TB/libexec/vis/prerender";
my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";
# Just one of these, at Utah.
my $GENICH_PEMFILE = "@prefix@/etc/genich.pem";
my $WITHPROVENANCE = @IMAGEPROVENANCE@;
my $PROTOGENI_LOCALUSER = @PROTOGENI_LOCALUSER@;
my $API_VERSION    = 2;

#
# 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 @input_rspec_versions = ( "0.1", "0.2", "2", "3", "PG 0.1", "PG 0.2", "PG 2" );
    my @ad_rspec_versions = ( "0.1", "0.2", "2", "3", "PG 0.1", "PG 0.2", "PG 2" );
    my $blob = {
	"api" => $API_VERSION,
	"level" => 1,
	"input_rspec" => \@input_rspec_versions,
	"output_rspec" => "2",
	"ad_rspec" => \@ad_rspec_versions
    };
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
}

#
# Respond to a Resolve request. 
#
sub Resolve($)
{
    my ($argref) = @_;
    my $credentials = $argref->{'credentials'};
    my $urn         = $argref->{'urn'};
    my $admin       = 0;
    my $isauth	    = 0;

    if (! (defined($credentials) && defined($urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! GeniHRN::IsValid($urn)) {
	return GeniResponse->MalformedArgsResponse("Invalid URN");
    }
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    my ($object, $type) = LookupURN($urn);
    return $object
	if (GeniResponse::IsResponse($object));

    #
    # This is a convenience for testing. If a local user and that
    # user is an admin person, then do whatever it says. This is
    # easier then trying to do this with credential privs. But,
    # watch for credentials from authorities instead of users.
    #
    my (undef,$callertype,$callerid) = GeniHRN::Parse($credential->owner_urn());
    if ($callertype eq "user") {
	my $user = GeniCM::CreateUserFromCertificate($credential);
	if (!GeniResponse::IsResponse($user) &&
	    $user->IsLocal() && $user->admin()) {
	    $admin = 1;
	}
    }
    elsif ($callertype eq "authority" &&
	   ($callerid eq "cm" || $callerid eq "sa")) {
	$isauth = 1;
    }
    
    if ($type eq "node") {
	my $node  = $object;
	# Not sure about this, but I do know that Resolving a virtnode
	# is not useful right now. 
	if ($node->isvirtnode()) {
	    $node = Node->Lookup($node->phys_nodeid());
	}
	my $rspec = GeniCM::GetAdvertisement(0, $node->node_id(), "0.1", undef);
	if (! defined($rspec)) {
	    print STDERR "Could not get advertisement for $node!\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Error getting advertisement");
	}
	my $me = GeniAuthority->Lookup($ENV{'MYURN'});
	if (!defined($me)) {
	    print STDERR
		"Could not find local authority object for $ENV{'MYURN'}\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Error getting advertisement");
	}
	my $myurn = GeniHRN::Generate($OURDOMAIN, "node", $node->node_id());
	my $myhrn = "${PGENIDOMAIN}." . $node->node_id();

	#
	# See if the component object exists; if not create it.
	#
	my $component = GeniComponent->Lookup($node->uuid());
	if (!defined($component)) {
	    my $certificate = GeniCertificate->Lookup($node->uuid());
	    if (!defined($certificate)) {
		$certificate =
		    GeniCertificate->Create({'urn'  => $myurn,
					     'hrn'  => $myhrn,
					     'email'=> $TBOPS,
					     'uuid' => $node->uuid(),
					     'url'  => $me->url()});
		if (!defined($certificate)) {
		    print STDERR "Could not generate certificate for $node\n";
		    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Error getting advertisement");
		}
	    }
	    $component = GeniComponent->Create($certificate, $me);
	    if (!defined($component)) {
		print STDERR "Could not create component for $node\n";
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Error getting advertisement");
	    }
	}
	# Return a blob.
	my $blob = { "hrn"          => $myhrn,
		     "uuid"         => $node->uuid(),
		     "role"	    => $node->role(),
		     "hostname"     =>
			 GeniUtil::FindHostname($node->node_id()),
		     "physctrl"     => 
			 Interface->LookupControl($node->phys_nodeid())->IP(),
		     "urn"          => $myurn,
		     "rspec"        => $rspec,
		     "url"          => $me->url(),
		     "gid"          => $component->cert(),
		   };

	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "slice") {
	my $slice = $object;

	#
	# In this implementation, the caller must hold a valid slice
	# credential for the slice being looked up. 
	#
	if (! ($isauth || $admin ||
	       $slice->urn() eq $credential->target_urn())) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"No permission to resolve $slice\n");
	}
	# Return a blob.
	my $blob = { "urn"          => $urn };

	my $aggregate = GeniAggregate->SliceAggregate($slice);
	if (defined($aggregate)) {
	    $blob->{'sliver_urn'} = $aggregate->urn();
	    my $manifest = $aggregate->GetManifest(1);
	    if (defined($manifest)) {
		$blob->{'manifest'}   = $manifest;
	    }
	    # For key bindings.
	    my $slice_experiment = $slice->GetExperiment();
	    if (!defined($slice_experiment)) {
		print STDERR "*** No Experiment for $slice\n";
	    }
	    else {
		my $bindings;
		if ($slice_experiment->NonLocalUsers(\$bindings)) {
		    print STDERR "*** No bindings for $slice_experiment\n";
		}
		elsif (@{ $bindings }) {
		    $blob->{'users'} = $bindings;
		}
	    }
	    $blob->{'public_url'} =
		"$TBDOCBASE/showslicepub.php?publicid=" . $slice->publicid()
		if (defined($slice->publicid()));
	}
	my $ticket = GeniTicket->SliceTicket($slice);
	if (defined($ticket)) {
	    $blob->{'ticket_urn'} = $ticket->urn();
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "sliver") {
	my $sliver = $object;
	my $slice  = $sliver->GetSlice();
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!defined($slice));

	#
	# In this implementation, the caller must hold a valid slice
	# or sliver credential for the slice being looked up. 
	#
	if (! ($admin || $isauth ||
	       $sliver->urn() eq $credential->target_urn() ||
	       $slice->urn() eq $credential->target_urn())) {
	    print STDERR $sliver->urn() . "\n";
	    print STDERR $slice->urn() . "\n";
	    print STDERR $credential->target_urn() . "\n";
	    print STDERR $ENV{'MYURN'} . "\n";
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN);
	}
	my $manifest = $sliver->GetManifest(1);
	if (!defined($manifest)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	# Return a blob.
	my $blob = { "urn"          => $urn,
		     "manifest"     => $manifest,
		 };
	$blob->{'public_url'} =
	    "$TBDOCBASE/showslicepub.php?publicid=" . $slice->publicid()
	    if (defined($slice->publicid()));
	
	# For key bindings.
	my $slice_experiment = $slice->GetExperiment();
	if (!defined($slice_experiment)) {
	    print STDERR "*** No Experiment for $slice\n";
	}
	else {
	    my $bindings;
	    if ($slice_experiment->NonLocalUsers(\$bindings)) {
		print STDERR "*** No bindings for $slice_experiment\n";
	    }
	    elsif (@{ $bindings }) {
		$blob->{'users'} = $bindings;
	    }
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "ticket") {
	my $ticket = $object;

	#
	# In this implementation, the caller must hold a valid slice
	# or sliver credential to get the ticket.
	#
	my $slice = GeniSlice->Lookup($ticket->slice_urn());
	if (!defined($slice)) {
	    print STDERR "Could not find slice for $ticket\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	if (! ($admin || $slice->urn() eq $credential->target_urn())) {
	    #
	    # See if its the sliver credential. 
	    #
	    my $aggregate = GeniAggregate->SliceAggregate($slice);
	    if (!defined($aggregate) ||
		$aggregate->urn() ne $credential->target_urn()) {
		return GeniResponse->Create(GENIRESPONSE_FORBIDDEN());
	    }
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $ticket->asString());
    }
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED, undef,
				"Cannot resolve $type at this authority");
}

#
# Discover resources on this component, returning a resource availablity spec
#
sub DiscoverResources($)
{
    my ($argref) = @_;
    my $credentials = $argref->{'credentials'};
    my $available   = $argref->{'available'} || 0;
    my $compress    = $argref->{'compress'} || 0;
    my $version     = $argref->{'rspec_version'} || undef;

    if (! (defined($credentials))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my ($credential,$speaksfor,@morecreds) = GeniStd::CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    return GeniCM::DiscoverResourcesAux($available, $compress,
        $version, [$credential, @morecreds]);
}

#
# Create a Sliver.
#
sub CreateSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $rspecstr     = $argref->{'rspec'};
    my $credentials  = $argref->{'credentials'};
    my $keys         = $argref->{'keys'};
    my $impotent     = $argref->{'impotent'} || 0;
    require Node;
    require Experiment;
    require libtestbed;
    require libaudit;

    # For now, I am not worrying about the slice_urn argument.
    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($rspecstr))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in rspec");
    }
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
    my ($credential,$speaksfor,@morecreds) =
	GeniStd::CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    main::AddLogfileMetaData("slice_urn", $slice_urn);
    
    #
    # In this implementation, the user must provide a slice credential,
    # so we ignore the slice_urn. For CreateSliver(), the slice must not
    # be instantiated.
    #
    my ($slice,$aggregate) = Credential2SliceAggregate($credential);
    if (defined($slice)) {
	return $slice
	    if (GeniResponse::IsResponse($slice));

	if ($slice_urn ne $slice->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"Credential does not match the URN");
	}
	main::AddLogfileMetaDataFromSlice($slice);
	
	#
	# Watch for a placeholder slice and update it.
	#
	if ($slice->isplaceholder()) {
	    if ($slice->Lock() != 0) {
		return GeniResponse->BusyResponse();
	    }
	    #
	    # Confirm that the slice certificate is the same.
	    #
	    if ($slice->cert() ne $credential->target_cert()->cert()) {
		$slice->UnLock();
		return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					    "Slice certificate mismatch");
	    }
	    my $user =
		GeniCM::CreateUserFromCertificate($credential);
	    if (GeniResponse::IsResponse($user)) {	    
		$slice->UnLock();
		return $user;
	    }
	    if ($slice->ConvertPlaceholder($user) != 0) {
		$slice->UnLock();
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Could not convert placeholder");
	    }
	    $slice->UnLock();
	}
	if (defined($aggregate)) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					"Must delete existing slice first");
	}
    }
    my $rspec = GeniCM::GetTicketAux($credential, $rspecstr,
				     0, $impotent, 1, 0,
				     undef, $speaksfor, @morecreds);
    return $rspec
	if (GeniResponse::IsResponse($rspec));

    $slice = GeniSlice->Lookup($credential->target_urn());
    if (!defined($slice)) {
	print STDERR "CreateSliver: Could not find slice for $credential\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,"Internal Error");
    }
    main::AddLogfileMetaDataFromSlice($slice);

    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();

    my $response = GeniCM::SliverWorkAux($credential, $rspec,
					 $keys, 0, $impotent, 1, 0, $speaksfor);

    if (GeniResponse::IsError($response)) {
	#
	# We have to make sure there is nothing left over since there
	# is no actual ticket, so the resources will not get cleaned
	# up by the daemon. This is mostly cause I am reaching into
	# the V1 code, and its messy.
	#
	$slice = GeniSlice->Lookup($credential->target_urn());
	if (defined($slice)) {
	    if ($slice->Lock() != 0) {
		print STDERR
		    "CreateSliver: Could not lock $slice before delete\n";
		return $response;
	    }
	    GeniCM::CleanupDeadSlice($slice, 1);
	}
	return $response;
    }
    my ($sliver_credential) = @{ $response->{'value'} };

    #
    # Leave the slice intact on error, so we can go look at it. 
    #
    if ($slice->WaitForLock(30) != 0) {
	print STDERR "CreateSliver: Could not lock $slice before start\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Internal Error");
    }
    $aggregate = GeniAggregate->SliceAggregate($slice);
    if (!defined($aggregate)) {
	print STDERR "CreateSliver: Could not find aggregate for $slice\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Internal Error");
    }
    # We get the manifest from the aggregate object, so that the
    # expiration goes in.
    my $sliver_manifest = $aggregate->GetManifest(1);

    #
    # At this point we want to return and let the startsliver proceed
    # in the background. Parent never returns, just the child.
    #
    my $mypid = main::WrapperFork();
    if ($mypid) {
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    [$sliver_credential, $sliver_manifest]);
    }

    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();

    #
    # The callee might also do a wrapper fork, so remember our PID
    # to make sure we unlock properly in only the parent side of the
    # fork. Child runs with slice unlocked for now. 
    #
    $mypid = $PID;
    
    if ($aggregate->Start($API_VERSION) != 0) {
	if ($PID == $mypid) {
	    $slice->UnLock();
	    print STDERR "Could not start sliver.\n";
	}
	else {
	    print STDERR "Error waiting for nodes.\n";
	}
	return -1;
    }
    if ($PID == $mypid) {
	$slice->UnLock();
    }
    return 0;
}

#
# Delete a Sliver.
#
sub DeleteSliver($)
{
    my ($argref) = @_;
    my $sliver_urn   = $argref->{'sliver_urn'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;

    if (! (defined($credentials) && defined($sliver_urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! GeniHRN::IsValid($sliver_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    #
    # In this implementation, the user must provide a slice or sliver
    # credential
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));
    
    if (! (defined($slice) && defined($aggregate))) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "Sliver does not exist");
    }
    if ($sliver_urn ne $aggregate->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }

    # If a monitor process is running, we are "busy".
    if ($slice->monitor_pid()) {
	return GeniResponse->MonitorResponse();
    }
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
    # If any slivers are imaging, then we are busy as well.
    if ($aggregate->CheckSliverStates("imaging")) {
	$slice->UnLock();
	return GeniResponse->BusyResponse();
    }
    
    main::AddLogfileMetaData("sliver_urn", $sliver_urn);
    main::AddLogfileMetaDataFromSlice($slice);
    
    #
    # We need this below to sign the ticket.
    #
    my $authority = GeniCertificate->LoadFromFile($EMULAB_PEMFILE);
    if (!defined($authority)) {
	print STDERR " Could not load $EMULAB_PEMFILE\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
	
    }
    #
    # We need the user to sign the new ticket to. 
    #
    my $user = GeniCM::CreateUserFromCertificate($credential);
    return $user
	if (GeniResponse::IsResponse($user));
    
    my $response = GeniCM::DeleteSliverAux($credential, $impotent, 1);
    return $response
	if (GeniResponse::IsResponse($response));

    #
    # In the v2 API, return a new ticket for the resources
    # (which were not released). As with all tickets, it will
    # expire very quickly. 
    #
    #
    # Create a new ticket from the manifest.
    #
    my $manifest = $aggregate->GetManifest(0);
    if (!defined($manifest)) {
	print STDERR "No manifest found for $aggregate\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
    my $ticket = GeniTicket->Create($authority, $user,
				    GeniXML::Serialize($manifest));
    if (!defined($ticket)) {
	print STDERR "Could not create new ticket for $slice\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
    $ticket->SetSlice($slice);
    $ticket->SetSpeaksFor($speaksfor)
	if (defined($speaksfor));
    
    if ($ticket->Sign()) {
	$ticket->Delete();
	print STDERR "Could not sign new ticket $ticket\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
    if ($ticket->Store()) {
	$ticket->Delete();
	print STDERR "Could not store new ticket $ticket\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
    my $slice_uuid = $slice->uuid();
    DBQueryWarn("delete from geni_manifests ".
		"where slice_uuid='$slice_uuid'");
    $slice->UnLock();
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $ticket->asString());

  bad:
    if (GeniCM::CleanupDeadSlice($slice) != 0) {
	print STDERR "Could not cleanup slice\n";
    }
    return $response;
}

#
# Delete a Slice
#
sub DeleteSlice($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;
    my $blocking     = 0;

    if (! (defined($credentials) && defined($slice_urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
    if (exists($argref->{'blocking'}) && $argref->{'blocking'}) {
	$blocking = 1;
    }
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

    if (! defined($slice)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No such slice here");
    }
    main::AddLogfileMetaDataFromSlice($slice);
    
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }

    #
    # If a monitor process is running, then the slice is busy.
    # This might mean that the user will not be able to delete
    # the slice for a long time, but we are having problems with
    # users canceling slices before they finish setting up, and
    # the XEN client side is not handling this very well. Note that
    # the cleanupslice script calls GeniCM::CleanupDeadSlice()
    # directly, which *does* kill the monitor, so admin cleanup
    # is not affected.
    #
    if ($slice->monitor_pid()) {
	$slice->UnLock();
	return GeniResponse->MonitorResponse();
    }
    # If any slivers are imaging, then we are busy as well.
    if (defined($aggregate) &&
	$aggregate->CheckSliverStates("imaging")) {
	$slice->UnLock();
	return GeniResponse->BusyResponse();
    }

    #
    # Proceed in the background. No reason to make the caller wait,
    # it takes too long.
    #
    if (!$blocking) {
	my $mypid = main::WrapperFork();
	if ($mypid) {
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	}
    }
    my $retval = GeniCM::CleanupDeadSlice($slice, 1);
    if ($retval) {
	return -1
	    if (!$blocking);
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    return 0
	if (!$blocking);
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

#
# Get a Sliver (credential)
#
sub GetSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};

    if (! (defined($credentials) && defined($slice_urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

    if (! (defined($slice) && defined($aggregate))) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No slice or aggregate here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    return GeniCM::GetSliverAux($credential);
}

#
# Start a sliver (not sure what this means yet, so reboot for now).
#
sub StartSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
    my $credentials  = $argref->{'credentials'};
    my $manifest     = $argref->{'manifest'};
    
    return SliverAction("start",
			$slice_urn, $sliver_urns, $credentials, $manifest);
}

sub StopSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
    my $credentials  = $argref->{'credentials'};

    return SliverAction("stop",
			$slice_urn, $sliver_urns, $credentials, undef);
}

sub RestartSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
    my $credentials  = $argref->{'credentials'};
    my $manifest     = $argref->{'manifest'};

    return SliverAction("restart",
			$slice_urn, $sliver_urns, $credentials, $manifest);
}

sub ReloadSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
    my $credentials  = $argref->{'credentials'};

    return SliverAction("reload",
			$slice_urn, $sliver_urns, $credentials, undef);
}

sub SliverAction($$$$$)
{
    my ($action, $slice_urn, $sliver_urns, $credentials, $manifest) = @_;
    my $response;
    my $isasync = 0;

    if (! (defined($credentials) &&
	   (defined($slice_urn) || defined($sliver_urns)))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "info" ) or
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Insufficient privilege");

    if (defined($manifest)) {
	$manifest = GeniXML::Parse($manifest);
	if (!defined($manifest)) {
	    print STDERR "Error reading manifest\n";
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Bad manifest");
	}
    }
    
    #
    # For now, only allow top level aggregate or the slice
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

    #
    # I think this allows the CM to perform an action without
    # the slice credential?
    #
    if ( (!defined($slice)) && 
          ($credential->target_urn() =~ /\+authority\+cm$/)) {
          # administrative credentials are presented.
          my $cm_urn = GeniHRN::Generate($OURDOMAIN, "authority", "cm");
          if ($cm_urn != $credential->target_urn()) {
            return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
                      "Credential target does not match CM URN");
          }

      if (!defined($slice_urn)) {
          return GeniResponse->MalformedArgsResponse("Missing arguments");
      }       
      $slice = GeniSlice->Lookup($slice_urn);
      return GeniResponse->Create(GENIRESPONSE_ERROR, undef, 
                "No Slice with urn $slice_urn here")
          if (!defined($slice));
      $aggregate = GeniAggregate->SliceAggregate($slice);
      return GeniResponse->Create(GENIRESPONSE_ERROR, undef, 
                      "No Aggregate here")
          if (!defined($aggregate));
    } 

    if (! (defined($slice) && defined($aggregate))) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "No slice or aggregate here");
    }
    main::AddLogfileMetaDataFromSlice($slice);

    # If a monitor process is running, we are "busy".
    if ($slice->monitor_pid()) {
	return GeniResponse->MonitorResponse();
    }
    
    if (defined($slice_urn)) {
	if (! GeniHRN::IsValid($slice_urn)) {
	    return
		GeniResponse->MalformedArgsResponse("Bad characters in URN");
	}
	if ($slice_urn ne $slice->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"Credential does not match the URN");
	}
    }
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
    # Shutdown slices get nothing.
    if ($slice->shutdown()) {
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Slice has been shutdown");
    }
    if ($aggregate->ComputeState()) {
	$slice->UnLock();
	print STDERR "Could not determine current state\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    my $CheckState = sub {
	my ($object, $action) = @_;

	if ($action eq "start") {
	    if ($object->state() ne "stopped" && $object->state() ne "new"
		&& $object->state() ne "mixed") {
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					    "Sliver is not stopped (yet)");
	    }
	}
	elsif ($action eq "stop") {
	    if ($object->state() ne "started" && $object->state() ne "mixed") {
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					    "Sliver is not started (yet)");
	    }
	}
	elsif ($action eq "restart") {
	    if ($object->state() ne "started" && $object->state() ne "mixed") {
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					    "Sliver is not started (yet)");
	    }
	}
	elsif ($action eq "reload") {
	    if ($object->state() ne "started" && $object->state() ne "stopped"){
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Sliver is not started or stopped (yet)");
	    }
	}
	return 0;
    };
    my $PerformAction = sub {
	my ($object, $action) = @_;

	my $exitval = 0;

	if ($action eq "start") {
	    $exitval = $object->Start($API_VERSION);
	}
	elsif ($action eq "stop") {
	    $exitval = $object->Stop($API_VERSION);
	}
	elsif ($action eq "restart") {
	    $exitval = $object->Restart($API_VERSION);
	}
	elsif ($action eq "reload") {
	    $exitval = $object->Reload($API_VERSION);
	}
	return GeniResponse->Create(GENIRESPONSE_ERROR, 
				    "Could not $action sliver")
	    if ($exitval);
	
	return 0;
    };

    my $user = GeniCM::CreateUserFromCertificate($credential);
    return $user
	if (GeniResponse::IsResponse($user));

    my $realuser = GeniCM::FlipToUser($slice, $user);
    if (! (defined($realuser) && $realuser)) {
	print STDERR "Error flipping to real user\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "FlipToUser Error");
    }

    if (defined($slice_urn)) {
	$response = &$CheckState($aggregate, $action);
	goto bad
	    if (GeniResponse::IsResponse($response));
	    
	if ($action eq "start" || $action eq "restart" || $action eq "reload"){
	    if (defined($manifest) &&
		$aggregate->ProcessManifest($manifest)) {
		$response = GeniResponse->Create(GENIRESPONSE_ERROR,
						 undef,
						 "Error processing manifest");
		goto bad;
	    }
	    #
	    # At this point we want to return and let the startsliver proceed
	    # in the background
	    #
	    my $mypid = main::WrapperFork();
	    if ($mypid) {
		return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	    }
	    # Remember our pid in case callee wrapper forks again.
	    $isasync = $PID;
	}
	$response = &$PerformAction($aggregate, $action);
	goto bad
	    if (GeniResponse::IsResponse($response));

	if (!$isasync || $isasync == $PID) {
	    $slice->UnLock();
	}
	return ($isasync ? GENIRESPONSE_SUCCESS :
		GeniResponse->Create(GENIRESPONSE_SUCCESS));
    }
    else {
	my @slivers = ();

	#
	# Sanity check all arguments before doing anything.
	#
	foreach my $urn (@{ $sliver_urns }) {
	    my $sliver = GeniSliver->Lookup($urn);
	    if (!defined($sliver)) {
		$response = GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
						 undef,
						 "Nothing here by that name");
		goto bad;
	    }
	    
	    $response = &$CheckState($sliver, $action);
	    goto bad
		if (GeniResponse::IsResponse($response));

	    push(@slivers, $sliver);
	}
	foreach my $sliver (@slivers) {
	    if ($action eq "start" && defined($manifest)) {
		if ($sliver->ProcessManifest($manifest)) {
		    $response = GeniResponse->Create(GENIRESPONSE_ERROR,
				     undef,
				     "Error processing manifest for $sliver");
		    goto bad;
		}
	    }
	    $response = &$PerformAction($sliver, $action);
	    goto bad
		if (GeniResponse::IsResponse($response));
	}
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
    }
  bad:
    $slice->UnLock();
    return ($isasync ? $response->{'code'} : $response);
}

#
# Get sliver status
#
sub SliverStatus($)
{
    my ($argref)     = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};

    if (! (defined($credentials) && defined($slice_urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "info" ) or
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Insufficient privilege");

    #
    # For now, only allow top level aggregate or the slice
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

    if (! (defined($slice) && defined($aggregate))) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No slice or aggregate here");
    }
    main::AddLogfileMetaDataFromSlice($slice);
    
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
    if ($aggregate->ComputeState()) {
	print STDERR "SliverStatus: Could not compute state for $aggregate\n";
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }

    #
    # Grab all the slivers for this slice, and then
    # look for just the nodes.
    #
    my @slivers    = ();
    if ($aggregate->SliverList(\@slivers) != 0) {
	print STDERR "SliverStatus: Could not get slivers for $aggregate\n";
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }

    my $blob = {
	"state"   => $aggregate->state(),
	"status"  => $aggregate->status(),