GeniTicket.pm.in 12.8 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);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
26
use English;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
27 28
use XML::Simple;
use XML::LibXML;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
29 30
use Data::Dumper;
use File::Temp qw(tempfile);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
31
use overload ('""' => 'Stringify');
Leigh B. Stoller's avatar
Leigh B. Stoller committed
32 33 34 35 36 37 38 39 40

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

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

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

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

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

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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182
    #
    # 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
183 184
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
185 186
    # Use XML::Simple to convert to something we can mess with.
    my $parser = XML::LibXML->new;
187 188 189 190 191 192 193 194
    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
195 196 197 198 199

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

    # 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));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
208 209
    my $slice_cert = $uuid_node->to_literal();
    my $slice_uuid;
210
    GeniCertificate->CertificateInfo($slice_cert, \$slice_uuid) == 0
Leigh B. Stoller's avatar
Leigh B. Stoller committed
211
	or return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
212 213 214 215 216 217 218 219 220 221 222

    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));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
223 224
    my $owner_cert = $uuid_node->to_literal();
    my $owner_uuid;
225
    GeniCertificate->CertificateInfo($owner_cert, \$owner_uuid) == 0
Leigh B. Stoller's avatar
Leigh B. Stoller committed
226
	or return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
227 228 229 230 231 232

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
233 234 235 236
    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
237

Leigh B. Stoller's avatar
Leigh B. Stoller committed
238 239 240
    if (! ($seqno =~ /^\w+$/)) {
	print STDERR "Invalid sequence number in ticket\n";
	return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
241 242
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
243
    my $self = {};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
244
    $self->{'idx'}           = undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
245 246 247
    $self->{'rspec'}         = $rspec;
    $self->{'slice_uuid'}    = $slice_uuid;
    $self->{'owner_uuid'}    = $owner_uuid;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
248 249
    $self->{'slice_cert'}    = $slice_cert;
    $self->{'owner_cert'}    = $owner_cert;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
250 251
    $self->{'ticket_string'} = $ticket_string;
    $self->{'xmlref'}        = $doc;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
252
    $self->{'component'}     = $component;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269
    $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
270 271 272 273
    bless($self, $class);

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
275
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
276 277
# 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
278 279 280 281 282 283 284 285
#
sub Delete($)
{
    my ($self) = @_;

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
286
    if ($self->stored()) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
287 288 289 290
	my $idx = $self->idx();
	
	DBQueryWarn("delete from geni_tickets where idx='$idx'")
	    or return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
291 292
	
	delete($tickets{"$idx"});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
293 294 295 296
    }
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
297 298 299 300 301 302 303 304
#
# 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
305
    return -1
Leigh B. Stoller's avatar
Leigh B. Stoller committed
306 307 308 309 310 311
	if (! ref($self));

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
312
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
313 314 315
# 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
316
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
317
sub Store($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
318
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
319
    my ($self) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
320 321
    my @insert_data  = ();

Leigh B. Stoller's avatar
Leigh B. Stoller committed
322 323
    my $idx        = $self->idx();
    my $seqno      = $self->seqno();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
324 325 326
    my $slice_uuid = $self->slice_uuid();
    my $owner_uuid = $self->owner_uuid();

Leigh B. Stoller's avatar
Leigh B. Stoller committed
327 328 329 330 331
    #
    # 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
332 333 334 335
    if (!defined($idx)) {
	$idx = TBGetUniqueIndex('next_ticket', 1);
	$self->{'idx'} = $idx;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
336
    # A locally generated ticket will not have a component. Might change that.
337
    push(@insert_data, "component_uuid='" . $self->component()->uuid() . "'")
Leigh B. Stoller's avatar
Leigh B. Stoller committed
338 339
	if (defined($self->component()));

Leigh B. Stoller's avatar
Leigh B. Stoller committed
340 341 342
    # 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
343
    push(@insert_data, "seqno='$seqno'");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
344 345 346 347 348 349 350 351 352 353
    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
354 355
    $tickets{"$idx"}  = $self;
    $self->{'stored'} = 1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
356 357 358
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
359 360
#
# Sign the ticket before returning it. We capture the output, which is
Leigh B. Stoller's avatar
Leigh B. Stoller committed
361
# in XML. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
362 363 364 365 366 367 368
#
sub Sign($)
{
    my ($self) = @_;

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
370
    my $idx        = $self->seqno();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
371 372
    my $slice_cert = $self->slice_cert();
    my $owner_cert = $self->owner_cert();
373
    my $hrn        = "$OURDOMAIN.tickets.$idx";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
374 375
    my $rspec_xml  = XMLout($self->rspec(), "NoAttr" => 1);
    $rspec_xml =~ s/opt\>/rspec\>/g;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
376 377 378 379 380 381

    #
    # 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
382
	"<credential xml:id=\"ref1\">\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
383
	" <type>ticket</type>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
384
	" <serial>$idx</serial>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
385
	" <owner_uuid>$owner_cert</owner_uuid>\n".
386
	" <target_uuid>$slice_cert</target_uuid>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
387
	" <this_uuid>$slice_cert</this_uuid>\n".
388 389
	" <hrn>$hrn</hrn>\n".
	" <expires>2008-05-10T09:00:00</expires>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
390 391
	" <ticket>\n".
	"  <can_delegate>1</can_delegate>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
392
	"  $rspec_xml\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
393 394 395 396 397 398 399 400 401 402 403 404 405 406
	" </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
407
    if (! open(SIGNER, "$SIGNCRED -c $CMCERT $filename |")) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
408 409 410 411 412 413 414
	print STDERR "Could not sign $filename\n";
	return -1;
    }
    my $ticket = "";
    while (<SIGNER>) {
	$ticket .= $_;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
415 416 417 418
    if (!close(SIGNER)) {
	print STDERR "Could not sign $filename\n";
	return -1;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
419
    $self->{'ticket_string'} = $ticket;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
420

Leigh B. Stoller's avatar
Leigh B. Stoller committed
421
    $self->Store() == 0
Leigh B. Stoller's avatar
Leigh B. Stoller committed
422 423
	or return -1;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
424
    unlink($filename);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440
    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());
}

441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467
#
# 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
468 469
#
# Release a ticket. Need to release the nodes ...
470
# Used by the CM.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
471 472 473 474 475 476 477 478 479
#
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
480 481 482
    my $pid     = $experiment->pid();
    my $eid     = $experiment->eid();
    my @nodeids = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
483
    my @nodes   = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
484

485 486
    foreach my $ref (@{$self->rspec()->{'node'}}) {
	my $resource_uuid = $ref->{'uuid'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
487 488 489 490 491
	my $node = Node->Lookup($resource_uuid);
	next
	    if (!defined($node));

	my $reservation = $node->Reservation();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
492 493 494 495
	next
	    if (!defined($reservation));
	
	if ($reservation->SameExperiment($experiment)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
496
	    push(@nodeids, $node->node_id());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
497
	    push(@nodes, $node);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
498 499 500
	}
    }
    if (@nodeids) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
501
	system("export NORELOAD=1; $NFREE -x -q $pid $eid @nodeids");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
502
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
503 504 505
    foreach my $node (@nodes) {
	$node->Refresh();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
506
    $self->Delete();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
507 508 509
    return 0;
}

510 511 512 513 514 515 516 517 518 519 520 521 522 523
#
# 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
524 525
# _Always_ make sure that this 1 is at the end of the file...
1;