GeniSA.pm.in 46 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
my $allow_nonproject_slice_share    = 1;
#$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;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
894

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

899
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
900
901
902
903
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
904
905
    my ($credential, $speaksfor);
    if (defined($cred)) {
906
907
908
909
910
911
912
913
914
915
916
917
918
        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);
        }
919
920
    }
    else {
921
922
923
924
925
926
        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);
        }
927
    }
928
929
930
    return $credential
	if (GeniResponse::IsResponse($credential));
   
931
932
933
934
935
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

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

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

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

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

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

    my $slice = GeniSlice->Lookup($credential->target_urn());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1023
    if (!defined($slice)) {
1024
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1025
1026
1027
1028
1029
1030
				    "Unknown slice for this credential");
    }
    
    #
    # Locate the target user; must exist locally.
    #
1031
    my $target_user = GeniUser->Lookup($urn, 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1032
1033
    if (!defined($target_user)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
1034
				    undef, "No such user here");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1035
    }
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
   
    if (defined ($ignore_subauthority) && $ignore_subauthority && ! $allow_nonproject_slice_share) {
        #check if target user is member of project of slice
        my ($slice_authority, $slice_type, $slice_name) = GeniHRN::Parse( $slice->urn() );
        my @slice_auth_parts = split(':', $slice_authority);
        my $slice_auth_parts_size = scalar @slice_auth_parts;
        my $project_id;
        #my $project_urn;
        if ($slice_auth_parts_size == 2) {
            $project_id = $slice_auth_parts[1];
            #$project_urn = GeniHRN::Generate($slice_auth_parts[0], 'project', $slice_auth_parts[1]);
        }
        if (defined($project_id) && !CheckMembershipByProjectId($target_user, $project_id)) {
            return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
                "Target user $urn is not a member of project $project_id to which the target slice belongs" );
        }
    }

1054
1055
1056
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse("slice");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1057
1058
    if ($slice->BindUser($target_user) != 0) {
	print STDERR "Could not bind $target_user to $slice\n";
1059
	$slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1060
1061
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
1062
    $slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1063
1064
1065
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
#
# 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();
    }
1078
    my $credential = GeniCredential::CheckCredential($cred);
1079
1080
    return $credential
	if (GeniResponse::IsResponse($credential));
1081

1082
1083
1084
1085
    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "control" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );
1086
1087
1088
1089
1090
1091

    my $slice = GeniSlice->Lookup($credential->target_urn());
    if (!defined($slice)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "Unknown slice for this credential");
    }
1092
1093
    my $slice_urn = $slice->urn();
    system("$SLICESHUTDOWN $slice_urn");
1094
    if ($?) {
1095
	print STDERR "Could not shutdown $slice_urn!\n";
1096
1097
1098
1099
1100
1101
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Error shutting down slice");
    }
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

1102
1103
1104
1105
1106
1107
#
# Extend a slice expiration time.
#
sub RenewSlice($)
{
    my ($argref) = @_;
1108
1109
    my $cred    = $argref->{'credential'};
    my $creds   = $argref->{'credentials'};
1110
1111
1112
    my $expires = $argref->{'expiration'};
    my $message = "Error renewing slice";

1113
    if (! (defined($cred) || defined($creds)) && defined($expires)) {
1114
1115
1116
	return GeniResponse->Create(GENIRESPONSE_BADARGS);
    }

1117
1118
1119
1120
1121
1122
1123
1124
1125
    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)) {
1126
	$credential = GeniCredential::CheckCredential($cred);
1127
1128
1129
1130
    }
    else {
	($credential,$speaksfor) = GeniStd::CheckCredentials($creds);
    }
1131
1132
1133
1134
1135
1136
1137
1138
1139
    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());
1140
    if (!defined($slice)) {
1141
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
1142
1143
				    "Unknown slice for this credential");
    }
1144

1145
1146
1147
1148
1149
1150
1151
    #
    # Not allowed to renew a cooked mode slice via this interface.
    #
    if ($slice->exptidx()) {
	return