GeniTicket.pm.in 13.7 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
#!/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;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
22
use GeniCredential;
23
use GeniCertificate;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
24 25
use Experiment;
use libdb qw(TBGetUniqueIndex);
26
use libtestbed qw(NewUUID);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
27
use English;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
28 29
use XML::Simple;
use XML::LibXML;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
30 31
use Data::Dumper;
use File::Temp qw(tempfile);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
32
use overload ('""' => 'Stringify');
Leigh B. Stoller's avatar
Leigh B. Stoller committed
33 34 35 36 37 38 39 40 41

# 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";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
42
my $VERIFYCRED	   = "$TB/sbin/verifygenicred";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
43
my $NFREE	   = "$TB/bin/nfree";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
44
my $CMCERT	   = "$TB/etc/genicm.pem";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
45

Leigh B. Stoller's avatar
Leigh B. Stoller committed
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
# 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;
71 72
    if ($row->{'component_uuid'}) {
	$component = GeniComponent->Lookup($row->{'component_uuid'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
73 74 75 76 77 78 79 80
	return undef
	    if (!defined($component));
    }
    my $ticket = GeniTicket->CreateFromSignedTicket($row->{'ticket_string'},
						    $component, 1);
    return undef
	if (!defined($ticket));

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

    # Cache.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
86 87 88 89
    $tickets{"$idx"} = $ticket;
    return $ticket;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
90
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
91
# Create an unsigned ticket object, to be populated and signed and returned.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
92
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
93
sub Create($$$$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
94
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
95
    my ($class, $slice, $owner, $rspec) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
96

Leigh B. Stoller's avatar
Leigh B. Stoller committed
97 98 99
    # Every Ticket gets a new unique index (sequence number).
    my $seqno = TBGetUniqueIndex('next_ticket', 1);
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
100
    my $self = {};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
101
    $self->{'rspec'}         = $rspec;
102
    $self->{'ticket_uuid'}   = undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
103 104
    $self->{'slice_uuid'}    = $slice->uuid();
    $self->{'owner_uuid'}    = $owner->uuid();
105 106
    $self->{'slice_cert'}    = $slice->GetCertificate();
    $self->{'owner_cert'}    = $owner->GetCertificate();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
107
    $self->{'seqno'}         = $seqno;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
108 109
    $self->{'ticket_string'} = undef;
    $self->{'component'}     = undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
110 111 112 113 114 115 116 117 118 119
    $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;
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
120 121 122 123 124 125
    bless($self, $class);

    return $self;
}
# accessors
sub field($$)           { return ($_[0]->{$_[1]}); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
126
sub idx($)		{ return field($_[0], "idx"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
127
sub seqno($)		{ return field($_[0], "seqno"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
128
sub rspec($)		{ return field($_[0], "rspec"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
129
sub slice_uuid($)	{ return field($_[0], "slice_uuid"); }
130
sub target_uuid($)	{ return field($_[0], "slice_uuid"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
131
sub owner_uuid($)	{ return field($_[0], "owner_uuid"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
132 133
sub slice_cert($)	{ return field($_[0], "slice_cert"); }
sub owner_cert($)	{ return field($_[0], "owner_cert"); }
134
sub uuid($)		{ return field($_[0], "ticket_uuid"); }
135
sub ticket_uuid($)	{ return field($_[0], "ticket_uuid"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
136
sub ticket($)		{ return field($_[0], "ticket"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
137
sub asString($)		{ return field($_[0], "ticket_string"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
138
sub ticket_string($)	{ return field($_[0], "ticket_string"); }
139
sub component_uuid($)	{ return field($_[0], "component_uuid"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
140
sub component($)	{ return field($_[0], "component"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
141 142 143 144 145 146 147 148 149 150 151 152 153 154
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";
    }
155 156 157
    my $slice_uuid = $self->slice_uuid();
    
    return "[GeniTicket: $idx, slice:$slice_uuid]";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
158
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
159 160 161 162

#
# Create a ticket object from a signed ticket string.
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
163
sub CreateFromSignedTicket($$;$$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
164
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
165
    my ($class, $ticket_string, $component, $nosig) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
166

Leigh B. Stoller's avatar
Leigh B. Stoller committed
167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186
    #
    # 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);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
187 188
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
189 190
    # Use XML::Simple to convert to something we can mess with.
    my $parser = XML::LibXML->new;
191 192 193 194 195 196 197 198
    my $doc;
    eval {
	$doc = $parser->parse_string($ticket_string);
    };
    if ($@) {
	print STDERR "Failed to parse ticket string: $@\n";
	return undef;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
199 200 201 202 203

    # Dig out the rspec.
    my ($rspec_node) = $doc->getElementsByTagName("rspec");
    return undef
	if (!defined($rspec_node));
204 205
    my $rspec = XMLin($rspec_node->toString(), ForceArray => ["node",
							      "link"]);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
206

207 208 209 210
    # Dig out the ticket uuid.
    my ($uuid_node) = $doc->getElementsByTagName("uuid");
    return undef
	if (!defined($uuid_node));
211
    my $ticket_uuid = $uuid_node->to_literal();
212 213 214 215 216 217

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

218 219
    # Dig out the target certificate.
    my ($cert_node) = $doc->getElementsByTagName("target_gid");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
220
    return undef
221 222 223 224 225
	if (!defined($cert_node));
    my $target_certificate =
	GeniCertificate->LoadFromString($cert_node->to_literal());
    return undef
	if (!defined($target_certificate));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
226

227 228 229 230 231 232
    if (!($target_certificate->uuid() =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
	print STDERR "Invalid target_uuid in credential\n";
	return undef;
    }
    if (!($target_certificate->hrn() =~ /^[\w\.]+$/)) {
	print STDERR "Invalid hrn in credential\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
233 234 235
	return undef;
    }

236 237
    # Dig out the owner certificate.
    ($cert_node) = $doc->getElementsByTagName("owner_gid");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
238
    return undef
239 240 241 242 243 244
	if (!defined($cert_node));

    my $owner_certificate =
	GeniCertificate->LoadFromString($cert_node->to_literal());
    return undef
	if (!defined($owner_certificate));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
245

246 247 248 249 250 251
    if (!($owner_certificate->uuid() =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
	print STDERR "Invalid target_uuid in credential\n";
	return undef;
    }
    if (!($owner_certificate->hrn() =~ /^[\w\.]+$/)) {
	print STDERR "Invalid hrn in credential\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
252 253 254
	return undef;
    }

255
    # Sequence number
Leigh B. Stoller's avatar
Leigh B. Stoller committed
256 257 258 259
    my ($seqno_node) = $doc->getElementsByTagName("serial");
    return undef
	if (!defined($seqno_node));
    my $seqno = $seqno_node->to_literal();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
260

Leigh B. Stoller's avatar
Leigh B. Stoller committed
261 262 263
    if (! ($seqno =~ /^\w+$/)) {
	print STDERR "Invalid sequence number in ticket\n";
	return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
264 265
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
266
    my $self = {};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
267
    $self->{'idx'}           = undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
268
    $self->{'rspec'}         = $rspec;
269
    $self->{'ticket_uuid'}   = $ticket_uuid;
270 271 272 273
    $self->{'slice_uuid'}    = $target_certificate->uuid();
    $self->{'owner_uuid'}    = $owner_certificate->uuid();
    $self->{'slice_cert'}    = $target_certificate;
    $self->{'owner_cert'}    = $owner_certificate;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
274 275
    $self->{'ticket_string'} = $ticket_string;
    $self->{'xmlref'}        = $doc;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
276
    $self->{'component'}     = $component;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293
    $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;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
294 295 296 297
    bless($self, $class);

    return $self;
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
298

Leigh B. Stoller's avatar
Leigh B. Stoller committed
299
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
300 301
# Might have to delete this from the DB, as with an error handing out
# a ticket.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
302 303 304 305 306 307 308 309
#
sub Delete($)
{
    my ($self) = @_;

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
310
    if ($self->stored()) {
311 312
	my $idx  = $self->idx();
	my $uuid = $self->ticket_uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
313 314 315
	
	DBQueryWarn("delete from geni_tickets where idx='$idx'")
	    or return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
316 317
	
	delete($tickets{"$idx"});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
318 319 320 321
    }
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
322 323 324 325 326 327 328 329
#
# 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) = @_;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
330
    return -1
Leigh B. Stoller's avatar
Leigh B. Stoller committed
331 332 333 334 335 336
	if (! ref($self));

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
337
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
338 339 340
# 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.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
341
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
342
sub Store($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
343
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
344
    my ($self) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
345 346
    my @insert_data  = ();

Leigh B. Stoller's avatar
Leigh B. Stoller committed
347 348
    my $idx        = $self->idx();
    my $seqno      = $self->seqno();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
349 350
    my $slice_uuid = $self->slice_uuid();
    my $owner_uuid = $self->owner_uuid();
351
    my $ticket_uuid= $self->ticket_uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
352

Leigh B. Stoller's avatar
Leigh B. Stoller committed
353 354 355 356 357
    #
    # 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.
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
358 359 360 361
    if (!defined($idx)) {
	$idx = TBGetUniqueIndex('next_ticket', 1);
	$self->{'idx'} = $idx;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
362
    # A locally generated ticket will not have a component. Might change that.
363
    push(@insert_data, "component_uuid='" . $self->component()->uuid() . "'")
Leigh B. Stoller's avatar
Leigh B. Stoller committed
364 365
	if (defined($self->component()));

Leigh B. Stoller's avatar
Leigh B. Stoller committed
366 367 368
    # Now tack on other stuff we need.
    push(@insert_data, "created=now()");
    push(@insert_data, "idx='$idx'");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
369
    push(@insert_data, "seqno='$seqno'");
370
    push(@insert_data, "ticket_uuid='$ticket_uuid'");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
371 372 373 374 375 376 377 378 379 380
    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;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
381 382
    $tickets{"$idx"}  = $self;
    $self->{'stored'} = 1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
383 384 385
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
386 387
#
# Sign the ticket before returning it. We capture the output, which is
Leigh B. Stoller's avatar
Leigh B. Stoller committed
388
# in XML. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
389 390 391 392 393 394 395
#
sub Sign($)
{
    my ($self) = @_;

    return -1
	if (!ref($self));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
396

Leigh B. Stoller's avatar
Leigh B. Stoller committed
397
    my $idx        = $self->seqno();
398 399
    my $slice_cert = $self->slice_cert()->cert();
    my $owner_cert = $self->owner_cert()->cert();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
400 401
    my $rspec_xml  = XMLout($self->rspec(), "NoAttr" => 1);
    $rspec_xml =~ s/opt\>/rspec\>/g;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
402

403
    #
404
    # Every ticket/credential gets its own uuid.
405
    #
406 407
    my $ticket_uuid = NewUUID();
    $self->{'ticket_uuid'} = $ticket_uuid;
408

Leigh B. Stoller's avatar
Leigh B. Stoller committed
409 410 411 412 413
    #
    # Create a template xml file to sign.
    #
    my $template =
	"<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
414
	"<credential xml:id=\"ref1\">\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
415
	" <type>ticket</type>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
416
	" <serial>$idx</serial>\n".
417 418 419
	" <owner_gid>$owner_cert</owner_gid>\n".
	" <target_gid>$slice_cert</target_gid>\n".
	" <uuid>$ticket_uuid</uuid>\n".
420
	" <expires>2008-05-10T09:00:00</expires>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
421 422
	" <ticket>\n".
	"  <can_delegate>1</can_delegate>\n".
423
	"  <redeem_before>2008-05-10T09:00:00</redeem_before>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
424
	"  $rspec_xml\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
425 426 427 428 429 430 431 432 433 434 435 436 437 438
	" </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. 
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
439
    if (! open(SIGNER, "$SIGNCRED -c $CMCERT $filename |")) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
440 441 442 443 444 445 446
	print STDERR "Could not sign $filename\n";
	return -1;
    }
    my $ticket = "";
    while (<SIGNER>) {
	$ticket .= $_;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
447 448 449 450
    if (!close(SIGNER)) {
	print STDERR "Could not sign $filename\n";
	return -1;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
451
    $self->{'ticket_string'} = $ticket;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
452

Leigh B. Stoller's avatar
Leigh B. Stoller committed
453
    $self->Store() == 0
Leigh B. Stoller's avatar
Leigh B. Stoller committed
454 455
	or return -1;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
456
    unlink($filename);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472
    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());
}

473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499
#
# 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;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
500 501
#
# Release a ticket. Need to release the nodes ...
502
# Used by the CM.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
503 504 505 506 507 508 509 510 511
#
sub Release($)
{
    my ($self) = @_;

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

    my $experiment = Experiment->Lookup($self->slice_uuid());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
512 513 514
    my $pid     = $experiment->pid();
    my $eid     = $experiment->eid();
    my @nodeids = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
515
    my @nodes   = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
516

517 518
    foreach my $ref (@{$self->rspec()->{'node'}}) {
	my $resource_uuid = $ref->{'uuid'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
519 520 521 522 523
	my $node = Node->Lookup($resource_uuid);
	next
	    if (!defined($node));

	my $reservation = $node->Reservation();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
524 525 526 527
	next
	    if (!defined($reservation));
	
	if ($reservation->SameExperiment($experiment)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
528
	    push(@nodeids, $node->node_id());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
529
	    push(@nodes, $node);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
530 531 532
	}
    }
    if (@nodeids) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
533
	system("export NORELOAD=1; $NFREE -x -q $pid $eid @nodeids");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
534
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
535 536 537
    foreach my $node (@nodes) {
	$node->Refresh();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
538
    $self->Delete();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
539 540 541
    return 0;
}

542 543 544 545 546 547 548 549 550 551 552 553 554 555
#
# 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();
}

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