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
38f9b5fb
Commit
38f9b5fb
authored
May 27, 2008
by
Leigh B. Stoller
Browse files
Checkpoint
parent
8c6bae5a
Changes
13
Hide whitespace changes
Inline
Side-by-side
protogeni/lib/GNUmakefile.in
View file @
38f9b5fb
...
...
@@ -14,7 +14,8 @@ 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
GeniComponent.pm GeniCH.pm GeniCHClient.pm \
GeniAuthority.pm GeniCertificate.pm
#
# Force dependencies on the scripts so that they will be rerun through
...
...
protogeni/lib/GeniAuthority.pm.in
0 → 100644
View file @
38f9b5fb
#
!/usr/bin/perl -wT
#
#
EMULAB
-
COPYRIGHT
#
Copyright
(
c
)
2008
University
of
Utah
and
the
Flux
Group
.
#
All
rights
reserved
.
#
package
GeniAuthority
;
#
#
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
libtestbed
;
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
%
authorities
=
();
#
#
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_sliceauthorities "
.
"where uuid='$token'"
);
return
undef
if
(
! $query_result || !$query_result->numrows);
($
idx
)
=
$
query_result
->
fetchrow_array
();
}
else
{
return
undef
;
}
#
Look
in
cache
first
return
$
authorities
{
"$idx"
}
if
(
exists
($
authorities
{
"$idx"
}));
$
query_result
=
DBQueryWarn
(
"select * from geni_sliceauthorities where idx='$idx'"
);
return
undef
if
(
!$query_result || !$query_result->numrows);
my
$
self
=
{};
$
self
->{
'AUTHORITY'
}
=
$
query_result
->
fetchrow_hashref
();
bless
($
self
,
$
class
);
#
#
Grab
the
certificate
,
since
we
will
probably
want
it
.
#
my
$
uuid
=
$
self
->{
'AUTHORITY'
}->{
'uuid'
};
$
query_result
=
DBQueryWarn
(
"select cert from geni_certificates "
.
"where uuid='$uuid'"
);
if
(
!$query_result || !$query_result->numrows) {
print
STDERR
"Could not find certificate for authority $idx
\n
"
;
return
undef
;
}
my
($
cert
)
=
$
query_result
->
fetchrow_array
();
$
self
->{
'AUTHORITY'
}->{
'cert'
}
=
$
cert
;
#
Add
to
cache
.
$
authorities
{$
self
->{
'AUTHORITY'
}->{
'idx'
}}
=
$
self
;
return
$
self
;
}
#
#
Stringify
for
output
.
#
sub
Stringify
($)
{
my
($
self
)
=
@
_
;
my
$
uuid
=
$
self
->
uuid
();
my
$
idx
=
$
self
->
idx
();
return
"[GeniAuthority: $uuid, IDX: $idx]"
;
}
#
#
Create
a
Geni
authority
in
the
DB
.
#
sub
Create
($$$$$)
{
my
($
class
,
$
uuid
,
$
hrn
,
$
url
,
$
cert
)
=
@
_
;
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
);
#
Now
tack
on
other
stuff
we
need
.
push
(@
insert_data
,
"created=now()"
);
push
(@
insert_data
,
"idx='$idx'"
);
push
(@
insert_data
,
"hrn=$safe_hrn"
);
push
(@
insert_data
,
"url=$safe_url"
);
push
(@
insert_data
,
"uuid=$safe_uuid"
);
#
Insert
into
DB
.
DBQueryWarn
(
"replace into geni_sliceauthorities 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_sliceauthorities where idx='$idx'"
);
return
undef
;
}
return
GeniAuthority
->
Lookup
($
idx
);
}
#
accessors
sub
field
($$)
{
return
((
! ref($_[0])) ? -1 : $_[0]->{'AUTHORITY'}->{$_[1]}); }
sub
idx
($)
{
return
field
($
_
[
0
],
"idx"
);
}
sub
uuid
($)
{
return
field
($
_
[
0
],
"uuid"
);
}
sub
uuid_prefix
($)
{
return
field
($
_
[
0
],
"uuid_prefix"
);
}
sub
url
($)
{
return
field
($
_
[
0
],
"url"
);
}
sub
hrn
($)
{
return
field
($
_
[
0
],
"hrn"
);
}
sub
cert
($)
{
return
field
($
_
[
0
],
"cert"
);
}
#
_Always_
make
sure
that
this
1
is
at
the
end
of
the
file
...
1
;
protogeni/lib/GeniCH.pm.in
View file @
38f9b5fb
...
...
@@ -25,6 +25,7 @@ use User;
use
GeniUser
;
use
GeniSlice
;
use
GeniComponent
;
use
GeniAuthority
;
use
libtestbed
;
use
emutil
;
use
English
;
...
...
@@ -59,15 +60,28 @@ sub LookupUser($)
"No such user $uuid"
);
}
#
Return
a
blob
.
my
$
blob
=
{
"uid"
=>
$
user
->
uid
(),
"hrn"
=>
$
user
->
hrn
(),
"uuid"
=>
$
user
->
uuid
(),
"email"
=>
$
user
->
email
(),
"name"
=>
$
user
->
name
()
};
my
$
authority
=
GeniAuthority
->
Lookup
($
user
->
sa_idx
());
if
(
!defined($authority)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No slice authority found for user"
);
}
#
Return
a
blob
.
my
$
blob
=
{
"uid"
=>
$
user
->
uid
(),
"hrn"
=>
$
user
->
hrn
(),
"uuid"
=>
$
user
->
uuid
(),
"email"
=>
$
user
->
email
(),
"cert"
=>
$
user
->
cert
(),
"name"
=>
$
user
->
name
(),
"sa"
=>
{
"hrn"
=>
$
authority
->
hrn
(),
"uuid"
=>
$
authority
->
uuid
(),
"cert"
=>
$
authority
->
cert
(),
"url"
=>
$
authority
->
url
()
}
};
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
}
sub
LookupSlice
($)
{
my
($
argref
)
=
@
_
;
...
...
@@ -82,11 +96,22 @@ sub LookupSlice($)
"No such user $uuid"
);
}
my
$
authority
=
GeniAuthority
->
Lookup
($
slice
->
sa_idx
());
if
(
!defined($authority)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No slice authority found for slice"
);
}
#
Return
a
blob
.
my
$
blob
=
{
"hrn"
=>
$
slice
->
hrn
(),
"uuid"
=>
$
slice
->
uuid
(),
"creator_uuid"
=>
$
slice
->
creator_uuid
(),
"cert"
=>
$
slice
->
cert
()
};
"cert"
=>
$
slice
->
cert
(),
"sa"
=>
{
"hrn"
=>
$
authority
->
hrn
(),
"uuid"
=>
$
authority
->
uuid
(),
"cert"
=>
$
authority
->
cert
(),
"url"
=>
$
authority
->
url
()
}
};
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
}
...
...
@@ -98,15 +123,13 @@ sub RegisterUser($)
{
my
($
argref
)
=
@
_
;
my
$
hrn
=
$
argref
->{
'hrn'
};
my
$
uid
=
$
argref
->{
'uid'
};
my
$
uuid
=
$
argref
->{
'uuid'
};
my
$
name
=
$
argref
->{
'name'
};
my
$
email
=
$
argref
->{
'email'
};
my
$
cert
=
$
argref
->{
'cert'
};
if
(
! (defined($hrn) && defined($uid) && defined($name) &&
defined
($
email
)
&&
defined
($
cert
)
&&
defined
($
uuid
)))
{
if
(
! (defined($hrn) && defined($name) &&
defined
($
email
)
&&
defined
($
cert
)
&&
defined
($
uuid
)))
{
return
GeniResponse
->
MalformedArgsResponse
();
}
...
...
@@ -125,10 +148,6 @@ sub RegisterUser($)
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"name: "
.
TBFieldErrorString
());
}
if
(
! TBcheck_dbslot($uid, "users", "uid", TBDB_CHECKDBSLOT_ERROR)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"uid: "
.
TBFieldErrorString
());
}
if
(
! TBcheck_dbslot($email, "users", "usr_email",TBDB_CHECKDBSLOT_ERROR)){
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"email: "
.
TBFieldErrorString
());
...
...
@@ -179,6 +198,16 @@ sub RegisterUser($)
"$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
,
$
sa_idx
);
if
(
!defined($newuser)) {
...
...
protogeni/lib/GeniCM.pm.in
View file @
38f9b5fb
...
...
@@ -116,15 +116,16 @@ sub DiscoverResources($)
sub
GetTicket
($)
{
my
($
argref
)
=
@
_
;
my
$
slice_
uuid
=
$
argref
->{
'slice
_uuid
'
};
my
$
slice_
cert
=
$
argref
->{
'slice'
};
my
$
rspec
=
$
argref
->{
'rspec'
};
my
$
impotent
=
$
argref
->{
'impotent'
};
my
$
credential
=
$
argref
->{
'credential'
};
my
$
owner_uuid
=
$
ENV
{
'GENIUSER'
};
my
$
slice_uuid
;
if
(
!
(
defined($slice_
uuid) && ($slice_uuid =~ /^[-\w]+$/)
)) {
if
(
! defined($slice_
cert
)) {
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
"Improper slice
uuid
"
);
"Improper slice"
);
}
if
(
! (defined($rspec) && ($rspec =~ /^[-\w]+$/))) {
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
...
...
@@ -141,6 +142,11 @@ sub GetTicket($)
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not create GeniCredential object"
);
}
GeniCredential
->
CertificateInfo
($
slice_cert
,
\$
slice_uuid
)
==
0
or
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not get uuid from Certificate"
);
#
The
credential
owner
/
slice
has
to
match
what
was
provided
.
if
(
! ($owner_uuid eq $credential->owner_uuid() &&
$
slice_uuid
eq
$
credential
->
this_uuid
()))
{
...
...
@@ -155,13 +161,27 @@ sub GetTicket($)
#
my
$
slice
=
GeniSlice
->
Lookup
($
slice_uuid
);
if
(
!defined($slice)) {
$
slice
=
GeniSlice
->
CreateFromRegistry
($
slice_uuid
);
if
(
!defined($slice)) {
print
STDERR
"No slice $slice_uuid in the ClearingHouse
\n
"
;
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not get slice info from ClearingHouse"
);
}
}
#
#
XXX
Should
we
create
a
local
geni_slices
record
in
the
DB
?
#
Ditto
the
user
.
#
my
$
user
=
GeniUser
->
Lookup
($
owner_uuid
);
if
(
!defined($user)) {
$
user
=
GeniUser
->
CreateFromRegistry
($
owner_uuid
);
if
(
!defined($user)) {
print
STDERR
"No user $owner_uuid in the ClearingHouse
\n
"
;
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not get user info from ClearingHouse"
);
}
}
#
#
If
the
underlying
experiment
does
not
exist
,
need
to
create
#
a
holding
experiment
.
All
these
are
going
to
go
into
the
same
...
...
@@ -208,7 +228,7 @@ sub GetTicket($)
#
#
Create
the
ticket
first
,
before
allocating
the
node
.
#
my
$
ticket
=
GeniTicket
->
Create
($
slice
_uuid
,
$
owner_uuid
,
$
rspec
);
my
$
ticket
=
GeniTicket
->
Create
($
slice
,
$
user
,
$
rspec
);
if
(
!defined($ticket)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not create GeniTicket object"
);
...
...
protogeni/lib/GeniCMClient.pm.in
View file @
38f9b5fb
...
...
@@ -41,47 +41,6 @@ my $OURDOMAIN = "@OURDOMAIN@";
my
$
GENICENTRAL
=
"myboss.little-emulab-bsd61.testbed.emulab.net"
;
my
$
GENICENTRALURL
=
"https://$GENICENTRAL/protogeni/xmlrpc"
;
#
#
Ask
for
a
ticket
.
We
provide
an
rspec
.
Neither
of
these
are
defined
yet
#
so
lets
be
simpleminded
;
send
a
count
of
nodes
we
want
and
get
back
a
#
count
of
nodes
that
can
be
allocated
.
I
realize
there
is
a
problem
of
#
those
nodes
getting
allocated
before
the
tickets
are
redeemed
,
but
not
#
going
to
worry
about
that
either
.
#
#
$
component
is
just
a
url
for
now
.
#
sub
GetTicket
($$$$)
{
my
($
experiment
,
$
component
,
$
rspec
,
$
pref
)
=
@
_
;
#
#
XXX
#
my
$
this_user
=
User
->
LookupByUnixId
($
UID
);
if
(
! defined($this_user)) {
print
STDERR
"You ($UID) do not exist!
\n
"
;
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
->
Sign
())
{
print
STDERR
"Could not sign slice credential!
\n
"
;
return
-
1
;
}
my
$
ticket
=
$
component
->
GetTicket
($
this_user
,
$
credential
,
$
experiment
->
uuid
(),
$
rspec
);
$$
pref
=
$
ticket
;
return
0
;
}
sub
CreateSliver
($$$)
{
my
($
experiment
,
$
ticket
,
$
pref
)
=
@
_
;
...
...
protogeni/lib/GeniCertificate.pm.in
0 → 100644
View file @
38f9b5fb
#
!/usr/bin/perl -wT
#
#
EMULAB
-
COPYRIGHT
#
Copyright
(
c
)
2008
University
of
Utah
and
the
Flux
Group
.
#
All
rights
reserved
.
#
package
GeniCertificate
;
#
#
Some
simple
certificate
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
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
$
SIGNCRED
=
"$TB/sbin/signgenicred"
;
my
$
VERIFYCRED
=
"$TB/sbin/verifygenicred"
;
my
$
NFREE
=
"$TB/bin/nfree"
;
my
$
OPENSSL
=
"/usr/bin/openssl"
;
#
_Always_
make
sure
that
this
1
is
at
the
end
of
the
file
...
1
;
protogeni/lib/GeniComponent.pm.in
View file @
38f9b5fb
...
...
@@ -250,11 +250,11 @@ sub DiscoverResources($$$$$)
#
sub
GetTicket
($$$$$)
{
my
($
self
,
$
user
,
$
credential
,
$
slice_uuid
,
$
rspec
)
=
@
_
;
my
($
self
,
$
slice
,
$
rspec
,
$
user
,
$
credential
)
=
@
_
;
my
$
rspec_xml
=
$
rspec
;
#
Must
be
a
real
reference
.
return
-
1
return
undef
if
(
! ref($self));
#
The
rspec
is
passed
as
XML
.
If
we
get
a
ref
,
convert
it
.
...
...
@@ -266,9 +266,9 @@ sub GetTicket($$$$$)
Genixmlrpc
::
CallMethodHTTP
($
self
->
url
(),
$
user
,
"CM::GetTicket"
,
{
"slice
_uuid"
=>
$
slice
_uuid
,
{
"slice
"
=>
$
slice
->
cert
()
,
"credential"
=>
$
credential
->
asString
(),
"impotent"
=>
0
,
"impotent"
=>
1
,
"rspec"
=>
$
rspec_xml
});
return
undef
...
...
@@ -280,8 +280,7 @@ sub GetTicket($$$$$)
#
#
Convert
this
into
a
(
signed
)
ticket
object
.
#
return
GeniTicket
->
Create
($
slice_uuid
,
$
user
->
uuid
(),
$
rspec
,
$
response
->
value
(),
$
self
);
return
GeniTicket
->
CreateFromSignedTicket
($
response
->
value
(),
$
self
,
1
);
}
#
...
...
@@ -289,10 +288,10 @@ sub GetTicket($$$$$)
#
sub
CreateSliver
($$$$)
{
my
($
self
,
$
user
,
$
ticket
,
$
pref
)
=
@
_
;
my
($
self
,
$
slice
,
$
ticket
,
$
user
)
=
@
_
;
#
Must
be
a
real
reference
.
return
-
1
return
undef
if
(
! ref($self));
my
$
response
=
...
...
@@ -300,10 +299,10 @@ sub CreateSliver($$$$)
"CM::CreateSliver"
,
{
"ticket"
=>
$
ticket
->
asString
()
});
return
-
1
return
undef
if
(
!defined($response));
return
-
1
return
undef
if
($
response
->
code
()
!= GENIRESPONSE_SUCCESS);
#
...
...
@@ -312,16 +311,15 @@ sub CreateSliver($$$$)
my
$
credential
=
GeniCredential
->
CreateFromSigned
($
response
->
value
());
if
(
!defined($credential)) {
print
STDERR
"Could not create local credential object.
\n
"
;
return
-
1
;
return
undef
;
}
my
$
sliver
=
GeniSliver
->
Create
($
ticket
,
$
credential
);
if
(
!defined($sliver)) {
print
STDERR
"Could not create local sliver object.
\n
"
;
return
-
1
;
return
undef
;
}
$$
pref
=
$
sliver
;
return
0
;
return
$
sliver
;
}
#
...
...
protogeni/lib/GeniCredential.pm.in
View file @
38f9b5fb
...
...
@@ -298,6 +298,38 @@ sub Store($)
return
0
;
}
#
#
Create
a
certificate
pair
,
which
gives
us
a
uuid
to
use
for
an
object
.
#
We
need
a
file
to
store
the
cert
/
key
in
.
#
sub
CreateCertificate
($$$$)
{
my
($
class
,
$
what
,
$
certfile
,
$
pref
)
=
@
_
;
system
(
"$MKCERT -o $certfile $what $uuid"
);
if
($?)
{
print
STDERR
"Could not start $MKCERT
\n
"
;
return
-
1
;
}
my
$
cert
;
open
(
CERT
,
$
certfile
)
or
return
-
1
;
while
(<
CERT
>)
{
if
($
_
=~
/^-----
BEGIN
CERT
/)
{
$
cert
=
""
;
next
;
}
last
if
($
_
=~
/^-----
END
CERT
/);
next
if
(
!defined($cert));
$
cert
.=
$
_
;
}
close
(
CERT
);
$$
pref
=
$
cert
;
return
0
;
}
#
#
Convert
a
certificate
to
its
uuid
.
#
...
...
@@ -306,7 +338,7 @@ sub CertificateInfo($$$)
my
($
class
,
$
string
,
$
pref
)
=
@
_
;
#
Deleted
when
scope
is
left
.
my
$
tempfile
=
new
File
::
Temp
(
UNLINK
=>
0
);
my
$
tempfile
=
new
File
::
Temp
(
UNLINK
=>
1
);
my
$
filename
=
$
tempfile
->
filename
;
print
$
tempfile
"-----BEGIN CERTIFICATE-----
\n
"
;
print
$
tempfile
"$string"
;
...
...
protogeni/lib/GeniSlice.pm.in
View file @
38f9b5fb
...
...
@@ -17,6 +17,8 @@ use vars qw(@ISA @EXPORT);
use
lib
'@prefix@/lib'
;
use
GeniDB
;
use
GeniCHClient
;
use
GeniAuthority
;
use
GeniCredential
;
use
libtestbed
;
#
Hate
to
import
all
this
crap
;
need
a
utility
library
.
use
libdb
qw
(
TBGetUniqueIndex
);
...
...
@@ -207,26 +209,11 @@ sub CreateFromLocal($$)
#
the
DB
so
we
have
ready
access
to
it
.
#
my
$
certfile
=
$
experiment
->
WorkDir
()
.
"/genicert.pem"
;
system
(
"$MKCERT -o $certfile slice $uuid"
);
if
($?)
{
print
STDERR
"Could not start $MKCERT
\n
"
;
return
undef
;
}
my
$
cert
;
open
(
CERT
,
$
certfile
)
or
if
(
GeniCredential
->
CreateCertificate
(
"slice"
,
$
certfile
,
\$
cert
)
!= 0) {
print
STDERR
"Could not create certificate for slice.
\n
"
;
return
undef
;
while
(<
CERT
>)
{
if
($
_
=~
/^-----
BEGIN
CERT
/)
{
$
cert
=
""
;
next
;
}
last
if
($
_
=~
/^-----
END
CERT
/);
next
if
(
!defined($cert));
$
cert
.=
$
_
;
}
close
(
CERT
);
return
GeniSlice
->
Create
($
hrn
,
$
uuid
,
$
creator_uuid