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
4e3396cf
Commit
4e3396cf
authored
Jun 03, 2008
by
Leigh B. Stoller
Browse files
Checkpoint
parent
9e7294d9
Changes
14
Hide whitespace changes
Inline
Side-by-side
protogeni/etc/protogeni.sql
View file @
4e3396cf
...
...
@@ -118,7 +118,27 @@ CREATE TABLE `geni_slivers` (
`uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`slice_uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`creator_uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`node_id`
varchar
(
32
)
default
NULL
,
`resource_uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`created`
datetime
default
NULL
,
`credential_idx`
int
(
10
)
unsigned
default
NULL
,
`ticket_idx`
int
(
10
)
unsigned
default
NULL
,
`component_idx`
int
(
10
)
unsigned
NOT
NULL
default
'0'
,
`aggregate_idx`
int
(
10
)
unsigned
default
NULL
,
`status`
enum
(
'ready'
,
'broken'
)
NOT
NULL
default
'ready'
,
PRIMARY
KEY
(
`idx`
),
UNIQUE
KEY
`uuid`
(
`uuid`
),
INDEX
`slice_uuid`
(
`slice_uuid`
)
)
ENGINE
=
MyISAM
DEFAULT
CHARSET
=
latin1
;
#
#
Geni
Aggregates
,
which
are
a
collection
of
resources
(
nodes
,
links
,
etc
).
#
DROP
TABLE
IF
EXISTS
`geni_aggregates`
;
CREATE
TABLE
`geni_aggregates`
(
`idx`
mediumint
(
8
)
unsigned
NOT
NULL
default
'0'
,
`uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`slice_uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`creator_uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`created`
datetime
default
NULL
,
`credential_idx`
int
(
10
)
unsigned
default
NULL
,
`ticket_idx`
int
(
10
)
unsigned
default
NULL
,
...
...
@@ -177,3 +197,13 @@ CREATE TABLE `geni_certificates` (
PRIMARY
KEY
(
`uuid`
)
)
ENGINE
=
MyISAM
DEFAULT
CHARSET
=
latin1
;
#
#
A
clearinghouse
table
to
hold
sshkeys
associated
with
geni
users
.
#
DROP
TABLE
IF
EXISTS
`geni_sshkeys`
;
CREATE
TABLE
`geni_sshkeys`
(
`uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`created`
datetime
default
NULL
,
`sshkey`
text
,
PRIMARY
KEY
(
`uuid`
)
)
ENGINE
=
MyISAM
DEFAULT
CHARSET
=
latin1
;
protogeni/lib/GeniAggregate.pm.in
View file @
4e3396cf
...
...
@@ -22,6 +22,7 @@ use GeniDB;
use
GeniCredential
;
use
GeniCertificate
;
use
GeniSliver
;
use
GeniSlice
;
use
libdb
qw
(
TBGetUniqueIndex
);
use
English
;
use
overload
(
'""'
=>
'Stringify'
);
...
...
@@ -77,6 +78,7 @@ sub Lookup($$)
my
$
self
=
{};
$
self
->{
'AGGREGATE'
}
=
$
query_result
->
fetchrow_hashref
();
$
self
->{
'CREDENTIAL'
}
=
undef
;
$
self
->{
'SLICE'
}
=
undef
;
bless
($
self
,
$
class
);
#
...
...
@@ -214,6 +216,31 @@ sub GetCredential($)
return
$
credential
;
}
#
#
Get
the
slice
for
the
aggregate
.
#
sub
GetSlice
($)
{
my
($
self
)
=
@
_
;
return
undef
if
(
! ref($self));
return
$
self
->{
'SLICE'
}
if
(
defined
($
self
->{
'SLICE'
}));
if
(
!defined($self->slice_uuid())) {
print
STDERR
"No slice associated with $self
\n
"
;
return
undef
;
}
my
$
slice
=
GeniSlice
->
Lookup
($
self
->
slice_uuid
());
if
(
!defined($slice)) {
print
STDERR
"Could not get slice object associated with $self
\n
"
;
return
undef
;
}
$
self
->{
'SLICE'
}
=
$
slice
;
return
$
slice
;
}
#
#
Create
a
signed
credential
for
this
aggregate
,
issued
to
the
provided
user
.
#
The
credential
will
grant
all
permissions
for
now
.
...
...
protogeni/lib/GeniAuthority.pm.in
View file @
4e3396cf
...
...
@@ -111,17 +111,18 @@ sub Stringify($)
#
#
Create
a
Geni
authority
in
the
DB
.
#
sub
Create
($$$$$)
sub
Create
($$$$$
$
)
{
my
($
class
,
$
uuid
,
$
hrn
,
$
url
,
$
cert
)
=
@
_
;
my
($
class
,
$
uuid
,
$
hrn
,
$
url
,
$
cert
,
$
prefix
)
=
@
_
;
my
@
insert_data
=
();
my
$
idx
=
TBGetUniqueIndex
(
'next_authority'
,
1
);
my
$
safe_hrn
=
DBQuoteSpecial
($
hrn
);
my
$
safe_url
=
DBQuoteSpecial
($
url
);
my
$
safe_uuid
=
DBQuoteSpecial
($
uuid
);
my
$
safe_cert
=
DBQuoteSpecial
($
cert
);
my
$
safe_hrn
=
DBQuoteSpecial
($
hrn
);
my
$
safe_url
=
DBQuoteSpecial
($
url
);
my
$
safe_uuid
=
DBQuoteSpecial
($
uuid
);
my
$
safe_cert
=
DBQuoteSpecial
($
cert
);
my
$
safe_prefix
=
DBQuoteSpecial
($
prefix
);
#
Now
tack
on
other
stuff
we
need
.
push
(@
insert_data
,
"created=now()"
);
...
...
@@ -129,6 +130,7 @@ sub Create($$$$$)
push
(@
insert_data
,
"hrn=$safe_hrn"
);
push
(@
insert_data
,
"url=$safe_url"
);
push
(@
insert_data
,
"uuid=$safe_uuid"
);
push
(@
insert_data
,
"uuid_prefix=$safe_prefix"
);
#
Insert
into
DB
.
DBQueryWarn
(
"replace into geni_sliceauthorities set "
.
...
...
protogeni/lib/GeniCH.pm.in
View file @
4e3396cf
...
...
@@ -81,6 +81,7 @@ sub LookupUser($)
"sa"
=>
{
"hrn"
=>
$
authority
->
hrn
(),
"uuid"
=>
$
authority
->
uuid
(),
"cert"
=>
$
authority
->
cert
(),
"uuid_prefix"
=>
$
authority
->
uuid_prefix
(),
"url"
=>
$
authority
->
url
()
}
};
$
blob
->{
'sshkey'
}
=
$
sshkey
...
...
@@ -114,10 +115,11 @@ sub LookupSlice($)
"uuid"
=>
$
slice
->
uuid
(),
"creator_uuid"
=>
$
slice
->
creator_uuid
(),
"cert"
=>
$
slice
->
cert
(),
"sa"
=>
{
"hrn"
=>
$
authority
->
hrn
(),
"uuid"
=>
$
authority
->
uuid
(),
"cert"
=>
$
authority
->
cert
(),
"url"
=>
$
authority
->
url
()
}
"sa"
=>
{
"hrn"
=>
$
authority
->
hrn
(),
"uuid"
=>
$
authority
->
uuid
(),
"cert"
=>
$
authority
->
cert
(),
"uuid_prefix"
=>
$
authority
->
uuid_prefix
(),
"url"
=>
$
authority
->
url
()
}
};
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
...
...
protogeni/lib/GeniCM.pm.in
View file @
4e3396cf
...
...
@@ -49,6 +49,8 @@ my $OURDOMAIN = "@OURDOMAIN@";
my
$
CREATEEXPT
=
"$TB/bin/batchexp"
;
my
$
NALLOC
=
"$TB/bin/nalloc"
;
my
$
AVAIL
=
"$TB/sbin/avail"
;
my
$
TBSWAP
=
"$TB/bin/tbswap"
;
my
$
SWAPEXP
=
"$TB/bin/swapexp"
;
#
#
Discover
resources
on
this
component
,
returning
a
resource
availablity
spec
...
...
@@ -199,7 +201,7 @@ sub GetTicket($)
#
Note
the
-
h
option
;
allows
experiment
with
no
NS
file
.
system
(
"$CREATEEXPT -q -i -w -E 'Geni Slice Experiment' "
.
"-h '$slice_uuid' -p
g
eni
s
lices -e $eid"
);
"-h '$slice_uuid' -p
G
eni
S
lices -e $eid"
);
if
($?)
{
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Internal Error"
);
...
...
@@ -295,6 +297,8 @@ sub CreateSliver($)
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"No local experiment for slice"
);
}
my
$
pid
=
$
experiment
->
pid
();
my
$
eid
=
$
experiment
->
eid
();
#
#
See
if
we
have
a
record
of
this
slice
in
the
DB
.
If
not
,
throw
an
...
...
@@ -323,7 +327,7 @@ sub CreateSliver($)
"Error binding user to slice"
);
#
#
We
are
actually
an
Aggregate
,
so
return
an
aggregate
of
sliver
,
#
We
are
actually
an
Aggregate
,
so
return
an
aggregate
of
sliver
s
,
#
even
if
there
is
just
one
node
(
simpler
).
#
my
$
aggregate
=
GeniAggregate
->
Create
($
ticket
);
...
...
@@ -365,6 +369,22 @@ sub CreateSliver($)
}
}
#
#
Run
swapexp
in
update
mode
.
The
nodes
are
already
allocated
,
but
need
#
to
be
configured
like
a
real
experiment
.
#
#
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
(
!$impotent) {
system
(
"$SWAPEXP -s modify -r -g $pid $eid"
);
if
($?)
{
$
message
=
"Failed to tbswap $pid,$eid"
;
goto
bad
;
}
}
#
#
The
API
states
we
return
a
credential
to
control
the
sliver
/
aggregate
.
#
...
...
@@ -492,3 +512,214 @@ 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/GeniComponent.pm.in
View file @
4e3396cf
...
...
@@ -248,6 +248,64 @@ 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/GeniSA.pm.in
View file @
4e3396cf
...
...
@@ -24,9 +24,11 @@ use lib '@prefix@/lib';
use
GeniDB
;
use
Genixmlrpc
;
use
GeniResponse
;
use
User
;
use
GeniUser
;
use
libtestbed
;
use
GeniSlice
;
use
GeniCredential
;
use
GeniCertificate
;
use
emutil
;
use
English
;
use
Data
::
Dumper
;
...
...
protogeni/lib/GeniSlice.pm.in
View file @
4e3396cf
...
...
@@ -249,7 +249,8 @@ sub CreateFromRegistry($$)
$
authority
=
GeniAuthority
->
Create
($
blob
->{
'sa'
}->{
'uuid'
},
$
blob
->{
'sa'
}->{
'hrn'
},
$
blob
->{
'sa'
}->{
'url'
},
$
blob
->{
'sa'
}->{
'cert'
});
$
blob
->{
'sa'
}->{
'cert'
},
$
blob
->{
'sa'
}->{
'uuid_prefix'
});
if
(
!defined($authority)) {
print
STDERR
"Could not create new authority record
\n
"
;
return
undef
;
...
...
@@ -291,6 +292,10 @@ sub Delete($)
my
$
idx
=
$
self
->
idx
();
my
$
uuid
=
$
self
->
uuid
();
my
$
experiment
=
$
self
->
GetExperiment
();
return
-
1
if
(
!defined($experiment));
$
experiment
->
UnBindNonLocalUsers
();
DBQueryWarn
(
"delete from geni_certificates where uuid='$uuid'"
)
or
return
-
1
;
...
...
@@ -301,34 +306,32 @@ sub Delete($)
}
#
#
Bind
user
to
slice
.
#
Return
the
emulab
experiment
for
this
slice
.
#
sub
BindUserToSlice
($
$)
sub
GetExperiment
(
$)
{
my
($
self
,
$
user
)
=
@
_
;
my
($
self
)
=
@
_
;
return
-
1
if
(
!
(
ref($self)
&& ref($user))
);
return
undef
if
(
!ref($self));
my
$
experiment
=
Experiment
->
Lookup
($
self
->
uuid
());
if
(
!defined($experiment)) {
print
STDERR
"Could not locate experiment object for $self
\n
"
;
return
-
1
;
}
return
$
user
return
Experiment
->
Lookup
($
self
->
uuid
());
}
#
#
Return
the
emulab
experiment
for
th
is
slice
.
#
Check
if
the
given
SA
is
the
actual
SA
for
th
e
slice
.
#
sub
GetExperiment
(
$)
sub
IsSliceAuthority
($
$)
{
my
($
self
)
=
@
_
;
my
($
self
,
$
authority
)
=
@
_
;
return
undef
if
(
!ref($self));
return
0
if
(
!
(
ref($self)
&& ref($authority))
);
return
Experiment
->
Lookup
($
self
->
uuid
());
return
1
if
($
self
->
sa_idx
()
==
$
authority
->
idx
());
return
0
;
}
#
_Always_
make
sure
that
this
1
is
at
the
end
of
the
file
...
...
...
protogeni/lib/GeniSliver.pm.in
View file @
4e3396cf
...
...
@@ -18,11 +18,12 @@ use vars qw(@ISA @EXPORT);
use
lib
'@prefix@/lib'
;
use
GeniDB
;
use
GeniComponent
;
use
GeniSlice
;
use
GeniCredential
;
use
GeniCertificate
;
use
GeniAggregate
;
#
Hate
to
import
all
this
crap
;
need
a
utility
library
.
use
libdb
qw
(
TBGetUniqueIndex
);
use
libdb
qw
(
TBGetUniqueIndex
TBDB_ALLOCSTATE_RES_INIT_DIRTY
);
use
libtestbed
;
use
Experiment
;
use
Node
;
...
...
@@ -85,6 +86,7 @@ sub Lookup($$)
my
$
self
=
{};
$
self
->{
'SLIVER'
}
=
$
query_result
->
fetchrow_hashref
();
$
self
->{
'COMPONENT'
}
=
undef
;
#
Client
side
.
$
self
->{
'SLICE'
}
=
undef
;
#
Client
side
.
$
self
->{
'CREDENTIAL'
}
=
undef
;
#
Client
side
.
$
self
->{
'AGGREGATE'
}
=
undef
;
#
server
side
.
...
...
@@ -189,6 +191,7 @@ sub Create($$$;$$)
$
sliver
->{
'COMPONENT'
}
=
$
component
if
(
defined
($
component
));
$
sliver
->{
'AGGREGATE'
}
=
undef
;
$
sliver
->{
'SLICE'
}
=
undef
;
return
$
sliver
;
}
...
...
@@ -340,6 +343,31 @@ sub GetComponent($)
return
$
component
;
}
#
#
Get
the
slice
for
the
sliver
.