GeniCredential.pm.in

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

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

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

use GeniDB;
use GeniCertificate;
use GeniUtil;
use GeniXML;
use GeniHRN;
use emutil qw(TBGetUniqueIndex);
use English;
use XML::Simple;
use XML::LibXML;
use Data::Dumper;
use File::Temp qw(tempfile);
use Date::Parse;
use POSIX qw(strftime);
use Time::Local;
use overload ('""' => 'Stringify');

# Exported variables
use vars qw(@EXPORT_OK $LOCALSA_FLAG $LOCALCM_FLAG $LOCALMA_FLAG);

# 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 $OPENSSL	   = "/usr/bin/openssl";

# Signing flags
$LOCALSA_FLAG	   = 1;
$LOCALCM_FLAG	   = 2;
$LOCALMA_FLAG	   = 3;
@EXPORT_OK	   = qw($LOCALSA_FLAG $LOCALCM_FLAG $LOCALMA_FLAG);

# Capability Flags.

#
# Look for a signed credential in the DB. At present, we store a credential
# by user/object (uuid/uuid), not worrying about different flavors of creds
# with different permissions. This is basically a cache on the client side of
# credentials in use so that they do not need to be regenerated.
#
sub Lookup($$;$)
{
    my ($class, $arg1, $arg2) = @_;
    my $query_result;

    if (!defined($arg2)) {
	if ($arg1 =~ /^(\d*)$/) {
	    $query_result =
		DBQueryWarn("select * from geni_credentials ".
			    "where idx='$arg1'");
	}
	else {
	    return undef;
	}
    }
    elsif (ref($arg1) && ref($arg2)) {
	my $target_uuid  = $arg1->uuid();
	my $owner_uuid   = $arg2->uuid();

	$query_result =
	    DBQueryWarn("select * from geni_credentials ".
			"where owner_uuid='$owner_uuid' and ".
			"      this_uuid='$target_uuid'");
    }
    else {
	return undef;
    }
    return undef
	if (!$query_result || !$query_result->numrows);

    my $row = $query_result->fetchrow_hashref();
    
    my $credential =
	GeniCredential->CreateFromSigned($row->{'credential_string'}, 1);

    return undef
	if (!defined($credential));

    # Mark as coming from the DB.
    $credential->{'idx'}          = $row->{'idx'};
    return $credential;
}
  
#
# Create an unsigned credential object.
#
sub Create($$$)
{
    my ($class, $target, $owner) = @_;

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

    my $self = {};
    $self->{'uuid'}          = undef;
    $self->{'valid_until'}   = $target->expires();
    $self->{'target_uuid'}   = $target->uuid();
    $self->{'owner_uuid'}    = $owner->uuid();
    # Convenience stuff.
    $self->{'target_cert'}   = $target->GetCertificate();
    $self->{'owner_cert'}    = $owner->GetCertificate();
    $self->{'string'}        = undef;
    $self->{'capabilities'}  = undef;
    $self->{'extensions'}    = undef;
    $self->{'idx'}	     = undef;	# Only set when stored to DB.
    bless($self, $class);

    return $self;
}
# accessors
sub field($$)           { return ($_[0]->{$_[1]}); }
sub idx($)		{ return field($_[0], "idx"); }
sub uuid($)		{ return field($_[0], "uuid"); }
sub expires($)		{ return field($_[0], "valid_until"); }
sub target_uuid($)	{ return field($_[0], "target_uuid"); }
sub slice_uuid($)	{ return field($_[0], "target_uuid"); }
sub owner_uuid($)	{ return field($_[0], "owner_uuid"); }
sub asString($)		{ return field($_[0], "string"); }
sub capabilities($)	{ return field($_[0], "capabilities"); }
sub extensions($)	{ return field($_[0], "extensions"); }
sub owner_cert($)	{ return $_[0]->{"owner_cert"}; }
sub target_cert($)	{ return $_[0]->{"target_cert"}; }
sub hrn($)		{ return $_[0]->{"target_cert"}->hrn(); }
sub target_urn($)       { return $_[0]->{"target_cert"}->urn(); }
sub owner_urn($)        { return $_[0]->{"owner_cert"}->urn(); }

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

    return "[GeniCredential: $target_uuid, $owner_uuid]";
}

#
# Add a capability to the array.
#
sub AddCapability($$$)
{
    my ($self, $name, $delegate) = @_;

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

    if (!defined($self->capabilities())) {
	$self->{'capabilities'} = {};
    }
    $self->{'capabilities'}->{$name} = {"can_delegate" => $delegate};
    return 0;
}

#
# Add an extension. Each extension is an xml element.
# If the element is in a different namespace it has to be specified
# during element construction.
# It also accepts key/value pairs. When key/value pair is specified
# It converts them to <key>value</key> xml element and 
# adds under extensions.
sub AddExtension
{
    my $self = shift;
    my $elem = undef;
    return -1
	      if (!ref($self));
    if (@_ == 1) {
        # it means xml element is specified.
        $elem = shift;
    }
    elsif (@_ == 2) {
        # it means key/value pair is specified.
        $elem = XML::LibXML::Element->new($_[0]);
        $elem->appendText($_[1]);
    }
    else {
        return -1;
    }
    
    my $root = $self->extensions();
    $root = XML::LibXML::Element->new("extensions")
    if (!defined($root));
    $root->appendChild($elem);
    $self->{'extensions'} = $root;
    return 0;
}

#
# Convenience function; create a signed credential for the target,
# issued to the provided user.
#
sub CreateSigned($$$;$)
{
    my ($class, $target, $owner, $signer) = @_;

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

    $signer = $target->GetCertificate()
	if (!defined($signer));

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

#
# Create a credential object from a signed credential string.
#
sub CreateFromSigned($$;$)
{
    my ($class, $string, $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));

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

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

    # Dig out the extensions
    # now extensions is an xml element.
    my ($extensions) = GeniXML::FindNodes('//n:extensions', 
                        $root)->get_nodelist;
    
    # UUID of the credential.
    my ($uuid_node) = $doc->getElementsByTagName("uuid");
    return undef
	if (!defined($uuid_node));
    my $this_uuid = $uuid_node->to_literal();

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

    # Expiration
    my ($expires_node) = $doc->getElementsByTagName("expires");
    if (!defined($expires_node)) {
	print STDERR "Credential is missing expires node\n";
	return undef;
    }
    my $expires = $expires_node->to_literal();

    if (! ($expires =~ /^[-\w:.\/]+/)) {
	print STDERR "Invalid expires date in credential\n";
	return undef;
    }
    # Convert to a localtime.
    my $when = timegm(strptime($expires));
    if (!defined($when)) {
	print STDERR "Could not parse expires: '$expires'\n";
	return undef;
    }
    $expires = POSIX::strftime("20%y-%m-%dT%H:%M:%S", localtime($when));

    # Dig out the target certificate.
    my ($cert_node) = $doc->getElementsByTagName("target_gid");
    return undef
	if (!defined($cert_node));
    my $target_certificate =
	GeniCertificate->LoadFromString($cert_node->to_literal());
    return undef
	if (!defined($target_certificate));

    if (!($target_certificate->uuid() =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
	print STDERR "Invalid target_uuid in credential\n";
	return undef;
    }
    if (!($target_certificate->hrn() =~ /^[-\w\.]+$/)) {
	my $hrn = $target_certificate->hrn();
	print STDERR "Invalid hrn $hrn in target of credential\n";
	return undef;
    }
    if (!GeniHRN::IsValid($target_certificate->urn())) {
	print STDERR "Invalid urn in target certificate of credential\n";
	return undef;
    }

    # Dig out the owner certificate.
    ($cert_node) = $doc->getElementsByTagName("owner_gid");
    return undef
	if (!defined($cert_node));

    my $owner_certificate =
	GeniCertificate->LoadFromString($cert_node->to_literal());
    return undef
	if (!defined($owner_certificate));

    if (!($owner_certificate->uuid() =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
	print STDERR "Invalid target_uuid in credential\n";
	return undef;
    }
    if (!($owner_certificate->hrn() =~ /^[-\w\.]+$/)) {
	my $hrn = $owner_certificate->hrn();
	print STDERR "Invalid hrn $hrn in owner of credential\n";
	return undef;
    }
    if (!GeniHRN::IsValid($owner_certificate->urn())) {
	print STDERR "Invalid urn in owner certificate of credential\n";
	return undef;
    }

    my $self = {};
    $self->{'capabilities'}  = undef;
    $self->{'extensions'}    = $extensions;
    $self->{'uuid'}          = $this_uuid;
    $self->{'valid_until'}   = $expires;
    $self->{'target_uuid'}   = $target_certificate->uuid();
    $self->{'target_cert'}   = $target_certificate;
    $self->{'owner_uuid'}    = $owner_certificate->uuid();
    $self->{'owner_cert'}    = $owner_certificate;
    $self->{'string'}        = $string;
    $self->{'idx'}	     = undef;	# Only set when stored to DB.
    bless($self, $class);

    # Dig out the capabilities
    foreach my $cap (GeniXML::FindNodes('.//n:privileges/n:privilege',
					 $root)->get_nodelist()) {
	my $name = GeniXML::FindElement('n:name', $cap);
	my $delegate = GeniXML::FindElement('n:can_delegate', $cap);
	if (defined($name) && defined($delegate)) {
	    $self->AddCapability($name->textContent(),
				 $delegate->textContent());
	}
    }

    return $self;
}

# Returns a NodeList for a given XPath using a given node as
# context. 'n' is defined to be the prefix for the namespace of the
# node.
#sub findnodes_n($$)
#{
#    my ($path, $node) = @_;
#    my $xc = XML::LibXML::XPathContext->new();
#    my $ns = $node->namespaceURI();
#    if (defined($ns)) {
#	$xc->registerNs('ns', $node->namespaceURI());
#    } else {
#	$path =~ s/\bn://g;
#    }
#    return $xc->findnodes($path, $node);
#}

# Returns the first Node which matches a given XPath against a given
# node. Works like findnodes_n.
#sub findfirst_n($$)
#{
#    my ($path, $node) = @_;
#    return findnodes_n($path, $node)->pop();
#}

#
# Might have to delete this from the DB.
#
sub Delete($)
{
    my ($self) = @_;

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

    if (defined($self->idx())) {
	my $idx  = $self->idx();
	my $uuid = $self->uuid();
	
	DBQueryWarn("delete from geni_certificates where uuid='$uuid'")
	    or return -1;
	DBQueryWarn("delete from geni_credentials where idx='$idx'")
	    or return -1;
    }
    return 0;
}

#
# Sign the credential.
#
sub Sign($$)
{
    my ($self, $how) = @_;

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

    # If no capabilities, then allow all rights, with delegation.
    if (!defined($self->capabilities())) {
	$self->AddCapability("*", 1);
    }
    # This little wrapup is for xmlout.
    my $cap_xml = "<privileges>\n";
    foreach my $cap (keys(%{ $self->capabilities() })) {
	my $can_delegate = $self->capabilities()->{$cap}->{'can_delegate'};
	$cap_xml .= "<privilege>";
	$cap_xml .= "<name>$cap</name>";
	$cap_xml .= "<can_delegate>$can_delegate</can_delegate>";
	$cap_xml .= "</privilege>\n";
    }
    $cap_xml .= "</privileges>\n";

    my $extensions = $self->extensions();
    $cap_xml .= GeniXML::Serialize($extensions)
        if (defined($extensions) && $extensions->hasChildNodes());
    # Every one gets a new unique index, which is used in the xml:id below.
    my $idx = TBGetUniqueIndex('next_ticket', 1);

    #
    # Every ticket/credential its own uuid.
    #
    my $cred_uuid = GeniUtil::NewUUID();

    #
    # Need the certificates for target and owner of the credential.
    #
    if (!defined($self->target_cert())) {
	print STDERR "No target certificate attached to $self\n";
	return -1;
    }
    my $target_cert = $self->target_cert()->cert();
    my $target_urn = $self->target_urn();
    if (! defined($target_urn)) {
	$target_urn = $self->target_uuid();
    }

    if (!defined($self->owner_cert())) {
	print STDERR "No owner certificate attached to $self\n";
	return -1;
    }
    my $owner_cert = $self->owner_cert()->cert();
    my $owner_urn = $self->owner_urn();
    if (! defined($owner_urn)) {
	$owner_urn = $self->owner_uuid();
    }

    # Credential expiration: hard-code to 24 hours, if the underlying
    # object does not define an expiration.
    my $expires = $self->expires();
    if (!defined($expires)) {
	$expires = POSIX::strftime("20%y-%m-%dT%H:%M:%S",
				   gmtime(time() + 24 * 60 * 60));
    }
    else {
	$expires = POSIX::strftime("20%y-%m-%dT%H:%M:%S",
				   gmtime(str2time($expires)));
    }

    #
    # 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>privilege</type>\n".
	" <serial>$idx</serial>\n".
	" <owner_gid>$owner_cert</owner_gid>\n".
	" <owner_urn>$owner_urn</owner_urn>\n".
	" <target_gid>$target_cert</target_gid>\n".
	" <target_urn>$target_urn</target_urn>\n".
	" <uuid>$cred_uuid</uuid>\n".
	" <expires>$expires</expires>\n".
	"  $cap_xml\n".
        "</credential>\n";

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

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

    #
    # Who signs the credential? $how is either a flag (CM or SA) or its
    # a certificate object in the DB. 
    #
    my $certificate;
    
    if (ref($how)) {
	# This will auto delete too.
	my $certfile = $how->certfile() || $how->WriteToFile(1);
	if (!defined($certfile)) {
	    print STDERR "Could not write $how to temp file\n";
	    return -1;
	}
	$certificate = "-c $certfile";
    }
    elsif ($how == $LOCALSA_FLAG) {
	$certificate = "-c $TB/etc/genisa.pem";
    }
    elsif ($how == $LOCALCM_FLAG) {
	$certificate = "-c $TB/etc/genicm.pem";
    }
    elsif ($how == $LOCALMA_FLAG) {
	if (defined($main::GENI_CHPEMFILE)) {
	    # See xmlrpc/protogeni-ch.pl.in
	    $certificate = "-c $main::GENI_CHPEMFILE";
	}
	else {
	    $certificate = "-c $TB/etc/genich.pem";
	}
    }
    else {
	print STDERR "Invalid 'how' argument to Sign()\n";
	return -1;
    }

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

#
# Store the given signed credential in the DB. Client side only for now;
# does the CM need to save all the credentials it hands out?
#
sub Store($)
{
    my ($self) = @_;
    my @insert_data  = ();

    # Do not store again.
    return 0
	if (defined($self->idx()));

    # Every credential store gets a new unique index.
    my $idx = TBGetUniqueIndex('next_ticket', 1);
    
    my $this_uuid  = $self->target_uuid();
    my $owner_uuid = $self->owner_uuid();
    my $uuid       = $self->uuid();
    my $expires    = $self->expires();

    # Now tack on other stuff we need.
    push(@insert_data, "created=now()");
    push(@insert_data, "idx='$idx'");
    push(@insert_data, "this_uuid='$this_uuid'");
    push(@insert_data, "owner_uuid='$owner_uuid'");
    push(@insert_data, "uuid='$uuid'");
    
    my $safe_credential = DBQuoteSpecial($self->asString());
    push(@insert_data, "credential_string=$safe_credential");

    if (defined($expires)) {
	my $safe_expires = DBQuoteSpecial($expires);
	push(@insert_data, "valid_until=$safe_expires");
    }

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

    # If sucessfully stored, set the idx field so we know.
    $self->{'idx'} = $idx;

    return 0;
}

sub HasPrivilege($$)
{
    my ( $self, $p ) = @_;

    return 0
	if( !defined( $self->{ 'capabilities' } ) );

    return 1
	if( defined( $self->{ 'capabilities' }->{ "*" } ) );

    return defined( $self->{ 'capabilities' }->{ $p } );
}

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