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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

961 962 963 964 965 966