Skip to content
GitLab
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
23a12aa5
Commit
23a12aa5
authored
Jul 31, 2008
by
Leigh B. Stoller
Browse files
Checkpoint
parent
8f598e53
Changes
15
Hide whitespace changes
Inline
Side-by-side
protogeni/lib/GNUmakefile.in
View file @
23a12aa5
...
...
@@ -14,8 +14,9 @@ include $(OBJDIR)/Makeconf
LIB_SCRIPTS = GeniDB.pm GeniUser.pm GeniSAClient.pm \
GeniSlice.pm GeniSA.pm GeniCM.pm GeniCMClient.pm \
test.pl GeniTicket.pm GeniSliver.pm GeniCredential.pm \
GeniComponent.pm GeniCH.pm GeniCHClient.pm \
GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm
GeniComponent.pm GeniCH.pm GeniCHClient.pm GeniEmulab.pm \
GeniAuthority.pm GeniCertificate.pm GeniAggregate.pm \
node.pl
#
# Force dependencies on the scripts so that they will be rerun through
...
...
protogeni/lib/GeniCH.pm.in
View file @
23a12aa5
...
...
@@ -110,6 +110,13 @@ sub LookupSlice($)
"No slice authority found for slice"
);
}
#
User
bindings
too
.
my
@
userbindings
=
();
if
($
slice
->
UserBindings
(\@
userbindings
)
!= 0) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Error getting user bindings for slice"
);
}
#
Return
a
blob
.
my
$
blob
=
{
"hrn"
=>
$
slice
->
hrn
(),
"uuid"
=>
$
slice
->
uuid
(),
...
...
@@ -119,7 +126,8 @@ sub LookupSlice($)
"uuid"
=>
$
authority
->
uuid
(),
"cert"
=>
$
authority
->
cert
(),
"uuid_prefix"
=>
$
authority
->
uuid_prefix
(),
"url"
=>
$
authority
->
url
()
}
"url"
=>
$
authority
->
url
()
},
"userbindings"
=>
\@
userbindings
,
};
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
...
...
@@ -342,3 +350,126 @@ sub DiscoverResources($)
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
\@
results
);
}
#
#
Bind
user
to
slice
#
sub
BindUser
($)
{
my
($
argref
)
=
@
_
;
my
$
slice_uuid
=
$
argref
->{
'slice_uuid'
};
my
$
user_uuid
=
$
argref
->{
'user_uuid'
};
if
(
! (defined($slice_uuid) && defined($user_uuid))) {
return
GeniResponse
->
MalformedArgsResponse
();
}
#
#
Use
the
Emulab
checkslot
routines
.
#
if
(
! ($slice_uuid =~ /^[-\w]*$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"uuid: Invalid characters"
);
}
if
(
! ($user_uuid =~ /^[-\w]*$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"uuid: Invalid characters"
);
}
#
#
The
SA
UUID
comes
from
the
SSL
environment
(
certificate
).
Verify
it
#
and
the
prefix
match
for
the
uuid
.
#
#
Need
to
verify
the
UUID
is
permitted
for
the
SA
making
the
request
.
#
my
$
sa_uuid
=
$
ENV
{
'GENIUUID'
};
my
$
query_result
=
DBQueryWarn
(
"select idx, uuid_prefix from geni_sliceauthorities "
.
"where uuid='$sa_uuid'"
);
return
GeniResponse
->
Create
(
GENIRESPONSE_DBERROR
)
if
(
!defined($query_result));
return
GeniResponse
->
Create
(
GENIRESPONSE_REFUSED
,
undef
,
"Who are You?"
)
if
(
!$query_result->numrows);
my
$
slice
=
GeniSlice
->
Lookup
($
slice_uuid
);
if
(
!defined($slice)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No such slice $slice_uuid"
);
}
my
$
user
=
GeniUser
->
Lookup
($
user_uuid
);
if
(
!defined($slice)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No such user $user_uuid"
);
}
DBQueryWarn
(
"replace into geni_bindings set "
.
" slice_uuid='$slice_uuid', user_uuid='$user_uuid', "
.
" created=now()"
)
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Error binding user to slice"
);
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
undef
,
"$user_uuid has been bound to slice"
);
}
#
#
UnBind
user
from
slice
#
sub
UnBindUser
($)
{
my
($
argref
)
=
@
_
;
my
$
slice_uuid
=
$
argref
->{
'slice_uuid'
};
my
$
user_uuid
=
$
argref
->{
'user_uuid'
};
if
(
! (defined($slice_uuid) && defined($user_uuid))) {
return
GeniResponse
->
MalformedArgsResponse
();
}
#
#
Use
the
Emulab
checkslot
routines
.
#
if
(
! ($slice_uuid =~ /^[-\w]*$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"uuid: Invalid characters"
);
}
if
(
! ($user_uuid =~ /^[-\w]*$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"uuid: Invalid characters"
);
}
#
#
The
SA
UUID
comes
from
the
SSL
environment
(
certificate
).
Verify
it
#
and
the
prefix
match
for
the
uuid
.
#
#
Need
to
verify
the
UUID
is
permitted
for
the
SA
making
the
request
.
#
my
$
sa_uuid
=
$
ENV
{
'GENIUUID'
};
my
$
query_result
=
DBQueryWarn
(
"select idx, uuid_prefix from geni_sliceauthorities "
.
"where uuid='$sa_uuid'"
);
return
GeniResponse
->
Create
(
GENIRESPONSE_DBERROR
)
if
(
!defined($query_result));
return
GeniResponse
->
Create
(
GENIRESPONSE_REFUSED
,
undef
,
"Who are You?"
)
if
(
!$query_result->numrows);
my
$
slice
=
GeniSlice
->
Lookup
($
slice_uuid
);
if
(
!defined($slice)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No such slice $slice_uuid"
);
}
my
$
user
=
GeniUser
->
Lookup
($
user_uuid
);
if
(
!defined($slice)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No such user $user_uuid"
);
}
DBQueryWarn
(
"delete from geni_bindings "
.
"where slice_uuid='$slice_uuid' and user_uuid='$user_uuid'"
)
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Error unbinding user from slice"
);
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
undef
,
"$user_uuid has been unbound from slice"
);
}
protogeni/lib/GeniCHClient.pm.in
View file @
23a12aa5
...
...
@@ -35,7 +35,7 @@ my $TBAPPROVAL = "@TBAPPROVALEMAIL@";
my
$
TBAUDIT
=
"@TBAUDITEMAIL@"
;
my
$
BOSSNODE
=
"@BOSSNODE@"
;
my
$
OURDOMAIN
=
"@OURDOMAIN@"
;
my
$
GENICENTRAL
=
"myboss.
little-emulab-bsd61
.testbed.emulab.net"
;
my
$
GENICENTRAL
=
"myboss.
myelab
.testbed.emulab.net"
;
my
$
GENICENTRALURL
=
"https://$GENICENTRAL/protogeni/xmlrpc/ch"
;
#
...
...
@@ -194,3 +194,39 @@ sub DiscoverResources($$)
return
0
;
}
#
#
Bind
and
unbind
users
to
/
from
slices
#
sub
BindUser
($$)
{
my
($
slice_uuid
,
$
user_uuid
)
=
@
_
;
my
$
args
=
{
"slice_uuid"
=>
$
slice_uuid
,
"user_uuid"
=>
$
user_uuid
};
my
$
response
=
Genixmlrpc
::
CallMethodHTTP
($
GENICENTRALURL
,
undef
,
"CH::BindUser"
,
$
args
);
return
-
1
if
(
!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
return
0
;
}
sub
UnBindUser
($$)
{
my
($
slice_uuid
,
$
user_uuid
)
=
@
_
;
my
$
args
=
{
"slice_uuid"
=>
$
slice_uuid
,
"user_uuid"
=>
$
user_uuid
};
my
$
response
=
Genixmlrpc
::
CallMethodHTTP
($
GENICENTRALURL
,
undef
,
"CH::UnBindUser"
,
$
args
);
return
-
1
if
(
!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
return
0
;
}
protogeni/lib/GeniCM.pm.in
View file @
23a12aa5
...
...
@@ -186,6 +186,11 @@ sub GetTicket($)
"Could not get slice info from ClearingHouse"
);
}
}
else
{
$
slice
->
UpdateFromRegistry
()
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not update slice info from ClearingHouse"
);
}
#
#
Ditto
the
user
.
...
...
@@ -345,6 +350,20 @@ sub CreateSliver($)
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Error binding user to slice"
);
#
Bind
the
other
users
too
.
my
@
userbindings
;
if
($
slice
->
UserBindings
(\@
userbindings
)
!= 0) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Error binding users to slice"
);
}
foreach
my
$
otheruuid
(@
userbindings
)
{
my
$
otheruser
=
GeniUser
->
Lookup
($
otheruuid
);
if
(
!$otheruser->BindToSlice($slice) != 0) {
print
STDERR
"Could not bind $otheruser to $slice
\n
"
;
}
}
#
#
We
are
actually
an
Aggregate
,
so
return
an
aggregate
of
slivers
,
#
unless
there
is
just
one
node
.
...
...
@@ -453,21 +472,6 @@ sub CreateSliver($)
}
}
#
#
This
stuff
needs
to
be
moved
elsewhere
.
#
#
XXX
What
if
we
have
multiple
slivers
for
this
slice
?
We
are
going
#
to
need
some
locking
or
management
at
the
slice
level
so
that
we
run
#
tbswap
only
once
,
or
at
least
no
more
then
one
at
a
time
.
#
if
(
0
&&
!$impotent) {
system
(
"$SWAPEXP -s modify -g $pid $eid"
);
if
($?)
{
$
message
=
"Failed to tbswap $pid,$eid"
;
goto
bad
;
}
}
#
#
The
API
states
we
return
a
credential
to
control
the
sliver
/
aggregate
.
#
...
...
@@ -602,213 +606,3 @@ sub DestroySliver($)
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
);
}
#
#
Bind
a
user
to
a
slice
.
#
sub
BindUser
($)
{
my
($
argref
)
=
@
_
;
my
$
sliver
=
$
argref
->{
'sliver'
};
my
$
hrn
=
$
argref
->{
'userinfo'
}->{
'hrn'
};
my
$
uuid
=
$
argref
->{
'userinfo'
}->{
'uuid'
};
my
$
name
=
$
argref
->{
'userinfo'
}->{
'name'
};
my
$
email
=
$
argref
->{
'userinfo'
}->{
'email'
};
my
$
cert
=
$
argref
->{
'userinfo'
}->{
'cert'
};
my
$
sshkey
=
$
argref
->{
'userinfo'
}->{
'sshkey'
};
my
$
sliver_uuid
;
if
(
! (defined($hrn) && defined($name) && defined($sliver) &&
defined
($
email
)
&&
defined
($
cert
)
&&
defined
($
uuid
)))
{
return
GeniResponse
->
MalformedArgsResponse
();
}
GeniCertificate
->
CertificateInfo
($
sliver
,
\$
sliver_uuid
)
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not get uuid from Certificate"
);
#
#
See
if
we
have
a
record
of
this
sliver
in
the
DB
.
If
not
,
then
we
have
#
to
go
to
the
ClearingHouse
to
find
its
record
,
so
that
we
can
find
out
#
who
the
SA
for
it
is
.
#
$
sliver
=
GeniSliver
->
Lookup
($
sliver_uuid
);
if
(
!defined($sliver)) {
#
Might
be
an
aggregate
instead
.
$
sliver
=
GeniAggregate
->
Lookup
($
sliver_uuid
);
if
(
!defined($sliver)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"No such sliver $sliver_uuid"
);
}
}
my
$
slice
=
$
sliver
->
GetSlice
();
#
#
Use
the
Emulab
checkslot
routines
.
#
if
(
! ($hrn =~ /^[-\w\.]*$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"hrn: Invalid characters"
);
}
if
(
! ($uuid =~ /^[-\w]*$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"uuid: Invalid characters"
);
}
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
());
}
if
(
! ($cert =~ /^[\012\015\040-\176]*$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"cert: Invalid characters"
);
}
if
(
defined
($
sshkey
)
&&
! ($sshkey =~ /^[\012\015\040-\176]*$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"sshkey: Invalid characters"
);
}
#
#
The
SA
UUID
comes
from
the
SSL
environment
(
certificate
).
Verify
it
#
and
the
prefix
match
for
the
uuid
.
#
my
$
sa_uuid
=
$
ENV
{
'GENIUUID'
};
my
$
authority
=
GeniAuthority
->
Lookup
($
sa_uuid
);
if
(
!defined($authority)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No slice authority record for $sa_uuid"
);
}
if
(
! $authority->PrefixMatch($uuid)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_FORBIDDEN
,
undef
,
"uuid: Prefix mismatch"
);
}
#
#
Verify
that
this
is
the
SA
for
the
slice
.
#
if
(
! $slice->IsSliceAuthority($authority)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_FORBIDDEN
,
undef
,
"Must be the SA for the slice"
);
}
#
Might
already
exist
.
Not
an
error
,
Just
check
binding
and
return
.
my
$
user
=
GeniUser
->
Lookup
($
uuid
);
if
(
defined
($
user
))
{
$
user
->
BindToSlice
($
slice
)
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Error binding user to slice"
);
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
undef
,
"$hrn/$email has been bound to slice"
);
}
#
#
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
?
#
if
(
GeniUser
->
CheckExisting
($
hrn
,
$
email
))
{
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"$hrn/$email already registered"
);
}
#
The
local
uid
we
will
use
is
the
last
part
of
the
hrn
.
my
($
uid
)
=
($
hrn
=~
/^.*\.(\
w
*)$/);
if
(
!defined($uid)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"uid: cannot parse hrn to get uid"
);
}
elsif
(
! TBcheck_dbslot($uid, "users", "uid", TBDB_CHECKDBSLOT_ERROR)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"uid: "
.
TBFieldErrorString
());
}
my
$
newuser
=
GeniUser
->
Create
($
hrn
,
$
uid
,
$
uuid
,
$
name
,
$
email
,
$
cert
,
$
authority
->
idx
(),
$
sshkey
);
if
(
!defined($newuser)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"$hrn/$email could not be registered"
);
}
$
newuser
->
BindToSlice
($
slice
)
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Error binding user to sliver"
);
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
undef
,
"$hrn/$email has been bound to $sliver_uuid"
);
}
#
#
Unbind
user
from
sliver
.
#
sub
UnBindUser
($)
{
my
($
argref
)
=
@
_
;
my
$
sliver
=
$
argref
->{
'sliver'
};
my
$
user
=
$
argref
->{
'user'
};
my
$
sliver_uuid
;
my
$
user_uuid
;
if
(
! (defined($sliver) && defined($user))) {
return
GeniResponse
->
MalformedArgsResponse
();
}
GeniCertificate
->
CertificateInfo
($
sliver
,
\$
sliver_uuid
)
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not get uuid from Certificate"
);
GeniCertificate
->
CertificateInfo
($
user
,
\$
user_uuid
)
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not get uuid from Certificate"
);
#
#
See
if
we
have
a
record
of
this
sliver
in
the
DB
.
If
not
,
then
we
have
#
to
go
to
the
ClearingHouse
to
find
its
record
,
so
that
we
can
find
out
#
who
the
SA
for
it
is
.
#
$
sliver
=
GeniSliver
->
Lookup
($
sliver_uuid
);
if
(
!defined($sliver)) {
#
Might
be
an
aggregate
instead
.
$
sliver
=
GeniAggregate
->
Lookup
($
sliver_uuid
);
if
(
!defined($sliver)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"No such sliver $sliver_uuid"
);
}
}
#
Does
not
exist
?
Not
an
error
.
$
user
=
GeniUser
->
Lookup
($
user_uuid
);
if
(
! defined($user)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
undef
,
"$user_uuid is not bound to $sliver_uuid"
);
}
my
$
slice
=
$
sliver
->
GetSlice
();
#
#
The
SA
UUID
comes
from
the
SSL
environment
(
certificate
).
#
my
$
sa_uuid
=
$
ENV
{
'GENIUUID'
};
my
$
authority
=
GeniAuthority
->
Lookup
($
sa_uuid
);
if
(
!defined($authority)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No slice authority record for $sa_uuid"
);
}
#
#
Verify
that
this
is
the
SA
for
the
slice
.
#
if
(
! $slice->IsSliceAuthority($authority)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_FORBIDDEN
,
undef
,
"Must be the SA for the slice"
);
}
$
user
->
UnBindFromSlice
($
slice
)
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Error unbinding user from sliver"
);
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
undef
,
"$user_uuid has been unbound from sliver"
);
}
protogeni/lib/GeniCMClient.pm.in
View file @
23a12aa5
...
...
@@ -38,8 +38,6 @@ my $TBAPPROVAL = "@TBAPPROVALEMAIL@";
my
$
TBAUDIT
=
"@TBAUDITEMAIL@"
;
my
$
BOSSNODE
=
"@BOSSNODE@"
;
my
$
OURDOMAIN
=
"@OURDOMAIN@"
;
my
$
GENICENTRAL
=
"myboss.little-emulab-bsd61.testbed.emulab.net"
;
my
$
GENICENTRALURL
=
"https://$GENICENTRAL/protogeni/xmlrpc"
;
#
_Always_
make
sure
that
this
1
is
at
the
end
of
the
file
...
1
;
...
...
protogeni/lib/GeniComponent.pm.in
View file @
23a12aa5
...
...
@@ -159,6 +159,52 @@ sub url($) { return field($_[0], "url"); }
sub
hrn
($)
{
return
field
($
_
[
0
],
"hrn"
);
}
sub
cert
($)
{
return
field
($
_
[
0
],
"cert"
);
}
#
#
Class
method
to
lookup
the
component
for
a
given
resource
(
uuid
)
by
#
looking
in
the
resources
table
.
#
sub
LookupByResource
($$)
{
my
($
class
,
$
uuid
)
=
@
_
;
return
undef
if
(
! ($uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/));
my
$
query_result
=
DBQueryWarn
(
"select component_idx from geni_resources "
.
"where resource_uuid='$uuid'"
);
return
undef
if
(
! $query_result || !$query_result->numrows);
my
($
idx
)
=
$
query_result
->
fetchrow_array
();
return
GeniComponent
->
Lookup
($
idx
);
}
#
#
Method
to
insert
a
new
geni_resources
record
for
the
component
.
#
sub
NewResource
($$)
{
my
($
self
,
$
uuid
)
=
@
_
;
return
-
1
if
(
! ref($self));
my
$
idx
=
TBGetUniqueIndex
(
'next_resource'
,
1
);
my
$
component_idx
=
$
self
->
idx
();
$
uuid
=
DBQuoteSpecial
(
"$uuid"
);
return
-
1
if
(
! DBQueryWarn("replace into geni_resources set ".
" idx=$idx, resource_uuid=$uuid, "
.
" resource_type='node', "
.
" created=now(), component_idx=$component_idx"
));
return
0
;
}
#
#
Refresh
a
class
instance
by
reloading
from
the
DB
.
#
...
...
@@ -248,64 +294,6 @@ sub DiscoverResources($$$$$)
return
0
;
}
#
#
Bind
and
UnBind
users
to
/
from
slivers
.
#
#
We
do
this
with
the
local
SA
as
the
credential
,
not
the
sliver
credential
.
#
sub
BindUser
($$$$)
{
my
($
self
,
$
sliver
,
$
target_user
)
=
@
_
;
#
Must
be
a
real
reference
.
return
-
1
if
(
! (ref($self) && ref($sliver) && ref($target_user)));
my
$
sshkey
;
$
target_user
->
GetSSHKey
(\$
sshkey
);
my
$
userinfo
=
{
"hrn"
=>
$
target_user
->
hrn
(),
"uuid"
=>
$
target_user
->
uuid
(),
"name"
=>
$
target_user
->
name
(),
"email"
=>
$
target_user
->
email
(),
"cert"
=>
$
target_user
->
cert
(),
"sshkey"
=>
$
sshkey
};
my
$
response
=
Genixmlrpc
::
CallMethodHTTP
($
self
->
url
(),
undef
,
"CM::BindUser"
,
{
"sliver"
=>
$
sliver
->
cert
(),
"userinfo"
=>
$
userinfo
});
if
($
response
->
code
()
!= GENIRESPONSE_SUCCESS) {
print
STDERR
"Could not bind $target_user to sliver $sliver
\n
"
;
return
-
1
;
}
return
0
;
}
sub
UnBindUser
($$$$)
{
my
($
self
,
$
sliver
,
$
target_user
)
=
@
_
;
#
Must
be
a
real
reference
.
return
-
1
if
(
! (ref($self) && ref($sliver) && ref($target_user)));
my
$
response
=
Genixmlrpc
::
CallMethodHTTP
($
self
->
url
(),
undef
,
"CM::UnBindUser"
,
{
"sliver"
=>
$
sliver
->
cert
(),
"user"
=>
$
target_user
->
cert
()
});
if
($
response
->
code
()
!= GENIRESPONSE_SUCCESS) {
print
STDERR
"Could not unbind $target_user to sliver $sliver
\n
"
;
return
-
1
;
}
return
0
;
}
#
#
Get
a
Ticket
from
a
component
;
#
...
...
protogeni/lib/GeniCredential.pm.in
View file @
23a12aa5
...
...
@@ -49,6 +49,39 @@ $LOCALSA_FLAG = 1;