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
89c96adb
Commit
89c96adb
authored
May 30, 2008
by
Leigh B. Stoller
Browse files
Checkpoint
parent
1fd88cbc
Changes
15
Hide whitespace changes
Inline
Side-by-side
protogeni/lib/GNUmakefile.in
View file @
89c96adb
...
...
@@ -15,7 +15,7 @@ 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
GeniAuthority.pm GeniCertificate.pm
GeniAggregate.pm
#
# Force dependencies on the scripts so that they will be rerun through
...
...
protogeni/lib/GeniAggregate.pm.in
0 → 100644
View file @
89c96adb
#
!/usr/bin/perl -wT
#
#
EMULAB
-
COPYRIGHT
#
Copyright
(
c
)
2008
University
of
Utah
and
the
Flux
Group
.
#
All
rights
reserved
.
#
package
GeniAggregate
;
#
#
Some
simple
ticket
stuff
.
#
use
strict
;
use
Exporter
;
use
vars
qw
(@
ISA
@
EXPORT
);
@
ISA
=
"Exporter"
;
@
EXPORT
=
qw
(
);
#
Must
come
after
package
declaration
!
use
lib
'@prefix@/lib'
;
use
GeniDB
;
use
GeniCredential
;
use
GeniCertificate
;
use
GeniSliver
;
use
libdb
qw
(
TBGetUniqueIndex
);
use
English
;
use
overload
(
'""'
=>
'Stringify'
);
use
XML
::
Simple
;
#
Configure
variables
my
$
TB
=
"@prefix@"
;
my
$
TBOPS
=
"@TBOPSEMAIL@"
;
my
$
TBAPPROVAL
=
"@TBAPPROVALEMAIL@"
;
my
$
TBAUDIT
=
"@TBAUDITEMAIL@"
;
my
$
BOSSNODE
=
"@BOSSNODE@"
;
my
$
OURDOMAIN
=
"@OURDOMAIN@"
;
my
$
SIGNCRED
=
"$TB/sbin/signgenicred"
;
my
$
VERIFYCRED
=
"$TB/sbin/verifygenicred"
;
#
Cache
of
instances
to
avoid
regenerating
them
.
my
%
aggregates
=
();
#
#
Lookup
by
idx
,
or
uuid
.
#
sub
Lookup
($$)
{
my
($
class
,
$
token
)
=
@
_
;
my
$
query_result
;
my
$
idx
;
if
($
token
=~
/^\
d
+$/)
{
$
idx
=
$
token
;
}
elsif
($
token
=~
/^\
w
+\-\
w
+\-\
w
+\-\
w
+\-\
w
+$/)
{
$
query_result
=
DBQueryWarn
(
"select idx from geni_aggregates "
.
"where uuid='$token'"
);
return
undef
if
(
! $query_result || !$query_result->numrows);
($
idx
)
=
$
query_result
->
fetchrow_array
();
}
else
{
return
undef
;
}
#
Look
in
cache
first
return
$
aggregates
{
"$idx"
}
if
(
exists
($
aggregates
{
"$idx"
}));
$
query_result
=
DBQueryWarn
(
"select * from geni_aggregates where idx='$idx'"
);
return
undef
if
(
!$query_result || !$query_result->numrows);
my
$
self
=
{};
$
self
->{
'AGGREGATE'
}
=
$
query_result
->
fetchrow_hashref
();
$
self
->{
'CREDENTIAL'
}
=
undef
;
bless
($
self
,
$
class
);
#
#
Grab
the
certificate
,
since
we
will
probably
want
it
.
#
my
$
uuid
=
$
self
->{
'AGGREGATE'
}->{
'uuid'
};
my
$
certificate
=
GeniCertificate
->
Lookup
($
uuid
);
if
(
!defined($certificate)) {
print
STDERR
"Could not find certificate for aggregate $idx ($uuid)
\n
"
;
return
undef
;
}
$
self
->{
'CERTIFICATE'
}
=
$
certificate
;
#
Add
to
cache
.
$
aggregates
{$
self
->{
'AGGREGATE'
}->{
'idx'
}}
=
$
self
;
return
$
self
;
}
#
#
Stringify
for
output
.
#
sub
Stringify
($)
{
my
($
self
)
=
@
_
;
my
$
uuid
=
$
self
->
uuid
();
my
$
idx
=
$
self
->
idx
();
return
"[GeniAggregate: $uuid, IDX: $idx]"
;
}
#
#
Create
a
Geni
aggregate
in
the
DB
.
This
happens
on
the
server
side
only
#
for
now
.
The
client
side
does
not
actually
know
its
an
aggregate
,
at
#
least
not
yet
.
#
sub
Create
($$)
{
my
($
class
,
$
ticket
)
=
@
_
;
my
@
insert_data
=
();
#
Every
aggregate
gets
a
new
unique
index
.
my
$
idx
=
TBGetUniqueIndex
(
'next_aggregate'
,
1
);
#
Create
a
cert
pair
,
which
gives
us
a
new
uuid
.
my
$
certificate
=
GeniCertificate
->
Create
(
"aggregate"
);
if
(
!defined($certificate)) {
print
STDERR
"Could not generate new certificate and UUID!
\n
"
;
return
undef
;
}
my
$
uuid
=
$
certificate
->
uuid
();
my
$
slice_uuid
=
$
ticket
->
slice_uuid
();
my
$
owner_uuid
=
$
ticket
->
owner_uuid
();
#
Now
tack
on
other
stuff
we
need
.
push
(@
insert_data
,
"created=now()"
);
push
(@
insert_data
,
"idx='$idx'"
);
push
(@
insert_data
,
"uuid='$uuid'"
);
push
(@
insert_data
,
"creator_uuid='$owner_uuid'"
);
push
(@
insert_data
,
"slice_uuid='$slice_uuid'"
);
#
Insert
into
DB
.
if
(
!DBQueryWarn("insert into geni_aggregates set " .
join
(
","
,
@
insert_data
)))
{
$
certificate
->
Delete
();
return
undef
;
}
return
GeniAggregate
->
Lookup
($
idx
);
}
#
accessors
sub
field
($$)
{
return
((
! ref($_[0])) ? -1 : $_[0]->{'AGGREGATE'}->{$_[1]}); }
sub
idx
($)
{
return
field
($
_
[
0
],
"idx"
);
}
sub
uuid
($)
{
return
field
($
_
[
0
],
"uuid"
);
}
sub
slice_uuid
($)
{
return
field
($
_
[
0
],
"slice_uuid"
);
}
sub
creator_uuid
($)
{
return
field
($
_
[
0
],
"creator_uuid"
);
}
sub
created
($)
{
return
field
($
_
[
0
],
"created"
);
}
sub
credential_idx
($)
{
return
field
($
_
[
0
],
"credential_idx"
);
}
sub
ticket_idx
($)
{
return
field
($
_
[
0
],
"ticket_idx"
);
}
sub
cert
($)
{
return
$
_
[
0
]->{
'CERTIFICATE'
}->
cert
();
}
sub
GetCertificate
($)
{
return
$
_
[
0
]->{
'CERTIFICATE'
};
}
#
#
List
of
slivers
for
this
aggregate
.
#
sub
SliverList
($$)
{
my
($
self
,
$
pref
)
=
@
_
;
my
@
result
=
();
return
-
1
if
(
! (ref($self) && ref($pref)));
my
$
idx
=
$
self
->
idx
();
my
$
query_result
=
DBQueryWarn
(
"select idx from geni_slivers where aggregate_idx='$idx'"
);
return
-
1
if
(
!$query_result);
while
(
my
($
sliver_idx
)
=
$
query_result
->
fetchrow_array
())
{
my
$
sliver
=
GeniSliver
->
Lookup
($
sliver_idx
);
if
(
!defined($sliver)) {
print
STDERR
"Could not find sliver object for $sliver_idx
\n
"
;
return
-
1
;
}
push
(@
result
,
$
sliver
);
}
@$
pref
=
@
result
;
return
0
;
}
#
#
Get
the
credential
for
the
aggregate
.
#
sub
GetCredential
($)
{
my
($
self
)
=
@
_
;
return
undef
if
(
! ref($self));
return
$
self
->{
'CREDENTIAL'
}
if
(
defined
($
self
->{
'CREDENTIAL'
}));
if
(
!defined($self->credential_idx())) {
print
STDERR
"No credential associated with $self
\n
"
;
return
undef
;
}
my
$
credential
=
GeniCredential
->
Lookup
($
self
->
credential_idx
());
if
(
!defined($credential)) {
print
STDERR
"Could not get credential object associated with $self
\n
"
;
return
undef
;
}
$
self
->{
'CREDENTIAL'
}
=
$
credential
;
return
$
credential
;
}
#
#
Create
a
signed
credential
for
this
aggregate
,
issued
to
the
provided
user
.
#
The
credential
will
grant
all
permissions
for
now
.
#
#
Should
we
store
these
credentials
in
the
DB
,
recording
what
we
hand
out
?
#
sub
NewCredential
($$)
{
my
($
self
,
$
owner
)
=
@
_
;
return
undef
if
(
! (ref($self) && ref($owner)));
my
$
credential
=
GeniCredential
->
Create
($
self
,
$
owner
);
if
(
!defined($credential)) {
print
STDERR
"Could not create credential for $self, $owner
\n
"
;
return
undef
;
}
if
($
credential
->
Sign
($
self
->
GetCertificate
())
!= 0) {
print
STDERR
"Could not sign credential for $self, $owner
\n
"
;
return
undef
;
}
return
$
credential
;
}
#
#
Start
all
the
slivers
in
the
aggregate
.
#
sub
StartUp
($)
{
my
($
self
)
=
@
_
;
return
-
1
if
(
! ref($self));
my
@
slivers
=
();
if
($
self
->
SliverList
(\@
slivers
)
!= 0) {
print
STDERR
"Could not get sliver list for $self
\n
"
;
return
-
1
;
}
foreach
my
$
sliver
(@
slivers
)
{
if
($
sliver
->
StartUp
()
!= 0) {
print
STDERR
"Could not start $sliver in $self
\n
"
;
next
;
}
}
return
0
;
}
#
#
Unprovision
all
the
slivers
in
the
aggregate
.
#
sub
UnProvision
($)
{
my
($
self
)
=
@
_
;
return
-
1
if
(
! ref($self));
my
@
slivers
=
();
if
($
self
->
SliverList
(\@
slivers
)
!= 0) {
print
STDERR
"Could not get sliver list for $self
\n
"
;
return
-
1
;
}
foreach
my
$
sliver
(@
slivers
)
{
if
($
sliver
->
UnProvision
()
!= 0) {
print
STDERR
"Could not unprovision $sliver in $self
\n
"
;
DBQueryWarn
(
"update geni_slivers set status='broken' "
.
"where idx="
.
$
sliver
->
idx
());
next
;
}
}
return
0
;
}
#
#
Destroy
all
the
slivers
in
the
aggregate
,
and
then
the
aggregate
if
there
#
is
nothing
in
it
.
Leave
it
around
if
something
goes
wrong
.
#
sub
Delete
($)
{
my
($
self
)
=
@
_
;
my
$
broken
=
0
;
return
-
1
if
(
! ref($self));
my
@
slivers
=
();
if
($
self
->
SliverList
(\@
slivers
)
!= 0) {
print
STDERR
"Could not get sliver list for $self
\n
"
;
return
-
1
;
}
foreach
my
$
sliver
(@
slivers
)
{
if
($
sliver
->
status
()
eq
"broken"
)
{
$
broken
++;
next
;
}
if
($
sliver
->
Delete
()
!= 0) {
print
STDERR
"Could not delete $sliver from $self
\n
"
;
DBQueryWarn
(
"update geni_slivers set status='broken' "
.
"where idx="
.
$
sliver
->
idx
());
$
broken
++;
next
;
}
}
return
-
1
if
($
broken
);
my
$
idx
=
$
self
->
idx
();
my
$
uuid
=
$
self
->
uuid
();
DBQueryWarn
(
"delete from geni_credentials where this_uuid='$uuid'"
)
or
return
-
1
;
DBQueryWarn
(
"delete from geni_certificates where uuid='$uuid'"
)
or
return
-
1
;
DBQueryWarn
(
"delete from geni_aggregates where idx='$idx'"
)
or
return
-
1
;
return
0
;
}
#
_Always_
make
sure
that
this
1
is
at
the
end
of
the
file
...
1
;
protogeni/lib/GeniCH.pm.in
View file @
89c96adb
...
...
@@ -65,6 +65,11 @@ sub LookupUser($)
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No slice authority found for user"
);
}
#
Grab
ssh
key
.
my
$
sshkey
;
if
($
user
->
GetSSHKey
(\$
sshkey
)
!= 0) {
print
STDERR
"Could not get ssh key for $user
\n
"
;
}
#
Return
a
blob
.
my
$
blob
=
{
"uid"
=>
$
user
->
uid
(),
...
...
@@ -78,6 +83,8 @@ sub LookupUser($)
"cert"
=>
$
authority
->
cert
(),
"url"
=>
$
authority
->
url
()
}
};
$
blob
->{
'sshkey'
}
=
$
sshkey
if
(
defined
($
sshkey
));
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
}
...
...
@@ -127,6 +134,7 @@ sub RegisterUser($)
my
$
name
=
$
argref
->{
'name'
};
my
$
email
=
$
argref
->{
'email'
};
my
$
cert
=
$
argref
->{
'cert'
};
my
$
sshkey
=
$
argref
->{
'sshkey'
};
if
(
! (defined($hrn) && defined($name) &&
defined
($
email
)
&&
defined
($
cert
)
&&
defined
($
uuid
)))
{
...
...
@@ -156,6 +164,10 @@ sub RegisterUser($)
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
...
...
@@ -209,7 +221,7 @@ sub RegisterUser($)
"uid: "
.
TBFieldErrorString
());
}
my
$
newuser
=
GeniUser
->
Create
($
hrn
,
$
uid
,
$
uuid
,
$
name
,
$
email
,
$
cert
,
$
sa_idx
);
$
name
,
$
email
,
$
cert
,
$
sa_idx
,
$
sshkey
);
if
(
!defined($newuser)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"$hrn/$email could not be registered"
);
...
...
protogeni/lib/GeniCHClient.pm.in
View file @
89c96adb
...
...
@@ -82,18 +82,21 @@ sub LookupSlice($$)
#
Register
a
local
Emulab
user
at
the
Geni
ClearingHouse
(
which
in
the
#
prototype
is
Utah
Emulab
).
#
sub
RegisterUser
($$$$$)
sub
RegisterUser
($$$$$
$
)
{
my
($
hrn
,
$
uuid
,
$
name
,
$
email
,
$
cert
)
=
@
_
;
my
($
hrn
,
$
uuid
,
$
name
,
$
email
,
$
cert
,
$
sshkey
)
=
@
_
;
my
$
args
=
{
"hrn"
=>
$
hrn
,
"uuid"
=>
$
uuid
,
"name"
=>
$
name
,
"email"
=>
$
email
,
"cert"
=>
$
cert
};
$
args
->{
"sshkey"
}
=
$
sshkey
if
(
defined
($
sshkey
));
my
$
response
=
Genixmlrpc
::
CallMethodHTTP
($
GENICENTRALURL
,
undef
,
"CH::RegisterUser"
,
{
"hrn"
=>
$
hrn
,
"uuid"
=>
$
uuid
,
"name"
=>
$
name
,
"email"
=>
$
email
,
"cert"
=>
$
cert
});
"CH::RegisterUser"
,
$
args
);
return
-
1
if
(
!defined($response) || $response->code() != GENIRESPONSE_SUCCESS);
...
...
protogeni/lib/GeniCM.pm.in
View file @
89c96adb
...
...
@@ -26,6 +26,7 @@ use GeniTicket;
use
GeniCredential
;
use
GeniCertificate
;
use
GeniSlice
;
use
GeniAggregate
;
use
GeniSliver
;
use
GeniUser
;
use
libtestbed
;
...
...
@@ -267,6 +268,7 @@ sub CreateSliver($)
my
$
owner_uuid
=
$
ENV
{
'GENIUSER'
};
my
$
ticket
=
$
argref
->{
'ticket'
};
my
$
impotent
=
$
argref
->{
'impotent'
};
my
$
message
=
"Error creating sliver/aggregate"
;
$
impotent
=
0
if
(
!defined($impotent));
...
...
@@ -313,45 +315,92 @@ sub CreateSliver($)
"No user record for $owner_uuid"
);
}
my
$
sliver
=
GeniSliver
->
Create
($
ticket
);
if
(
!defined($sliver)) {
#
#
Create
an
emulab
nonlocal
user
for
tmcd
.
#
$
owner
->
BindToSlice
($
slice
)
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Error binding user to slice"
);
#
#
We
are
actually
an
Aggregate
,
so
return
an
aggregate
of
sliver
,
#
even
if
there
is
just
one
node
(
simpler
).
#
my
$
aggregate
=
GeniAggregate
->
Create
($
ticket
);
if
(
!defined($aggregate)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not create Geni
Sliver
object"
);
"Could not create Geni
Aggregate
object"
);
}
#
#
Provision
the
slice
.
Okay
,
we
already
allocated
the
node
above
,
#
so
this
should
just
work
,
unless
the
node
has
been
released
cause
#
it
has
been
too
long
.
#
Now
for
each
resource
(
okay
,
node
)
in
the
ticket
create
a
sliver
and
#
add
it
to
the
aggregate
.
#
if
(
!$impotent && $sliver->Provision() != 0) {
$
sliver
->
Delete
();
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not provision sliver"
);
my
@
slivers
=
();
foreach
my
$
resource_uuid
(
keys
(%{$
ticket
->
rspec
()->{
'node'
}}))
{
if
(
! ($resource_uuid =~ /^[-\w]*$/)) {
$
message
=
"Improper resource_uuid in ticket: $resource_uuid"
;
goto
bad
;
}
my
$
sliver
=
GeniSliver
->
Create
($
slice
,
$
owner
,
$
resource_uuid
);
if
(
!defined($sliver)) {
$
message
=
"Could not create GeniSliver object for $resource_uuid"
;
goto
bad
;
}
push
(@
slivers
,
$
sliver
);
}
#
#
Now
do
the
provisioning
(
note
that
we
actually
allocated
the
node
#
above
when
the
ticket
was
granted
).
The
add
the
sliver
to
the
aggregate
.
#
foreach
my
$
sliver
(@
slivers
)
{
if
(
!$impotent && $sliver->Provision() != 0) {
$
message
=
"Could not provision $sliver"
;
goto
bad
;
}
if
($
sliver
->
SetAggregate
($
aggregate
)
!= 0) {
$
message
=
"Could not aggregate for $sliver to $aggregate"
;
goto
bad
;
}
}
#
#
The
API
states
we
return
a
credential
to
control
the
sliver
.
#
The
API
states
we
return
a
credential
to
control
the
sliver
/
aggregate
.
#
my
$
credential
=
$
sliver
->
NewCredential
($
owner
);
my
$
credential
=
$
aggregate
->
NewCredential
($
owner
);
if
(
!defined($credential)) {
$
sliver
->
UnProvision
();
$
sliver
->
Delete
();
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not create credential sliver"
);
$
message
=
"Could not create credential for $aggregate"
;
goto
bad
;
}
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
credential
->
asString
());
bad
:
foreach
my
$
sliver
(@
slivers
)
{
$
sliver
->
UnProvision
()
if
(
! $impotent);
$
sliver
->
Delete
();
}
$
aggregate
->
Delete
()
if
(
defined
($
aggregate
));
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
$
message
);
}
#
#
Destroy
a
sliver
.
#
Start
a
sliver
(
not
sure
what
this
means
yet
,
so
reboot
for
now
)
.
#
sub
Destroy
Sliver
($)
sub
Start
Sliver
($)
{
my
($
argref
)
=
@
_
;
my
$
owner_uuid
=
$
ENV
{
'GENIUSER'
};
my
$
sliver_cert
=
$
argref
->{
'sliver'
};
my
$
credential
=
$
argref
->{
'credential'
};
my
$
sliver_uuid
;
my
$
impotent
=
$
argref
->{
'impotent'
};
$
impotent
=
0
if
(
!defined($impotent));
if
(
!defined($sliver_cert) || !defined($credential)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
);
...
...
@@ -360,28 +409,86 @@ sub DestroySliver($)
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not get uuid from Certificate"
);
$
credential
=
GeniCredential
->
CreateFromSigned
($
credential
);
if
(
!defined($credential)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not create GeniCredential object"
);
}
my
$
sliver
=
GeniSliver
->
Lookup
($
sliver_uuid
);
if
(
!defined($sliver)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
"No such sliver $sliver_uuid"
);
#
Might
be
an
aggregate
instead
.
$
sliver
=
GeniAggregate
->
Lookup
($
sliver_uuid
);
if
(
!defined($sliver)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
"No such sliver/aggregate $sliver_uuid"
);
}
}
#
The
credential
owner
has
to
match
what
is
in
the
ticket
.
if
(
! ($owner_uuid eq $credential->owner_uuid() &&
$
sliver_uuid
eq
$
credential
->
this_uuid
()))
{
return
GeniResponse
->
Create
(
GENIRESPONSE_FORBIDDEN
,
undef
,
"Invalid credentials for operation"
);
}
if
(
!$impotent) {
$
sliver
->
StartUp
()
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not start sliver/aggregate"
);
}
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
);
}
#
#
Destroy
a
sliver
/
aggregate
.
#
sub
DestroySliver
($)
{
my
($
argref
)
=
@
_
;
my
$
owner_uuid
=
$
ENV
{
'GENIUSER'
};
my
$
sliver_cert
=
$
argref
->{
'sliver'
};
my
$
credential
=
$
argref
->{
'credential'
};
my
$
sliver_uuid
;
my
$
impotent
=
$
argref
->{
'impotent'
};
$
impotent
=
0
if
(
!defined($impotent));
if
(
!defined($sliver_cert) || !defined($credential)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
);
}
GeniCertificate
->
CertificateInfo
($
sliver_cert
,
\$
sliver_uuid
)
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,