GeniCMV2.pm.in 185 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 EmulabConstants;
63
use libtestbed;
64 65 66
use Data::Dumper;
use XML::Simple;
use Date::Parse;
67
use POSIX qw(strftime);
68
use POSIX qw(setsid :sys_wait_h);
69 70
use Time::Local;
use Compress::Zlib;
71
use File::Temp qw(tempfile);
72
use MIME::Base64;
73
use Errno qw(:POSIX);
74
use List::Util qw(shuffle);
75 76 77 78

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

#
# 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()
{
138 139
    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" );
140 141 142
    my $blob = {
	"api" => $API_VERSION,
	"level" => 1,
143
	"input_rspec" => \@input_rspec_versions,
144
	"output_rspec" => "2",
145
	"ad_rspec" => \@ad_rspec_versions
146
    };
147 148
    #POSIX::_exit(1);
    #sleep(30);
149
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
150 151 152 153 154 155 156 157
}

#
# Respond to a Resolve request. 
#
sub Resolve($)
{
    my ($argref) = @_;
158 159
    my $credentials = $argref->{'credentials'};
    my $urn         = $argref->{'urn'};
160
    my $admin       = 0;
161
    my $isauth	    = 0;
162

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

173 174 175
    my ($object, $type) = LookupURN($urn);
    return $object
	if (GeniResponse::IsResponse($object));
176 177 178 179

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

	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
Leigh Stoller's avatar
Leigh Stoller committed
261
    if ($type eq "slice") {
262 263
	my $slice = $object;

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

	#
	# We stored an error after a wrapperfork; return that error now.
	#
	if ($slice->async_code()) {
	    $blob->{"async_code"}   = $slice->async_code();
	    $blob->{"async_output"} = $slice->async_output();
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
	}
Leigh Stoller's avatar
Leigh Stoller committed
284 285 286

	my $aggregate = GeniAggregate->SliceAggregate($slice);
	if (defined($aggregate)) {
287
	    $blob->{'sliver_urn'} = $aggregate->urn();
288 289 290 291
	    my $manifest = $aggregate->GetManifest(1);
	    if (defined($manifest)) {
		$blob->{'manifest'}   = $manifest;
	    }
292 293 294 295 296 297 298 299 300 301 302
	    # 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 }) {
303
		    $blob->{'users'} = $bindings;
304 305
		}
	    }
306 307 308
	    $blob->{'public_url'} =
		"$TBDOCBASE/showslicepub.php?publicid=" . $slice->publicid()
		if (defined($slice->publicid()));
Leigh Stoller's avatar
Leigh Stoller committed
309 310 311
	}
	my $ticket = GeniTicket->SliceTicket($slice);
	if (defined($ticket)) {
312
	    $blob->{'ticket_urn'} = $ticket->urn();
Leigh Stoller's avatar
Leigh Stoller committed
313 314 315 316
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "sliver") {
317
	my $sliver = $object;
318 319 320
	my $slice  = $sliver->GetSlice();
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!defined($slice));
321

Leigh Stoller's avatar
Leigh Stoller committed
322 323 324 325
	#
	# In this implementation, the caller must hold a valid slice
	# or sliver credential for the slice being looked up. 
	#
326
	if (! ($admin || $isauth ||
327
	       $sliver->urn() eq $credential->target_urn() ||
328 329 330 331 332
	       $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 Stoller's avatar
Leigh Stoller committed
333 334
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN);
	}
335 336
	my $manifest = $sliver->GetManifest(1);
	if (!defined($manifest)) {
Leigh Stoller's avatar
Leigh Stoller committed
337 338 339 340 341 342
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	# Return a blob.
	my $blob = { "urn"          => $urn,
		     "manifest"     => $manifest,
		 };
343 344 345 346
	$blob->{'public_url'} =
	    "$TBDOCBASE/showslicepub.php?publicid=" . $slice->publicid()
	    if (defined($slice->publicid()));
	
347 348 349 350 351 352 353 354 355 356 357
	# 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 }) {
358
		$blob->{'users'} = $bindings;
359 360
	    }
	}
Leigh Stoller's avatar
Leigh Stoller committed
361 362 363
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "ticket") {
364 365
	my $ticket = $object;

Leigh Stoller's avatar
Leigh Stoller committed
366 367 368 369
	#
	# In this implementation, the caller must hold a valid slice
	# or sliver credential to get the ticket.
	#
370
	my $slice = GeniSlice->Lookup($ticket->slice_urn());
Leigh Stoller's avatar
Leigh Stoller committed
371 372 373 374
	if (!defined($slice)) {
	    print STDERR "Could not find slice for $ticket\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
375
	if (! ($admin || $slice->urn() eq $credential->target_urn())) {
Leigh Stoller's avatar
Leigh Stoller committed
376 377 378 379 380
	    #
	    # See if its the sliver credential. 
	    #
	    my $aggregate = GeniAggregate->SliceAggregate($slice);
	    if (!defined($aggregate) ||
381
		$aggregate->urn() ne $credential->target_urn()) {
Leigh Stoller's avatar
Leigh Stoller committed
382 383 384 385 386
		return GeniResponse->Create(GENIRESPONSE_FORBIDDEN());
	    }
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $ticket->asString());
    }
387 388
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED, undef,
				"Cannot resolve $type at this authority");
389 390 391 392 393 394 395 396
}

#
# Discover resources on this component, returning a resource availablity spec
#
sub DiscoverResources($)
{
    my ($argref) = @_;
397 398 399
    my $credentials = $argref->{'credentials'};
    my $available   = $argref->{'available'} || 0;
    my $compress    = $argref->{'compress'} || 0;
400
    my $version     = $argref->{'rspec_version'} || undef;
401 402 403 404

    if (! (defined($credentials))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
405 406 407 408
    my ($credential,$speaksfor,@morecreds) =
	GeniStd::CheckCredentials($credentials);
    return GeniResponse->MalformedArgsResponse("Missing arguments")
	if (!defined($credential));
409 410
    return $credential
	if (GeniResponse::IsResponse($credential));
411

412
    return GeniCM::DiscoverResourcesAux($available, $compress,
413
        $version, [$credential, @morecreds]);
414 415 416 417 418 419 420 421
}

#
# Create a Sliver.
#
sub CreateSliver($)
{
    my ($argref) = @_;
422 423 424 425 426
    my $slice_urn    = $argref->{'slice_urn'};
    my $rspecstr     = $argref->{'rspec'};
    my $credentials  = $argref->{'credentials'};
    my $keys         = $argref->{'keys'};
    my $impotent     = $argref->{'impotent'} || 0;
427
    my $usetracker   = $argref->{'usetracker'} || 0;
428 429 430
    my $async        = $argref->{'asyncmode'} || 0;
    my $mypid        = $PID;
    my $cachedebug   = 0;
431 432 433
    my $rspec;
    my $response;
    my $retval;
434 435
    require Node;
    require Experiment;
436 437
    require libtestbed;
    require libaudit;
438

439
    # For now, I am not worrying about the slice_urn argument.
440 441
    if (! (defined($credentials) &&
	   defined($slice_urn) && defined($rspecstr))) {
442 443
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
444 445 446 447 448 449
    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");
    }
450 451
    my ($credential,$speaksfor,@morecreds) =
	GeniStd::CheckCredentials($credentials);
452 453
    return $credential
	if (GeniResponse::IsResponse($credential));
454

455
    main::AddLogfileMetaData("slice_urn", $slice_urn);
456 457 458 459 460 461

    my $user = GeniCM::CreateUserFromCertificate($credential);
    if (GeniResponse::IsResponse($user)) {
	print STDERR "Could not create geni user for $credential\n";
	return $user;
    }
462
    
463 464 465 466 467 468 469
    #
    # 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)) {
470 471 472
	return $slice
	    if (GeniResponse::IsResponse($slice));

473 474 475 476
	if ($slice_urn ne $slice->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"Credential does not match the URN");
	}
477
	main::AddLogfileMetaDataFromSlice($slice);
478
	
479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500
	#
	# 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");
	    }
	    if ($slice->ConvertPlaceholder($user) != 0) {
		$slice->UnLock();
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Could not convert placeholder");
	    }
	    $slice->UnLock();
	}
501 502 503 504 505
	if (defined($aggregate)) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					"Must delete existing slice first");
	}
    }
506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548
    else {
	#
	# Create the slice here so we can lock it for the duration.
	#
	$slice = GeniCM::CreateSliceFromCertificate($credential, $user);
	return $slice
	    if (GeniResponse::IsResponse($slice));
    }
    main::AddLogfileMetaDataFromSlice($slice);
    
    #
    # Just in case a SliceStatus() snuck in ...
    #
    if ($slice->WaitForLock(10) != 0) {
	print STDERR "CreateSliver: Could not lock $slice\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Internal Error locking slice");
    }
    eval {$rspec = GeniCM::GetTicketAux({"credential" => $credential,
					 "rspecstr"   => $rspecstr,
					 "isupdate"   => 0,
					 "impotent"   => $impotent,
					 "v2"         => 1,
					 "level"      => 0,
					 "usetracker" => $usetracker,
					 "ticket"     => undef,
					 "speaksfor"  => $speaksfor,
					 "morecreds"  => \@morecreds,
					 "async"      => $async,
					 "slice"      => $slice}); };
    if ($@) {
	# Cons up a response for the check below.
	$rspec = GeniResponse->Create(GENIRESPONSE_SERVERERROR, undef,
				      "Internal Error: $@");
	if ($async) {
	    $slice->SetAsyncError($rspec);
	}
    }

    #
    # Slice is returned locked, but if we got an error and are going to
    # give up, then be sure to unlock it so we can kill it.
    #
549 550
    if ($async) {
	if ($PID == $mypid) {
551 552 553 554 555
	    # Did not fork or we are the parent, so we just return the response.
	    if (GeniResponse::IsResponse($rspec)) {
		$slice->UnLock();
		return $rspec;
	    }
556 557 558 559
	}
	else {
	    # Forked, return status code only for failure, otherwise
	    # we keep on going.
560 561 562 563
	    if (GeniResponse::IsError($rspec)) {
		$slice->UnLock();
		return $rspec->{'code'};
	    }
564 565 566
	}
    }
    else {
567 568 569 570 571 572 573 574
	if (GeniResponse::IsResponse($rspec)) {
	    #
	    # Depending on how this failed, we might not have a slice
	    # any more. But okay to call UnLock() on it, harmless.
	    #
	    $slice->UnLock();
	    return $rspec;
	}
575
    }
576

577 578 579 580 581 582 583 584 585 586 587 588
    #
    # 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));
    }

589 590 591
    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();
592 593 594 595
    if ($cachedebug) {
	GeniUtil::DumpCaches();
	emutil::DumpCaches();
    }
596

597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612
    eval { $response =
	       GeniCM::SliverWorkAux({"credential"  => $credential,
				      "object"      => $rspec,
				      "keys"        => $keys,
				      "isupdate"    => 0,
				      "impotent"    => $impotent,
				      "v2"          => 1,
				      "level"       => 0,
				      "speaksfor"   => $speaksfor,
				      # Currently locked, leave it locked.
				      "nolock"      => 1}); };
    if ($@) {
	# Cons up a response for the check below.
	$response = GeniResponse->Create(GENIRESPONSE_SERVERERROR, undef,
					 "Internal Error: $@");
    }
613

614 615 616 617 618 619 620
    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.
	#
621 622 623 624 625 626
	my $tmp = GeniSlice->Lookup($credential->target_urn());
	if (defined($tmp)) {
	    #
	    # If SliverWork() killed the slice, nothing more to do.
	    # Otherwise, it is still locked.
	    #
627 628 629 630 631 632 633 634 635 636 637
	    # In async mode store off error info.
	    if ($async) {
		$slice->SetAsyncError($response);
	    }
	    # In async mode we are going to leave the slice record around
	    # so the client can pickup the error info.
	    GeniCM::CleanupDeadSlice($slice, !$async);
	    # And unlock since it still exists.
	    if ($async) {
		$slice->UnLock();
	    }
638
	}
639
	return $response;
640 641
    }
    #
642
    # Slice is still locked.
643
    #
644 645 646
    my ($sliver_credential) = @{ $response->{'value'} };

    # This should never happen
647
    $aggregate = GeniAggregate->SliceAggregate($slice);
648 649 650
    if (!defined($aggregate)) {
	print STDERR "CreateSliver: Could not find aggregate for $slice\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
651
				    "Internal Error, no aggregate for slice");
652
    }
653 654 655
    # We get the manifest from the aggregate object, so that the
    # expiration goes in.
    my $sliver_manifest = $aggregate->GetManifest(1);
656

657 658
    # Free this possibly massive XML structure, we do not need it anymore.
    undef $rspec;
659 660
    # Purge all the XML objects from the slivers, we do not need them again.
    GeniSliver->PurgeRspecs();
661

662 663
    #
    # At this point we want to return and let the startsliver proceed
664
    # in the background. Parent never returns, just the child.
665
    #
666 667 668 669 670 671 672
    # But in async mode, GetTicketAux has already forked, so do not do
    # it again here. 
    #
    if (!$async) {
	$mypid = main::WrapperFork();
	if ($mypid) {
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS,
673
				    [$sliver_credential, $sliver_manifest]);
674
	}
675
    }
676

677 678 679
    # Make sure that the next phase sees all changes.
    Experiment->FlushAll();
    Node->FlushAll();
680 681 682 683
    if ($cachedebug) {
	GeniUtil::DumpCaches();
	emutil::DumpCaches();
    }
684

685 686 687 688 689 690
    #
    # 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;
691 692 693 694 695 696 697 698 699 700 701 702 703 704

    eval { $retval = $aggregate->Start($API_VERSION); };
    if ($@) {
	#
	# This will cause the slice status to be failure.
	#
	$aggregate->SetBootFailure(GENIRESPONSE_SERVERERROR);
	$aggregate->SetErrorLog("Internal Error: $@");
	$retval = -1;
    }
    if ($retval) {
	print STDERR "Could not start sliver.\n";
	
	# Only parent unlocks.
705 706 707
	if ($PID == $mypid) {
	    $slice->UnLock();
	}
708 709 710 711
	if ($cachedebug) {
	    GeniUtil::DumpCaches();
	    emutil::DumpCaches();
	}
712
	return -1;
713
    }
714
    # Only parent unlocks.
715 716 717
    if ($PID == $mypid) {
	$slice->UnLock();
    }
718 719 720 721
    if ($cachedebug) {
	GeniUtil::DumpCaches();
	emutil::DumpCaches();
    }
722
    return 0;
723 724 725 726 727 728
}

#
# Delete a Sliver.
#
sub DeleteSliver($)
729 730 731 732 733 734 735 736 737 738 739 740
{
    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");
    }
741
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
742 743 744 745 746 747 748 749
    return $credential
	if (GeniResponse::IsResponse($credential));

    #
    # In this implementation, the user must provide a slice or sliver
    # credential
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
750 751 752
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));
    
753 754 755 756 757 758 759 760 761
    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");
    }

762 763 764
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
765
    # If a monitor process is running, we are "busy".
766
    GeniCM::CheckMonitor($slice);
767
    if ($slice->monitor_pid()) {
768
	$slice->UnLock();
769 770
	return GeniResponse->MonitorResponse();
    }
771
    
772 773 774 775 776
    # If any slivers are imaging, then we are busy as well.
    if ($aggregate->CheckSliverStates("imaging")) {
	$slice->UnLock();
	return GeniResponse->BusyResponse();
    }
777 778 779 780
    
    main::AddLogfileMetaData("sliver_urn", $sliver_urn);
    main::AddLogfileMetaDataFromSlice($slice);
    
781 782 783 784 785
    #
    # We need this below to sign the ticket.
    #
    my $authority = GeniCertificate->LoadFromFile($EMULAB_PEMFILE);
    if (!defined($authority)) {
786
	print STDERR " Could not load $EMULAB_PEMFILE\n";
787
	$slice->UnLock();
788 789 790 791 792 793
	return GeniResponse->Create(GENIRESPONSE_ERROR);
	
    }
    #
    # We need the user to sign the new ticket to. 
    #
794
    my $user = GeniCM::CreateUserFromCertificate($credential);
795 796 797 798
    if (GeniResponse::IsResponse($user)) {
	$slice->UnLock();
	return $user;
    }
799 800
    
    my $response = GeniCM::DeleteSliverAux($credential, $impotent, 1);
801 802 803 804
    if (GeniResponse::IsResponse($response)) {
	$slice->UnLock();
	return $response;
    }
805 806 807 808 809 810 811 812 813 814 815 816 817 818 819

    #
    # 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;
    }
820 821
    my $ticket = GeniTicket->Create($authority, $user,
				    GeniXML::Serialize($manifest));
822 823 824 825 826
    if (!defined($ticket)) {
	print STDERR "Could not create new ticket for $slice\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
827
    $ticket->SetSlice($slice);
828 829
    $ticket->SetSpeaksFor($speaksfor)
	if (defined($speaksfor));
830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859
    
    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($)
860 861
{
    my ($argref) = @_;
862 863 864
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
    my $impotent     = $argref->{'impotent'} || 0;
865
    my $cancel       = 0;
866
    my $blocking     = 0;
867
    my $canceled     = 0;
868

869
    if (! (defined($credentials) && defined($slice_urn))) {
870 871
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
872 873 874
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
875 876 877
    if (exists($argref->{'blocking'}) && $argref->{'blocking'}) {
	$blocking = 1;
    }
878 879 880
    if (exists($argref->{'cancel'}) && $argref->{'cancel'}) {
	$cancel = 1;
    }
881
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
882 883
    return $credential
	if (GeniResponse::IsResponse($credential));
884

885 886 887 888
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
889 890 891
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

892 893 894 895
    if (! defined($slice)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No such slice here");
    }
896
    main::AddLogfileMetaDataFromSlice($slice);
897
    
898 899 900 901
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
902 903 904 905
    if ($slice->lockdown()) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
				    "Slice is locked down");
    }
906 907 908
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
909
    my $slice_experiment = $slice->GetExperiment();
910

911 912 913 914
    #
    # Do not allow a paniced slice to be terminated until the panic
    # is cleared. 
    #
915 916 917
    if (defined($slice_experiment) && 
	($slice_experiment->state() eq EXPTSTATE_PANICED() ||
	 $slice_experiment->paniced())) {
918 919 920 921 922 923
	print STDERR "Refusing to terminate a paniced experiment\n";
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_REFUSED(), undef,
			    "Refusing to terminate a paniced experiment");
    }

924
    #
925 926 927 928 929 930 931 932
    # 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.
933
    #
934
    GeniCM::CheckMonitor($slice);
935
    if ($slice->GetMonitorPid()) {
936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951
	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. 
	#
	if (defined($slice_experiment)) {
	    $slice_experiment->SetCancelFlag(1);
	}
	print STDERR "Canceling the monitor (" . $slice->monitor_pid() . ")\n";
	$canceled = 1;
952
    }
953
    # If any slivers are imaging, then we are busy as well.
954
    elsif (defined($aggregate) &&
Leigh Stoller's avatar
Leigh Stoller committed
955
	$aggregate->CheckSliverStates("imaging")) {
956 957 958
	$slice->UnLock();
	return GeniResponse->BusyResponse();
    }
959 960 961 962 963

    #
    # Proceed in the background. No reason to make the caller wait,
    # it takes too long.
    #
964 965 966 967 968
    if (!$blocking) {
	my $mypid = main::WrapperFork();
	if ($mypid) {
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	}
969
    }
970
    #
971 972
    # If we were canceled, we wait for the monitor to stop before
    # we can kill it.
973 974
    #
    if ($canceled) {
975
	while ($slice->GetMonitorPid()) {
976 977 978 979
	    sleep(10);
	    GeniCM::CheckMonitor($slice);
	    print STDERR "Checking to see if monitor has stopped ...\n";
	}
980 981 982 983
	#
	# The monitor has stopped and we have the lock. Clear the
	# cancel flag so we can actually terminate (checked in endexp).
	#
984
	$slice_experiment->SetCancelFlag(0);
985
    }
986 987
    my $retval = GeniCM::CleanupDeadSlice($slice, 1);
    if ($retval) {
988 989 990 991 992 993
        #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();

994 995 996
	return -1
	    if (!$blocking);
	return GeniResponse->Create(GENIRESPONSE_ERROR);
997
    }
998 999 1000
    return 0
	if (!$blocking);
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
1001 1002 1003 1004 1005 1006 1007 1008
}

#
# Get a Sliver (credential)
#
sub GetSliver($)
{
    my ($argref) = @_;
1009 1010
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
1011

1012
    if (! (defined($credentials) && defined($slice_urn))) {
1013 1014
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
1015 1016 1017
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
1018
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
1019 1020 1021
    return $credential
	if (GeniResponse::IsResponse($credential));

1022 1023 1024 1025
    #
    # In this implementation, the user must provide a slice credential.
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
1026 1027 1028
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

1029
    if (! (defined($slice) && defined($aggregate))) {
1030
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
1031 1032 1033 1034 1035 1036
				    "No slice or aggregate here");
    }
    if ($slice_urn ne $slice->urn()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
				    "Credential does not match the URN");
    }
1037
    return GeniCM::GetSliverAux($credential);
1038 1039 1040
}

#
1041
# Start a sliver (not sure what this means yet, so reboot for now).
1042
#
1043
sub StartSliver($)
1044 1045
{
    my ($argref) = @_;
1046
    my $slice_urn    = $argref->{'slice_urn'};
1047
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
1048
    my $credentials  = $argref->{'credentials'};
1049
    my $manifest     = $argref->{'manifest'};
1050
    
1051
    return SliverAction("start",
1052
			$slice_urn, $sliver_urns, $credentials, $manifest, 0);
1053 1054 1055 1056 1057 1058
}

sub StopSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
1059
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
1060 1061
    my $credentials  = $argref->{'credentials'};

1062
    return SliverAction("stop",
1063
			$slice_urn, $sliver_urns, $credentials, undef, 0);
1064 1065 1066 1067 1068 1069
}

sub RestartSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
1070
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
1071
    my $credentials  = $argref->{'credentials'};
1072
    my $manifest     = $argref->{'manifest'};
1073 1074
    my $asyncmode    = (exists($argref->{'asyncmode'}) ?
			$argref->{'asyncmode'} : 0);
1075

1076
    return SliverAction("restart",
1077 1078
			$slice_urn, $sliver_urns, $credentials, $manifest,
			$asyncmode);
1079
}
1080

1081 1082 1083 1084 1085 1086
sub ReloadSliver($)
{
    my ($argref) = @_;
    my $slice_urn    = $argref->{'slice_urn'};
    my $sliver_urns  = $argref->{'sliver_urns'} || $argref->{'component_urns'};
    my $credentials  = $argref->{'credentials'};
1087 1088
    my $asyncmode    = (exists($argref->{'asyncmode'}) ?
			$argref->{'asyncmode'} : 0);
1089 1090

    return SliverAction("reload",
1091 1092
			$slice_urn, $sliver_urns, $credentials, undef,
			$asyncmode);
1093 1094
}

1095
sub SliverAction($$$$$$)
1096
{
1097 1098
    my ($action, $slice_urn, $sliver_urns, $credentials,
	$manifest, $asyncmode) = @_;
1099
    my $response;
1100
    my $isasync = 0;
1101

1102 1103
    if (! (defined($credentials) &&
	   (defined($slice_urn) || defined($sliver_urns)))) {
1104 1105
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
1106
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
1107 1108 1109 1110 1111 1112 1113 1114
    return $credential
	if (GeniResponse::IsResponse($credential));

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

1115 1116 1117 1118 1119 1120 1121 1122 1123
    if (defined($manifest)) {
	$manifest = GeniXML::Parse($manifest);
	if (!defined($manifest)) {
	    print STDERR "Error reading manifest\n";
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Bad manifest");
	}
    }
    
1124 1125 1126
    #
    # For now, only allow top level aggregate or the slice
    #
1127
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
1128 1129
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));
Srikanth's avatar
Srikanth committed
1130

1131 1132 1133 1134
    #
    # I think this allows the CM to perform an action without
    # the slice credential?
    #
1135 1136 1137 1138 1139
    if ( (!defined($slice)) && 
          ($credential->target_urn() =~ /\+authority\+cm$/)) {
          # administrative credentials are presented.
          my $cm_urn = GeniHRN::Generate($OURDOMAIN, "authority", "cm");
          if ($cm_urn != $credential->target_urn()) {
Srikanth's avatar
Srikanth committed
1140
            return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
1141 1142 1143 1144
                      "Credential target does not match CM URN");
          }

      if (!defined($slice_urn)) {
Srikanth's avatar
Srikanth committed
1145 1146
          return GeniResponse->MalformedArgsResponse("Missing arguments");
      }       
1147 1148 1149 1150 1151 1152 1153 1154
      $slice = GeniSlice->Lookup($slice_urn);
      return GeniResponse->Create(GENIRESPONSE_ERROR, undef, 
                "No Slice with urn $slice_urn here")
          if (!defined($slice));
      $aggregate = GeniAggregate->SliceAggregate($slice);
      return GeniResponse->Create(GENIRESPONSE_ERROR, undef, 
                      "No Aggregate here")
          if (!defined($aggregate));
Srikanth's avatar
Srikanth committed
1155
    } 
1156

1157 1158 1159 1160
    if (! (defined($slice) && defined($aggregate))) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "No slice or aggregate here");
    }
1161 1162
    main::AddLogfileMetaDataFromSlice($slice);

1163 1164
    if (defined($slice_urn)) {
	if (! GeniHRN::IsValid($slice_urn)) {
1165 1166
	    return
		GeniResponse->MalformedArgsResponse("Bad characters in URN");
1167
	}
1168 1169 1170
	if ($slice_urn ne $slice->urn()) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN(), undef,
					"Credential does not match the URN");
1171
	}
1172 1173 1174 1175
    }
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse();
    }
1176 1177 1178 1179 1180 1181
    # If a monitor process is running, we are "busy".
    GeniCM::CheckMonitor($slice);
    if ($slice->monitor_pid()) {
	$slice->UnLock();
	return GeniResponse->MonitorResponse();
    }
1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195
    # Shutdown slices get nothing.
    if ($slice->shutdown()) {
	$slice->UnLock();
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Slice has been shutdown");
    }
    if ($aggregate->ComputeState()) {
	$slice->UnLock();
	print STDERR "Could not determine current state\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    my $CheckState = sub {
	my ($object, $action) = @_;

1196
	if ($action eq "start") {
1197 1198
	    if ($object->state() ne "stopped" && $object->state() ne "new"
		&& $object->state() ne "mixed") {
1199 1200 1201 1202 1203
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					    "Sliver is not stopped (yet)");
	    }
	}
	elsif ($action eq "stop") {
1204
	    if ($object->state() ne "started" && $object->state() ne "mixed") {
1205 1206 1207 1208 1209
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					    "Sliver is not started (yet)");
	    }
	}
	elsif ($action eq "restart") {
1210
	    if ($object->state() ne "started" && $object->state() ne "mixed") {
1211 1212 1213
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					    "Sliver is not started (yet)");
	    }
1214
	}
1215 1216 1217 1218 1219 1220
	elsif ($action eq "reload") {
	    if ($object->state() ne "started" && $object->state() ne "stopped"){
		return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Sliver is not started or stopped (yet)");
	    }
	}
1221 1222 1223
	return 0;
    };
    my $PerformAction = sub {
1224
	my ($object, $action, @slivers) = @_;
1225

1226 1227
	my $exitval = 0;

1228
	if ($action eq "start") {
1229
	    $exitval = $object->Start($API_VERSION);
1230
	}
1231
	elsif ($action eq "stop") {
1232
	    $exitval = $object->Stop($API_VERSION);
1233 1234
	}
	elsif ($action eq "restart") {
1235 1236 1237 1238 1239 1240
	    if (@slivers) {
		$exitval = $object->BatchAction("restart", @slivers);
	    }
	    else {
		$exitval = $object->Restart($API_VERSION);
	    }
1241 1242
	}
	elsif ($action eq "reload") {
1243 1244 1245 1246 1247 1248
	    if (@slivers) {
		$exitval = $object->BatchAction("reload", @slivers);
	    }
	    else {
		$exitval = $object->Reload($API_VERSION);
	    }
1249
	}
1250 1251 1252 1253
	return GeniResponse->Create(GENIRESPONSE_ERROR, 
				    "Could not $action sliver")
	    if ($exitval);
	
1254 1255 1256
	return 0;
    };

1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267
    my $user = GeniCM::CreateUserFromCertificate($credential);
    return $user
	if (GeniResponse::IsResponse($user));

    my $realuser = GeniCM::FlipToUser($slice, $user);
    if (! (defined($realuser) && $realuser)) {
	print STDERR "Error flipping to real user\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "FlipToUser Error");
    }

1268 1269 1270 1271 1272
    if (defined($slice_urn)) {
	$response = &$CheckState($aggregate, $action);
	goto bad
	    if (GeniResponse::IsResponse($response));
	    
1273
	if ($action eq "start" || $action eq "restart" || $action eq "reload"){
1274 1275
	    if (defined($manifest) &&
		$aggregate->ProcessManifest($manifest)) {
1276 1277 1278 1279 1280
		$response = GeniResponse->Create(GENIRESPONSE_ERROR,
						 undef,
						 "Error processing manifest");
		goto bad;
	    }
1281 1282 1283 1284
	    #
	    # At this point we want to return and let the startsliver proceed
	    # in the background
	    #
1285
	    my $mypid = main::WrapperFork();
1286 1287 1288
	    if ($mypid) {
		return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	    }
1289 1290
	    # Remember our pid in case callee wrapper forks again.
	    $isasync = $PID;
1291
	}
1292 1293 1294 1295
	$response = &$PerformAction($aggregate, $action);
	goto bad
	    if (GeniResponse::IsResponse($response));

1296 1297 1298
	if (!$isasync || $isasync == $PID) {
	    $slice->UnLock();
	}
1299 1300
	return ($isasync ? GENIRESPONSE_SUCCESS :
		GeniResponse->Create(GENIRESPONSE_SUCCESS));
1301
    }
1302
    else {
1303
	my @slivers = ();
1304

1305 1306 1307 1308 1309
	#
	# Sanity check all arguments before doing anything.
	#
	foreach my $urn (@{ $sliver_urns }) {
	    my $sliver = GeniSliver->Lookup($urn);
Leigh Stoller's avatar
Leigh Stoller committed
1310 1311 1312 1313 1314 1315
	    if (!defined($sliver)) {
		$response = GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
						 undef,
						 "Nothing here by that name");
		goto bad;
	    }
1316 1317 1318 1319 1320 1321 1322 1323
	    
	    $response = &$CheckState($sliver, $action);
	    goto bad
		if (GeniResponse::IsResponse($response));

	    push(@slivers, $sliver);
	}
	foreach my $sliver (@slivers) {
1324 1325 1326 1327 1328 1329 1330 1331
	    if ($action eq "start" && defined($manifest)) {
		if ($sliver->ProcessManifest($manifest)) {
		    $response = GeniResponse->Create(GENIRESPONSE_ERROR,
				     undef,
				     "Error processing manifest for $sliver");
		    goto bad;
		}
	    }
1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345
	}
	if ($asyncmode && $action =~ /^(restart|reload)$/) {
	    #
	    # At this point we want to return and let the startsliver proceed
	    # in the background
	    #
	    my $mypid = main::WrapperFork();
	    if ($mypid) {
		return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	    }
	    # Remember our pid in case callee forks again.
	    $isasync = $PID;

	    $response = &$PerformAction($aggregate, $action, @slivers);
1346 1347
	    goto bad
		if (GeniResponse::IsResponse($response));
1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359

	    # Callee did not fork again, we can unlock.
	    if ($isasync == $PID) {
		$slice->UnLock();
	    }
	}
	else {
	    foreach my $sliver (@slivers) {
		$response = &$PerformAction($sliver, $action);
		goto bad
		    if (GeniResponse::IsResponse($response));
	    }
1360 1361
	}
	$slice->UnLock();
1362 1363
	return ($isasync ? GENIRESPONSE_SUCCESS :
		GeniResponse->Create(GENIRESPONSE_SUCCESS));
1364
    }
1365 1366
  bad:
    $slice->UnLock();
1367
    return ($isasync ? $response->{'code'} : $response);
1368 1369 1370 1371 1372 1373 1374
}

#
# Get sliver status
#
sub SliverStatus($)
{
1375
    my ($argref)     = @_;
1376 1377
    my $slice_urn    = $argref->{'slice_urn'};
    my $credentials  = $argref->{'credentials'};
1378
    require Node;
1379 1380 1381 1382 1383 1384 1385

    if (! (defined($credentials) && defined($slice_urn))) {
	return GeniResponse->MalformedArgsResponse("Missing arguments");
    }
    if (! GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
    }
1386
    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398
    return $credential
	if (GeniResponse::IsResponse($credential));

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

    #
    # For now, only allow top level aggregate or the slice
    #
    my ($slice, $aggregate) = Credential2SliceAggregate($credential);
1399 1400 1401
    return $slice
	if (defined($slice) && GeniResponse::IsResponse($slice));

1402
    if (! (defined($slice) && defined($aggregate))) {
1403
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
1404 1405
				    "No slice or aggregate here");
    }
1406
    main::AddLogfileMetaDataFromSlice($slice);
1407