GeniCH.pm.in 28.4 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-2009 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;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
26
use GeniAuthority;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
27
use emutil;
28
use libtestbed qw(SENDMAIL);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
29
30
31
32
33
34
35
36
37
38
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@";
39
my $SLICESHUTDOWN  = "$TB/sbin/protogeni/shutdownslice";
40

Leigh B. Stoller's avatar
Leigh B. Stoller committed
41
#
42
43
44
45
# 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.
46
#
47
sub GetCredential($)
48
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
49
50
    my ($argref) = @_;
    my $uuid = $argref->{'uuid'};
51
52
    my $cred = $argref->{'credential'};
    my $type = $argref->{'type'};
53
    my $gid  = $argref->{'gid'} || $argref->{'cert'};
54

55
56
57
58
59
60
    #
    # 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
61
    if (!defined($caller_authority)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
62
63
	print STDERR "GetCredential()\n";
	
Leigh B. Stoller's avatar
Leigh B. Stoller committed
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
        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));

	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
86
	if (! ($certificate->hrn() =~ /^[-\w\.]+$/)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
87
88
89
90
91
92
93
94
	    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));

95
96
97
98
99
	if ($certificate->hrn() =~ /^unknown/i) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Please define PROTOGENI_DOMAIN");
	}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
	#
	# 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");
	}
    }
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
    
    #
    # 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);
	}
	my $credential = GeniCredential->Create($authority, $caller_authority);
	if (!defined($credential)) {
	    print STDERR "Could not create credential for $caller_authority\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	if ($credential->Sign($GeniCredential::LOCALMA_FLAG)) {
	    print STDERR "Could not sign credential for $caller_authority\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS,
				    $credential->asString());
145
146
    }

147
148
149
150
151
    #
    # 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
152
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
153

154
155
156
157
158
##
# 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
159
160
{
    my ($argref) = @_;
161
    my $cred = $argref->{'credential'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
162
    my $uuid = $argref->{'uuid'};
163
    my $hrn  = $argref->{'hrn'};
164
    my $type = $argref->{'type'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
165

166
167
168
169
170
171
172
173
174
175
    if (! (defined($uuid) || defined($hrn))) {
	return GeniResponse->MalformedArgsResponse();
    }
    if (defined($uuid) && defined($hrn)) {
	return GeniResponse->MalformedArgsResponse();
    }
    if (defined($uuid) && !($uuid =~ /^[-\w]*$/)) {
	return GeniResponse->MalformedArgsResponse();
    }
    if (defined($hrn) && !($hrn =~ /^[-\w\.]*$/)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
176
177
	return GeniResponse->MalformedArgsResponse();
    }
178
    if (! (defined($type) && ($type =~ /^(SA|CM|MA|Component|Slice|User)$/i))){
179
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
180
    }
181
    $type = lc($type);
182
183
184
185
186
187
188
    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
189
    }
190
    my $lookup_token = ($uuid || $hrn);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
191

192
193
194
195
    #
    # 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
196
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
				    "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!");
    }

212
213
214
215
216
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "resolve" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

217
218
    if ($type eq "user") {
	my $user = GeniUser->Lookup($lookup_token);
219
220
	if (!defined($user)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
221
					"No such user $lookup_token");
222
223
224
225
226
227
228
	}

	# 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
229
		     "gid"      => $user->cert(),
230
231
232
233
234
		     "name"     => $user->name(),
		     "sa_uuid"  => $user->sa_uuid(),
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
235
236
    if ($type eq "component") {
	my $component = GeniComponent->Lookup($lookup_token);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
237
238
239
	
	if (!defined($component)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
240
					"No such component $lookup_token");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
241
242
243
	}

	# Return a blob.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
244
	my $blob = { "gid"      => $component->cert(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
245
246
247
248
249
		     "url"      => $component->url(),
		 };
    
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
250
    if ($type eq "sa") {
251
	my $authority = GeniAuthority->Lookup($lookup_token);
252
253
	if (!defined($authority)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
254
					"No such authority $lookup_token");
255
256
	}
	# Return a blob.
257
	my $blob = { "gid"         => $authority->cert(),
258
		     "url"         => $authority->url(),
259
		     "type"        => $authority->type(),
260
261
262
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
263
264
    if ($type eq "cm") {
	my $manager = GeniAuthority->Lookup($lookup_token);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
265
	if (!defined($manager)) {
266
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
267
					"No such manager $lookup_token");
268
269
	}
	# Return a blob.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
270
271
	my $blob = { "gid"         => $manager->cert(),
		     "url"         => $manager->url(),
272
273
274
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
275
    if ($type eq "ma") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
276
277
278
279
280
281
282
283
284
	#
	# I think the MA is the ClearingHouse?
	#
	# Return a blob.
	my $blob = { "gid"         => $authority->cert(),
		     "url"         => $authority->url(),
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
285
    if ($type eq "slice") {
286
	my $slice = GeniRegistry::GeniSlice->Lookup($lookup_token);
287
288
	if (!defined($slice)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
289
					"No such slice $lookup_token");
290
291
292
293
294
295
	}

	# 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
296
		     "gid"          => $slice->cert(),
297
298
299
300
301
		     "sa_uuid"      => $slice->sa_uuid(),
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
302
303
}

304
305
##
# Register a new object.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
306
#
307
sub Register($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
308
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
309
    my ($argref) = @_;
310
    my $cred  = $argref->{'credential'};
311
    my $cert  = $argref->{'gid'} || $argref->{'cert'};
312
313
    my $info  = $argref->{'info'};
    my $type  = $argref->{'type'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
314

315
    if (! (defined($type) && ($type =~ /^(SA|MA|CM|SES|Component|Slice|User)$/i))){
316
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
317
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
318
    $type = lc($type);
319
320
    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
321
    }
322
323
    if (! defined($cert)) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
324
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
325
    if (! ($cert =~ /^[\012\015\040-\176]*$/)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
326
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
327
				    "cert: Invalid characters");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
328
    }
329
330
331
332
333
    if (! defined($info)) {
	return GeniResponse->MalformedArgsResponse();
    }
    my $credential = GeniCredential->CreateFromSigned($cred);
    if (!defined($credential)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
334
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
335
				    "Could not create GeniCredential object");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
336
    }
337

Leigh B. Stoller's avatar
Leigh B. Stoller committed
338
    #
339
    # Make sure the credential was issued to the caller.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
340
    #
341
342
343
344
    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
345
    #
346
347
348
349
350
351
    # 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
352
    }
353
354
355
    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
356
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
357

358
359
360
361
362
    $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
363
    #
364
    # Grab the uuid and hrn out of the certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
365
    #
366
367
368
369
    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
370

371
    if (! ($certificate->uuid() =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
372
373
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper format for uuid");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
374
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
375
    if (! ($certificate->hrn() =~ /^[-\w\.]+$/)) {
376
377
378
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper format for hrn");
    }
379
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
380
    if ($type eq "user") {
381
382
	my $name  = $info->{'name'};
	my $email = $info->{'email'};
383
	my $keys  = undef;
384
385
386
387
388
389
390
391
392
393
394
395
396
397

	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
398
399
400
401
402
	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);
	}
403
	if (! $slice_authority->PrefixMatch($certificate->uuid())) {
404
405
406
407
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"uuid: Prefix mismatch");
	}

408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
	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);
	}
427
428
429
430
431
432
433
434
	#
	# 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?
	#
435
	if (GeniUser->CheckExisting($certificate->hrn(), $email)) {
436
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
437
					"hrn/email already registered");
438
	}
439
440
	my $newuser = GeniUser->Create($certificate, $slice_authority,
				       $info, $keys);
441
442
	if (!defined($newuser)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
443
					"Could not be registered");
444
445
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
446
				    "User has been registered");
447
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
448
    if ($type eq "slice") {
449
450
451
452
453
454
455
456
457
458
459
460
461
462
	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");
	}
463

464
465
466
	#
	# Need to verify the UUID is permitted for the SA making the request.
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
467
468
469
470
471
	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);
	}
472
	if (! $slice_authority->PrefixMatch($certificate->uuid())) {
473
474
475
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"uuid: Prefix mismatch");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
476

477
478
479
	#
	# Reregistration of existing slice is okay.
	#
480
	my $existing = GeniRegistry::GeniSlice->Lookup($certificate->uuid());
481
482
483
484
485
486
487
488
489
490
491
492
493
	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);
	}

494
495
496
	#
	# Make sure slice hrn and uuid are unique.
	#
497
498
	if (GeniRegistry::GeniSlice->CheckExisting($certificate->hrn(),
						   $certificate->uuid())) {
499
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
500
					"Slice already registered");
501
502
	}

503
504
505
	my $newslice = GeniRegistry::GeniSlice->Create($certificate,
						       $creator_uuid,
						       $slice_authority);
506
507
	if (!defined($newslice)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
508
					"Could not be registered");
509
	}
510

511
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
512
				    "Slice has been registered");
513
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
514
    if ($type eq "component") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
515
516
517
	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
518
519
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
520
521
522
	my $component = GeniComponent->CreateFromCertificate($certificate,
							     $manager);
	if (!defined($component)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
523
524
525
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not register new resource");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
526
	return GeniResponse->Create(GENIRESPONSE_SUCCESS);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
527
    }
528
    if ($type eq "cm" || $type eq "sa" || $type eq "ses") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
529
530
531
	#
	# Check for an existing authority. 
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
532
	if (GeniAuthority->CheckExisting($type, $certificate->uuid(), 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
533
534
535
536
537
					 $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
538
539
540
541
542
	my $url = $certificate->URL();
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not find URL in the certificate")
	    if (!defined($url));

543
544
545
546
547
	if ($certificate->hrn() =~ /^unknown/i) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"Please define PROTOGENI_DOMAIN");
	}
	
Leigh B. Stoller's avatar
Leigh B. Stoller committed
548
549
550
	SENDMAIL($TBOPS, "ProtoGeni Authority Registration",
		 $certificate->asText());
	
Leigh B. Stoller's avatar
Leigh B. Stoller committed
551
552
553
554
555
556
557
	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);
    }
558
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
559
560
}

561
562
##
# Delete an object.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
563
#
564
sub Remove($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
565
566
{
    my ($argref) = @_;
567
    my $cred  = $argref->{'credential'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
568
    my $uuid  = $argref->{'uuid'};
569
    my $type  = $argref->{'type'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
570

Leigh B. Stoller's avatar
Leigh B. Stoller committed
571
    if (! (defined($type) && ($type =~ /^(SA|MA|CM|Component|Slice|User)$/))) {
572
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
573
    }
574
575
    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
576
    }
577
578
    if (! (defined($uuid) && ($uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/))) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
579
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
580

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

    #
588
    # Make sure the credential was issued to the caller.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
589
    #
590
    if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
591
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
592
				    "This is not your credential!");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
593
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
594
    #
595
    # And that the target of the credential is this registry.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
596
    #
597
    my $authority = GeniAuthority->Lookup($ENV{'MYUUID'});
598
    if (!defined($authority)) {
599
600
601
602
603
604
605
606
	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!");
    }

607
608
609
610
611
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "refresh" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
    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") {
627
	my $slice = GeniRegistry::GeniSlice->Lookup($uuid);
628
	if (!defined($slice)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
629
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
630
631
632
633
634
635
636
637
638
639
640
					"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
641
642
}

643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
#
# 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!");
    }
686
687
688
689
690
    $credential->HasPrivilege( "authority" ) or
	$credential->HasPrivilege( "operator" ) or
	return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				     "Insufficient privilege" );

691
    my $slice = GeniRegistry::GeniSlice->Lookup($uuid);
692
693
694
695
696
697
698
699
700
701
    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.
    #
702
    my $opt = ($clear ? "-u": "");
703
    # -c option indicates acting as CH. 
704
    system("$SLICESHUTDOWN -c $opt $uuid");
705
706
707
708
709
710
711
712
    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
713
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
714
715
# 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
716
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
717
sub ListComponents($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
718
719
{
    my ($argref) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
720
721
722
723
724
725
726
727
728
729
    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
730

Leigh B. Stoller's avatar
Leigh B. Stoller committed
731
732
733
734
735
736
    #
    # 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
737
738
    }

739
740
741
742
743
    $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
744
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
745
    # Return simple list of components managers (aggregate managers?)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
746
747
    #
    my @results = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
748
749
    my $query_result = DBQueryWarn("select uuid from geni_authorities ".
				   "where type='cm'");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
750
751
752
    return GeniResponse->Create(GENIRESPONSE_DBERROR)
	if (!defined($query_result));

Leigh B. Stoller's avatar
Leigh B. Stoller committed
753
754
    while (my ($manager_uuid) = $query_result->fetchrow_array()) {
	my $manager = GeniAuthority->Lookup($manager_uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
755
	return GeniResponse->Create(GENIRESPONSE_DBERROR)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
756
	    if (!defined($manager));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
757
	    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
758
759
760
	push(@results, { "gid" => $manager->cert(),
			 "hrn" => $manager->hrn(),
		         "url" => $manager->url() });
Leigh B. Stoller's avatar
Leigh B. Stoller committed
761
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
762
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
763
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
764

Leigh B. Stoller's avatar
Leigh B. Stoller committed
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
#
# 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!");
    }

810
811
812
813
814
    $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
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
    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);
}
833
834
835
836
837
838
839
840
841
842
843
844

##
# 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
845
    if (! (defined($type) && ($type =~ /^(Authorities|Components|Slices|Users)$/i))){
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
	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
910
911
912
913
914
915
916
917
918
919
920
921
922
923
    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);
	}
    }
924
925
926
927
928
929
    else {
	return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
    }
    
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
}