GeniSliver.pm.in 25.7 KB
Newer Older
Leigh Stoller's avatar
Leigh Stoller committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2008 University of Utah and the Flux Group.
# All rights reserved.
#
package GeniSliver;

#
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 Stoller's avatar
Leigh Stoller committed
20
use GeniComponent;
Leigh Stoller's avatar
Leigh Stoller committed
21
use GeniSlice;
Leigh Stoller's avatar
Leigh Stoller committed
22
use GeniCredential;
23
use GeniCertificate;
Leigh Stoller's avatar
Leigh Stoller committed
24
use GeniAggregate;
Leigh Stoller's avatar
Leigh Stoller committed
25
# Hate to import all this crap; need a utility library.
26
use libdb qw(TBGetUniqueIndex);
Leigh Stoller's avatar
Leigh Stoller committed
27
use libtestbed;
Leigh Stoller's avatar
Leigh Stoller committed
28 29
use Experiment;
use Node;
Leigh Stoller's avatar
Leigh Stoller committed
30
use English;
Leigh Stoller's avatar
Leigh Stoller committed
31
use XML::Simple;
Leigh Stoller's avatar
Leigh Stoller committed
32 33
use Data::Dumper;
use File::Temp qw(tempfile);
Leigh Stoller's avatar
Leigh Stoller committed
34
use overload ('""' => 'Stringify');
Leigh Stoller's avatar
Leigh Stoller committed
35 36 37 38 39 40 41 42 43

# 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 Stoller's avatar
Leigh Stoller committed
44 45 46
my $AVAIL	   = "$TB/sbin/avail";
my $NALLOC	   = "$TB/bin/nalloc";
my $NFREE	   = "$TB/bin/nfree";
Leigh Stoller's avatar
Leigh Stoller committed
47
my $NODEREBOOT	   = "$TB/bin/node_reboot";
48
my $NAMEDSETUP     = "$TB/sbin/named_setup";
Leigh Stoller's avatar
Leigh Stoller committed
49 50
my $PLABNODE       = "$TB/sbin/plabnodewrapper";
my $VNODESETUP     = "$TB/sbin/vnode_setup";
51
my $GENTOPOFILE    = "$TB/libexec/gentopofile";
Leigh Stoller's avatar
Leigh Stoller committed
52 53 54 55 56 57 58 59 60 61 62

# Cache of instances to avoid regenerating them.
my %slivers      = ();

#
# Lookup by idx, or uuid.
#
sub Lookup($$)
{
    my ($class, $token) = @_;
    my $query_result;
Leigh Stoller's avatar
Leigh Stoller committed
63
    my $idx;
Leigh Stoller's avatar
Leigh Stoller committed
64 65

    if ($token =~ /^\d+$/) {
Leigh Stoller's avatar
Leigh Stoller committed
66
	$idx = $token;
Leigh Stoller's avatar
Leigh Stoller committed
67 68 69
    }
    elsif ($token =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
	$query_result =
Leigh Stoller's avatar
Leigh Stoller committed
70
	    DBQueryWarn("select idx from geni_slivers ".
Leigh Stoller's avatar
Leigh Stoller committed
71
			"where uuid='$token'");
Leigh Stoller's avatar
Leigh Stoller committed
72 73 74 75
	    return undef
		if (! $query_result || !$query_result->numrows);

	    ($idx) = $query_result->fetchrow_array();
Leigh Stoller's avatar
Leigh Stoller committed
76 77 78 79
    }
    else {
	return undef;
    }
Leigh Stoller's avatar
Leigh Stoller committed
80 81 82 83 84 85 86 87

    # Look in cache first
    return $slivers{"$idx"}
        if (exists($slivers{"$idx"}));

    $query_result = DBQueryWarn("select * from geni_slivers ".
				"where idx='$idx'");

Leigh Stoller's avatar
Leigh Stoller committed
88 89 90
    return undef
	if (!$query_result || !$query_result->numrows);

Leigh Stoller's avatar
Leigh Stoller committed
91 92
    my $self              = {};
    $self->{'SLIVER'}     = $query_result->fetchrow_hashref();
Leigh Stoller's avatar
Leigh Stoller committed
93 94 95 96 97 98 99 100 101 102 103
    $self->{'COMPONENT'}  = undef;	# client
    $self->{'SLICE'}      = undef;	# client/server
    $self->{'CREDENTIAL'} = undef;	# client
    $self->{'AGGREGATE'}  = undef;	# server
    $self->{'RSPEC'}      = undef;	# client/server

    my $rspec_string = $self->{'SLIVER'}->{'rspec_string'};
    if (defined($rspec_string) && $rspec_string ne "") {
	$self->{'RSPEC'} = XMLin($rspec_string,
				 ForceArray => ["node", "link"]);
    }
104 105 106 107 108 109 110 111 112 113 114

    #
    # Grab the certificate, since we will probably want it.
    #
    my $uuid = $self->{'SLIVER'}->{'uuid'};
    my $certificate = GeniCertificate->Lookup($uuid);
    if (!defined($certificate)) {
	print STDERR "Could not find certificate for sliver $idx ($uuid)\n";
	return undef;
    }
    $self->{'CERTIFICATE'} = $certificate;
115 116 117 118

    # Bless into sub package if called for.
    my $resource_type = $self->{'SLIVER'}->{'resource_type'};
    if (defined($resource_type) && $resource_type ne "") {
119
	bless($self, $class . "::" . $resource_type);
120 121 122 123
    }
    else {
	bless($self, $class);
    }
Leigh Stoller's avatar
Leigh Stoller committed
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
    
    # Add to cache. 
    $slivers{$self->{'SLIVER'}->{'idx'}} = $self;
    
    return $self;
}

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

    return "[GeniSliver: $uuid, IDX: $idx]";
}

#
Leigh Stoller's avatar
Leigh Stoller committed
145
# Create a sliver record in the DB. On the client side we save the credential
Leigh Stoller's avatar
Leigh Stoller committed
146
# that allows control of it, for later operations.
Leigh Stoller's avatar
Leigh Stoller committed
147
#
148
sub Create($$$$$$$$;$$$)
Leigh Stoller's avatar
Leigh Stoller committed
149
{
150
    my ($class, $slice, $owner_uuid, $uuid, $resource_uuid, $resource_type,
151
	$hrn, $nickname,
Leigh Stoller's avatar
Leigh Stoller committed
152
	$rspec, $credential, $component) = @_;
Leigh Stoller's avatar
Leigh Stoller committed
153
    my @insert_data = ();
154
    my $certificate;
Leigh Stoller's avatar
Leigh Stoller committed
155 156 157

    # Every sliver gets a new unique index.
    my $idx = TBGetUniqueIndex('next_sliver', 1);
Leigh Stoller's avatar
Leigh Stoller committed
158
    if (defined($credential)) {
159
	$certificate = $credential->target_cert();
160
	# Store the certificate for later use.
161
	if ($certificate->Store() != 0) {
162 163 164
	    print STDERR "Could not store certificate\n";
	    return undef;
	}
165
	$resource_uuid = $uuid = $credential->this_uuid();
166 167 168 169 170
	$hrn = $credential->hrn();
	if (defined($credential->extensions()) &&
	    exists($credential->extensions()->{'nickname'})) {
	    $nickname = $credential->extensions()->{'nickname'};
	}
Leigh Stoller's avatar
Leigh Stoller committed
171 172 173 174 175
	# Store the credential
	return undef
	    if ($credential->Store() != 0);
    }
    else {
176
	# Create a cert pair, for this resource uuid. 
177
	$certificate = GeniCertificate->Create("sliver", $hrn, $TBOPS, $uuid);
178 179
	if (!defined($certificate)) {
	    print STDERR "Could not generate new certificate and UUID!\n";
Leigh Stoller's avatar
Leigh Stoller committed
180 181
	    return undef;
	}
Leigh Stoller's avatar
Leigh Stoller committed
182
    }
Leigh Stoller's avatar
Leigh Stoller committed
183
    my $slice_uuid     = $slice->uuid();
Leigh Stoller's avatar
Leigh Stoller committed
184 185 186 187

    # Now tack on other stuff we need.
    push(@insert_data, "created=now()");
    push(@insert_data, "idx='$idx'");
188 189 190
    push(@insert_data, "hrn=" . DBQuoteSpecial($hrn));
    push(@insert_data, "nickname=" . DBQuoteSpecial($nickname))
	if (defined($nickname));
Leigh Stoller's avatar
Leigh Stoller committed
191
    push(@insert_data, "uuid='$uuid'");
192 193
    push(@insert_data, "resource_uuid='$resource_uuid'");
    push(@insert_data, "resource_type='$resource_type'");
Leigh Stoller's avatar
Leigh Stoller committed
194 195 196
    push(@insert_data, "creator_uuid='$owner_uuid'");
    push(@insert_data, "slice_uuid='$slice_uuid'");

Leigh Stoller's avatar
Leigh Stoller committed
197 198 199 200
    # Only on the client side.
    push(@insert_data, "credential_idx=" . $credential->idx())
	if (defined($credential));
    # Only on the client side.
Leigh Stoller's avatar
Leigh Stoller committed
201
    push(@insert_data, "component_uuid='" . $component->uuid() . "'")
Leigh Stoller's avatar
Leigh Stoller committed
202
	if (defined($component));
Leigh Stoller's avatar
Leigh Stoller committed
203

Leigh Stoller's avatar
Leigh Stoller committed
204 205 206 207 208 209 210
    if (defined($rspec)) {
	my $rspec_string = XMLout($rspec, RootName => "rspec");
	my $safe_rspec   = DBQuoteSpecial($rspec_string);

	push(@insert_data, "rspec_string=$safe_rspec");
    }

Leigh Stoller's avatar
Leigh Stoller committed
211
    # Insert into DB.
212 213 214
    if (!DBQueryWarn("insert into geni_slivers set " .
		     join(",", @insert_data))) {
	$certificate->Delete();
Leigh Stoller's avatar
Leigh Stoller committed
215 216 217
	return undef;
    }

Leigh Stoller's avatar
Leigh Stoller committed
218 219 220
    my $sliver = GeniSliver->Lookup($idx);
    return undef
	if (!defined($sliver));
Leigh Stoller's avatar
Leigh Stoller committed
221 222 223
    
    $sliver->{'CREDENTIAL'} = $credential
	if (defined($credential));
Leigh Stoller's avatar
Leigh Stoller committed
224 225 226
    $sliver->{'COMPONENT'} = $component
	if (defined($component));
    $sliver->{'AGGREGATE'} = undef;
Leigh Stoller's avatar
Leigh Stoller committed
227
    $sliver->{'SLICE'}     = undef;
Leigh Stoller's avatar
Leigh Stoller committed
228 229

    return $sliver;
Leigh Stoller's avatar
Leigh Stoller committed
230 231 232 233 234
}
# accessors
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'SLIVER'}->{$_[1]}); }
sub idx($)		{ return field($_[0], "idx"); }
sub uuid($)		{ return field($_[0], "uuid"); }
235 236
sub hrn($)		{ return field($_[0], "hrn"); }
sub nickname($)		{ return field($_[0], "nickname"); }
Leigh Stoller's avatar
Leigh Stoller committed
237 238 239
sub slice_uuid($)	{ return field($_[0], "slice_uuid"); }
sub creator_uuid($)	{ return field($_[0], "creator_uuid"); }
sub created($)		{ return field($_[0], "created"); }
Leigh Stoller's avatar
Leigh Stoller committed
240
sub credential_idx($)	{ return field($_[0], "credential_idx"); }
Leigh Stoller's avatar
Leigh Stoller committed
241
sub resource_uuid($)	{ return field($_[0], "resource_uuid"); }
242
sub resource_type($)	{ return field($_[0], "resource_type"); }
Leigh Stoller's avatar
Leigh Stoller committed
243 244 245
sub component_uuid($)	{ return field($_[0], "component_uuid"); }
sub aggregate_uuid($)	{ return field($_[0], "aggregate_uuid"); }
sub rspec_string($)     { return field($_[0], "rspec_string"); }
Leigh Stoller's avatar
Leigh Stoller committed
246
sub status($)		{ return field($_[0], "status"); }
247 248
sub cert($)		{ return $_[0]->{'CERTIFICATE'}->cert(); }
sub GetCertificate($)   { return $_[0]->{'CERTIFICATE'}; }
Leigh Stoller's avatar
Leigh Stoller committed
249
sub rspec($)            { return $_[0]->{'RSPEC'}; }
Leigh Stoller's avatar
Leigh Stoller committed
250 251 252 253 254 255 256 257 258 259 260

#
# Delete the sliver. The sliver should not be provisioned when this done.
#
sub Delete($)
{
    my ($self) = @_;

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

261 262
    my $idx  = $self->idx();
    my $uuid = $self->uuid();
Leigh Stoller's avatar
Leigh Stoller committed
263

264 265 266 267
    DBQueryWarn("delete from geni_credentials where this_uuid='$uuid'")
	or return -1;
    DBQueryWarn("delete from geni_certificates where uuid='$uuid'")
	or return -1;
Leigh Stoller's avatar
Leigh Stoller committed
268 269 270 271 272 273
    DBQueryWarn("delete from geni_slivers where idx='$idx'")
	or return -1;
    
    return 0;
}

Leigh Stoller's avatar
Leigh Stoller committed
274 275 276 277 278 279 280 281 282 283
#
# Set the aggregate for a sliver.
#
sub SetAggregate($$)
{
    my ($self, $aggregate) = @_;

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

Leigh Stoller's avatar
Leigh Stoller committed
284 285
    my $idx      = $self->idx();
    my $agg_uuid = $aggregate->uuid();
Leigh Stoller's avatar
Leigh Stoller committed
286 287 288

    return -1
	if (!DBQueryWarn("update geni_slivers set ".
Leigh Stoller's avatar
Leigh Stoller committed
289
			 "  aggregate_uuid='$agg_uuid' ".
Leigh Stoller's avatar
Leigh Stoller committed
290 291
			 "where idx='$idx'"));
    
Leigh Stoller's avatar
Leigh Stoller committed
292
    $self->{'SLIVER'}->{'aggregate_uuid'} = $agg_uuid;
Leigh Stoller's avatar
Leigh Stoller committed
293 294 295 296
    $self->{'AGGREGATE'} = $aggregate;
    return 0;
}

297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318
#
# And clear the aggregate.
#
sub ClearAggregate($$)
{
    my ($self) = @_;

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

    my $idx      = $self->idx();

    return -1
	if (!DBQueryWarn("update geni_slivers set ".
			 "  aggregate_uuid=NULL ".
			 "where idx='$idx'"));
    
    $self->{'SLIVER'}->{'aggregate_uuid'} = undef;
    $self->{'AGGREGATE'} = undef;
    return 0;
}

Leigh Stoller's avatar
Leigh Stoller committed
319 320 321 322 323 324 325 326 327 328 329 330
#
# Get the aggregate for a sliver.
#
sub GetAggregate($)
{
    my ($self) = @_;

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

    return $self->{'AGGREGATE'} if (defined($self->{'AGGREGATE'}));
    return undef
Leigh Stoller's avatar
Leigh Stoller committed
331
	if (!defined($self->aggregate_uuid()));
Leigh Stoller's avatar
Leigh Stoller committed
332

Leigh Stoller's avatar
Leigh Stoller committed
333
    my $aggregate = GeniAggregate->Lookup($self->aggregate_uuid());
Leigh Stoller's avatar
Leigh Stoller committed
334 335 336 337 338 339 340 341
    if (!defined($aggregate)) {
	print STDERR "Could not get aggregate object associated with $self\n";
	return undef;
    }
    $self->{'AGGREGATE'} = $aggregate;
    return $aggregate;
}

342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362
#
# Set the status for the sliver.
#
sub SetStatus($$)
{
    my ($self, $status) = @_;

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

    my $idx = $self->idx();
    
    return -1
	if (!DBQueryWarn("update geni_slivers set ".
			 "  status='$status' ".
			 "where idx='$idx'"));
    
    $self->{'SLIVER'}->{'status'} = $status;
    return 0;
}

Leigh Stoller's avatar
Leigh Stoller committed
363 364 365 366 367 368 369 370 371 372 373 374 375
#
# 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());
}

Leigh Stoller's avatar
Leigh Stoller committed
376
#
Leigh Stoller's avatar
Leigh Stoller committed
377
# Get the credential for the sliver.
Leigh Stoller's avatar
Leigh Stoller committed
378
#
Leigh Stoller's avatar
Leigh Stoller committed
379
sub GetCredential($$)
Leigh Stoller's avatar
Leigh Stoller committed
380
{
Leigh Stoller's avatar
Leigh Stoller committed
381
    my ($self, $user) = @_;
Leigh Stoller's avatar
Leigh Stoller committed
382 383 384 385

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

Leigh Stoller's avatar
Leigh Stoller committed
386 387
    return $self->{'CREDENTIAL'} if (defined($self->{'CREDENTIAL'}));

Leigh Stoller's avatar
Leigh Stoller committed
388
    my $credential = GeniCredential->Lookup($self, $user);
Leigh Stoller's avatar
Leigh Stoller committed
389 390
    if (!defined($credential)) {
	print STDERR "Could not get credential object associated with $self\n";
Leigh Stoller's avatar
Leigh Stoller committed
391 392
	return undef;
    }
Leigh Stoller's avatar
Leigh Stoller committed
393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408
    $self->{'CREDENTIAL'} = $credential;
    return $credential;
}

#
# Get the component for the sliver.
#
sub GetComponent($)
{
    my ($self) = @_;

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

    return $self->{'COMPONENT'} if (defined($self->{'COMPONENT'}));

Leigh Stoller's avatar
Leigh Stoller committed
409
    if (!defined($self->component_uuid())) {
Leigh Stoller's avatar
Leigh Stoller committed
410 411 412
	print STDERR "No component associated with $self\n";
	return undef;
    }
Leigh Stoller's avatar
Leigh Stoller committed
413
    my $component = GeniComponent->Lookup($self->component_uuid());
Leigh Stoller's avatar
Leigh Stoller committed
414 415 416 417 418 419
    if (!defined($component)) {
	print STDERR "Could not get component object associated with $self\n";
	return undef;
    }
    $self->{'COMPONENT'} = $component;
    return $component;
Leigh Stoller's avatar
Leigh Stoller committed
420 421
}

Leigh Stoller's avatar
Leigh Stoller committed
422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446
#
# Get the slice for the sliver.
#
sub GetSlice($)
{
    my ($self) = @_;

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

    return $self->{'SLICE'} if (defined($self->{'SLICE'}));

    if (!defined($self->slice_uuid())) {
	print STDERR "No slice associated with $self\n";
	return undef;
    }
    my $slice = GeniSlice->Lookup($self->slice_uuid());
    if (!defined($slice)) {
	print STDERR "Could not get slice object associated with $self\n";
	return undef;
    }
    $self->{'SLICE'} = $slice;
    return $slice;
}

447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473
#
# Look up a list of slivers for a locally instantiated slice. 
# Used by the CM.
#
sub SliceSlivers($$$)
{
    my ($class, $slice, $pref) = @_;

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

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

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

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 500 501 502 503 504 505 506
#
# Find slivers "dependent" on this sliver, as for interfaces on nodes.
#
sub DependentSlivers($$)
{
    my ($self, $pref) = @_;

    return -1
	if (! (ref($self) && ref($pref)));
    @$pref = ();

    my $idx = $self->idx();
    my $resource_uuid = $self->resource_uuid();

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

    my @result = ();
    while (my ($idx) = $query_result->fetchrow_array()) {
	my $sliver = GeniSliver->Lookup($idx);
	if (!defined($sliver)) {
	    print STDERR "Could not get sliver object for $idx\n";
	    return -1;
	}
	push(@result, $sliver);
    }
    @$pref = @result;
    return 0;
}

507
#
Leigh Stoller's avatar
Leigh Stoller committed
508 509
# Create a signed credential for this sliver, issued to the provided user.
# The credential will grant all permissions for now.
510
#
Leigh Stoller's avatar
Leigh Stoller committed
511 512 513
# Should we store these credentials in the DB, recording what we hand out?
#
sub NewCredential($$)
514
{
Leigh Stoller's avatar
Leigh Stoller committed
515
    my ($self, $owner) = @_;
516

Leigh Stoller's avatar
Leigh Stoller committed
517 518
    return undef
	if (! (ref($self) && ref($owner)));
519

Leigh Stoller's avatar
Leigh Stoller committed
520 521 522 523 524
    my $credential = GeniCredential->Create($self, $owner);
    if (!defined($credential)) {
	print STDERR "Could not create credential for $self, $owner\n";
	return undef;
    }
525 526 527
    if (defined($self->nickname())) {
	$credential->AddExtension("nickname", $self->nickname());
    }
Leigh Stoller's avatar
Leigh Stoller committed
528 529 530 531 532 533
    if ($credential->Sign($self->GetCertificate()) != 0) {
	print STDERR "Could not sign credential for $self, $owner\n";
	return undef;
    }
    return $credential;
}
534

Leigh Stoller's avatar
Leigh Stoller committed
535 536 537 538 539 540 541
############################################################################
#
# The client side methods are in packages which inherit from above.
#
package GeniSliver::Client;
use vars qw(@ISA);
@ISA = "GeniSliver";
542

Leigh Stoller's avatar
Leigh Stoller committed
543 544 545 546 547 548 549
use GeniDB;
use GeniComponent;
use GeniSlice;
use GeniCredential;
use GeniCertificate;
use GeniAggregate;
use libdb qw(TBDB_ALLOCSTATE_RES_INIT_DIRTY);
550

Leigh Stoller's avatar
Leigh Stoller committed
551 552 553 554
sub Create()
{
    my ($class, $slice, $user_uuid, $rspec, $credential, $component) = @_;

555
    return GeniSliver->Create($slice, $user_uuid, undef, undef,
556
			      "Client", undef, undef, $rspec, 
Leigh Stoller's avatar
Leigh Stoller committed
557
			      $credential, $component);
558 559
}

Leigh Stoller's avatar
Leigh Stoller committed
560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579
#
# Client side method to contact the sliver component and start it.
#
sub Start($$)
{
    my ($self, $user) = @_;

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

    my $component = $self->GetComponent();
    return -1
	if (!defined($component));

    return -1
	if ($component->StartSliver($self, $user) != 0);

    return 0;
}

580
#
Leigh Stoller's avatar
Leigh Stoller committed
581
# Client side method to contact the sliver component and destroy it.
582
#
Leigh Stoller's avatar
Leigh Stoller committed
583
sub Destroy($$)
584
{
Leigh Stoller's avatar
Leigh Stoller committed
585
    my ($self, $user) = @_;
586

Leigh Stoller's avatar
Leigh Stoller committed
587 588
    return -1
	if (! ref($self));
589

Leigh Stoller's avatar
Leigh Stoller committed
590 591 592 593 594 595 596 597 598 599 600 601
    my $component = $self->GetComponent();
    return -1
	if (!defined($component));

    return -1
	if ($component->DestroySliver($self, $user) != 0);

    # Delete the local object from the DB.
    $self->Delete() == 0
	or return -1;

    return 0;
602 603
}

604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624
#
# On the client side, the aggregate points to the parent sliver when it
# contains multiple resources.
#
sub SetAggregate($$)
{
    my ($self, $parent) = @_;

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

    my $idx         = $self->idx();
    my $parent_uuid = $parent->uuid();

    return -1
	if (!DBQueryWarn("update geni_slivers set ".
			 "  aggregate_uuid='$parent_uuid' ".
			 "where idx='$idx'"));

    return 0;
}
625 626 627 628 629 630 631 632 633 634 635 636 637 638 639
sub ClearAggregate($)
{
    my ($self) = @_;

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

    my $idx         = $self->idx();

    return -1
	if (!DBQueryWarn("update geni_slivers set ".
			 "  aggregate_uuid=NULL ".
			 "where idx='$idx'"));
    return 0;
}
640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657
sub GetAggregate($)
{
    my ($self) = @_;

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

    return undef
	if (!defined($self->aggregate_uuid()));

    my $parent = GeniSliver->Lookup($self->aggregate_uuid());
    if (!defined($parent)) {
	print STDERR "Could not get parent object associated with $self\n";
	return undef;
    }
    return $parent;
}

658 659 660 661 662 663 664 665 666 667 668 669 670
############################################################################
#
# The server side methods are in packages which inherit from above.
#
package GeniSliver::Node;
use vars qw(@ISA);
@ISA = "GeniSliver";

use GeniDB;
use GeniComponent;
use GeniSlice;
use GeniCredential;
use GeniCertificate;
Leigh Stoller's avatar
Leigh Stoller committed
671
use Experiment;
672
use GeniAggregate;
Leigh Stoller's avatar
Leigh Stoller committed
673
use XML::Simple;
674 675
use libdb qw(TBDB_ALLOCSTATE_RES_INIT_DIRTY);

Leigh Stoller's avatar
Leigh Stoller committed
676
sub Create($$$$$)
677
{
Leigh Stoller's avatar
Leigh Stoller committed
678
    my ($class, $slice, $user_uuid, $resource_uuid, $rspec) = @_;
Leigh Stoller's avatar
Leigh Stoller committed
679
    my $virtualization_type = $rspec->{'virtualization_type'};
680
    my $uuid = $resource_uuid;
Leigh Stoller's avatar
Leigh Stoller committed
681 682 683 684

    my $experiment = $slice->GetExperiment();
    if (!defined($experiment)) {
	print STDERR "Could not map $slice to its experiment\n";
685
	return undef;
Leigh Stoller's avatar
Leigh Stoller committed
686
    }
687

Leigh Stoller's avatar
Leigh Stoller committed
688 689 690 691 692 693 694 695
    #
    # the node is already allocated to the sliver, but still need to enter
    # a virt_nodes entry, and possibly more virt table entries, so that the
    # node will boot properly, and is otherwise controllable.
    #
    my $node = Node->Lookup($resource_uuid);
    if (!defined($node)) {
	print STDERR "Could not map node $resource_uuid to its object\n";
696
	return undef;
Leigh Stoller's avatar
Leigh Stoller committed
697
    }
698 699 700 701 702 703 704 705 706 707 708
    if (! $node->isremotenode()) {
	my $reservation = $node->Reservation();
	if (!defined($reservation)) {
	    print STDERR "$node was already released from $slice\n";
	    return undef;
	}
	if (! $reservation->SameExperiment($experiment)) {
	    print STDERR "$node is reserved to another, not $reservation\n";
	    # Signal error so we can look at what happened.
	    return undef;
	}
Leigh Stoller's avatar
Leigh Stoller committed
709
    }
710 711
    my $hrn = "emulab." . $node->node_id();
    my $nickname = $rspec->{'nickname'};
Leigh Stoller's avatar
Leigh Stoller committed
712 713 714 715 716 717
    
    #
    # The resource UUID refers to the physical node, but the virtualization
    # type might require a vnode.
    # 
    if ($virtualization_type eq "emulab-vnode") {
Leigh Stoller's avatar
Leigh Stoller committed
718 719 720 721 722 723 724 725 726 727 728
	my $vtype = "pcfake";

	if ($node->isplabphysnode()) {
	    if ($node->type() =~ /^(\w*)phys$/) {
		$vtype = $1;
	    }
	    else {
		print STDERR "Could not determine vtype for $node\n";
		return undef;
	    }
	}
729
	
Leigh Stoller's avatar
Leigh Stoller committed
730
	#
731
	# Create a virtual node on the physnode. 
Leigh Stoller's avatar
Leigh Stoller committed
732 733 734
	#
	my @vnodes;
	if (Node::CreateVnodes(\@vnodes,
735 736
			       {"pid"      => $experiment->pid(),
				"eid"      => $experiment->eid(),
Leigh Stoller's avatar
Leigh Stoller committed
737
				"count"    => 1,
738
				"vtype"    => "$vtype",
Leigh Stoller's avatar
Leigh Stoller committed
739 740
				"nodeid"   => $node->node_id(),
				"verbose"  => 1 }) < 0) {
741
	    print STDERR "Could not create new virtual node on $node\n";
742
	    return undef;
Leigh Stoller's avatar
Leigh Stoller committed
743 744
	}
	my $vnode = Node->Lookup($vnodes[0]);
745
	$uuid = $vnode->uuid();
746
	$hrn = "emulab." . $vnode->node_id()
Leigh Stoller's avatar
Leigh Stoller committed
747
    }
748
    return GeniSliver->Create($slice, $user_uuid, $uuid, $resource_uuid,
749
			      "Node", $hrn, $nickname, $rspec);
750 751
}

Leigh Stoller's avatar
Leigh Stoller committed
752 753
#
# Provision a slice. We actually did this when the ticket was requested.
Leigh Stoller's avatar
Leigh Stoller committed
754
# We fill in some virt table stuff so that tbswap will work.
Leigh Stoller's avatar
Leigh Stoller committed
755
#
Leigh Stoller's avatar
Leigh Stoller committed
756
sub Provision($;$)
Leigh Stoller's avatar
Leigh Stoller committed
757
{
Leigh Stoller's avatar
Leigh Stoller committed
758
    my ($self, $extraargs) = @_;
Leigh Stoller's avatar
Leigh Stoller committed
759 760 761 762 763 764 765

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

    #
    # the node is already allocated to the sliver, but still need to enter
    # a virt_nodes entry, and possibly more virt table entries, so that the
Leigh Stoller's avatar
Leigh Stoller committed
766
    # node will boot properly, and is otherwise controllable.
Leigh Stoller's avatar
Leigh Stoller committed
767 768 769 770 771 772
    #
    my $experiment = Experiment->Lookup($self->slice_uuid());
    if (!defined($experiment)) {
	print STDERR "Could not map $self to its experiment\n";
	return -1;
    }
773
    my $uuid = $self->uuid();
Leigh Stoller's avatar
Leigh Stoller committed
774
    return 0
775 776
	if (!defined($uuid));
    my $node       = Node->Lookup($uuid);
Leigh Stoller's avatar
Leigh Stoller committed
777
    if (!defined($node)) {
778
	print STDERR "Could not map node $uuid to its object\n";
Leigh Stoller's avatar
Leigh Stoller committed
779 780
	return -1;
    }
781
    my $node_id     = $node->node_id();
Leigh Stoller's avatar
Leigh Stoller committed
782 783
    my $reservation = $node->Reservation();
    if (!defined($reservation)) {
784
	print STDERR "$node was already released from slice\n";
Leigh Stoller's avatar
Leigh Stoller committed
785 786
	return -1;
    }
787 788 789 790 791 792 793
    if (! $reservation->SameExperiment($experiment)) {
	print STDERR "$node is reserved to another, not $reservation\n";
	# Signal error so we can look at what happened.
	return -1;
    }
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();
794
	
795 796 797 798
    if ($experiment->InsertVirtNode($node) != 0) {
	print STDERR "Could not add virtnode entry for $node to $self\n";
	return -1;
    }
Leigh Stoller's avatar
Leigh Stoller committed
799

800 801 802 803 804
    if (exists($self->rspec()->{'tmcd_server'}) &&
	exists($self->rspec()->{'tmcd_nodeid'})) {
	my $tmcd_redirect =
	    $self->rspec()->{'tmcd_server'} . ":" .
	    $self->rspec()->{'tmcd_nodeid'};
Leigh Stoller's avatar
Leigh Stoller committed
805

806 807
	if ($node->ModifyReservation({"tmcd_redirect" => $tmcd_redirect})){
	    return -1;
Leigh Stoller's avatar
Leigh Stoller committed
808
	}
809
    }
Leigh Stoller's avatar
Leigh Stoller committed
810

811 812 813 814 815 816 817 818 819 820 821 822 823
    #
    # An emulab cluster node uses a vnode on the physnode, even for a
    # dedicated physical nodes. We need to tell tmcd about the pnode,
    # but not the vnode since it is going to redirect to tmcd on the
    # remote Emulab controlling the experiment.
    #
    if (!$node->isremotenode() &&
	exists($self->rspec()->{'virtualization_type'}) &&
	$self->rspec()->{'virtualization_type'} eq "emulab-vnode") {
	my $pnode = Node->Lookup($node->phys_nodeid());
	if (!defined($pnode)) {
	    print STDERR "Could not get pnode object for $node\n";
	    return -1;
Leigh Stoller's avatar
Leigh Stoller committed
824
	}
825 826 827
	    
	if ($experiment->InsertVirtNode($pnode) != 0) {
	    print STDERR "Could not add virtnode entry for $pnode to $self\n";
828 829
	    return -1;
	}
830
	$pnode->ModifyReservation({"genisliver_idx" => $self->idx()});
831

832 833
	# Set it to boot the default OS.
	if ($pnode->SelectOS() != 0) {
834 835
	    return -1;
	}
Leigh Stoller's avatar
Leigh Stoller committed
836 837
    }
    else {
838 839 840 841 842 843 844 845
	#
	# For a "raw" node, there is no vnode, so this is the pnode
	# we need to mark for tmcd.
	#
	if ($node->ModifyReservation({"genisliver_idx" => $self->idx()})) {
	    return -1;
	}
    }
Leigh Stoller's avatar
Leigh Stoller committed
846 847 848 849 850 851 852 853 854 855 856 857 858 859
    return 0;
}

#
# Unprovision a sliver. 
#
sub UnProvision($)
{
    my ($self) = @_;

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

    my $experiment = Experiment->Lookup($self->slice_uuid());
Leigh Stoller's avatar
Leigh Stoller committed
860 861 862 863
    if (!defined($experiment)) {
	print STDERR "Could not map $self to its experiment\n";
	return -1;
    }
864
    my $uuid = $self->uuid();
Leigh Stoller's avatar
Leigh Stoller committed
865
    return 0
866 867
	if (!defined($uuid));
    my $node       = Node->Lookup($uuid);
Leigh Stoller's avatar
Leigh Stoller committed
868
    if (!defined($node)) {
869
	print STDERR "Could not map node $uuid to its object\n";
Leigh Stoller's avatar
Leigh Stoller committed
870 871 872 873 874 875 876 877
	return -1;
    }
    my $reservation = $node->Reservation();
    if (!defined($reservation)) {
	print STDERR "$node was already released from $self\n";
	return 0;
    }
    if ($reservation->SameExperiment($experiment)) {
Leigh Stoller's avatar
Leigh Stoller committed
878
	my $node_id = $node->node_id();
Leigh Stoller's avatar
Leigh Stoller committed
879 880
	my $pid = $experiment->pid();
	my $eid = $experiment->eid();
Leigh Stoller's avatar
Leigh Stoller committed
881

882
	if ($node->isremotenode()) {
Leigh Stoller's avatar
Leigh Stoller committed
883
	    system("$VNODESETUP -p -q -m -k $pid $eid $node_id");
884
	    if ($?) {
Leigh Stoller's avatar
Leigh Stoller committed
885
		print STDERR "$VNODESETUP failed\n";
886 887 888 889
		return -1;
	    }
	}

890 891 892 893
	if ($experiment->DeleteVirtNode($node) != 0) {
	    print STDERR "Could remove virtnode entry for $node from $self\n";
	    return -1;
	}
Leigh Stoller's avatar
Leigh Stoller committed
894

895 896
	if (!$node->isremotenode() &&
	    $self->rspec()->{'virtualization_type'} eq "emulab-vnode") {
Leigh Stoller's avatar
Leigh Stoller committed
897 898 899 900 901 902 903 904 905 906 907 908 909 910 911
	    my $pnode_id = $node->phys_nodeid();
	    my $pnode = Node->Lookup($pnode_id);
	    if (!defined($pnode)) {
		print STDERR "Could not get pnode object for $pnode_id\n";
		return -1;
	    }
	    if ($experiment->DeleteVirtNode($pnode) != 0) {
		print STDERR
		    "Could remove virtnode entry for $pnode from $self\n";
		return -1;
	    }
	    system("export NORELOAD=1; $NFREE -x -q $pid $eid $pnode_id");
	}
	else {
	    system("export NORELOAD=1; $NFREE -q $pid $eid $node_id");
Leigh Stoller's avatar
Leigh Stoller committed
912
	}
Leigh Stoller's avatar
Leigh Stoller committed
913 914
	if ($?) {
	    print STDERR "Could not deallocate $node from $self\n";
Leigh Stoller's avatar
Leigh Stoller committed
915
	    $node->Refresh();
Leigh Stoller's avatar
Leigh Stoller committed
916 917
	    return -1;
	}
Leigh Stoller's avatar
Leigh Stoller committed
918
	$node->Refresh();
Leigh Stoller's avatar
Leigh Stoller committed
919 920 921 922 923 924 925 926 927 928
    }
    else {
	print STDERR "$node is reserved to another, not $self\n";
	# Signal error so we can look at what happened.
	return -1;
    }
    return 0;
}

#
Leigh Stoller's avatar
Leigh Stoller committed
929
# Start a sliver, which means what?
Leigh Stoller's avatar
Leigh Stoller committed
930
#
931
sub Start($)
Leigh Stoller's avatar
Leigh Stoller committed
932 933 934 935 936 937 938 939 940 941 942
{
    my ($self) = @_;

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

    my $experiment = Experiment->Lookup($self->slice_uuid());
    if (!defined($experiment)) {
	print STDERR "Could not map $self to its experiment\n";
	return -1;
    }
943
    my $uuid = $self->uuid();
Leigh Stoller's avatar
Leigh Stoller committed
944
    return 0
945 946
	if (!defined($uuid));
    my $node       = Node->Lookup($uuid);
Leigh Stoller's avatar
Leigh Stoller committed
947
    if (!defined($node)) {
948
	print STDERR "Could not map node $uuid to its object\n";
Leigh Stoller's avatar
Leigh Stoller committed
949 950 951 952 953 954 955 956
	return -1;
    }
    my $reservation = $node->Reservation();
    if (!defined($reservation)) {
	print STDERR "$node was already released from $self\n";
	return -1;
    }
    if ($reservation->SameExperiment($experiment)) {
Leigh Stoller's avatar
Leigh Stoller committed
957
	my $node_id = $node->node_id();
Leigh Stoller's avatar
Leigh Stoller committed
958

959 960 961
	# XXX Need to fix up this status stuff.
	if ($node->isremotenode() && $self->status() eq "created") {
	    $self->SetStatus("ready");
Leigh Stoller's avatar
Leigh Stoller committed
962
	    goto done;
963 964
	}

Leigh Stoller's avatar
Leigh Stoller committed
965 966 967 968 969 970 971
	#
	# Reboot pnode if not already running. 
	#
	if ($self->rspec()->{'virtualization_type'} eq "emulab-vnode" &&
	    $self->status() eq "created") {
	    $node_id = $node->phys_nodeid();
	}
Leigh Stoller's avatar
Leigh Stoller committed
972 973 974
	#
	# Reboot and wait?
	#
Leigh Stoller's avatar
Leigh Stoller committed
975 976 977 978 979
	system("$NODEREBOOT -s $node_id");
	$self->SetStatus("ready")
	    if (!$?);
	return -1
	    if ($?);
Leigh Stoller's avatar
Leigh Stoller committed
980 981 982 983 984
    }
    else {
	print STDERR "$node is reserved to another, not $self\n";
	# Signal error so we can look at what happened.
	return -1;
Leigh Stoller's avatar
Leigh Stoller committed
985
    }
Leigh Stoller's avatar
Leigh Stoller committed
986
  done:
Leigh Stoller's avatar
Leigh Stoller committed
987 988
    return 0;
}
Leigh Stoller's avatar
Leigh Stoller committed
989

990
##########################################################################
991
#
992 993 994 995 996 997 998 999 1000 1001
package GeniSliver::Interface;
use vars qw(@ISA);
@ISA = "GeniSliver";

use GeniDB;
use GeniComponent;
use GeniSlice;
use GeniCredential;
use GeniCertificate;
use GeniAggregate;
1002 1003 1004
use Interface;
use Experiment;
use Node;
1005 1006 1007

sub Create()
{
1008
    my ($class, $slice, $user_uuid,
1009 1010 1011 1012
	$interface_uuid, $node, $rspec) = @_;

    my $nickname = $rspec->{'nickname'};
    my $hrn = "emulab." . $node->node_id() . "." . $rspec->{'iface_name'};
1013

1014
    return GeniSliver->Create($slice, $user_uuid, $interface_uuid,
1015 1016
			      $node->uuid(), "Interface",
			      $hrn, $nickname, $rspec);
1017 1018 1019 1020 1021 1022
}

sub Provision($)
{
    my ($self) = @_;

1023 1024 1025 1026
    #
    # This is actually implemented in GeniAggregate since currently "link"
    # is the smallest entity; you cannot operate on an individual interface.
    #
1027 1028 1029 1030 1031 1032 1033
    return -1
	if (! ref($self));

    return 0;
}

#
1034
# Unprovision a single interface from a link/lan. 
1035 1036 1037 1038 1039 1040 1041 1042
#
sub UnProvision($)
{
    my ($self) = @_;

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

1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061
    my $aggregate = $self->GetAggregate();
    if (!defined($aggregate)) {
	print STDERR "Could not find aggregate for $self\n";
	return -1;
    }

    #
    # This is terrible; we need an interface to remove ports form vlans,
    # so that we do not have to tear down the entire vlan and recreate.
    #
    if ($aggregate->UnProvision() != 0) {
	print STDERR "Could not unprovision $aggregate\n";
	return -1;
    }
    $self->ClearAggregate();
    if ($aggregate->Provision() != 0) {
	print STDERR "Could not provision $aggregate\n";
	return -1;
    }
1062 1063 1064 1065
    return 0;
}

#
1066
# Start a sliver.
1067
#
1068
sub Start($)
1069 1070 1071
{
    my ($self) = @_;

1072 1073 1074 1075
    #
    # This is actually implemented in GeniAggregate since currently "link"
    # is the smallest entity; you cannot operate on an individual interface.
    #
1076 1077 1078 1079 1080
    return -1
	if (! ref($self));

    return 0;
}
Leigh Stoller's avatar
Leigh Stoller committed
1081

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