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-devel
Commits
461c5029
Commit
461c5029
authored
Sep 03, 2008
by
Leigh B. Stoller
Browse files
Changes for protogeni support.
parent
f5a1c6b5
Changes
3
Hide whitespace changes
Inline
Side-by-side
db/Experiment.pm.in
View file @
461c5029
...
...
@@ -2520,7 +2520,7 @@ sub OldReservedNodeList($$)
#
#
Return
list
of
experiment
nodes
(
objects
or
just
names
)
#
#
sub
NodeList
($;$$)
{
my
($
self
,
$
namesonly
,
$
includevirtual
)
=
@
_
;
...
...
@@ -2813,9 +2813,9 @@ sub SetPanicBit($$)
#
#
Is
experiment
firewalled
?
#
sub
IsFirewalled
($)
sub
IsFirewalled
($
;$
)
{
my
($
self
)
=
@
_
;
my
($
self
,
$
pref
)
=
@
_
;
#
Must
be
a
real
reference
.
return
-
1
...
...
@@ -2824,7 +2824,7 @@ sub IsFirewalled($)
my
$
pid
=
$
self
->
pid
();
my
$
eid
=
$
self
->
eid
();
return
TBExptFirewall
($
pid
,
$
eid
);
return
TBExptFirewall
($
pid
,
$
eid
,
$
pref
);
}
#
...
...
@@ -3589,10 +3589,11 @@ sub InsertVirtNode($$)
my
$
eid
=
$
self
->
eid
();
my
$
idx
=
$
self
->
idx
();
my
$
node_id
=
$
node
->
node_id
();
my
$
type
=
$
node
->
type
();
DBQueryWarn
(
"replace into virt_nodes set "
.
" pid='$pid', eid='$eid', exptidx='$idx', "
.
" vname='$node_id', type='
pc
', ips='', "
.
" vname='$node_id', type='
$type
', ips='', "
.
" cmd_line='', startupcmd='', osname=''"
)
or
return
-
1
;
...
...
@@ -3671,5 +3672,28 @@ sub LinkInterfaces($$$)
return
0
;
}
#
#
Does
the
experiment
have
any
geni
nodes
.
Faster
then
checking
all
the
nodes
.
#
sub
HasGeniNodes
($)
{
my
($
self
)
=
@
_
;
#
Must
be
a
real
reference
.
return
-
1
if
(
!ref($self));
my
$
idx
=
$
self
->
idx
();
my
$
query_result
=
DBQueryFatal
(
"select n.node_id from reserved as r "
.
"left join nodes as n on n.node_id=r.node_id "
.
"left join node_types as t on t.type=n.type "
.
"where r.exptidx=$idx and t.isfednode=1"
);
return
-
1
if
(
!$query_result);
return
$
query_result
->
num_rows
;
}
#
_Always_
make
sure
that
this
1
is
at
the
end
of
the
file
...
1
;
db/Interface.pm.in
View file @
461c5029
...
...
@@ -45,24 +45,27 @@ sub mysystem($)
#
#
Lookup
interfaces
for
a
node
and
create
a
list
of
class
instances
to
return
.
#
sub
LookupAll
($$)
sub
LookupAll
($$
$
)
{
my
($
class
,
$
nodeid
)
=
@
_
;
my
($
class
,
$
nodeid
,
$
pref
)
=
@
_
;
$
nodeid
=
$
nodeid
->
node_id
()
if
(
ref
($
nodeid
));
#
Look
in
cache
first
return
@{
$
node_interfaces
{$
nodeid
}
}
if
(
exists
($
node_interfaces
{$
nodeid
}));
if
(
exists
($
node_interfaces
{$
nodeid
}))
{
@$
pref
=
@{
$
node_interfaces
{$
nodeid
}
};
return
0
;
}
@$
pref
=
();
my
$
query_result
=
DBQueryWarn
(
"select * from interfaces "
.
"where node_id='$nodeid'"
);
return
undef
return
-
1
if
(
!$query_result);
return
()
return
0
if
(
!$query_result->numrows);
my
$
results
=
[];
...
...
@@ -95,7 +98,8 @@ sub LookupAll($$)
#
Add
to
cache
of
node
interfaces
$
node_interfaces
{$
nodeid
}
=
$
results
;
return
@{
$
results
};
@$
pref
=
@{
$
results
};
return
0
;
}
#
accessors
sub
field
($$)
{
return
((
! ref($_[0])) ? -1 : $_[0]->{'DBROW'}->{$_[1]}); }
...
...
@@ -155,6 +159,84 @@ sub Lookup($$$$)
return
$
interface
;
}
#
#
Create
a
new
interface
record
.
This
also
handles
the
wires
table
entries
.
#
sub
Create
($$$)
{
my
($
class
,
$
node
,
$
argref
)
=
@
_
;
return
undef
if
(
! (ref($node) && ref($argref)));
my
$
node_id
=
$
node
->
node_id
();
my
$
MAC
=
$
argref
->{
'MAC'
};
my
$
IP
=
$
argref
->{
'IP'
};
my
$
mask
=
$
argref
->{
'mask'
};
my
$
card
=
$
argref
->{
'card'
};
my
$
port
=
$
argref
->{
'port'
};
my
$
iftype
=
$
argref
->{
'type'
};
my
$
ifrole
=
$
argref
->{
'role'
};
my
$
uuid
=
$
argref
->{
'uuid'
};
my
$
max_speed
=
$
argref
->{
'max_speed'
};
my
$
duplex
=
$
argref
->{
'duplex'
};
my
$
switch_id
=
$
argref
->{
'switch_id'
};
my
$
switch_card
=
$
argref
->{
'switch_card'
};
my
$
switch_port
=
$
argref
->{
'switch_port'
};
my
$
wire_type
=
$
argref
->{
'wire_type'
};
my
$
cable
=
$
argref
->{
'cable'
};
my
$
length
=
$
argref
->{
'length'
};
my
$
iface
=
"eth$card"
;
$
port
=
1
if
(
!defined($port));
$
IP
=
""
if
(
!defined($IP));
$
mask
=
""
if
(
!defined($mask));
$
duplex
=
"full"
if
(
!defined($duplex));
$
max_speed
=
0
if
(
!defined($max_speed));
if
(
!defined($uuid)) {
$
uuid
=
NewUUID
();
if
(
!defined($uuid)) {
print
STDERR
"Could not generate a UUID!
\n
"
;
return
undef
;
}
}
DBQueryWarn
(
"insert into interfaces set "
.
" node_id='$node_id', "
.
" card=$card, port=$port, role='$ifrole', "
.
" mac='$MAC', IP='$IP', mask='$mask', "
.
" interface_type='$iftype', iface='$iface', "
.
" current_speed='$max_speed', duplex='$duplex', "
.
" uuid='$uuid'"
)
or
return
undef
;
if
(
defined
($
switch_id
))
{
my
$
cable_len
=
""
;
if
(
defined
($
cable
))
{
$
cable_len
.=
", cable=$cable"
;
}
if
(
defined
($
length
))
{
$
cable_len
.=
", len=$length"
;
}
if
(
!DBQueryWarn("insert into wires set".
" type='$wire_type', "
.
" node_id1='$node_id', card1=$card, port1=$port, "
.
" node_id2='$switch_id', card2='$switch_card', "
.
" port2='$switch_port' $cable_len"
))
{
DBQueryWarn
(
"delete from interfaces "
.
"where node_id='$node_id' and card='$card' "
.
" and port='$port'"
);
return
undef
;
}
}
return
Interface
->
Lookup
($
node_id
,
$
card
,
$
port
);
}
#
#
Lookup
by
iface
#
...
...
@@ -170,7 +252,7 @@ sub LookupByIface($$$)
if
(
exists
($
all_interfaces
{
"$nodeid:$iface"
}));
my
$
query_result
=
DBQueryWarn
(
"select
*
from interfaces "
.
DBQueryWarn
(
"select
card,port
from interfaces "
.
"where node_id='$nodeid' and iface='$iface'"
);
return
undef
...
...
@@ -178,19 +260,9 @@ sub LookupByIface($$$)
return
undef
if
(
!$query_result->numrows);
my
$
interface
=
{};
$
interface
->{
"DBROW"
}
=
$
query_result
->
fetchrow_hashref
();
bless
($
interface
,
$
class
);
my
($
card
,
$
port
)
=
$
query_result
->
fetchrow_array
();
#
Cache
by
card
,
port
and
by
iface
my
$
card
=
$
interface
->
card
();
my
$
port
=
$
interface
->
port
();
$
all_interfaces
{
"$nodeid:$card:$port"
}
=
$
interface
;
$
all_interfaces
{
"$nodeid:$iface"
}
=
$
interface
;
return
$
interface
;
return
Interface
->
Lookup
($
nodeid
,
$
card
,
$
port
);
}
#
...
...
@@ -205,7 +277,7 @@ sub LookupByUUID($$)
}
my
$
query_result
=
DBQueryWarn
(
"select node_id,
iface
from interfaces "
.
DBQueryWarn
(
"select node_id,
card,port
from interfaces "
.
"where uuid='$uuid'"
);
return
undef
...
...
@@ -213,9 +285,9 @@ sub LookupByUUID($$)
return
undef
if
(
!$query_result->numrows);
my
($
node
_
id
,
$
iface
)
=
$
query_result
->
fetchrow_array
();
my
($
nodeid
,
$
card
,
$
port
)
=
$
query_result
->
fetchrow_array
();
return
Interface
->
Lookup
ByIface
($
node
_
id
,
$
iface
);
return
Interface
->
Lookup
($
nodeid
,
$
card
,
$
port
);
}
#
...
...
@@ -229,7 +301,7 @@ sub LookupControl($)
if
(
ref
($
nodeid
));
my
$
query_result
=
DBQueryWarn
(
"select
*
from interfaces "
.
DBQueryWarn
(
"select
card,port
from interfaces "
.
"where node_id='$nodeid' and "
.
" role='"
.
TBDB_IFACEROLE_CONTROL
()
.
"'"
);
...
...
@@ -238,20 +310,9 @@ sub LookupControl($)
return
undef
if
(
!$query_result->numrows);
my
$
interface
=
{};
$
interface
->{
"DBROW"
}
=
$
query_result
->
fetchrow_hashref
();
bless
($
interface
,
$
class
);
my
($
card
,
$
port
)
=
$
query_result
->
fetchrow_array
();
#
Cache
by
card
,
port
and
by
iface
my
$
card
=
$
interface
->
card
();
my
$
port
=
$
interface
->
port
();
my
$
iface
=
$
interface
->
iface
();
$
all_interfaces
{
"$nodeid:$card:$port"
}
=
$
interface
;
$
all_interfaces
{
"$nodeid:$iface"
}
=
$
interface
;
return
$
interface
;
return
Interface
->
Lookup
($
nodeid
,
$
card
,
$
port
);
}
#
...
...
db/Node.pm.in
View file @
461c5029
...
...
@@ -112,12 +112,92 @@ sub Lookup($$)
$
nodes
{$
nodeid
}
=
$
self
;
return
$
self
;
}
#
#
Bulk
lookup
of
nodes
reserved
to
an
experiment
.
More
efficient
.
#
sub
BulkLookup
($$$)
{
my
($
class
,
$
experiment
,
$
pref
)
=
@
_
;
my
%
nodelist
=
();
my
$
exptidx
=
$
experiment
->
idx
();
my
$
query_result
=
DBQueryWarn
(
"select n.* from reserved as r "
.
"left join nodes as n on n.node_id=r.node_id "
.
"where r.exptidx=$exptidx"
);
return
-
1
if
(
!defined($query_result));
while
(
my
$
row
=
$
query_result
->
fetchrow_hashref
())
{
my
$
nodeid
=
$
row
->{
'node_id'
};
my
$
node
;
if
(
exists
($
nodes
{$
nodeid
}))
{
$
node
=
$
nodes
{$
nodeid
};
$
node
->{
"DBROW"
}
=
$
row
;
}
else
{
$
node
=
{};
$
node
->{
"DBROW"
}
=
$
row
;
bless
($
node
,
$
class
);
#
Add
to
cache
.
$
nodes
{$
nodeid
}
=
$
node
;
}
$
node
->{
"RSRV"
}
=
undef
;
$
node
->{
"TYPEINFO"
}
=
undef
;
$
node
->{
"ATTRS"
}
=
undef
;
$
nodelist
{$
nodeid
}
=
$
node
;
}
$
query_result
=
DBQueryWarn
(
"select r.* from reserved as r "
.
"where r.exptidx=$exptidx"
);
return
-
1
if
(
!defined($query_result));
while
(
my
$
row
=
$
query_result
->
fetchrow_hashref
())
{
my
$
nodeid
=
$
row
->{
'node_id'
};
my
$
node
=
$
nodelist
{$
nodeid
};
return
-
1
if
(
!defined($node));
$
node
->{
"RSRV"
}
=
$
row
;
}
$
query_result
=
DBQueryWarn
(
"select a.* from reserved as r "
.
"left join node_attributes as a on a.node_id=r.node_id "
.
"where r.exptidx=$exptidx and a.node_id is not null"
);
return
-
1
if
(
!defined($query_result));
while
(
my
$
row
=
$
query_result
->
fetchrow_hashref
())
{
my
$
nodeid
=
$
row
->{
'node_id'
};
my
$
key
=
$
row
->{
'attrkey'
};
my
$
node
=
$
nodelist
{$
nodeid
};
return
-
1
if
(
!defined($node));
$
node
->{
"ATTRS"
}->{$
key
}
=
$
row
;
}
@$
pref
=
values
(%
nodelist
);
return
0
;
}
#
accessors
sub
field
($$)
{
return
((
! ref($_[0])) ? -1 : $_[0]->{'DBROW'}->{$_[1]}); }
sub
node_id
($)
{
return
field
($
_
[
0
],
'node_id'
);
}
sub
uuid
($)
{
return
field
($
_
[
0
],
'uuid'
);
}
sub
type
($)
{
return
field
($
_
[
0
],
'type'
);
}
sub
eventstate
($)
{
return
field
($
_
[
0
],
'eventstate'
);
}
sub
allocstate
($)
{
return
field
($
_
[
0
],
'allocstate'
);
}
sub
jailflag
($)
{
return
field
($
_
[
0
],
'jailflag'
);
}
sub
phys_nodeid
($)
{
return
field
($
_
[
0
],
'phys_nodeid'
);
}
sub
def_boot_osid
($)
{
return
field
($
_
[
0
],
'def_boot_osid'
);
}
...
...
@@ -134,6 +214,19 @@ sub Create($$$$)
my
$
type
=
$
argref
->{
'type'
};
my
$
role
=
$
argref
->{
'role'
};
my
$
uuid
;
if
(
exists
($
argref
->{
'uuid'
}))
{
$
uuid
=
$
argref
->{
'uuid'
};
}
else
{
$
uuid
=
NewUUID
();
if
(
!defined($uuid)) {
print
STDERR
"Could not generate a UUID!
\n
"
;
return
undef
;
}
}
$
uuid
=
DBQuoteSpecial
($
uuid
);
my
$
typeinfo
=
NodeType
->
Lookup
($
type
);
return
undef
...
...
@@ -184,7 +277,7 @@ sub Create($$$$)
" priority=$priority, "
.
" eventstate='$state', op_mode='$opmode', "
.
" def_boot_osid='$osid', "
.
" inception=now(), "
.
" inception=now(),
uuid=$uuid,
"
.
" state_timestamp=unix_timestamp(NOW()), "
.
" op_mode_timestamp=unix_timestamp(NOW())"
)
or
goto
bad
;
...
...
@@ -226,16 +319,18 @@ sub Create($$$$)
#
Add
vnode
counts
.
#
if
($
role
eq
$
Node
::
NODEROLE_TESTNODE
&&
$
virtnode_capacity
)
{
my
$
vtype
=
$
type
;
if
(
!($vtype =~ s/pc/pcvm/)) {
$
vtype
=
"$vtype-vm"
;
my
$
vtype
;
if
(
exists
($
argref
->{
'vtype'
}))
{
$
vtype
=
$
argref
->{
'vtype'
};
}
my
$
pcvmtype
=
($
isremote
?
"pcvwa"
:
"pcvm"
);
DBQueryWarn
(
"insert into node_auxtypes set node_id='$node_id', "
.
"type='$pcvmtype', count=$virtnode_capacity"
)
or
goto
bad
;
else
{
$
vtype
=
$
type
;
if
(
!($vtype =~ s/pc/pcvm/)) {
$
vtype
=
"$vtype-vm"
;
}
}
DBQueryWarn
(
"insert into node_auxtypes set node_id='$node_id', "
.
"type='$vtype', count=$virtnode_capacity"
)
or
goto
bad
;
...
...
@@ -600,16 +695,20 @@ sub ModifyReservation($$)
if (! $self->IsReserved());
my $node_id = $self->node_id();
my @sets = ();
foreach my $key (keys(%{$argref})) {
my $val = $argref->{$key};
my $query = "update reserved set ".
join(",", map("$_='
" . $argref->{$_} . "
'", keys(%{$argref})));
push(@sets, "$key=" . ("$val" eq "NULL" ? "NULL" : "'
$
val
'"));
}
my $query = "update reserved set ". join(",", @sets);
$query .= " where node_id='
$
node_id
'";
return -1
if (! DBQueryWarn($query));
return
0
;
return
Refresh($self)
;
}
#
...
...
@@ -722,11 +821,15 @@ sub VirtualNodes($$)
return -1
if (! ref($self));
@$plist = ();
my $reservation = $self->Reservation();
return 0
if (!defined($reservation));
my $node_id = $self->node_id();
my $exptidx = $reservation->idx();
my @result = ();
@$plist = ();
my $query_result =
DBQueryWarn("select r.node_id from reserved as r ".
...
...
@@ -975,6 +1078,20 @@ sub ClearInterfaces($)
return 0;
}
#
# Look up all interfaces for a node, return list of objects.
#
sub AllInterfaces($$)
{
my ($self, $pref) = @_;
# Must be a real reference.
return -1
if (! (ref($self) && ref($pref)));
return Interface->LookupAll($self->node_id(), $pref);
}
#
# Mark a node for an update.
#
...
...
@@ -1143,11 +1260,12 @@ sub CreateVnodes($$)
my $vtype = $options->{'
vtype
'};
my $pnode = $options->{'
nodeid
'};
my $exp
tidx
;
if (!
TBExptIDX($pid, $eid, \$exptidx
)) {
my $exp
eriment = Experiment->Lookup($pid, $eid)
;
if (!
defined($experiment
)) {
print STDERR "*** CreateVnodes: No such experiment $pid/$eid!\n";
return -1;
}
my $exptidx = $experiment->idx();
#
# Need the vtype node_type info.
...
...
@@ -1593,6 +1711,46 @@ sub SelectOS($)
return 0;
}
#
# Set geni sliver idx,tmcd for the node. Called out of the geni libraries
# when the sliver that corresponds to the node has been created.
#
sub SetGeniSliverInfo($$;$)
{
my ($self, $idx, $tmcd_redirect) = @_;
return -1
if (! (ref($self)));
my $args = {"genisliver_idx" => $idx};
if (defined($tmcd_redirect)) {
$args->{'
tmcd_redirect
'} =
($tmcd_redirect eq "" ? "NULL" : $tmcd_redirect);
}
return $self->ModifyReservation($args);
}
#
# Get the geni info for a node.
#
sub GetGeniSliverInfo($$;$)
{
my ($self, $idx, $tmcd_redirect) = @_;
return -1
if (! (ref($self)));
my $reservation = $self->ReservedTableEntry();
return -1
if (!defined($reservation));
$$idx = $reservation->{'
genisliver_idx
'};
$$tmcd_redirect = $reservation->{'
tmcd_redirect
'}
if defined($tmcd_redirect);
return 0;
}
# _Always_ make sure that this 1 is at the end of the file...
1;
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment