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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
9
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
10
# The server side of the Geni ClearingHouse API. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
11
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
12
13
14
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);
15

Leigh B. Stoller's avatar
Leigh B. Stoller committed
16
17
@ISA    = "Exporter";
@EXPORT = qw ( );
18

19
#use Devel::TraceUse;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
20
use GeniDB;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
21
use Genixmlrpc;
22
use GeniRegistry;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
23
use GeniResponse;
24
use GeniUser;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
25
use GeniComponent;
26
use GeniHRN;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
27
use GeniAuthority;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
28
use emutil;
29
use libtestbed qw(SENDMAIL);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
30
31
32
33
34
35
36
37
38
39
use English;
use Data::Dumper;

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
40
my $SLICESHUTDOWN  = "$TB/sbin/protogeni/shutdownslice";
41

42
43
44
45
46
47
48
49
50
51
52
53
my $API_VERSION = 1;

#
# 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
54
#
55
56
57
58
# Get a credential to use the ClearingHouse. For the moment, the initial
# credential will be provided to callers with the proper certificate, which
# means just SAs/CMs that we know about via the ssl certificate used to
# connect to us.
59
#
60
sub GetCredential($)
61
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
62
63
    my ($argref) = @_;
    my $uuid = $argref->{'uuid'};
64
65
    my $cred = $argref->{'credential'};
    my $type = $argref->{'type'};
66
    my $gid  = $argref->{'gid'} || $argref->{'cert'};
67

68
69
70
71
72
73
    #
    # The caller has to be known to us, but how are they known to us?
    # Probably need a web interface? 
    #
    my $caller_uuid = $ENV{'GENIUUID'};
    my $caller_authority = GeniAuthority->Lookup($ENV{'GENIUUID'});
Leigh B. Stoller's avatar
Leigh B. Stoller committed
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
    if (!defined($caller_authority)) {
        if (!defined($gid)) {
	    return GeniResponse->Create(GENIRESPONSE_REFUSED,
					undef, "Who are You?");
	}
	#
	# Must be a new site. We could not have gotten this far without
	# their CA certificate being know to us, so lets just register them
	# and tell tbops about it.
	#
	if (! ($gid =~ /^[\012\015\040-\176]*$/)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"cert: Invalid characters");
	}
	my $certificate = GeniCertificate->LoadFromString($gid);
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not parse certificate")
	    if (!defined($certificate));

Leigh B. Stoller's avatar
Leigh B. Stoller committed
93
94
	print STDERR "GetCredential(): " . $certificate->DN() . "\n";

Leigh B. Stoller's avatar
Leigh B. Stoller committed
95
96
97
98
	if (! ($certificate->uuid() =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Improper format for uuid");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
99
	if (! ($certificate->hrn() =~ /^[-\w\.]+$/)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
100
101
102
103
104
105
106
107
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Improper format for hrn");
	}
	my $url = $certificate->URL();
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not find URL in the certificate")
	    if (!defined($url));

108
109
110
111
112
	if ($certificate->hrn() =~ /^unknown/i) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Please define PROTOGENI_DOMAIN");
	}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
	#
	# Check for an existing authority. 
	#
	if (GeniAuthority->CheckExisting("sa", $certificate->uuid(), 
					 $certificate->hrn()) != 0) {
	    print STDERR "Attempt to register existing slice authority\n";
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Slice Authority already exists");
	}

	SENDMAIL($TBOPS, "New ProtoGeni Authority",
		 $certificate->asText());

	$caller_authority = GeniAuthority->Create($certificate, $url, "sa");
	if (!defined($caller_authority)) {
	    print STDERR "Could not create new geni authority\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not create new GeniAuthority");
	}
    }
133
134
135
136
137
138
139
140
141
142
143
144
145
146
    
    #
    # No credential, then return a generic credential giving caller permission
    # to do other things.
    #
    if (!defined($cred)) {
	#
	# This credential is for access to this authority.
	#
	my $authority = GeniAuthority->Lookup($ENV{'MYUUID'});
	if (!defined($authority)) {
	    print STDERR "Could not find local authority object\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
147
148
149
150
151
152
153
154

	my $credential =
	    GeniCredential->CreateSigned($authority,
					 $caller_authority,
					 $GeniCredential::LOCALMA_FLAG);
	return GeniResponse->Create(GENIRESPONSE_ERROR)
	    if (!defined($credential));

155
156
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    $credential->asString());
157
158
    }

159
160
161
162
163
    #
    # User provided a credential, and wants a new credential to access
    # the object referenced by the uuid.
    #
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
164
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
165

166
167
168
169
170
##
# Lookup a UUID and return a blob of stuff. We allow lookups of both
# users and slices, which is what we allow clients to register.
#
sub Resolve($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
171
172
{
    my ($argref) = @_;
173
    my $cred = $argref->{'credential'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
174
    my $uuid = $argref->{'uuid'};
175
    my $hrn  = $argref->{'hrn'};
176
    my $type = $argref->{'type'};
177
    my $urn  = undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
178

179
180
181
182
183
184
    if (! (defined($uuid) || defined($hrn))) {
	return GeniResponse->MalformedArgsResponse();
    }
    if (defined($uuid) && defined($hrn)) {
	return GeniResponse->MalformedArgsResponse();
    }
185
186
187
188
    $urn = $uuid if (defined($uuid) && GeniHRN::IsValid( $uuid ));
    $urn = $hrn if (defined($hrn) && GeniHRN::IsValid( $hrn ));
    if (defined($urn)) {
	my ($auth,$t,$id) = GeniHRN::Parse( $urn );
Leigh B. Stoller's avatar
Leigh B. Stoller committed
189
190
	my $manager_urn = GeniHRN::Generate($auth, "authority", "cm");
	my $authority   = GeniAuthority->Lookup($manager_urn);
191

192
193
#	print STDERR "$authority, $urn\n";
	
194
	return GeniResponse->Create(GENIRESPONSE_DBERROR)
195
196
197
	    if (!defined($authority));

	my ($translated) = $authority->hrn() =~ /^([-\w]+)\..*/;
198

Leigh B. Stoller's avatar
Leigh B. Stoller committed
199
200
#	print STDERR "$auth, $t, $id, $translated\n";

201
202
203
204
205
206
207
208
209
	if ($t eq "node") {
	    $type = "Component";
	}
	elsif ($t eq "authority") {
	    $type = $id;
	}
	else {
	    $type = $t;
	}
210
	$hrn = $translated . "." . $id;
211
#	print STDERR "$auth, $t, $id, $hrn, $type\n";
212
213
	$uuid = undef;
    }
214
215
216
217
    if (defined($uuid) && !($uuid =~ /^[-\w]*$/)) {
	return GeniResponse->MalformedArgsResponse();
    }
    if (defined($hrn) && !($hrn =~ /^[-\w\.]*$/)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
218
219
	return GeniResponse->MalformedArgsResponse();
    }
220
    if (! (defined($type) && ($type =~ /^(SA|CM|MA|Component|Slice|User)$/i))){
221
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
222
    }
223
    $type = lc($type);
224
225
226
227
228
229
230
    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
    my $credential = GeniCredential->CreateFromSigned($cred);
    if (!defined($credential)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create GeniCredential object");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
231
    }
232
    my $lookup_token = ($uuid || $hrn);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
233

234
235
236
237
    #
    # Make sure the credential was issued to the caller.
    #
    if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
238
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
239
240
241
242
243
244
245
246
247
248
				    "This is not your credential!");
    }
    #
    # And that the target of the credential is this registry.
    #
    my $authority = GeniAuthority->Lookup($ENV{'MYUUID'});
    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
249
    if ($credential->target_uuid() ne $authority->uuid()) {
250
251
252
253
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
				    undef, "This is not your registry!");
    }

254
255
256
257
258
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

259
260
    if ($type eq "user") {
	my $user = GeniUser->Lookup($lookup_token);
261
262
	if (!defined($user)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
263
					"No such user $lookup_token");
264
265
266
267
268
269
270
	}

	# Return a blob.
	my $blob = { "uid"      => $user->uid(),
		     "hrn"      => $user->hrn(),
		     "uuid"     => $user->uuid(),
		     "email"    => $user->email(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
271
		     "gid"      => $user->cert(),
272
273
274
275
276
		     "name"     => $user->name(),
		     "sa_uuid"  => $user->sa_uuid(),
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
277
278
    if ($type eq "component") {
	my $component = GeniComponent->Lookup($lookup_token);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
279
280
281
	
	if (!defined($component)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
282
					"No such component $lookup_token");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
283
	}
Leigh B Stoller's avatar
Leigh B Stoller committed
284
	my $manager = $component->GetManager();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
285
286

	# Return a blob.
Leigh B Stoller's avatar
Leigh B Stoller committed
287
288
289
	my $blob = { "gid"         => $component->cert(),
		     "url"         => $component->url(),
		     "manager_gid" => $manager->cert(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
290
291
292
293
		 };
    
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
294
    if ($type eq "sa") {
295
	my $authority = GeniAuthority->Lookup($lookup_token);
296
297
	if (!defined($authority)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
298
					"No such authority $lookup_token");
299
300
	}
	# Return a blob.
301
	my $blob = { "gid"         => $authority->cert(),
302
		     "url"         => $authority->url(),
303
		     "type"        => $authority->type(),
304
305
306
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
307
308
    if ($type eq "cm") {
	my $manager = GeniAuthority->Lookup($lookup_token);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
309
	if (!defined($manager)) {
310
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
311
					"No such manager $lookup_token");
312
313
	}
	# Return a blob.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
314
315
	my $blob = { "gid"         => $manager->cert(),
		     "url"         => $manager->url(),
316
		     "type"        => $manager->type(),
317
318
319
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
320
    if ($type eq "ma") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
321
322
323
324
325
326
	#
	# I think the MA is the ClearingHouse?
	#
	# Return a blob.
	my $blob = { "gid"         => $authority->cert(),
		     "url"         => $authority->url(),
327
		     "type"        => $authority->type(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
328
329
330
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
331
    if ($type eq "slice") {
332
	my $slice = GeniRegistry::GeniSlice->Lookup($lookup_token);
333
334
	if (!defined($slice)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
335
					"No such slice $lookup_token");
336
337
338
339
340
341
	}

	# Return a blob.
	my $blob = { "hrn"          => $slice->hrn(),
		     "uuid"         => $slice->uuid(),
		     "creator_uuid" => $slice->creator_uuid(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
342
		     "gid"          => $slice->cert(),
343
344
345
346
347
		     "sa_uuid"      => $slice->sa_uuid(),
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
348
349
}

350
351
##
# Register a new object.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
352
#
353
sub Register($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
354
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
355
    my ($argref) = @_;
356
    my $cred  = $argref->{'credential'};
357
    my $cert  = $argref->{'gid'} || $argref->{'cert'};
358
359
    my $info  = $argref->{'info'};
    my $type  = $argref->{'type'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
360

361
    if (! (defined($type) && ($type =~ /^(SA|MA|CM|SES|Component|Slice|User)$/i))){
362
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
363
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
364
    $type = lc($type);
365
366
    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
367
    }
368
369
    if (! defined($cert)) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
370
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
371
    if (! ($cert =~ /^[\012\015\040-\176]*$/)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
372
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
373
				    "cert: Invalid characters");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
374
    }
375
376
377
378
379
    if (! defined($info)) {
	return GeniResponse->MalformedArgsResponse();
    }
    my $credential = GeniCredential->CreateFromSigned($cred);
    if (!defined($credential)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
380
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
381
				    "Could not create GeniCredential object");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
382
    }
383

Leigh B. Stoller's avatar
Leigh B. Stoller committed
384
    #
385
    # Make sure the credential was issued to the caller.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
386
    #
387
388
389
390
    if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "This is not your credential!");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
391
    #
392
393
394
395
396
397
    # And that the target of the credential is this registry.
    #
    my $authority = GeniAuthority->Lookup($ENV{'MYUUID'});
    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
398
    }
399
400
401
    if ($credential->target_uuid() ne $authority->uuid()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
				    undef, "This is not your registry!");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
402
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
403

404
405
406
407
408
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "refresh" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

Leigh B. Stoller's avatar
Leigh B. Stoller committed
409
    #
410
    # Grab the uuid and hrn out of the certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
411
    #
412
413
414
415
    my $certificate = GeniCertificate->LoadFromString($cert);
    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"Could not parse certificate")
	if (!defined($certificate));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
416

417
    if (! ($certificate->uuid() =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
418
419
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper format for uuid");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
420
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
421
    if (! ($certificate->hrn() =~ /^[-\w\.]+$/)) {
422
423
424
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper format for hrn");
    }
425
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
426
    if ($type eq "user") {
427
428
	my $name  = $info->{'name'};
	my $email = $info->{'email'};
429
	my $keys  = undef;
430
431
432
433
434
435
436
437
438
439
440
441
442
443

	if (! TBcheck_dbslot($name, "users", "usr_name",
			     TBDB_CHECKDBSLOT_ERROR)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"name: ". TBFieldErrorString());
	}
	if (! TBcheck_dbslot($email, "users", "usr_email",
			     TBDB_CHECKDBSLOT_ERROR)){
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"email: ". TBFieldErrorString());
	}
	#
	# Need to verify the UUID is permitted for the SA making the request.
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
444
445
446
447
448
	my $slice_authority = GeniAuthority->Lookup($ENV{'GENIUUID'});
	if (!defined($slice_authority)) {
	    print STDERR "Could not find authority object for caller.\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
449
	if (! $slice_authority->PrefixMatch($certificate->uuid())) {
450
451
452
453
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"uuid: Prefix mismatch");
	}

454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
	my $existing = GeniUser->Lookup($certificate->uuid());
	if (defined($existing)) {
	    if (! ($existing->hrn() eq $certificate->hrn())) {
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Not allowed to change hrn");
	    }
	    if (! ($existing->sa_uuid() eq $slice_authority->uuid())) {
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"Already registered with another SA");
	    }
	    #
	    # Update operation, but only name, email, and keys for now.
	    #
	    if ($existing->Modify($name, $email, $keys) != 0) {
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Could not update user");
	    }
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	}
473
474
475
476
477
478
479
480
	#
	# XXX
	#
	# What kind of uniquess requirements do we need? No one else with this
	# email address? Of course, we have to allow hrn reuse, but should we
	# require that for a given SA, that hrn is unique, at least to avoid
	# lots of confusion?
	#
481
	if (GeniUser->CheckExisting($certificate->hrn(), $email)) {
482
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
483
					"hrn/email already registered");
484
	}
485
486
	my $newuser = GeniUser->Create($certificate, $slice_authority,
				       $info, $keys);
487
488
	if (!defined($newuser)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
489
					"Could not be registered");
490
491
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
492
				    "User has been registered");
493
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
494
    if ($type eq "slice") {
495
496
497
498
499
500
501
502
503
504
505
506
507
508
	my $creator_uuid  = $info->{'creator_uuid'};

	if (! ($creator_uuid =~ /^[-\w]*$/)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"creator_uuid: Invalid characters");
	}
	#
	# Make sure the geni user exists. 	
	#
	my $user = GeniUser->Lookup($creator_uuid);
	if (!defined($user)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"creator_uuid: No such User");
	}
509

510
511
512
	#
	# Need to verify the UUID is permitted for the SA making the request.
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
513
514
515
516
517
	my $slice_authority = GeniAuthority->Lookup($ENV{'GENIUUID'});
	if (!defined($slice_authority)) {
	    print STDERR "Could not find authority object for caller.\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
518
	if (! $slice_authority->PrefixMatch($certificate->uuid())) {
519
520
521
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"uuid: Prefix mismatch");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
522

523
524
525
	#
	# Reregistration of existing slice is okay.
	#
526
	my $existing = GeniRegistry::GeniSlice->Lookup($certificate->uuid());
527
528
529
530
531
532
533
534
535
536
537
538
539
	if (defined($existing)) {
	    if (! ($existing->cert() eq $certificate->cert())) {
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					    "Not allowed to change cert");
	    }
	    if (! ($existing->sa_uuid() eq $slice_authority->uuid())) {
		return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				"Already registered with another SA");
	    }
	    
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	}

540
541
542
	#
	# Make sure slice hrn and uuid are unique.
	#
543
544
	if (GeniRegistry::GeniSlice->CheckExisting($certificate->hrn(),
						   $certificate->uuid())) {
545
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
546
					"Slice already registered");
547
548
	}

549
550
551
	my $newslice = GeniRegistry::GeniSlice->Create($certificate,
						       $creator_uuid,
						       $slice_authority);
552
553
	if (!defined($newslice)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
554
					"Could not be registered");
555
	}
556

557
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
558
				    "Slice has been registered");
559
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
560
    if ($type eq "component") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
561
562
563
	my $manager = GeniAuthority->Lookup($ENV{'GENIUUID'});
	if (!defined($manager)) {
	    print STDERR "Could not find manager object for caller.\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
564
565
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
566
567
568
	my $component = GeniComponent->CreateFromCertificate($certificate,
							     $manager);
	if (!defined($component)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
569
570
571
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not register new resource");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
572
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
573
    }
574
    if ($type eq "cm" || $type eq "sa" || $type eq "ses") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
575
576
577
	#
	# Check for an existing authority. 
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
578
	if (GeniAuthority->CheckExisting($type, $certificate->uuid(), 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
579
580
581
582
583
					 $certificate->hrn()) != 0) {
	    print STDERR "Attempt to register existing authority\n";
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Authority already exists");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
584
585
586
587
588
	my $url = $certificate->URL();
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not find URL in the certificate")
	    if (!defined($url));

589
590
591
592
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not find URN in the certificate")
	    if (!defined( $certificate->URN() ) );

593
594
595
596
597
	if ($certificate->hrn() =~ /^unknown/i) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Please define PROTOGENI_DOMAIN");
	}
	
Leigh B. Stoller's avatar
Leigh B. Stoller committed
598
599
600
	SENDMAIL($TBOPS, "ProtoGeni Authority Registration",
		 $certificate->asText());
	
Leigh B. Stoller's avatar
Leigh B. Stoller committed
601
602
603
604
605
606
607
	my $authority = GeniAuthority->Create($certificate, $url, $type);
	if (!defined($authority)) {
	    print STDERR "Could not register new authority\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
    }
608
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
609
610
}

611
612
##
# Delete an object.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
613
#
614
sub Remove($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
615
616
{
    my ($argref) = @_;
617
    my $cred  = $argref->{'credential'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
618
    my $uuid  = $argref->{'uuid'};
619
    my $type  = $argref->{'type'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
620

Leigh B. Stoller's avatar
Leigh B. Stoller committed
621
    if (! (defined($type) && ($type =~ /^(SA|MA|CM|Component|Slice|User)$/))) {
622
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
623
    }
624
625
    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
626
    }
627
628
    if (! (defined($uuid) && ($uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/))) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
629
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
630

631
632
    my $credential = GeniCredential->CreateFromSigned($cred);
    if (!defined($credential)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
633
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
634
				    "Could not create GeniCredential object");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
635
636
637
    }

    #
638
    # Make sure the credential was issued to the caller.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
639
    #
640
    if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
641
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
642
				    "This is not your credential!");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
643
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
644
    #
645
    # And that the target of the credential is this registry.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
646
    #
647
    my $authority = GeniAuthority->Lookup($ENV{'MYUUID'});
648
    if (!defined($authority)) {
649
650
651
652
653
654
655
656
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    if ($credential->target_uuid() ne $authority->uuid()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
				    undef, "This is not your registry!");
    }

657
658
659
660
661
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "refresh" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
    if ($type eq "User") {
	my $user = GeniUser->Lookup($uuid);
	if (!defined($user)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					"No such user $uuid");
	}
	if (!$user->Delete()) {
	    print STDERR "Could not delete $user from ClearingHouse!\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"$uuid could not be unregistered");
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
				    "$uuid has been unregistered");
    }
    if ($type eq "Slice") {
677
	my $slice = GeniRegistry::GeniSlice->Lookup($uuid);
678
	if (!defined($slice)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
679
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
680
681
682
683
684
685
686
687
688
689
690
					"No such slice $uuid");
	}
	if ($slice->Delete()) {
	    print STDERR "Could not delete $slice from ClearingHouse!\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"$uuid could not be unregistered");
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
				    "$uuid has been unregistered");
    }
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
691
692
}

693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
#
# Emergency Shutdown of a slice. 
#
sub Shutdown($)
{
    my ($argref) = @_;
    my $cred   = $argref->{'credential'};
    my $uuid   = $argref->{'uuid'};
    my $clear  = $argref->{'clear'};

    if (! (defined($cred) && defined($uuid))) {
	return GeniResponse->MalformedArgsResponse();
    }
    $clear = (defined($clear) ? $clear : 0);
    if (! ($uuid =~ /^[-\w]*$/)) {
	return GeniResponse->MalformedArgsResponse();
    }
    my $credential = GeniCredential->CreateFromSigned($cred);
    if (!defined($credential)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create GeniCredential object");
    }

    #
    # Make sure the credential was issued to the caller.
    #
    if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "This is not your credential!");
    }

    #
    # And that the target of the credential is this registry.
    #
    my $authority = GeniAuthority->Lookup($ENV{'MYUUID'});
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    if ($credential->target_uuid() ne $authority->uuid()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
				    undef, "This is not your registry!");
    }
736
737
738
739
740
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "operator" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

741
    my $slice = GeniRegistry::GeniSlice->Lookup($uuid);
742
743
744
745
746
747
748
749
750
751
    if (!defined($slice)) {
	print STDERR "No slice record $uuid for shutdown!\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "No such slice registered here");
    }

    #
    # Pass the whole thing off to a script that will contact the
    # CMs.
    #
752
    my $opt = ($clear ? "-u": "");
753
    # -c option indicates acting as CH. 
754
    system("$SLICESHUTDOWN -c $opt $uuid");
755
756
757
758
759
760
761
762
    if ($?) {
	print STDERR "Could not shutdown $uuid!\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Error shutting down slice");
    }
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
763
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
764
765
# This is just a placeholder; return a list of all components. Eventually
# takes an rspec and we do a resource mapping. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
766
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
767
sub ListComponents($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
768
769
{
    my ($argref) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
770
771
772
773
774
775
776
777
778
779
    my $cred  = $argref->{'credential'};

    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
    my $credential = GeniCredential->CreateFromSigned($cred);
    if (!defined($credential)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create GeniCredential object");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
780

Leigh B. Stoller's avatar
Leigh B. Stoller committed
781
782
783
784
785
786
    #
    # Make sure the credential was issued to the caller.
    #
    if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "This is not your credential!");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
787
788
    }

789
790
791
792
793
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

Leigh B. Stoller's avatar
Leigh B. Stoller committed
794
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
795
    # Return simple list of components managers (aggregate managers?)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
796
797
    #
    my @results = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
798
799
    my $query_result = DBQueryWarn("select uuid from geni_authorities ".
				   "where type='cm'");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
800
801
802
    return GeniResponse->Create(GENIRESPONSE_DBERROR)
	if (!defined($query_result));

Leigh B. Stoller's avatar
Leigh B. Stoller committed
803
804
    while (my ($manager_uuid) = $query_result->fetchrow_array()) {
	my $manager = GeniAuthority->Lookup($manager_uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
805
	return GeniResponse->Create(GENIRESPONSE_DBERROR)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
806
	    if (!defined($manager));
807
808
	next
	    if ($manager->disabled());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
809
	    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
810
811
	push(@results, { "gid" => $manager->cert(),
			 "hrn" => $manager->hrn(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
812
			 "urn" => $manager->urn() || "",
Leigh B. Stoller's avatar
Leigh B. Stoller committed
813
		         "url" => $manager->url() });
Leigh B. Stoller's avatar
Leigh B. Stoller committed
814
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
815
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
816
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
817

Leigh B. Stoller's avatar
Leigh B. Stoller committed
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
#
# Post a new CRL
#
sub PostCRL($)
{
    my ($argref) = @_;
    my $cred  = $argref->{'credential'};
    my $cert  = $argref->{'cert'};

    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
    if (! defined($cert)) {
	return GeniResponse->MalformedArgsResponse();
    }
    if (! ($cert =~ /^[\012\015\040-\176]*$/)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "cert: Invalid characters");
    }
    my $credential = GeniCredential->CreateFromSigned($cred);
    if (!defined($credential)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create GeniCredential object");
    }

    #
    # Make sure the credential was issued to the caller.
    #
    if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "This is not your credential!");
    }
    #
    # And that the target of the credential is this registry.
    #
    my $authority = GeniAuthority->Lookup($ENV{'MYUUID'});
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    if ($credential->target_uuid() ne $authority->uuid()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
				    undef, "This is not your registry!");
    }

863
864
865
866
867
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "refresh" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

Leigh B. Stoller's avatar
Leigh B. Stoller committed
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
    my $caller_authority = GeniAuthority->Lookup($ENV{'GENIUUID'});
    if (!defined($caller_authority)) {
	print STDERR "Could not find authority object for caller.\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    if (GeniCertificate->StoreCRL($caller_authority, $cert) != 0) {
	print STDERR "Could not store CRL for $caller_authority\n";

	SENDMAIL($TBOPS, "Failed to Store CRL",
		 "Fail to store CRL for $caller_authority\n".
		 "$cert");
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    SENDMAIL($TBOPS, "Stored a new CRL",
	     "Storeed a new CRL for $caller_authority\n".
	     "$cert");
    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
}
886
887
888
889
890
891
892
893
894
895
896
897

##
# Lookup a UUID and return a blob of stuff. We allow lookups of both
# users and slices, which is what we allow clients to register.
#
sub List($)
{
    my ($argref) = @_;
    my $cred = $argref->{'credential'};
    my $type = $argref->{'type'};
    my @results = ();

Leigh B. Stoller's avatar
Leigh B. Stoller committed
898
    if (! (defined($type) && ($type =~ /^(Authorities|Components|Slices|Users)$/i))){
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
	return GeniResponse->MalformedArgsResponse();
    }
    $type = lc($type);
    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
    my $credential = GeniCredential->CreateFromSigned($cred);
    if (!defined($credential)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create GeniCredential object");
    }

    #
    # Make sure the credential was issued to the caller.
    #
    if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "This is not your credential!");
    }
    #
    # And that the target of the credential is this registry.
    #
    my $authority = GeniAuthority->Lookup($ENV{'MYUUID'});
    if (!defined($authority)) {
	print STDERR "Could not find local authority object\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    if ($credential->target_uuid() ne $authority->uuid()) {
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
				    undef, "This is not your registry!");
    }
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

    if ($type eq "slices") {
	my @slices;

	if (GeniRegistry::GeniSlice->ListAll(\@slices) != 0) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	foreach my $slice (@slices) {
	    my $blob = {"gid"  => $slice->cert(),
			"hrn"  => $slice->hrn(),
			"uuid" => $slice->uuid() };
	    
	    push(@results, $blob);
	}
    }
    elsif ($type eq "authorities") {
	my @authorities;

	if (GeniAuthority->ListAll(\@authorities) != 0) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	foreach my $authority (@authorities) {
	    my $blob = {"gid"  => $authority->cert(),
			"hrn"  => $authority->hrn(),
			"uuid" => $authority->uuid() };
	    
	    push(@results, $blob);
	}
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
963
964
965
966
967
968
969
970
971
972
973
974
975
976
    elsif ($type eq "users") {
	my @users;

	if (GeniUser->ListAll(\@users) != 0) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	foreach my $user (@users) {
	    my $blob = {"gid"  => $user->cert(),
			"hrn"  => $user->hrn(),
			"uuid" => $user->uuid() };
	    
	    push(@results, $blob);
	}
    }
977
978
979
980
981
982
    else {
	return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
    }
    
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
}