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
    # Free this possibly massive XML structure, we do not need it anymore.
    undef $rspec;
559 560
    # Purge all the XML objects from the slivers, we do not need them again.
    GeniSliver->PurgeRspecs();
561

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

954 955
    if (! (defined($credentials) &&
	   (defined($slice_urn) || defined($sliver_urns)))) {
956 957
	return