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

#
# The server side of the CM interface on remote sites. Also communicates
# with the GMC interface at Geni Central as a client.
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

40 41
@ISA    = qw(Exporter);
@EXPORT = qw();
42 43 44 45 46 47 48

# Must come after package declaration!
use GeniDB;
use GeniResponse;
use GeniTicket;
use GeniCredential;
use GeniCertificate;
49
use GeniComponent;
50 51 52 53
use GeniSlice;
use GeniAggregate;
use GeniSliver;
use GeniUtil;
54
use GeniCM;
55
use GeniHRN;
56
use GeniXML;
57
use GeniStitch;
58
use GeniStd;
59
use emutil;
60
use libEmulab;
61
use English;
62
use libtestbed;
63 64 65 66
use Data::Dumper;
use XML::Simple;
use Date::Parse;
use POSIX qw(strftime tmpnam);
67
use POSIX qw(setsid :sys_wait_h);
68 69
use Time::Local;
use Compress::Zlib;
70
use File::Temp qw(tempfile);
71
use MIME::Base64;
72
use Errno;
73
use List::Util qw(shuffle);
74 75 76 77 78 79 80 81 82

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
83
my $ELABINELAB     = "@ELABINELAB@";
84
my $TBBASE         = "@TBBASE@";
85
my $TBDOCBASE      = "@TBDOCBASE@";
86 87 88 89
my $CREATEEXPT     = "$TB/bin/batchexp";
my $ENDEXPT        = "$TB/bin/endexp";
my $NALLOC	   = "$TB/bin/nalloc";
my $NFREE	   = "$TB/bin/nfree";
90
my $TEVC	   = "$TB/bin/tevc";
91 92 93 94 95 96 97 98 99 100 101 102
my $AVAIL	   = "$TB/sbin/avail";
my $PTOPGEN	   = "$TB/libexec/ptopgen";
my $TBSWAP	   = "$TB/bin/tbswap";
my $SWAPEXP	   = "$TB/bin/swapexp";
my $PLABSLICE	   = "$TB/sbin/plabslicewrapper";
my $NAMEDSETUP     = "$TB/sbin/named_setup";
my $VNODESETUP     = "$TB/sbin/vnode_setup";
my $GENTOPOFILE    = "$TB/libexec/gentopofile";
my $TARFILES_SETUP = "$TB/bin/tarfiles_setup";
my $MAPPER         = "$TB/bin/mapper";
my $VTOPGEN        = "$TB/bin/vtopgen";
my $SNMPIT         = "$TB/bin/snmpit";
103 104
my $CLONEIMAGE     = "$TB/sbin/clone_image";
my $CREATEIMAGE    = "$TB/bin/create_image";
105
my $DELETEIMAGE    = "$TB/sbin/delete_image";
106 107
my $WAP            = "$TB/sbin/withadminprivs";
my $SHAREVLAN      = "$TB/sbin/sharevlan";
108
my $PANIC          = "$TB/sbin/panic";
109
my $XMLLINT	   = "/usr/local/bin/xmllint";
110
my $PRERENDER      = "$TB/libexec/vis/prerender";
111 112
my $IMPORTER       = "$TB/sbin/image_import";
my $POSTIMAGEDATA  = "$TB/sbin/protogeni/postimagedata";
113
my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";
114 115
# Just one of these, at Utah.
my $GENICH_PEMFILE = "@prefix@/etc/genich.pem";
116
my $WITHPROVENANCE = @IMAGEPROVENANCE@;
117
my $PROTOGENI_LOCALUSER = @PROTOGENI_LOCALUSER@;
118
my $API_VERSION    = 2;
119 120 121 122 123 124 125 126

#
# Tell the client what API revision we support.  The correspondence
# between revision numbers and API features is to be specified elsewhere.
# No credentials are required.
#
sub GetVersion()
{
127 128
    my @input_rspec_versions = ( "0.1", "0.2", "2", "3", "PG 0.1", "PG 0.2", "PG 2" );
    my @ad_rspec_versions = ( "0.1", "0.2", "2", "3", "PG 0.1", "PG 0.2", "PG 2" );
Gary Wong's avatar
Gary Wong committed
129 130 131
    my $blob = {
	"api" => $API_VERSION,
	"level" => 1,
132
	"input_rspec" => \@input_rspec_versions,
133
	"output_rspec" => "2",
134
	"ad_rspec" => \@ad_rspec_versions
Gary Wong's avatar
Gary Wong committed
135
    };
136
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
137 138 139 140 141 142 143 144
}

#
# Respond to a Resolve request. 
#
sub Resolve($)
{
    my ($argref) = @_;
145 146
    my $credentials = $argref->{'credentials'};
    my $urn         = $argref->{'urn'};
147
    my $admin       = 0;
148
    my $isauth	    = 0;
149

150 151 152 153 154 155
    if (! (defined($credentials) && defined($urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! GeniHRN::IsValid($urn)) {
	return GeniResponse->MalformedArgsResponse("Invalid URN");
    }
156
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
157 158 159
    return $credential
	if (GeniResponse::IsResponse($credential));

160 161 162
    my ($object, $type) = LookupURN($urn);
    return $object
	if (GeniResponse::IsResponse($object));
163 164 165 166

    #
    # This is a convenience for testing. If a local user and that
    # user is an admin person, then do whatever it says. This is
167 168
    # easier then trying to do this with credential privs. But,
    # watch for credentials from authorities instead of users.
169
    #
170 171
    my (undef,$callertype,$callerid) = GeniHRN::Parse($credential->owner_urn());
    if ($callertype eq "user") {
172
	my $user = GeniCM::CreateUserFromCertificate($credential);
173 174
	if (!GeniResponse::IsResponse($user) &&
	    $user->IsLocal() && $user->admin()) {
175 176 177
	    $admin = 1;
	}
    }
178 179
    elsif ($callertype eq "authority" &&
	   ($callerid eq "cm" || $callerid eq "sa")) {
180
	$isauth = 1;
181
    }
182 183
    
    if ($type eq "node") {
184
	my $node  = $object;
185 186 187 188 189
	# Not sure about this, but I do know that Resolving a virtnode
	# is not useful right now. 
	if ($node->isvirtnode()) {
	    $node = Node->Lookup($node->phys_nodeid());
	}
190
	my $rspec = GeniCM::GetAdvertisement(0, $node->node_id(), "0.1", undef);
191
	if (! defined($rspec)) {
192
	    print STDERR "Could not get advertisement for $node!\n";
193
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
194
					"Error getting advertisement");
195
	}
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231
	my $me = GeniAuthority->Lookup($ENV{'MYURN'});
	if (!defined($me)) {
	    print STDERR
		"Could not find local authority object for $ENV{'MYURN'}\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Error getting advertisement");
	}
	my $myurn = GeniHRN::Generate($OURDOMAIN, "node", $node->node_id());
	my $myhrn = "${PGENIDOMAIN}." . $node->node_id();

	#
	# See if the component object exists; if not create it.
	#
	my $component = GeniComponent->Lookup($node->uuid());
	if (!defined($component)) {
	    my $certificate = GeniCertificate->Lookup($node->uuid());
	    if (!defined($certificate)) {
		$certificate =
		    GeniCertificate->Create({'urn'  => $myurn,
					     'hrn'  => $myhrn,
					     'email'=> $TBOPS,
					     'uuid' => $node->uuid(),
					     'url'  => $me->url()});
		if (!defined($certificate)) {
		    print STDERR "Could not generate certificate for $node\n";
		    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Error getting advertisement");
		}
	    }
	    $component = GeniComponent->Create($certificate, $me);
	    if (!defined($component)) {
		print STDERR "Could not create component for $node\n";
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Error getting advertisement");
	    }
	}
232
	# Return a blob.
233
	my $blob = { "hrn"          => $myhrn,
234 235
		     "uuid"         => $node->uuid(),
		     "role"	    => $node->role(),
236 237
		     "hostname"     =>
			 GeniUtil::FindHostname($node->node_id()),
238 239
		     "physctrl"     => 
			 Interface->LookupControl($node->phys_nodeid())->IP(),
240 241 242 243
		     "urn"          => $myurn,
		     "rspec"        => $rspec,
		     "url"          => $me->url(),
		     "gid"          => $component->cert(),
244 245 246 247
		   };

	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
248
    if ($type eq "slice") {
249 250
	my $slice = $object;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
251 252 253 254
	#
	# In this implementation, the caller must hold a valid slice
	# credential for the slice being looked up. 
	#
255 256
	if (! ($isauth || $admin ||
	       $slice->urn() eq $credential->target_urn())) {
257 258
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"No permission to resolve $slice\n");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
259 260 261 262 263 264
	}
	# Return a blob.
	my $blob = { "urn"          => $urn };

	my $aggregate = GeniAggregate->SliceAggregate($slice);
	if (defined($aggregate)) {
265
	    $blob->{'sliver_urn'} = $aggregate->urn();
266 267 268 269
	    my $manifest = $aggregate->GetManifest(1);
	    if (defined($manifest)) {
		$blob->{'manifest'}   = $manifest;
	    }
270 271 272 273 274 275 276 277 278 279 280
	    # For key bindings.
	    my $slice_experiment = $slice->GetExperiment();
	    if (!defined($slice_experiment)) {
		print STDERR "*** No Experiment for $slice\n";
	    }
	    else {
		my $bindings;
		if ($slice_experiment->NonLocalUsers(\$bindings)) {
		    print STDERR "*** No bindings for $slice_experiment\n";
		}
		elsif (@{ $bindings }) {
281
		    $blob->{'users'} = $bindings;
282 283
		}
	    }
284 285 286
	    $blob->{'public_url'} =
		"$TBDOCBASE/showslicepub.php?publicid=" . $slice->publicid()
		if (defined($slice->publicid()));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
287 288 289
	}
	my $ticket = GeniTicket->SliceTicket($slice);
	if (defined($ticket)) {
290
	    $blob->{'ticket_urn'} = $ticket->urn();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
291 292 293 294
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "sliver") {
295
	my $sliver = $object;
296 297 298
	my $slice  = $sliver->GetSlice();
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!defined($slice));
299

Leigh B. Stoller's avatar
Leigh B. Stoller committed
300 301 302 303
	#
	# In this implementation, the caller must hold a valid slice
	# or sliver credential for the slice being looked up. 
	#
304
	if (! ($admin || $isauth ||
305
	       $sliver->urn() eq $credential->target_urn() ||
306 307 308 309 310
	       $slice->urn() eq $credential->target_urn())) {
	    print STDERR $sliver->urn() . "\n";
	    print STDERR $slice->urn() . "\n";
	    print STDERR $credential->target_urn() . "\n";
	    print STDERR $ENV{'MYURN'} . "\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
311 312
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN);
	}
313 314
	my $manifest = $sliver->GetManifest(1);
	if (!defined($manifest)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
315 316 317 318 319 320
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	# Return a blob.
	my $blob = { "urn"          => $urn,
		     "manifest"     => $manifest,
		 };
321 322 323 324
	$blob->{'public_url'} =
	    "$TBDOCBASE/showslicepub.php?publicid=" . $slice->publicid()
	    if (defined($slice->publicid()));
	
325 326 327 328 329 330 331 332 333 334 335
	# For key bindings.
	my $slice_experiment = $slice->GetExperiment();
	if (!defined($slice_experiment)) {
	    print STDERR "*** No Experiment for $slice\n";
	}
	else {
	    my $bindings;
	    if ($slice_experiment->NonLocalUsers(\$bindings)) {
		print STDERR "*** No bindings for $slice_experiment\n";
	    }
	    elsif (@{ $bindings }) {
336
		$blob->{'users'} = $bindings;
337 338
	    }
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
339 340 341
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "ticket") {
342 343
	my $ticket = $object;

Leigh B. Stoller's avatar
Leigh B. Stoller committed
344 345 346 347
	#
	# In this implementation, the caller must hold a valid slice
	# or sliver credential to get the ticket.
	#
348
	my $slice = GeniSlice->Lookup($ticket->slice_urn());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
349 350 351 352
	if (!defined($slice)) {
	    print STDERR "Could not find slice for $ticket\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
353
	if (! ($admin || $slice->urn() eq $credential->target_urn())) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
354 355 356 357 358
	    #
	    # See if its the sliver credential. 
	    #
	    my $aggregate = GeniAggregate->SliceAggregate($slice);
	    if (!defined($aggregate) ||
359
		$aggregate->urn() ne $credential->target_urn()) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
360 361 362 363 364
		return GeniResponse->Create(GENIRESPONSE_FORBIDDEN());
	    }
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $ticket->asString());
    }
365 366
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED, undef,
				"Cannot resolve $type at this authority");
367 368 369 370 371 372 373 374
}

#
# Discover resources on this component, returning a resource availablity spec
#
sub DiscoverResources($)
{
    my ($argref) = @_;
375 376 377
    my $credentials = $argref->{'credentials'};
    my $available   = $argref->{'available'} || 0;
    my $compress    = $argref->{'compress'} || 0;
378
    my $version     = $argref->{'rspec_version'} || undef;
379 380 381 382

    if (! (defined($credentials))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
383 384 385 386
    my ($credential,$speaksfor,@morecreds) =
	GeniStd::CheckCredentials($credentials);
    return GeniResponse->MalformedArgsResponse("Missing arguments")
	if (!defined($credential));
387 388
    return $credential
	if (GeniResponse::IsResponse($credential));
389

390
    return GeniCM::DiscoverResourcesAux($available, $compress,
391
        $version, [$credential, @morecreds]);
392 393 394 395 396 397 398 399
}

#
# Create a Sliver.
#
sub CreateSliver($)
{
    my ($argref) = @_;
400 401 402 403 404
    my $slice_urn    = $argref->{'slice_urn'};
    my $rspecstr     = $argref->{'rspec'};
    my $credentials  = $argref->{'credentials'};
    my $keys         = $argref->{'keys'};
    my $impotent     = $argref->{'impotent'} || 0;
405
    my $usetracker   = $argref->{'usetracker'} || 0;
406 407
    require Node;
    require Experiment;
408 409
    require libtestbed;
    require libaudit;
410

411
    # For now, I am not worrying about the slice_urn argument.
412 413
    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($rspecstr))) {
414 415
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
416 417 418 419 420 421
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in rspec");
    }
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
422 423
    my ($credential,$speaksfor,@morecreds) =
	GeniStd::CheckCredentials($credentials);
424 425
    return $credential
	if (GeniResponse::IsResponse($credential));
426

427 428
    main::AddLogfileMetaData("slice_urn", $slice_urn);
    
429 430 431 432 433 434 435
    #
    # In this implementation, the user must provide a slice credential,
    # so we ignore the slice_urn. For CreateSliver(), the slice must not
    # be instantiated.
    #
    my ($slice,$aggregate) = Credential2SliceAggregate($credential);
    if (defined($slice)) {
436 437 438
	return $slice
	    if (GeniResponse::IsResponse($slice));

439 440 441 442
	if ($slice_urn ne $slice->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"Credential does not match the URN");
	}
443
	main::AddLogfileMetaDataFromSlice($slice);
444
	
445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460
	#
	# Watch for a placeholder slice and update it.
	#
	if ($slice->isplaceholder()) {
	    if ($slice->Lock() != 0) {
		return GeniResponse->BusyResponse();
	    }
	    #
	    # Confirm that the slice certificate is the same.
	    #
	    if ($slice->cert() ne $credential->target_cert()->cert()) {
		$slice->UnLock();
		return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					    "Slice certificate mismatch");
	    }
	    my $user =
461
		GeniCM::CreateUserFromCertificate($credential);
462
	    if (GeniResponse::IsResponse($user)) {	    
463
		$slice->UnLock();
464
		return $user;
465 466 467 468 469 470 471 472
	    }
	    if ($slice->ConvertPlaceholder($user) != 0) {
		$slice->UnLock();
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Could not convert placeholder");
	    }
	    $slice->UnLock();
	}
473 474 475 476 477
	if (defined($aggregate)) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					"Must delete existing slice first");
	}
    }
478
    my $rspec = GeniCM::GetTicketAux($credential, $rspecstr,
479
				     0, $impotent, 1, 0, $usetracker,
480
				     undef, $speaksfor, @morecreds);
481 482 483
    return $rspec
	if (GeniResponse::IsResponse($rspec));

Leigh B Stoller's avatar
Leigh B Stoller committed
484
    $slice = GeniSlice->Lookup($credential->target_urn());
485 486 487 488
    if (!defined($slice)) {
	print STDERR "CreateSliver: Could not find slice for $credential\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,"Internal Error");
    }
489
    main::AddLogfileMetaDataFromSlice($slice);
490

491 492 493 494 495 496 497 498 499 500 501 502
    #
    # If we got a cert/key, record them for the slice. This is a
    # generic openssl key/cert that is stored on the nodes (and from
    # which an ssh key pair can be derived).
    #
    if (exists($argref->{'certificate'}) || exists($argref->{'key'})) {
	$slice->AddGenericCert((exists($argref->{'certificate'}) ?
				$argref->{'certificate'} : undef),
			       (exists($argref->{'key'}) ?
				$argref->{'key'} : undef));
    }

503 504 505 506
    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();

507 508
    my $response = GeniCM::SliverWorkAux($credential, $rspec,
					 $keys, 0, $impotent, 1, 0, $speaksfor);
509

510 511 512 513 514 515 516
    if (GeniResponse::IsError($response)) {
	#
	# We have to make sure there is nothing left over since there
	# is no actual ticket, so the resources will not get cleaned
	# up by the daemon. This is mostly cause I am reaching into
	# the V1 code, and its messy.
	#
517
	$slice = GeniSlice->Lookup($credential->target_urn());
518
	if (defined($slice)) {
519 520 521 522 523
	    if ($slice->Lock() != 0) {
		print STDERR
		    "CreateSliver: Could not lock $slice before delete\n";
		return $response;
	    }
524 525
	    GeniCM::CleanupDeadSlice($slice, 1);
	}
526
	return $response;
527
    }
528
    my ($sliver_credential) = @{ $response->{'value'} };
529

530 531 532
    #
    # Leave the slice intact on error, so we can go look at it. 
    #
533
    if ($slice->WaitForLock(30) != 0) {
534 535 536 537
	print STDERR "CreateSliver: Could not lock $slice before start\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Internal Error");
    }
538
    $aggregate = GeniAggregate->SliceAggregate($slice);
539 540 541 542 543
    if (!defined($aggregate)) {
	print STDERR "CreateSliver: Could not find aggregate for $slice\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Internal Error");
    }
544 545 546
    # We get the manifest from the aggregate object, so that the
    # expiration goes in.
    my $sliver_manifest = $aggregate->GetManifest(1);
547

548 549
    #
    # At this point we want to return and let the startsliver proceed
550
    # in the background. Parent never returns, just the child.
551
    #
552
    my $mypid = main::WrapperFork();
553 554 555 556
    if ($mypid) {
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    [$sliver_credential, $sliver_manifest]);
    }
557

558 559 560 561
    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();

562 563 564 565 566 567 568
    #
    # The callee might also do a wrapper fork, so remember our PID
    # to make sure we unlock properly in only the parent side of the
    # fork. Child runs with slice unlocked for now. 
    #
    $mypid = $PID;
    
569
    if ($aggregate->Start($API_VERSION) != 0) {
570 571 572 573 574 575 576
	if ($PID == $mypid) {
	    $slice->UnLock();
	    print STDERR "Could not start sliver.\n";
	}
	else {
	    print STDERR "Error waiting for nodes.\n";
	}
577
	return -1;
578
    }
579 580 581
    if ($PID == $mypid) {
	$slice->UnLock();
    }
582
    return 0;
583 584 585 586 587 588
}

#
# Delete a Sliver.
#
sub DeleteSliver($)
589 590 591 592 593 594 595 596 597 598 599 600
{
    my ($argref) = @_;
    my $sliver_urn   = $argref->{'sliver_urn'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;

    if (! (defined($credentials) && defined($sliver_urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! GeniHRN::IsValid($sliver_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
601
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
602 603 604 605 606 607 608 609
    return $credential
	if (GeniResponse::IsResponse($credential));

    #
    # In this implementation, the user must provide a slice or sliver
    # credential
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
610 611 612
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));
    
613 614 615 616 617 618 619 620 621
    if (! (defined($slice) && defined($aggregate))) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "Sliver does not exist");
    }
    if ($sliver_urn ne $aggregate->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }

622 623 624
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
625
    # If a monitor process is running, we are "busy".
626
    GeniCM::CheckMonitor($slice);
627
    if ($slice->monitor_pid()) {
628
	$slice->UnLock();
629 630
	return GeniResponse->MonitorResponse();
    }
631
    
632 633 634 635 636
    # If any slivers are imaging, then we are busy as well.
    if ($aggregate->CheckSliverStates("imaging")) {
	$slice->UnLock();
	return GeniResponse->BusyResponse();
    }
637 638 639 640
    
    main::AddLogfileMetaData("sliver_urn", $sliver_urn);
    main::AddLogfileMetaDataFromSlice($slice);
    
641 642 643 644 645
    #
    # We need this below to sign the ticket.
    #
    my $authority = GeniCertificate->LoadFromFile($EMULAB_PEMFILE);
    if (!defined($authority)) {
646
	print STDERR " Could not load $EMULAB_PEMFILE\n";
647 648 649 650 651 652
	return GeniResponse->Create(GENIRESPONSE_ERROR);
	
    }
    #
    # We need the user to sign the new ticket to. 
    #
653
    my $user = GeniCM::CreateUserFromCertificate($credential);
654 655
    return $user
	if (GeniResponse::IsResponse($user));
656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674
    
    my $response = GeniCM::DeleteSliverAux($credential, $impotent, 1);
    return $response
	if (GeniResponse::IsResponse($response));

    #
    # In the v2 API, return a new ticket for the resources
    # (which were not released). As with all tickets, it will
    # expire very quickly. 
    #
    #
    # Create a new ticket from the manifest.
    #
    my $manifest = $aggregate->GetManifest(0);
    if (!defined($manifest)) {
	print STDERR "No manifest found for $aggregate\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
675 676
    my $ticket = GeniTicket->Create($authority, $user,
				    GeniXML::Serialize($manifest));
677 678 679 680 681
    if (!defined($ticket)) {
	print STDERR "Could not create new ticket for $slice\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
682
    $ticket->SetSlice($slice);
683 684
    $ticket->SetSpeaksFor($speaksfor)
	if (defined($speaksfor));
685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714
    
    if ($ticket->Sign()) {
	$ticket->Delete();
	print STDERR "Could not sign new ticket $ticket\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
    if ($ticket->Store()) {
	$ticket->Delete();
	print STDERR "Could not store new ticket $ticket\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
    my $slice_uuid = $slice->uuid();
    DBQueryWarn("delete from geni_manifests ".
		"where slice_uuid='$slice_uuid'");
    $slice->UnLock();
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $ticket->asString());

  bad:
    if (GeniCM::CleanupDeadSlice($slice) != 0) {
	print STDERR "Could not cleanup slice\n";
    }
    return $response;
}

#
# Delete a Slice
#
sub DeleteSlice($)
715 716
{
    my ($argref) = @_;
717 718 719
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;
720
    my $cancel       = 0;
721
    my $blocking     = 0;
722
    my $canceled     = 0;
723

724
    if (! (defined($credentials) && defined($slice_urn))) {
725 726
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
727 728 729
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
730 731 732
    if (exists($argref->{'blocking'}) && $argref->{'blocking'}) {
	$blocking = 1;
    }
733 734 735
    if (exists($argref->{'cancel'}) && $argref->{'cancel'}) {
	$cancel = 1;
    }
736
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
737 738
    return $credential
	if (GeniResponse::IsResponse($credential));
739

740 741 742 743
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
744 745 746
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

747 748 749 750
    if (! defined($slice)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No such slice here");
    }
751
    main::AddLogfileMetaDataFromSlice($slice);
752
    
753 754 755 756
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
757 758 759 760
    if ($slice->lockdown()) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
				    "Slice is locked down");
    }
761 762 763
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
764 765

    #
766 767 768 769 770 771 772 773
    # If a monitor process is running, then the slice is busy.
    # This might mean that the user will not be able to delete
    # the slice for a long time, but we are having problems with
    # users canceling slices before they finish setting up, and
    # the XEN client side is not handling this very well. Note that
    # the cleanupslice script calls GeniCM::CleanupDeadSlice()
    # directly, which *does* kill the monitor, so admin cleanup
    # is not affected.
774
    #
775
    GeniCM::CheckMonitor($slice);
776
    if ($slice->monitor_pid()) {
777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793
	if (!$cancel) {
	    $slice->UnLock();
	    return GeniResponse->MonitorResponse()
	}
	    
	#
	# But what we can do is set the cancel flag, which the monitor is
	# checking each time through the loop. This will cause it to stop
	# rebooting timed out nodes, and quit earlier. The caller will not
	# have to retry as long. 
	#
	my $slice_experiment = $slice->GetExperiment();
	if (defined($slice_experiment)) {
	    $slice_experiment->SetCancelFlag(1);
	}
	print STDERR "Canceling the monitor (" . $slice->monitor_pid() . ")\n";
	$canceled = 1;
794
    }
795
    # If any slivers are imaging, then we are busy as well.
796
    elsif (defined($aggregate) &&
Leigh B Stoller's avatar
Leigh B Stoller committed
797
	$aggregate->CheckSliverStates("imaging")) {
798 799 800
	$slice->UnLock();
	return GeniResponse->BusyResponse();
    }
801 802 803 804 805

    #
    # Proceed in the background. No reason to make the caller wait,
    # it takes too long.
    #
806 807 808 809 810
    if (!$blocking) {
	my $mypid = main::WrapperFork();
	if ($mypid) {
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	}
811
    }
812 813 814 815 816 817 818 819 820 821
    #
    # If we were canceled, we wait for the monitor to stop, instead of
    #
    if ($canceled) {
	while ($slice->monitor_pid()) {
	    sleep(10);
	    GeniCM::CheckMonitor($slice);
	    print STDERR "Checking to see if monitor has stopped ...\n";
	}
    }
822 823
    my $retval = GeniCM::CleanupDeadSlice($slice, 1);
    if ($retval) {
824 825 826 827 828 829
        #wvdemeer: Something went wrong deleting the slice.
        #          But we have a taken a lock above.
        #          So we need to unlock, or retry becomes impossible and the slice stays locked forever.
        #          If all is successfull, unlock is apparently not needed, I assume this is because the lock is deleted along with the slice.
        $slice->UnLock();

830 831 832
	return -1
	    if (!$blocking);
	return GeniResponse->Create(GENIRESPONSE_ERROR);
833
    }
834 835 836
    return 0
	if (!$blocking);
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
837 838 839 840 841 842 843 844
}

#
# Get a Sliver (credential)
#
sub GetSliver($)
{
    my ($argref) = @_;
845 846
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
847

848
    if (! (defined($credentials) && defined($slice_urn))) {
849 850
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
851 852 853
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
854
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
855 856 857
    return $credential
	if (GeniResponse::IsResponse($credential));

858 859 860 861
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
862 863 864
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

865
    if (! (defined($slice) && defined($aggregate))) {
866
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
867 868 869 870 871 872
				    "No slice or aggregate here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
873
    return GeniCM::GetSliverAux($credential);
874 875 876
}

#
877
# Start a sliver (not sure what this means yet, so reboot for now).
878
#
879
sub StartSliver($)
880 881
{
    my ($argref) = @_;
882
    my $slice_urn    = $argref->{'slice_urn'};
883
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
884
    my $credentials  = $argref->{'credentials'};
885
    my $manifest     = $argref->{'manifest'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
886
    
887 888
    return SliverAction("start",
			$slice_urn, $sliver_urns, $credentials, $manifest);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
889 890 891 892 893 894
}

sub StopSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
895
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
896 897
    my $credentials  = $argref->{'credentials'};

898 899
    return SliverAction("stop",
			$slice_urn, $sliver_urns, $credentials, undef);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
900 901 902 903 904 905
}

sub RestartSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
906
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
907
    my $credentials  = $argref->{'credentials'};
908
    my $manifest     = $argref->{'manifest'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
909

910 911
    return SliverAction("restart",
			$slice_urn, $sliver_urns, $credentials, $manifest);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
912
}
913

914 915 916 917 918 919 920 921 922 923 924
sub ReloadSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
    my $credentials  = $argref->{'credentials'};

    return SliverAction("reload",
			$slice_urn, $sliver_urns, $credentials, undef);
}

925
sub SliverAction($$$$$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
926
{
927
    my ($action, $slice_urn, $sliver_urns, $credentials, $manifest) = @_;
928
    my $response;
929
    my $isasync = 0;
930

931 932
    if (! (defined($credentials) &&
	   (defined($slice_urn) || defined($sliver_urns)))) {
933 934
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
935
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
936 937 938 939 940 941 942 943
    return $credential
	if (GeniResponse::IsResponse($credential));

    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "info" ) or
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Insufficient privilege");

944 945 946 947 948 949 950 951 952
    if (defined($manifest)) {
	$manifest = GeniXML::Parse($manifest);
	if (!defined($manifest)) {
	    print STDERR "Error reading manifest\n";
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Bad manifest");
	}
    }
    
953 954 955
    #
    # For now, only allow top level aggregate or the slice
    #
956
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
957 958
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));
Srikanth's avatar
Srikanth committed
959

960 961 962 963
    #
    # I think this allows the CM to perform an action without
    # the slice credential?
    #
964 965 966 967 968
    if ( (!defined($slice)) && 
          ($credential->target_urn() =~ /\+authority\+cm$/)) {
          # administrative credentials are presented.
          my $cm_urn = GeniHRN::Generate($OURDOMAIN, "authority", "cm");
          if ($cm_urn != $credential->target_urn()) {
Srikanth's avatar
Srikanth committed
969
            return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
970 971 972 973
                      "Credential target does not match CM URN");
          }

      if (!defined($slice_urn)) {
Srikanth's avatar
Srikanth committed
974 975
          return GeniResponse->MalformedArgsResponse("Missing arguments");
      }       
976 977