Commit 9a0186db authored by Leigh B. Stoller's avatar Leigh B. Stoller

First working vtopgen. Rough of course, but this is pretty basically a

cleaup pass through the original top generation code. I did not try to
change the logic much (that would be insane). My hope was to improve
all the data structures and get rid of the zillion global variables.
This version still generates plain text. Now on to the XML.
parent 5dc478d7
......@@ -26,10 +26,13 @@ use OSinfo;
use English;
use Data::Dumper;
use Carp;
use POSIX;
# Configure variables
my $TB = "@prefix@";
my $BOSSNODE = "@BOSSNODE@";
my $TB = "@prefix@";
my $BOSSNODE = "@BOSSNODE@";
my $DELAYCAPACITY = @DELAYCAPACITY@; # Can be overridden by user!
my $DELAYTHRESH = @DELAYTHRESH@;
# Flags.
$VTOP_FLAGS_VERBOSE = 0x01;
......@@ -56,7 +59,16 @@ sub Create($$$)
$self->{'VIRTEXPT'} = $virtexperiment;
$self->{'FLAGS'} = $flags;
$self->{'VNODES'} = {};
$self->{'DELAYNODES'} = {};
$self->{'LANNODES'} = {};
$self->{'VLANS'} = {};
$self->{'MEMBEROF'} = {};
$self->{'COUNTERS'} = {};
$self->{'EXPTSTATS'} = {};
$self->{'DELAYLINKS'} = {};
$self->{'OPTIONS'} = {};
$self->{'DELAYID'} = 0;
$self->{'PORTBW'} = {};
bless($self, $class);
return $self;
......@@ -66,7 +78,17 @@ sub experiment($) { return $_[0]->{'EXPERIMENT'}; }
sub virtexperiment($) { return $_[0]->{'VIRTEXPT'}; }
sub flags($) { return $_[0]->{'FLAGS'}; }
sub vnodes($) { return $_[0]->{'VNODES'}; }
sub delaynodes($) { return $_[0]->{'DELAYNODES'}; }
sub lannodes($) { return $_[0]->{'LANNODES'}; }
sub vlans($) { return $_[0]->{'VLANS'}; }
sub memberof($) { return $_[0]->{'MEMBEROF'}; }
sub counters($) { return $_[0]->{'COUNTERS'}; }
sub options($) { return $_[0]->{'OPTIONS'}; }
sub option($$) { return $_[0]->{'OPTIONS'}->{$_[1]}; }
sub exptstats($) { return $_[0]->{'EXPTSTATS'}; }
sub delaylinks($) { return $_[0]->{'DELAYLINKS'}; }
sub delaynodecount() { return scalar(keys(%{ $_[0]->delaynodes() })); }
sub portbw($) { return $_[0]->{'PORTBW'}; }
sub pid($) { return $_[0]->experiment()->pid(); }
sub pid_idx($) { return $_[0]->experiment()->pid_idx(); }
sub eid($) { return $_[0]->experiment()->eid(); }
......@@ -75,13 +97,26 @@ sub exptidx($) { return $_[0]->experiment()->idx(); }
# The virtual tables from the DB.
sub virt_table($$) { return $_[0]->virtexperiment()->Table($_[1]); }
sub virt_vtypes($) { return $_[0]->virt_table("virt_vtypes"); }
sub virt_desires($) { return $_[0]->virt_table("virt_desires"); }
sub virt_nodes($) { return $_[0]->virt_table("virt_nodes"); }
sub virt_lans($) { return $_[0]->virt_table("virt_lans"); }
sub virt_lan_lans($) { return $_[0]->virt_table("virt_lan_lans"); }
sub virt_desires($) { return $_[0]->virt_table("virt_node_desires"); }
sub virt_startloc($) { return $_[0]->virt_table("virt_node_startloc"); }
# Given a vname, is it a node in the topo (or something else like a delay).
sub isatoponode($$) { return exists($_[0]->vnodes()->{$_[1]}); }
sub isadelaynode($$) { return exists($_[0]->delaynodes()->{$_[1]}); }
# Debug output.
sub verbose($) { return $_[0]->flags() & $VTOP_FLAGS_VERBOSE; }
sub updating($) { return $_[0]->flags() & $VTOP_FLAGS_UPDATE; }
sub printdb($$) { print $_[1] if ($_[0]->verbose()); }
# We name delay nodes internally as they are needed.
sub nextdelayname($) { return "tbsdelay" . $_[0]->{'DELAYID'}++; }
# For when the user wants a specific delay os. Use a desire.
sub delay_desire($) { return $_[0]->option("delay_desire_string"); }
###############################################################################
# Virtual Types.
#
......@@ -103,8 +138,10 @@ sub PrintVirtTypes($)
print "make-vclass $name $weight @members\n";
}
return 0;
}
###############################################################################
# Virtual Nodes. A separate package so we can create objects for each one
# and then add local stuff to them.
......@@ -112,6 +149,7 @@ sub PrintVirtTypes($)
package libvtop::virt_node;
use Carp;
use vars qw($AUTOLOAD);
use overload ('""' => 'Stringify');
# To avoid wrtting out all the methods.
sub AUTOLOAD {
......@@ -162,21 +200,306 @@ sub DESTROY {
$self->{'HASH'} = undef;
}
sub Stringify($)
{
my ($self) = @_;
my $vname = $self->vname();
return "[vnode:$vname]";
}
###############################################################################
# Virtual Lans. This wraps up the virt_lan_lan table, and allows storing
# the members (virt_lans table entries).
#
package libvtop::virt_lan;
use Carp;
use vars qw($AUTOLOAD);
use overload ('""' => 'Stringify');
# To avoid wrtting out all the methods.
sub AUTOLOAD {
my $self = shift;
my $type = ref($self) or croak "$self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip fully-qualified portion
if (@_) {
return $self->{'HASH'}->{$name} = shift;
}
elsif (exists($self->{'HASH'}->{$name})) {
return $self->{'HASH'}->{$name};
}
else {
return $self->virt_lanlan()->$name();
}
}
#
# Wrap up a virt lan.
#
sub Create($$$$)
{
my ($class, $vtop, $virt_lanlan) = @_;
my $self = {};
bless($self, $class);
$self->{'VIRTLANLAN'} = $virt_lanlan;
$self->{'VTOP'} = $vtop;
$self->{'MEMBERS'} = {};
$self->{'SHAPEDMEMBERS'} = {};
$self->{'HASH'} = {};
return $self;
}
# accessors
sub virt_lanlan($) { return $_[0]->{'VIRTLANLAN'}; }
sub members($) { return $_[0]->{'MEMBERS'}; }
sub memberlist($) { return values(%{ $_[0]->members() }); }
sub shapedmembers($) { return $_[0]->{'SHAPEDMEMBERS'}; }
sub vtop($) { return $_[0]->{'VTOP'}; }
sub hash($) { return $_[0]->{'HASH'}; }
# Break circular reference someplace to avoid exit errors.
sub DESTROY {
my $self = shift;
$self->{'VIRTLANLAN'} = undef;
$self->{'MEMBERS'} = undef;
$self->{'VTOP'} = undef;
$self->{'HASH'} = undef;
}
sub Stringify($)
{
my ($self) = @_;
my $vname = $self->vname();
return "[vlan:$vname]";
}
#
# Other support functions.
#
sub usevirtiface($)
{
my ($self) = @_;
my $encap = $self->_encapstyle();
return ($encap eq "veth" || $encap eq "veth-ne" || $encap eq "vlan");
}
sub membershaped($$) {
my ($self, $member) = @_;
return $self->shapedmembers()->{"$member"};
}
sub setmembershaped($$) {
my ($self, $member) = @_;
$self->shapedmembers()->{"$member"} = 1;
}
###############################################################################
# Virtual Lans Member. A separate package so we can create objects for
# each one and then add local stuff to them.
#
package libvtop::virt_lan_member;
use Carp;
use vars qw($AUTOLOAD);
use overload ('""' => 'Stringify');
# To avoid wrtting out all the methods.
sub AUTOLOAD {
my $self = shift;
my $type = ref($self) or croak "$self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip fully-qualified portion
if (@_) {
return $self->{'HASH'}->{$name} = shift;
}
elsif (exists($self->{'HASH'}->{$name})) {
return $self->{'HASH'}->{$name};
}
else {
return $self->virt_member()->$name();
}
}
#
# Wrap up a virt lan member.
#
sub Create($$$$)
{
my ($class, $vtop, $virt_member, $virt_lan) = @_;
my $self = {};
bless($self, $class);
$self->{'VIRTMEMBER'} = $virt_member;
$self->{'VIRTLAN'} = $virt_lan;
$self->{'VIRTNODE'} = $vtop->vnodes()->{$virt_member->vnode()};
$self->{'VTOP'} = $vtop;
$self->{'HASH'} = {};
return $self;
}
# accessors
sub virt_member($) { return $_[0]->{'VIRTMEMBER'}; }
sub virt_lan($) { return $_[0]->{'VIRTLAN'}; }
sub virt_node($) { return $_[0]->{'VIRTNODE'}; }
sub vtop($) { return $_[0]->{'VTOP'}; }
sub hash($) { return $_[0]->{'HASH'}; }
# Break circular reference someplace to avoid exit errors.
sub DESTROY {
my $self = shift;
$self->{'VIRTLAN'} = undef;
$self->{'VIRTNODE'} = undef;
$self->{'VIRTMEMBER'} = undef;
$self->{'VTOP'} = undef;
$self->{'HASH'} = undef;
}
sub Stringify($)
{
my ($self) = @_;
my $vnode = $self->vnode();
my $vport = $self->vport();
return "$vnode:$vport";
}
#############################################################################
# Back to the main package.
#
package libvtop;
#
# Load some physical info (for types, interfaces, speeds).
#
sub LoadPhysInfo($)
{
my ($self) = @_;
$self->printdb("Loading physical info\n");
#
# Interface capabilities, for getting speeds.
#
my %interface_capabilities = ();
my $query_result =
DBQueryWarn("select * from interface_capabilities");
return -1
if (!$query_result);
while (my ($type, $capkey, $capval) = $query_result->fetchrow()) {
$interface_capabilities{$type} = {}
if (!defined($interface_capabilities{$type}));
$interface_capabilities{$type}->{$capkey} = $capval;
}
#
# Now get interface speeds for each type/class. We use this for
# determining if a delay node is required. Very hacky, quite
# wrong.
#
my %node_type_linkbw = ();
# XXX: PlanetLab hack - PlanetLab 'control' interfaces are also
# 'experimental' interfaces! We probably need a way to express
# this in the interfaces table or interface_types
#
$query_result =
DBQueryWarn("select distinct i.interface_type,n.type ".
" from interfaces as i ".
"left join nodes as n on n.node_id=i.node_id ".
"where i.role='" . TBDB_IFACEROLE_EXPERIMENT . "' ".
" or (n.type='pcplabphys' and i.role='" .
TBDB_IFACEROLE_CONTROL . "')");
return -1
if (!$query_result);
# XXX Special hack for sim nodes.
$node_type_linkbw{"sim"} = {};
while (my ($iface_type, $node_type) = $query_result->fetchrow()) {
my $typeinfo = NodeType->Lookup($node_type);
if (!defined($typeinfo)) {
carp("No type info for node type $node_type");
return -1;
}
my $node_class = $typeinfo->class();
$node_type_linkbw{$node_type} = {}
if (!defined($node_type_linkbw{$node_type}));
$node_type_linkbw{$node_class} = {}
if (!defined($node_type_linkbw{$node_class}));
if (!defined($interface_capabilities{$iface_type}->{"protocols"})) {
carp("No protocols listed in capabilities for $iface_type!");
return -1;
}
my @protolist =
split(",", $interface_capabilities{$iface_type}->{"protocols"});
foreach my $proto (@protolist) {
my $def_speed =
$interface_capabilities{$iface_type}->{"${proto}_defspeed"};
if (!defined($def_speed)) {
carp("No default speed in capabilites for $iface_type!");
return -1;
}
my $auxspeeds =
$interface_capabilities{$iface_type}->{"${proto}_auxspeeds"};
my @auxspeedlist = ();
if ($auxspeeds) {
@auxspeedlist = split(",", $auxspeeds);
}
foreach my $speed ($def_speed, @auxspeedlist) {
$node_type_linkbw{$node_type}{$proto}->{$speed} = 1;
$node_type_linkbw{$node_class}{$proto}->{$speed} = 1;
#
# If the type/class has a non-zero simnode capacity, then add
# entries for the interface speed so that requires_delay can
# figure out interface speeds the underlying node type
# supports.
#
if ($typeinfo->simnode_capacity()) {
$node_type_linkbw{"sim"}{$proto}->{$speed} = 1;
}
}
}
}
$self->{'IFACECAPS'} = \%interface_capabilities;
$self->{'TYPELINKBW'} = \%node_type_linkbw;
return 0;
}
sub LoadVirtNodes($)
{
my ($self) = @_;
$self->printdb("Loading virtual nodes\n");
my $table = $self->virt_nodes();
my $pid = $self->pid();
my $eid = $self->eid();
my $table = $self->virt_nodes();
foreach my $virt_node ($table->Rows()) {
my $vnode = libvtop::virt_node->Create($self, $virt_node);
my $vname = $vnode->vname();
my $vnode = libvtop::virt_node->Create($self, $virt_node);
my $vname = $vnode->vname();
my $desires = {};
my $startloc = undef;
# Other fields we need.
my $ips = $vnode->ips();
......@@ -196,6 +519,7 @@ sub LoadVirtNodes($)
my $isplab = 0;
my $issim = 0;
my $isdyn = 0; # Only virtnodes are dynamic.
my $isvtyped= 0;
# If we have a real type or auxtype ...
my $nodetype = NodeType->LookupAny($type);
......@@ -216,7 +540,10 @@ sub LoadVirtNodes($)
carp("Improper type $vtypename in vtypes for node $vnode!");
return -1;
}
$isvtyped = 1;
}
$vnode->_typeinfo($nodetype);
$isremote = $nodetype->isremotenode();
$isvirt = $nodetype->isvirtnode();
$issub = $nodetype->issubnode();
......@@ -224,6 +551,9 @@ sub LoadVirtNodes($)
$issim = $nodetype->issimnode();
$isdyn = $nodetype->isdynamic();
# Mark this as being a virtual typed node.
$vnode->_isvtyped($isvtyped);
# All this info is stashed in our local object.
$vnode->_nodeweight(undef);
$vnode->_isremotenode($isremote);
......@@ -233,8 +563,8 @@ sub LoadVirtNodes($)
$vnode->_issimnode($issim);
$vnode->_isdynamic($isdyn);
# The mapped osname to actual osid.
$vnode->_osid(undef);
# The mapped osname to actual osinfo structure.
$vnode->_osinfo(undef);
# Eventual physical mapping.
$vnode->_physnode(undef);
# Handy to combine these.
......@@ -264,6 +594,7 @@ sub LoadVirtNodes($)
# Can fixed really get set to ""?
if (defined($fixed) && $fixed ne "") {
# Store the name since we use FIXED_NODES for delay nodes too.
$self->{'FIXED_NODES'}->{$vname} = $fixed;
}
......@@ -272,6 +603,1201 @@ sub LoadVirtNodes($)
$self->printdb("fixed:$fixed")
if (defined($fixed));
$self->printdb("\n");
# We need to check the names to make sure they do not clash with
# our internal delay node names.
if (($vname =~ /^tbdelay\d+/) ||
($vname =~ /^tbsdelay\d+/)) {
print "Warning: $vname is a reserved name. Working around it.\n";
my ($num) = ($vname =~ /(\d+)/);
$self->delayid($num + 1);
}
$self->{'COUNTERS'}->{'simcount'}++
if ($issim);
$self->{'COUNTERS'}->{'remotecount'}++
if ($isremote);
$self->{'COUNTERS'}->{'virtcount'}++
if ($isvirt);
$self->{'COUNTERS'}->{'plabcount'}++
if ($isplab);
$self->{'COUNTERS'}->{'physcount'}++
if (!$issim && !$isvirt);
# stats
my @iplist = split(" ", $ips);
my $ipcount = scalar(@iplist);
$self->exptstats()->{"maxlinks"} = $ipcount
if ($ipcount > $self->exptstats()->{"maxlinks"});
$self->exptstats()->{"minlinks"} = $ipcount
if ($ipcount < $self->exptstats()->{"minlinks"});
# Take apart the IP list.
foreach my $ipinfo (@iplist) {
my ($port,$ip) = split(":",$ipinfo);
$self->{'IPS'}->{"$vname:$port"} = $ip;
}
#
# Map the osname to an OSID now so that we can check max_concurrent.
# This also avoids the work and *check* later after we have done 90%
# of assign_wrapper. If no osname was specified, we have to wait and
# use the default for the type of phys node that assign picks.
#
if (defined($osname) && $osname ne "") {
my $osinfo = OSinfo->Lookup("$pid,$osname");
if (!defined($osinfo)) {
$osinfo = OSinfo->LookupByName($osname);
if (!defined($osinfo)) {
tberror({cause => 'user', type => 'primary',
severity => SEV_ERROR,
error => ['invalid_os', undef, $osname, $pid]},
"Invalid OS $osname in project $pid!");
return -1;
}
}
$vnode->_osinfo($osinfo);
}
#
# Add in desires.
#
foreach my $desire ($self->virt_desires()->Rows()) {
next
if ($desire->vname() ne $vname);
$desires->{$desire->desire()} = $desire->weight();
}
$vnode->_desires($desires);
#
# And the startloc, but doubt this is used anymore.
#
foreach my $startloc ($self->virt_startloc()->Rows()) {
if ($startloc->vname() eq $vname) {
$startloc = $startloc->building();
last;
}
}
$vnode->_startloc($startloc);
# Add to the list.
$self->{'VNODES'}->{$vname} = $vnode;
}
return 0;
}
sub LoadVirtLans($)
{
my ($self) = @_;
$self->printdb("Loading virtual lans\n");
my $pid = $self->pid();
my $eid = $self->eid();
my $table = $self->virt_lans();
foreach my $virt_lan_member ($table->Rows()) {
my $vlanname = $virt_lan_member->vname();
# Local wrapper for virt_lan_lan table entry (the "lan").
my $virtlan = $self->vlans()->{$vlanname};
if (!defined($virtlan)) {
my $virt_lan_lan = $self->virt_lan_lans()->Find($vlanname);
$virtlan = libvtop::virt_lan->Create($self, $virt_lan_lan);
# Add it to the toplevel list of lans.
$self->vlans()->{$vlanname} = $virtlan;
}
# Now the local wrapper for the virt_lan table entry (the "member").
my $vlanmember = libvtop::virt_lan_member->Create($self,
$virt_lan_member,
$virtlan);
# Which we add to the member hash for the lan by vnode:vport
# Note that $vlanmember->member() returns vnode:port.
$virtlan->members()->{$vlanmember->member()} = $vlanmember;
# Global map from vnode:port back to the lan object
$self->memberof()->{$vlanmember->member()} = $virtlan;
# Other fields we need below
my $delay = $vlanmember->delay();
my $bandwidth = $vlanmember->bandwidth();
my $est_bandwidth = $vlanmember->est_bandwidth();
my $lossrate = $vlanmember->lossrate();
my $rdelay = $vlanmember->rdelay();
my $rbandwidth = $vlanmember->rbandwidth();
my $rest_bandwidth = $vlanmember->rest_bandwidth();
my $rlossrate = $vlanmember->rlossrate();
my $widearea = $vlanmember->widearea();
my $isemulated = $vlanmember->emulated();
my $uselinkdelay = $vlanmember->uselinkdelay();
my $nobwshaping = $vlanmember->nobwshaping();
my $trivial_ok = $vlanmember->trivial_ok();
my $protocol = $vlanmember->protocol();
my $mustdelay = $vlanmember->mustdelay();
my $encap = $vlanmember->encap_style();
my $mask = $vlanmember->mask();
#
# So all this stuff is really per-lan state, but an artifact of
# the original implementation is that it is duplicated in every
# single member row. So, push the info up a level to make it easy
# to figure out how each lan is set up.
#
# If RED, must insert traffic shapping.
$virtlan->_mustdelay($mustdelay);
# User has requested the link/lan be emulated. Not typical.
$virtlan->_emulated($isemulated);
# User has requested "endnodeshaping" (dummynet on end nodes).
$virtlan->_uselinkdelay($uselinkdelay);
# The nobwshaping flag is used in conjunction with emulated
# links to turn off actual bw traffic shaping on an emulated
# link. This allows assign to match the specified bws, but not
# force them to be such with delay nodes (leaves it up to the
# user to moderate the bw).
$virtlan->_nobwshaping($nobwshaping);
$virtlan->_encapstyle($encap);
# User has said that colocating is okay. Not typical.
$virtlan->_trivial_ok($trivial_ok);
# Link is connected to a remote node, and gets a tunnel.
$virtlan->_tunnel(0);
# Netmask for the entire lan.
$virtlan->_mask($mask);
$virtlan->_widearea($widearea);
# Whether all member nodes are simulated
$virtlan->_allsim(0);
$virtlan->_protocol($protocol);
$virtlan->_accesspoint($vlanmember)
if ($vlanmember->is_accesspoint());
if (defined($encap) &&
($encap eq "vtun" || $encap eq "gre" || $encap eq "egre")) {
$virtlan->_tunnel(1);
}
# Store this stuff as a unit to make it easier to grab later.
$vlanmember->_delayinfo([ $delay,
$bandwidth,
$est_bandwidth,
$lossrate,
$rdelay,
$rbandwidth,
$rest_bandwidth,
$rlossrate ]);
#
# Ditto for the Q stuff, which is not needed until the delay
# links are created. There are no "r" params either; Queue
# stuff is handled in just the to-switch direction.
#
$vlanmember->_queueinfo([$vlanmember->q_limit(),
$vlanmember->q_maxthresh(),
$vlanmember->q_minthresh(),
$vlanmember->q_weight(),
$vlanmember->q_linterm(),
$vlanmember->q_qinbytes(),
$vlanmember->q_bytes(),
$vlanmember->q_meanpsize(),
$vlanmember->q_wait(),
$vlanmember->q_setbit(),
$vlanmember->q_droptail(),
$vlanmember->q_red(),
$vlanmember->q_gentle() ]);
#
# The trace info is stored along with the QUEUEINFO, but its
# easier if I split it out.
#
$vlanmember->_traceinfo([$vlanmember->traced(),
$vlanmember->trace_endnode(),
$vlanmember->trace_type(),
$vlanmember->trace_expr(),
$vlanmember->trace_snaplen(),
$vlanmember->trace_db() ]);