GeniTicket.pm.in

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

#
# Some simple ticket stuff.
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

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

# Must come after package declaration!
use lib '@prefix@/lib';
use GeniDB;
use GeniCredential;
use GeniCertificate;
use Experiment;
use libdb qw(TBGetUniqueIndex);
use English;
use XML::Simple;
use XML::LibXML;
use Data::Dumper;
use File::Temp qw(tempfile);
use overload ('""' => 'Stringify');

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
my $SIGNCRED	   = "$TB/sbin/signgenicred";
my $VERIFYCRED	   = "$TB/sbin/verifygenicred";
my $NFREE	   = "$TB/bin/nfree";
my $CMCERT	   = "$TB/etc/genicm.pem";

# Cache of tickets.
my %tickets = ();

#
# Lookup by local idx.
#
sub Lookup($$)
{
    my ($class, $idx) = @_;

    return undef
	if (! ($idx =~ /^\d*$/));
    return $tickets{"$idx"}
        if (exists($tickets{"$idx"}));

    my $query_result =
	DBQueryWarn("select * from geni_tickets where idx='$idx'");

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

    my $row = $query_result->fetchrow_hashref();

    # Map the component
    my $component;
    if ($row->{'component_uuid'}) {
	$component = GeniComponent->Lookup($row->{'component_uuid'});
	return undef
	    if (!defined($component));
    }
    my $ticket = GeniTicket->CreateFromSignedTicket($row->{'ticket_string'},
						    $component, 1);
    return undef
	if (!defined($ticket));

    # Mark as coming from the DB.
    $ticket->{'idx'}    = $idx;
    $ticket->{'stored'} = 1;

    # Cache.
    $tickets{"$idx"} = $ticket;
    return $ticket;
}

#
# Create an unsigned ticket object, to be populated and signed and returned.
#
sub Create($$$$)
{
    my ($class, $slice, $owner, $rspec) = @_;

    # Every Ticket gets a new unique index (sequence number).
    my $seqno = TBGetUniqueIndex('next_ticket', 1);
    
    my $self = {};
    $self->{'rspec'}         = $rspec;
    $self->{'slice_uuid'}    = $slice->uuid();
    $self->{'owner_uuid'}    = $owner->uuid();
    $self->{'slice_cert'}    = $slice->cert();
    $self->{'owner_cert'}    = $owner->cert();
    $self->{'seqno'}         = $seqno;
    $self->{'ticket_string'} = undef;
    $self->{'component'}     = undef;
    $self->{'stored'}        = 0;	# Stored to the DB.

    #
    # Locally generated tickets need a local DB index, which can be the
    # same as the sequence number. A ticket from a remote component will
    # have it own seqno, and so we will generate a locally valid idx for
    # those when when(if) we store them in the DB.
    #
    $self->{'idx'}           = $seqno;
    
    bless($self, $class);

    return $self;
}
# accessors
sub field($$)           { return ($_[0]->{$_[1]}); }
sub idx($)		{ return field($_[0], "idx"); }
sub seqno($)		{ return field($_[0], "seqno"); }
sub rspec($)		{ return field($_[0], "rspec"); }
sub uuid($)		{ return field($_[0], "slice_uuid"); }
sub slice_uuid($)	{ return field($_[0], "slice_uuid"); }
sub owner_uuid($)	{ return field($_[0], "owner_uuid"); }
sub slice_cert($)	{ return field($_[0], "slice_cert"); }
sub owner_cert($)	{ return field($_[0], "owner_cert"); }
sub ticket($)		{ return field($_[0], "ticket"); }
sub asString($)		{ return field($_[0], "ticket_string"); }
sub ticket_string($)	{ return field($_[0], "ticket_string"); }
sub component_uuid($)	{ return field($_[0], "component_uuid"); }
sub component($)	{ return field($_[0], "component"); }
sub stored($)		{ return field($_[0], "stored"); }

#
# Stringify for output.
#
sub Stringify($)
{
    my ($self) = @_;
    
    my $idx = $self->idx();
    if (!defined($idx)) {
	my $seqno = $self->seqno();
	$idx = "S$seqno";
    }
    my $slice_uuid = $self->slice_uuid();
    
    return "[GeniTicket: $idx, slice:$slice_uuid]";
}

#
# Create a ticket object from a signed ticket string.
#
sub CreateFromSignedTicket($$;$$)
{
    my ($class, $ticket_string, $component, $nosig) = @_;

    #
    # This flag is used to avoid verifying the signature since I do not
    # really care if the component gives me a bad ticket; I am not using
    # it locally, just passing it back to the component at some point.
    #
    $nosig = 0
	if (!defined($nosig));

    if (! $nosig) {
	my ($fh, $filename) = tempfile(UNLINK => 0);
	return undef
	    if (!defined($fh));
	print $fh $ticket_string;
	close($fh);
	system("$VERIFYCRED $filename");
	if ($?) {
	    print STDERR "Ticket in $filename did not verify\n";
	    return undef;
	}
	unlink($filename);
    }

    # Use XML::Simple to convert to something we can mess with.
    my $parser = XML::LibXML->new;
    my $doc;
    eval {
	$doc = $parser->parse_string($ticket_string);
    };
    if ($@) {
	print STDERR "Failed to parse ticket string: $@\n";
	return undef;
    }

    # Dig out the rspec.
    my ($rspec_node) = $doc->getElementsByTagName("rspec");
    return undef
	if (!defined($rspec_node));
    my $rspec = XMLin($rspec_node->toString(), ForceArray => ["node",
							      "link"]);

    # Dig out the slice uuid. Locally, I am not sure if we bother to
    # keep slices in the DB (they are in the DB at geni central).
    my ($uuid_node) = $doc->getElementsByTagName("this_uuid");
    return undef
	if (!defined($uuid_node));
    my $slice_cert = $uuid_node->to_literal();
    my $slice_uuid;
    GeniCertificate->CertificateInfo($slice_cert, \$slice_uuid) == 0
	or return undef;

    if (! ($slice_uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
	print STDERR "Invalid slice_uuid in ticket\n";
	return undef;
    }

    # Dig out the owner uuid. Locally, I am not sure if we bother to
    # keep users in the DB (they are in the DB at geni central).
    ($uuid_node) = $doc->getElementsByTagName("owner_uuid");
    return undef
	if (!defined($uuid_node));
    my $owner_cert = $uuid_node->to_literal();
    my $owner_uuid;
    GeniCertificate->CertificateInfo($owner_cert, \$owner_uuid) == 0
	or return undef;

    if (! ($owner_uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
	print STDERR "Invalid owner_uuid in ticket\n";
	return undef;
    }

    my ($seqno_node) = $doc->getElementsByTagName("serial");
    return undef
	if (!defined($seqno_node));
    my $seqno = $seqno_node->to_literal();

    if (! ($seqno =~ /^\w+$/)) {
	print STDERR "Invalid sequence number in ticket\n";
	return undef;
    }

    my $self = {};
    $self->{'idx'}           = undef;
    $self->{'rspec'}         = $rspec;
    $self->{'slice_uuid'}    = $slice_uuid;
    $self->{'owner_uuid'}    = $owner_uuid;
    $self->{'slice_cert'}    = $slice_cert;
    $self->{'owner_cert'}    = $owner_cert;
    $self->{'ticket_string'} = $ticket_string;
    $self->{'xmlref'}        = $doc;
    $self->{'component'}     = $component;
    $self->{'seqno'}         = $seqno;
    $self->{'stored'}        = 0;
    
    #
    # We save copies of the tickets we hand out; lets find that record
    # in the DB, just to verify.
    #
    if (! $nosig) {
	my $query_result =
	    DBQueryWarn("select * from geni_tickets where idx='$seqno'");
	if (!$query_result || !$query_result->numrows) {
	    print STDERR "Could not find the ticket $seqno in the DB\n";
	    return undef;
	}
	$self->{'idx'}    = $seqno;
	$self->{'stored'} = 1;
    }
    bless($self, $class);

    return $self;
}

#
# Might have to delete this from the DB, as with an error handing out
# a ticket.
#
sub Delete($)
{
    my ($self) = @_;

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

    if ($self->stored()) {
	my $idx = $self->idx();
	
	DBQueryWarn("delete from geni_tickets where idx='$idx'")
	    or return -1;
	
	delete($tickets{"$idx"});
    }
    return 0;
}

#
# Populate the ticket with some stuff, which right now is just the
# number of node we are willing to grant.
#
sub Grant($$)
{
    my ($self, $count) = @_;

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

    $self->{'count'} = $count;
    return 0;
}

#
# Store the given ticket in the DB. We only do this for signed tickets,
# so we have a record of them. We store them on the server and the client
# side.
#
sub Store($)
{
    my ($self) = @_;
    my @insert_data  = ();

    my $idx        = $self->idx();
    my $seqno      = $self->seqno();
    my $slice_uuid = $self->slice_uuid();
    my $owner_uuid = $self->owner_uuid();

    #
    # For a locally created/signed ticket, seqno=idx. For a ticket from
    # another component, we have to generate a locally unique idx for
    # the DB insertion.
    #
    if (!defined($idx)) {
	$idx = TBGetUniqueIndex('next_ticket', 1);
	$self->{'idx'} = $idx;
    }
    # A locally generated ticket will not have a component. Might change that.
    push(@insert_data, "component_uuid='" . $self->component()->uuid() . "'")
	if (defined($self->component()));

    # Now tack on other stuff we need.
    push(@insert_data, "created=now()");
    push(@insert_data, "idx='$idx'");
    push(@insert_data, "seqno='$seqno'");
    push(@insert_data, "slice_uuid='$slice_uuid'");
    push(@insert_data, "owner_uuid='$owner_uuid'");
    
    my $safe_ticket = DBQuoteSpecial($self->ticket_string());
    push(@insert_data, "ticket_string=$safe_ticket");

    # Insert into DB.
    DBQueryWarn("insert into geni_tickets set " . join(",", @insert_data))
	or return -1;

    $tickets{"$idx"}  = $self;
    $self->{'stored'} = 1;
    return 0;
}

#
# Sign the ticket before returning it. We capture the output, which is
# in XML. 
#
sub Sign($)
{
    my ($self) = @_;

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

    my $idx        = $self->seqno();
    my $slice_cert = $self->slice_cert();
    my $owner_cert = $self->owner_cert();
    my $hrn        = "$OURDOMAIN.tickets.$idx";
    my $rspec_xml  = XMLout($self->rspec(), "NoAttr" => 1);
    $rspec_xml =~ s/opt\>/rspec\>/g;

    #
    # Create a template xml file to sign.
    #
    my $template =
	"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>\n".
	"<credential xml:id=\"ref1\">\n".
	" <type>ticket</type>\n".
	" <serial>$idx</serial>\n".
	" <owner_uuid>$owner_cert</owner_uuid>\n".
	" <target_uuid>$slice_cert</target_uuid>\n".
	" <this_uuid>$slice_cert</this_uuid>\n".
	" <hrn>$hrn</hrn>\n".
	" <expires>2008-05-10T09:00:00</expires>\n".
	" <ticket>\n".
	"  <can_delegate>1</can_delegate>\n".
	"  $rspec_xml\n".
	" </ticket>\n".	
        "</credential>\n";

    my ($fh, $filename) = tempfile(UNLINK => 0);
    return -1
	if (!defined($fh));

    print $fh $template;
    close($fh);

    #
    # Fire up the signer and capture the output. This is the signed ticket
    # that is returned. 
    #
    if (! open(SIGNER, "$SIGNCRED -c $CMCERT $filename |")) {
	print STDERR "Could not sign $filename\n";
	return -1;
    }
    my $ticket = "";
    while (<SIGNER>) {
	$ticket .= $_;
    }
    if (!close(SIGNER)) {
	print STDERR "Could not sign $filename\n";
	return -1;
    }
    $self->{'ticket_string'} = $ticket;

    $self->Store() == 0
	or return -1;

    unlink($filename);
    return 0;
}

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

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

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

#
# Look up a list of tickets for a locally instantiated slice. 
# Used by the CM.
#
sub SliceTickets($$$)
{
    my ($class, $slice, $pref) = @_;

    my $slice_uuid = $slice->uuid();
    my @result = ();

    my $query_result =
	DBQueryWarn("select idx from geni_tickets ".
		    "where slice_uuid='$slice_uuid'");
    return -1
	if (!$query_result);

    while (my ($idx) = $query_result->fetchrow_array()) {
	my $ticket = GeniTicket->Lookup($idx);
	return -1
	    if (!defined($ticket));
	push(@result, $ticket);
    }
    @$pref = @result;
    return 0;
}

#
# Release a ticket. Need to release the nodes ...
# Used by the CM.
#
sub Release($)
{
    my ($self) = @_;

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

    my $experiment = Experiment->Lookup($self->slice_uuid());
    my $pid     = $experiment->pid();
    my $eid     = $experiment->eid();
    my @nodeids = ();
    my @nodes   = ();

    foreach my $ref (@{$self->rspec()->{'node'}}) {
	my $resource_uuid = $ref->{'uuid'};
	my $node = Node->Lookup($resource_uuid);
	next
	    if (!defined($node));

	my $reservation = $node->Reservation();
	next
	    if (!defined($reservation));
	
	if ($reservation->SameExperiment($experiment)) {
	    push(@nodeids, $node->node_id());
	    push(@nodes, $node);
	}
    }
    if (@nodeids) {
	system("export NORELOAD=1; $NFREE -x -q $pid $eid @nodeids");
    }
    foreach my $node (@nodes) {
	$node->Refresh();
    }
    $self->Delete();
    return 0;
}

#
# Equality test for two tickets.
#
sub SameTicket($$)
{
    my ($self, $other) = @_;

    # Must be a real reference. 
    return 0
	if (! (ref($self) && ref($other)));

    return $self->idx() == $other->idx();
}

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