GeniCredential.pm.in 24.3 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1 2
#!/usr/bin/perl -wT
#
3
# Copyright (c) 2008-2013 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28
# 
# {{{GENIPUBLIC-LICENSE
# 
# GENI Public License
# 
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and/or hardware specification (the "Work") to
# deal in the Work without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Work, and to permit persons to whom the Work
# is furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Work.
# 
# THE WORK IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE WORK OR THE USE OR OTHER DEALINGS
# IN THE WORK.
# 
# }}}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
29 30 31 32 33 34 35 36 37 38 39 40 41 42
#
package GeniCredential;

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

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

use GeniDB;
43
use GeniCertificate;
44
use GeniUtil;
45
use GeniXML;
46
use GeniHRN;
47
use emutil qw(TBGetUniqueIndex);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
48 49 50 51 52
use English;
use XML::Simple;
use XML::LibXML;
use Data::Dumper;
use File::Temp qw(tempfile);
53 54 55
use Date::Parse;
use POSIX qw(strftime);
use Time::Local;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
56
use overload ('""' => 'Stringify');
Leigh B. Stoller's avatar
Leigh B. Stoller committed
57

Leigh B. Stoller's avatar
Leigh B. Stoller committed
58
# Exported variables
59 60
use vars qw(@EXPORT_OK $LOCALSA_FLAG $LOCALCM_FLAG $LOCALMA_FLAG $CHECK_UUID
            $CreateFromSignedError);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
61

Leigh B. Stoller's avatar
Leigh B. Stoller committed
62 63 64 65 66 67 68 69 70 71
# 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";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
72 73 74 75 76
my $OPENSSL	   = "/usr/bin/openssl";

# Signing flags
$LOCALSA_FLAG	   = 1;
$LOCALCM_FLAG	   = 2;
77
$LOCALMA_FLAG	   = 3;
78 79
$CHECK_UUID        = 1;  # Default to true, enabling uuid checks
@EXPORT_OK	   = qw($LOCALSA_FLAG $LOCALCM_FLAG $LOCALMA_FLAG $CHECK_UUID);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
80

Leigh B. Stoller's avatar
Leigh B. Stoller committed
81 82
# Capability Flags.

Leigh B. Stoller's avatar
Leigh B. Stoller committed
83 84 85 86 87 88
#
# 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.
#
89
sub Lookup($$;$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
90
{
91 92
    my ($class, $arg1, $arg2) = @_;
    my $query_result;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
93

94 95 96 97 98 99 100 101 102 103
    if (!defined($arg2)) {
	if ($arg1 =~ /^(\d*)$/) {
	    $query_result =
		DBQueryWarn("select * from geni_credentials ".
			    "where idx='$arg1'");
	}
	else {
	    return undef;
	}
    }
104 105 106
    elsif (defined($arg1)) {
	my $target_uuid = (ref($arg1) ? $arg1->uuid() : $arg1);
	my $owner_uuid  = (ref($arg2) ? $arg2->uuid() : $arg2);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
107

108 109 110 111
	return undef
	    if (! ($target_uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/ &&
		   $owner_uuid  =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/));
	
112 113 114 115 116 117 118 119
	$query_result =
	    DBQueryWarn("select * from geni_credentials ".
			"where owner_uuid='$owner_uuid' and ".
			"      this_uuid='$target_uuid'");
    }
    else {
	return undef;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
120
    return undef
121 122
	if (!$query_result || !$query_result->numrows);

Leigh B. Stoller's avatar
Leigh B. Stoller committed
123 124 125 126
    my $row = $query_result->fetchrow_hashref();
    
    my $credential =
	GeniCredential->CreateFromSigned($row->{'credential_string'}, 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
127 128 129 130

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
131
    # Mark as coming from the DB.
132
    $credential->{'idx'}          = $row->{'idx'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
133 134
    return $credential;
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
135
  
Leigh B. Stoller's avatar
Leigh B. Stoller committed
136
#
137
# Create an unsigned credential object.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
138
#
139
sub Create($$$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
140
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
141
    my ($class, $target, $owner) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
142 143

    return undef
Leigh B. Stoller's avatar
Leigh B. Stoller committed
144
	if (! (ref($target) && ref($owner)));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
145

146 147 148 149 150
    #
    # Every ticket/credential its own uuid.
    #
    my $uuid = GeniUtil::NewUUID();

Leigh B. Stoller's avatar
Leigh B. Stoller committed
151
    my $self = {};
152
    $self->{'uuid'}          = $uuid;
153
    $self->{'valid_until'}   = $target->expires();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
154
    $self->{'target_uuid'}   = $target->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
155
    $self->{'owner_uuid'}    = $owner->uuid();
156 157 158
    # Convenience stuff.
    $self->{'target_cert'}   = $target->GetCertificate();
    $self->{'owner_cert'}    = $owner->GetCertificate();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
159 160
    $self->{'string'}        = undef;
    $self->{'capabilities'}  = undef;
161
    $self->{'extensions'}    = undef;
162
    $self->{'parent_cred'}   = undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
163
    $self->{'idx'}	     = undef;	# Only set when stored to DB.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
164 165 166 167 168 169
    bless($self, $class);

    return $self;
}
# accessors
sub field($$)           { return ($_[0]->{$_[1]}); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
170
sub idx($)		{ return field($_[0], "idx"); }
171
sub uuid($)		{ return field($_[0], "uuid"); }
172
sub expires($)		{ return field($_[0], "valid_until"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
173
sub target_uuid($)	{ return field($_[0], "target_uuid"); }
174
sub slice_uuid($)	{ return field($_[0], "target_uuid"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
175 176 177
sub owner_uuid($)	{ return field($_[0], "owner_uuid"); }
sub asString($)		{ return field($_[0], "string"); }
sub capabilities($)	{ return field($_[0], "capabilities"); }
178 179 180 181
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(); }
182 183
sub target_urn($)       { return $_[0]->{"target_cert"}->urn(); }
sub owner_urn($)        { return $_[0]->{"owner_cert"}->urn(); }
184
sub signer_certs($)     { return $_[0]->{"signer_certs"}; }
185
sub parent_cred($)      { return $_[0]->{"parent_cred"}; }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
186

Leigh B. Stoller's avatar
Leigh B. Stoller committed
187 188 189 190 191 192 193 194 195 196 197 198 199
#
# 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]";
}

200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218
#
# Is expired? 
#
sub IsExpired($)
{
    my ($self) = @_;

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

    my $expires = $self->expires();
    return 0
	if (!defined($expires));
    
    $expires = str2time($expires);

    return (time() >= $expires);
}

219 220 221 222 223 224 225 226 227 228 229 230 231 232
#
# Set the expiration time for a credential. Only changes the
# in memory copy, not the DB.
#
sub SetExpiration($$)
{
    my ($self, $expires) = @_;

    $self->{'valid_until'} =
	POSIX::strftime("20%y-%m-%dT%H:%M:%S", localtime($expires));

    return 0;
}

233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258
#
# Compare the certs inside a credential to make sure that the
# certs for the target/owner have not changed. Say, if the user
# regens their certificate, we need to invalidate any cached
# credentials based on that cert.
#
sub SameCerts($$$)
{
    my ($self, $target, $owner) = @_;

    return -1
	if (! (ref($target) && ref($owner)));

    my $current_target_cert = $self->target_cert();
    my $current_owner_cert  = $self->owner_cert();
    my $other_target_cert   = $target->GetCertificate();
    my $other_owner_cert    = $owner->GetCertificate();

    return 0
	if (!$current_owner_cert->SameCert($other_owner_cert));
    return 0
	if (!$current_target_cert->SameCert($other_target_cert));
    
    return 1;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275
#
# 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;
}

276
#
277 278 279
# 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.
280 281 282 283
# 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
284
{
285 286
    my $self = shift;
    my $elem = undef;
287
    return -1
288 289 290 291 292 293 294 295 296 297 298 299
	      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;
300 301
    }
    
302
    my $root = $self->extensions();
303 304
    $root = XML::LibXML::Element->new("extensions")
    if (!defined($root));
305
    $root->appendChild($elem);
306
    $self->{'extensions'} = $root;
307 308 309
    return 0;
}

310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336
#
# 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;
}

337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365
#
# Create a self signed credential.
#
sub GetSelfCredential($$)
{
    my ($class, $me) = @_;

    #
    # Oh, this is kinda bogus, but need to know who we are
    # so we can sign it properly. 
    #
    my $which  = $me->type();
    my $signer;
    if ($which eq "sa") {
	$signer = $LOCALSA_FLAG;
    }
    elsif ($which eq "cm") {
	$signer = $LOCALCM_FLAG;
    }
    elsif ($which eq "ch" || $which eq "ma") {
	$signer = $LOCALMA_FLAG;
    }
    else {
	print STDERR "Could not determine who we are\n";
	return undef;
    }
    return GeniCredential->CreateSigned($me, $me, $signer);
}

366 367 368 369 370 371 372 373 374 375
# Find an element (which must exist exactly once) within a node.
my $find = sub
{
    my( $node, $name ) = @_;

    my @cnodes = grep( $_->nodeName eq $name, $node->childNodes );

    return undef unless scalar( @cnodes ) == 1;

    return $cnodes[ 0 ];
376
};
377

Leigh B. Stoller's avatar
Leigh B. Stoller committed
378 379 380
#
# Create a credential object from a signed credential string.
#
381 382 383 384 385 386 387
# We keep the error in a global variable for the caller if wanted.
# Certainly not ideal but I do not want to complicate things by
# using eval/die to mimic try/finally. We are not thread safe and
# never will be, so lets not get crazy.
#
$CreateFromSignedError = undef;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
388
sub CreateFromSigned($$;$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
389
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
390
    my ($class, $string, $nosig) = @_;
391
    my $msg = undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
392 393 394 395 396 397 398 399

    #
    # 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));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
400 401

    # First verify the credential
Leigh B. Stoller's avatar
Leigh B. Stoller committed
402 403
    if (! $nosig) {
	my ($fh, $filename) = tempfile(UNLINK => 0);
404 405 406 407
	if (!defined($fh)) {
	    $msg = "Error creating temporary file";
	    goto bad;
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
408 409
	print $fh $string;
	close($fh);
410
	my $output = GeniUtil::ExecQuiet("$VERIFYCRED $filename");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
411
	if ($?) {
412
	    unlink($filename);
413 414
	    $msg = $output;
	    goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
415 416
	}
	unlink($filename);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
417 418
    }

419
    # Use XML::LibXML to convert to something we can mess with.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
420
    my $parser = XML::LibXML->new;
421 422 423 424 425
    my $doc;
    eval {
	$doc = $parser->parse_string($string);
    };
    if ($@) {
426 427
	$msg = "Failed to parse credential string: $@";
	goto bad;
428
    }
429
    my $root = $doc->documentElement();
430
    my $credential_el = &$find( $root, "credential" );
431
    goto bad unless defined( $credential_el );
Leigh B. Stoller's avatar
Leigh B. Stoller committed
432

433 434 435 436 437 438
    # Dig out the entire credential structure to save it.
    my ($credential) = $doc->getElementsByTagName("credential");

    # Ditto the signatures.
    my @signatures = $doc->getElementsByTagName("signatures");

439
    # Dig out the extensions
440 441 442
    # now extensions is an xml element.
    my ($extensions) = GeniXML::FindNodes('//n:extensions', 
                        $root)->get_nodelist;
443
    
444
    # UUID of the credential.
445
    my $uuid_node = &$find( $credential_el, "uuid" );
446
    goto bad
Leigh B. Stoller's avatar
Leigh B. Stoller committed
447
	if (!defined($uuid_node));
448
    my $this_uuid = $uuid_node->to_literal();
449 450
    $this_uuid = undef
	if (defined($this_uuid) && $this_uuid eq "");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
451

452 453 454 455 456 457
    #
    # No longer require this uuid; only PG credentials have it.
    # If we try to store it, throw an error. See below.
    #
    if (defined($this_uuid) &&
	! ($this_uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
458 459
	$msg = "Invalid this_uuid in credential";
        goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
460 461
    }

462
    # Expiration
463
    my $expires_node = &$find( $credential_el, "expires" );
464
    if (!defined($expires_node)) {
465 466
	$msg = "Credential is missing expires node";
	goto bad;
467 468 469 470
    }
    my $expires = $expires_node->to_literal();

    if (! ($expires =~ /^[-\w:.\/]+/)) {
471 472
	$msg = "Invalid expires date in credential";
	goto bad;
473 474 475 476
    }
    # Convert to a localtime.
    my $when = timegm(strptime($expires));
    if (!defined($when)) {
477 478
	$msg = "Could not parse expires: '$expires'";
	goto bad;
479 480 481
    }
    $expires = POSIX::strftime("20%y-%m-%dT%H:%M:%S", localtime($when));

482
    # Dig out the target certificate.
483
    my $cert_node = &$find( $credential_el, "target_gid" );
484
    goto bad
485 486 487
	if (!defined($cert_node));
    my $target_certificate =
	GeniCertificate->LoadFromString($cert_node->to_literal());
488
    goto bad
489
	if (!defined($target_certificate));
490

491 492
    if (!($target_certificate->uuid() =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)
        && $CHECK_UUID) {
493 494
        $msg = "Invalid target_uuid in credential";
        goto bad;
495
    }
496
    if (!($target_certificate->hrn() =~ /^[-\w\.]+$/)) {
497
	my $hrn = $target_certificate->hrn();
498 499
	$msg = "Invalid hrn $hrn in target of credential";
	goto bad;
500
    }
501
    if (!GeniHRN::IsValid($target_certificate->urn())) {
502 503
	$msg = "Invalid urn in target certificate of credential";
	goto bad;
504
    }
505

506
    # Dig out the owner certificate.
507
    $cert_node = &$find( $credential_el, "owner_gid" );
508
    goto bad
509
	if (!defined($cert_node));
510

511 512
    my $owner_certificate =
	GeniCertificate->LoadFromString($cert_node->to_literal());
513
    goto bad
514
	if (!defined($owner_certificate));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
515

516 517
    if (!($owner_certificate->uuid() =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)
        && $CHECK_UUID) {
518 519
        $msg = "Invalid target_uuid in credential";
        goto bad;
520
    }
521
    if (!($owner_certificate->hrn() =~ /^[-\w\.]+$/)) {
522
	my $hrn = $owner_certificate->hrn();
523 524
	$msg = "Invalid hrn $hrn in owner of credential";
	goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
525
    }
526
    if (!GeniHRN::IsValid($owner_certificate->urn())) {
527 528
	$msg = "Invalid urn in owner certificate of credential";
	goto bad;
529
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
530

531 532 533 534 535 536 537 538
    # extract the signer certs
    my $cert_nodes = $doc->getElementsByTagName("X509Certificate");
    my $signer_certs = [];
    foreach my $node (@$cert_nodes) {
        my $signer_cert = $node->to_literal();
        push(@$signer_certs, $signer_cert);
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
539
    my $self = {};
540
    $self->{'capabilities'}  = undef;
541
    $self->{'extensions'}    = $extensions;
542
    $self->{'uuid'}          = $this_uuid;
543
    $self->{'valid_until'}   = $expires;
544 545 546 547
    $self->{'target_uuid'}   = $target_certificate->uuid();
    $self->{'target_cert'}   = $target_certificate;
    $self->{'owner_uuid'}    = $owner_certificate->uuid();
    $self->{'owner_cert'}    = $owner_certificate;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
548
    $self->{'string'}        = $string;
549 550 551
    $self->{'parent_cred'}   = undef;
    $self->{'credentialdoc'} = $credential;
    $self->{'signatures'}    = \@signatures;
552
    $self->{'signer_certs'}  = $signer_certs;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
553
    $self->{'idx'}	     = undef;	# Only set when stored to DB.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
554 555
    bless($self, $class);

556
    # Dig out the capabilities
557
    foreach my $cap (GeniXML::FindNodes('n:credential/' .
558 559
					'n:privileges/n:privilege',
					$root)->get_nodelist()) {
560 561
	my $name = GeniXML::FindElement('n:name', $cap);
	my $delegate = GeniXML::FindElement('n:can_delegate', $cap);
562 563 564 565 566
	if (defined($name) && defined($delegate)) {
	    $self->AddCapability($name->textContent(),
				 $delegate->textContent());
	}
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
567
    return $self;
568 569 570 571 572 573 574 575

  bad:
    if (!defined($msg)) {
	$msg = "Internal error creating credential object";
    }
    print STDERR "$msg\n";
    $CreateFromSignedError = $msg;
    return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
576 577
}

578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601
# 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();
#}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
602 603 604 605 606 607 608 609 610 611
#
# Might have to delete this from the DB.
#
sub Delete($)
{
    my ($self) = @_;

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
612
    if (defined($self->idx())) {
613 614
	my $idx  = $self->idx();
	my $uuid = $self->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
615
	
616 617
	DBQueryWarn("delete from geni_certificates where uuid='$uuid'")
	    or return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
618 619 620
	DBQueryWarn("delete from geni_credentials where idx='$idx'")
	    or return -1;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
621 622 623
    return 0;
}

624 625 626 627 628 629 630 631 632 633 634 635 636 637
#
# Delete stored credentials for a particular target.
#
sub DeleteForTarget($$)
{
    my ($class, $target) = @_;
    my $target_uuid = $target->uuid();

    DBQueryWarn("delete from geni_credentials where this_uuid='$target_uuid'")
	or return -1;

    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
638 639 640
#
# Sign the credential.
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
641
sub Sign($$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
642
{
643
    my ($self, $how) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
644 645 646 647

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

648
    # If no capabilities, then allow all rights, with delegation.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
649
    if (!defined($self->capabilities())) {
650
	$self->AddCapability("*", 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
651 652
    }
    # This little wrapup is for xmlout.
653 654 655 656 657 658 659 660
    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";
    }
661
    $cap_xml .= "</privileges>";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
662

663 664 665
    my $extensions = $self->extensions();
    $cap_xml .= GeniXML::Serialize($extensions)
        if (defined($extensions) && $extensions->hasChildNodes());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
666 667
    # Every one gets a new unique index, which is used in the xml:id below.
    my $idx = TBGetUniqueIndex('next_ticket', 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
668 669 670 671

    #
    # Need the certificates for target and owner of the credential.
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
672 673
    if (!defined($self->target_cert())) {
	print STDERR "No target certificate attached to $self\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
674 675
	return -1;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
676
    my $target_cert = $self->target_cert()->cert();
677
    my $target_urn = $self->target_urn();
678 679 680
    if (! defined($target_urn)) {
	$target_urn = $self->target_uuid();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
681

Leigh B. Stoller's avatar
Leigh B. Stoller committed
682 683
    if (!defined($self->owner_cert())) {
	print STDERR "No owner certificate attached to $self\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
684 685
	return -1;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
686
    my $owner_cert = $self->owner_cert()->cert();
687
    my $owner_urn = $self->owner_urn();
688 689 690
    if (! defined($owner_urn)) {
	$owner_urn = $self->owner_uuid();
    }
691
    my $cred_uuid = $self->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
692

693 694 695 696
    # Credential expiration: hard-code to 24 hours, if the underlying
    # object does not define an expiration.
    my $expires = $self->expires();
    if (!defined($expires)) {
697
	$expires = POSIX::strftime("20%y-%m-%dT%H:%M:%SZ",
698 699 700
				   gmtime(time() + 24 * 60 * 60));
    }
    else {
701
	$expires = POSIX::strftime("20%y-%m-%dT%H:%M:%SZ",
702 703
				   gmtime(str2time($expires)));
    }
704
    $self->{'valid_until'} = $expires;
705

Leigh B. Stoller's avatar
Leigh B. Stoller committed
706 707 708
    #
    # Create a template xml file to sign.
    #
709 710 711
    my $id = sprintf( "%04X%04X%04X%04X", int( rand( 0x10000 ) ), 
		      int( rand( 0x10000 ) ), int( rand( 0x10000 ) ),
		      int( rand( 0x10000 ) ) );
712 713 714 715 716 717 718 719 720

    # If this is a delegation, need to construct a different XML file.
    my $parent_xml = "";
    if (defined($self->{'parent_cred'})) {
	$parent_xml = "<parent>" . 
	    $self->{'parent_cred'}->{'credentialdoc'}->toString() . 
	    "</parent>";
    }
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
721
    my $template =
722
	"<credential xml:id=\"ref$id\">\n".
723
	" <type>privilege</type>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
724
	" <serial>$idx</serial>\n".
725
	" <owner_gid>$owner_cert</owner_gid>\n".
726
	" <owner_urn>$owner_urn</owner_urn>\n".
727
	" <target_gid>$target_cert</target_gid>\n".
728
	" <target_urn>$target_urn</target_urn>\n".
729
	" <uuid>$cred_uuid</uuid>\n".
730
	" <expires>$expires</expires>\n".
731
	"  $cap_xml". $parent_xml .
Leigh B. Stoller's avatar
Leigh B. Stoller committed
732
        "</credential>\n";
733 734 735 736 737 738 739
    if (defined($self->{'parent_cred'})) {
	$template = "<signed-credential>\n$template\n";
	foreach my $sig (@{ $self->{'parent_cred'}->{'signatures'}}) {
	    $template .= $sig->toString();
	}
	$template .= "</signed-credential>\n";
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
740 741 742 743
    my ($fh, $filename) = tempfile(UNLINK => 0);
    return -1
	if (!defined($fh));

744
    print $fh "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
745 746 747
    print $fh $template;
    close($fh);

748 749 750 751
    #
    # Who signs the credential? $how is either a flag (CM or SA) or its
    # a certificate object in the DB. 
    #
752
    my $certificate;
Leigh B Stoller's avatar
Leigh B Stoller committed
753
    my $certfile;
754 755
    
    if (ref($how)) {
756
	# This will auto delete too.
Leigh B Stoller's avatar
Leigh B Stoller committed
757
	$certfile = $how->certfile() || $how->WriteToFile(1);
758
	if (!defined($certfile)) {
759
	    print STDERR "Could not write $how to temp file\n";
760 761 762 763 764 765 766 767 768 769
	    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";
    }
770
    elsif ($how == $LOCALMA_FLAG) {
771 772 773 774 775 776 777
	if (defined($main::GENI_CHPEMFILE)) {
	    # See xmlrpc/protogeni-ch.pl.in
	    $certificate = "-c $main::GENI_CHPEMFILE";
	}
	else {
	    $certificate = "-c $TB/etc/genich.pem";
	}
778
    }
779 780 781 782 783
    else {
	print STDERR "Invalid 'how' argument to Sign()\n";
	return -1;
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
784 785 786 787
    #
    # Fire up the signer and capture the output. This is the signed credential
    # that is returned. 
    #
788
    if (! open(SIGNER, "$SIGNCRED $certificate $filename |")) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
789 790 791 792 793 794 795 796 797 798 799 800 801
	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);
Leigh B Stoller's avatar
Leigh B Stoller committed
802 803
    unlink($certfile)
	if (defined($certfile) && -e $certfile);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
804 805 806
    return 0;
}

807 808 809 810 811 812 813 814 815 816 817 818
#
# Delegate to another owner. This creates a new credential.
#
sub Delegate($$)
{
    my ($self, $owner) = @_;

    my $credential = GeniCredential->Create($self->target_cert(), $owner);
    if (!defined($credential)) {
	print STDERR "Could not delegate $self to $owner\n";
	return undef;
    }
819 820 821 822
    #
    # The new credential has no privs; the caller has to fill
    # them for this credential to be useful.
    #
823 824 825 826 827
    $credential->{'parent_cred'} = $self;
    $credential->{'valid_until'} = $self->{'valid_until'};
    return $credential;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
828
#
829
# Store the given signed credential in the DB. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
830 831 832 833 834 835 836 837 838 839
#
sub Store($)
{
    my ($self) = @_;
    my @insert_data  = ();

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

840
    if (defined($self->{'parent_cred'})) {
Leigh B Stoller's avatar
Leigh B Stoller committed
841
	print STDERR "Not allowed to store delegated credential: $self\n";
842 843
	return -1;
    }
844 845 846 847 848 849
    # Foreign credentials will not have this, and we should never
    # store them, so throw an error.
    if (!defined($self->uuid())) {
	print STDERR "Not allowed to store foreign credential: $self\n";
	return -1;
    }
850

Leigh B. Stoller's avatar
Leigh B. Stoller committed
851 852 853
    # Every credential store gets a new unique index.
    my $idx = TBGetUniqueIndex('next_ticket', 1);
    
854
    my $this_uuid  = $self->target_uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
855
    my $owner_uuid = $self->owner_uuid();
856
    my $uuid       = $self->uuid();
857
    my $expires    = $self->expires();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
858 859 860 861 862 863

    # 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'");
864
    push(@insert_data, "uuid='$uuid'");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
865 866 867 868
    
    my $safe_credential = DBQuoteSpecial($self->asString());
    push(@insert_data, "credential_string=$safe_credential");

869 870
    if (defined($expires)) {
	my $safe_expires = DBQuoteSpecial($expires);
871
	push(@insert_data, "valid_until=$safe_expires");
872 873
    }

874 875 876 877 878 879 880 881 882 883 884 885 886 887
    DBQueryWarn("lock tables geni_credentials write")
	or return undef;
    my $query_result =
	DBQueryWarn("select uuid from geni_credentials ".
		    "where this_uuid='$this_uuid' and ".
		    "      owner_uuid='$owner_uuid'");
    goto bad
	if (!$query_result);
    if ($query_result->numrows) {
	my ($ouuid) = $query_result->fetchrow_array();
	print STDERR "*** Duplicate uuid in geni_credentials table\n";
	print STDERR "*** $uuid,$this_uuid,$owner_uuid : $ouuid\n";
	goto bad;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
888 889
    # Insert into DB.
    DBQueryWarn("insert into geni_credentials set " . join(",", @insert_data))
890 891
	or goto bad;
    DBQueryWarn("unlock tables");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
892 893 894 895

    # If sucessfully stored, set the idx field so we know.
    $self->{'idx'} = $idx;
    return 0;
896 897 898
  bad:
    DBQueryWarn("unlock tables");
    return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
899 900
}

901 902 903 904 905 906 907 908 909 910 911 912 913
sub HasPrivilege($$)
{
    my ( $self, $p ) = @_;

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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
914 915
# _Always_ make sure that this 1 is at the end of the file...
1;