Commit cc22200f authored by Leigh B. Stoller's avatar Leigh B. Stoller
Browse files

Out with the vlans table, in with lans, lan_attributes, lan_members,

lan_member_attributes, and ifaces. Making the world safe for protogenis.
parent 96af2532
......@@ -25,7 +25,7 @@ WEB_BIN_SCRIPTS = webnfree
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
Image.pm OSinfo.pm Archive.pm Logfile.pm Lan.pm
# Stuff installed on plastic.
USERSBINS = genelists.proxy dumperrorlog.proxy
......
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2007, 2008 University of Utah and the Flux Group.
# All rights reserved.
#
package Lan;
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 Node;
use Experiment;
use English;
use Data::Dumper;
use overload ('""' => 'Stringify');
use vars qw(@EXPORT_OK);
# Configure variables
my $TB = "@prefix@";
my $BOSSNODE = "@BOSSNODE@";
my $CONTROL = "@USERNODE@";
my $TBOPS = "@TBOPSEMAIL@";
# Why, why, why?
@EXPORT_OK = qw();
# Cache of instances to avoid regenerating them.
my %lans = ();
my $debug = 0;
sub debugging() {return $debug; }
# Set during initial crossover.
my $initialize = 0;
#
# Lookup and create a class instance to return.
#
sub Lookup($$;$)
{
my ($class, $arg1, $arg2) = @_;
my $lanid;
my $experiment;
#
# A single arg is a lanid. Two args is exptidx and vname (lan name).
#
if (!defined($arg2)) {
if ($arg1 =~ /^(\d*)$/) {
$lanid = $1;
}
else {
return undef;
}
}
elsif (ref($arg1) && ($arg2 =~ /^[-\w]*$/)) {
# Assumed to be an experiment object.
$experiment = $arg1;
$arg1 = $experiment->idx();
}
elsif (! (($arg1 =~ /^\d*$/) && ($arg2 =~ /^[-\w]*$/))) {
return undef;
}
#
# Two args means lookup by exptidx,vname.
#
if (defined($arg2)) {
my $result =
DBQueryWarn("select lanid from lans ".
"where exptidx='$arg1' and vname='$arg2' and ".
" link is null");
return undef
if (! $result || !$result->numrows);
($lanid) = $result->fetchrow_array();
}
# Look in cache first
return $lans{"$lanid"}
if (exists($lans{"$lanid"}));
my $query_result =
DBQueryWarn("select * from lans where lanid='$lanid'");
return undef
if (!$query_result || !$query_result->numrows);
my $self = {};
$self->{'LAN'} = $query_result->fetchrow_hashref();
$self->{"ATTRS"} = {};
$self->{"EXPT"} = $experiment;
#
# Grab the attributes for this lan now.
#
$query_result =
DBQueryWarn("select * from lan_attributes where lanid='$lanid'");
return undef
if (!$query_result);
while (my $rowref = $query_result->fetchrow_hashref()) {
my $key = $rowref->{'attrkey'};
$self->{"ATTRS"}->{$key} = $rowref;
}
bless($self, $class);
# Add to cache.
$lans{"$lanid"} = $self;
return $self;
}
# accessors
sub field($$) { return ((! ref($_[0])) ? -1 : $_[0]->{'LAN'}->{$_[1]}); }
sub pid($) { return field($_[0], 'pid'); }
sub eid($) { return field($_[0], 'eid'); }
sub exptidx($) { return field($_[0], 'exptidx'); }
sub lanid($) { return field($_[0], 'lanid'); }
sub vname($) { return field($_[0], 'vname'); }
sub vidx($) { return field($_[0], 'vidx'); }
sub ready($) { return field($_[0], 'ready'); }
sub link($) { return field($_[0], 'link'); }
sub type($) { return field($_[0], 'type'); }
#
# Create a new (empty) lan. Ready bit is set to zero.
#
sub Create($$$;$$$)
{
my ($class, $experiment, $vname, $type, $id, $link) = @_;
return undef
if (ref($class) || !ref($experiment));
my $pid = $experiment->pid();
my $eid = $experiment->eid();
my $exptidx = $experiment->idx();
my $safe_vname = DBQuoteSpecial($vname);
my $linkid = (defined($link) ? $link->lanid() : "NULL");
my $vidx = 0;
# Allow for the caller to specify the ID, as when converting from
# existing vlans table.
$id = "NULL"
if (!defined($id));
# We need the idx from the virt_lan_lans table.
my $query_result =
DBQueryWarn("select idx from virt_lan_lans ".
"where exptidx=$exptidx and vname='$vname'");
return undef
if (!$query_result);
($vidx) = $query_result->fetchrow_array()
if ($query_result->numrows);
$query_result =
DBQueryWarn("insert into lans set ".
" lanid=$id, ".
" exptidx='$exptidx', ".
" pid='$pid', eid='$eid', ".
" vname=$safe_vname, ".
" type='$type', ".
" vidx='$vidx', ".
" link='$linkid', ".
" ready=0");
return undef
if (!defined($query_result));
# Need the newly minted ID
my $lanid = $query_result->insertid();
my $lan = Lan->Lookup($lanid);
# Keep the vlans table in sync for now. Will remove later.
if ($type eq "vlan" && !$initialize) {
$query_result =
DBQueryWarn("insert into vlans (id,exptidx,pid,eid,virtual) ".
"values ".
"(0, '$exptidx', '$pid', '$eid', $safe_vname)");
if (!$query_result) {
DBQueryWarn("delete from lans where lanid='$lanid'");
return undef;
}
my $vlanid = $query_result->insertid();
$lan->SetAttribute("vlanid", $vlanid);
}
print "Created lan: $lan\n"
if ($debug && $lan);
return $lan;
}
#
# Destroy a lan and its attributes.
#
sub Destroy($)
{
my ($self) = @_;
return -1
if (!ref($self));
my $lanid = $self->lanid();
my $type = $self->type();
#
# List of members to destroy.
#
my @members;
if ($self->MemberList(\@members) != 0) {
print STDERR "Destroy: Could not get member list\n";
return -1;
}
foreach my $member (@members) {
#
# Delete all members and interfaces and attributes.
#
my $memberid = $member->memberid();
return -1
if (!DBQueryWarn("delete from lan_member_attributes ".
"where lanid='$lanid' and memberid='$memberid'"));
return -1
if (!DBQueryWarn("delete from ifaces ".
"where lanid='$lanid' and ifaceid='$memberid'"));
return -1
if (!DBQueryWarn("delete from lan_members ".
"where lanid='$lanid' and memberid='$memberid'"));
}
# Keep the vlans table in sync for now. Will remove later.
if ($type eq "vlan" && !$initialize) {
my $vlanid;
$self->GetAttribute("vlanid", \$vlanid);
DBQueryWarn("delete from vlans where id='$vlanid'");
}
# Must delete attributes after above vlan removal but before lan removal.
return -1
if (!DBQueryWarn("delete from lan_attributes ".
"where lanid='$lanid'"));
return -1
if (!DBQueryWarn("delete from lans ".
"where lanid='$lanid'"));
# From the cache.
delete($lans{"$lanid"});
return 0;
}
#
# Class method to destroy all lans for an experiment.
#
sub DestroyExperimentLans($$)
{
my ($class, $experiment) = @_;
return -1
if (! ref($experiment));
my $exptidx = $experiment->idx();
my $query_result =
DBQueryWarn("select lanid from lans where exptidx='$exptidx'");
return -1
if (! $query_result);
while (my ($lanid) = $query_result->fetchrow_array()) {
my $lan = Lan->Lookup($lanid);
return -1
if (!$lan);
$lan->Destroy() == 0 or return -1;
}
return 0;
}
#
# Class method to backup all lans for an experiment.
#
sub BackupExperimentLans($$$)
{
my ($class, $experiment, $pstatedir) = @_;
my @lanids = ();
return -1
if (! ref($experiment));
my $exptidx = $experiment->idx();
my $query_result =
DBQueryWarn("select lanid from lans where exptidx='$exptidx'");
return -1
if (! $query_result);
while (my ($lanid) = $query_result->fetchrow_array()) {
push(@lanids, $lanid);
}
foreach my $table ("lans", "lan_attributes", "lan_members",
"lan_member_attributes", "ifaces") {
DBQueryWarn("select * from $table where ".
join(" or ", map("lanid='$_'", @lanids)) . " " .
"into outfile '$pstatedir/$table'")
or return -1;
}
return 0;
}
#
# Stringify for output.
#
sub Stringify($)
{
my ($self) = @_;
my $pid = $self->pid();
my $eid = $self->eid();
my $vname = $self->vname();
my $id = $self->lanid();
return "[Lan ${id}: $pid/$eid/$vname]";
}
#
# Refresh a class instance by reloading from the DB.
#
sub Refresh($)
{
my ($self) = @_;
return -1
if (! ref($self));
my $newref = Lan->Lookup($self->lanid());
return -1
if (!defined($newref));
$self->{'LAN'} = $newref->{'LAN'};
$self->{"ATTRS"} = $newref->{'ATTRS'};
return 0;
}
#
# Get value of an attribute.
#
sub GetAttribute($$$;$)
{
my ($self, $key, $pvalue, $ptype) = @_;
return -1
if (!exists($self->{'ATTRS'}->{$key}));
$$pvalue = $self->{'ATTRS'}->{$key}->{'attrvalue'};
$$ptype = $self->{'ATTRS'}->{$key}->{'attrtype'}
if (defined($ptype));
return 0;
}
#
# Set value of an attribute.
#
sub SetAttribute($$$;$)
{
my ($self, $key, $value, $type) = @_;
return -1
if (!ref($self));
$type = "string"
if (!defined($type));
return -1
if ($type ne "string" && $type ne "integer" &&
$type ne "float" && $type ne "boolean");
my $lanid = $self->lanid();
my $safe_key = DBQuoteSpecial($key);
my $safe_val = DBQuoteSpecial($value);
return -1
if (!DBQueryWarn("replace into lan_attributes set ".
" lanid='$lanid', ".
" attrkey=$safe_key, ".
" attrvalue=$safe_val, ".
" attrtype='$type'"));
$self->{'ATTRS'}->{$key}->{'attrkey'} = $key;
$self->{'ATTRS'}->{$key}->{'attrvalue'} = $value;
$self->{'ATTRS'}->{$key}->{'attrtype'} = $type;
return 0;
}
#
# Shorthand
#
sub SetRole($$)
{
my ($self, $role) = @_;
return -1
if (!ref($self));
return $self->SetAttribute("role", $role);
}
#
# Get the experiment object for a lan.
#
sub GetExperiment($)
{
my ($self) = @_;
return -1
if (!ref($self));
return $self->{"EXPT"}
if (defined($self->{"EXPT"}));
$self->{"EXPT"} = Experiment->Lookup($self->exptidx());
return $self->{"EXPT"};
}
#
# Get the linked lan as a lan object.
#
sub GetLinkedLan($)
{
my ($self) = @_;
return -1
if (!ref($self));
return Lan->Lookup($self->link());
}
#
# Add an Interface to a Lan. This interface always corresponds to a virtual
# interface on link or lan.
#
sub AddInterface($$$$;$$)
{
my ($self, $node, $vnode, $vport, $iface, $member) = @_;
return undef
if (! (ref($self) && ref($node)));
my $interface = Lan::Interface->Create($self, $node,
$vnode, $vport, $member);
return undef
if (!defined($interface));
#print "fee $interface\n";
# Set the attribute for the physical interface.
if (defined($iface) &&
$interface->SetAttribute("iface", $iface) != 0) {
$interface->Destroy();
return undef;
}
# And the node
if ($interface->SetAttribute("node_id", $node->node_id()) != 0) {
$interface->Destroy();
return undef;
}
# Keep vlans table in sync for now.
if ($self->type() eq "vlan" && !$initialize) {
my $nodeiface = $node->node_id() . ":" . $iface;
my $vlanid;
$self->GetAttribute("vlanid", \$vlanid);
DBQueryWarn("update vlans set ".
" members=CONCAT_WS(' ', members, '$nodeiface') ".
"where id='$vlanid'");
}
return $interface;
}
#
# Add a member to a lan
#
sub AddMember($$;$)
{
my ($self, $node, $iface) = @_;
return undef
if (!ref($self));
return undef
if (defined($node) && !ref($node));
my $member = Lan::Member->Create($self);
if (defined($node)) {
# And the node.
if ($member->SetAttribute("node_id", $node->node_id()) != 0) {
$member->Destroy();
return undef;
}
# Set the attribute for the physical interface.
if (defined($iface) &&
$member->SetAttribute("iface", $iface) != 0) {
$member->Destroy();
return undef;
}
# Keep vlans table in sync for now.
if ($self->type() eq "vlan" && !$initialize) {
my $member = $node->node_id() . ":" . $iface;
my $vlanid;
$self->GetAttribute("vlanid", \$vlanid);
DBQueryWarn("update vlans set ".
" members=CONCAT_WS(' ', members, '$member') ".
"where id='$vlanid'");
}
}
return $member;
}
#
# Remove a member from a lan.
#
sub DelMember($$)
{
my ($self, $member) = @_;
#
# We do not cache the members, so just delete it.
#
return $member->Destroy();
}
#
# Return a list of members for a lan.
#
sub MemberList($$)
{
my ($self, $plist) = @_;
return -1
if (! (ref($self) && ref($plist)));
my $lanid = $self->lanid();
my $query_result =
DBQueryWarn("select memberid from lan_members where lanid='$lanid'");
return -1
if (!defined($query_result));
my @result = ();
while (my ($memberid) = $query_result->fetchrow_array()) {
my $member = Lan::Member->Lookup($self, $memberid);
return -1
if (!defined($member));
push(@result, $member);
}
@$plist = @result;
return 0;
}
#
# List of all experiment lans. This is a class method.
#
sub ExperimentLans($$$)
{
my ($class, $experiment, $plist) = @_;
return -1
if (! (ref($plist) && ref($experiment)));
my $exptidx = $experiment->idx();
my $query_result =
DBQueryWarn("select l.lanid from lans as l ".
"where l.exptidx='$exptidx'");
return -1
if (!defined($query_result));
my @result = ();
while (my ($lanid) = $query_result->fetchrow_array()) {
my $lan = Lan->Lookup($lanid);
return -1
if (!defined($lan));
push(@result, $lan);
}
@$plist = @result;
return 0;
}
#
# Initialize from vlans table. Used when converting from old vlans table.
#
# XXX Need to deal with vlan encapsulation ...
#
sub Initialize($)
{