GeniCMV2.pm.in 173 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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "info" ) or
	return GeniResponse->Create