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-stable
Commits
ceb61751
Commit
ceb61751
authored
Oct 16, 2008
by
Leigh B. Stoller
Browse files
Checkpoint in case I need to install this into the main tree
parent
c3f0111e
Changes
30
Hide whitespace changes
Inline
Side-by-side
protogeni/GNUmakefile.in
View file @
ceb61751
...
...
@@ -11,7 +11,7 @@ SUBDIR = protogeni
include $(OBJDIR)/Makeconf
SUBDIRS = security xmlrpc lib
SUBDIRS = security xmlrpc lib
scripts
all: all-subdirs
...
...
@@ -21,6 +21,7 @@ install:
@$(MAKE) -C security install
@$(MAKE) -C xmlrpc install
@$(MAKE) -C lib install
@$(MAKE) -C scripts install
control-install:
...
...
protogeni/etc/protogeni.sql
View file @
ceb61751
...
...
@@ -81,7 +81,8 @@ CREATE TABLE `geni_authorities` (
`type`
enum
(
'sa'
,
'ma'
,
'ch'
)
NOT
NULL
default
'sa'
,
`url`
tinytext
,
PRIMARY
KEY
(
`idx`
),
UNIQUE
KEY
`uuid`
(
`uuid`
)
UNIQUE
KEY
`uuid`
(
`uuid`
),
UNIQUE
KEY
`uuid_prefix`
(
`uuid_prefix`
)
)
ENGINE
=
MyISAM
DEFAULT
CHARSET
=
latin1
;
#
...
...
@@ -119,7 +120,7 @@ CREATE TABLE `geni_slivers` (
`idx`
mediumint
(
8
)
unsigned
NOT
NULL
default
'0'
,
`uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`hrn`
varchar
(
256
)
NOT
NULL
default
''
,
`name`
varchar
(
256
)
NOT
NULL
default
''
,
`
nick
name`
varchar
(
256
)
default
NULL
,
`slice_uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`creator_uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`resource_uuid`
varchar
(
40
)
NOT
NULL
default
''
,
...
...
@@ -142,14 +143,13 @@ DROP TABLE IF EXISTS `geni_aggregates`;
CREATE
TABLE
`geni_aggregates`
(
`idx`
mediumint
(
8
)
unsigned
NOT
NULL
default
'0'
,
`hrn`
varchar
(
256
)
NOT
NULL
default
''
,
`name`
varchar
(
256
)
NOT
NULL
default
''
,
`
nick
name`
varchar
(
256
)
default
NULL
,
`uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`type`
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
,
`component_idx`
int
(
10
)
unsigned
NOT
NULL
default
'0'
,
`aggregate_idx`
int
(
10
)
unsigned
default
NULL
,
`status`
enum
(
'created'
,
'ready'
,
'broken'
)
NOT
NULL
default
'created'
,
...
...
@@ -176,7 +176,7 @@ CREATE TABLE `geni_tickets` (
PRIMARY
KEY
(
`idx`
),
INDEX
`owner_uuid`
(
`owner_uuid`
),
INDEX
`slice_uuid`
(
`slice_uuid`
),
UNIQUE
KEY
`compseqno`
(
`component_id
x
`
,
`seqno`
)
UNIQUE
KEY
`compseqno`
(
`component_
uu
id`
,
`seqno`
)
)
ENGINE
=
MyISAM
DEFAULT
CHARSET
=
latin1
;
#
...
...
@@ -206,6 +206,7 @@ CREATE TABLE `geni_certificates` (
`uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`created`
datetime
default
NULL
,
`cert`
text
,
`DN`
text
,
`privkey`
text
,
`revoked`
datetime
default
NULL
,
PRIMARY
KEY
(
`uuid`
)
...
...
protogeni/lib/GeniAggregate.pm.in
View file @
ceb61751
...
...
@@ -125,16 +125,16 @@ sub Stringify($)
#
for
now
.
The
client
side
does
not
actually
know
its
an
aggregate
,
at
#
least
not
yet
.
#
sub
Create
($$$$$)
sub
Create
($$$$$
$
)
{
my
($
class
,
$
slice
,
$
owner
,
$
aggregate_type
,
$
hrn
)
=
@
_
;
my
($
class
,
$
slice
,
$
owner
,
$
aggregate_type
,
$
hrn
,
$
nickname
)
=
@
_
;
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"
);
my
$
certificate
=
GeniCertificate
->
Create
(
"aggregate"
,
$
hrn
,
$
TBOPS
);
if
(
!defined($certificate)) {
print
STDERR
"Could not generate new certificate and UUID!
\n
"
;
return
undef
;
...
...
@@ -147,6 +147,7 @@ sub Create($$$$$)
push
(@
insert_data
,
"created=now()"
);
push
(@
insert_data
,
"idx='$idx'"
);
push
(@
insert_data
,
"hrn="
.
DBQuoteSpecial
($
hrn
));
push
(@
insert_data
,
"nickname="
.
DBQuoteSpecial
($
nickname
));
push
(@
insert_data
,
"uuid='$uuid'"
);
push
(@
insert_data
,
"creator_uuid='$owner_uuid'"
);
push
(@
insert_data
,
"slice_uuid='$slice_uuid'"
);
...
...
@@ -165,6 +166,7 @@ sub Create($$$$$)
sub
field
($$)
{
return
((
! ref($_[0])) ? -1 : $_[0]->{'AGGREGATE'}->{$_[1]}); }
sub
idx
($)
{
return
field
($
_
[
0
],
"idx"
);
}
sub
uuid
($)
{
return
field
($
_
[
0
],
"uuid"
);
}
sub
nickname
($)
{
return
field
($
_
[
0
],
"nickname"
);
}
sub
type
($)
{
return
field
($
_
[
0
],
"type"
);
}
sub
slice_uuid
($)
{
return
field
($
_
[
0
],
"slice_uuid"
);
}
sub
creator_uuid
($)
{
return
field
($
_
[
0
],
"creator_uuid"
);
}
...
...
@@ -232,7 +234,7 @@ sub hrn($)
if
(
defined
($
hrn
)
&&
$
hrn
ne
""
)
{
return
$
hrn
;
}
return
$
OURDOMAIN
.
"
.aggregate
s.
"
.
$
self
->
idx
();
return
"emulab
.aggregate
_
"
.
$
self
->
idx
();
}
#
...
...
@@ -441,6 +443,9 @@ sub NewCredential($$)
print
STDERR
"Could not create credential for $self, $owner
\n
"
;
return
undef
;
}
if
(
defined
($
self
->
nickname
()))
{
$
credential
->
AddExtension
(
"nickname"
,
$
self
->
nickname
());
}
if
($
credential
->
Sign
($
self
->
GetCertificate
())
!= 0) {
print
STDERR
"Could not sign credential for $self, $owner
\n
"
;
return
undef
;
...
...
@@ -557,9 +562,14 @@ use Interface;
sub
Create
($$$)
{
my
($
class
,
$
slice
,
$
owner
,
$
hrn
)
=
@
_
;
my
($
class
,
$
slice
,
$
owner
,
$
linkname
)
=
@
_
;
#
#
Form
an
hrn
using
the
slicename
and
linkname
#
my
$
hrn
=
"emulab."
.
$
slice
->
slicename
()
.
"."
.
$
linkname
;
return
GeniAggregate
->
Create
($
slice
,
$
owner
,
"Link"
,
$
hrn
);
return
GeniAggregate
->
Create
($
slice
,
$
owner
,
"Link"
,
$
hrn
,
$
linkname
);
}
#
...
...
protogeni/lib/GeniAuthority.pm.in
View file @
ceb61751
...
...
@@ -59,6 +59,12 @@ sub Lookup($$)
($
idx
)
=
$
query_result
->
fetchrow_array
();
}
elsif
($
token
=~
/^\
d
+$/)
{
$
idx
=
$
token
;
}
elsif
($
token
=~
/^
P
([\
w
]+)$/)
{
return
GeniAuthority
->
LookupByPrefix
($
1
);
}
elsif
($
token
=~
/^[\
w
\.]*$/)
{
$
query_result
=
DBQueryWarn
(
"select idx from geni_authorities "
.
...
...
@@ -120,15 +126,15 @@ sub Stringify($)
#
sub
Create
($$$$$$)
{
my
($
class
,
$
uuid
,
$
hrn
,
$
url
,
$
cert
,
$
prefix
,
$
type
)
=
@
_
;
my
($
class
,
$
certificate
,
$
url
,
$
type
)
=
@
_
;
my
@
insert_data
=
();
my
$
idx
=
TBGetUniqueIndex
(
'next_authority'
,
1
);
my
($
prefix
)
=
($
certificate
->
uuid
()
=~
/^\
w
+\-\
w
+\-\
w
+\-\
w
+\-(\
w
+)$/);
my
$
safe_hrn
=
DBQuoteSpecial
($
hrn
);
my
$
safe_hrn
=
DBQuoteSpecial
($
certificate
->
hrn
()
);
my
$
safe_url
=
DBQuoteSpecial
($
url
);
my
$
safe_uuid
=
DBQuoteSpecial
($
uuid
);
my
$
safe_cert
=
DBQuoteSpecial
($
cert
);
my
$
safe_uuid
=
DBQuoteSpecial
($
certificate
->
uuid
());
my
$
safe_prefix
=
DBQuoteSpecial
($
prefix
);
my
$
safe_type
=
DBQuoteSpecial
($
type
);
...
...
@@ -141,18 +147,16 @@ sub Create($$$$$$)
push
(@
insert_data
,
"uuid_prefix=$safe_prefix"
);
push
(@
insert_data
,
"type=$safe_type"
);
#
Insert
into
DB
.
DBQueryWarn
(
"replace into geni_authorities set "
.
join
(
","
,
@
insert_data
))
or
return
undef
;
#
Insert
the
certificate
.
if
(
!DBQueryWarn("replace into geni_certificates set ".
" uuid=$safe_uuid, cert=$safe_cert"
))
{
DBQueryWarn
(
"delete from geni_authorities where idx='$idx'"
);
if
($
certificate
->
Store
()
!= 0) {
print
STDERR
"Could not store certificate for new user.
\n
"
;
return
undef
;
}
#
Insert
into
DB
.
return
undef
if
(
!DBQueryWarn("replace into geni_authorities set " .
join
(
","
,
@
insert_data
)));
return
GeniAuthority
->
Lookup
($
idx
);
}
#
accessors
...
...
@@ -166,6 +170,30 @@ sub type($) { return field($_[0], "type"); }
sub
cert
($)
{
return
$
_
[
0
]->{
'CERT'
}->
cert
();
}
sub
GetCertificate
($)
{
return
$
_
[
0
]->{
'CERT'
};
}
#
#
Create
authority
from
the
ClearingHouse
,
by
looking
up
the
info
.
#
sub
CreateFromRegistry
($$$)
{
my
($
class
,
$
type
,
$
uuid
)
=
@
_
;
my
$
blob
;
return
undef
if
(
GeniCHClient
::
Resolve
($
uuid
,
$
type
,
\$
blob
)
!= 0);
my
$
certificate
=
GeniCertificate
->
LoadFromString
($
blob
->{
'gid'
});
return
undef
if
(
!defined($certificate));
my
$
authority
=
GeniAuthority
->
Create
($
certificate
,
$
blob
->{
'url'
},
$
blob
->{
'type'
});
$
certificate
->
Delete
()
if
(
!defined($authority));
return
$
authority
;
}
#
#
Does
the
uuid
prefix
match
.
#
...
...
@@ -178,8 +206,6 @@ sub PrefixMatch($$)
my
$
uuid_prefix
=
$
self
->
uuid_prefix
();
print
"$uuid, $uuid_prefix, $self
\n
"
;
if
($
uuid
=~
/^\
w
+\-\
w
+\-\
w
+\-\
w
+\-(\
w
+)$/)
{
return
1
if
(
"$uuid_prefix"
eq
"$1"
);
...
...
@@ -187,6 +213,38 @@ sub PrefixMatch($$)
return
0
;
}
#
#
Find
an
authority
by
looking
for
the
prefix
.
This
will
eventually
go
#
away
when
we
switch
top
chains
.
#
sub
LookupByPrefix
($$)
{
my
($
class
,
$
uuid
)
=
@
_
;
my
$
prefix
;
if
($
uuid
=~
/^\
w
+\-\
w
+\-\
w
+\-\
w
+\-(\
w
+)$/)
{
$
prefix
=
$
1
;
}
elsif
($
uuid
=~
/^(\
w
+)$/)
{
$
prefix
=
$
1
;
}
else
{
print
STDERR
"Could no parse uuid for prefix
\n
"
;
return
undef
;
}
my
$
query_result
=
DBQueryWarn
(
"select idx from geni_authorities "
.
"where uuid_prefix='$prefix'"
);
return
undef
if
(
! $query_result || !$query_result->numrows);
my
($
idx
)
=
$
query_result
->
fetchrow_array
();
return
GeniAuthority
->
Lookup
($
idx
);
}
#
_Always_
make
sure
that
this
1
is
at
the
end
of
the
file
...
1
;
protogeni/lib/GeniCH.pm.in
View file @
ceb61751
...
...
@@ -108,7 +108,7 @@ sub Resolve($)
if
(
! (defined($uuid) && ($uuid =~ /^[-\w]*$/))) {
return
GeniResponse
->
MalformedArgsResponse
();
}
if
(
! (defined($type) && ($type =~ /^(SA|CM|MA|Component|Slice|User)$/)))
{
if
(
! (defined($type) && ($type =~ /^(SA|CM|MA|Component|Slice|User)$/
i
))){
return
GeniResponse
->
MalformedArgsResponse
();
}
if
(
! defined($cred)) {
...
...
@@ -147,10 +147,10 @@ sub Resolve($)
"No such user $uuid"
);
}
#
Grab
keys
.
my
@
sliverkeys
;
if
($
user
->
GetKeys
(\@
sliverkeys
)
!= 0) {
print
STDERR
"Could not get sliver keys for $user
\n
"
;
}
#
my
@
sliverkeys
;
#
if
($
user
->
GetKeys
(\@
sliverkeys
)
!= 0) {
#
print
STDERR
"Could not get sliver keys for $user
\n
"
;
#
}
#
Return
a
blob
.
my
$
blob
=
{
"uid"
=>
$
user
->
uid
(),
...
...
@@ -161,23 +161,21 @@ sub Resolve($)
"name"
=>
$
user
->
name
(),
"sa_uuid"
=>
$
user
->
sa_uuid
(),
};
$
blob
->{
'sliverkeys'
}
=
\@
sliverkeys
if
(@
sliverkeys
);
#
$
blob
->{
'sliverkeys'
}
=
\@
sliverkeys
#
if
(@
sliverkeys
);
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
}
if
($
type
eq
"SA"
)
{
if
($
type
eq
"SA"
||
$
type
eq
"sa"
)
{
my
$
authority
=
GeniAuthority
->
Lookup
($
uuid
);
if
(
!defined($authority)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No such authority $uuid"
);
}
#
Return
a
blob
.
my
$
blob
=
{
"uuid"
=>
$
authority
->
uuid
(),
"cert"
=>
$
authority
->
cert
(),
"hrn"
=>
$
authority
->
hrn
(),
"uuid_prefix"
=>
$
authority
->
uuid_prefix
(),
my
$
blob
=
{
"gid"
=>
$
authority
->
cert
(),
"url"
=>
$
authority
->
url
(),
"type"
=>
$
authority
->
type
(),
};
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
}
...
...
@@ -188,9 +186,7 @@ sub Resolve($)
"No such component $uuid"
);
}
#
Return
a
blob
.
my
$
blob
=
{
"uuid"
=>
$
component
->
uuid
(),
"cert"
=>
$
component
->
cert
(),
"hrn"
=>
$
component
->
hrn
(),
my
$
blob
=
{
"gid"
=>
$
component
->
cert
(),
"url"
=>
$
component
->
url
(),
};
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
...
...
@@ -203,11 +199,11 @@ sub Resolve($)
}
#
User
bindings
too
.
my
@
userbindings
=
();
if
($
slice
->
UserBindings
(\@
userbindings
)
!= 0) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Error getting users for slice"
);
}
#
my
@
userbindings
=
();
#
if
($
slice
->
UserBindings
(\@
userbindings
)
!= 0) {
#
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
#
"Error getting users for slice"
);
#
}
#
Return
a
blob
.
my
$
blob
=
{
"hrn"
=>
$
slice
->
hrn
(),
...
...
@@ -215,7 +211,7 @@ sub Resolve($)
"creator_uuid"
=>
$
slice
->
creator_uuid
(),
"cert"
=>
$
slice
->
cert
(),
"sa_uuid"
=>
$
slice
->
sa_uuid
(),
"userbindings"
=>
\@
userbindings
,
#
"userbindings"
=>
\@
userbindings
,
};
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
}
...
...
@@ -229,14 +225,10 @@ sub Register($)
{
my
($
argref
)
=
@
_
;
my
$
cred
=
$
argref
->{
'credential'
};
my
$
hrn
=
$
argref
->{
'hrn'
};
my
$
cert
=
$
argref
->{
'cert'
};
my
$
info
=
$
argref
->{
'info'
};
my
$
type
=
$
argref
->{
'type'
};
if
(
! (defined($hrn) && ($hrn =~ /^[-\w.]*$/))) {
return
GeniResponse
->
MalformedArgsResponse
();
}
if
(
! (defined($type) && ($type =~ /^(SA|MA|Component|Slice|User)$/))) {
return
GeniResponse
->
MalformedArgsResponse
();
}
...
...
@@ -280,22 +272,26 @@ sub Register($)
}
#
#
Grab
the
uuid
out
of
the
certificate
.
#
Grab
the
uuid
and
hrn
out
of
the
certificate
.
#
my
$
uuid
;
GeniCertificate
->
CertificateInfo
($
cert
,
\$
uuid
)
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"cert: Could not get uuid"
);
my
$
certificate
=
GeniCertificate
->
LoadFromString
($
cert
)
;
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not parse certificate"
)
if
(
!defined($certificate)
);
if
(
! ($uuid =~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
if
(
! ($
certificate->
uuid
()
=~ /^\w+\-\w+\-\w+\-\w+\-\w+$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
"Improper format for uuid"
);
}
if
(
! ($certificate->hrn() =~ /^[\w\.]+$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
"Improper format for hrn"
);
}
if
($
type
eq
"User"
)
{
my
$
name
=
$
info
->{
'name'
};
my
$
email
=
$
info
->{
'email'
};
my
$
keys
=
$
info
->{
'sliverkeys'
}
;
my
$
keys
=
undef
;
if
(
! TBcheck_dbslot($name, "users", "usr_name",
TBDB_CHECKDBSLOT_ERROR
))
{
...
...
@@ -307,7 +303,7 @@ sub Register($)
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"email: "
.
TBFieldErrorString
());
}
if
(
defined
($
keys
))
{
if
(
0
&&
defined
($
keys
))
{
foreach
my
$
keyref
(@{
$
keys
})
{
my
$
type
=
$
keyref
->{
'type'
};
my
$
key
=
$
keyref
->{
'key'
};
...
...
@@ -330,11 +326,30 @@ sub Register($)
print
STDERR
"Could not find authority object for caller.
\n
"
;
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
);
}
if
(
! $slice_authority->PrefixMatch($uuid)) {
if
(
! $slice_authority->PrefixMatch($
certificate->
uuid
()
)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
"uuid: Prefix mismatch"
);
}
my
$
existing
=
GeniUser
->
Lookup
($
certificate
->
uuid
());
if
(
defined
($
existing
))
{
if
(
! ($existing->hrn() eq $certificate->hrn())) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Not allowed to change hrn"
);
}
if
(
! ($existing->sa_uuid() eq $slice_authority->uuid())) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Already registered with another SA"
);
}
#
#
Update
operation
,
but
only
name
,
email
,
and
keys
for
now
.
#
if
($
existing
->
Modify
($
name
,
$
email
,
$
keys
)
!= 0) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not update user"
);
}
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
);
}
#
#
XXX
#
...
...
@@ -343,31 +358,18 @@ sub Register($)
#
require
that
for
a
given
SA
,
that
hrn
is
unique
,
at
least
to
avoid
#
lots
of
confusion
?
#
if
(
GeniUser
->
CheckExisting
($
hrn
,
$
email
))
{
if
(
GeniUser
->
CheckExisting
($
certificate
->
hrn
()
,
$
email
))
{
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"
$
hrn/
$
email already registered"
);
"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
,
$
slice_authority
,
$
keys
);
my
$
newuser
=
GeniUser
->
Create
($
certificate
,
$
slice_authority
,
$
info
,
$
keys
);
if
(
!defined($newuser)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"
$hrn/$email c
ould not be registered"
);
"
C
ould not be registered"
);
}
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
undef
,
"
$hrn/$email
has been registered"
);
"
User
has been registered"
);
}
if
($
type
eq
"Slice"
)
{
my
$
creator_uuid
=
$
info
->{
'creator_uuid'
};
...
...
@@ -389,7 +391,7 @@ sub Register($)
#
#
Ditto
any
users
bound
to
the
slice
.
#
if
(
defined
($
userbindings
))
{
if
(
0
&&
defined
($
userbindings
))
{
foreach
my
$
binding_uuid
(@{
$
userbindings
})
{
my
$
binding_user
=
GeniUser
->
Lookup
($
binding_uuid
);
if
(
!defined($binding_user)) {
...
...
@@ -407,30 +409,56 @@ sub Register($)
print
STDERR
"Could not find authority object for caller.
\n
"
;
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
);
}
if
(
! $slice_authority->PrefixMatch($uuid)) {
if
(
! $slice_authority->PrefixMatch($
certificate->
uuid
()
)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
"uuid: Prefix mismatch"
);
}
#
#
Reregistration
of
existing
slice
is
okay
.
#
my
$
existing
=
GeniSlice
->
Lookup
($
certificate
->
uuid
());
if
(
defined
($
existing
))
{
if
(
! ($existing->cert() eq $certificate->cert())) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Not allowed to change cert"
);
}
if
(
! ($existing->sa_uuid() eq $slice_authority->uuid())) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Already registered with another SA"
);
}
if
(
0
&&
defined
($
userbindings
))
{
$
existing
->
UnBindUsers
();
foreach
my
$
binding_uuid
(@{
$
userbindings
})
{
my
$
binding_user
=
GeniUser
->
Lookup
($
binding_uuid
);
$
existing
->
BindUser
($
binding_user
);
}
}
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
);
}
#
#
Make
sure
slice
hrn
and
uuid
are
unique
.
#
if
(
GeniSlice
->
CheckExisting
($
hrn
,
$
uuid
))
{
if
(
GeniSlice
->
CheckExisting
($
certificate
->
hrn
(),
$
certificate
->
uuid
()))
{
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"
$hrn or $uuid
already registered"
);
"
Slice
already registered"
);
}
my
$
newslice
=
GeniSlice
->
Create
($
hrn
,
$
uuid
,
$
creator_uuid
,
$
cert
,
$
slice_authority
);
my
$
newslice
=
GeniSlice
->
Create
($
certificate
,
$
creator_uuid
,
$
slice_authority
);
if
(
!defined($newslice)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"
$hrn/$uuid c
ould not be registered"
);
"
C
ould not be registered"
);
}
#
#
Add
the
bindings
now
.
#
if
(
defined
($
userbindings
))
{
if
(
0
&&
defined
($
userbindings
))
{
foreach
my
$
binding_uuid
(@{
$
userbindings
})
{
my
$
binding_user
=
GeniUser
->
Lookup
($
binding_uuid
);
$
newslice
->
BindUser
($
binding_user
);
...
...
@@ -438,7 +466,7 @@ sub Register($)
}
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
undef
,
"
$hrn/$uuid
has been registered"
);
"
Slice
has been registered"
);
}
return
GeniResponse
->
Create
(
GENIRESPONSE_UNSUPPORTED
);
}
...
...
@@ -547,7 +575,7 @@ sub DiscoverResources($)
return
GeniResponse
->
Create
(
GENIRESPONSE_DBERROR
)
if
(
!defined($component));
push
(@
results
,
{
"
uu
id"
=>
$
component
_uuid
});
push
(@
results
,
{
"
g
id"
=>
$
component
->
cert
()
});
}
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
\@
results
);
}
...
...
protogeni/lib/GeniCHClient.pm.in
View file @
ceb61751
...
...
@@ -132,9 +132,9 @@ sub LookupSlice($$)
#
#
Register
a
record
at
the
clearing
house
.
#
sub
Register
($$$
$
)
sub
Register
($$$)
{
my
(
$
hrn
,
$
type
,
$
cert
,
$
info
)
=
@
_
;
my
($
type
,
$
cert
,
$
info
)
=
@
_
;
SetCredential
();
...
...
@@ -142,7 +142,6 @@ sub Register($$$$)
Genixmlrpc
::
CallMethod
($
GENICENTRALURL
,
$
MyContext
,
"Register"
,
{
"credential"
=>
$
Credential
,
"type"
=>
$
type
,
"hrn"
=>
$
hrn
,
"cert"
=>
$
cert
,
"info"
=>
$
info
});
return
-
1
...
...
@@ -155,29 +154,29 @@ sub Register($$$$)
#
Register
a
local
Emulab
user
at
the
Geni
ClearingHouse
(
which
in
the
#
prototype
is
Utah
Emulab
).
#
sub
RegisterUser
($$$$
$
)
sub
RegisterUser
($$$$)
{
my
(
$
hrn
,
$
name
,
$
email
,
$
cert
,
$
keys
)
=
@
_
;
my
($
name
,
$
email
,
$
cert
,
$
keys
)
=
@
_
;
my
$
info
=
{
"name"
=>
$
name
,
"email"
=>
$
email
};
$
info
->{
"sliverkeys"
}
=
$
keys
if
(
defined
($
keys
));