GeniCMV2.pm.in 169 KB
Newer Older
1 2
#!/usr/bin/perl -wT
#
3
# Copyright (c) 2008-2017 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 qw(:POSIX);
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 108 109 110
my $CREATEDATASET  = "$TB/bin/createdataset";
my $DELETEDATASET  = "$TB/bin/deletelease";
my $EXTENDDATASET  = "$TB/bin/extendlease";
my $GRANTDATASET   = "$TB/bin/grantlease";
my $GRANTIMAGE     = "$TB/sbin/grantimage";
111 112
my $WAP            = "$TB/sbin/withadminprivs";
my $SHAREVLAN      = "$TB/sbin/sharevlan";
113
my $PANIC          = "$TB/sbin/panic";
114
my $LINKTEST       = "$TB/sbin/linktest_control";
115
my $XMLLINT	   = "/usr/local/bin/xmllint";
116
my $IMAGEINFO      = "$TB/sbin/imageinfo";
117
my $PRERENDER      = "$TB/libexec/vis/prerender";
118 119
my $IMPORTER       = "$TB/sbin/image_import";
my $POSTIMAGEDATA  = "$TB/sbin/protogeni/postimagedata";
120
my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";
121 122
# Just one of these, at Utah.
my $GENICH_PEMFILE = "@prefix@/etc/genich.pem";
123
my $WITHPROVENANCE = @IMAGEPROVENANCE@;
124
my $PROTOGENI_LOCALUSER = @PROTOGENI_LOCALUSER@;
125
my $API_VERSION    = 2;
126 127 128 129 130 131 132 133

#
# 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()
{
134 135
    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
136 137 138
    my $blob = {
	"api" => $API_VERSION,
	"level" => 1,
139
	"input_rspec" => \@input_rspec_versions,
140
	"output_rspec" => "2",
141
	"ad_rspec" => \@ad_rspec_versions
Gary Wong's avatar
Gary Wong committed
142
    };
143
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
144 145 146 147 148 149 150 151
}

#
# Respond to a Resolve request. 
#
sub Resolve($)
{
    my ($argref) = @_;
152 153
    my $credentials = $argref->{'credentials'};
    my $urn         = $argref->{'urn'};
154
    my $admin       = 0;
155
    my $isauth	    = 0;
156

157 158 159 160 161 162
    if (! (defined($credentials) && defined($urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! GeniHRN::IsValid($urn)) {
	return GeniResponse->MalformedArgsResponse("Invalid URN");
    }
163
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
164 165 166
    return $credential
	if (GeniResponse::IsResponse($credential));

167 168 169
    my ($object, $type) = LookupURN($urn);
    return $object
	if (GeniResponse::IsResponse($object));
170 171 172 173

    #
    # This is a convenience for testing. If a local user and that
    # user is an admin person, then do whatever it says. This is
174 175
    # easier then trying to do this with credential privs. But,
    # watch for credentials from authorities instead of users.
176
    #
177 178
    my (undef,$callertype,$callerid) = GeniHRN::Parse($credential->owner_urn());
    if ($callertype eq "user") {
179
	my $user = GeniCM::CreateUserFromCertificate($credential);
180 181
	if (!GeniResponse::IsResponse($user) &&
	    $user->IsLocal() && $user->admin()) {
182 183 184
	    $admin = 1;
	}
    }
185 186
    elsif ($callertype eq "authority" &&
	   ($callerid eq "cm" || $callerid eq "sa")) {
187
	$isauth = 1;
188
    }
189 190
    
    if ($type eq "node") {
191
	my $node  = $object;
192 193 194 195 196
	# 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());
	}
197
	my $rspec = GeniCM::GetAdvertisement(0, $node->node_id(), "0.1", undef);
198
	if (! defined($rspec)) {
199
	    print STDERR "Could not get advertisement for $node!\n";
200
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
201
					"Error getting advertisement");
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 232 233 234 235 236 237 238
	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");
	    }
	}
239
	# Return a blob.
240
	my $blob = { "hrn"          => $myhrn,
241 242
		     "uuid"         => $node->uuid(),
		     "role"	    => $node->role(),
243 244
		     "hostname"     =>
			 GeniUtil::FindHostname($node->node_id()),
245 246
		     "physctrl"     => 
			 Interface->LookupControl($node->phys_nodeid())->IP(),
247 248 249 250
		     "urn"          => $myurn,
		     "rspec"        => $rspec,
		     "url"          => $me->url(),
		     "gid"          => $component->cert(),
251 252 253 254
		   };

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

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

	my $aggregate = GeniAggregate->SliceAggregate($slice);
	if (defined($aggregate)) {
272
	    $blob->{'sliver_urn'} = $aggregate->urn();
273 274 275 276
	    my $manifest = $aggregate->GetManifest(1);
	    if (defined($manifest)) {
		$blob->{'manifest'}   = $manifest;
	    }
277 278 279 280 281 282 283 284 285 286 287
	    # 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 }) {
288
		    $blob->{'users'} = $bindings;
289 290
		}
	    }
291 292 293
	    $blob->{'public_url'} =
		"$TBDOCBASE/showslicepub.php?publicid=" . $slice->publicid()
		if (defined($slice->publicid()));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
294 295 296
	}
	my $ticket = GeniTicket->SliceTicket($slice);
	if (defined($ticket)) {
297
	    $blob->{'ticket_urn'} = $ticket->urn();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
298 299 300 301
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "sliver") {
302
	my $sliver = $object;
303 304 305
	my $slice  = $sliver->GetSlice();
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!defined($slice));
306

Leigh B. Stoller's avatar
Leigh B. Stoller committed
307 308 309 310
	#
	# In this implementation, the caller must hold a valid slice
	# or sliver credential for the slice being looked up. 
	#
311
	if (! ($admin || $isauth ||
312
	       $sliver->urn() eq $credential->target_urn() ||
313 314 315 316 317
	       $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
318 319
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN);
	}
320 321
	my $manifest = $sliver->GetManifest(1);
	if (!defined($manifest)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
322 323 324 325 326 327
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	# Return a blob.
	my $blob = { "urn"          => $urn,
		     "manifest"     => $manifest,
		 };
328 329 330 331
	$blob->{'public_url'} =
	    "$TBDOCBASE/showslicepub.php?publicid=" . $slice->publicid()
	    if (defined($slice->publicid()));
	
332 333 334 335 336 337 338 339 340 341 342
	# 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 }) {
343
		$blob->{'users'} = $bindings;
344 345
	    }
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
346 347 348
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "ticket") {
349 350
	my $ticket = $object;

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

#
# Discover resources on this component, returning a resource availablity spec
#
sub DiscoverResources($)
{
    my ($argref) = @_;
382 383 384
    my $credentials = $argref->{'credentials'};
    my $available   = $argref->{'available'} || 0;
    my $compress    = $argref->{'compress'} || 0;
385
    my $version     = $argref->{'rspec_version'} || undef;
386 387 388 389

    if (! (defined($credentials))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
390 391 392 393
    my ($credential,$speaksfor,@morecreds) =
	GeniStd::CheckCredentials($credentials);
    return GeniResponse->MalformedArgsResponse("Missing arguments")
	if (!defined($credential));
394 395
    return $credential
	if (GeniResponse::IsResponse($credential));
396

397
    return GeniCM::DiscoverResourcesAux($available, $compress,
398
        $version, [$credential, @morecreds]);
399 400 401 402 403 404 405 406
}

#
# Create a Sliver.
#
sub CreateSliver($)
{
    my ($argref) = @_;
407 408 409 410 411
    my $slice_urn    = $argref->{'slice_urn'};
    my $rspecstr     = $argref->{'rspec'};
    my $credentials  = $argref->{'credentials'};
    my $keys         = $argref->{'keys'};
    my $impotent     = $argref->{'impotent'} || 0;
412
    my $usetracker   = $argref->{'usetracker'} || 0;
413 414
    require Node;
    require Experiment;
415 416
    require libtestbed;
    require libaudit;
417

418
    # For now, I am not worrying about the slice_urn argument.
419 420
    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($rspecstr))) {
421 422
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
423 424 425 426 427 428
    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");
    }
429 430
    my ($credential,$speaksfor,@morecreds) =
	GeniStd::CheckCredentials($credentials);
431 432
    return $credential
	if (GeniResponse::IsResponse($credential));
433

434 435
    main::AddLogfileMetaData("slice_urn", $slice_urn);
    
436 437 438 439 440 441 442
    #
    # 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)) {
443 444 445
	return $slice
	    if (GeniResponse::IsResponse($slice));

446 447 448 449
	if ($slice_urn ne $slice->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"Credential does not match the URN");
	}
450
	main::AddLogfileMetaDataFromSlice($slice);
451
	
452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467
	#
	# 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 =
468
		GeniCM::CreateUserFromCertificate($credential);
469
	    if (GeniResponse::IsResponse($user)) {	    
470
		$slice->UnLock();
471
		return $user;
472 473 474 475 476 477 478 479
	    }
	    if ($slice->ConvertPlaceholder($user) != 0) {
		$slice->UnLock();
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Could not convert placeholder");
	    }
	    $slice->UnLock();
	}
480 481 482 483 484
	if (defined($aggregate)) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					"Must delete existing slice first");
	}
    }
485
    my $rspec = GeniCM::GetTicketAux($credential, $rspecstr,
486
				     0, $impotent, 1, 0, $usetracker,
487
				     undef, $speaksfor, @morecreds);
488 489 490
    return $rspec
	if (GeniResponse::IsResponse($rspec));

Leigh B Stoller's avatar
Leigh B Stoller committed
491
    $slice = GeniSlice->Lookup($credential->target_urn());
492 493 494 495
    if (!defined($slice)) {
	print STDERR "CreateSliver: Could not find slice for $credential\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,"Internal Error");
    }
496
    main::AddLogfileMetaDataFromSlice($slice);
497

498 499 500 501 502 503 504 505 506 507 508 509
    #
    # 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));
    }

510 511 512 513
    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();

514 515
    my $response = GeniCM::SliverWorkAux($credential, $rspec,
					 $keys, 0, $impotent, 1, 0, $speaksfor);
516

517 518 519 520 521 522 523
    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.
	#
524
	$slice = GeniSlice->Lookup($credential->target_urn());
525
	if (defined($slice)) {
526 527 528 529 530
	    if ($slice->Lock() != 0) {
		print STDERR
		    "CreateSliver: Could not lock $slice before delete\n";
		return $response;
	    }
531 532
	    GeniCM::CleanupDeadSlice($slice, 1);
	}
533
	return $response;
534
    }
535
    my ($sliver_credential) = @{ $response->{'value'} };
536

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

555 556
    #
    # At this point we want to return and let the startsliver proceed
557
    # in the background. Parent never returns, just the child.
558
    #
559
    my $mypid = main::WrapperFork();
560 561 562 563
    if ($mypid) {
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    [$sliver_credential, $sliver_manifest]);
    }
564

565 566 567 568
    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();

569 570 571 572 573 574 575
    #
    # 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;
    
576
    if ($aggregate->Start($API_VERSION) != 0) {
577 578 579 580 581 582 583
	if ($PID == $mypid) {
	    $slice->UnLock();
	    print STDERR "Could not start sliver.\n";
	}
	else {
	    print STDERR "Error waiting for nodes.\n";
	}
584
	return -1;
585
    }
586 587 588
    if ($PID == $mypid) {
	$slice->UnLock();
    }
589
    return 0;
590 591 592 593 594 595
}

#
# Delete a Sliver.
#
sub DeleteSliver($)
596 597 598 599 600 601 602 603 604 605 606 607
{
    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");
    }
608
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
609 610 611 612 613 614 615 616
    return $credential
	if (GeniResponse::IsResponse($credential));

    #
    # In this implementation, the user must provide a slice or sliver
    # credential
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
617 618 619
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));
    
620 621 622 623 624 625 626 627 628
    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");
    }

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

    #
    # 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;
    }
687 688
    my $ticket = GeniTicket->Create($authority, $user,
				    GeniXML::Serialize($manifest));
689 690 691 692 693
    if (!defined($ticket)) {
	print STDERR "Could not create new ticket for $slice\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
694
    $ticket->SetSlice($slice);
695 696
    $ticket->SetSpeaksFor($speaksfor)
	if (defined($speaksfor));
697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726
    
    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($)
727 728
{
    my ($argref) = @_;
729 730 731
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;
732
    my $cancel       = 0;
733
    my $blocking     = 0;
734
    my $canceled     = 0;
735

736
    if (! (defined($credentials) && defined($slice_urn))) {
737 738
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
739 740 741
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
742 743 744
    if (exists($argref->{'blocking'}) && $argref->{'blocking'}) {
	$blocking = 1;
    }
745 746 747
    if (exists($argref->{'cancel'}) && $argref->{'cancel'}) {
	$cancel = 1;
    }
748
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
749 750
    return $credential
	if (GeniResponse::IsResponse($credential));
751

752 753 754 755
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
756 757 758
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

759 760 761 762
    if (! defined($slice)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No such slice here");
    }
763
    main::AddLogfileMetaDataFromSlice($slice);
764
    
765 766 767 768
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
769 770 771 772
    if ($slice->lockdown()) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
				    "Slice is locked down");
    }
773 774 775
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
776 777

    #
778 779 780 781 782 783 784 785
    # 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.
786
    #
787
    GeniCM::CheckMonitor($slice);
788
    if ($slice->monitor_pid()) {
789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805
	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;
806
    }
807
    # If any slivers are imaging, then we are busy as well.
808
    elsif (defined($aggregate) &&
Leigh B Stoller's avatar
Leigh B Stoller committed
809
	$aggregate->CheckSliverStates("imaging")) {
810 811 812
	$slice->UnLock();
	return GeniResponse->BusyResponse();
    }
813 814 815 816 817

    #
    # Proceed in the background. No reason to make the caller wait,
    # it takes too long.
    #
818 819 820 821 822
    if (!$blocking) {
	my $mypid = main::WrapperFork();
	if ($mypid) {
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	}
823
    }
824 825 826 827 828 829 830 831 832 833
    #
    # 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";
	}
    }
834 835
    my $retval = GeniCM::CleanupDeadSlice($slice, 1);
    if ($retval) {
836 837 838 839 840 841
        #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();

842 843 844
	return -1
	    if (!$blocking);
	return GeniResponse->Create(GENIRESPONSE_ERROR);
845
    }
846 847 848
    return 0
	if (!$blocking);
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
849 850 851 852 853 854 855 856
}

#
# Get a Sliver (credential)
#
sub GetSliver($)
{
    my ($argref) = @_;
857 858
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
859

860
    if (! (defined($credentials) && defined($slice_urn))) {
861 862
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
863 864 865
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
866
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
867 868 869
    return $credential
	if (GeniResponse::IsResponse($credential));

870 871 872 873
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
874 875 876
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

877
    if (! (defined($slice) && defined($aggregate))) {
878
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
879 880 881 882 883 884
				    "No slice or aggregate here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
885
    return GeniCM::GetSliverAux($credential);
886 887 888
}

#
889
# Start a sliver (not sure what this means yet, so reboot for now).
890
#
891
sub StartSliver($)
892 893
{
    my ($argref) = @_;
894
    my $slice_urn    = $argref->{'slice_urn'};
895
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
896
    my $credentials  = $argref->{'credentials'};
897
    my $manifest     = $argref->{'manifest'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
898
    
899
    return SliverAction("start",
900
			$slice_urn, $sliver_urns, $credentials, $manifest, 0);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
901 902 903 904 905 906
}

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

910
    return SliverAction("stop",
911
			$slice_urn, $sliver_urns, $credentials, undef, 0);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
912 913 914 915 916 917
}

sub RestartSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
918
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
919
    my $credentials  = $argref->{'credentials'};
920
    my $manifest     = $argref->{'manifest'};
921 922
    my $asyncmode    = (exists($argref->{'asyncmode'}) ?
			$argref->{'asyncmode'} : 0);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
923

924
    return SliverAction("restart",
925 926
			$slice_urn, $sliver_urns, $credentials, $manifest,
			$asyncmode);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
927
}
928

929 930 931 932 933 934 935 936
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",
937
			$slice_urn, $sliver_urns, $credentials, undef, 0);
938 939
}

940
sub SliverAction($$$$$$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
941
{
942 943
    my ($action, $slice_urn, $sliver_urns, $credentials,
	$manifest, $asyncmode) = @_;
944
    my $response;
945
    my $isasync = 0;
946

947 948
    if (! (defined($credentials) &&
	   (defined($slice_urn) || defined($sliver_urns)))) {
949 950
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
951
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
952 953 954 955 956 957 958 959
    return $credential
	if (GeniResponse::IsResponse($credential));

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

960 961 962 963 964 965 966 967 968
    if (defined($manifest)) {
	$manifest = GeniXML::Parse($manifest);
	if (!defined($manifest)) {
	    print STDERR "Error reading manifest\n";
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Bad manifest");
	}
    }