Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
emulab
emulab-devel
Commits
b9df9923
Commit
b9df9923
authored
Sep 18, 2013
by
Jonathon Duerig
Browse files
Checkpoint for MA/SA standard.
parent
c72ef653
Changes
15
Hide whitespace changes
Inline
Side-by-side
protogeni/lib/GNUmakefile.in
View file @
b9df9923
...
...
@@ -41,7 +41,8 @@ LIB_SCRIPTS = GeniDB.pm GeniUser.pm \
GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \
GeniUtil.pm GeniRegistry.pm GeniUsage.pm GeniHRN.pm \
GeniSES.pm GeniResource.pm GeniXML.pm GeniAM.pm \
GeniEmulab.pm GeniFoam.pm GeniStitch.pm
GeniEmulab.pm GeniFoam.pm GeniStitch.pm \
GeniStd.pm GeniMA.pm GeniStdSA.pm
SBIN_SCRIPTS = plabnodewrapper plabslicewrapper
SCRIPTS = genischemacheck.pl
...
...
protogeni/lib/GeniAM.pm.in
View file @
b9df9923
...
...
@@ -40,6 +40,7 @@ use vars qw(@ISA @EXPORT);
@
ISA
=
"Exporter"
;
@
EXPORT
=
qw
(
);
use
GeniStd
;
use
GeniCMV2
;
use
GeniResponse
;
use
GeniCredential
;
...
...
@@ -49,7 +50,6 @@ use emutil;
use
Compress
::
Zlib
;
use
MIME
::
Base64
;
use
XML
::
LibXML
;
use
URI
;
use
Date
::
Parse
;
use
Data
::
Dumper
;
use
Frontier
::
RPC2
;
...
...
@@ -258,7 +258,7 @@ sub ListResources()
my
$
credentials
=
$
credential_args
;
if
($
API_VERSION
>=
3
)
{
$
credentials
=
FilterCredentials
($
credential_args
);
$
credentials
=
GeniStd
::
FilterCredentials
($
credential_args
);
}
my
$
xml
=
undef
;
...
...
@@ -330,128 +330,6 @@ sub ListResources()
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
xml
);
}
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
if
($
cred
->
type
()
eq
"speaksfor"
);
#
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
;
}
###############################################################################
#
AM
API
V2
###############################################################################
...
...
@@ -471,7 +349,7 @@ sub CreateSliver()
#
onto
a
list
here
and
remove
them
at
the
end
of
this
#
function
.
The
other
AM
calls
do
not
need
the
dynamically
#
added
SA
.
auto_add_sa
($
cred
);
GeniStd
::
auto_add_sa
($
cred
);
}
#
Package
the
caller_keys
in
a
list
of
hashes
the
way
the
CM
wants
...
...
@@ -731,7 +609,7 @@ sub CreateImage()
my $credentials = $credential_args;
if ($API_VERSION >= 3) {
$credentials = FilterCredentials($credential_args);
$credentials =
GeniStd::
FilterCredentials($credential_args);
}
my $args = {
...
...
@@ -800,9 +678,9 @@ sub Describe
return GeniResponse->MalformedArgsResponse("Missing arguments");
}
my @urns = @{ $urn_args };
my $credentials = FilterCredentials($credential_args);
my $credentials =
GeniStd::
FilterCredentials($credential_args);
my $cred = Geni
CMV2
::CheckCredentials($credentials);
my $cred = Geni
Std
::CheckCredentials($credentials);
return $cred
if (GeniResponse::IsResponse($cred));
...
...
@@ -907,8 +785,8 @@ sub Update
return GeniResponse->MalformedArgsResponse("Missing arguments");
}
my @urns = @{ $urn_args };
my $credentials = FilterCredentials($credential_args);
my $cred = Geni
CMV2
::CheckCredentials($credentials);
my $credentials =
GeniStd::
FilterCredentials($credential_args);
my $cred = Geni
Std
::CheckCredentials($credentials);
return $cred
if (GeniResponse::IsResponse($cred));
...
...
@@ -1048,7 +926,7 @@ sub Renew
! defined($expiration_time) || ! defined($options)) {
return GeniResponse->MalformedArgsResponse("Missing arguments");
}
my $credentials = FilterCredentials($credential_args);
my $credentials =
GeniStd::
FilterCredentials($credential_args);
my @urns = @{ $urn_args};
return GeniResponse->MalformedArgsResponse("Empty URN List")
if (scalar(@urns) < 1);
...
...
@@ -1080,7 +958,7 @@ sub Provision
my @urns = @{ $urn_args };
return GeniResponse->MalformedArgsResponse("Empty URN List")
if (scalar(@urns) < 1);
my $credentials = FilterCredentials($credential_args);
my $credentials =
GeniStd::
FilterCredentials($credential_args);
my $users = $options->{'
geni_users
'};
my $sliver_keys = [];
if (defined($users) && @$users) {
...
...
@@ -1098,7 +976,7 @@ sub Provision
}
}
my $cred = Geni
CMV2
::CheckCredentials($credentials);
my $cred = Geni
Std
::CheckCredentials($credentials);
return $cred
if (GeniResponse::IsResponse($cred));
...
...
@@ -1163,12 +1041,12 @@ sub PerformOperationalAction
return GeniResponse->MalformedArgsResponse("Empty URN List")
if (scalar(@urns) < 1);
my $credentials = FilterCredentials($credential_args);
my $credentials =
GeniStd::
FilterCredentials($credential_args);
my $args = {
'
credentials
' => $credentials
};
my $cred = Geni
CMV2
::CheckCredentials($credentials);
my $cred = Geni
Std
::CheckCredentials($credentials);
return $cred
if (GeniResponse::IsResponse($cred));
...
...
@@ -1262,7 +1140,7 @@ sub Delete
push
(@{
$
slivers
},
$
blob
);
}
my
$
credentials
=
FilterCredentials
($
credential_args
);
my
$
credentials
=
GeniStd
::
FilterCredentials
($
credential_args
);
my
$
args
=
{
'slice_urn'
=>
$
urns
[
0
],
'credentials'
=>
$
credentials
...
...
@@ -1281,8 +1159,8 @@ sub Cancel
return
GeniResponse
->
MalformedArgsResponse
(
"Empty URN List"
)
if
(
scalar
(@
urns
)
<
1
);
my
$
credentials
=
FilterCredentials
($
credential_args
);
my
$
cred
=
Geni
CMV2
::
CheckCredentials
($
credentials
);
my
$
credentials
=
GeniStd
::
FilterCredentials
($
credential_args
);
my
$
cred
=
Geni
Std
::
CheckCredentials
($
credentials
);
return
$
cred
if
(
GeniResponse
::
IsResponse
($
cred
));
...
...
@@ -1290,7 +1168,7 @@ sub Cancel
my
$
response
;
my
$
ticket
=
GeniTicket
->
SliceTicket
($
slice
);
if
(
defined
($
ticket
))
{
my
$
credentials
=
FilterCredentials
($
credential_args
);
my
$
credentials
=
GeniStd
::
FilterCredentials
($
credential_args
);
my
$
args
=
{
'slice_urn'
=>
$
urns
[
0
],
'ticket'
=>
$
ticket
->
ticket_string
(),
...
...
@@ -1304,23 +1182,6 @@ sub Cancel
return
$
response
;
}
#
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
=
[];
foreach
my
$
cred
(@{
$
credentials
})
{
if
($
cred
->{
'geni_type'
}
eq
"geni_sfa"
&&
($
cred
->{
'geni_version'
}
eq
2
||
$
cred
->{
'geni_version'
}
eq
3
))
{
push
(@{
$
result
},
$
cred
->{
'geni_value'
});
auto_add_sa
($
cred
->{
'geni_value'
});
}
}
return
$
result
;
}
#
Determines
operational
state
based
on
the
state
/
status
of
a
sliver
.
sub
GetOpState
{
...
...
protogeni/lib/GeniCMV2.pm.in
View file @
b9df9923
...
...
@@ -55,6 +55,7 @@ use GeniCM;
use
GeniHRN
;
use
GeniXML
;
use
GeniStitch
;
use
GeniStd
;
use
emutil
;
use
English
;
use
Data
::
Dumper
;
...
...
@@ -141,7 +142,7 @@ sub Resolve($)
if
(
! GeniHRN::IsValid($urn)) {
return
GeniResponse
->
MalformedArgsResponse
(
"Invalid URN"
);
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -368,7 +369,7 @@ sub DiscoverResources($)
if
(
! (defined($credentials))) {
return
GeniResponse
->
MalformedArgsResponse
(
"Missing arguments"
);
}
my
($
credential
,$
speaksfor
,@
morecreds
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
,@
morecreds
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -403,7 +404,7 @@ sub CreateSliver($)
if
(
! GeniHRN::IsValid($slice_urn)) {
return
GeniResponse
->
MalformedArgsResponse
(
"Bad characters in URN"
);
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -565,7 +566,7 @@ sub DeleteSliver($)
if
(
! GeniHRN::IsValid($sliver_urn)) {
return
GeniResponse
->
MalformedArgsResponse
(
"Bad characters in URN"
);
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -680,7 +681,7 @@ sub DeleteSlice($)
if
(
! GeniHRN::IsValid($slice_urn)) {
return
GeniResponse
->
MalformedArgsResponse
(
"Bad characters in URN"
);
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -741,7 +742,7 @@ sub GetSliver($)
if
(
! GeniHRN::IsValid($slice_urn)) {
return
GeniResponse
->
MalformedArgsResponse
(
"Bad characters in URN"
);
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -811,7 +812,7 @@ sub SliverAction($$$$$)
(
defined
($
slice_urn
)
||
defined
($
sliver_urns
))))
{
return
GeniResponse
->
MalformedArgsResponse
(
"Missing arguments"
);
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -1040,7 +1041,7 @@ sub SliverStatus($)
if
(
! GeniHRN::IsValid($slice_urn)) {
return
GeniResponse
->
MalformedArgsResponse
(
"Bad characters in URN"
);
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -1144,7 +1145,7 @@ sub Shutdown($)
if
(
! (defined($credentials) && defined($slice_urn))) {
return
GeniResponse
->
MalformedArgsResponse
(
"Missing arguments"
);
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -1240,7 +1241,7 @@ sub RenewSlice($)
if
(
! GeniHRN::IsValid($slice_urn)) {
return
GeniResponse
->
MalformedArgsResponse
(
"Bad characters in URN"
);
}
my
($
credential
,$
speaksfor
,@
morecreds
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
,@
morecreds
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -1282,7 +1283,7 @@ sub GetTicket($)
if
(
! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
return
GeniResponse
->
MalformedArgsResponse
(
"Bad characters in rspec"
);
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -1386,7 +1387,7 @@ sub UpdateTicket($)
if
(
! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
return
GeniResponse
->
MalformedArgsResponse
(
"Bad characters in rspec"
);
}
my
($
credential
,$
speaksfor
,@
morecreds
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
,@
morecreds
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -1492,7 +1493,7 @@ sub UpdateSliver($)
if
(
! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
return
GeniResponse
->
MalformedArgsResponse
(
"Bad characters in rspec"
);
}
my
($
credential
,$
speaksfor
,@
morecreds
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
,@
morecreds
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -1571,7 +1572,7 @@ sub RedeemTicket($)
defined
($
slice_urn
)
&&
defined
($
ticketstr
)))
{
return
GeniResponse
->
MalformedArgsResponse
(
"Missing arguments"
);
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -1634,7 +1635,7 @@ sub BindToSlice($)
defined
($
slice_urn
)
&&
defined
($
keys
)))
{
return
GeniResponse
->
MalformedArgsResponse
(
"Missing arguments"
);
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -1710,7 +1711,7 @@ sub ReleaseTicket($)
defined
($
slice_urn
)
&&
defined
($
ticketstr
)))
{
return
GeniResponse
->
MalformedArgsResponse
(
"Missing arguments"
);
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -1839,7 +1840,7 @@ sub ReserveVlanTags($)
return
GeniResponse
->
MalformedArgsResponse
(
"Bad tag in list"
);
}
}
my
($
credential
,$
speaksfor
)
=
CheckCredentials
($
credentials
);
my
($
credential
,$
speaksfor
)
=
GeniStd
::
CheckCredentials
($
credentials
);
return
$
credential
if
(
GeniResponse
::
IsResponse
($
credential
));
...
...
@@ -2130,167 +2131,6 @@ sub ReserveVlanTags($)
return
$
response
;
}
#
#
Initial
credential
check
.
#
sub
CheckCredentials
($)
{
my
($
speakee
,
$
speaksfor
);
my
@
rest
=
();
my
$
error
;
if
(
ref
($
_
[
0
])
ne
"ARRAY"
)
{
$
error
=
GeniResponse
->
MalformedArgsResponse
(
"Credentials should be a "
.
"array not a singleton"
);
goto
bad
;
}
else
{
my
@
credential_strings
=
@{
$
_
[
0
]
};
if
(
scalar
(@
credential_strings
)
==
1
)
{
#
#
Must
be
a
speaks
-
as
credential
.
#
$
speakee
=
GeniCredential
::
CheckCredential
($
credential_strings
[
0
]);
}
else
{
#
#
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)) {
$
error
=
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
$
GeniCredential
::
CreateFromSignedError
);
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
);
$
speakee
=
GeniCredential
::
CheckCredential
($
speakee
);
if
(
!GeniResponse::IsError($speakee)) {
$
error
=
$
speakee
;
goto
bad
;
}
@
rest
=
@
credentials
;
#
#
The
rest
of
the
credentials
have
to
be
valid
too
.
#
foreach
my
$
credential
(@
rest
)
{
$
credential
=
GeniCredential
::
CheckCredential
($
credential
);
if
(
!GeniResponse::IsError($credential)) {
$
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
);
}
else
{
$
speaksfor
=
GeniCredential
::
CheckCredential
($
speaksfor
);
if
(
GeniResponse
::
IsError
($
speaksfor
))
{
$
error
=
$
speaksfor
;
goto
bad
;
}
}
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
)
{
my
$
cred
=
GeniCredential
::
CheckCredential
($
credential
,
undef
,
1
);
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
;
}
}
}
if
(
wantarray
())
{
return
($
speakee
,
$
speaksfor
,
@
rest
);
}
return
$
speakee
;
bad
:
return
(
wantarray
()
?
($
error
)
:
$
error
);
}
#
#
Convert
a
URN
to
the
local
object
.
#
...
...
@@ -2418,7 +2258,7 @@ sub InjectEvent($)
$
waitmode
=
1
if
(
exists
($
argref
->{
'waitmode'
})
&&
$
argref
->{
'waitmode'
});