GeniSA.pm.in 35.2 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1
2
#!/usr/bin/perl -wT
#
3
# GENIPUBLIC-COPYRIGHT
4
# Copyright (c) 2008-2011 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5
6
7
8
9
# All rights reserved.
#
package GeniSA;

#
10
11
# 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
12
13
14
15
16
17
18
19
20
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

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

# Must come after package declaration!
21
use libtestbed;
22
use libEmulab;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
23
24
use GeniDB;
use Genixmlrpc;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
25
26
use GeniResponse;
use GeniUser;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
27
28
29
use GeniSlice;
use GeniCredential;
use GeniCertificate;
30
use GeniAuthority;
31
use GeniHRN;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
32
use English;
33
use XML::Simple;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
34
use Data::Dumper;
35
36
37
use Date::Parse;
use POSIX qw(strftime);
use Time::Local;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
38
39
40

# Configure variables
my $TB		   = "@prefix@";
41
my $TBOPS          = "@TBOPSEMAIL@";
42
my $MAINSITE 	   = @TBMAINSITE@;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
43
my $OURDOMAIN      = "@OURDOMAIN@";
44
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
45
my $SLICESHUTDOWN  = "$TB/sbin/protogeni/shutdownslice";
46
my $PROTOGENI_URL  = "@PROTOGENI_URL@";
47
48
my $RegisterNow    = 0;
my $API_VERSION    = 1.01;
49
50
51
52
53
54
55
56
57
58
59

#
# 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
60
#
61
62
63
# 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
64
#
65
66
67
sub GetCredential($)
{
    my ($argref) = @_;
68
    my $urn  = $argref->{'urn'};
69
    my $cred = $argref->{'credential'};
70

71
    if (0 && $MAINSITE) {
72
73
74
	print STDERR "Debugging getslicecred()\n";
    }

75
76
77
78
79
    #
    # No credential, then return a generic credential giving user permission
    # to do other things.
    #
    if (!defined($cred)) {
80
	my $geniuser = GeniUser->Lookup($ENV{'GENIURN'}, 1);
81
	if (!defined($geniuser)) {
82
83
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
					undef, "Who are you?");
84
	}
85

86
87
88
	#
	# This credential is for access to this SA.
	#
89
	my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
90
	if (!defined($authority)) {
91
92
	    print STDERR
		"Could not find local authority object for $ENV{'MYURN'}\n";
93
94
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
	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,
					     $GeniCredential::LOCALSA_FLAG);

	    # Okay if this fails.
	    $credential->Store()
		if (defined($credential));
	}
116
117
118
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!defined($credential));

119
120
121
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    $credential->asString());
    }
122
    return GeniResponse->MalformedArgsResponse()
123
	if (! (defined($urn) && GeniHRN::IsValid($urn)));
124

125
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
126
127
128
129
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
130
131
132
133
    my $credential = CheckCredential($cred, $authority);
    return $credential
	if (GeniResponse::IsResponse($credential));
   
134
135
136
137
138
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

139
    my $this_user = GeniUser->Lookup($ENV{'GENIURN'}, 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
140
141
142
143
    if (!defined($this_user)) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
				    undef, "Who are you?");
    }
144
145
    my ($undef, $type, $id) = GeniHRN::Parse($urn);
	
146
147
    #
    # User provided a credential, and wants a new credential to access
148
    # the object referenced by the URN.
149
    #
150
    if (lc($type) eq "slice") {
151
152
153
154
155
156
157
	#
	# 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());
	
158
	my $slice = GeniSlice->Lookup($urn);
159

Leigh B. Stoller's avatar
Leigh B. Stoller committed
160
161
162
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No such Slice")
	    if (!defined($slice));
163
164
165
	if ($slice->Lock() != 0) {
	    return GeniResponse->BusyResponse("slice");
	}
166
	if ($slice->creator_urn() ne $this_user->urn() &&
167
168
169
170
171
	    !$slice->IsBound($this_user)) {
	    $slice->UnLock();
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					"Not your slice!");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
172
173
174
	#
	# Return a credential for the slice.
	#
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
	my $slice_credential = GeniCredential->Lookup($slice, $this_user);
	if (defined($slice_credential)) {
	    #
	    # Check for expiration and for changed certificate.
	    #
	    if ($slice_credential->IsExpired() ||
		!$slice_credential->SameCerts($slice, $this_user)) {
		$slice_credential->Delete();
		$slice_credential = undef;
	    }
	}
	if (!defined($slice_credential)) {
	    $slice_credential =
		GeniCredential->CreateSigned($slice,
					     $this_user,
					     $GeniCredential::LOCALSA_FLAG);
	    # Okay if this fails.
	    $slice_credential->Store()
		if (defined($slice_credential));
	}
195
196
197
198
199
	if (!defined($slice_credential)) {
	    $slice->UnLock();
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	$slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
200
201
202
203
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    $slice_credential->asString());
    }
    
204
205
206
207
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
}

#
208
# Resolve a record.
209
210
211
212
213
#
sub Resolve($)
{
    my ($argref) = @_;
    my $hrn  = $argref->{'hrn'};
214
    my $urn  = $argref->{'urn'};
215
216
217
    my $cred = $argref->{'credential'};
    my $type = $argref->{'type'};

218
    if (! (defined($hrn) || defined($urn))) {
219
220
	return GeniResponse->MalformedArgsResponse();
    }
221
222
223
224
225
    # URN always takes precedence and all items should now have URNs
    # in their certificates.
    if (defined($urn)) {
	return GeniResponse->MalformedArgsResponse()
	    if (!GeniHRN::IsValid($urn));
226
	$hrn = undef;
227
    }
228
229
    elsif (defined($hrn) && GeniHRN::IsValid($hrn)) {
	$urn = $hrn;
230
	$hrn = undef;
231
    }
232
    elsif (defined($hrn) && (!defined($type) || !($hrn =~ /^[-\w\.]*$/))) {
233
234
	return GeniResponse->MalformedArgsResponse();
    }
235
236
237
238
239
    #
    # Deprecated (pre-URN) HRN.
    # XXX Form hrn from the uid and domain. This is backwards.
    #
    if (defined($hrn) && !($hrn =~ /\./)) {
240
241
242
243
	$hrn  = "${PGENIDOMAIN}.${hrn}";
    }
    else {
	(undef,$type,undef) = GeniHRN::Parse($urn);
244
    }
245
    $type = lc($type);
246
247
248
249
    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
    
250
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
251
252
253
254
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
255
256
257
258
    my $credential = CheckCredential($cred, $authority);
    return $credential
	if (GeniResponse::IsResponse($credential));
   
259
260
261
262
263
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

264
265
266
267
268
    #
    # 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.
    #
269
    my $this_user = GeniUser->Lookup($ENV{'GENIURN'}, 1);
270
    if (!defined($this_user)) {
271
272
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
273
    }
274
    my $lookup_token = $urn || $hrn;
275
    
276
    if ($type eq "user") {
277
	my $geniuser = GeniUser->Lookup($lookup_token, 1);
278
	if (!defined($geniuser)) {
279
280
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					"No one here by that name");
281
	}
282
283

	my @slices = GeniSlice->LookupByCreator( $geniuser );
284
285
	# Cull out cooked mode slices.
	@slices = grep {!defined($_->exptidx())} @slices;
286
	my @sliceURNs = map( $_->urn(), @slices );
287

288
289
290
	# Return a blob.
	my $blob = { "uid"      => $geniuser->uid(),
		     "hrn"      => $geniuser->hrn(),
291
		     "urn"      => $geniuser->urn(),
292
293
		     "uuid"     => $geniuser->uuid(),
		     "email"    => $geniuser->email(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
294
		     "gid"      => $geniuser->cert(),
295
		     "name"     => $geniuser->name(),
296
		     "slices"   => \@sliceURNs
297
		    };
298
299
300
301
302
303
304
305
306
307
308
309

	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");
310
		    my $url = "$PROTOGENI_URL/project/$pid/sa";
311
312
313
314
315
316
		    $subsas{$urn} = $url;
		}
		$blob->{'subauthorities'} = \%subsas;
	    }
	}

317
318
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
319
    if ($type eq "slice") {
320
	my $slice = GeniSlice->Lookup($lookup_token);
321
322
	if (!defined($slice)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
323
					"No such slice registered here");
324
	}
325
326
327
	if ($slice->Lock() != 0) {
	    return GeniResponse->BusyResponse("slice");
	}
328
	my @slivers = GeniSlice::ClientSliver->LookupBySlice($slice);
329
330
331
332
	my @managers = ();
	foreach my $sliver (@slivers) {
	    push(@managers, $sliver->manager_urn());
	}
333
334
	# Return a blob.
	my $blob = { "hrn"          => $slice->hrn(),
335
		     "urn"          => $slice->urn(),
336
337
		     "uuid"         => $slice->uuid(),
		     "creator_uuid" => $slice->creator_uuid(),
338
		     "creator_urn"  => $slice->creator_urn(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
339
		     "gid"          => $slice->cert(),
340
		     "urn"          => $slice->urn(),
341
		     "component_managers" => \@managers
342
		 };
343
	$slice->UnLock();
344
345
346
347
348
349
350
351
352
353
354
355
356
357
	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($)
{
358
359
    # FIXME once migration to URNs is complete, $type should be removed
    # (it's deduced automatically from the URN).
360
361
362
363
    my ($argref) = @_;
    my $cred  = $argref->{'credential'};
    my $type  = $argref->{'type'};
    my $hrn   = $argref->{'hrn'};
364
    my $urn   = $argref->{'urn'};
365

366
    if (! ((defined($hrn) || defined($urn)) && defined($cred))) {
367
368
	return GeniResponse->MalformedArgsResponse();
    }
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
    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);
387

388
389
390
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Authority mismatch")
	    if ($auth ne $OURDOMAIN);
391

392
393
394
395
	#
	# The user can supply a URN, but only the type and id
	# really matter. The URN is ignored below.
	#
396
	$type = $t;
397
	$hrn  = $id;
398
    }
399
400
    elsif (!defined($type)) {
	return GeniResponse->MalformedArgsResponse();
401
402
    }

403
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
404
405
406
407
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
408
409
410
411
    my $credential = CheckCredential($cred, $authority);
    return $credential
	if (GeniResponse::IsResponse($credential));
   
412
413
414
415
416
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "refresh" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

417
418
419
420
421
    #
    # 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.
    #
422
    my $this_user = GeniUser->Lookup($ENV{'GENIURN'}, 1);
423
    if (!defined($this_user)) {
424
425
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
426
427
    }
    
428
429
430
431
432
433
434
    #
    # 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());
	
435
    if ( lc( $type ) eq "slice") {
436
	my $expires = $argref->{'expiration'};
437

438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
	#
	# 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?
457
458
	    # A sitevar controls the sliver lifetime.
	    #
459
460
461
	    my $max_slice_lifetime = 0; 
	    if (!libEmulab::GetSiteVar('protogeni/max_slice_lifetime', 
				       \$max_slice_lifetime)) {
462
		# Cannot get the value, default it to 90 days.
463
		$max_slice_lifetime = 90;
464
	    }
465

466
	    my $diff = $when - time();
467
468
469
470
471
472
473
	    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);
474
475
476
477
		goto bad;
	    }
	  bad:
	    if (defined($message)) {
478
479
		return GeniResponse->Create(GENIRESPONSE_ERROR,
					    undef, $message);
480
481
482
	    }
	    $expires = $when;
	}
483
	
Gary Wong's avatar
Gary Wong committed
484
485
	my ($ourdomain, undef, undef) = GeniHRN::Parse( $ENV{ 'MYURN' } );
	my $urn = GeniHRN::Generate( $ourdomain, "slice", $hrn );
486
	
487
488
489
490
491
492
493
	#
	# 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.
	#
494
	my $hrn = "${PGENIDOMAIN}.${hrn}";
495

496
497
498
499
500
501
502
503
504
	#
	# 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");
	}
	    
505
	#
506
	# Generate a certificate for this new slice.
507
	#
508
509
510
511
512
	my $error;
	my $certificate =
	    GeniCertificate->Create({'urn'  => $urn,
				     'hrn'  => $hrn,
				     'email'=> $this_user->email()}, \$error);
513
	if (!defined($certificate)) {
514
515
516
517
	    if (defined($error)) {
		return GeniResponse->Create($error, undef,
					    GENIRESPONSE_STRING($error));
	    }
518
519
520
521
	    print STDERR "Could not create new certificate for slice\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	
522
	# Slice is created as locked.
523
	my $slice = GeniSlice->Create($certificate,
524
				      $this_user, $authority, undef, 1);
525
526
527
528
529
	if (!defined($slice)) {
	    $certificate->Delete();
	    print STDERR "Could not create new slice object\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
530
	
531
532
	if (defined($expires) && $slice->SetExpiration($expires) != 0) {
	    print STDERR "Could not set slice expiration to $expires\n";
533
	    $slice->Delete();
534
535
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
536
537
538
539

	#
	# Return a credential for the slice.
	#
540
541
542
543
	my $slice_credential =
	    GeniCredential->CreateSigned($slice,
					 $this_user,
					 $GeniCredential::LOCALSA_FLAG);
544
545
546
547
	if (!defined($slice_credential)) {
	    $slice->Delete();
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
548
549
	# Okay if this fails.
	$slice_credential->Store();
550
551

	#
552
	# Register new slice and creator at the clearinghouse.
553
	#
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
	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";
	    }
569
	}
570
	$slice->UnLock();
571
572
573
574
575
576
577
578
579
580
581
582
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    $slice_credential->asString());
    }

    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
}

#
# Remove record.
#
sub Remove($)
{
583
    # FIXME once migration to URNs is complete, $type should be removed
584
    # (it's deduced automatically from the URN).
585
    my ($argref) = @_;
586
    my $hrn  = $argref->{'hrn'};
587
    my $urn  = $argref->{'urn'};
588
    my $cred = $argref->{'credential'};
589
    my $type = $argref->{'type'};
590

591
    if (! ((defined($hrn) || defined($urn)) && defined($cred))) {
592
593
	return GeniResponse->MalformedArgsResponse();
    }
594
595
596
    if (defined($urn)) {
	return GeniResponse->MalformedArgsResponse()
	    if (!GeniHRN::IsValid($urn));
597
	$hrn = undef;
598
    }
599
600
    elsif (defined($hrn) && GeniHRN::IsValid($hrn)) {
	$urn = $hrn;
601
	$hrn = undef;
602
    }
603
    elsif (defined($hrn) && (!defined($type) || !($hrn =~ /^[-\w\.]*$/))) {
604
	return GeniResponse->MalformedArgsResponse();
605
606
    }
    #
607
608
    # Deprecated (pre-URN) HRN.
    # XXX Form hrn from the uid and domain. This is backwards.
609
    #
610
    if (defined($hrn) && !($hrn =~ /\./)) {
611
	$hrn  = "${PGENIDOMAIN}.${hrn}";
612
    }
613
614
    else {
	(undef,$type,undef) = GeniHRN::Parse($urn);
615
    }
616
    $type = lc($type);
617
618

    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
619
620
621
622
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
623
624
625
626
    my $credential = CheckCredential($cred, $authority);
    return $credential
	if (GeniResponse::IsResponse($credential));
   
627
628
629
630
631
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "refresh" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

632
    my $this_user = GeniUser->Lookup($ENV{'GENIURN'}, 1);
633
    if (!defined($this_user)) {
634
635
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
636
637
    }
    
638
    if ($type eq "slice") {
639
	my $slice = GeniSlice->Lookup($urn || $hrn);
640
641
	if (!defined($slice)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
642
					"No such slice");
643
	}
644
645
646
647
648
649
650
651
652
653
654
655
	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");
	}
	
656
657
658
659
660
661
	#
	# Not allowed to delete a slice that has not expired since
	# that would make it impossible to control any existing
	# slivers.
	#
	if (! $slice->IsExpired()) {
662
	    $slice->UnLock();
663
664
665
	    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
					"Slice has not expired");
	}
666
	# Needs to move.
667
	GeniSlice::ClientSliver->SliceDelete($slice);
668
669
670

	# Remove any stored credentials for this slice.
	GeniCredential->DeleteForTarget($slice);
671
	
672
673
674
675
	#
	# Remove from the clearing house.
	#
	if ($slice->UnRegister()) {
676
677
678
	    #
	    # Not a fatal error; the CH will age it out eventually. 
	    #
679
680
681
682
683
	    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,
684
					"Slice could not be deleted");
685
686
687
688
689
690
691
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
    }
    
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
692
693
694
695
696
697
#
# Return ssh keys.
#
sub GetKeys($)
{
    my ($argref) = @_;
698
699
700
    my $cred     = $argref->{'credential'};
    # Hidden option. Remove later.
    my $version  = $argref->{'version'} || 1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
701
702
703
704
705

    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }

706
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
707
708
709
710
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
711
712
713
714
    my $credential = CheckCredential($cred, $authority);
    return $credential
	if (GeniResponse::IsResponse($credential));
   
715
716
717
718
719
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

720
    my $this_user = GeniUser->Lookup($ENV{'GENIURN'}, 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
721
    if (!defined($this_user)) {
722
723
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
724
    }
725
    my $blob;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
726
    my @keys;
727
    if ($this_user->GetKeyBundle(\@keys) != 0) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
728
729
730
	print STDERR "Could not get keys for $this_user\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);	
    }
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
    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
750
751
752
753
754
755
756
757
758
759
760
}

#
# 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'};
761
    my $urn   = $argref->{'urn'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
762

763
    if (! (defined($urn) && defined($cred))) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
764
765
	return GeniResponse->MalformedArgsResponse();
    }
766
767
    return GeniResponse->MalformedArgsResponse()
	if (defined($urn) && !GeniHRN::IsValid($urn));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
768

769
770
771
772
    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
773
    }
774
    my $credential = CheckCredential($cred);
775
776
777
778
779
780
781
782
783
    return $credential
	if (GeniResponse::IsResponse($credential));
   
    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "bind" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );
    
    my $this_user = GeniUser->Lookup($ENV{'GENIURN'}, 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
784
    if (!defined($this_user)) {
785
786
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
787
    }
788
789

    my $slice = GeniSlice->Lookup($credential->target_urn());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
790
    if (!defined($slice)) {
791
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
792
793
794
795
796
797
				    "Unknown slice for this credential");
    }
    
    #
    # Locate the target user; must exist locally.
    #
798
    my $target_user = GeniUser->Lookup($urn, 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
799
800
    if (!defined($target_user)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
801
				    undef, "No such user here");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
802
    }
803
804
805
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse("slice");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
806
807
    if ($slice->BindUser($target_user) != 0) {
	print STDERR "Could not bind $target_user to $slice\n";
808
	$slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
809
810
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
811
    $slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
812
813
814
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

815
816
817
818
819
820
821
822
823
824
825
826
#
# 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();
    }
827
828
829
    my $credential = CheckCredential($cred);
    return $credential
	if (GeniResponse::IsResponse($credential));
830

831
832
833
834
    $credential->HasPrivilege( "pi" ) or
	$credential->HasPrivilege( "control" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );
835
836
837
838
839
840

    my $slice = GeniSlice->Lookup($credential->target_urn());
    if (!defined($slice)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "Unknown slice for this credential");
    }
841
842
    my $slice_urn = $slice->urn();
    system("$SLICESHUTDOWN $slice_urn");
843
    if ($?) {
844
	print STDERR "Could not shutdown $slice_urn!\n";
845
846
847
848
849
850
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Error shutting down slice");
    }
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

851
852
853
854
855
856
857
858
859
860
861
862
863
864
#
# Extend a slice expiration time.
#
sub RenewSlice($)
{
    my ($argref) = @_;
    my $credstr = $argref->{'credential'};
    my $expires = $argref->{'expiration'};
    my $message = "Error renewing slice";

    if (! (defined($credstr) && defined($expires))) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS);
    }

865
866
867
868
869
870
871
872
873
874
    my $credential = CheckCredential($credstr);
    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());
875
    if (!defined($slice)) {
876
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
877
878
				    "Unknown slice for this credential");
    }
879
880
881
882
883
884
885
    #
    # Not allowed to renew a cooked mode slice via this interface.
    #
    if ($slice->exptidx()) {
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Cooked mode Slice");
    }
886

887
    my $this_user = GeniUser->Lookup($ENV{"GENIURN"}, 1);
888
    if (!defined($this_user)) {
889
890
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Who are you? No local record");
891
892
    }
    
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
    #
    # Figure out new expiration time; this is the time at which we can
    # idleswap the slice out. 
    #
    if (! ($expires =~ /^[-\w:.\/]+/)) {
	$message = "Illegal characters in expiration";
	goto bad;
    }
    # Convert to a localtime.
    my $when = timegm(strptime($expires));
    if (!defined($when)) {
	$message = "Could not parse expiration";
	goto bad;
    }
    #
    # Do we need a policy limit?
909
    # A sitevar controls the sliver lifetime.
910
    #
911
912
913
    my $max_slice_lifetime = 0; 
    if (!libEmulab::GetSiteVar('protogeni/max_slice_lifetime', 
			       \$max_slice_lifetime)) {
914
        # Cannot get the value, default it to 90 days.
915
        $max_slice_lifetime = 90;
916
917
    }

918
919
    my $diff = $when - time();

920
921
922
923
924
925
926
    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);
927
928
929
930
931
932
	goto bad;
    }
    if ($when < time()) {
	$message = "Expiration is in the past";
	goto bad;
    }
933
934
935
936
    if ($when < timegm( strptime( $slice->expires() ) ) ) {
	$message = "Cannot shorten slice lifetime";
	goto bad;
    }
937
938
939
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse("slice");
    }
940
941
    if ($slice->SetExpiration($when) != 0) {
	$message = "Could not set expiration time";
942
	$slice->UnLock();
943
944
	goto bad;
    }
945
946
947
948
    #
    # Tell the clearinghouse about the new expiration.
    #
    $slice->SetRegisteredFlag(0);
949
    if ($RegisterNow && $slice->Register() != 0) {
950
951
952
953
954
955
	#
	# Non-fatal; the sa_daemon will do it later.
	#
	print STDERR "Could not update $slice at the clearinghouse\n";
    }
    
956
957
958
    # Remove any stored credentials for this slice so callers get new ones.
    GeniCredential->DeleteForTarget($slice);

959
960
961
962
963
964
965
966
967
968
969
970
    #
    # Return a credential for the slice.
    #
    my $slice_credential =
	GeniCredential->CreateSigned($slice,
				     $this_user,
				     $GeniCredential::LOCALSA_FLAG);
    if (!defined($slice_credential)) {
	$slice->UnLock();
	$message = "Could not create new slice credential";
	goto bad;
    }
971
    $slice->UnLock();
972
973
    return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				$slice_credential->asString());
974
975
976
977
  bad:
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef, $message);
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
#
# Register a sliver.
#
sub RegisterSliver($)
{
    my ($argref) = @_;
    my $credstr  = $argref->{'credential'};
    my $slice_urn= $argref->{'slice_urn'};
    my $blob     = $argref->{'info'};

    if (! (defined($blob) && defined($slice_urn) && defined($credstr))) {
	return GeniResponse->MalformedArgsResponse("Missing Arguments");
    }
    if (!GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad URN");
    }

995
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
996
997
998
999
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
1000
    my $credential = CheckCredential($credstr);
1001
1002
1003
    return $credential
	if (GeniResponse::IsResponse($credential));
   
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1004
1005
1006
1007
1008
1009
1010
1011
1012
    $credential->HasPrivilege( "authority" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

    my $slice = GeniSlice->Lookup($slice_urn);
    if (!defined($slice)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No such slice here");
    }
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052

    if ($credential->target_urn() eq $authority->urn()) {
	#
	# Old permission check until all CMs are updated to send a
	# proper sliver credential instead of bogus self signed
	# credential.
	#
	my ($o_domain,$o_type,$o_id) =
	    GeniHRN::Parse($credential->owner_urn());
	if (! ($o_type eq "authority" && $o_id eq "cm")) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					"Credential owner is not a CM");
	}
    }
    else {
	#
	# New Permission check. The best we can do is make sure the
	# caller is a CM, and the same CM that signed the credential,
	# and the same CM as the sliver. This means that an errant CM
	# can register a sliver for another slice, but not much we can
	# do about that, without delegation. Not yet.
	#
	my ($o_domain,$o_type,$o_id) =
	    GeniHRN::Parse($credential->owner_urn());
	if (! ($o_type eq "authority" && $o_id eq "cm")) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					"Credential owner is not a CM");
	}
	my ($t_domain,$t_type,$t_id) =
	    GeniHRN::Parse($credential->target_urn());
	if (! ($t_type eq "sliver")) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					"Credential target is not a Sliver");
	}
	if ($t_domain ne $o_domain) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				"Target domain is different then owner");
	}
    }
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
    # The user is embedded in the blob.
    if (!exists($blob->{'creator_urn'})) {
	return GeniResponse->MalformedArgsResponse("Please tell me creator");
    }
    my $user = GeniUser->Lookup($blob->{'creator_urn'}, 1);
    if (!defined($user)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No such user here");
    }
    if (!exists($blob->{'urn'})) {
	return GeniResponse->MalformedArgsResponse("Please tell me the urn");
    }
    my $manager_urn = $credential->owner_cert()->urn();
    if (!defined($manager_urn)) {
	print STDERR "No URN in $credential\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
1070
1071
1072
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse("slice");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1073
1074
1075
1076
    #
    # See if one already exists; overwrite it.
    #
    my $clientsliver =
1077
	GeniSlice::ClientSliver->LookupByAuthority($slice, $manager_urn);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1078
1079
1080
1081
    $clientsliver->Delete()
	if (defined($clientsliver));
    
    $clientsliver =
1082
	GeniSlice::ClientSliver->Create($slice, $manager_urn, $user, $blob);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1083
1084
1085
    if (!defined($clientsliver)) {
	print STDERR "Could not register sliver for $slice_urn\n";
	print STDERR Dumper($blob);
1086
	$slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1087
1088
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
1089
    $slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

#
# UnRegister a sliver.
#
sub UnRegisterSliver($)
{
    my ($argref) = @_;
    my $credstr  = $argref->{'credential'};
    my $slice_urn= $argref->{'slice_urn'};

    if (! (defined($slice_urn) && defined($credstr))) {
	return GeniResponse->MalformedArgsResponse("Missing Arguments");
    }
    if (!GeniHRN::IsValid($slice_urn)) {
	return GeniResponse->MalformedArgsResponse("Bad URN");
    }
1108
    my $authority = GeniAuthority->Lookup($ENV{'MYURN'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1109
1110
1111
1112
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
1113
    my $credential = CheckCredential($credstr);
1114
1115
1116
    return $credential
	if (GeniResponse::IsResponse($credential));
   
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1117
1118
1119
1120
    $credential->HasPrivilege( "authority" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
    if ($credential->target_urn() eq $authority->urn()) {
	#
	# Old permission check until all CMs are updated to send a
	# proper sliver credential instead of bogus self signed
	# credential.
	#
	my ($o_domain,$o_type,$o_id) =
	    GeniHRN::Parse($credential->owner_urn());
	if (! ($o_type eq "authority" && $o_id eq "cm")) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					"Credential owner is not a CM");
	}
    }
    else {
	#
	# New Permission check. The best we can do is make sure the
	# caller is a CM, and the same CM that signed the credential,
	# and the same CM as the sliver. This means that an errant CM
	# can register a sliver for another slice, but not much we can
	# do about that, without delegation. Not yet.
	#
	my ($o_domain,$o_type,$o_id) =
	    GeniHRN::Parse($credential->owner_urn());
	if (! ($o_type eq "authority" && $o_id eq "cm")) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					"Credential owner is not a CM");
	}
	my ($t_domain,$t_type,$t_id) =
	    GeniHRN::Parse($credential->target_urn());
	if (! ($t_type eq "sliver")) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
					"Credential target is not a Sliver");
	}
	if ($t_domain ne $o_domain) {
	    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				"Target domain is different then owner");
	}
    }
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
    my $slice = GeniSlice->Lookup($slice_urn);
    if (!defined($slice)) {
	return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
				    "No such slice here");
    }

    my $manager_urn = $credential->owner_cert()->urn();
    if (!defined($manager_urn)) {
	print STDERR "No URN in $credential\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
1171
1172
1173
    if ($slice->Lock() != 0) {
	return GeniResponse->BusyResponse("slice");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1174
1175
1176
1177
    #
    # See if one already exists; overwrite it.
    #
    my $clientsliver =
1178
	GeniSlice::ClientSliver->LookupByAuthority($slice, $manager_urn);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1179
1180
1181
1182

    $clientsliver->Delete()
	if (defined($clientsliver));
    
1183
    $slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1184
1185
1186
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
#
# Initial credential check.
#
sub CheckCredential($;$)
{
    my ($credstring, $authority) = @_;

    my $credential = GeniCredential->CreateFromSigned($credstring);
    if (!defined($credential)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create credential object");
    }
    #
    # Well formed credentials must now have URNs.
    #
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"Malformed credentials; missing URNs")
	if (! (defined($credential->owner_urn()) &&
	       defined($credential->target_urn()) &&
	       GeniHRN::IsValid($credential->owner_urn()) &&
	       GeniHRN::IsValid($credential->target_urn())));
	
    #
    # Make sure the credential was issued to the caller.
    #
    if ($credential->owner_urn() ne $ENV{'GENIURN'}) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "This is not your credential");
    }
    #
    # If an authority is provided, the target must match the authority.
    #
    return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				"This credential is for another authority!")
	if (defined($authority) &&
	    $credential->target_urn() ne $authority->urn());
	
    return $credential;
}

1227
1228
# _Always_ make sure that this 1 is at the end of the file...
1;