GeniSA.pm.in 46 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1 2
#!/usr/bin/perl -wT
#
Leigh B Stoller's avatar
Leigh B Stoller committed
3
# Copyright (c) 2008-2015 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

Leigh B Stoller's avatar
Leigh B Stoller committed
75
my $allow_nonproject_slice_share    = 0;
76 77 78 79
#$allow_nonproject_slice_share
#  if set to true, users can share slices to users that are not in 
#  the project of the slice

80 81 82 83 84 85 86 87 88 89
#
# 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
90
#
91 92 93
# 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
94
#
95 96 97
sub GetCredential($)
{
    my ($argref) = @_;
98
    my $urn  = $argref->{'urn'};
99
    my $cred = $argref->{'credential'};
100 101
    my $creds = $argref->{'credentials'};
    my $geniuser;
102

103
    if (0 && $MAINSITE) {
104 105 106
	print STDERR "Debugging getslicecred()\n";
    }

107
    #
108
    # This credential is for access to this SA.
109
    #
110 111 112 113 114 115
    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);
    }
116

117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
    #
    # 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))) {
138
	#
139
	# No cred, caller wants a self credential.
140
	#
141 142 143 144
	$geniuser = GeniUser->Lookup($ENV{'GENIURN'}, 1);
	if (!defined($geniuser)) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					"Who are you?");
145
	}
146
      selfcred:
147 148 149 150 151 152
	if( !CheckMembership( $geniuser ) ) {
	    return GeniResponse->Create( GENIRESPONSE_FORBIDDEN,
					 undef, "No privilege at this " .
					 "authority" );
	}

153 154 155 156 157 158 159 160 161 162 163 164 165 166 167
	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,
168 169 170
					     $main::PROJECT ?
					     $authority->GetCertificate() :
					     $GeniCredential::LOCALSA_FLAG );
171 172 173 174 175

	    # Okay if this fails.
	    $credential->Store()
		if (defined($credential));
	}
176 177 178
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!defined($credential));

179 180 181
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    $credential->asString());
    }
182
    return GeniResponse->MalformedArgsResponse()
183
	if (! (defined($urn) && GeniHRN::IsValid($urn)));
184

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

205
    my ($undef, $type, $id) = GeniHRN::Parse($urn);
206 207 208 209 210 211 212 213 214

    $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 ) ) {
215 216 217 218 219
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN,
				     undef, "No privilege at this " .
				     "authority" );
    }

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

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

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

#
285
# Resolve a record.
286 287 288 289 290
#
sub Resolve($)
{
    my ($argref) = @_;
    my $hrn  = $argref->{'hrn'};
291
    my $urn  = $argref->{'urn'};
292 293
    my $cred = $argref->{'credential'};
    my $type = $argref->{'type'};
294
    my $creds = $argref->{'credentials'};
295

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

348 349 350 351 352
    #
    # 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.
    #
353 354 355
    my $this_user =
	GeniUser->Lookup((defined($speaksfor) ?
			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
356
    if (!defined($this_user)) {
357 358
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
359
    }
360
    my $lookup_token = $urn || $hrn;
361
    
362
    if ($type eq "user") {
363
	my $geniuser = GeniUser->Lookup($lookup_token, 1);
364
	if (!defined($geniuser)) {
365 366
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					"No one here by that name");
367
	}
368 369

	my @slices = GeniSlice->LookupByCreator( $geniuser );
370 371
	# Cull out cooked mode slices.
	@slices = grep {!defined($_->exptidx())} @slices;
372
	my @sliceURNs = map( $_->urn(), @slices );
373

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

	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");
396
		    my $url = "$PROTOGENI_URL/project/$pid/sa";
397 398 399 400
		    $subsas{$urn} = $url;
		}
		$blob->{'subauthorities'} = \%subsas;
	    }
401 402 403 404 405 406 407
	    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;
408 409
	}

410 411
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
412
    if ($type eq "slice") {
413
	my $slice = GeniSlice->Lookup($lookup_token);
414 415
	if (!defined($slice)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
416
					"No such slice registered here");
417
	}
418 419 420
	if ($slice->Lock() != 0) {
	    return GeniResponse->BusyResponse("slice");
	}
421
	my @slivers = GeniSlice::ClientSliver->LookupBySlice($slice);
422 423 424 425
	my @managers = ();
	foreach my $sliver (@slivers) {
	    push(@managers, $sliver->manager_urn());
	}
426 427
	# Return a blob.
	my $blob = { "hrn"          => $slice->hrn(),
428
		     "urn"          => $slice->urn(),
429 430
		     "uuid"         => $slice->uuid(),
		     "creator_uuid" => $slice->creator_uuid(),
431
		     "creator_urn"  => $slice->creator_urn(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
432
		     "gid"          => $slice->cert(),
433
		     "urn"          => $slice->urn(),
434
		     "component_managers" => \@managers
435
		 };
436
	$slice->UnLock();
437 438 439 440 441 442 443 444 445 446 447 448
	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. 
#
449 450 451 452 453
sub Register($) {
	my ($argref) = @_;
	return RegisterInternal($argref, undef);
}
sub RegisterInternal($$)
454
{
455 456
    require Experiment;
    
457 458
    # FIXME once migration to URNs is complete, $type should be removed
    # (it's deduced automatically from the URN).
459
    my ($argref, $project_name) = @_;
460
    my $cred  = $argref->{'credential'};
461
    my $creds = $argref->{'credentials'};
462 463
    my $type  = $argref->{'type'};
    my $hrn   = $argref->{'hrn'};
464
    my $urn   = $argref->{'urn'};
465

466 467 468 469 470
    if (! ((defined($hrn) || defined($urn)))) {
	return GeniResponse->MalformedArgsResponse('hrn or urn argument required');
    }
    if (! (defined($cred) || defined($creds))) {
	return GeniResponse->MalformedArgsResponse('credential or credentials argument required');
471
    }
472
    if (defined($urn)) {
473
	return GeniResponse->MalformedArgsResponse('invalid urn "'.$urn.'"')
474 475 476 477 478 479 480 481
	    if (!GeniHRN::IsValid($urn));
	$hrn = undef;
    }
    elsif (defined($hrn) && GeniHRN::IsValid($hrn)) {
	$urn = $hrn;
	$hrn = undef;
    }
    elsif (defined($hrn) && !($hrn =~ /^[-\w\.]*$/)) {
482
	return GeniResponse->MalformedArgsResponse('invalid hrn "'.$hrn.'"');
483 484 485 486 487 488 489
    }
    elsif (! ($hrn =~ /^[-\w]+$/)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "hrn: Single token only please");
    }
    if (defined($urn)) {
	my ($auth,$t,$id) = GeniHRN::Parse($urn);
490
	my ($myauth, $myt, $myid) = GeniHRN::Parse( $ENV{'MYURN'} );
491

492 493
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Authority mismatch")
494
	    unless( $auth eq $OURDOMAIN or $auth eq $myauth );
495

496 497 498 499
	#
	# The user can supply a URN, but only the type and id
	# really matter. The URN is ignored below.
	#
500
	$type = $t;
501
	$hrn  = $id;
502
    }
503
    elsif (!defined($type)) {
504
	return GeniResponse->MalformedArgsResponse('type required');
505 506
    }

507 508 509 510 511 512 513 514
    my ($server_auth, $server_type, $server_authname) = GeniHRN::Parse( $ENV{'MYURN'} );
    my $authority;
    if (defined($project_name)) {
        my $subauth_urn = GeniHRN::Generate($server_auth . ':' . $project_name, $server_type, $server_authname);
        $authority = GeniAuthority->Lookup($subauth_urn);
    } else {
        $authority = GeniAuthority->Lookup($ENV{'MYURN'});
    }
515 516 517 518
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
519 520
    my ($credential, $speaksfor);
    if (defined($cred)) {
521 522 523 524
        if (defined($project_name)) {
            #don't check sub authority when project_name is defined
            $credential = GeniCredential::CheckCredential($cred);
        } else {
525 526
	$credential = GeniCredential::CheckCredential($cred, $authority);
    }
527
    }
528
    else {
529 530 531 532 533 534 535 536
        if (defined($project_name)) {
            #don't check sub authority when project_name is defined
            ($credential,$speaksfor) = GeniStd::CheckCredentials($creds);

            #wvdemeer: AddUserCredWhenSpeaksForOnly automatically adds a user credential when only speaksfor is present and it is needed, allowed and possible.
            #          note on error handling: if the credential provided to it is a response, it will just return that response.
            ($credential, $speaksfor) = GeniStd::AddUserCredWhenSpeaksForOnly($credential, $speaksfor, $creds);
        } else {
537 538
	($credential,$speaksfor) = GeniStd::CheckCredentials($creds, $authority);
    }
539 540
    }
    
541 542 543
    return $credential
	if (GeniResponse::IsResponse($credential));
   
544 545 546 547 548
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "refresh" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

549 550 551 552 553
    #
    # 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.
    #
554 555 556
    my $this_user =
	GeniUser->Lookup((defined($speaksfor) ?
			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
557
    if (!defined($this_user)) {
558 559
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
560 561
    }
    
562
    if( !defined( $project_name) && !CheckMembership( $this_user ) ) {
563 564 565 566 567
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN,
				     undef, "No privilege at this " .
				     "authority" );
    }

568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586
    
    if (defined( $project_name) ) {
    # check if the user is a member with correct priviledges 
    # of the project the slice should be created in
    my $project = Project->Lookup( $project_name );
    if (!defined( $project )) {
        return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
            "Project '$project_name' not known");
    }
    if (!$this_user->IsLocal()) {
        return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef, "Who are you? No local record");
    }
    my $emulabuser = $this_user->emulab_user();
    if (! $project->AccessCheck( $emulabuser, EmulabConstants::TB_PROJECT_CREATEEXPT() ) ) {
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN,
            undef, "No privilege for project " . $project_name . "" );
    }
    }

587 588 589 590 591 592 593
    #
    # 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());
	
594
    if ( lc( $type ) eq "slice") {
595
	my $expires = $argref->{'expiration'};
596

597 598 599 600 601
	if (! Experiment->ValidEID($hrn)) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				"$hrn is not a valid slice name");
	}

602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620
	#
	# 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?
621 622
	    # A sitevar controls the sliver lifetime.
	    #
623 624 625
	    my $max_slice_lifetime = 0; 
	    if (!libEmulab::GetSiteVar('protogeni/max_slice_lifetime', 
				       \$max_slice_lifetime)) {
626
		# Cannot get the value, default it to 90 days.
627
		$max_slice_lifetime = 90;
628
	    }
629

630
	    my $diff = $when - time();
631 632 633 634 635 636 637
	    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);
638 639 640 641
		goto bad;
	    }
	  bad:
	    if (defined($message)) {
642 643
		return GeniResponse->Create(GENIRESPONSE_ERROR,
					    undef, $message);
644 645 646
	    }
	    $expires = $when;
	}
647

Gary Wong's avatar
Gary Wong committed
648
	my ($ourdomain, undef, undef) = GeniHRN::Parse( $ENV{ 'MYURN' } );
649 650 651 652 653 654 655 656
	my $urn = defined($project_name) ? 
		GeniHRN::Generate( $server_auth . ':' . $project_name , "slice", $hrn )
	      : GeniHRN::Generate( $ourdomain, "slice", $hrn );
    
        if (!defined($urn)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"internal error creating URN");
        }
657
	
658 659 660 661 662 663 664
	#
	# 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.
	#
665
	my $hrn = "${PGENIDOMAIN}.${hrn}";
666

667 668 669 670 671 672 673 674 675
	#
	# 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");
	}
	    
676
	#
677
	# Generate a certificate for this new slice.
678
	#
679 680 681 682
	my $error;
	my $certificate =
	    GeniCertificate->Create({'urn'  => $urn,
				     'hrn'  => $hrn,
683
				     'showuuid' => 1,
684
				     'email'=> $this_user->email()}, \$error);
685
	if (!defined($certificate)) {
686 687 688 689
	    if (defined($error)) {
		return GeniResponse->Create($error, undef,
					    GENIRESPONSE_STRING($error));
	    }
690 691 692
	    print STDERR "Could not create new certificate for slice\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
693

694
	# Slice is created as locked.
695
	my $slice = GeniSlice->Create($certificate,
696
				      $this_user, $authority, undef, 1);
697 698 699 700 701
	if (!defined($slice)) {
	    $certificate->Delete();
	    print STDERR "Could not create new slice object\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
702
	
703 704
	if (defined($expires) && $slice->SetExpiration($expires) != 0) {
	    print STDERR "Could not set slice expiration to $expires\n";
705
	    $slice->Delete();
706 707
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
708 709 710 711

	#
	# Return a credential for the slice.
	#
712 713 714
	my $slice_credential =
	    GeniCredential->CreateSigned($slice,
					 $this_user,
715 716 717 718
					 $main::PROJECT ?
					 $authority->GetCertificate() :
					 $GeniCredential::LOCALSA_FLAG );

719 720 721 722
	if (!defined($slice_credential)) {
	    $slice->Delete();
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
723 724
	# Okay if this fails.
	$slice_credential->Store();
725 726

	#
727
	# Register new slice and creator at the clearinghouse.
728
	#
729 730 731 732 733 734 735 736 737 738 739 740 741 742 743
	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";
	    }
744
	}
745
	$slice->UnLock();
746

747 748 749 750 751 752 753 754 755 756 757 758
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    $slice_credential->asString());
    }

    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
}

#
# Remove record.
#
sub Remove($)
{
759
    # FIXME once migration to URNs is complete, $type should be removed
760
    # (it's deduced automatically from the URN).
761
    my ($argref) = @_;
762
    my $hrn  = $argref->{'hrn'};
763
    my $urn  = $argref->{'urn'};
764
    my $cred = $argref->{'credential'};
765
    my $type = $argref->{'type'};
766
    my $creds= $argref->{'credentials'};
767

768 769
    if (! ((defined($hrn) || defined($urn)) &&
	   (defined($cred) || defined($creds)))) {
770 771
	return GeniResponse->MalformedArgsResponse();
    }
772 773 774
    if (defined($urn)) {
	return GeniResponse->MalformedArgsResponse()
	    if (!GeniHRN::IsValid($urn));
775
	$hrn = undef;
776
    }
777 778
    elsif (defined($hrn) && GeniHRN::IsValid($hrn)) {
	$urn = $hrn;
779
	$hrn = undef;
780
    }
781
    elsif (defined($hrn) && (!defined($type) || !($hrn =~ /^[-\w\.]*$/))) {
782
	return GeniResponse->MalformedArgsResponse();
783 784
    }
    #
785 786
    # Deprecated (pre-URN) HRN.
    # XXX Form hrn from the uid and domain. This is backwards.
787
    #
788
    if (defined($hrn) && !($hrn =~ /\./)) {
789
	$hrn  = "${PGENIDOMAIN}.${hrn}";
790
    }
791 792
    else {
	(undef,$type,undef) = GeniHRN::Parse($urn);
793
    }
794
    $type = lc($type);
795 796

    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
797 798 799 800
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
801 802 803 804 805 806 807
    my ($credential, $speaksfor);
    if (defined($cred)) {
	$credential = GeniCredential::CheckCredential($cred, $authority);
    }
    else {
	($credential,$speaksfor) = GeniStd::CheckCredentials($creds, $authority);
    }
808 809 810
    return $credential
	if (GeniResponse::IsResponse($credential));
   
811 812 813 814 815
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "refresh" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

816 817 818
    my $this_user =
	GeniUser->Lookup((defined($speaksfor) ?
			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
819
    if (!defined($this_user)) {
820 821
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
822 823
    }
    
824 825 826 827 828 829
    if( !CheckMembership( $this_user ) ) {
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN,
				     undef, "No privilege at this " .
				     "authority" );
    }

830
    if ($type eq "slice") {
831
	my $slice = GeniSlice->Lookup($urn || $hrn);
832 833
	if (!defined($slice)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
834
					"No such slice");
835
	}
836 837 838 839 840 841 842 843 844 845 846 847
	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");
	}
	
848 849 850 851 852 853
	#
	# Not allowed to delete a slice that has not expired since
	# that would make it impossible to control any existing
	# slivers.
	#
	if (! $slice->IsExpired()) {
854
	    $slice->UnLock();
855 856 857
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					"Slice has not expired");
	}
858
	# Needs to move.
859
	GeniSlice::ClientSliver->SliceDelete($slice);
860 861 862

	# Remove any stored credentials for this slice.
	GeniCredential->DeleteForTarget($slice);
863
	
864 865 866 867
	#
	# Remove from the clearing house.
	#
	if ($slice->UnRegister()) {
868 869 870
	    #
	    # Not a fatal error; the CH will age it out eventually. 
	    #
871 872 873 874 875
	    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,
876
					"Slice could not be deleted");
877 878 879 880 881 882 883
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
    }
    
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
884 885 886 887 888 889
#
# Return ssh keys.
#
sub GetKeys($)
{
    my ($argref) = @_;
890
    my $cred     = $argref->{'credential'};
891
    my $creds    = $argref->{'credentials'};
892 893
    # Hidden option. Remove later.
    my $version  = $argref->{'version'} || 1;
894
    my $ignore_subauthority;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
895

896
    if (! (defined($cred) || defined($creds))) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
897 898 899
	return GeniResponse->MalformedArgsResponse();
    }

900
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
901 902 903 904
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
905 906
    my ($credential, $speaksfor);
    if (defined($cred)) {
907 908 909 910 911 912 913 914 915 916 917 918 919
        if (defined ($ignore_subauthority) && $ignore_subauthority) {
	#NOTE:
        #  the check for the credential $authority was removed
        #  this is needed to allow the geni-sa to work without sub authorities
	#  but this ALSO allows sharing with non-project members
        #     That is actually a nice feature. 
        #     The previous restriction to sharing only within a 
        #        project can be reimplemented by checking project membership of the target user manually here. 
	$credential = GeniCredential::CheckCredential($cred);

        } else {
            $credential = GeniCredential::CheckCredential($cred, $authority);
        }
920 921
    }
    else {
922 923 924 925 926 927
        if (defined ($ignore_subauthority) && $ignore_subauthority) {
            #Same note as above about check for matching $authority
	($credential,$speaksfor) = GeniStd::CheckCredentials($creds);
        } else {
            ($credential,$speaksfor) = GeniStd::CheckCredentials($creds, $authority);
        }
928
    }
929 930 931
    return $credential
	if (GeniResponse::IsResponse($credential));
   
932 933 934 935 936
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

937 938 939
    my $this_user =
	GeniUser->Lookup((defined($speaksfor) ?
			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
940
    if (!defined($this_user)) {
941 942
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
943
    }
944
    my $blob;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
945
    my @keys;
946
    if ($this_user->GetKeyBundle(\@keys) != 0) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
947 948 949
	print STDERR "Could not get keys for $this_user\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);	
    }
950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968
    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
969 970 971 972 973 974 975 976 977 978
}

#
# 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) = @_;
979 980 981 982 983 984
    return BindToSliceInternal($argref, 0);
}

sub BindToSliceInternal($$)
{
    my ($argref, $ignore_subauthority) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
985
    my $cred  = $argref->{'credential'};
986
    my $creds = $argref->{'credentials'};
987
    my $urn   = $argref->{'urn'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
988

989
    if (! (defined($urn) && (defined($cred) || defined($creds)))) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
990 991
	return GeniResponse->MalformedArgsResponse();
    }
992 993
    return GeniResponse->MalformedArgsResponse()
	if (defined($urn) && !GeniHRN::IsValid($urn));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
994

995 996 997 998
    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
999
    }
1000 1001
    my ($credential, $speaksfor);
    if (defined($cred)) {
1002
	$credential = GeniCredential::CheckCredential($cred);
1003 1004
    }
    else {
1005
	($credential,$speaksfor) = GeniStd::CheckCredentials($creds);
1006
    }
1007 1008 1009 1010 1011 1012 1013 1014
    return $credential
	if (GeniResponse::IsResponse($credential));
   
    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "bind" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );
    
1015 1016 1017
    my $this_user =
	GeniUser->Lookup((defined($speaksfor) ?
			  $speaksfor->target_urn() : $ENV{'GENIURN'}), 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1018
    if (!defined($this_user)) {
1019 1020
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1021
    }
1022 1023

    my $slice = GeniSlice->Lookup($credential->target_urn());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1024
    if (!defined($slice)) {
1025
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1026 1027 1028 1029 1030 1031
				    "Unknown slice for this credential");
    }
    
    #
    # Locate the target user; must exist locally.
    #
1032
    my $target_user = GeniUser->Lookup($urn, 1);