#!/usr/bin/perl -wT
#
# GENIPUBLIC-COPYRIGHT
# Copyright (c) 2008-2011 University of Utah and the Flux Group.
# All rights reserved.
#
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    = "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 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;

# 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 $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 $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 $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", "PG 0.1", "PG 0.2", "PG 2" );
    my @ad_rspec_versions = ( "0.1", "0.2", "2", "PG 0.1", "PG 0.2", "PG 2" );
    my $blob = {
	"api" => $API_VERSION,
	"level" => 1,
	"input_rspec" => \@input_rspec_versions,
	"output_rspec" => "0.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 = 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") {
	$isauth = 1;
    }
    
    if ($type eq "node") {
	my $node  = $object;
	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());
	}
	# 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;
	    }
	}
	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;

	#
	# In this implementation, the caller must hold a valid slice
	# or sliver credential for the slice being looked up. 
	#
	if (! ($admin ||
	       $sliver->urn() eq $credential->target_urn() ||
	       $sliver->slice_uuid() eq $credential->target_uuid())) {
	    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,
		 };
	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 = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    my $credential_objects = [];
    foreach my $credstr (@$credentials) {
        my $cred = CheckCredential($credstr);
        push(@$credential_objects, $cred) 
            if(!GeniResponse::IsResponse($cred));
    }
    return GeniCM::DiscoverResourcesAux($available, $compress,
        $version, $credential_objects);
}

#
# 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 = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    #
    # 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");
	}
	#
	# 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);
    return $rspec
	if (GeniResponse::IsResponse($rspec));

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

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

    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.
	#
	my $slice = GeniSlice->Lookup($credential->target_urn());
	if ($slice->Lock() != 0) {
	    print STDERR "CreateSliver: Could not lock $slice before delete\n";
	    return $response;
	}
	if (defined($slice)) {
	    GeniCM::CleanupDeadSlice($slice, 1);
	}
	return $response;
    }
    my ($sliver_credential, $sliver_manifest) = @{ $response->{'value'} };
    
    #
    # Leave the slice intact on error, so we can go look at it. 
    #
    $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");
    }
    if ($slice->Lock() != 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");
    }
    #
    # At this point we want to return and let the startsliver proceed
    # in the background
    #
    my $mypid = fork();
    if ($mypid) {
	# Let the child get going.
	sleep(1);
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    [$sliver_credential, $sliver_manifest]);
    }
    # This switches the file that we are writing to. 
    libaudit::AuditFork();
    
    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();

    if ($aggregate->Start($API_VERSION, 0) != 0) {
	$slice->UnLock();
	print STDERR "Could not start sliver\n";
	return -1;
    }
    $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 = 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");
    }

    #
    # 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);
    
    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;

    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 = 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");
    }
    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 (GeniCM::CleanupDeadSlice($slice, 1) != 0) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not cleanup slice");
    }
    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 = 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 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 = 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));

    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");
    }
    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)");
	    }
	}
	return 0;
    };
    my $PerformAction = sub {
	my ($object, $action) = @_;

	my $exitval = 0;

	if ($action eq "start") {
	    $exitval = $object->Start($API_VERSION, 0);
	}
	elsif ($action eq "stop") {
	    $exitval = $object->Stop($API_VERSION);
	}
	elsif ($action eq "restart") {
	    $exitval = $object->Start($API_VERSION, 1);
	}
	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") {
	    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 = fork();
	    if ($mypid) {
		# Let the child get going.
		sleep(1);
		return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	    }
	    $isasync = 1;
	    
	    # This switches the file that we are writing to. 
	    libaudit::AuditFork();
	}
	$response = &$PerformAction($aggregate, $action);
	goto bad
	    if (GeniResponse::IsResponse($response));

	$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 = 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");
    }
    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(),
	"error"   => $aggregate->ErrorLog(),
	"details" => {},
    };
    foreach my $sliver (@slivers) {
	if ($sliver->isa("GeniAggregate")) {
	    next
		if (! (ref($sliver) eq "GeniAggregate::Link" ||
		       ref($sliver) eq "GeniAggregate::Tunnel"));
	}
	elsif ($sliver->resource_type() ne "Node") {
	    next;
	}

	my $sliver_urn    = $sliver->sliver_urn();
	my $resource_id = $sliver->resource_id();
	my $state         = $sliver->state();
	my $status        = $sliver->status();
	my $error         = "";

	# New is the same as stopped. Separate state is handy.
	$state = "stopped"
	    if ($state eq "new");

	if ($status eq "failed") {
	    $error = $sliver->ErrorLog();
	}
	$blob->{'details'}->{$sliver_urn} = {
	    "component_urn" => $resource_id,
	    "state"  => $state,
	    "status" => $status,
	    "error"  => $error,
	};
    }
    $slice->UnLock();
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
}

#
# Shutdown sliver
#
sub Shutdown($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $clear        = $argref->{'clear'} || 0;
    my $credentials  = $argref->{'credentials'};
    require libtestbed;

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

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

    #
    # The clearinghouse generates a different credential to do this.
    #
    if ($slice_urn ne $credential->target_urn()) {
	my $certificate = GeniCertificate->LoadFromFile($GENICH_PEMFILE);
	if (!defined($certificate)) {
	    print STDERR "Could not load certificate from $GENICH_PEMFILE\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}

	# The caller has to match the clearinghouse.
	if ($credential->owner_urn() ne $certificate->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					"Insufficient privilege");
	}
    }

    #
    # No slice here? Done.
    #
    my $slice = GeniSlice->Lookup($slice_urn);
    if (!defined($slice)) {
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
    }
    #
    # Do not worry about locking when setting the shutdown time.
    # This can lead to race though, if a clear shutdown comes in first.
    # Seems unlikely though. 
    #
    if (!$clear) {
	# Do not overwrite original shutdown time
	$slice->SetShutdown(1)
	    if (!defined($slice->shutdown()) || $slice->shutdown() eq "");
    }
    else {
	$slice->SetShutdown(0);
    }
    # Always make sure the slice is shutdown.
    if ($slice->shutdown()) {
	# The expire daemon is going to look for this, so it will get
	# taken care of shortly.
	if ($slice->Lock() != 0) {
	    return GeniResponse->BusyResponse();
	}
	if (GeniCM::CleanupDeadSlice($slice, 0) != 0) {
	    libtestbed::SENDMAIL($TBOPS, "Emergency Shutdown failed",
				 "Emergency shutdown failed on $slice\n");
	    print STDERR "Could not shutdown $slice!\n";
	    # Lets call this a non-error since the local admin person
	    # is going to have to deal with it anyway. 
	}
	$slice->UnLock();
    }
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

#
# Renew a slice
#
sub RenewSlice($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $valid_until  = $argref->{'valid_until'} || $argref->{'expiration'};
    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 = 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_BADARGS, undef,
				    "No slice or aggregate here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    my $credential_objects = [];
    foreach my $credstr (@$credentials) {
        my $cred = CheckCredential($credstr);
        push(@$credential_objects, $cred) 
            if(!GeniResponse::IsResponse($cred));
    }
    return GeniCM::RenewSliverAux($credential_objects, $valid_until);
}

#
# Get a Ticket.
#
sub GetTicket($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $rspecstr     = $argref->{'rspec'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;

    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");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    #
    # This implementation requires a slice credential, and it must
    # match the slice_urn.
    #
    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");
	}

	#
	# 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();
	}
	
	#
	# GetTicket applies only to slices that are not active. Must
	# use UpdateSliver() for an active sliver.
	#
	if (defined($aggregate)) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
				"Cannot get a ticket for active sliver");
	}
	#
	# It is an error if there is an outstanding ticket. That ticket
	# must be released first.
	#
	my $ticket = GeniTicket->SliceTicket($slice);
	if (defined($ticket)) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Must release unredeemed ticket first");
	}
	if ($slice->IsExpired()) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					"Slice has expired");
	}
    }
    else {
	# Slice does not exist yet. 
    }
    return GeniCM::GetTicketAux($credential,
				$rspecstr, 0, $impotent, 1, 1, undef);
}    
	
#
# Update a ticket, returning a new ticket. 
#
sub UpdateTicket($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $ticketstr    = $argref->{'ticket'};
    my $rspecstr     = $argref->{'rspec'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;

    if (! (defined($credentials) && defined($ticketstr) &&
	   defined($slice_urn) && defined($rspecstr))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in rspec");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    defined($credential) &&
	($credential->HasPrivilege( "pi" ) or
	 $credential->HasPrivilege( "instantiate" ) or
	 $credential->HasPrivilege( "bind" ) or
	 return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				      "Insufficient privilege" ));

    #
    # This implementation requires a slice credential, and it must
    # match the slice_urn.
    #
    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");
	}
    }
    else {
	# Slice should exist at this point.
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED(), undef,
				    "Slice does not exist here");
    }
    if ($slice->IsExpired()) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Slice has expired");
    }
    
    #
    # UpdateTicket applies only to slices that are not active. Must
    # use UpdateSliver() for an active sliver.
    #
    if (defined($aggregate)) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
			    "Cannot update a ticket for active sliver");
    }

    my $ticket = GeniTicket->CreateFromSignedTicket($ticketstr);
    if (!defined($ticket)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create GeniTicket object");
    }
    #
    # Make sure the ticket was issued to the caller.
    #
    if ($ticket->owner_urn() ne $ENV{'GENIURN'}) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "This is not your ticket");
    }
    if (!$ticket->stored()) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
				    "Not an active ticket");
    }
    if ($ticket->slice_urn() ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "This ticket is for another slice");
    }
    
    #
    # We need the user to sign the new ticket to. 
    #
    my $user = GeniCM::CreateUserFromCertificate($credential);
    return $user
	if (GeniResponse::IsResponse($user));
    
    my $credential_objects = [];
    foreach my $credstr (@$credentials) {
        my $cred = CheckCredential($credstr);
        push(@$credential_objects, $cred) 
            if(!GeniResponse::IsResponse($cred));
    }
    return GeniCM::GetTicketAuxAux($slice, $user,
				   $rspecstr, 1, $impotent, 1, 1, $ticket, $credential_objects);
}

#
# Update a sliver, returning a new ticket. 
#
sub UpdateSliver($)
{
    my ($argref) = @_;
    my $sliver_urn   = $argref->{'sliver_urn'};
    my $rspecstr     = $argref->{'rspec'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;

    if (! (defined($credentials) &&
	   defined($sliver_urn) && defined($rspecstr))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in rspec");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    defined($credential) &&
	($credential->HasPrivilege( "pi" ) or
	 $credential->HasPrivilege( "instantiate" ) or
	 $credential->HasPrivilege( "bind" ) or
	 return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				      "Insufficient privilege" ));

    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

    if (! (defined($slice) && defined($aggregate))) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "No slice or aggregate here");
    }
    # Must be an aggregate (top level sliver).
    if (ref($aggregate) ne "GeniAggregate") {
	return GeniResponse->MalformedArgsResponse("Must supply aggregate");
    }
    if ($sliver_urn ne $aggregate->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    #
    # It is an error if there is an outstanding ticket. That ticket
    # must be released first.
    #
    my $ticket = GeniTicket->SliceTicket($slice);
    if (defined($ticket)) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Must release unredeemed ticket first");
    }

    if ($slice->IsExpired()) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Slice has expired");
    }

    #
    # Any user can update the sliver. The ticket is signed to that user.
    #
    my $user = GeniCM::CreateUserFromCertificate($credential);
    return $user
	if (GeniResponse::IsResponse($user));
    
    my $credential_objects = [];
    foreach my $credstr (@$credentials) {
        my $cred = CheckCredential($credstr);
        push(@$credential_objects, $cred) 
            if(!GeniResponse::IsResponse($cred));
    }
    return GeniCM::GetTicketAuxAux($slice, $user,
				   $rspecstr, 1, $impotent, 1, 1, undef, $credential_objects);
}

#
# Redeem a ticket
#
sub RedeemTicket($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $ticketstr    = $argref->{'ticket'};
    my $credentials  = $argref->{'credentials'};
    my $keys         = $argref->{'keys'};
    my $impotent     = $argref->{'impotent'} || 0;
    
    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($ticketstr))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

    my $ticket = GeniTicket->CreateFromSignedTicket($ticketstr);
    if (!defined($ticket)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create GeniTicket object");
    }
    #
    # Make sure the ticket was issued to the caller.
    #
    if ($ticket->owner_urn() ne $ENV{'GENIURN'}) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "This is not your ticket");
    }
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

    if (! (defined($slice))) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "No slice here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    my $isupdate = defined($aggregate);

    return GeniCM::SliverWorkAux($credential,
				 $ticket, $keys, $isupdate, $impotent, 1, 1);
}

#
# Redeem a ticket
#
sub BindToSlice($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
    my $keys         = $argref->{'keys'};
    
    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($keys))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

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

    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

    if (! (defined($slice))) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "No slice here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    
    #
    # Find or create the user.
    #
    my $user = GeniCM::CreateUserFromCertificate($credential);
    return $user
	if (GeniResponse::IsResponse($user));
    
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
    # Bind for future slivers.
    if ($slice->BindUser($user) != 0) {
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Error binding slice to user");
    }
    if (defined($keys)) {
	my $response = GeniCM::AddKeys($slice, $user, $keys);
	if (GeniResponse::IsResponse($response)) {
	    $slice->UnLock();
	    return $response;
	}
    }
    $slice->UnLock();
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

#
# Release a ticket.
#
sub ReleaseTicket($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $ticketstr    = $argref->{'ticket'};
    my $credentials  = $argref->{'credentials'};
    
    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($ticketstr))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

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

    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

    if (! (defined($slice))) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No slice here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    my $ticket = GeniTicket->CreateFromSignedTicket($ticketstr);
    if (!defined($ticket)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create GeniTicket object");
    }
    #
    # If the ticket is not stored, it is not a ticket that needs
    # to be released. It is a copy or a reissue. Needs more thought.
    #
    if (! $ticket->stored()) {
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
    }
    #
    # And of course, the ticket has to be for the slice indicated
    # by the provided credential.
    #
    if ($ticket->slice_urn() ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "This ticket is for another slice");
    }
    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");
    }
    #
    # XXX Need to do a restore backup state operation if this ticket
    # was the result of an update.
    #
    if ($ticket->Lock() != 0) {
	return GeniResponse->BusyResponse("ticket");
    }
    if ($ticket->Release(TICKET_RELEASED) != 0) {
	print STDERR "ReleaseTicket: Error releasing $ticket\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

sub ListUsage($)
{
    my ($argref)    = @_;
    my $credentials = $argref->{'credentials'};
    
    if (! (defined($credentials))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my @credentials = @{ $credentials };
    return GeniCM::ListUsage({"credential" => $credentials[0]});
}

sub ListHistory($)
{
    my ($argref)    = @_;
    my $credentials = $argref->{'credentials'};
    my $type        = $argref->{'type'};

    if (! (defined($credentials) && defined($type))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    my @credentials = @{ $credentials };
    return GeniCM::ListHistory({"credential" => $credentials[0],
				"type"       => $type});
}

sub ReserveVlanTags($)
{
    my ($argref)    = @_;
    my $credentials = $argref->{'credentials'};
    my $slice_urn   = $argref->{'slice_urn'};
    my $slice_cert  = $argref->{'slice_cert'};
    my $rspecstr    = $argref->{'rspec'};
    my $linkname    = $argref->{'linkname'};
    my $taglist     = $argref->{'taglist'};
    my $response;
    my $actualtag;
    # List of vlans to delete after getting the tags.
    my @delete      = ();
    my %linkmap     = ();

    require Lan;

    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);
    }
    if (! (defined($credentials) && defined($slice_cert) &&
	   defined($taglist) &&
	   defined($linkname) && defined($slice_urn) && defined($rspecstr))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! ($linkname =~ /^[-\w]*$/)) {
	return GeniResponse->MalformedArgsResponse("Bad linkname");
    }
    foreach my $tag (@{ $taglist }) {
	if (! ($tag =~ /^\d*$/)) {
	    return GeniResponse->MalformedArgsResponse("Bad tag in list");
	}
    }
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($credential));

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

    my (undef,$callertype,$callerid) = GeniHRN::Parse($credential->owner_urn());
    if (! ($callertype eq "authority" && $callerid eq "cm")) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef, "Not a CM");
    }
    my $slice_certificate = GeniCertificate->LoadFromString($slice_cert);
    if (!defined($slice_certificate)) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Bad slice certificate");
    }
    if ($slice_urn ne $slice_certificate->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Slice URN mismatch");
    }
    my $slice = GeniSlice->Lookup($slice_urn);
    if (defined($slice)) {
	#
	# Already exists locally. 
	#
        if ($slice->StitchLock() != 0) {
	    return GeniResponse->BusyResponse();
	}
    }
    else {
	#
	# Create a placeholder slice. Have to watch for a concurrent
	# slice creation through the normal path, in which case the code
	# needs to see if the slice was first created on this path.
	#
	my $authority =
	    GeniCMV2::CreateAuthorityFromRegistry($slice_certificate);
	if (GeniResponse::IsResponse($authority)) {
	    print STDERR "Could not create authority from registry\n";
	    $response = $authority;
	    goto done;
	}
	$slice = GeniSlice->Create($slice_certificate, undef, $authority);
	if (!defined($slice)) {
	    $response = GeniResponse->Create(GENIRESPONSE_ERROR);
	    goto done;
	}
	#
	# Concurrency requires that we try for the lock after we create
	# it, since in fact it might not be us that created it. 
	#
        if ($slice->StitchLock() != 0) {
	    return GeniResponse->BusyResponse();
	}
    }
    #
    # Confirm that the certificate is the same.
    #
    if ($slice->cert() ne $slice_cert) {
	$response = GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					 "Slice certificate mismatch");
	goto done;
    }
    
    my $slice_experiment = GeniCM::GeniExperiment($slice);
    if (GeniResponse::IsResponse($slice_experiment)) {
	print STDERR "Could not create new Geni slice experiment!\n";
	$response = $slice_experiment;
	goto done;
    }
    my $pid = $slice_experiment->pid();
    my $eid = $slice_experiment->eid();
    
    #
    # Run xmllint on the rspec to catch format errors.
    #
    my ($fh, $filename) = tempfile(UNLINK => 0);
    if (!defined($fh)) {
	print STDERR "Could not create temp file for rspec\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto done;
    }
    print $fh $rspecstr;
    close($fh);
    my $xmlerrors = `$XMLLINT --noout $filename 2>&1`;
    unlink($filename);
    if ($?) {
	$response = GeniResponse->Create(GENIRESPONSE_BADARGS,
					 $xmlerrors,
					 "rspec is not well formed");
	goto done;
    }
    my $rspec = GeniXML::Parse($rspecstr);
    if (! defined($rspec)) {
	$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Error Parsing rspec XML");
	goto done;
    }

    my $rspecVersion = GeniXML::GetXmlVersion($rspec);
    if (! defined($rspecVersion)) {
	$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Unknown RSpec Version");
	goto done;
    }

    #
    # Find the linkref for the one link we care about. 
    #
    my $linkref;
    
    foreach my $ref (GeniXML::FindNodes("n:link", $rspec)->get_nodelist()){
	my $vname  = GeniXML::GetVirtualId($ref);

	if ($vname eq $linkname) {
	    $linkref = $ref;
	    last;
	}
    }
    if (!defined($linkref)) {
	$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Could not find link in rspec");
	goto done;
    }

    #
    # Go through the component hops and find the one that refers to us.
    # This is our external network point.
    #
    my $hopref;
    foreach my $ref (GeniXML::FindNodes("n:component_hop",
					$linkref)->get_nodelist()) {
	my $component_urn = GeniXML::GetNodeId($ref);
	my ($domain,undef,undef) = GeniHRN::Parse($component_urn);
	if (defined($domain) and $domain eq $me->domain()) {
	    $hopref = $ref;
	    last;
	}
    }
    if (!defined($hopref)) {
	$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Could not find hop in link");
	goto done;
    }
    my $hop_urn = GeniXML::GetNodeId($hopref);
    my (undef,undef,$network_id) = GeniHRN::Parse($hop_urn);

    my $network = ExternalNetwork->Lookup($network_id);
    if (!defined($network)) {
	$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				 "$hop_urn is not an external network");
	goto done;
    }
    
    my $vlan = VLan->Lookup($slice_experiment, $linkname);
    if (!defined($vlan)) {
	#
	# The point of this is to create the VLan object, just
	# long enough to get a lanid and a tag assigned. 
	#
	$vlan = VLan->Create($slice_experiment, $linkname);
	if (!defined($vlan)) {
	    print STDERR "Could not create vlan for $linkname\n";
	    $response = GeniResponse->Create(GENIRESPONSE_ERROR);
	    goto done;
	}
	push(@delete, $vlan);
    }

    #
    # If there is already a reservation, it better be one of the
    # tags we got.
    #
    my $tag = $vlan->GetReservedVlanTag();
    if ($tag) {
	print STDERR "$vlan already had tag $tag.\n";
	if (! (grep {$_ == $tag} @{ $taglist })) {
	    print STDERR "  but the tag is not in the list we got.\n";
	    #
	    # Tell the caller about the tag; it is the only choice.
	    #
	    my @okaytags = ($tag);
	    $response = GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
					     \@okaytags,
					     "Could not find a suitable tag");
	    goto done;
	}
	$actualtag = $tag;
    }
    else {
	#
	# Check to see what tags are valid for us. 
	#
	my @tags = ();
	foreach my $tag (@{ $taglist }) {
	    push(@tags, $tag)
		if ($network->VlanTagOkay($tag));
	}
	if (!@tags) {
	    #
	    # Return a list of okay tags. 
	    #
	    my @okaytags = ();
	    for (my $i = $network->min_vlan();
		 $i < $network->max_vlan(); $i++) {
		push(@okaytags, $i);
	    }
	    $response = GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
					     \@okaytags,
					     "Could not find a suitable tag");
	    goto done;
	}
	
	#
	# This is a debugging hack; Inside an elabinelab, it might be
	# an other local elabinelab or the outer boss. In this case,
	# there is no need to ask the outer boss to reserve a vlan, since
	# we already know that will fail (already reserved by the other).
	# In this case, we can just stipulate that one of the tags is good.
	#
	if ($ELABINELAB) {
	    my ($hisauth,undef,undef) = GeniHRN::Parse($slice_urn);

	    my @tmp = split('\.', $OURDOMAIN);
	    # Get the last two tokens. Not always the right thing to do. 
	    my $dom = join('.', splice(@tmp, -2, 2));

	    if ($me->domain() =~ /$dom$/ && $hisauth =~ /$dom$/) {
		print STDERR "ElabInElab clause is true\n";

		my $tag = pop(@tags);
		if ($vlan->ReserveVlanTag($tag)) {
		    $actualtag = $tag;
		    goto gottag;
		}
		print STDERR "But could not allocate tag $tag\n";
		$response =
		    GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					 "Could not find a suitable tag");
		goto done;
	    }
	}
	
	#
	# Find a tag that we think is free. Snmpit will be the one to
	# say for sure, since it will also check the switches.
	#
	my $vlanid = $vlan->lanid();
	my $tag = undef;
	my @tmp = @tags;
	while (@tmp) {
	    $tag = pop(@tmp);
	    if ($vlan->ReserveVlanTag($tag, 1)) {
		#
		# Have snmpit do actual reservation.
		#
		system("$SNMPIT -A $pid $eid $vlanid,$tag");
		if ($?) {
		    print STDERR "Could not reserve $vlanid,$tag\n";
		    next;
		}
		$actualtag = $vlan->GetReservedVlanTag();
		if (! $actualtag || $actualtag != $tag) {
		    print STDERR "No tag reserved for $vlan\n";
		    $response = GeniResponse->Create(GENIRESPONSE_ERROR);
		    goto done;
		}
		$actualtag = $tag;
		last;
	    }
	}
    }
    if (!defined($actualtag)) {
	$response = GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					 "Could not find a suitable tag");
	goto done;
    }
  gottag:
    GeniXML::SetText("vlantag", $linkref, $actualtag);
    $response = GeniResponse->Create(GENIRESPONSE_SUCCESS, 
				     GeniXML::Serialize($rspec));
  done:
    foreach my $vlan (@delete) {
	$vlan->ClearReservedVlanTag()
	    if (GeniResponse::IsError($response));

	$vlan->Destroy();
    }
    $slice->StitchUnLock()
	if (defined($slice));
    return $response;
}

#
# Initial credential check.
#
sub CheckCredentials($)
{
    if (ref($_[0]) ne "ARRAY") {
	return
	    GeniResponse->MalformedArgsResponse("Credentials should be a ".
						"array not a singleton");
    }
    
    my @credentials = @{ $_[0] };
    if (scalar(@credentials) != 1) {
	return
	    GeniResponse->MalformedArgsResponse("Wrong number of credentials");
    }
    my $credential  = GeniCredential->CreateFromSigned($credentials[0]);
    if (!defined($credential)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create credential object");
    }
    #
    # Well formed credentials must now have URNs.
    #
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"Malformed credentials; missing URNs")
	if (! (defined($credential->owner_urn()) &&
	       defined($credential->target_urn()) &&
	       GeniHRN::IsValid($credential->owner_urn()) &&
	       GeniHRN::IsValid($credential->target_urn())));
	
    #
    # Make sure the credential was issued to the caller.
    #
    if ($credential->owner_urn() ne $ENV{'GENIURN'}) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "This is not your credential");
    }
    return $credential;
}

sub CheckCredential($)
{
    my $credential = GeniCredential->CreateFromSigned($_[0]);
    if (!defined($credential)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create credential object");
    }
    #
    # Well formed credentials must now have URNs.
    #
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"Malformed credentials; missing URNs")
	if (! (defined($credential->owner_urn()) &&
	       defined($credential->target_urn()) &&
	       GeniHRN::IsValid($credential->owner_urn()) &&
	       GeniHRN::IsValid($credential->target_urn())));
	
    #
    # Make sure the credential was issued to the caller.
    #
    if ($credential->owner_urn() ne $ENV{'GENIURN'}) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "This is not your credential");
    }
    return $credential;
}

#
# Convert a URN to the local object.
#
sub LookupURN($)
{
    my ($urn) = @_;
    my $object = undef;
    
    if (! GeniHRN::IsValid($urn)) {
	return GeniResponse->MalformedArgsResponse("Invalid URN");
    }
    # The URN encodes the type.
    my ($auth,$type,$id) = GeniHRN::Parse($urn);
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"Authority mismatch")
	if ($type ne "slice" && $auth ne $OURDOMAIN);
    $type = lc($type);

    if ($type eq "node") {
	$object = GeniUtil::LookupNode($urn);
    }
    elsif ($type eq "slice") {
	$object = GeniSlice->Lookup($urn);
    }
    elsif ($type eq "ticket") {
	$object = GeniTicket->Lookup($urn);
    }
    elsif ($type eq "sliver") {
	$object = GeniAggregate->Lookup($urn) || GeniSliver->Lookup($urn);
    }
    if (!defined($object)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
				    undef, "Nothing here by that name");
    }
    return ($object, $type);
}

#
# Map a slice/sliver credential to slice/aggregate
#
sub Credential2SliceAggregate($)
{
    my ($credential) = @_;
    my $target_cert  = $credential->target_cert();
    my $target_urn   = $credential->target_urn();
    my $target_uuid  = $credential->target_uuid();
    my $slice;
    my $aggregate;
    
    # First try the target urn, then fall back to the uuid
    $slice = GeniSlice->Lookup($target_urn);
    if (! defined($slice)) {
        # Could not find it by urn, trying uuid
        $slice = GeniSlice->Lookup($target_uuid);
    }
    if (defined($slice)) {
	#
	# Make sure the certificate has not changed. If it has, then
	# this is really a new slice. That is an error. 
	#
	if (!$target_cert->SameCert($slice)) {
	    return (GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				 "Duplicate slice URN already exists here"));
	}
	if ($credential->expires() gt $slice->expires()) {
	    #
	    # The credential presented lasts longer than we thought the
	    # slice did: our expiry date must have been stale.  This can
	    # happen because the SA is always free to extend the lifetime
	    # of a slice, and is not required to tell us.
	    #
	    # If the slice has already expired, then the expiration daemon will
	    # take care of this, and lets not get in the way of that.
	    # The user needed to renew the slice to prevent it.
	    # 
	    # If not expired, still do nothing; it is up to the user to renew
	    # the sliver.
	    #
	    ;
	}
	$aggregate = GeniAggregate->SliceAggregate($slice);
    }
    else {
	$aggregate = GeniAggregate->Lookup($target_uuid);
	if (defined($aggregate)) {
	    if ($aggregate->type() ne "Aggregate") {
		$aggregate = undef;
	    }
	    else {
		$slice = GeniSlice->Lookup($aggregate->slice_uuid());
		if (!defined($slice)) {
		    $aggregate = undef;
		}
	    }
	}
    }
    return ($slice, $aggregate);
}

#
# Emulab specific function to inject events into the experiment event scheduler.
#
sub InjectEvent($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
    my $time         = $argref->{'time'};
    my $name         = $argref->{'name'};
    my $event	     = $argref->{'event'};
    my $args         = "";
    my $waitmode     = 0;
    
    if (! (defined($credentials) && defined($slice_urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! (defined($time) && defined($name) && defined($event))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! ($time eq "now" || $time =~ /^\+\d*$/)) {
	return GeniResponse->MalformedArgsResponse("Improper time argument");
    }
    if (! ($name =~ /^[-\w]*$/)) {
	return GeniResponse->MalformedArgsResponse("Improper name argument");
    }
    if (! ($event =~ /^[-\w]*$/)) {
	return GeniResponse->MalformedArgsResponse("Improper event argument");
    }
    if (exists($argref->{'args'})) {
	if (ref($argref->{'args'}) ne "ARRAY") {
	    return
		GeniResponse->MalformedArgsResponse("Improper args argument");
	}
	my @args = @{ $argref->{'args'} };
	# Sanitize for shell.
	foreach my $arg (@args) {
	    $arg =~ s/(')/'\\''/g;
	    $args .= "'$arg' ";
	}
    }
    $waitmode = 1
	if (exists($argref->{'waitmode'}) && $argref->{'waitmode'});
    
    my $credential = CheckCredentials($credentials);
    return $credential
	if (GeniResponse::IsResponse($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 ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
    my $experiment = $slice->GetExperiment();
    if (!defined($experiment)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "No local experiment for slice");
    }
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();
    my $opt = ($waitmode ? "-w" : "");

    my $output =
	GeniUtil::ExecQuiet("$TEVC $opt -e $pid/$eid $time $name $event $args");
    if ($?) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef, $output);
    }
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

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