Commit 624a0364 authored by Leigh Stoller's avatar Leigh Stoller

Changes necessary for moving most of the stuff in the node_types

table, into a new table called node_type_attributes, which is intended
to be a more extensible way of describing nodes.

The only things left in the node_types table will be type,class and the
various isXXX boolean flags, since we use those in numerous joins all over
the system (ie: when discriminating amongst nodes).

For the most part, all of that other stuff is rarely used, or used in
contexts where the information is needed, but not for type descrimination.
Still, it made for a lot of queries to change!

Along the way I added a NodeType library module that represents the type
info as a perl object. I also beefed up the existing Node module, and
started using it in more places. I also added an Interfaces module, but I
have not done much with that yet.

I have not yet removed all the slots from the node_types table; I plan to
run the new code for a few days and then remove the slots.

Example using the new NodeType object:

	use NodeType;

	my $typeinfo = NodeType->Lookup($type);

        if ($typeinfo->control_interface(\$control_iface) ||
            !$control_iface) {
  	    warn "No control interface for $type is defined in the DB!\n";
        }

or using the Node:

	use Node;

        my $nodeobject = Node->Lookup($node_id);
        my $imageable  = $nodeobject->NodeTypeInfo()->imageable();
or
        my $rebootable = $nodeobject->isrebootable();
or
        $nodeobject->NodeTypeAttribute("control_interface", \$control_iface);

Lots of way to accomplish the same thing, but the main point is that the
Node is able to override the NodeType (if it wants to), which I think is
necessary for flexibly describing one/two of a kind things like switches, etc.
parent df6dedcc
......@@ -293,8 +293,6 @@ sub Create($$$$)
my $noidleswap_reason = DBQuoteSpecial($argref->{'noidleswap_reason'});
delete($argref->{'noidleswap_reason'});
print Dumper($argref);
my $query = "insert into experiments set ".
join(",", map("$_='" . $argref->{$_} . "'", keys(%{$argref})));
......
......@@ -19,7 +19,8 @@ SBIN_SCRIPTS = avail inuse showgraph if2port backup webcontrol node_status \
elabinelab_bossinit update_permissions mysqld_watchdog \
dumperrorlog
LIBEXEC_SCRIPTS = webnodelog webnfree webnewwanode webidlemail xmlconvert
LIB_SCRIPTS = libdb.pm Node.pm libdb.py libadminctrl.pm Experiment.pm
LIB_SCRIPTS = libdb.pm Node.pm libdb.py libadminctrl.pm Experiment.pm \
NodeType.pm Interface.pm
# Stuff installed on plastic.
USERSBINS = genelists.proxy dumperrorlog.proxy
......
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005, 2006 University of Utah and the Flux Group.
# All rights reserved.
#
package Interface;
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);
@ISA = "Exporter";
@EXPORT = qw ( );
# Must come after package declaration!
use lib '@prefix@/lib';
use libdb;
use libtestbed;
use English;
use Data::Dumper;
use overload ('""' => 'Stringify');
# Configure variables
my $TB = "@prefix@";
my $BOSSNODE = "@BOSSNODE@";
# Cache of instances to avoid regenerating them.
my %all_interfaces = ();
my %node_interfaces = ();
# Manual
my $debug = 0;
# Little helper and debug function.
sub mysystem($)
{
my ($command) = @_;
print STDERR "Running '$command'\n"
if ($debug);
return system($command);
}
#
# Lookup interfaces for a node and create a list of class instances to return.
#
sub LookupAll($$)
{
my ($class, $nodeid) = @_;
# Look in cache first
return @{ $node_interfaces{$nodeid} }
if (exists($node_interfaces{$nodeid}));
my $query_result =
DBQueryWarn("select * from interfaces ".
"where node_id='$nodeid'");
return undef
if (!$query_result);
return ()
if (!$query_result->numrows);
my $results = [];
while (my $rowref = $query_result->fetchrow_hashref()) {
my $card = $rowref->{'card'};
my $port = $rowref->{'port'};
my $iface = $rowref->{'iface'};
my $interface;
#
# If we already have this in the interface cache, lets not create
# another one. Just use that one.
#
if (exists($all_interfaces{"$nodeid:$card:$port"})) {
$interface = $all_interfaces{"$nodeid:$card:$port"};
}
else {
$interface = {};
$interface->{"DBROW"} = $rowref;
bless($interface, $class);
# Cache by card,port and by iface
$all_interfaces{"$nodeid:$card:$port"} = $interface;
$all_interfaces{"$nodeid:$iface"} = $interface;
}
push(@{ $results }, $interface);
}
# Add to cache of node interfaces
$node_interfaces{$nodeid} = $results;
return @{ $results };
}
# accessors
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'DBROW'}->{$_[1]}); }
sub node_id($) { return field($_[0], 'node_id'); }
sub card($) { return field($_[0], 'card'); }
sub port($) { return field($_[0], 'port'); }
sub iface($) { return field($_[0], 'iface'); }
sub mac($) { return field($_[0], 'mac'); }
sub IP($) { return field($_[0], 'IP'); }
sub role($) { return field($_[0], 'role'); }
sub type($) { return field($_[0], 'interface_type'); }
sub mask($) { return field($_[0], 'mask'); }
#
# Lookup by card,port
#
sub Lookup($$$$)
{
my ($class, $nodeid, $card, $port) = @_;
# Look in cache first
return $all_interfaces{"$nodeid:$card:$port"}
if (exists($all_interfaces{"$nodeid:$card:$port"}));
my $query_result =
DBQueryWarn("select * from interfaces ".
"where node_id='$nodeid' and ".
" card='$card' and port='$port'");
return undef
if (!$query_result);
return undef
if (!$query_result->numrows);
my $interface = {};
$interface->{"DBROW"} = $query_result->fetchrow_hashref();
bless($interface, $class);
# Cache by card,port and by iface
my $iface = $interface->iface();
$all_interfaces{"$nodeid:$card:$port"} = $interface;
$all_interfaces{"$nodeid:$iface"} = $interface;
return $interface;
}
#
# Lookup by iface
#
sub LookupByIface($$$)
{
my ($class, $nodeid, $iface) = @_;
# Look in cache first
return $all_interfaces{"$nodeid:$iface"}
if (exists($all_interfaces{"$nodeid:$iface"}));
my $query_result =
DBQueryWarn("select * from interfaces ".
"where node_id='$nodeid' and iface='$iface'");
return undef
if (!$query_result);
return undef
if (!$query_result->numrows);
my $interface = {};
$interface->{"DBROW"} = $query_result->fetchrow_hashref();
bless($interface, $class);
# 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;
}
#
# Lookup the control interface for a node, which is something we do a lot.
#
sub LookupControl($)
{
my ($class, $nodeid) = @_;
my $query_result =
DBQueryWarn("select * from interfaces ".
"where node_id='$nodeid' and ".
" role='" . TBDB_IFACEROLE_CONTROL() . "'");
return undef
if (!$query_result);
return undef
if (!$query_result->numrows);
my $interface = {};
$interface->{"DBROW"} = $query_result->fetchrow_hashref();
bless($interface, $class);
# 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;
}
#
# Stringify for output.
#
sub Stringify($)
{
my ($self) = @_;
my $nodeid = $self->node_id();
my $iface = $self->iface();
return "[Interface: $nodeid:$iface]";
}
# _Always_ make sure that this 1 is at the end of the file...
1;
#!/usr/bin/perl -w
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2005 University of Utah and the Flux Group.
# Copyright (c) 2005, 2006 University of Utah and the Flux Group.
# All rights reserved.
#
#
# A library for getting the physical (or jailed) node data out of the
# DB, and caching it. The intent is to place all of the data about a
# node in one spot, and use that instead of querying the DB over and
# over, with specific queries scattered around. I'm hoping this also
# reduces the load on the DB. It remains to be seen if this approach
# will work or will be any more convenient.
#
# Used like this:
#
# my $pc1 = Node::Lookup("pc1");
# my $isvirt = $pc1->IsNodeVirtual();
# my $reserved = $pc1->IsNodeReserved();
#
# or:
# my $isvirt = Node::IsNodeVirtual("pc1");
# my $reserved = Node::IsNodeReserved("pc1");
#
package Node;
require Exporter;
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);
@ISA = qw( Exporter );
@ISA = "Exporter";
@EXPORT = qw ( );
# Must come after package declaration!
use lib '@prefix@/lib';
use English;
use libdb;
use libtestbed;
use NodeType;
use Interface;
use English;
use Data::Dumper;
use overload ('""' => 'Stringify');
# Configure variables
my $TB = "@prefix@";
my $BOSSNODE = "@BOSSNODE@";
my $EVENTSYS = @EVENTSYS@;
# XXX stinky hack detection
my $ISUTAH = @TBMAINSITE@;
my $ISUTAH = @TBMAINSITE@;
#
# Cache the node structures to avoid repeated lookups. It is up to the
# user to request nodes be synched with the DB if they think that is
# necessary.
#
my %nodes = ();
# Cache of instances to avoid regenerating them.
my %nodes = ();
my $debug = 0;
# Little helper and debug function.
sub mysystem($)
{
my ($command) = @_;
print STDERR "Running '$command'\n"
if ($debug);
return system($command);
}
#
# Lookup and return a node structure.
# Lookup a (physical) node and create a class instance to return.
#
sub Lookup ($$) {
sub Lookup($$)
{
my ($class, $nodeid) = @_;
if (exists($nodes{$nodeid})) {
return $nodes{$nodeid};
}
# Look in cache first
return $nodes{$nodeid}
if (exists($nodes{$nodeid}));
my $query_result =
libdb::DBQueryFatal("select n.*,nt.*,r.vname from nodes as n ".
"left join reserved as r on r.node_id=n.node_id ".
"left join node_types as nt on nt.type=n.type ".
"where n.node_id='$nodeid'");
DBQueryWarn("select * from nodes as n ".
"where n.node_id='$nodeid'");
if (! $query_result->numrows) {
return undef;
}
my $self = {};
$self->{"DBROW"} = $query_result->fetchrow_hashref();
$self->{"NODEID"} = $nodeid;
bless($self);
return undef
if (!$query_result || !$query_result->numrows);
my $self = {};
$self->{"DBROW"} = $query_result->fetchrow_hashref();
$self->{"RSRV"} = undef;
$self->{"TYPEINFO"} = undef;
bless($self, $class);
# Add to cache.
$nodes{$nodeid} = $self;
return $self;
}
# accessors
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'DBROW'}->{$_[1]}); }
sub node_id($) { return field($_[0], 'node_id'); }
sub type($) { return field($_[0], 'type'); }
sub eventstate($) { return field($_[0], 'eventstate'); }
sub jailflag($) { return field($_[0], 'jailflag'); }
sub phys_nodeid($) { return field($_[0], 'phys_nodeid'); }
sub def_boot_osid($) { return field($_[0], 'def_boot_osid'); }
#
# Poor man polysomething. These routines can be called as methods on an
# instance, or as package functions on a "pcxxx" argument. That is:
# Refresh a class instance by reloading from the DB.
#
# $isvirt = Node::IsNodeVirtual("pc1");
# $isvirt = $pc1->IsNodeReserved();
#
sub GetNode($)
sub Refresh($)
{
my $arg = shift;
my ($self) = @_;
return -1
if (! ref($self));
return $arg
if (ref($arg));
my $nodeid = $self->node_id();
return Node->Lookup($arg);
my $query_result =
DBQueryWarn("select * from nodes as n ".
"where n.node_id='$nodeid'");
return -1
if (!$query_result || !$query_result->numrows);
$self->{"DBROW"} = $query_result->fetchrow_hashref();
# Force reload
$self->{"RSRV"} = undef;
$self->{"TYPEINFO"} = undef;
return 0;
}
#
# Return the DB data. Maybe this should be a set of tables instead of
# one big mess.
#
sub DBData ($)
# Stringify for output.
#
sub Stringify($)
{
my ($arg) = @_;
my $node = GetNode($arg);
my $row = $node->{"DBROW"};
my ($self) = @_;
my $nodeid = $self->node_id();
return $row;
return "[Node: $nodeid]";
}
#
# Throw away the current info, and reload from the DB.
#
sub Sync ($)
# Lazily load the reservation info.
#
sub IsReserved($)
{
my ($arg) = @_;
my $node = GetNode($arg);
my ($self) = @_;
delete($nodes{$node->{"NODEID"}});
Node->Lookup($node->{"NODEID"});
return -1
if (! ref($self));
return $row;
if (! defined($self->{"RSRV"})) {
my $nodeid = $self->node_id();
my $query_result =
DBQueryWarn("select * from reserved " .
"where node_id='$nodeid'");
return -1
if (!$query_result);
return 0
if (!$query_result->numrows);
$self->{"RSRV"} = $query_result->fetchrow_hashref();
return 1;
}
return 1;
}
sub IsVirtual ($)
#
# Return type info. We cache this in the instance since node_type stuff
# does not change much.
#
sub NodeTypeInfo($)
{
my ($arg) = @_;
my $node = GetNode($arg);
my ($self) = @_;
return undef
if (!defined($node));
if (! ref($self));
return $node->{"DBROW"}{"isvirtnode"};
return $self->{"TYPEINFO"}
if (defined($self->{"TYPEINFO"}));
my $type = $self->type();
my $nodetype = NodeType->Lookup($type);
$self->{"TYPEINFO"} = $nodetype
if (defined($nodetype));
return $nodetype;
}
sub IsReserved ($)
#
# Lookup a specific attribute in the nodetype info.
#
sub NodeTypeAttribute($$$;$)
{
my ($arg) = @_;
my $node = GetNode($arg);
my ($self, $attrkey, $pattrvalue, $pattrtype) = @_;
return -1
if (!ref($self));
return undef
if (!defined($node));
my $typeinfo = $self->NodeTypeInfo();
return 0
if (!defined($node->{"DBROW"}{"vname"}));
return -1
if (!defined($typeinfo));
return 1;
return $typeinfo->GetAttribute($attrkey, $pattrvalue, $pattrtype);
}
sub IsDynamic ($)
{
my ($arg) = @_;
my $node = GetNode($arg);
return undef
if (!defined($node));
return 0
if (!defined($node->{"DBROW"}{"isdynamic"}));
#
# Shortcuts to "common" type information.
# Later these might be overriden by node attributes.
#
sub class($) { return NodeTypeInfo($_[0])->class(); }
sub isvirtnode($) { return NodeTypeInfo($_[0])->isvirtnode(); }
sub isjailed($) { return NodeTypeInfo($_[0])->isjailed(); }
sub isdynamic($) { return NodeTypeInfo($_[0])->isdynamic(); }
sub isremotenode($) { return NodeTypeInfo($_[0])->isremotenode(); }
sub issubnode($) { return NodeTypeInfo($_[0])->issubnode(); }
sub isplabdslice($) { return NodeTypeInfo($_[0])->isplabdslice(); }
sub isplabphysnode($) { return NodeTypeInfo($_[0])->isplabphysnode(); }
sub issimnode($) { return NodeTypeInfo($_[0])->issimnode(); }
return 1;
#
# And these are the less common attributes, but still common enough to
# warrant shortcuts.
#
sub default_osid($;$) {
return NodeTypeInfo($_[0])->default_osid($_[1]);
}
sub imageable($;$) {
return NodeTypeInfo($_[0])->imageable($_[1]);
}
sub disksize($;$) {
return NodeTypeInfo($_[0])->disksize($_[1]);
}
sub disktype($;$) {
return NodeTypeInfo($_[0])->disktype($_[1]);
}
sub bootdisk_unit($;$) {
return NodeTypeInfo($_[0])->bootdisk_unit($_[1]);
}
sub control_iface($;$) {
return NodeTypeInfo($_[0])->control_iface($_[1]);
}
sub rebootable($;$) {
return NodeTypeInfo($_[0])->rebootable($_[1]);
}
#
......@@ -424,7 +496,7 @@ sub CreateVnodes($$)
bad:
if (!$impotent) {
foreach my $vnodeid (@newnodes) {
foreach my $vnodeid (@created) {
DBQueryWarn("delete from reserved where node_id='$vnodeid'");
DBQueryWarn("delete from nodes where node_id='$vnodeid'");
DBQueryWarn("delete from node_hostkeys where node_id='$vnodeid'");
......
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005, 2006 University of Utah and the Flux Group.
# All rights reserved.
#
package NodeType;
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);
@ISA = "Exporter";
@EXPORT = qw ( );
# Must come after package declaration!
use lib '@prefix@/lib';
use libdb;
use libtestbed;
use English;
use Data::Dumper;
use overload ('""' => 'Stringify');
# Configure variables
my $TB = "@prefix@";
my $BOSSNODE = "@BOSSNODE@";
# Cache of instances to avoid regenerating them.
my %nodetypes = ();
my %nodeclasses = ();
my $debug = 0;
# Little helper and debug function.
sub mysystem($)
{
my ($command) = @_;
print STDERR "Running '$command'\n"
if ($debug);
return system($command);
}
#
# Lookup a (physical) node and create a class instance to return.
#
sub Lookup($$)
{
my ($class, $type) = @_;
# Look in cache first
return $nodetypes{$type}
if (exists($nodetypes{$type}));
my $query_result =
DBQueryWarn("select * from node_types where type='$type'");
return undef
if (!$query_result || !$query_result->numrows);
my $self = {};
# Do not use the embedded type field, cause of auxtypes.
$self->{"TYPE"} = $type;
$self->{"DBROW"} = $query_result->fetchrow_hashref();
$self->{"ATTRS"} = undef;
bless($self, $class);
# Add to cache.
$nodetypes{$type} = $self;
return $self;
}
# accessors
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'DBROW'}->{$_[1]}); }
# Do not use the embedded type field, cause of auxtypes.
sub type($) { return $_[0]->{'TYPE'}; }
sub class($) { return field($_[0], 'class'); }
sub isvirtnode($) { return field($_[0], 'isvirtnode'); }
sub isjailed($) { return field($_[0], 'isjailed'); }
sub isdynamic($) { return field($_[0], 'isdynamic'); }
sub isremotenode($) { return field($_[0], 'isremotenode'); }
sub issubnode($) { return field($_[0], 'issubnode'); }
sub isplabdslice($) { return field($_[0], 'isplabdslice'); }
sub isplabphysnode($) { return field($_[0], 'isplabphysnode'); }
sub issimnode($) { return field($_[0], 'issimnode'); }
#
# Force a reload of the data.
#
sub LookupSync($$)
{
my ($class, $type) = @_;
# delete from cache
delete($nodetypes{$type})
if (exists($nodetypes{$type}));
delete($nodeclasses{$type})
if (exists($nodeclasses{$type}));
return Lookup($class, $type);
}
#
# Return a list of all types.
#
sub AllTypes($)
{
my ($class) = @_;
my @alltypes = ();
my $query_result =
DBQueryWarn("select type from node_types");
return undef
if (!$query_result || !$query_result->numrows);
while (my ($type) = $query_result->fetchrow_array()) {
my $typeinfo = Lookup($class, $type);
# Something went wrong?
return undef
if (!defined($typeinfo));
push(@alltypes, $typeinfo);
}
return @alltypes;
}
sub AuxTypes($)
{
my ($class) = @_;
my @auxtypes = ();
my $query_result =
DBQueryFatal("select at.auxtype,nt.type ".
" from node_types_auxtypes as at ".
"left join node_types as nt on nt.type=at.type ");
return undef
if (!$query_result || !$query_result->numrows);
while (my ($auxtype, $type) = $query_result->fetchrow_array()) {
my $typeinfo = Lookup($class, $type);
# Something went wrong?