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
58d825e3
Commit
58d825e3
authored
May 13, 2008
by
Leigh B. Stoller
Browse files
Checkpoint
parent
85777f5c
Changes
10
Hide whitespace changes
Inline
Side-by-side
protogeni/lib/GNUmakefile.in
View file @
58d825e3
...
...
@@ -13,7 +13,7 @@ include $(OBJDIR)/Makeconf
LIB_SCRIPTS = Protogeni.pm GeniDB.pm GeniUser.pm GeniSAClient.pm \
GeniSlice.pm GeniSA.pm GeniCM.pm GeniCMClient.pm \
test.pl GeniTicket.pm GeniSliver.pm
test.pl GeniTicket.pm GeniSliver.pm
GeniCredential.pm
#
# Force dependencies on the scripts so that they will be rerun through
...
...
protogeni/lib/GeniCM.pm.in
View file @
58d825e3
...
...
@@ -23,6 +23,7 @@ use GeniDB;
use
Genixmlrpc
;
use
GeniResponse
;
use
GeniTicket
;
use
GeniCredential
;
use
GeniSliver
;
use
GeniUser
;
use
libtestbed
;
...
...
@@ -52,26 +53,39 @@ my $NALLOC = "$TB/bin/nalloc";
sub
GetTicket
($)
{
my
($
argref
)
=
@
_
;
my
$
owner_uuid
=
$
argref
->{
'owner_uuid'
};
my
$
slice_uuid
=
$
argref
->{
'slice_uuid'
};
my
$
rspec
=
$
argref
->{
'rspec'
};
my
$
impotent
=
$
argref
->{
'impotent'
};
my
$
credstring
=
$
argref
->{
'credential_string'
};
my
$
owner_uuid
=
$
ENV
{
'GENIUSER'
};
if
(
! (defined($slice_uuid) && ($slice_uuid =~ /^[-\w]+$/))) {
return
GeniResponse
->
MalformedArgsResponse
();
}
#
XXX
This
needs
to
come
from
the
SSL
environment
.
if
(
! (defined($owner_uuid) && ($owner_uuid =~ /^[-\w]+$/))) {
return
GeniResponse
->
MalformedArgsResponse
();
}
if
(
! defined($rspec)) {
return
GeniResponse
->
MalformedArgsResponse
();
}
$
impotent
=
0
if
(
!defined($impotent));
my
$
credential
=
GeniCredential
->
CreateFromSigned
($
credstring
);
if
(
!defined($credential)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not create GeniCredential object"
);
}
#
The
credential
owner
/
slice
has
to
match
what
was
provided
.
if
(
! ($owner_uuid eq $credential->owner_uuid() &&
$
slice_uuid
eq
$
credential
->
this_uuid
()))
{
return
GeniResponse
->
Create
(
GENIRESPONSE_FORBIDDEN
,
undef
,
"Invalid credentials for operation"
);
}
#
#
XXX
Should
we
create
a
local
geni_slices
record
in
the
DB
?
#
if
(
0
)
{
#
#
If
the
underlying
experiment
does
not
exist
,
need
to
create
#
a
holding
experiment
.
All
these
are
going
to
go
into
the
same
#
project
for
now
.
Generally
,
users
for
non
-
local
slices
do
not
...
...
@@ -110,7 +124,6 @@ if (0) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
"Improper node id"
);
}
}
#
#
Create
the
ticket
first
,
before
allocating
the
node
.
...
...
@@ -120,20 +133,20 @@ if (0) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not create GeniTicket object"
);
}
if
(
0
)
{
#
Nalloc
might
fail
if
the
node
gets
picked
up
by
someone
else
.
#
system
(
"$NALLOC $pid $eid $node_id"
);
if
(($?
>>
8
)
<
0
)
{
$
ticket
->
Delete
();
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Allocation failure"
);
}
elsif
(($?
>>
8
)
>
0
)
{
$
ticket
->
Delete
();
return
GeniResponse
->
Create
(
GENIRESPONSE_UNAVAILABLE
,
undef
,
"Could not allocate node
\n
"
);
if
(
!$impotent) {
system
(
"$NALLOC $pid $eid $node_id"
);
if
(($?
>>
8
)
<
0
)
{
$
ticket
->
Delete
();
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Allocation failure"
);
}
elsif
(($?
>>
8
)
>
0
)
{
$
ticket
->
Delete
();
return
GeniResponse
->
Create
(
GENIRESPONSE_UNAVAILABLE
,
undef
,
"Could not allocate node
\n
"
);
}
}
}
if
($
ticket
->
Sign
()
!= 0) {
#
Release
will
free
the
node
.
$
ticket
->
Release
();
...
...
@@ -147,6 +160,8 @@ if (0) {
#
#
Create
a
sliver
.
#
#
XXX
Credentials
stuff
.
#
sub
CreateSliver
($)
{
my
($
argref
)
=
@
_
;
...
...
@@ -190,5 +205,74 @@ sub CreateSliver($)
"Could not provision sliver"
);
}
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
0
,
"Wow!"
);
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
sliver
->
uuid
(),
"Wow!"
);
}
#
#
Start
a
sliver
.
I
take
this
to
mean
,
reboot
the
node
.
Currently
,
using
#
the
ticket
as
the
credential
.
#
#
XXX
Credentials
stuff
.
#
sub
StartSliver
($)
{
my
($
argref
)
=
@
_
;
my
$
ticket
=
$
argref
->{
'ticket'
};
my
$
sliver_uuid
=
$
argref
->{
'uuid'
};
if
(
!defined($sliver_uuid)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
);
}
my
$
sliver
=
GeniSliver
->
Lookup
($
sliver_uuid
);
if
(
!defined($sliver)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
"No such sliver $sliver_uuid"
);
}
if
(
! (defined($ticket) &&
!TBcheck_dbslot($ticket, "default", "text",
TBDB_CHECKDBSLOT_ERROR
)))
{
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"ticket: "
.
TBFieldErrorString
());
}
$
ticket
=
GeniTicket
->
CreateFromSignedTicket
($
ticket
);
if
(
!defined($ticket)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not create GeniTicket object"
);
}
$
sliver
->
Start
()
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not start $sliver"
);
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
);
}
#
#
Destroy
a
sliver
.
#
#
XXX
Credential
stuff
...
#
sub
DestroySliver
($)
{
my
($
argref
)
=
@
_
;
my
$
sliver_uuid
=
$
argref
->{
'uuid'
};
if
(
!defined($sliver_uuid)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
);
}
my
$
sliver
=
GeniSliver
->
Lookup
($
sliver_uuid
);
if
(
!defined($sliver)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
"No such sliver $sliver_uuid"
);
}
$
sliver
->
UnProvision
()
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not unprovision sliver"
);
$
sliver
->
Delete
()
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not delete sliver"
);
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
);
}
protogeni/lib/GeniCMClient.pm.in
View file @
58d825e3
...
...
@@ -23,6 +23,7 @@ use GeniDB;
use
Genixmlrpc
;
use
GeniResponse
;
use
GeniTicket
;
use
GeniCredential
;
use
GeniSliver
;
use
User
;
use
libtestbed
;
...
...
@@ -50,7 +51,8 @@ sub DiscoverResources($$)
my
($
experiment
,
$
pref
)
=
@
_
;
my
$
response
=
Genixmlrpc
::
CallMethodHTTP
($
GENICENTRAL
,
"SA::DiscoverResources"
,
Genixmlrpc
::
CallMethodHTTP
($
GENICENTRAL
,
User
->
LookupByUnixId
($
UID
),
"SA::DiscoverResources"
,
{
"uuid"
=>
$
experiment
->
uuid
()
});
return
-
1
...
...
@@ -87,11 +89,28 @@ sub GetTicket($$$$)
return
-
1
;
}
#
Need
to
construct
a
credential
.
my
$
credential
=
GeniCredential
->
Create
($
experiment
->
uuid
(),
$
this_user
->
uuid
());
if
(
!defined($credential)) {
print
STDERR
"Could not create a slice credential for $experiment!
\n
"
;
return
-
1
;
}
if
($
credential
->
AddCapability
(
"createslice"
,
0
))
{
print
STDERR
"Could not add capability to slice credential!
\n
"
;
return
-
1
;
}
if
($
credential
->
Sign
())
{
print
STDERR
"Could not sign slice credential!
\n
"
;
return
-
1
;
}
my
$
response
=
Genixmlrpc
::
CallMethodHTTP
($
component
,
"CM::GetTicket"
,
{
"slice_uuid"
=>
$
experiment
->
uuid
(),
"owner_uuid"
=>
$
this_user
->
uuid
(),
"rspec"
=>
$
rspec
});
Genixmlrpc
::
CallMethodHTTP
($
component
,
$
this_user
,
"CM::GetTicket"
,
{
"slice_uuid"
=>
$
experiment
->
uuid
(),
"credential_string"
=>
$
credential
->
asString
(),
"impotent"
=>
1
,
"rspec"
=>
$
rspec
});
return
-
1
if
(
!defined($response));
...
...
@@ -120,15 +139,35 @@ sub CreateSliver($$$)
return
-
1
if
(
!defined($response));
print
Dumper
($
response
);
return
-
1
if
($
response
->
code
()
!= GENIRESPONSE_SUCCESS);
my
$
sliver
=
undef
;
my
$
sliver
=
GeniSliver
->
Create
($
ticket
,
$
response
->
value
());
if
(
!defined($sliver)) {
print
STDERR
"Could not create local sliver object
\n
"
;
return
undef
;
}
$$
pref
=
$
sliver
;
return
0
;
}
sub
DestroySliver
($$)
{
my
($
experiment
,
$
sliver
)
=
@
_
;
my
$
ticket
=
$
sliver
->
GetTicket
();
my
$
response
=
Genixmlrpc
::
CallMethodHTTP
($
ticket
->
component
(),
"CM::DestroySliver"
,
{
"uuid"
=>
$
sliver
->
uuid
()
});
if
($
response
->
code
()
!= GENIRESPONSE_SUCCESS) {
print
STDERR
"Could not destroy sliver $sliver
\n
"
;
return
-
1
;
}
$
sliver
->
Delete
()
==
0
or
return
-
1
;
return
0
;
}
protogeni/lib/GeniCredential.pm.in
0 → 100644
View file @
58d825e3
#
!/usr/bin/perl -wT
#
#
EMULAB
-
COPYRIGHT
#
Copyright
(
c
)
2008
University
of
Utah
and
the
Flux
Group
.
#
All
rights
reserved
.
#
package
GeniCredential
;
#
#
Some
simple
credential
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
libtestbed
;
use
Experiment
;
use
libdb
qw
(
TBGetUniqueIndex
);
use
English
;
use
XML
::
Simple
;
use
XML
::
LibXML
;
use
Data
::
Dumper
;
use
File
::
Temp
qw
(
tempfile
);
#
Configure
variables
my
$
TB
=
"@prefix@"
;
my
$
TBOPS
=
"@TBOPSEMAIL@"
;
my
$
TBAPPROVAL
=
"@TBAPPROVALEMAIL@"
;
my
$
TBAUDIT
=
"@TBAUDITEMAIL@"
;
my
$
BOSSNODE
=
"@BOSSNODE@"
;
my
$
OURDOMAIN
=
"@OURDOMAIN@"
;
my
$
GENICENTRAL
=
"https://boss/protogeni/xmlrpc"
;
my
$
SIGNCRED
=
"$TB/sbin/signgenicred"
;
my
$
VERIFYCRED
=
"$TB/sbin/verifygenicred"
;
my
$
NFREE
=
"$TB/bin/nfree"
;
#
#
Create
an
empty
credential
object
.
#
sub
Create
($$$$)
{
my
($
class
,
$
this_uuid
,
$
owner_uuid
)
=
@
_
;
my
$
self
=
{};
$
self
->{
'this_uuid'
}
=
$
this_uuid
;
$
self
->{
'owner_uuid'
}
=
$
owner_uuid
;
$
self
->{
'string'
}
=
undef
;
$
self
->{
'capabilities'
}
=
undef
;
bless
($
self
,
$
class
);
return
$
self
;
}
#
accessors
sub
field
($$)
{
return
($
_
[
0
]->{$
_
[
1
]});
}
sub
this_uuid
($)
{
return
field
($
_
[
0
],
"this_uuid"
);
}
sub
owner_uuid
($)
{
return
field
($
_
[
0
],
"owner_uuid"
);
}
sub
asString
($)
{
return
field
($
_
[
0
],
"string"
);
}
sub
capabilities
($)
{
return
field
($
_
[
0
],
"capabilities"
);
}
#
#
Add
a
capability
to
the
array
.
#
sub
AddCapability
($$$)
{
my
($
self
,
$
name
,
$
delegate
)
=
@
_
;
return
-
1
if
(
!ref($self));
if
(
!defined($self->capabilities())) {
$
self
->{
'capabilities'
}
=
{};
}
$
self
->{
'capabilities'
}->{$
name
}
=
{
"can_delegate"
=>
$
delegate
};
return
0
;
}
#
#
Create
a
credential
object
from
a
signed
credential
string
.
#
sub
CreateFromSigned
($$)
{
my
($
class
,
$
string
)
=
@
_
;
#
First
verify
the
credential
my
($
fh
,
$
filename
)
=
tempfile
(
UNLINK
=>
0
);
return
undef
if
(
!defined($fh));
print
$
fh
$
string
;
close
($
fh
);
system
(
"$VERIFYCRED $filename"
);
if
($?)
{
print
STDERR
"Credential in $filename did not verify
\n
"
;
return
undef
;
}
unlink
($
filename
);
#
Use
XML
::
Simple
to
convert
to
something
we
can
mess
with
.
my
$
parser
=
XML
::
LibXML
->
new
;
my
$
doc
=
$
parser
->
parse_string
($
string
);
#
Dig
out
the
capabilities
my
($
cap_node
)
=
$
doc
->
getElementsByTagName
(
"capabilities"
);
return
undef
if
(
!defined($cap_node));
my
$
capabilities
=
XMLin
($
cap_node
->
toString
(),
ForceArray
=>
0
);
#
Dig
out
the
slice
uuid
.
Locally
,
I
am
not
sure
if
we
bother
to
#
keep
slices
in
the
DB
(
they
are
in
the
DB
at
geni
central
).
my
($
uuid_node
)
=
$
doc
->
getElementsByTagName
(
"this_uuid"
);
return
undef
if
(
!defined($uuid_node));
my
$
this_uuid
=
$
uuid_node
->
to_literal
();
if
(
! ($this_uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
print
STDERR
"Invalid this_uuid in credential
\n
"
;
return
undef
;
}
#
Dig
out
the
owner
uuid
.
Locally
,
I
am
not
sure
if
we
bother
to
#
keep
users
in
the
DB
(
they
are
in
the
DB
at
geni
central
).
($
uuid_node
)
=
$
doc
->
getElementsByTagName
(
"owner_uuid"
);
return
undef
if
(
!defined($uuid_node));
my
$
owner_uuid
=
$
uuid_node
->
to_literal
();
if
(
! ($owner_uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
print
STDERR
"Invalid owner_uuid in credential
\n
"
;
return
undef
;
}
my
$
self
=
{};
$
self
->{
'capabilities'
}
=
$
capabilities
;
$
self
->{
'this_uuid'
}
=
$
this_uuid
;
$
self
->{
'owner_uuid'
}
=
$
owner_uuid
;
$
self
->{
'string'
}
=
$
string
;
$
self
->{
'xmlref'
}
=
$
doc
;
bless
($
self
,
$
class
);
return
$
self
;
}
#
#
Might
have
to
delete
this
from
the
DB
.
#
sub
Delete
($)
{
my
($
self
)
=
@
_
;
return
-
1
if
(
! ref($self));
return
0
;
}
#
#
Sign
the
credential
.
#
sub
Sign
($)
{
my
($
self
)
=
@
_
;
return
-
1
if
(
!ref($self));
#
If
no
capabilities
,
then
allow
all
rights
,
no
delegation
.
if
(
!defined($self->capabilities())) {
$
self
->
AddCapability
(
"*"
,
0
);
}
#
This
little
wrapup
is
for
xmlout
.
my
$
capabilities
=
{
"capability"
=>
$
self
->
capabilities
()};
#
Every
one
gets
a
new
unique
index
,
which
is
used
in
the
xml
:
id
below
.
my
$
idx
=
TBGetUniqueIndex
(
'next_ticket'
,
1
);
my
$
this_uuid
=
$
self
->
this_uuid
();
my
$
owner_uuid
=
$
self
->
owner_uuid
();
my
$
cap_xml
=
XMLout
($
capabilities
,
"NoAttr"
=>
1
);
$
cap_xml
=~
s
/
opt
\>/
capabilities
\>/
g
;
#
#
Create
a
template
xml
file
to
sign
.
#
my
$
template
=
"<?xml version=
\"
1.0
\"
encoding=
\"
UTF-8
\"
standalone=
\"
no
\"
?>
\n
"
.
"<credential xml:id=
\"
ref1
\"
>
\n
"
.
" <type>capability</type>
\n
"
.
" <serial>$idx</serial>
\n
"
.
" <owner_uuid>$owner_uuid</owner_uuid>
\n
"
.
" <this_uuid>$this_uuid</this_uuid>
\n
"
.
" $cap_xml
\n
"
.
"</credential>
\n
"
;
my
($
fh
,
$
filename
)
=
tempfile
(
UNLINK
=>
0
);
return
-
1
if
(
!defined($fh));
print
$
fh
$
template
;
close
($
fh
);
#
#
Fire
up
the
signer
and
capture
the
output
.
This
is
the
signed
credential
#
that
is
returned
.
#
if
(
! open(SIGNER, "$SIGNCRED $filename |")) {
print
STDERR
"Could not start $SIGNCRED on $filename
\n
"
;
return
-
1
;
}
my
$
credential
=
""
;
while
(<
SIGNER
>)
{
$
credential
.=
$
_
;
}
if
(
!close(SIGNER)) {
print
STDERR
"Could not sign $filename
\n
"
;
return
-
1
;
}
$
self
->{
'string'
}
=
$
credential
;
unlink
($
filename
);
return
0
;
}
#
_Always_
make
sure
that
this
1
is
at
the
end
of
the
file
...
1
;
protogeni/lib/GeniSliver.pm.in
View file @
58d825e3
...
...
@@ -25,6 +25,7 @@ use Node;
use
English
;
use
Data
::
Dumper
;
use
File
::
Temp
qw
(
tempfile
);
use
overload
(
'""'
=>
'Stringify'
);
#
Configure
variables
my
$
TB
=
"@prefix@"
;
...
...
@@ -96,20 +97,22 @@ sub Stringify($)
}
#
#
Create
a
sliver
.
Not
much
to
it
yet
.
#
Create
a
sliver
.
#
sub
Create
($$)
sub
Create
($$
;$
)
{
my
($
class
,
$
ticket
)
=
@
_
;
my
($
class
,
$
ticket
,
$
uuid
)
=
@
_
;
my
@
insert_data
=
();
#
Every
sliver
gets
a
new
unique
index
.
my
$
idx
=
TBGetUniqueIndex
(
'next_sliver'
,
1
);
#
And
a
new
uuid
.
my
$
uuid
=
NewUUID
();
if
(
!defined($uuid)) {
print
"*** WARNING: Could not generate a UUID!
\n
"
;
return
undef
;
#
And
a
new
uuid
for
a
local
sliver
.
$
uuid
=
NewUUID
();
if
(
!defined($uuid)) {
print
"*** WARNING: Could not generate a UUID!
\n
"
;
return
undef
;
}
}
my
$
slice_uuid
=
$
ticket
->
slice_uuid
();
my
$
owner_uuid
=
$
ticket
->
owner_uuid
();
...
...
@@ -127,7 +130,12 @@ sub Create($$)
DBQueryWarn
(
"insert into geni_slivers set "
.
join
(
","
,
@
insert_data
))
or
return
undef
;
return
GeniSlice
->
Lookup
($
idx
);
my
$
sliver
=
GeniSliver
->
Lookup
($
idx
);
return
undef
if
(
!defined($sliver));
$
sliver
->{
'TICKET'
}
=
$
ticket
;
return
$
sliver
;
}
#
accessors
sub
field
($$)
{
return
((
! ref($_[0])) ? -1 : $_[0]->{'SLIVER'}->{$_[1]}); }
...
...
@@ -170,11 +178,67 @@ sub GetExperiment($)
return
Experiment
->
Lookup
($
self
->
slice_uuid
());
}
#
#
Get
the
ticket
for
the
sliver
.
#
sub
GetTicket
($)
{
my
($
self
)
=
@
_
;
return
undef
if
(
! ref($self));
if
(
!exists($self->{'TICKET'})) {
print
STDERR
"No ticket object associated with $self
\n
"
;
return
undef
;
}
return
$
self
->{
'TICKET'
};
}
#
#
Provision
a
slice
.
We
actually
did
this
when
the
ticket
was
requested
.
#
sub
Provision
($)
{
my
($
self
)
=
@
_
;
return
-
1
if
(
! ref($self));
#
#
the
node
is
already
allocated
to
the
sliver
,
but
still
need
to
enter
#
a
virt_nodes
entry
,
and
possibly
more
virt
table
entries
,
so
that
the
#
node
will
boot
properly
,
and
is
otherwie
controllable
.
#
my
$
experiment
=
Experiment
->
Lookup
($
self
->
slice_uuid
());
if
(
!defined($experiment)) {
print
STDERR
"Could not map $self to its experiment
\n
"
;
return
-
1
;
}
my
$
node_id
=
$
self
->
node_id
();
return
0
if
(
!defined($node_id));
my
$
node
=
Node
->
Lookup
($
node_id
);
if
(
!defined($node)) {
print
STDERR
"Could not map node $node_id to its object
\n
"
;
return
-
1
;
}
my
$
reservation
=
$
node
->
Reservation
();
if
(
!defined($reservation)) {
print
STDERR
"$node was already released from $self
\n
"
;
return
-
1
;
}
if
($
reservation
->
SameExperiment
($
experiment
))
{
if
($
experiment
->
InsertVirtNode
($
node
)
!= 0) {
print
STDERR
"Could not add virtnode entry for $node to $self
\n
"
;