GeniCMV2.pm.in 173 KB
Newer Older
1 2
#!/usr/bin/perl -wT
#
3
# Copyright (c) 2008-2018 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

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
78
my $TBLOGS         = "@TBLOGSEMAIL@";
79 80 81 82 83
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
84
my $ELABINELAB     = "@ELABINELAB@";
85
my $TBBASE         = "@TBBASE@";
86
my $TBDOCBASE      = "@TBDOCBASE@";
87 88 89 90
my $CREATEEXPT     = "$TB/bin/batchexp";
my $ENDEXPT        = "$TB/bin/endexp";
my $NALLOC	   = "$TB/bin/nalloc";
my $NFREE	   = "$TB/bin/nfree";
91
my $TEVC	   = "$TB/bin/tevc";
92 93 94 95 96 97 98 99 100 101 102 103
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";
104 105
my $CLONEIMAGE     = "$TB/sbin/clone_image";
my $CREATEIMAGE    = "$TB/bin/create_image";
106
my $DELETEIMAGE    = "$TB/sbin/delete_image";
107 108 109 110
my $CREATEDATASET  = "$TB/bin/createdataset";
my $DELETEDATASET  = "$TB/bin/deletelease";
my $EXTENDDATASET  = "$TB/bin/extendlease";
my $GRANTDATASET   = "$TB/bin/grantlease";
111
my $APPROVEDATASET = "$TB/bin/approvelease";
112
my $GRANTIMAGE     = "$TB/sbin/grantimage";
113 114
my $WAP            = "$TB/sbin/withadminprivs";
my $SHAREVLAN      = "$TB/sbin/sharevlan";
115
my $PANIC          = "$TB/sbin/panic";
116
my $LINKTEST       = "$TB/sbin/linktest_control";
117
my $XMLLINT	   = "/usr/local/bin/xmllint";
118
my $IMAGEINFO      = "$TB/sbin/imageinfo";
119
my $PRERENDER      = "$TB/libexec/vis/prerender";
120 121
my $IMPORTER       = "$TB/sbin/image_import";
my $POSTIMAGEDATA  = "$TB/sbin/protogeni/postimagedata";
122
my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";
123 124
# Just one of these, at Utah.
my $GENICH_PEMFILE = "@prefix@/etc/genich.pem";
125
my $WITHPROVENANCE = @IMAGEPROVENANCE@;
126
my $PROTOGENI_LOCALUSER = @PROTOGENI_LOCALUSER@;
127
my $API_VERSION    = 2;
128 129 130 131 132 133 134 135

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

557 558 559
    # Free this possibly massive XML structure, we do not need it anymore.
    undef $rspec;

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

570 571 572 573
    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();

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

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

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

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

    #
    # 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;
    }
692 693
    my $ticket = GeniTicket->Create($authority, $user,
				    GeniXML::Serialize($manifest));
694 695 696 697 698
    if (!defined($ticket)) {
	print STDERR "Could not create new ticket for $slice\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
699
    $ticket->SetSlice($slice);
700 701
    $ticket->SetSpeaksFor($speaksfor)
	if (defined($speaksfor));
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 727 728 729 730 731
    
    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($)
732 733
{
    my ($argref) = @_;
734 735 736
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;
737
    my $cancel       = 0;
738
    my $blocking     = 0;
739
    my $canceled     = 0;
740

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

757 758 759 760
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
761 762 763
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

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

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

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

847 848 849
	return -1
	    if (!$blocking);
	return GeniResponse->Create(GENIRESPONSE_ERROR);
850
    }
851 852 853
    return 0
	if (!$blocking);
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
854 855 856 857 858 859 860 861
}

#
# Get a Sliver (credential)
#
sub GetSliver($)
{
    my ($argref) = @_;
862 863
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
864

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

875 876 877 878
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
879 880 881
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

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

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

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

915
    return SliverAction("stop",
916
			$slice_urn, $sliver_urns, $credentials, undef, 0);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
917 918 919 920 921 922
}

sub RestartSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
923
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
924
    my $credentials  = $argref->{'credentials'};
925
    my $manifest     = $argref->{'manifest'};
926 927
    my $asyncmode    = (exists($argref->{'asyncmode'}) ?
			$argref->{'asyncmode'} : 0);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
928

929
    return SliverAction("restart",
930 931
			$slice_urn, $sliver_urns, $credentials, $manifest,
			$asyncmode);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
932
}
933

934 935 936 937 938 939 940 941
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",
942
			$slice_urn, $sliver_urns, $credentials, undef, 0);
943 944
}

945
sub SliverAction($$$$$$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
946
{
947 948
    my ($action, $slice_urn, $sliver_urns, $credentials,
	$manifest, $asyncmode) = @_;
949
    my $response;
950
    my $isasync = 0;
951

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