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
ed5f6b52
Commit
ed5f6b52
authored
Nov 03, 2008
by
Leigh B. Stoller
Browse files
Checkpoint
parent
4e1c22fd
Changes
18
Hide whitespace changes
Inline
Side-by-side
protogeni/etc/GNUmakefile.in
View file @
ed5f6b52
...
...
@@ -22,6 +22,8 @@ all: $(ETCFILES)
include $(TESTBED_SRCDIR)/GNUmakerules
install: $(addprefix $(INSTALL_ETCDIR)/protogeni/, $(ETCFILES))
$(INSTALL_DATA) $(SRCDIR)/protogeni.sql \
$(INSTALL_ETCDIR)/protogeni/protogeni.sql
control-install:
...
...
protogeni/etc/geniuser.xml.in
View file @
ed5f6b52
<user>
<attribute name="name"> <value>Geni User</value></attribute>
<attribute name="email"> <value>
@TBOPSEMAIL_NOSLASH@
</attribute>
<attribute name="email"> <value>
root@@OURDOMAIN@</value>
</attribute>
<attribute name="address"> <value>DO NOT DELETE THIS USER</value></attribute>
<attribute name="address2"> <value>DO NOT DELETE THIS USER</value></attribute>
<attribute name="city"> <value>Any Town</value></attribute>
...
...
@@ -10,7 +10,8 @@
<attribute name="phone"> <value>555-555-5555</value></attribute>
<attribute name="shell"> <value>tcsh</value></attribute>
<attribute name="title"> <value>Geni User</value></attribute>
<attribute name="affiliation"> <value>Any U</value></attribute>
<attribute name="affiliation"> <value>Any University</value></attribute>
<attribute name="affiliation_abbreviation"> <value>AnyU</value></attribute>
<attribute name="password"> <value>*</value></attribute>
<attribute name="wikiname"> <value>GeniUser</value></attribute>
<attribute name="login"> <value>geniuser</value></attribute>
...
...
protogeni/etc/httpd.conf
0 → 100644
View file @
ed5f6b52
<
IfDefine
PGENI
>
# A bundle of trusted protogeni sites.
SSLCACertificatePath
@prefix@/etc/genica.bundle
# Default this to none so that regular web server requests pass.
SSLVerifyClient
none
ScriptAlias
/protogeni/xmlrpc/ch @prefix@/protogeni/xmlrpc/protogeni-ch.pl
ScriptAlias
/protogeni/xmlrpc/cm @prefix@/protogeni/xmlrpc/protogeni-cm.pl
ScriptAlias
/protogeni/xmlrpc/sa @prefix@/protogeni/xmlrpc/protogeni-sa.pl
<
Directory
"@prefix@/www/protogeni"
>
SSLRequireSSL
Order
deny,allow
allow
from
all
SSLVerifyClient
require
SSLVerifyDepth
5
</
Directory
>
<
Directory
"@prefix@/protogeni/"
>
SSLRequireSSL
Order
deny,allow
allow
from
all
SSLOptions
+StdEnvVars
Options
+ExecCGI +FollowSymLinks
SetHandler
cgi-script
SetEnv
USER
"nobody"
SSLVerifyClient
require
SSLVerifyDepth
5
</
Directory
>
</
IfDefine
>
protogeni/etc/protogeni.sql
View file @
ed5f6b52
...
...
@@ -49,14 +49,13 @@ CREATE TABLE `geni_users` (
#
DROP
TABLE
IF
EXISTS
`geni_components`
;
CREATE
TABLE
`geni_components`
(
`idx`
mediumint
(
8
)
unsigned
NOT
NULL
default
'0'
,
`hrn`
varchar
(
256
)
NOT
NULL
default
''
,
`uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`manager_uuid`
varchar
(
40
)
default
NULL
,
`created`
datetime
default
NULL
,
`url`
tinytext
,
PRIMARY
KEY
(
`idx`
),
UNIQUE
KEY
`hrn`
(
`hrn`
),
UNIQUE
KEY
`uuid`
(
`uuid`
)
PRIMARY
KEY
(
`uuid`
),
UNIQUE
KEY
`hrn`
(
`hrn`
)
)
ENGINE
=
MyISAM
DEFAULT
CHARSET
=
latin1
;
#
...
...
@@ -74,15 +73,13 @@ CREATE TABLE `geni_components` (
DROP
TABLE
IF
EXISTS
`geni_authorities`
;
CREATE
TABLE
`geni_authorities`
(
`hrn`
varchar
(
256
)
NOT
NULL
default
''
,
`idx`
mediumint
(
8
)
unsigned
NOT
NULL
default
'0'
,
`uuid`
varchar
(
40
)
NOT
NULL
default
''
,
`uuid_prefix`
varchar
(
12
)
NOT
NULL
default
''
,
`created`
datetime
default
NULL
,
`type`
enum
(
'sa'
,
'
cm'
,
'
ma'
,
'ch'
)
NOT
NULL
default
'sa'
,
`type`
enum
(
'sa'
,
'ma'
,
'ch'
,
'cm'
)
NOT
NULL
default
'sa'
,
`url`
tinytext
,
PRIMARY
KEY
(
`idx`
),
UNIQUE
KEY
`uuid`
(
`uuid`
),
UNIQUE
KEY
`uuid_prefix`
(
`uuid_prefix`
)
PRIMARY
KEY
(
`uuid`
),
UNIQUE
KEY
`hrn`
(
`hrn`
)
)
ENGINE
=
MyISAM
DEFAULT
CHARSET
=
latin1
;
#
...
...
protogeni/lib/GNUmakefile.in
View file @
ed5f6b52
...
...
@@ -20,7 +20,7 @@ LIB_SCRIPTS = GeniDB.pm GeniUser.pm GeniSAClient.pm \
SBIN_SCRIPTS = plabnodewrapper plabslicewrapper
SCRIPTS = test.pl addnode.pl test.pl addauthority
OPS_LIBS = GeniCMClient.pm GeniSAClient.pm
#
OPS_LIBS = GeniCMClient.pm GeniSAClient.pm
# These scripts installed setuid, with sudo.
SETUID_SBIN_SCRIPTS = plabnodewrapper plabslicewrapper
...
...
protogeni/lib/GeniAuthority.pm.in
View file @
ed5f6b52
...
...
@@ -40,50 +40,38 @@ my $VERIFYCRED = "$TB/sbin/verifygenicred";
my
%
authorities
=
();
#
#
Lookup
by
idx
,
or
uuid
.
#
Lookup
by
uuid
.
#
sub
Lookup
($$)
{
my
($
class
,
$
token
)
=
@
_
;
my
$
query_result
;
my
$
id
x
;
my
$
uu
id
;
if
($
token
=~
/^\
d
+$/)
{
$
idx
=
$
token
;
}
elsif
($
token
=~
/^\
w
+\-\
w
+\-\
w
+\-\
w
+\-\
w
+$/)
{
$
query_result
=
DBQueryWarn
(
"select idx from geni_authorities "
.
"where uuid='$token'"
);
return
undef
if
(
! $query_result || !$query_result->numrows);
($
idx
)
=
$
query_result
->
fetchrow_array
();
}
elsif
($
token
=~
/^\
d
+$/)
{
$
idx
=
$
token
;
if
($
token
=~
/^\
w
+\-\
w
+\-\
w
+\-\
w
+\-\
w
+$/)
{
$
uuid
=
$
token
;
}
elsif
($
token
=~
/^
P
([\
w
]+)$/)
{
return
GeniAuthority
->
LookupByPrefix
($
1
);
}
elsif
($
token
=~
/^[\
w
\.]*$/)
{
$
query_result
=
DBQueryWarn
(
"select id
x
from geni_authorities "
.
DBQueryWarn
(
"select
uu
id from geni_authorities "
.
"where hrn='$token'"
);
return
undef
if
(
! $query_result || !$query_result->numrows);
return
undef
if
(
! $query_result || !$query_result->numrows);
($
id
x
)
=
$
query_result
->
fetchrow_array
();
($
uu
id
)
=
$
query_result
->
fetchrow_array
();
}
else
{
return
undef
;
}
#
Look
in
cache
first
return
$
authorities
{
"$id
x
"
}
if
(
exists
($
authorities
{
"$id
x
"
}));
return
$
authorities
{
"$
uu
id"
}
if
(
exists
($
authorities
{
"$
uu
id"
}));
$
query_result
=
DBQueryWarn
(
"select * from geni_authorities where id
x
='$id
x
'"
);
DBQueryWarn
(
"select * from geni_authorities where
uu
id='$
uu
id'"
);
return
undef
if
(
!$query_result || !$query_result->numrows);
...
...
@@ -95,16 +83,15 @@ sub Lookup($$)
#
#
Grab
the
certificate
,
since
we
will
probably
want
it
.
#
my
$
uuid
=
$
self
->{
'AUTHORITY'
}->{
'uuid'
};
my
$
certificate
=
GeniCertificate
->
Lookup
($
uuid
);
if
(
!defined($certificate)) {
print
STDERR
"Could not find certificate for authority $id
x
\n
"
;
print
STDERR
"Could not find certificate for authority $
uu
id
\n
"
;
return
undef
;
}
$
self
->{
'CERT'
}
=
$
certificate
;
#
Add
to
cache
.
$
authorities
{$
self
->{
'AUTHORITY'
}->{
'id
x
'
}}
=
$
self
;
$
authorities
{$
self
->{
'AUTHORITY'
}->{
'
uu
id'
}}
=
$
self
;
return
$
self
;
}
...
...
@@ -117,9 +104,8 @@ sub Stringify($)
my
($
self
)
=
@
_
;
my
$
uuid
=
$
self
->
uuid
();
my
$
idx
=
$
self
->
idx
();
return
"[GeniAuthority: $uuid
, IDX: $idx
]"
;
return
"[GeniAuthority: $uuid]"
;
}
#
...
...
@@ -130,18 +116,16 @@ sub Create($$$$)
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
($
certificate
->
hrn
());
my
$
safe_url
=
DBQuoteSpecial
($
url
);
my
$
safe_uuid
=
DBQuoteSpecial
($
certificate
->
uuid
());
my
$
safe_prefix
=
DBQuoteSpecial
($
prefix
);
my
$
safe_type
=
DBQuoteSpecial
($
type
);
my
$
safe_type
=
DBQuoteSpecial
(
lc
(
$
type
)
)
;
#
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"
);
...
...
@@ -158,11 +142,10 @@ sub Create($$$$)
if
(
!DBQueryWarn("replace into geni_authorities set " .
join
(
","
,
@
insert_data
)));
return
GeniAuthority
->
Lookup
($
idx
);
return
GeniAuthority
->
Lookup
($
certificate
->
uuid
()
);
}
#
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"
);
}
...
...
@@ -178,7 +161,8 @@ sub CheckExisting($$$$)
{
my
($
class
,
$
type
,
$
uuid
,
$
hrn
)
=
@
_
;
my
($
prefix
)
=
($
certificate
->
uuid
()
=~
/^\
w
+\-\
w
+\-\
w
+\-\
w
+\-(\
w
+)$/);
my
($
prefix
)
=
($
uuid
=~
/^\
w
+\-\
w
+\-\
w
+\-\
w
+\-(\
w
+)$/);
$
type
=
lc
($
type
);
my
$
query_result
=
DBQueryWarn
(
"select uuid,type from geni_authorities "
.
...
...
@@ -273,15 +257,15 @@ sub LookupByPrefix($$)
}
my
$
query_result
=
DBQueryWarn
(
"select id
x
from geni_authorities "
.
DBQueryWarn
(
"select
uu
id from geni_authorities "
.
"where uuid_prefix='$prefix'"
);
return
undef
if
(
! $query_result || !$query_result->numrows);
my
($
id
x
)
=
$
query_result
->
fetchrow_array
();
($
uu
id
)
=
$
query_result
->
fetchrow_array
();
return
GeniAuthority
->
Lookup
($
id
x
);
return
GeniAuthority
->
Lookup
($
uu
id
);
}
#
_Always_
make
sure
that
this
1
is
at
the
end
of
the
file
...
...
...
protogeni/lib/GeniCH.pm.in
View file @
ed5f6b52
...
...
@@ -51,6 +51,7 @@ sub GetCredential($)
my
$
uuid
=
$
argref
->{
'uuid'
};
my
$
cred
=
$
argref
->{
'credential'
};
my
$
type
=
$
argref
->{
'type'
};
my
$
gid
=
$
argref
->{
'gid'
};
#
#
The
caller
has
to
be
known
to
us
,
but
how
are
they
known
to
us
?
...
...
@@ -58,8 +59,58 @@ sub GetCredential($)
#
my
$
caller_uuid
=
$
ENV
{
'GENIUUID'
};
my
$
caller_authority
=
GeniAuthority
->
Lookup
($
ENV
{
'GENIUUID'
});
return
GeniResponse
->
Create
(
GENIRESPONSE_REFUSED
,
undef
,
"Who are You?"
)
if
(
!defined($caller_authority));
if
(
!defined($caller_authority)) {
if
(
!defined($gid)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_REFUSED
,
undef
,
"Who are You?"
);
}
#
#
Must
be
a
new
site
.
We
could
not
have
gotten
this
far
without
#
their
CA
certificate
being
know
to
us
,
so
lets
just
register
them
#
and
tell
tbops
about
it
.
#
if
(
! ($gid =~ /^[\012\015\040-\176]*$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"cert: Invalid characters"
);
}
my
$
certificate
=
GeniCertificate
->
LoadFromString
($
gid
);
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not parse certificate"
)
if
(
!defined($certificate));
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"
);
}
my
$
url
=
$
certificate
->
URL
();
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not find URL in the certificate"
)
if
(
!defined($url));
#
#
Check
for
an
existing
authority
.
#
if
(
GeniAuthority
->
CheckExisting
(
"sa"
,
$
certificate
->
uuid
(),
$
certificate
->
hrn
())
!= 0) {
print
STDERR
"Attempt to register existing slice authority
\n
"
;
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
"Slice Authority already exists"
);
}
SENDMAIL
($
TBOPS
,
"New ProtoGeni Authority"
,
$
certificate
->
asText
());
$
caller_authority
=
GeniAuthority
->
Create
($
certificate
,
$
url
,
"sa"
);
if
(
!defined($caller_authority)) {
print
STDERR
"Could not create new geni authority
\n
"
;
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not create new GeniAuthority"
);
}
}
#
#
No
credential
,
then
return
a
generic
credential
giving
caller
permission
...
...
@@ -167,21 +218,15 @@ sub Resolve($)
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
}
if
($
type
eq
"Component"
)
{
my
$
component
=
GeniComponent
->
Lookup
ByResource
($
uuid
);
my
$
component
=
GeniComponent
->
Lookup
($
uuid
);
if
(
!defined($component)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No such resource $uuid"
);
}
my
$
certificate
=
GeniCertificate
->
Lookup
($
uuid
);
if
(
!defined($certificate)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No certificate for $uuid"
);
"No such component resource $uuid"
);
}
#
Return
a
blob
.
my
$
blob
=
{
"gid"
=>
$
certificate
->
cert
(),
"cm"
=>
$
component
->
cert
(),
my
$
blob
=
{
"gid"
=>
$
component
->
cert
(),
"url"
=>
$
component
->
url
(),
};
...
...
@@ -201,14 +246,14 @@ sub Resolve($)
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
}
if
($
type
eq
"CM"
)
{
my
$
component
=
GeniComponent
->
Lookup
($
uuid
);
if
(
!defined($
component
)) {
my
$
manager
=
GeniAuthority
->
Lookup
($
uuid
);
if
(
!defined($
manager
)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_SEARCHFAILED
,
undef
,
"No such
component
$uuid"
);
"No such
manager
$uuid"
);
}
#
Return
a
blob
.
my
$
blob
=
{
"gid"
=>
$
component
->
cert
(),
"url"
=>
$
component
->
url
(),
my
$
blob
=
{
"gid"
=>
$
manager
->
cert
(),
"url"
=>
$
manager
->
url
(),
};
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
$
blob
);
}
...
...
@@ -500,45 +545,37 @@ sub Register($)
"Slice has been registered"
);
}
if
($
type
eq
"Component"
)
{
my
$
resource_type
=
$
info
->{
'resource_type'
};
my
$
resource_uuid
=
$
info
->{
'resource_uuid'
};
my
$
component
=
GeniComponent
->
Lookup
($
ENV
{
'GENIUUID'
});
if
(
!defined($component)) {
print
STDERR
"Could not find component object for caller.
\n
"
;
my
$
manager
=
GeniAuthority
->
Lookup
($
ENV
{
'GENIUUID'
});
if
(
!defined($manager)) {
print
STDERR
"Could not find manager object for caller.
\n
"
;
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
);
}
if
(
! ($resource_uuid =~ /^[-\w]+$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"resource_uuid: Invalid characters"
);
}
if
(
! ($resource_type =~ /^[-\w]+$/)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"resource_type: Invalid characters"
);
}
if
($
certificate
->
Store
()
!= 0) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not store certificate"
);
}
if
($
component
->
NewResource
($
resource_uuid
)
!= 0) {
my
$
component
=
GeniComponent
->
CreateFromCertificate
($
certificate
,
$
manager
);
if
(
!defined($component)) {
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not register new resource"
);
}
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
);
}
if
($
type
eq
"CM"
||
$
type
eq
"SA"
)
{
my
$
url
=
$
info
->{
'url'
};
#
#
Check
for
an
existing
authority
.
#
if
(
GeniAuthority
->
CheckExisting
($
certificate
->
uuid
(),
$
type
,
if
(
GeniAuthority
->
CheckExisting
(
$
type
,
$
certificate
->
uuid
(),
$
certificate
->
hrn
())
!= 0) {
print
STDERR
"Attempt to register existing authority
\n
"
;
return
GeniResponse
->
Create
(
GENIRESPONSE_BADARGS
,
undef
,
"Authority already exists"
);
}
my
$
url
=
$
certificate
->
URL
();
return
GeniResponse
->
Create
(
GENIRESPONSE_ERROR
,
undef
,
"Could not find URL in the certificate"
)
if
(
!defined($url));
SENDMAIL
($
TBOPS
,
"ProtoGeni Authority Registration"
,
$
certificate
->
asText
());
my
$
authority
=
GeniAuthority
->
Create
($
certificate
,
$
url
,
$
type
);
if
(
!defined($authority)) {
print
STDERR
"Could not register new authority
\n
"
;
...
...
@@ -653,21 +690,22 @@ sub ListComponents($)
}
#
#
Return
simple
list
of
components
(
hashes
).
#
Return
simple
list
of
components
managers
(
aggregate
managers
?)
#
my
@
results
=
();
my
$
query_result
=
DBQueryWarn
(
"select uuid from geni_components"
);
my
$
query_result
=
DBQueryWarn
(
"select uuid from geni_authorities "
.
"where type='cm'"
);
return
GeniResponse
->
Create
(
GENIRESPONSE_DBERROR
)
if
(
!defined($query_result));
while
(
my
($
component
_uuid
)
=
$
query_result
->
fetchrow_array
())
{
my
$
component
=
GeniComponent
->
Lookup
($
component
_uuid
);
while
(
my
($
manager
_uuid
)
=
$
query_result
->
fetchrow_array
())
{
my
$
manager
=
GeniAuthority
->
Lookup
($
manager
_uuid
);
return
GeniResponse
->
Create
(
GENIRESPONSE_DBERROR
)
if
(
!defined($
component
));
if
(
!defined($
manager
));
push
(@
results
,
{
"gid"
=>
$
component
->
cert
(),
"hrn"
=>
$
component
->
hrn
(),
"url"
=>
$
component
->
url
()
});
push
(@
results
,
{
"gid"
=>
$
manager
->
cert
(),
"hrn"
=>
$
manager
->
hrn
(),
"url"
=>
$
manager
->
url
()
});
}
return
GeniResponse
->
Create
(
GENIRESPONSE_SUCCESS
,
\@
results
);
}
...
...
protogeni/lib/GeniCertificate.pm.in
View file @
ed5f6b52
...
...
@@ -129,14 +129,15 @@ sub email($)
#
#
Create
a
certificate
pair
,
which
gives
us
a
uuid
to
use
for
an
object
.
#
sub
Create
($$$$;$)
sub
Create
($$$$;$
$
)
{
my
($
class
,
$
what
,
$
hrn
,
$
email
,
$
uuid
)
=
@
_
;
my
($
class
,
$
what
,
$
hrn
,
$
email
,
$
uuid
,
$
url
)
=
@
_
;
#
Let
mkcert
generate
a
new
one
.
$
uuid
=
""
if
(
!defined($uuid));
$
url
=
(
defined
($
url
)
?
"-u $url"
:
""
);
if
(
! open(CERT, "$MKCERT -e \"$email\" $hrn $uuid |")) {
if
(
! open(CERT, "$MKCERT
$url
-e \"$email\" $hrn $uuid |")) {
print
STDERR
"Could not start $MKCERT
\n
"
;
return
undef
;
}
...
...
@@ -320,16 +321,19 @@ sub Store($)
#
#
Write
a
certificate
and
private
key
to
a
tempfile
,
as
for
signing
with
it
.
#
sub
WriteToFile
($)
sub
WriteToFile
($
;$
)
{
my
($
self
)
=
@
_
;
my
($
self
,
$
withkey
)
=
@
_
;
$
withkey
=
0
if
(
!defined($withkey));
#
We
want
this
file
to
be
passed
back
.
my
($
tempfile
,
$
filename
)
=
tempfile
(
UNLINK
=>
1
);
print
$
tempfile
"-----BEGIN CERTIFICATE-----
\n
"
;
print
$
tempfile
$
self
->
cert
();
print
$
tempfile
"-----END CERTIFICATE-----
\n
"
;
if
($
self
->
privkey
())
{
if
(
$
withkey
&&
$
self
->
privkey
())
{
print
$
tempfile
"-----BEGIN RSA PRIVATE KEY-----
\n
"
;
print
$
tempfile
$
self
->
privkey
();
print
$
tempfile
"-----END RSA PRIVATE KEY-----
\n
"
;
...
...
@@ -337,6 +341,54 @@ sub WriteToFile($)
return
$
filename
;
}
#
#
The
URL
is
buried
in
an
extension
so
we
have
to
parse
the
text
output
.
#
sub
URL
($)
{
my
($
self
)
=
@
_
;
my
$
url
;
my
$
filename
=
$
self
->
WriteToFile
();
if
(
! open(X509, "$OPENSSL x509 -in $filename -text -noout |")) {
print
STDERR
"Could not start $OPENSSL on $filename
\n
"
;
return
undef
;
}
while
(<
X509
>)
{
if
($
_
=~
/^\
s
+
URI
:([-\
w
\.\/:]+)$/)
{
$
url
=
$
1
;
chomp
($
url
);
}
}
if
(
!close(X509) || !defined($url)) {
print
STDERR
"Could not find url in certificate from $filename
\n
"
;
return
undef
;
}
unlink
($
filename
);
return
$
url
;
}
sub
asText
($)
{
my
($
self
)
=
@
_
;
my
$
text
=
""
;
my
$
filename
=
$
self
->
WriteToFile
();
if
(
! open(X509, "$OPENSSL x509 -in $filename -text |")) {
print
STDERR
"Could not start $OPENSSL on $filename
\n
"
;
return
undef
;
}
while
(<
X509
>)
{
$
text
.=
$
_
;
}
if
(
!close(X509) || $text eq "") {
print
STDERR
"Could not dump text of certificate from $filename
\n
"
;
return
undef
;
}
unlink
($
filename
);
return
$
text
;
}
############################################################################
#
#
Wrapper
for
local
users
.
...
...
protogeni/lib/GeniComponent.pm.in
View file @
ed5f6b52
...
...
@@ -24,6 +24,7 @@ use GeniResponse;
use
GeniRegistry
;
use
GeniTicket
;
use
GeniCredential
;
use
GeniAuthority
;
use
libdb
qw
(
TBGetUniqueIndex
);
use
English
;
use
overload
(
'""'
=>
'Stringify'
);
...
...
@@ -46,35 +47,26 @@ my $impotent = 0;
my
%
components
=
();
#
#
Lookup
by
idx
,
or
uuid
.
#
Lookup
by
uuid
.
#
sub
Lookup
($$)
{
my
($
class
,
$
token
)
=
@
_
;
my
$
query_result
;
my
$
id
x
;
my
$
uu
id
;
if
($
token
=~
/^\
d
+$/)
{
$
idx
=
$
token
;
}
elsif
($
token
=~
/^\
w
+\-\
w
+\-\
w
+\-\
w
+\-\
w
+$/)
{
$
query_result
=
DBQueryWarn
(
"select idx from geni_components "
.
"where uuid='$token'"
);
return
undef
if
(
! $query_result || !$query_result->numrows);
($
idx
)
=
$
query_result
->
fetchrow_array
();
if
($
token
=~
/^\
w
+\-\
w
+\-\
w
+\-\
w
+\-\
w
+$/)
{
$
uuid
=
$
token
;
}
else
{
return
undef
;
}
#
Look
in
cache
first
return
$
components
{
"$id
x
"
}
if
(
exists
($
components
{
"$id
x
"
}));
return
$
components
{
"$
uu
id"
}
if
(
exists
($
components
{
"$
uu
id"
}));
$
query_result
=
DBQueryWarn
(
"select * from geni_components where id
x
='$id
x
'"
);
DBQueryWarn
(
"select * from geni_components where
uu
id='$
uu
id'"
);
return
undef
if
(
!$query_result || !$query_result->numrows);
...
...
@@ -86,16 +78,28 @@ sub Lookup($$)