GeniStd.pm.in 12.4 KB
Newer Older
1
2
#!/usr/bin/perl -wT
#
3
# Copyright (c) 2008-2015 University of Utah and the Flux Group.
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
# 
# {{{GENIPUBLIC-LICENSE
# 
# GENI Public License
# 
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and/or hardware specification (the "Work") to
# deal in the Work without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Work, and to permit persons to whom the Work
# is furnished to do so, subject to the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Work.
# 
# THE WORK IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE WORK OR THE USE OR OTHER DEALINGS
# IN THE WORK.
# 
# }}}
#
package GeniStd;

#
# Library of common functions used in shims for providing standard
# GENI interfaces.
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

@ISA    = "Exporter";
@EXPORT = qw ( FilterCredentials auto_add_sa CheckCredentials FilterFields );

use GeniSA;
use GeniResponse;
use GeniCredential;
use GeniRegistry;
47
use GeniHRN;
48
49
use emutil;
use URI;
50
use Data::Dumper;
51
use Carp qw(cluck carp);
Leigh B Stoller's avatar
Leigh B Stoller committed
52
use POSIX qw(strftime);
Leigh B Stoller's avatar
Leigh B Stoller committed
53
use Date::Parse;
54
55
56
57
58
59
60
61

# Filter out any credentials of an uknown type leaving only geni_sfa
# version 2 and version 3 credentials in a list. Also invokes
# auto_add_sa on each credential.
sub FilterCredentials
{
    my ($credentials) = @_;
    my $result = [];
62
    if (defined($credentials)) {
63
64
65
66
	if (ref($credentials) ne "ARRAY") {
	    warn("Credentials is not an array!");
	    return $result;
	}
67
68
	foreach my $cred (@{ $credentials }) {
	    if (ref($cred) eq "HASH" &&
69
70
71
72
73
		(($cred->{'geni_type'} eq "geni_sfa" &&
		  ($cred->{'geni_version'} eq 2 ||
		   $cred->{'geni_version'} eq 3)) ||
		 ($cred->{'geni_type'} eq "geni_abac" &&
		  ($cred->{'geni_version'} eq 1)))) {
74
75
76
		push(@{ $result }, $cred->{'geni_value'});
		auto_add_sa($cred->{'geni_value'});
	    }
77
78
79
80
81
82
83
84
85
86
87
88
89
	}
    }
    return $result;
}

sub auto_add_sa($)
{
    my ($cred_str) = @_;
    my $verify_sig = 1;
    my $cred = GeniCredential->CreateFromSigned($cred_str, $verify_sig);
    my $signers = $cred->signer_certs();

    return
90
	if ($cred->type() eq "speaksfor" || $cred->type() eq "abac");
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206

    # The credential has been verified, so the signer derives from a
    # trusted root.
    my $sa_cert = @$signers[0];

    # These are borrowed from protogeni/scripts/addauthority
    my $certificate = GeniCertificate->LoadFromString($sa_cert);
    if (!defined($certificate)) {
        print STDERR "auto_add_sa: could not get certificate from $sa_cert\n";
        return;
    }
    if (! ($certificate->uuid() =~ /\w*-(\w*)$/)) {
        print STDERR "auto_add_sa: could not get prefix from uuid\n";
        return;
    }
    my $url = $certificate->URL();
    if (!defined($url)) {
        print STDERR "auto_add_sa: certificate does not have a URL extension\n";
    }
    my $urn = $certificate->urn();
    if (!defined($urn)) {
        print STDERR "auto_add_sa: certificate does not have a URN extension\n";
        return;
    }
    # Look to see if already registered.
    my $authority = GeniAuthority->Lookup($urn);
    if (defined($authority)) {
	#
	# See if the certificate has changed. If so we want to replace it.
	#
	return
	    if ($certificate->SameCert($authority->GetCertificate()));

	#
	# Want to reuse the old uuid since we use it as a table cross
	# reference index. Eventually need to use the URN. Anyway, change
	# the uuid in the new certificate so that it goes into the DB
	# with the original one. Then update the Authority record with
	# the new certificate.
	#
	print STDERR "Updating $authority with new certificate: $certificate\n";
	
	$certificate->setuuid($authority->uuid());
	if ($authority->UpdateCertificate($certificate)) {
	    print STDERR "Failed to update $authority with $certificate\n";
	    return;
	}
	return;
    }
    #
    # We want the URL! 
    #
    goto goturl
	if (defined($url));
    
    # First get the list of registries from PLC.
    my $registry = GeniRegistry::PLC->Create();
    if (!defined($registry)) {
	print STDERR "Cannot create a PLC registry object\n";
	return;
    }
    my $blob;
    if ($registry->GetRegistries(\$blob)) {
	print STDERR "Cannot get PLC registry listing\n";
	return;
    }
    print STDERR Dumper($blob);

    #
    # Now look at the last signer certificate; this is the actual authority.
    #
    my $authcertstr = @$signers[scalar(@$signers) - 1];
    my $authcert = GeniCertificate->LoadFromString($authcertstr);
    if (!defined($authcert)) {
        print STDERR
	    "auto_add_sa: could not get certificate from $authcertstr\n";
        return;
    }
    my $authurn = $authcert->urn();
    if (!defined($authurn)) {
        print STDERR "auto_add_sa: $authcert does not have a URN extension\n";
        return;
    }

    #
    # Now search ...
    #
    foreach my $ref (@$blob) {
	if ($ref->{'urn'} eq $authurn) {
	    $url = $ref->{'url'};
	    last;
	}
    }
    if (!defined($url)) {
        print STDERR "auto_add_sa: could not get a URL for $authcert\n";
	return;
    }
    #
    # Gack. Replace the URL with a modified URL which says https.
    # Why does PLC set the scheme to http?
    #
  goturl:
    my $uri = URI->new($url);
    $uri->scheme("https");
    $url = "$uri";
    
    if (!GeniAuthority->Create($certificate, $url, "sa")) {
        print STDERR "auto_add_sa: unable to add authority\n";
        return;
    }
    return $certificate;
}

#
# Initial credential check.
#
207
sub CheckCredentials($;$)
208
{
209
    my ($arg, $target_authority) = @_;
210
211
212
    my ($speakee, $speaksfor);
    my @rest = ();
    my $error;
213
214
215
216
217
218

    if (!defined($arg)) {
	cluck("CheckCredentials: No credentials!");
	$error = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
219
220
221
222
223
224
225
226
    
    if (ref($_[0]) ne "ARRAY") {
	$error = GeniResponse->MalformedArgsResponse("Credentials should be a ".
						     "array not a singleton");
	goto bad;
    }
    else {
	my @credential_strings = @{ $_[0] };
Leigh B Stoller's avatar
Leigh B Stoller committed
227
228
229
230
231
	if (! @credential_strings) {
	    $error = GeniResponse->MalformedArgsResponse("You did not supply ".
							 "any credentials!");
	    goto bad;
	}
232
233
234
235
236
237
238
239
240
241
242
	    #
	    # The only other case is that we get multiple credentials. One
	    # is the speaks-for credential and another one is the real
	    # credential. Other credentials may also be included, but the
	    # caller knows when to care about those.
	    #
	    my @credentials = ();
	    
	    foreach my $credstring (@credential_strings) {
		my $credential = GeniCredential->CreateFromSigned($credstring);
		if (!defined($credential)) {
Jonathon Duerig's avatar
Jonathon Duerig committed
243
		    $error = GeniResponse->MalformedArgsResponse($GeniCredential::CreateFromSignedError);
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
		    goto bad;
		}
		if ($credential->type() eq "speaksfor" ||
		    $credential->type() eq "abac") {
		    $speaksfor = $credential;
		}
		else {
		    push(@credentials, $credential);
		}
	    }
	    if (!defined($speaksfor)) {
		#
		# speaks-as credential has to be first. No reason, its
		# just the way I want it. 
		#
		$speakee = shift(@credentials);
260
261
		$speakee = GeniCredential::CheckCredential($speakee,
							   $target_authority);
262
		if (GeniResponse::IsError($speakee)) {
263
264
265
266
267
268
269
270
271
		    $error = $speakee;
		    goto bad;
		}
		@rest = @credentials;

		#
		# The rest of the credentials have to be valid too.
		#
		foreach my $credential (@rest) {
272
273
274
		    $credential =
			GeniCredential::CheckCredential($credential,
							$target_authority);
275
		    if (GeniResponse::IsError($credential)) {
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
			$error = $credential;
			goto bad;
		    }
		}
	    }
	    else {
		if ($speaksfor->type() eq "abac") {
		    #
		    # At the moment, the easiest thing to do is make the
		    # speaksfor credential look sorta like a normal
		    # credential.
		    #
		    # The signer of the credential is the one being
		    # spoken for. This is the target of the speaksfor.
		    # The speaker is derived from the TLS context, and
		    # is the owner of the credential.
		    #
		    my $speaker_certificate =
		       GeniCertificate->LoadFromString($ENV{'SSL_CLIENT_CERT'});
		    if (!defined($speaker_certificate)) {
			print STDERR "Could not load speaker certificate:\n";
			print STDERR $ENV{'SSL_CLIENT_CERT'} . "\n";
			$error = GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
						      undef,
				      "Could not load speaker certificate");
			goto bad;
		    }
		    $speaksfor->SetOwnerCert($speaker_certificate);

		    #
		    # Grab the signer. Should only be one.
		    #
		    my @signer_certs = @{ $speaksfor->signer_certs() };
		    
		    my $speakee_certificate =
			GeniCertificate->LoadFromString($signer_certs[0]);
		    if (!defined($speakee_certificate)) {
			print STDERR "Could not load user certificate:\n";
			print STDERR $signer_certs[0] . "\n";
			$error = GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
						      undef,
				      "Could not load user certificate");
			goto bad;
		    }
		    $speaksfor->SetTargetCert($speakee_certificate);
		}
322
323
324
325
		$speaksfor = GeniCredential::CheckCredential($speaksfor);
		if (GeniResponse::IsError($speaksfor)) {
		    $error = $speaksfor;
		    goto bad;
326
		}
327

328
329
330
331
332
		# Put this into the ENV for the backend scripts.
		if (GeniHRN::IsValid($speaksfor->target_urn()) &&
		    $speaksfor->target_urn() =~ /^(urn:publicid:.*)$/) {
		    $ENV{'REALGENIURN'} = $1;
		}
333
334
335
336
337
338
339
340
341
342
343
		main::AddLogfileMetaDataFromSpeaksFor($speaksfor);

		#
		# All the rest of the credentials are being spoken for;
		# its owner is equal to the owner of the speaksfor
		# credential. In other words, the speaksfor is signed
		# (owned) by the user, and grants to the tool that is in
		# the target. The real credential (say, a slice) is owned
		# by the user, so the owners must match.
		#
		foreach my $credential (@credentials) {
344
345
346
		    my $cred =
			GeniCredential::CheckCredential($credential,
							$target_authority, 1);
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
		    if (GeniResponse::IsError($cred)) {
			$error = $cred;
			goto bad;
		    }
		    if ($cred->owner_urn() ne $speaksfor->target_urn()) {
			$error = GeniResponse->Create(GENIRESPONSE_FORBIDDEN,
						      undef,
			   "Credential owner does not match speaksfor target");
			goto bad;
		    }
		    push(@rest, $cred);
		}
		#
		# speaks-as credential has to be first. No reason, its
		# just the way I want it. 
		#
		$speakee = shift(@credentials);
		@rest = @credentials;
	    }
366

367
368
369
370
371
372
373
374
375
376
377
378
379
380
    }
    if (wantarray()) {
	return ($speakee, $speaksfor, @rest);
    }
    return $speakee;
  bad:
    return (wantarray() ? ($error) : $error);
}

# Takes a blob and returns a new one with only the fields defined by
# the filter.
sub FilterFields($$)
{
    my ($blob, $filterList) = @_;
381
382
383
384
    my $hasFilter = 0;
    if (defined($filterList)) {
	$hasFilter = 1;
    }
385
    my $filter = {};
386
387
388
389
390
    if ($hasFilter)
    {
	foreach my $item ( @{ $filterList } ) {
	    $filter->{$item} = 1;
	}
391
392
393
    }
    my $result = {};
    foreach my $key (keys(%{ $blob })) {
394
	if (! $hasFilter || exists($filter->{$key})) {
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
	    $result->{$key} = $blob->{$key};
	}
    }
    return $result;
}

sub GetMatchFilter($)
{
    my ($options) = @_;
    my $match = [];
    my $filter;

    if (exists($options->{'match'})) {
	push(@{ $match }, getMaybeArray($options->{'match'}->{'MEMBER_URN'}));
	push(@{ $match }, getMaybeArray($options->{'match'}->{'MEMBER_UID'}));
410
	push(@{ $match }, getMaybeArray($options->{'match'}->{'SLICE_URN'}));
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
    }


    $filter = $options->{'filter'}
      if (exists($options->{'filter'}));

    return ($match, $filter);
}


# Take a reference that might be an array or might be a scalar or
# might be undefined. Return an array
sub getMaybeArray($)
{
    my ($ref) = @_;
    my @result = ();
    if (defined($ref)) {
	if (ref($ref) eq 'ARRAY') {
	    push(@result, @{ $ref });
	} else {
	    push(@result, $ref);
	}
    }
    return @result;
}
Jonathon Duerig's avatar
Jonathon Duerig committed
436
437
438
439
440
441
442
443
444

sub GenerateEmptyManifest()
{
    return '<rspec xmlns="http://www.geni.net/resources/rspec/3" '.
	'xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" '.
	'type="manifest" '.
	'xsi:schemaLocation="http://www.geni.net/resources/rspec/3 '.
	'http://www.geni.net/resources/rspec/3/manifest.xsd ">';
}
Leigh B Stoller's avatar
Leigh B Stoller committed
445
446
447
448
449
450
451
452
453
454
455
456
457

#
# Return date in GMT time format.
#
sub DateTimeGMT($)
{
    my ($datetime) = @_;

    return POSIX::strftime("20%y-%m-%dT%H:%M:%S GMT",
			   gmtime(str2time($datetime)));
}

1;