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-stable
Commits
30baa268
Commit
30baa268
authored
Sep 22, 2009
by
Leigh B. Stoller
Browse files
Checkpoint some geni (cooked mode) stuff.
parent
1e1188b5
Changes
3
Hide whitespace changes
Inline
Side-by-side
db/GNUmakefile.in
View file @
30baa268
...
...
@@ -18,7 +18,7 @@ SBIN_SCRIPTS = avail inuse showgraph if2port backup webcontrol node_status \
idletimes idlemail setsitevar audit changeuid changepid \
elabinelab_bossinit update_permissions mysqld_watchdog \
dumperrorlog changeleader checkstats changecreator \
dbupdate
dbupdate
geni_control
WEB_SBIN_SCRIPTS= webnodelog webnewwanode webidlemail webchangeuid \
webchangeleader
...
...
@@ -27,7 +27,7 @@ LIBEXEC_SCRIPTS = $(WEB_BIN_SCRIPTS) $(WEB_SBIN_SCRIPTS) xmlconvert
LIB_SCRIPTS = libdb.pm Node.pm libdb.py libadminctrl.pm Experiment.pm \
NodeType.pm Interface.pm User.pm Group.pm Project.pm \
Image.pm OSinfo.pm Archive.pm Logfile.pm Lan.pm emdbi.pm \
emdb.pm emutil.pm Firewall.pm VirtExperiment.pm
emdb.pm emutil.pm Firewall.pm VirtExperiment.pm
libGeni.pm
# Stuff installed on plastic.
USERSBINS = genelists.proxy dumperrorlog.proxy
...
...
db/geni_control.in
0 → 100755
View file @
30baa268
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2009 University of Utah and the Flux Group.
# All rights reserved.
#
use
strict
;
use
English
;
use
Getopt::
Std
;
#
# Exit status is important. Exit with -1 if an error, else the number
# of nodes that could not be allocated. Otherwise zero.
#
sub
usage
()
{
print
("
Usage: geni_control [-d] [-p] <pid> <eid> <action> ...
\n
"
.
"
-p enables partial allocation mode
\n
"
.
"
-d enables debugging output
\n
");
exit
(
-
1
);
}
my
$optlist
=
"
dp
";
my
$debug
=
0
;
my
$partial
=
0
;
my
$exitval
=
0
;
#
# Configure variables
#
my
$TB
=
"
@prefix
@
";
#
# Testbed Support libraries
#
use
lib
'
@prefix@/lib
';
use
libdb
;
use
libtestbed
;
use
Experiment
;
use
Project
;
use
User
;
use
Node
;
use
libGeni
;
use
GeniResource
;
use
GeniHRN
;
sub
fatal
($);
sub
AllocNodes
();
sub
FreeNodes
();
sub
Register
();
sub
UnRegister
();
sub
ClearAll
();
sub
StartAll
();
sub
WaitAll
();
sub
PurgeAll
();
#
# Turn off line buffering on output
#
$|
=
1
;
# For perf analysis.
#TBDebugTimeStampsOn();
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my
%options
=
();
if
(
!
getopts
(
$optlist
,
\
%options
))
{
usage
();
}
if
(
defined
(
$options
{"
d
"}))
{
$debug
=
1
;
}
if
(
defined
(
$options
{"
p
"}))
{
$partial
=
1
;
}
if
(
@ARGV
<
3
)
{
usage
();
}
my
$pid
=
shift
;
my
$eid
=
shift
;
my
$action
=
shift
;
if
(
$action
=~
/^(alloc|free|clear|wait|purge|start|register|unregister)$/
)
{
$action
=
$
1
;
}
else
{
usage
();
}
#
# Locals
#
my
$error
=
0
;
my
$noalloc
=
0
;
my
@oldnodes
=
();
my
@nodes
=
();
#
# Experiment must exist.
#
my
$experiment
=
Experiment
->
Lookup
(
$pid
,
$eid
);
if
(
!
$experiment
)
{
die
("
*** $0:
\n
"
.
"
No such experiment
$pid
/
$eid
in the Emulab Database.
\n
");
}
my
$exptidx
=
$experiment
->
idx
();
my
$project
=
$experiment
->
GetProject
();
if
(
!
defined
(
$project
))
{
die
("
*** $0:
\n
"
.
"
Could not get project for experiment
$experiment
!
\n
");
}
#
# User must have permission to modify the experiment.
#
my
$this_user
=
User
->
ThisUser
();
if
(
!
defined
(
$this_user
))
{
die
("
*** $0:
\n
"
.
"
You (
$UID
) do not exist in the Emulab DB!
\n
");
}
if
(
!
$experiment
->
AccessCheck
(
$this_user
,
TB_EXPT_MODIFY
))
{
die
("
*** $0:
\n
"
.
"
You do not have permission to allocate nodes in
$pid
/
$eid
\n
");
}
my
$foo
=
"
urn:publicid:IDN+emulab.net+authority+cm
";
my
$fee
=
"
urn:publicid:IDN+emulab.net+node+pc172
";
@ARGV
=
(
$fee
);
#
# Now dispatch operation.
#
SWITCH:
for
(
$action
)
{
/^register$/
&&
do
{
Register
();
last
SWITCH
;
};
/^unregister$/
&&
do
{
UnRegister
();
last
SWITCH
;
};
/^alloc$/
&&
do
{
AllocNodes
();
last
SWITCH
;
};
/^free$/
&&
do
{
FreeNodes
();
last
SWITCH
;
};
/^clear$/
&&
do
{
ClearAll
();
last
SWITCH
;
};
/^start$/
&&
do
{
StartAll
();
last
SWITCH
;
};
/^wait$/
&&
do
{
WaitAll
();
last
SWITCH
;
};
/^purge$/
&&
do
{
PurgeAll
();
last
SWITCH
;
};
fatal
("
Unknown action
$action
");
}
exit
(
$exitval
);
#
# Allocate
#
sub
AllocNodes
()
{
my
$node_urn
=
$ARGV
[
0
];
my
(
$auth
,
$type
,
$node_id
)
=
GeniHRN::
Parse
(
$node_urn
);
my
$cm
=
GeniHRN::
Generate
(
$auth
,
"
authority
",
"
cm
");
my
$resource
=
GeniResource
->
Lookup
(
$experiment
->
idx
(),
$cm
);
if
(
!
defined
(
$resource
))
{
$resource
=
GeniResource
->
Create
(
$experiment
,
$cm
);
if
(
!
defined
(
$resource
))
{
fatal
("
Cannot create new geni resource object for
$cm
");
}
}
print
"
$resource
\n
";
my
$rspec
=
"
<rspec xmlns=
\"
http://protogeni.net/resources/rspec/0.1
\"
>
"
.
"
<node virtual_id=
\"
geni1
\"
"
.
"
virtualization_type=
\"
emulab-vnode
\"
"
.
"
>
"
.
"
</node>
"
.
"
</rspec>
";
$resource
->
ModifyResources
(
$this_user
,
$rspec
)
==
0
or
fatal
("
Could not add new resources to
$resource
");
return
0
;
}
#
# Dealloc
#
sub
FreeNodes
()
{
}
sub
ClearAll
()
{
my
@resources
=
GeniResource
->
LookupAll
(
$experiment
);
foreach
my
$resource
(
@resources
)
{
$resource
->
Clear
(
$this_user
)
==
0
or
fatal
("
Could not clear resources from
$resource
");
}
return
0
;
}
sub
PurgeAll
()
{
my
@resources
=
GeniResource
->
LookupAll
(
$experiment
);
foreach
my
$resource
(
@resources
)
{
$resource
->
Purge
(
$this_user
)
==
0
or
fatal
("
Could not purge resources from
$resource
");
}
return
0
;
}
sub
StartAll
()
{
libGeni::
StartSlivers
(
$experiment
,
$this_user
)
==
0
or
fatal
("
Cannot start slivers!
\n
");
}
sub
WaitAll
()
{
libGeni::
WaitForSlivers
(
$experiment
,
$this_user
)
==
0
or
fatal
("
Cannot wait on slivers!
\n
");
}
#
# Register.
#
sub
Register
()
{
libGeni::
Register
(
$experiment
,
$this_user
)
==
0
or
fatal
("
Cannot register with Protgeni!
\n
");
return
0
;
}
#
# Unregister.
#
sub
UnRegister
()
{
libGeni::
UnRegister
(
$experiment
)
==
0
or
fatal
("
Cannot unregister with Protgeni!
");
return
0
;
}
sub
fatal
($)
{
my
(
$msg
)
=
@_
;
print
STDERR
"
*** $0:
\n
$msg
\n
";
exit
(
-
1
);
}
db/libGeni.pm.in
0 → 100644
View file @
30baa268
#
!/usr/bin/perl -wT
#
#
EMULAB
-
COPYRIGHT
#
Copyright
(
c
)
2009
University
of
Utah
and
the
Flux
Group
.
#
All
rights
reserved
.
#
package
libGeni
;
use
strict
;
use
Exporter
;
use
vars
qw
(@
ISA
@
EXPORT
);
@
ISA
=
"Exporter"
;
@
EXPORT
=
qw
();
#
Configure
variables
my
$
TB
=
"@prefix@"
;
my
$
BOSSNODE
=
"@BOSSNODE@"
;
use
libdb
;
use
libtestbed
;
use
emutil
;
use
NodeType
;
use
Interface
;
use
Experiment
;
use
OSinfo
;
use
GeniEmulab
;
use
GeniResource
;
use
English
;
use
Socket
;
use
Data
::
Dumper
;
sub
Register
($$)
{
my
($
experiment
,
$
user
)
=
@
_
;
return
GeniEmulab
::
RegisterExperiment
($
experiment
,
$
user
);
}
sub
UnRegister
($)
{
my
($
experiment
)
=
@
_
;
return
GeniEmulab
::
UnRegisterExperiment
($
experiment
);
}
sub
GetTickets
($$$$)
{
my
($
experiment
,
$
impotent
,
$
user
,
$
rspec
)
=
@
_
;
my
%
cm_urns
=
();
Register
($
experiment
,
$
user
)
==
0
or
return
-
1
;
foreach
my
$
ref
(@{
$
rspec
->{
'node'
}
})
{
my
$
node_urn
=
$
ref
->{
'component_urn'
};
my
($
auth
,$
type
,$
node_id
)
=
GeniHRN
::
Parse
($
node_urn
);
my
$
cm
=
GeniHRN
::
Generate
($
auth
,
"authority"
,
"cm"
);
$
ref
->{
'component_manager_uuid'
}
=
$
cm
;
$
ref
->{
'component_uuid'
}
=
$
node_urn
;
$
cm_urns
{$
cm
}
=
$
cm
;
}
print
STDERR
Dumper
($
rspec
);
#
#
Get
the
resource
objects
.
#
foreach
my
$
cm
(
keys
(%
cm_urns
))
{
my
$
resource
=
GeniResource
->
Lookup
($
experiment
->
idx
(),
$
cm
);
if
(
!defined($resource)) {
$
resource
=
GeniResource
->
Create
($
experiment
,
$
cm
);
if
(
!defined($resource)) {
print
STDERR
"Could not create GeniResource for $cm
\n
"
;
return
-
1
;
}
}
$
cm_urns
{$
cm
}
=
$
resource
;
}
#
#
Ask
for
tickets
.
#
foreach
my
$
cm
(
keys
(%
cm_urns
))
{
my
$
resource
=
$
cm_urns
{$
cm
};
print
STDERR
"Asking for ticket from $resource
\n
"
;
if
($
resource
->
GetTicket
($
user
,
$
rspec
,
$
impotent
))
{
print
STDERR
"Could not GetTicket for $resource
\n
"
;
return
-
1
;
}
}
#
#
If
we
can
get
all
of
the
tickets
,
lets
create
the
physical
nodes
#
we
need
.
#
foreach
my
$
cm
(
keys
(%
cm_urns
))
{
my
$
resource
=
$
cm_urns
{$
cm
};
my
$
ticket
=
$
resource
->
Ticket
();
if
(
!defined($ticket)) {
print
STDERR
"No ticket defined for $resource
\n
"
;
return
-
1
;
}
my
$
rspec
=
$
ticket
->
rspec
();
if
(
!defined($rspec)) {
print
STDERR
"No rspec defined for $ticket on $resource
\n
"
;
return
-
1
;
}
foreach
my
$
ref
(@{
$
rspec
->{
'node'
}
})
{
my
$
node_urn
=
$
ref
->{
'component_urn'
};
my
$
cm_urn
=
$
ref
->{
'component_manager_uuid'
};
print
STDERR
"Creating $node_urn for $resource
\n
"
;
my
$
node
=
GeniEmulab
::
CreatePhysNode
($
node_urn
);
if
(
!defined($node)) {
print
STDERR
" Could not create $node_urn!
\n
"
;
return
-
1
;
}
}
}
return
0
;
}
#
#
Redeem
the
tickets
for
an
experiment
.
#
sub
RedeemTickets
($$$)
{
my
($
experiment
,
$
user
,
$
rspec
)
=
@
_
;
#
#
Get
the
resource
objects
.
#
my
@
resources
=
GeniResource
->
LookupAll
($
experiment
);
if
(
! @resources) {
print
STDERR
"RedeemTickets: No resource objects
\n
"
;
return
0
;
}
foreach
my
$
resource
(@
resources
)
{
print
STDERR
"Redeeming ticket for $resource
\n
"
;
if
($
resource
->
RedeemTicket
($
user
))
{
print
STDERR
"RedeemTicket: Could not redeem ticket for $resource
\n
"
;
return
-
1
;
}
}
return
0
;
}
#
#
Map
the
local
nodes
to
the
external
nodes
.
This
just
sets
some
DB
#
state
for
now
.
#
sub
MapNodes
($)
{
my
($
experiment
)
=
@
_
;
#
#
Get
the
resource
objects
.
#
my
@
resources
=
GeniResource
->
LookupAll
($
experiment
);
if
(
! @resources) {
return
0
;
}
foreach
my
$
resource
(@
resources
)
{
my
$
manifest
=
$
resource
->
Manifest
();
return
-
1
if
(
!defined($manifest));
foreach
my
$
ref
(@{
$
manifest
->{
'node'
}
})
{
my
$
sliver_urn
=
$
ref
->{
'sliver_urn'
};
my
$
vname
=
$
ref
->{
'virtual_id'
};
my
$
node
=
$
experiment
->
VnameToNode
($
vname
);
if
(
!defined($node)) {
print
STDERR
"MapNodes: Could not locate node $vname in $experiment
\n
"
;
return
-
1
;
}
$
node
->
ModifyReservation
({
"external_resource_index"
=>
$
resource
->
idx
(),
"external_resource_id"
=>
$
sliver_urn
})
==
0
or
return
-
1
;
if
(
exists
($
ref
->{
'sshdport'
}))
{
my
$
sshdport
=
$
ref
->{
'sshdport'
};
$
node
->
Update
({
'sshdport'
=>
$
sshdport
});
}
}
}
return
0
;
}
#
#
Boot
(
Start
)
all
of
the
slivers
.
This
does
the
entire
set
,
and
blocks
#
till
done
.
#
sub
StartSlivers
($$)
{
my
($
experiment
,
$
user
)
=
@
_
;
#
#
Get
the
resource
objects
.
#
my
@
resources
=
GeniResource
->
LookupAll
($
experiment
);
if
(
! @resources) {
return
0
;
}
#
#
Start
slivers
in
parallel
.
#
my
@
results
=
();
my
$
coderef
=
sub
{
my
($
resource
)
=
@
_
;
print
STDERR
"Starting ($$) sliver $resource
\n
"
;
return
$
resource
->
StartSliver
($
user
);
};
if
(
ParRun
(
undef
,
\@
results
,
$
coderef
,
@
resources
))
{
print
STDERR
"*** StartSlivers: Internal error starting slivers.
\n
"
;
return
-
1
;
}
#
#
Check
the
exit
codes
.
Eventually
return
specific
error
info
.
#
my
$
errors
=
0
;
my
$
count
=
0
;
my
@
tmp
=
();
foreach
my
$
result
(@
results
)
{
my
$
resource
=
$
resources
[$
count
];
if
($
result
!= 0) {
print
STDERR
"*** Error starting slivers for $resource
\n
"
;
$
errors
++;
}
else
{
push
(@
tmp
,
$
resource
);
}
$
count
++;
}
return
WaitForSlivers
($
experiment
,
$
user
,
@
tmp
);
}
sub
WaitForSlivers
($$@)
{
my
($
experiment
,
$
user
,
@
resources
)
=
@
_
;
my
%
nodemap
=
();
#
#
Get
the
resource
objects
.
#
@
resources
=
GeniResource
->
LookupAll
($
experiment
)
if
(
!@resources);
if
(
! @resources) {
return
0
;
}
#
#
Build
a
map
of
the
nodes
.
#
my
@
nodelist
=
$
experiment
->
NodeList
(
0
,
1
);
foreach
my
$
node
(@
nodelist
)
{
next
if
(
!defined($node->external_resource_id()) ||
$
node
->
external_resource_id
()
eq
""
);
$
nodemap
{$
node
->
external_resource_id
()}
=
$
node
;
$
node
->
Refresh
();
}
#
#
Now
we
use
parrun
again
to
get
the
sliver
status
.
We
are
waiting
#
for
them
to
become
ready
so
we
can
send
them
into
ISUP
.
#
my
$
coderef
=
sub
{
my
($
resource
)
=
@
_
;
my
$
ref
;
print
STDERR
"Waiting ($$) for sliver $resource
\n
"
;
if
($
resource
->
SliverStatus
($
user
,
\$
ref
)
!= 0) {
print
STDERR
"Error getting sliver status for $resource
\n
"
;
#
Tell
the
parent
error
.
return
-
1
;
}
print
STDERR
Dumper
($
ref
);
#
#
If
the
results
indicate
ready
,
send
ISUP
for
all
of
the
#
nodes
.
Yes
,
this
treats
the
nodes
as
a
block
.
Change
later
.
#
if
($
ref
->{
'status'
}
eq
"ready"
)
{
print
STDERR
"Sliver ready for $resource
\n
"
;
foreach
my
$
key
(
keys
(%{
$
ref
->{
'detailsNew'
}
}))
{
my
$
val
=
$
ref
->{
'detailsNew'
}->{$
key
};
my
$
node
=
$
nodemap
{$
key
};
print
STDERR
" Node $key says $val.
\n
"
;
if
(
!defined($node)) {
print
STDERR
"No node in map for $key ($resource)
\n
"
;
next
;
}
#
#
Only
look
for
ready
transition
,
and
send
ISUP
.
#
Eventually
have
the
CM
tell
us
about
failure
.
#
if
($
val
eq
"ready"
&&
!$node->IsUp()) {
print
STDERR
" Sending ISUP event.
\n
"
;
$
node
->
SetEventState
(
TBDB_NODESTATE_ISUP
());
}
}
#
Tell
the
parent
ready
.
return
0
;
}
#
Tell
the
parent
not
ready
.
return
1
;
};
while
(@
resources
)
{
my
@
results
=
();
if
(
ParRun
(
undef
,
\@
results
,
$
coderef
,
@
resources
))
{
print
STDERR
"*** WaitForSlivers: Internal error waiting on slivers.
\n
"
;
return
-
1
;
}
my
@
tmp
=
();