GeniAggregate.pm.in 23.2 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1 2 3
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2008-2009 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5 6 7 8 9
# All rights reserved.
#
package GeniAggregate;

#
10
# Some simple aggregate stuff.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
11 12 13 14 15 16 17 18 19 20 21 22 23 24
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

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

# Must come after package declaration!
use lib '@prefix@/lib';
use GeniDB;
use GeniCredential;
use GeniCertificate;
use GeniSliver;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
25
use GeniSlice;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
26
use GeniRegistry;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
27 28 29 30 31 32 33 34 35 36 37 38
use libdb qw(TBGetUniqueIndex);
use English;
use overload ('""' => 'Stringify');
use XML::Simple;

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
39
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
40 41 42 43 44 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 70 71 72 73 74 75 76 77 78 79 80 81 82
my $SIGNCRED	   = "$TB/sbin/signgenicred";
my $VERIFYCRED	   = "$TB/sbin/verifygenicred";

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

#
# Lookup by idx, or uuid.
#
sub Lookup($$)
{
    my ($class, $token) = @_;
    my $query_result;
    my $idx;

    if ($token =~ /^\d+$/) {
	$idx = $token;
    }
    elsif ($token =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/) {
	$query_result =
	    DBQueryWarn("select idx from geni_aggregates ".
			"where uuid='$token'");
	    return undef
		if (! $query_result || !$query_result->numrows);

	    ($idx) = $query_result->fetchrow_array();
    }
    else {
	return undef;
    }
    # Look in cache first
    return $aggregates{"$idx"}
        if (exists($aggregates{"$idx"}));

    $query_result =
	DBQueryWarn("select * from geni_aggregates where idx='$idx'");
    
    return undef
	if (!$query_result || !$query_result->numrows);

    my $self              = {};
    $self->{'AGGREGATE'}  = $query_result->fetchrow_hashref();
    $self->{'CREDENTIAL'} = undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
83
    $self->{'SLICE'}      = undef;
84
    $self->{'PARENT'}     = undef;
85 86 87

    # Bless into sub package if called for.
    my $type = $self->{'AGGREGATE'}->{'type'};
88
    if (defined($type) && $type ne "" && $type ne "Aggregate") {
89 90 91 92 93
	bless($self, $class . "::" . $type);
    }
    else {
	bless($self, $class);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129

    #
    # Grab the certificate, since we will probably want it.
    #
    my $uuid = $self->{'AGGREGATE'}->{'uuid'};
    my $certificate = GeniCertificate->Lookup($uuid);
    if (!defined($certificate)) {
	print STDERR "Could not find certificate for aggregate $idx ($uuid)\n";
	return undef;
    }
    $self->{'CERTIFICATE'} = $certificate;
    
    # Add to cache. 
    $aggregates{$self->{'AGGREGATE'}->{'idx'}} = $self;
    
    return $self;
}

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

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

#
# Create a Geni aggregate in the DB. This happens on the server side only
# for now. The client side does not actually know its an aggregate, at
# least not yet.
#
130
sub Create($$$$$$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
131
{
132
    my ($class, $slice, $owner, $aggregate_type, $hrn, $nickname) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
133 134 135 136 137 138
    my @insert_data = ();

    # Every aggregate gets a new unique index.
    my $idx = TBGetUniqueIndex('next_aggregate', 1);

    # Create a cert pair, which gives us a new uuid.
139
    my $certificate = GeniCertificate->Create("aggregate", $hrn, $TBOPS);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
140 141 142 143 144
    if (!defined($certificate)) {
	print STDERR "Could not generate new certificate and UUID!\n";
	return undef;
    }
    my $uuid        = $certificate->uuid();
145 146
    my $slice_uuid  = $slice->uuid();
    my $owner_uuid  = $owner->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
147

Leigh B. Stoller's avatar
Leigh B. Stoller committed
148 149 150
    $aggregate_type = "Aggregate"
    	if (! defined($aggregate_type));

Leigh B. Stoller's avatar
Leigh B. Stoller committed
151 152 153
    # Now tack on other stuff we need.
    push(@insert_data, "created=now()");
    push(@insert_data, "idx='$idx'");
154
    push(@insert_data, "hrn=" . DBQuoteSpecial($hrn));
155
    push(@insert_data, "nickname=" . DBQuoteSpecial($nickname));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
156 157 158
    push(@insert_data, "uuid='$uuid'");
    push(@insert_data, "creator_uuid='$owner_uuid'");
    push(@insert_data, "slice_uuid='$slice_uuid'");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
159
    push(@insert_data, "type='$aggregate_type'");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
160 161 162 163 164 165 166 167 168 169 170 171 172

    # Insert into DB.
    if (!DBQueryWarn("insert into geni_aggregates set " .
		     join(",", @insert_data))) {
	$certificate->Delete();
	return undef;
    }
    return GeniAggregate->Lookup($idx);
}
# accessors
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'AGGREGATE'}->{$_[1]}); }
sub idx($)		{ return field($_[0], "idx"); }
sub uuid($)		{ return field($_[0], "uuid"); }
173
sub nickname($)		{ return field($_[0], "nickname"); }
174
sub type($)		{ return field($_[0], "type"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
175 176 177 178
sub slice_uuid($)	{ return field($_[0], "slice_uuid"); }
sub creator_uuid($)	{ return field($_[0], "creator_uuid"); }
sub created($)		{ return field($_[0], "created"); }
sub credential_idx($)	{ return field($_[0], "credential_idx"); }
179
sub aggregate_idx($)	{ return field($_[0], "aggregate_idx"); }
180
sub status($)		{ return field($_[0], "status"); }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
181 182 183
sub cert($)		{ return $_[0]->{'CERTIFICATE'}->cert(); }
sub GetCertificate($)   { return $_[0]->{'CERTIFICATE'}; }

184 185 186
# An alias so that slivers look like aggregates.
sub resource_type($)	{ return field($_[0], "type"); }

187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205
#
# Destroy all the slivers in the aggregate, and then the aggregate if there
# is nothing in it. Leave it around if something goes wrong.
#
sub Delete($)
{
    my ($self) = @_;
    my $broken = 0;

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

    my @slivers = ();
    if ($self->SliverList(\@slivers) != 0) {
	print STDERR "Could not get sliver list for $self\n";
	return -1;
    }
    foreach my $sliver (@slivers) {
	if ($sliver->status() eq "broken") {
206
	    print STDERR "Could not delete 'broken' $sliver from $self\n";
207
	    $broken++;
208
	    last;
209 210 211 212 213
	}
	if ($sliver->Delete() != 0) {
	    print STDERR "Could not delete $sliver from $self\n";
	    $sliver->SetStatus("broken");
	    $broken++;
214
	    last;
215 216 217 218 219 220 221 222 223 224 225 226 227 228 229
	}
    }
    return -1
	if ($broken);
    
    my $idx  = $self->idx();
    my $uuid = $self->uuid();

    DBQueryWarn("delete from geni_credentials where this_uuid='$uuid'")
	or return -1;
    DBQueryWarn("delete from geni_certificates where uuid='$uuid'")
	or return -1;
    DBQueryWarn("delete from geni_aggregates where idx='$idx'")
	or return -1;
    
230 231 232
    # Delete from cache. 
    delete($aggregates{$idx});

233 234 235
    return 0;
}

236 237 238 239 240 241 242
#
# Cons up an hrn.
#
sub hrn($)
{
    my ($self) = @_;

243 244 245 246 247
    my $hrn = field($self, "hrn");

    if (defined($hrn) && $hrn ne "") {
	return $hrn;
    }
248
    return "${PGENIDOMAIN}.aggregate_" . $self->idx();
249 250
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276
#
# Look up toplevel aggregate for a locally instantiated slice. 
#
sub SliceAggregate($$)
{
    my ($class, $slice) = @_;

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

    my $query_result =
	DBQueryWarn("select idx from geni_aggregates ".
		    "where slice_uuid='$slice_uuid' and type='Aggregate'");
    return undef
	if (!$query_result);
    return undef
	if ($query_result->numrows != 1);

    my ($idx) = $query_result->fetchrow_array();
    my $aggregate = GeniAggregate->Lookup($idx);
    return undef
	if (!defined($aggregate));

    return $aggregate;
}

277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303
#
# Look up a list of aggregates for a locally instantiated slice. 
# Used by the CM.
#
sub SliceAggregates($$$)
{
    my ($class, $slice, $pref) = @_;

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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
304 305 306 307 308 309 310 311 312 313 314
#
# List of slivers for this aggregate.
#
sub SliverList($$)
{
    my ($self, $pref) = @_;
    my @result = ();
    
    return -1
	if (! (ref($self) && ref($pref)));

315 316
    my $idx  = $self->idx();
    my $uuid = $self->uuid();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
317
    my $query_result =
318 319
	DBQueryWarn("select idx from geni_slivers ".
		    "where aggregate_uuid='$uuid'");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
320 321 322 323 324 325 326 327 328 329 330
    return -1
	if (!$query_result);

    while (my ($sliver_idx) = $query_result->fetchrow_array()) {
	my $sliver = GeniSliver->Lookup($sliver_idx);
	if (!defined($sliver)) {
	    print STDERR "Could not find sliver object for $sliver_idx\n";
	    return -1;
	}
	push(@result, $sliver);
    }
331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349

    #
    # And any aggregates that are children.
    #
    $query_result =
	DBQueryWarn("select idx from geni_aggregates ".
		    "where aggregate_idx='$idx'");
    return -1
	if (!$query_result);

    while (my ($aggregate_idx) = $query_result->fetchrow_array()) {
	my $aggregate = GeniAggregate->Lookup($aggregate_idx);
	if (!defined($aggregate_idx)) {
	    print STDERR
		"Could not find aggregate object for $aggregate_idx\n";
	    return -1;
	}
	push(@result, $aggregate);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
350 351 352 353 354
    @$pref = @result;
    return 0;
    
}

355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378
#
# Set the aggregate for an aggregate.
#
sub SetAggregate($$)
{
    my ($self, $aggregate) = @_;

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

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

    return -1
	if (!DBQueryWarn("update geni_aggregates set ".
			 "  aggregate_idx='$agg_idx' ".
			 "where idx='$idx'"));
    
    $self->{'AGGREGATE'}->{'aggregate_idx'} = $agg_idx;
    $self->{'PARENT'} = $aggregate;
    return 0;
}

#
379
# Get the aggregate for an aggregate.
380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400
#
sub GetAggregate($)
{
    my ($self) = @_;

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

    return $self->{'PARENT'} if (defined($self->{'PARENT'}));
    return undef
	if (!defined($self->aggregate_idx()));

    my $aggregate = GeniAggregate->Lookup($self->aggregate_idx());
    if (!defined($aggregate)) {
	print STDERR "Could not get aggregate object associated with $self\n";
	return undef;
    }
    $self->{'PARENT'} = $aggregate;
    return $aggregate;
}

401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418
#
# Is object in the aggregate.
#
sub IsMember($$)
{
    my ($self, $object) = @_;

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

    my $aggregate = $object->GetAggregate();
    return 0
	if (!$aggregate);
    return -1
	if ($self->idx() != $aggregate->idx());
    return 1;
}

419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439
#
# Set the status for the aggregate
#
sub SetStatus($$)
{
    my ($self, $status) = @_;

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464
#
# Get the slice for the aggregate.
#
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;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482
#
# Create a signed credential for this aggregate, issued to the provided user.
# The credential will grant all permissions for now.
#
# Should we store these credentials in the DB, recording what we hand out?
#
sub NewCredential($$)
{
    my ($self, $owner) = @_;

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

    my $credential = GeniCredential->Create($self, $owner);
    if (!defined($credential)) {
	print STDERR "Could not create credential for $self, $owner\n";
	return undef;
    }
483 484 485
    if (defined($self->nickname())) {
	$credential->AddExtension("nickname", $self->nickname());
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
486 487 488 489 490 491 492 493 494 495
    if ($credential->Sign($self->GetCertificate()) != 0) {
	print STDERR "Could not sign credential for $self, $owner\n";
	return undef;
    }
    return $credential;
}

#
# Start all the slivers in the aggregate.
#
496
sub Start($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
497 498 499 500 501 502 503 504 505 506 507 508
{
    my ($self) = @_;

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

    my @slivers = ();
    if ($self->SliverList(\@slivers) != 0) {
	print STDERR "Could not get sliver list for $self\n";
	return -1;
    }
    foreach my $sliver (@slivers) {
509
	if ($sliver->Start() != 0) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
510 511 512 513 514 515 516
	    print STDERR "Could not start $sliver in $self\n";
	    next;
	}
    }
    return 0;
}

517 518 519
#
# Provision all the slivers in the aggregate.
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
520
sub Provision($;$)
521
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
522
    my ($self, $extraargs) = @_;
523 524 525 526 527 528 529 530 531 532

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

    my @slivers = ();
    if ($self->SliverList(\@slivers) != 0) {
	print STDERR "Could not get sliver list for $self\n";
	return -1;
    }
    foreach my $sliver (@slivers) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
533
	if ($sliver->Provision($extraargs) != 0) {
534 535 536 537 538 539 540
	    print STDERR "Could not provision $sliver in $self\n";
	    next;
	}
    }
    return 0;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
541 542 543 544 545 546 547 548 549 550 551 552 553 554 555
#
# Unprovision all the slivers in the aggregate.
#
sub UnProvision($)
{
    my ($self) = @_;

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

    my @slivers = ();
    if ($self->SliverList(\@slivers) != 0) {
	print STDERR "Could not get sliver list for $self\n";
	return -1;
    }
556 557 558 559 560

    #
    # Might be an aggregate that includes link aggregates. Lets do those
    # first to avoid work when tearing down the nodes.
    #
561 562
    my @links = ();
    my @nodes = ();
563

Leigh B. Stoller's avatar
Leigh B. Stoller committed
564
    foreach my $sliver (@slivers) {
565 566 567
	if (ref($sliver) eq "GeniAggregate::Link" ||
	    ref($sliver) eq "GeniAggregate::Tunnel") {
	    push(@links, $sliver);
568
	}
569 570 571 572 573 574 575 576 577
	elsif (ref($sliver) eq "GeniAggregate") {
	    # Not really a node, but a sub aggregate. 
	    unshift(@nodes, $sliver);
	}
	elsif (ref($sliver) eq "GeniSliver::Node") {
	    push(@nodes, $sliver);
	}
    }
    foreach my $sliver (@links) {
578 579 580 581 582 583
	if ($sliver->UnProvision() != 0) {
	    print STDERR "Could not unprovision $sliver in $self\n";
	    $sliver->SetStatus("broken");
	    next;
	}
    }
584
    foreach my $sliver (@nodes) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
585 586
	if ($sliver->UnProvision() != 0) {
	    print STDERR "Could not unprovision $sliver in $self\n";
587
	    $sliver->SetStatus("broken");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
588 589 590 591 592 593
	    next;
	}
    }
    return 0;
}

594
############################################################################
Leigh B. Stoller's avatar
Leigh B. Stoller committed
595
#
596
# Link aggregates need special handling.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
597
#
598 599 600 601 602 603 604 605 606 607 608 609
package GeniAggregate::Link;
use vars qw(@ISA);
@ISA = "GeniAggregate";

use GeniDB;
use GeniSlice;
use GeniCredential;
use GeniCertificate;
use GeniAggregate;
use Experiment;
use Interface;

610
sub Create($$$)
611
{
612 613 614 615 616
    my ($class, $slice, $owner, $linkname) = @_;

    #
    # Form an hrn using the slicename and linkname
    #
617
    my $hrn = "${PGENIDOMAIN}." . $slice->slicename() . "." . $linkname;
618

619
    return GeniAggregate->Create($slice, $owner, "Link", $hrn, $linkname);
620 621 622 623 624
}

#
# Provision all the slivers in the aggregate.
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
625
sub Provision($;$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
626
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
627
    my ($self, $extraargs) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
628 629 630 631 632 633 634 635 636

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

    my @slivers = ();
    if ($self->SliverList(\@slivers) != 0) {
	print STDERR "Could not get sliver list for $self\n";
	return -1;
    }
637 638 639 640 641 642 643 644 645 646 647 648

    my $experiment = Experiment->Lookup($self->slice_uuid());
    if (!defined($experiment)) {
	print STDERR "Could not map $self to its experiment\n";
	return -1;
    }

    my $vlan = VLan->Create($experiment, $self->uuid());
    if (!defined($vlan)) {
	print STDERR "Could not create vlan for $self\n";
	goto bad;
    }
649 650

    foreach my $sliver (@slivers) {
651
	my $interface = Interface->LookupByUUID($sliver->uuid());
652 653 654 655 656 657 658 659
	if (! defined($interface)) {
	    print STDERR "Could not map $sliver to its interface object\n";
	    goto bad;
	}
	if (! $vlan->AddMember($interface->node_id(), $interface->iface())) {
	    print STDERR "$self: Could not add $interface to $vlan\n";
	    goto bad;
	}
660
    }
661
    if ($vlan->Instantiate(1) != 0) {
662 663
	print STDERR "$self: Could not instantiate $vlan on switches\n";
	goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
664
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
665
    $self->SetStatus("ready");
666 667 668
    return 0;

  bad:
669
    $vlan->UnInstantiate(1)
670 671 672
	if (defined($vlan));
    $vlan->Destroy()
	if (defined($vlan));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
673
    return -1
674
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
675

676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695
#
# Unprovision all the slivers in the aggregate.
#
sub UnProvision($)
{
    my ($self) = @_;

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

    my @slivers = ();
    if ($self->SliverList(\@slivers) != 0) {
	print STDERR "Could not get sliver list for $self\n";
	return -1;
    }
    my $experiment = Experiment->Lookup($self->slice_uuid());
    if (!defined($experiment)) {
	print STDERR "Could not map $self to its experiment\n";
	return -1;
    }
696

697 698
    my $vlan = VLan->Lookup($experiment, $self->uuid());
    if (! defined($vlan)) {
699 700
	print STDERR "No vlan associated with $self\n";
	return 0;
701
    }
702
    if ($vlan->UnInstantiate(1) != 0) {
703 704 705 706 707 708 709
	print STDERR "Could not uninstantiate $vlan\n";
	return -1;
    }
    if ($vlan->Destroy() != 0) {
	print STDERR "Could not destroy $vlan\n";
	return -1;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
710 711 712
    return 0;
}

713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739
#
# Nothing to do yet.
#
sub Start($)
{
    my ($self) = @_;

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

    return 0;
}

#
# Nothing to do yet.
#
sub Stop($)
{
    my ($self) = @_;

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

    return 0;
}


Leigh B. Stoller's avatar
Leigh B. Stoller committed
740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775
############################################################################
#
# Tunnel aggregates need special handling too
#
package GeniAggregate::Tunnel;
use vars qw(@ISA);
@ISA = "GeniAggregate";

use GeniDB;
use GeniSlice;
use GeniCredential;
use GeniCertificate;
use GeniRegistry;
use GeniAggregate;
use Experiment;
use Interface;
use Data::Dumper;

sub Create($$$$$$)
{
    my ($class, $slice, $owner, $node1sliver, $node2sliver, $rspec) = @_;
    my $clearinghouse;

    my $linkname = $rspec->{'nickname'};
    return undef
	if (!defined($linkname));

    my $experiment = Experiment->Lookup($slice->uuid());
    if (!defined($experiment)) {
	print STDERR "Could not map $slice to its experiment\n";
	return -1;
    }

    #
    # Form an hrn using the slicename and linkname
    #
776
    my $hrn = "${PGENIDOMAIN}." . $slice->slicename() . "." . $linkname;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828

    my $aggregate = GeniAggregate->Create($slice, $owner, "Tunnel",
					  $hrn, $linkname);
    goto bad
	if (!defined($aggregate));

    #
    # Create a tunnel entry in the lans table.
    #
    my $tunnel = Tunnel->Create($experiment, $aggregate->uuid(), "", "gre");
    if (!defined($tunnel)) {
	print STDERR "Could not create tunnel entry in lans table\n";
	return undef;
    }

    my $node1ref = (@{$rspec->{'linkendpoints'}})[0];
    my $node2ref = (@{$rspec->{'linkendpoints'}})[1];

    # These are the ips of the tunnel.
    my $ip1      = $node1ref->{'tunnel_ip'};
    my $ip2      = $node2ref->{'tunnel_ip'};
    my $ctrlip1;
    my $ctrlip2;
    my $iface1;
    my $iface2;

    # We need the control network addresses, but it is possible that
    # one of the nodes is not on this testbed.
    if (defined($node1sliver)) {
	my $node1 = Node->Lookup($node1ref->{'node_uuid'});
	my $interface = Interface->LookupControl($node1);
	goto bad
	    if (!defined($interface));
	$ctrlip1 = $interface->IP();
	$iface1  = $tunnel->AddMember($node1);
	if (!defined($iface1)) {
	    print STDERR "Could not add $node1 to $tunnel\n";
	    goto bad;
	}
    }
    else {
	#
	# Need to ask the clearinghouse where this node comes from.
	#
	$clearinghouse = GeniRegistry::ClearingHouse->Create();
	
	my $blob;
	if ($clearinghouse->Resolve($node1ref->{'node_uuid'},
				    "Component", \$blob) != 0) {
	    print STDERR "Could not lookup node at clearinghouse\n";
	    goto bad;
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
829 830
	
	my $certificate = GeniCertificate->LoadFromString($blob->{'gid'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
831 832 833 834 835
	goto bad
	    if (!defined($certificate));
	
	my $component = GeniComponent->Lookup($certificate->uuid());
	if (!defined($component)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
836
	    $component = GeniComponent->CreateFromCertificate($certificate);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885
	    if (!defined($component)) {
		print STDERR "Could not create component from $certificate\n";
		goto bad;
	    }
	}
	my $credential = GeniRegistry::Client->CreateCredential($component);
	if (!defined($credential)) {
	    print STDERR "Could not create a credential for $component\n";
	    goto bad;

	}
	my $registry = GeniRegistry::Client->Create($component, undef,
						    $credential);
	if (!defined($registry)) {
	    print STDERR "Could not create a registry client for $component\n";
	    goto bad;
	}
	$registry->Resolve($node1ref->{'node_uuid'}, "Node", \$blob);

	foreach my $ref (@{ $blob->{'interfaces'} }) {
	    $ctrlip1 = $ref->{'IP'}
	        if ($ref->{'role'} eq "ctrl");
	}
    }
    if (defined($node2sliver)) {
	my $node2 = Node->Lookup($node2ref->{'node_uuid'});
	my $interface = Interface->LookupControl($node2);
	goto bad
	    if (!defined($interface));
	$ctrlip2 = $interface->IP();
	$iface2  = $tunnel->AddMember($node2);
	if (!defined($iface2)) {
	    print STDERR "Could not add $node2 to $tunnel\n";
	    goto bad;
	}
    }
    else {
	#
	# Need to ask the clearinghouse where this node comes from.
	#
	$clearinghouse = GeniRegistry::ClearingHouse->Create()
	    if (!defined($clearinghouse));
	
	my $blob;
	if ($clearinghouse->Resolve($node2ref->{'node_uuid'},
				    "Component", \$blob) != 0) {
	    print STDERR "Could not lookup node at clearinghouse\n";
	    goto bad;
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
886
	my $certificate = GeniCertificate->LoadFromString($blob->{'gid'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
887 888 889 890 891
	goto bad
	    if (!defined($certificate));
	
	my $component = GeniComponent->Lookup($certificate->uuid());
	if (!defined($component)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
892
	    $component = GeniComponent->CreateFromCertificate($certificate);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916
	    if (!defined($component)) {
		print STDERR "Could not create component from $certificate\n";
		goto bad;
	    }
	}
	my $credential = GeniRegistry::Client->CreateCredential($component);
	if (!defined($credential)) {
	    print STDERR "Could not create a credential for $component\n";
	    goto bad;

	}
	my $registry = GeniRegistry::Client->Create($component, undef,
						    $credential);
	if (!defined($registry)) {
	    print STDERR "Could not create a registry client for $component\n";
	    goto bad;
	}
	$registry->Resolve($node2ref->{'node_uuid'}, "Node", \$blob);

	foreach my $ref (@{ $blob->{'interfaces'} }) {
	    $ctrlip2 = $ref->{'IP'}
	        if ($ref->{'role'} eq "ctrl");
	}
    }
917
    # print STDERR "$ip1, $ip2, $ctrlip1, $ctrlip2\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017

    if (defined($iface1)) {
	$iface1->SetAttribute("tunnel_ip", $ip1);
	$iface1->SetAttribute("tunnel_peerip", $ip2);
	$iface1->SetAttribute("tunnel_srcip", $ctrlip1);
	$iface1->SetAttribute("tunnel_dstip", $ctrlip2);
	$iface1->SetAttribute("tunnel_ipmask", "255.255.255.0");
	$iface1->SetAttribute("tunnel_lan", $linkname);
	$iface1->SetAttribute("tunnel_unit", $iface1->memberid());
	$iface1->SetAttribute("tunnel_style", "gre");
    }
    if (defined($iface2)) {
	$iface2->SetAttribute("tunnel_ip", $ip2);
	$iface2->SetAttribute("tunnel_peerip", $ip1);
	$iface2->SetAttribute("tunnel_srcip", $ctrlip2);
	$iface2->SetAttribute("tunnel_dstip", $ctrlip1);
	$iface2->SetAttribute("tunnel_ipmask", "255.255.255.0");
	$iface2->SetAttribute("tunnel_lan", $linkname);
	$iface2->SetAttribute("tunnel_unit", $iface2->memberid());
	$iface2->SetAttribute("tunnel_style", "gre");
    }
    return $aggregate;

  bad:
    $tunnel->Destroy()
	if (defined($tunnel));
    $aggregate->Delete()
	if (defined($aggregate));
    return undef;
}

#
# All the work done above.
#
sub Provision($)
{
    my ($self) = @_;

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

    $self->SetStatus("ready");
    return 0;
}

#
# Destroy the underlying tunnel in the lans table.
#
sub UnProvision($)
{
    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;
    }

    my $tunnel = Tunnel->Lookup($experiment, $self->uuid());
    if (! defined($tunnel)) {
	print STDERR "No tunnel associated with $self\n";
	return 0;
    }
    if ($tunnel->Destroy() != 0) {
	print STDERR "Could not destroy $tunnel\n";
	return -1;
    }
    return 0;
}

#
# Nothing to do yet.
#
sub Start($)
{
    my ($self) = @_;

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

    return 0;
}

#
# Nothing to do yet.
#
sub Stop($)
{
    my ($self) = @_;

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

    return 0;
}


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