GeniSA.pm.in 40.1 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1 2
#!/usr/bin/perl -wT
#
3
# Copyright (c) 2008-2014 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.
# 
# }}}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
29 30 31 32
#
package GeniSA;

#
33 34
# The server side of the SA interface. The SA is really just a registry,
# in our case mediated by Emulab. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
35 36 37 38 39 40 41 42 43
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

@ISA    = "Exporter";
@EXPORT = qw ( );

# Must come after package declaration!
44
use libtestbed;
45
use libEmulab;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
46 47
use GeniDB;
use Genixmlrpc;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
48 49
use GeniResponse;
use GeniUser;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
50 51 52
use GeniSlice;
use GeniCredential;
use GeniCertificate;
53
use GeniAuthority;
54
use GeniHRN;
55
use GeniStd;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
56
use English;
57
use XML::Simple;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
58
use Data::Dumper;
59 60 61
use Date::Parse;
use POSIX qw(strftime);
use Time::Local;
62
use Project;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
63 64 65

# Configure variables
my $TB		   = "@prefix@";
66
my $TBOPS          = "@TBOPSEMAIL@";
67
my $MAINSITE 	   = @TBMAINSITE@;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
68
my $OURDOMAIN      = "@OURDOMAIN@";
69
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
70
my $SLICESHUTDOWN  = "$TB/sbin/protogeni/shutdownslice";
71
my $PROTOGENI_URL  = "@PROTOGENI_URL@";
72 73
my $RegisterNow    = 0;
my $API_VERSION    = 1.01;
74 75 76 77 78 79 80 81 82 83 84

#
# 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()
{
    return GeniResponse->Create( GENIRESPONSE_SUCCESS, $API_VERSION );
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
85
#
86 87 88
# Get a credential for an object. If no credential provided, then return a
# generic credential for the registered Emulab user.  This is the easiest
# way to get credentials to registered users.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
89
#
90 91 92
sub GetCredential($)
{
    my ($argref) = @_;
93
    my $urn  = $argref->{'urn'};
94
    my $cred = $argref->{'credential'};
95 96
    my $creds = $argref->{'credentials'};
    my $geniuser;
97

98
    if (0 && $MAINSITE) {
99 100 101
	print STDERR "Debugging getslicecred()\n";
    }

102
    #
103
    # This credential is for access to this SA.
104
    #
105 106 107 108 109 110
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
    if (!defined($authority)) {
	print STDERR
	    "Could not find local authority object for $ENV{'MYURN'}\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
111

112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
    #
    # If we got *only* a speaks-for credential, then a tool is asking for
    # a self-cred on behalf of a user.
    #
    if (defined($cred)) {
	my ($credential,$speaksfor) =
	    GeniStd::CheckCredentials([$cred], $authority);
	return $credential
	    if (GeniResponse::IsResponse($credential));

	if (defined($speaksfor)) {
	    $geniuser = GeniUser->Lookup($speaksfor->target_urn(), 1);
	    if (!defined($geniuser)) {
		return GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
					    undef, "Who are you speaking for?");
	    }
	    # Asking for a self cred for the target user.
	    goto selfcred;
	}
    }
    elsif (!(defined($cred) || defined($creds))) {
133
	#
134
	# No cred, caller wants a self credential.
135
	#
136 137 138 139
	$geniuser = GeniUser->Lookup($ENV{'GENIURN'}, 1);
	if (!defined($geniuser)) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					"Who are you?");
140
	}
141
      selfcred:
142 143 144 145 146 147
	if( !CheckMembership( $geniuser ) ) {
	    return GeniResponse->Create( GENIRESPONSE_FORBIDDEN,
					 undef, "No privilege at this " .
					 "authority" );
	}

148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
	my $credential = GeniCredential->Lookup($authority, $geniuser);
	if (defined($credential)) {
	    #
	    # Check for expiration and for changed certificate.
	    #
	    if ($credential->IsExpired() ||
		!$credential->SameCerts($authority, $geniuser)) {
		$credential->Delete();
		$credential = undef;
	    }
	}
	if (!defined($credential)) {
	    $credential =
		GeniCredential->CreateSigned($authority,
					     $geniuser,
163 164 165
					     $main::PROJECT ?
					     $authority->GetCertificate() :
					     $GeniCredential::LOCALSA_FLAG );
166 167 168 169 170

	    # Okay if this fails.
	    $credential->Store()
		if (defined($credential));
	}
171 172 173
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!defined($credential));

174 175 176
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    $credential->asString());
    }
177
    return GeniResponse->MalformedArgsResponse()
178
	if (! (defined($urn) && GeniHRN::IsValid($urn)));
179

180
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
181 182 183 184
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
185 186 187 188 189 190 191
    my ($credential,$speaksfor);
    if (defined($cred)) {
	$credential = GeniCredential::CheckCredential($cred, $authority);
    }
    else {
	($credential,$speaksfor) = GeniStd::CheckCredentials($creds, $authority);
    }
192 193 194
    return $credential
	if (GeniResponse::IsResponse($credential));
   
195 196 197 198 199
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

200
    my ($undef, $type, $id) = GeniHRN::Parse($urn);
201 202 203 204 205 206 207 208 209

    $geniuser =
	GeniUser->Lookup((defined($speaksfor) ?
			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
    if (!defined($geniuser)) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
    }
    if( !CheckMembership( $geniuser ) ) {
210 211 212 213 214
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN,
				     undef, "No privilege at this " .
				     "authority" );
    }

215 216
    #
    # User provided a credential, and wants a new credential to access
217
    # the object referenced by the URN.
218
    #
219
    if (lc($type) eq "slice") {
220 221 222 223
	#
	# Bump the activity counter for the user. Lets us know in the
	# main DB that a user is doing something useful.
	#
224 225
	$geniuser->BumpActivity()
	    if ($geniuser->IsLocal());
226
	
227
	my $slice = GeniSlice->Lookup($urn);
228

Leigh B. Stoller's avatar
Leigh B. Stoller committed
229 230 231
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No such Slice")
	    if (!defined($slice));
232 233 234
	if ($slice->Lock() != 0) {
	    return GeniResponse->BusyResponse("slice");
	}
235 236
	if ($slice->creator_urn() ne $geniuser->urn() &&
	    !$slice->IsBound($geniuser)) {
237 238 239 240
	    $slice->UnLock();
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					"Not your slice!");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
241 242 243
	#
	# Return a credential for the slice.
	#
244
	my $slice_credential = GeniCredential->Lookup($slice, $geniuser);
245 246 247 248 249
	if (defined($slice_credential)) {
	    #
	    # Check for expiration and for changed certificate.
	    #
	    if ($slice_credential->IsExpired() ||
250
		!$slice_credential->SameCerts($slice, $geniuser)) {
251 252 253 254 255 256 257
		$slice_credential->Delete();
		$slice_credential = undef;
	    }
	}
	if (!defined($slice_credential)) {
	    $slice_credential =
		GeniCredential->CreateSigned($slice,
258
					     $geniuser,
259 260 261 262
					     $main::PROJECT ?
					     $authority->GetCertificate() :
					     $GeniCredential::LOCALSA_FLAG );

263 264 265 266
	    # Okay if this fails.
	    $slice_credential->Store()
		if (defined($slice_credential));
	}
267 268 269 270 271
	if (!defined($slice_credential)) {
	    $slice->UnLock();
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	$slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
272 273 274 275
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    $slice_credential->asString());
    }
    
276 277 278 279
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
}

#
280
# Resolve a record.
281 282 283 284 285
#
sub Resolve($)
{
    my ($argref) = @_;
    my $hrn  = $argref->{'hrn'};
286
    my $urn  = $argref->{'urn'};
287 288
    my $cred = $argref->{'credential'};
    my $type = $argref->{'type'};
289
    my $creds = $argref->{'credentials'};
290

291
    if (! (defined($hrn) || defined($urn))) {
292 293
	return GeniResponse->MalformedArgsResponse();
    }
294 295 296 297 298
    # URN always takes precedence and all items should now have URNs
    # in their certificates.
    if (defined($urn)) {
	return GeniResponse->MalformedArgsResponse()
	    if (!GeniHRN::IsValid($urn));
299
	$hrn = undef;
300
    }
301 302
    elsif (defined($hrn) && GeniHRN::IsValid($hrn)) {
	$urn = $hrn;
303
	$hrn = undef;
304
    }
305
    elsif (defined($hrn) && (!defined($type) || !($hrn =~ /^[-\w\.]*$/))) {
306 307
	return GeniResponse->MalformedArgsResponse();
    }
308 309 310 311 312
    #
    # Deprecated (pre-URN) HRN.
    # XXX Form hrn from the uid and domain. This is backwards.
    #
    if (defined($hrn) && !($hrn =~ /\./)) {
313 314 315 316
	$hrn  = "${PGENIDOMAIN}.${hrn}";
    }
    else {
	(undef,$type,undef) = GeniHRN::Parse($urn);
317
    }
318
    $type = lc($type);
319
    if (! (defined($cred) || defined($creds))) {
320 321 322
	return GeniResponse->MalformedArgsResponse();
    }
    
323
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
324 325 326 327
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
328 329 330 331 332 333 334
    my ($credential, $speaksfor);
    if (defined($cred)) {
	$credential = GeniCredential::CheckCredential($cred, $authority);
    }
    else {
	($credential,$speaksfor) = GeniStd::CheckCredentials($creds, $authority);
    }
335 336 337
    return $credential
	if (GeniResponse::IsResponse($credential));
   
338 339 340 341 342
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

343 344 345 346 347
    #
    # We need to enforce Emulab permissions here, since the credential
    # allows anyone with a credential for this registry to lookup anyone
    # else. Good feature of the Geni API.
    #
348 349 350
    my $this_user =
	GeniUser->Lookup((defined($speaksfor) ?
			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
351
    if (!defined($this_user)) {
352 353
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
354
    }
355
    my $lookup_token = $urn || $hrn;
356
    
357
    if ($type eq "user") {
358
	my $geniuser = GeniUser->Lookup($lookup_token, 1);
359
	if (!defined($geniuser)) {
360 361
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					"No one here by that name");
362
	}
363 364

	my @slices = GeniSlice->LookupByCreator( $geniuser );
365 366
	# Cull out cooked mode slices.
	@slices = grep {!defined($_->exptidx())} @slices;
367
	my @sliceURNs = map( $_->urn(), @slices );
368

369 370 371
	# Return a blob.
	my $blob = { "uid"      => $geniuser->uid(),
		     "hrn"      => $geniuser->hrn(),
372
		     "urn"      => $geniuser->urn(),
373 374
		     "uuid"     => $geniuser->uuid(),
		     "email"    => $geniuser->email(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
375
		     "gid"      => $geniuser->cert(),
376
		     "name"     => $geniuser->name(),
377
		     "slices"   => \@sliceURNs
378
		    };
379 380 381 382 383 384 385 386 387 388 389 390

	if ($geniuser->IsLocal()) {
	    my @projects = ();
	    my %subsas   = ();
	    if ($geniuser->emulab_user()->ProjectMembershipList(\@projects)) {
		print STDERR "Could not get project membership for $geniuser\n";
	    }
	    else {
		foreach my $project (@projects) {
		    my $pid = $project->pid();
		    my $urn = GeniHRN::Generate("$OURDOMAIN:$pid",
						"authority", "sa");
391
		    my $url = "$PROTOGENI_URL/project/$pid/sa";
392 393 394 395
		    $subsas{$urn} = $url;
		}
		$blob->{'subauthorities'} = \%subsas;
	    }
396 397 398 399 400 401 402
	    my @keys = ();
	    if ($geniuser->GetKeyBundle(\@keys) != 0) {
		print STDERR "Could not get keys for $geniuser\n";
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Could not get public keys");
	    }
	    $blob->{'pubkeys'} = \@keys;
403 404
	}

405 406
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
407
    if ($type eq "slice") {
408
	my $slice = GeniSlice->Lookup($lookup_token);
409 410
	if (!defined($slice)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
411
					"No such slice registered here");
412
	}
413 414 415
	if ($slice->Lock() != 0) {
	    return GeniResponse->BusyResponse("slice");
	}
416
	my @slivers = GeniSlice::ClientSliver->LookupBySlice($slice);
417 418 419 420
	my @managers = ();
	foreach my $sliver (@slivers) {
	    push(@managers, $sliver->manager_urn());
	}
421 422
	# Return a blob.
	my $blob = { "hrn"          => $slice->hrn(),
423
		     "urn"          => $slice->urn(),
424 425
		     "uuid"         => $slice->uuid(),
		     "creator_uuid" => $slice->creator_uuid(),
426
		     "creator_urn"  => $slice->creator_urn(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
427
		     "gid"          => $slice->cert(),
428
		     "urn"          => $slice->urn(),
429
		     "component_managers" => \@managers
430
		 };
431
	$slice->UnLock();
432 433 434 435 436 437 438 439 440 441 442 443 444 445
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
}

#
# Register a new Geni object. Currently, just slices. Also, the
# certificate and uuid are generated here, not by the caller. The Geni
# API says that the caller provides that, but I see that as being
# silly and more work then the user needs to deal with. 
#
sub Register($)
{
446 447
    require Experiment;
    
448 449
    # FIXME once migration to URNs is complete, $type should be removed
    # (it's deduced automatically from the URN).
450 451
    my ($argref) = @_;
    my $cred  = $argref->{'credential'};
452
    my $creds = $argref->{'credentials'};
453 454
    my $type  = $argref->{'type'};
    my $hrn   = $argref->{'hrn'};
455
    my $urn   = $argref->{'urn'};
456

457 458
    if (! ((defined($hrn) || defined($urn)) &&
	   (defined($cred) || defined($creds)))) {
459 460
	return GeniResponse->MalformedArgsResponse();
    }
461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478
    if (defined($urn)) {
	return GeniResponse->MalformedArgsResponse()
	    if (!GeniHRN::IsValid($urn));
	$hrn = undef;
    }
    elsif (defined($hrn) && GeniHRN::IsValid($hrn)) {
	$urn = $hrn;
	$hrn = undef;
    }
    elsif (defined($hrn) && !($hrn =~ /^[-\w\.]*$/)) {
	return GeniResponse->MalformedArgsResponse();
    }
    elsif (! ($hrn =~ /^[-\w]+$/)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "hrn: Single token only please");
    }
    if (defined($urn)) {
	my ($auth,$t,$id) = GeniHRN::Parse($urn);
479
	my ($myauth, $myt, $myid) = GeniHRN::Parse( $ENV{'MYURN'} );
480

481 482
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Authority mismatch")
483
	    unless( $auth eq $OURDOMAIN or $auth eq $myauth );
484

485 486 487 488
	#
	# The user can supply a URN, but only the type and id
	# really matter. The URN is ignored below.
	#
489
	$type = $t;
490
	$hrn  = $id;
491
    }
492 493
    elsif (!defined($type)) {
	return GeniResponse->MalformedArgsResponse();
494 495
    }

496
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
497 498 499 500
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
501 502 503 504 505 506 507
    my ($credential, $speaksfor);
    if (defined($cred)) {
	$credential = GeniCredential::CheckCredential($cred, $authority);
    }
    else {
	($credential,$speaksfor) = GeniStd::CheckCredentials($creds, $authority);
    }
508 509 510
    return $credential
	if (GeniResponse::IsResponse($credential));
   
511 512 513 514 515
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "refresh" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

516 517 518 519 520
    #
    # We need to enforce Emulab permissions here, since the credential
    # allows anyone with a credential for this registry to lookup anyone
    # else. Good feature of the Geni API.
    #
521 522 523
    my $this_user =
	GeniUser->Lookup((defined($speaksfor) ?
			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
524
    if (!defined($this_user)) {
525 526
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
527 528
    }
    
529 530 531 532 533 534
    if( !CheckMembership( $this_user ) ) {
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN,
				     undef, "No privilege at this " .
				     "authority" );
    }

535 536 537 538 539 540 541
    #
    # Bump the activity counter for the user. Lets us know in the
    # main DB that a user is doing something useful.
    #
    $this_user->BumpActivity()
	if ($this_user->IsLocal());
	
542
    if ( lc( $type ) eq "slice") {
543
	my $expires = $argref->{'expiration'};
544

545 546 547 548 549
	if (! Experiment->ValidEID($hrn)) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				"$hrn is not a valid slice name");
	}

550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568
	#
	# Figure out new expiration time; this is the time at which we can
	# idleswap the slice out. 
	#
	if (defined($expires)) {
	    my $message;
		
	    if (! ($expires =~ /^[-\w:.\/]+/)) {
		$message = "Illegal valid_until in rspec";
		goto bad;
	    }
	    # Convert to a localtime.
	    my $when = timegm(strptime($expires));
	    if (!defined($when)) {
		$message = "Could not parse valid_until";
		goto bad;
	    }
	    #
	    # Do we need a policy limit?
569 570
	    # A sitevar controls the sliver lifetime.
	    #
571 572 573
	    my $max_slice_lifetime = 0; 
	    if (!libEmulab::GetSiteVar('protogeni/max_slice_lifetime', 
				       \$max_slice_lifetime)) {
574
		# Cannot get the value, default it to 90 days.
575
		$max_slice_lifetime = 90;
576
	    }
577

578
	    my $diff = $when - time();
579 580 581 582 583 584 585
	    if ($diff < (60 * 5)) {
		$message = "such a short life for a slice? More time please.";
		goto bad;
	    }
	    elsif ($diff > (3600 * 24 * $max_slice_lifetime)) {
		$message = "expiration is greater then the maximum number ".
		    "of minutes " . (60 * 24 * $max_slice_lifetime);
586 587 588 589
		goto bad;
	    }
	  bad:
	    if (defined($message)) {
590 591
		return GeniResponse->Create(GENIRESPONSE_ERROR,
					    undef, $message);
592 593 594
	    }
	    $expires = $when;
	}
595

Gary Wong's avatar
Gary Wong committed
596 597
	my ($ourdomain, undef, undef) = GeniHRN::Parse( $ENV{ 'MYURN' } );
	my $urn = GeniHRN::Generate( $ourdomain, "slice", $hrn );
598
	
599 600 601 602 603 604 605
	#
	# When using this interface, the HRN does not correspond to an
	# existing experiment in a project. It is just a token to call
	# the slice (appended to our DOMAIN).
	#
	# XXX Form hrn from the uid and domain. This is backwards.
	#
606
	my $hrn = "${PGENIDOMAIN}.${hrn}";
607

608 609 610 611 612 613 614 615 616
	#
	# Make sure slice is unique. Locking?
	#
	my $tempslice = GeniSlice->Lookup($hrn) || GeniSlice->Lookup($urn);
	if ($tempslice) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"$urn already a registered slice");
	}
	    
617
	#
618
	# Generate a certificate for this new slice.
619
	#
620 621 622 623
	my $error;
	my $certificate =
	    GeniCertificate->Create({'urn'  => $urn,
				     'hrn'  => $hrn,
624
				     'showuuid' => 1,
625
				     'email'=> $this_user->email()}, \$error);
626
	if (!defined($certificate)) {
627 628 629 630
	    if (defined($error)) {
		return GeniResponse->Create($error, undef,
					    GENIRESPONSE_STRING($error));
	    }
631 632 633
	    print STDERR "Could not create new certificate for slice\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
634

635
	# Slice is created as locked.
636
	my $slice = GeniSlice->Create($certificate,
637
				      $this_user, $authority, undef, 1);
638 639 640 641 642
	if (!defined($slice)) {
	    $certificate->Delete();
	    print STDERR "Could not create new slice object\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
643
	
644 645
	if (defined($expires) && $slice->SetExpiration($expires) != 0) {
	    print STDERR "Could not set slice expiration to $expires\n";
646
	    $slice->Delete();
647 648
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
649 650 651 652

	#
	# Return a credential for the slice.
	#
653 654 655
	my $slice_credential =
	    GeniCredential->CreateSigned($slice,
					 $this_user,
656 657 658 659
					 $main::PROJECT ?
					 $authority->GetCertificate() :
					 $GeniCredential::LOCALSA_FLAG );

660 661 662 663
	if (!defined($slice_credential)) {
	    $slice->Delete();
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
664 665
	# Okay if this fails.
	$slice_credential->Store();
666 667

	#
668
	# Register new slice and creator at the clearinghouse.
669
	#
670 671 672 673 674 675 676 677 678 679 680 681 682 683 684
	if ($RegisterNow) {
	    if ($this_user->Register() != 0) {
		#
		# Non-fatal; the sa_daemon will do it later.
		#
		print STDERR
		    "Could not register $this_user at clearinghouse\n";
	    }
	    elsif ($slice->Register() != 0) {
		#
		# Non-fatal; the sa_daemon will do it later.
		#
		print STDERR
		    "Could not register $slice at the clearinghouse\n";
	    }
685
	}
686
	$slice->UnLock();
687

688 689 690 691 692 693 694 695 696 697 698 699
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    $slice_credential->asString());
    }

    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
}

#
# Remove record.
#
sub Remove($)
{
700
    # FIXME once migration to URNs is complete, $type should be removed
701
    # (it's deduced automatically from the URN).
702
    my ($argref) = @_;
703
    my $hrn  = $argref->{'hrn'};
704
    my $urn  = $argref->{'urn'};
705
    my $cred = $argref->{'credential'};
706
    my $type = $argref->{'type'};
707
    my $creds= $argref->{'credentials'};
708

709 710
    if (! ((defined($hrn) || defined($urn)) &&
	   (defined($cred) || defined($creds)))) {
711 712
	return GeniResponse->MalformedArgsResponse();
    }
713 714 715
    if (defined($urn)) {
	return GeniResponse->MalformedArgsResponse()
	    if (!GeniHRN::IsValid($urn));
716
	$hrn = undef;
717
    }
718 719
    elsif (defined($hrn) && GeniHRN::IsValid($hrn)) {
	$urn = $hrn;
720
	$hrn = undef;
721
    }
722
    elsif (defined($hrn) && (!defined($type) || !($hrn =~ /^[-\w\.]*$/))) {
723
	return GeniResponse->MalformedArgsResponse();
724 725
    }
    #
726 727
    # Deprecated (pre-URN) HRN.
    # XXX Form hrn from the uid and domain. This is backwards.
728
    #
729
    if (defined($hrn) && !($hrn =~ /\./)) {
730
	$hrn  = "${PGENIDOMAIN}.${hrn}";
731
    }
732 733
    else {
	(undef,$type,undef) = GeniHRN::Parse($urn);
734
    }
735
    $type = lc($type);
736 737

    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
738 739 740 741
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
742 743 744 745 746 747 748
    my ($credential, $speaksfor);
    if (defined($cred)) {
	$credential = GeniCredential::CheckCredential($cred, $authority);
    }
    else {
	($credential,$speaksfor) = GeniStd::CheckCredentials($creds, $authority);
    }
749 750 751
    return $credential
	if (GeniResponse::IsResponse($credential));
   
752 753 754 755 756
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "refresh" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

757 758 759
    my $this_user =
	GeniUser->Lookup((defined($speaksfor) ?
			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
760
    if (!defined($this_user)) {
761 762
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
763 764
    }
    
765 766 767 768 769 770
    if( !CheckMembership( $this_user ) ) {
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN,
				     undef, "No privilege at this " .
				     "authority" );
    }

771
    if ($type eq "slice") {
772
	my $slice = GeniSlice->Lookup($urn || $hrn);
773 774
	if (!defined($slice)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
775
					"No such slice");
776
	}
777 778 779 780 781 782 783 784 785 786 787 788
	if ($slice->Lock() != 0) {
	    return GeniResponse->BusyResponse("slice");
	}
	#
	# Not allowed to delete a cooked mode slice via this interface.
	#
	if ($slice->exptidx()) {
	    $slice->UnLock();
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					"Cooked mode Slice");
	}
	
789 790 791 792 793 794
	#
	# Not allowed to delete a slice that has not expired since
	# that would make it impossible to control any existing
	# slivers.
	#
	if (! $slice->IsExpired()) {
795
	    $slice->UnLock();
796 797 798
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					"Slice has not expired");
	}
799
	# Needs to move.
800
	GeniSlice::ClientSliver->SliceDelete($slice);
801 802 803

	# Remove any stored credentials for this slice.
	GeniCredential->DeleteForTarget($slice);
804
	
805 806 807 808
	#
	# Remove from the clearing house.
	#
	if ($slice->UnRegister()) {
809 810 811
	    #
	    # Not a fatal error; the CH will age it out eventually. 
	    #
812 813 814 815 816
	    print STDERR "Could not delete $slice from clearinghouse!\n";
	}
	if ($slice->Delete()) {
	    print STDERR "Could not delete $slice from SA!\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
817
					"Slice could not be deleted");
818 819 820 821 822 823 824
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
    }
    
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
825 826 827 828 829 830
#
# Return ssh keys.
#
sub GetKeys($)
{
    my ($argref) = @_;
831
    my $cred     = $argref->{'credential'};
832
    my $creds    = $argref->{'credentials'};
833 834
    # Hidden option. Remove later.
    my $version  = $argref->{'version'} || 1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
835

836
    if (! (defined($cred) || defined($creds))) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
837 838 839
	return GeniResponse->MalformedArgsResponse();
    }

840
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
841 842 843 844
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
845 846 847 848 849 850 851
    my ($credential, $speaksfor);
    if (defined($cred)) {
	$credential = GeniCredential::CheckCredential($cred, $authority);
    }
    else {
	($credential,$speaksfor) = GeniStd::CheckCredentials($creds, $authority);
    }
852 853 854
    return $credential
	if (GeniResponse::IsResponse($credential));
   
855 856 857 858 859
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

860 861 862
    my $this_user =
	GeniUser->Lookup((defined($speaksfor) ?
			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
863
    if (!defined($this_user)) {
864 865
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
866
    }
867
    my $blob;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
868
    my @keys;
869
    if ($this_user->GetKeyBundle(\@keys) != 0) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
870 871 872
	print STDERR "Could not get keys for $this_user\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);	
    }
873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891
    if ("$version" eq "am") {
	# Just for debugging the AM interface.
	my @tmp = ();
	foreach my $key (@keys) {
	    push(@tmp, $key->{'key'});
	}
	$blob = [{'urn'   => $this_user->urn(),
		  'keys'  => \@tmp}];
    }
    elsif ($version > 1) {
	# Note new format.
	$blob = [{'urn'   => $this_user->urn(),
		  'login' => $this_user->uid(),
		  'keys'  => \@keys}];
    }
    else {
	$blob = \@keys;
    }
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
892 893 894 895 896 897 898 899 900 901 902
}

#
# Bind a user to a slice. The slice creator does this so that the target
# user can request his own credential to manipulate the slice. This is in
# leu of delegation.
#
sub BindToSlice($)
{
    my ($argref) = @_;
    my $cred  = $argref->{'credential'};
903
    my $creds = $argref->{'credentials'};
904
    my $urn   = $argref->{'urn'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
905

906
    if (! (defined($urn) && (defined($cred) || defined($creds)))) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
907 908
	return GeniResponse->MalformedArgsResponse();
    }
909 910
    return GeniResponse->MalformedArgsResponse()
	if (defined($urn) && !GeniHRN::IsValid($urn));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
911

912 913 914 915
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
916
    }
917 918 919 920 921 922 923
    my ($credential, $speaksfor);
    if (defined($cred)) {
	$credential = GeniCredential::CheckCredential($cred, $authority);
    }
    else {
	($credential,$speaksfor) = GeniStd::CheckCredentials($creds, $authority);
    }
924 925 926 927 928 929 930 931
    return $credential
	if (GeniResponse::IsResponse($credential));
   
    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "bind" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );
    
932 933 934
    my $this_user =
	GeniUser->Lookup((defined($speaksfor) ?
			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
935
    if (!defined($this_user)) {
936 937
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
938
    }
939 940

    my $slice = GeniSlice->Lookup($credential->target_urn());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
941
    if (!defined($slice)) {
942
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
943 944 945 946 947 948
				    "Unknown slice for this credential");
    }
    
    #
    # Locate the target user; must exist locally.
    #
949
    my $target_user = GeniUser->Lookup($urn, 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
950 951
    if (!defined($target_user)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
952
				    undef, "No such user here");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
953
    }
954 955 956
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse("slice");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
957 958
    if ($slice->BindUser($target_user) != 0) {
	print STDERR "Could not bind $target_user to $slice\n";
959
	$slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
960 961
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
962
    $slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
963 964 965
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

966 967 968 969 970 971 972 973 974 975 976 977
#
# Emergency shutdown a slice. This cannot be undone via this interface.
# An Emulab admin will have to do that.
#
sub Shutdown($)
{
    my ($argref) = @_;
    my $cred  = $argref->{'credential'};

    if (!defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
978
    my $credential = GeniCredential::CheckCredential($cred);
979 980
    return $credential
	if (GeniResponse::IsResponse($credential));
981

982 983 984 985
    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "control" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );
986 987 988 989 990 991

    my $slice = GeniSlice->Lookup($credential->target_urn());
    if (!defined($slice)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "Unknown slice for this credential");
    }
992 993
    my $slice_urn = $slice->urn();
    system("$SLICESHUTDOWN $slice_urn");
994
    if ($?) {
995
	print STDERR "Could not shutdown $slice_urn!\n";
996 997 998 999 1000 1001
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Error shutting down slice");
    }
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

1002 1003 1004 1005 1006 1007
#
# Extend a slice expiration time.
#
sub RenewSlice($)
{
    my ($argref) = @_;
1008 1009
    my $cred    = $argref->{'credential'};
    my $creds   = $argref->{'credentials'};
1010 1011 1012
    my $expires = $argref->{'expiration'};
    my $message = "Error renewing slice";

1013
    if (! (defined($cred) || defined($creds)) && defined($expires)) {
1014 1015 1016
	return GeniResponse->Create(GENIRESPONSE_BADARGS);
    }

1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
    if (!defined($authority)) {
	print STDERR
	    "Could not find local authority object for $ENV{'MYURN'}\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }

    my ($credential, $speaksfor);
    if (defined($cred)) {
	$credential = GeniCredential::CheckCredential($cred, $authority);
    }
    else {
	($credential,$speaksfor) = GeniStd::CheckCredentials($creds);
    }
1031 1032 1033 1034 1035 1036 1037 1038 1039
    return $credential
	if (GeniResponse::IsResponse($credential));
   
    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "bind" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

    my $slice = GeniSlice->Lookup($credential->target_urn());
1040
    if (!defined($slice)) {
Leigh B Stoller's avatar