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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
19
20
# Must come after package declaration!
use lib '@prefix@/lib';
Leigh B. Stoller's avatar
Leigh B. Stoller committed
21
use GeniDB;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
22
use Genixmlrpc;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
23
use GeniResponse;
24
25
use User;
use GeniUser;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
26
use GeniSlice;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
27
use GeniComponent;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
28
use GeniAuthority;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
29
30
31
32
33
34
35
36
37
38
39
40
use libtestbed;
use emutil;
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@";
41

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

55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
    #
    # 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'});
    return GeniResponse->Create(GENIRESPONSE_REFUSED, undef, "Who are You?")
	if (!defined($caller_authority));
    
    #
    # 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());
88
89
    }

90
91
92
93
94
    #
    # 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
95
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
96

97
98
99
100
101
##
# 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
102
103
{
    my ($argref) = @_;
104
    my $cred = $argref->{'credential'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
105
    my $uuid = $argref->{'uuid'};
106
    my $type = $argref->{'type'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
107
108
109
110

    if (! (defined($uuid) && ($uuid =~ /^[-\w]*$/))) {
	return GeniResponse->MalformedArgsResponse();
    }
111
    if (! (defined($type) && ($type =~ /^(SA|CM|MA|Component|Slice|User)$/i))){
112
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
113
    }
114
115
116
117
118
119
120
    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
121
122
    }

123
124
125
126
    #
    # 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
127
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
				    "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!");
    }

    if ($type eq "User") {
	my $user = GeniUser->Lookup($uuid);
	if (!defined($user)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					"No such user $uuid");
	}
149
	# Grab keys.
150
151
152
153
	#my @sliverkeys;
	#if ($user->GetKeys(\@sliverkeys) != 0) {
	#    print STDERR "Could not get sliver keys for $user\n";
	#}
154
155
156
157
158
159
160
161
162
163

	# Return a blob.
	my $blob = { "uid"      => $user->uid(),
		     "hrn"      => $user->hrn(),
		     "uuid"     => $user->uuid(),
		     "email"    => $user->email(),
		     "cert"     => $user->cert(),
		     "name"     => $user->name(),
		     "sa_uuid"  => $user->sa_uuid(),
		 };
164
165
	#$blob->{'sliverkeys'} = \@sliverkeys
	#    if (@sliverkeys);
166
167
168
    
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
    if ($type eq "Component") {
	my $component = GeniComponent->LookupByResource($uuid);
	
	if (!defined($component)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					"No such resource $uuid");
	}
	my $certificate = GeniCertificate->Lookup($uuid);
	if (!defined($certificate)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					"No certificate for $uuid");
	}

	# Return a blob.
	my $blob = { "gid"      => $certificate->cert(),
		     "cm"	=> $component->cert(),
		     "url"      => $component->url(),
		 };
    
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
190
    if ($type eq "SA" || $type eq "sa") {
191
192
193
194
195
196
	my $authority = GeniAuthority->Lookup($uuid);
	if (!defined($authority)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					"No such authority $uuid");
	}
	# Return a blob.
197
	my $blob = { "gid"         => $authority->cert(),
198
		     "url"         => $authority->url(),
199
		     "type"        => $authority->type(),
200
201
202
203
204
205
206
207
208
209
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "CM") {
	my $component = GeniComponent->Lookup($uuid);
	if (!defined($component)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					"No such component $uuid");
	}
	# Return a blob.
210
	my $blob = { "gid"         => $component->cert(),
211
212
213
214
215
216
217
218
219
220
221
222
		     "url"         => $component->url(),
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    if ($type eq "Slice") {
	my $slice = GeniSlice->Lookup($uuid);
	if (!defined($slice)) {
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef,
					"No such slice $uuid");
	}

	# User bindings too.
223
224
225
226
227
	#my @userbindings = ();
	#if ($slice->UserBindings(\@userbindings) != 0) {
	#    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
	#				"Error getting users for slice");
	#}
228
229
230
231
232
233
234

	# Return a blob.
	my $blob = { "hrn"          => $slice->hrn(),
		     "uuid"         => $slice->uuid(),
		     "creator_uuid" => $slice->creator_uuid(),
		     "cert"         => $slice->cert(),
		     "sa_uuid"      => $slice->sa_uuid(),
235
	#	     "userbindings" => \@userbindings,
236
237
238
239
		 };
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
240
241
}

242
243
##
# Register a new object.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
244
#
245
sub Register($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
246
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
247
    my ($argref) = @_;
248
    my $cred  = $argref->{'credential'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
249
    my $cert  = $argref->{'cert'};
250
251
    my $info  = $argref->{'info'};
    my $type  = $argref->{'type'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
252

253
254
    if (! (defined($type) && ($type =~ /^(SA|MA|Component|Slice|User)$/))) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
255
    }
256
257
    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
258
    }
259
260
    if (! defined($cert)) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
261
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
262
    if (! ($cert =~ /^[\012\015\040-\176]*$/)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
263
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
264
				    "cert: Invalid characters");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
265
    }
266
267
268
269
270
    if (! defined($info)) {
	return GeniResponse->MalformedArgsResponse();
    }
    my $credential = GeniCredential->CreateFromSigned($cred);
    if (!defined($credential)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
271
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
272
				    "Could not create GeniCredential object");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
273
    }
274

Leigh B. Stoller's avatar
Leigh B. Stoller committed
275
    #
276
    # Make sure the credential was issued to the caller.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
277
    #
278
279
280
281
    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
282
    #
283
284
285
286
287
288
    # 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
289
    }
290
291
292
    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
293
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
294

Leigh B. Stoller's avatar
Leigh B. Stoller committed
295
    #
296
    # Grab the uuid and hrn out of the certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
297
    #
298
299
300
301
    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
302

303
    if (! ($certificate->uuid() =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
304
305
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper format for uuid");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
306
    }
307
308
309
310
    if (! ($certificate->hrn() =~ /^[\w\.]+$/)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper format for hrn");
    }
311
312
313
314
    
    if ($type eq "User") {
	my $name  = $info->{'name'};
	my $email = $info->{'email'};
315
	my $keys  = undef;
316
317
318
319
320
321
322
323
324
325
326

	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());
	}
327
	if (0 && defined($keys)) {
328
329
330
331
332
333
334
335
336
337
338
339
340
	    foreach my $keyref (@{ $keys }) {
		my $type = $keyref->{'type'};
		my $key  = $keyref->{'key'};

		if ($type ne 'ssh') {
		    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
						"key: Invalid key type");
		}
		if (! ($key =~ /^[\012\015\040-\176]*$/)) {
		    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
						"key: Invalid characters");
		}
	    }
341
342
343
344
	}
	#
	# Need to verify the UUID is permitted for the SA making the request.
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
345
346
347
348
349
	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);
	}
350
	if (! $slice_authority->PrefixMatch($certificate->uuid())) {
351
352
353
354
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"uuid: Prefix mismatch");
	}

355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
	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);
	}
374
375
376
377
378
379
380
381
	#
	# 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?
	#
382
	if (GeniUser->CheckExisting($certificate->hrn(), $email)) {
383
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
384
					"hrn/email already registered");
385
	}
386
387
	my $newuser = GeniUser->Create($certificate, $slice_authority,
				       $info, $keys);
388
389
	if (!defined($newuser)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
390
					"Could not be registered");
391
392
	}
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
393
				    "User has been registered");
394
395
396
    }
    if ($type eq "Slice") {
	my $creator_uuid  = $info->{'creator_uuid'};
397
	my $userbindings  = $info->{'userbindings'};
398
399
400
401
402
403
404
405
406
407
408
409
410

	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");
	}
411
412
413
414

	#
	# Ditto any users bound to the slice.
	#
415
	if (0 && defined($userbindings)) {
416
417
418
419
420
421
422
423
424
	    foreach my $binding_uuid (@{ $userbindings }) {
		my $binding_user = GeniUser->Lookup($binding_uuid);
		if (!defined($binding_user)) {
		    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
						"$binding_user: No such User");
		}
	    }
	}
	
425
426
427
	#
	# Need to verify the UUID is permitted for the SA making the request.
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
428
429
430
431
432
	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);
	}
433
	if (! $slice_authority->PrefixMatch($certificate->uuid())) {
434
435
436
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"uuid: Prefix mismatch");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
437

438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
	#
	# Reregistration of existing slice is okay.
	#
	my $existing = GeniSlice->Lookup($certificate->uuid());
	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");
	    }
	    if (0 && defined($userbindings)) {
		$existing->UnBindUsers();
		
		foreach my $binding_uuid (@{ $userbindings }) {
		    my $binding_user = GeniUser->Lookup($binding_uuid);
		    $existing->BindUser($binding_user);
		}
	    }
	    
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS);
	}

463
464
465
	#
	# Make sure slice hrn and uuid are unique.
	#
466
467
	if (GeniSlice->CheckExisting($certificate->hrn(),
				     $certificate->uuid())) {
468
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
469
					"Slice already registered");
470
471
	}

472
473
	my $newslice = GeniSlice->Create($certificate, $creator_uuid,
					 $slice_authority);
474
475
	if (!defined($newslice)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
476
					"Could not be registered");
477
	}
478
479
480
481

	#
	# Add the bindings now.
	# 
482
	if (0 && defined($userbindings)) {
483
484
485
486
487
	    foreach my $binding_uuid (@{ $userbindings }) {
		my $binding_user = GeniUser->Lookup($binding_uuid);
		$newslice->BindUser($binding_user);
	    }
	}
488
489
	
	return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
490
				    "Slice has been registered");
491
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
    if ($type eq "Component") {
	my $resource_type  = $info->{'resource_type'};
	my $resource_uuid  = $info->{'resource_uuid'};

	my $component = GeniComponent->Lookup($ENV{'GENIUUID'});
	if (!defined($component)) {
	    print STDERR "Could not find component object for caller.\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR);
	}

	if (! ($resource_uuid =~ /^[-\w]+$/)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"resource_uuid: Invalid characters");
	}
	if (! ($resource_type =~ /^[-\w]+$/)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"resource_type: Invalid characters");
	}
	if ($certificate->Store() != 0) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not store certificate");
	}
	if ($component->NewResource($resource_uuid) != 0) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not register new resource");
	}
    }

520
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
521
522
}

523
524
##
# Delete an object.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
525
#
526
sub Remove($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
527
528
{
    my ($argref) = @_;
529
    my $cred  = $argref->{'credential'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
530
    my $uuid  = $argref->{'uuid'};
531
    my $type  = $argref->{'type'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
532

533
534
    if (! (defined($type) && ($type =~ /^(SA|MA|Component|Slice|User)$/))) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
535
    }
536
537
    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
538
    }
539
540
    if (! (defined($uuid) && ($uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/))) {
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
541
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
542

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

    #
550
    # Make sure the credential was issued to the caller.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
551
    #
552
    if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
553
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
554
				    "This is not your credential!");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
555
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
556
    #
557
    # And that the target of the credential is this registry.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
558
    #
559
    my $authority = GeniAuthority->Lookup($ENV{'MYUUID'});
560
    if (!defined($authority)) {
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
	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!");
    }

    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") {
	my $slice = GeniSlice->Lookup($uuid);
	if (!defined($slice)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
586
	    return GeniResponse->Create(GENIRESPONSE_SUCCESS, undef,
587
588
589
590
591
592
593
594
595
596
597
					"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
598
599
600
}

#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
601
602
# 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
603
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
604
sub ListComponents($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
605
606
{
    my ($argref) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
607
608
609
610
611
612
613
614
615
616
    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
617

Leigh B. Stoller's avatar
Leigh B. Stoller committed
618
619
620
621
622
623
    #
    # 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
624
625
626
    }

    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
627
    # Return simple list of components (hashes).
Leigh B. Stoller's avatar
Leigh B. Stoller committed
628
629
    #
    my @results = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
630
    my $query_result = DBQueryWarn("select uuid from geni_components");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
631
632
633
    return GeniResponse->Create(GENIRESPONSE_DBERROR)
	if (!defined($query_result));

Leigh B. Stoller's avatar
Leigh B. Stoller committed
634
635
636
637
638
    while (my ($component_uuid) = $query_result->fetchrow_array()) {
	my $component = GeniComponent->Lookup($component_uuid);
	return GeniResponse->Create(GENIRESPONSE_DBERROR)
	    if (!defined($component));
	    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
639
640
641
	push(@results, { "gid" => $component->cert(),
			 "hrn" => $component->hrn(),
		         "url" => $component->url() });
Leigh B. Stoller's avatar
Leigh B. Stoller committed
642
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
643
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@results);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
644
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
645