libvtop_test.pm.in

#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2005-2011 University of Utah and the Flux Group.
# All rights reserved.
#
package libvtop_test;

use strict;
use Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK
	    $VTOP_FLAGS_UPDATE $VTOP_FLAGS_VERBOSE $VTOP_FLAGS_QUIET
	    $VTOP_FLAGS_FIXNODES $VTOP_FLAGS_IMPOTENT $VTOP_FLAGS_ALLOCONLY
	    $VTOP_FLAGS_REGRESSION);

@ISA    = "Exporter";
@EXPORT = qw( );

use libdb;
use libtblog_simple;
use libtestbed;
use Experiment;
use VirtExperiment;
use Node;
use NodeType;
use Lan;
use OSinfo;
use English;
use Data::Dumper;
use Carp;
use POSIX;
use XML::LibXML;
use XML::Simple;
use GeniHRN;

# Configure variables
my $TB		  = "@prefix@";
my $BOSSNODE      = "@BOSSNODE@";
my $AVAIL         = "$TB/bin/avail";
my $NALLOC        = "$TB/bin/nalloc";
my $NFREE         = "$TB/bin/nfree";
my $OS_SELECT     = "$TB/bin/os_select";
my $DELAYCAPACITY = @DELAYCAPACITY@;	# Can be overridden by user.
my $DELAYTHRESH   = @DELAYTHRESH@;
my $PGENISUPPORT  = @PROTOGENI_SUPPORT@;
my $OURDOMAIN     = "@OURDOMAIN@";
my $mycmurn       = GeniHRN::Generate("@OURDOMAIN@", "authority", "cm");

# Flags.
$VTOP_FLAGS_VERBOSE	= 0x01;
$VTOP_FLAGS_UPDATE	= 0x02;
$VTOP_FLAGS_FIXNODES	= 0x04;
$VTOP_FLAGS_IMPOTENT	= 0x08;
$VTOP_FLAGS_REGRESSION  = 0x10;
$VTOP_FLAGS_QUIET       = 0x20;
$VTOP_FLAGS_ALLOCONLY	= 0x40;

@EXPORT_OK = qw($VTOP_FLAGS_UPDATE $VTOP_FLAGS_VERBOSE $VTOP_FLAGS_FIXNODES
		$VTOP_FLAGS_IMPOTENT $VTOP_FLAGS_REGRESSION $VTOP_FLAGS_QUIET
		$VTOP_FLAGS_ALLOCONLY);

#
# Create an object representing the stuff we need to create the vtop file.
#
sub Create($$$$)
{
    my ($class, $experiment, $user, $flags) = @_;

    my $virtexperiment = VirtExperiment->Lookup($experiment);
    if (!defined($virtexperiment)) {
	tberror("Could not load virtual experiment object for $experiment\n");
	return undef;
    }

    my $self              = {};
    $self->{'EXPERIMENT'} = $experiment;
    $self->{'USER'}       = $user;
    $self->{'VIRTEXPT'}   = $virtexperiment;
    $self->{'FLAGS'}      = $flags;
    $self->{'VNODES'}     = {};
    $self->{'DELAYNODES'} = {};
    $self->{'LANNODES'}   = {};
    $self->{'BRIDGES'}    = {};
    $self->{'VLANS'}      = {};
    $self->{'VPATHS'}     = {};
    $self->{'MEMBEROF'}   = {};
    $self->{'COUNTERS'}   = {};
    $self->{'EXPTSTATS'}  = {};
    $self->{'DELAYLINKS'} = {};
    $self->{'VLINKS'}     = {};
    $self->{'OPTIONS'}    = {};
    $self->{'DELAYID'}    = 0;
    $self->{'PHOSTID'}    = 0;
    $self->{'IFACEID'}    = 32768;
    $self->{'PORTBW'}     = {};
    $self->{'RESULTS'}    = { "nodes"  => [],
			      "links"  => [],
			      "class"  => [],
			      "fixed"  => [] };
    $self->{'RSPEC'}      = {};
    $self->{'GENIRSPEC'}  = undef;

    # Mostly for update mode.
    $self->{'FIXEDNODES'}  = {};
    $self->{'CURRENT_V2P'} = {};
    $self->{'CURRENT_P2V'} = {};
    $self->{'CURRENT_V2V'} = {};
    $self->{'OLDRSRVCLEAN_FLAG'}  = 0;
    $self->{'OLDRSRVCLEAN_NODES'} = {};

    # Below is for interpretation of assign results.
    $self->{'PNODES'}      = {};
    $self->{'SOLUTION'}    = {};
    $self->{'NEWRESERVED'} = {};	# Newly reserved nodes.
    $self->{'NORECOVER'}   = 0;	
    
    bless($self, $class);
    $virtexperiment->Dump()
	if (0 && $self->verbose());

    return $self;
}
# accessors
sub experiment($)       { return $_[0]->{'EXPERIMENT'}; }
sub user($)             { return $_[0]->{'USER'}; }
sub virtexperiment($)   { return $_[0]->{'VIRTEXPT'}; }
sub flags($)            { return $_[0]->{'FLAGS'}; }
sub vnodes($)           { return $_[0]->{'VNODES'}; }
sub delaynodes($)       { return $_[0]->{'DELAYNODES'}; }
sub bridges($)          { return $_[0]->{'BRIDGES'}; }
sub lannodes($)         { return $_[0]->{'LANNODES'}; }
sub vlans($)            { return $_[0]->{'VLANS'}; }
sub memberof($)         { return $_[0]->{'MEMBEROF'}; }
sub vpaths($)           { return $_[0]->{'VPATHS'}; }
sub counters($)         { return $_[0]->{'COUNTERS'}; }
sub counter($$)         { return $_[0]->{'COUNTERS'}->{$_[1]}; }
sub options($)          { return $_[0]->{'OPTIONS'}; }
sub option($$)          { return (exists($_[0]->{'OPTIONS'}->{$_[1]}) ?
				  $_[0]->{'OPTIONS'}->{$_[1]} : undef); }
sub exptstats($)        { return $_[0]->{'EXPTSTATS'}; }
sub vlinks($)           { return $_[0]->{'VLINKS'}; }
sub delaylinks($)       { return $_[0]->{'DELAYLINKS'}; }
sub delaynodecount()    { return scalar(keys(%{ $_[0]->delaynodes() })); }
sub portbw($)           { return $_[0]->{'PORTBW'}; }
sub results($)          { return $_[0]->{'RESULTS'}; }
sub current_v2p($)      { return $_[0]->{'CURRENT_V2P'}; }
sub current_p2v($)      { return $_[0]->{'CURRENT_P2V'}; }
sub current_v2v($)      { return $_[0]->{'CURRENT_V2V'}; }
sub pnodes($)           { return $_[0]->{'PNODES'}; }
sub fixednodes($)       { return $_[0]->{'FIXEDNODES'}; }
sub newreserved($)      { return $_[0]->{'NEWRESERVED'}; }
sub rspec($)            { return $_[0]->{'RSPEC'}; }
sub genirspec($)        { return $_[0]->{'GENIRSPEC'}; }
sub newreservednodes($) { return keys(%{ $_[0]->{'NEWRESERVED'} }); }
sub oldreservednodes($) { return $_[0]->{'OLDRSRVCLEAN_NODES'}; }
sub norecover($)        { return $_[0]->{'norecover'}; }
sub pid($)		{ return $_[0]->experiment()->pid(); }
sub pid_idx($)		{ return $_[0]->experiment()->pid_idx(); }
sub eid($)		{ return $_[0]->experiment()->eid(); }
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_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_paths($)       { return $_[0]->virt_table("virt_paths"); }
sub virt_bridges($)     { return $_[0]->virt_table("virt_bridges"); }
sub virt_desires($)	{ return $_[0]->virt_table("virt_node_desires"); }
sub virt_startloc($)	{ return $_[0]->virt_table("virt_node_startloc"); }
sub virt_trafgens($)	{ return $_[0]->virt_table("virt_trafgens"); }
sub virt_lan_settings($){ return $_[0]->virt_table("virt_lan_settings"); }
sub virt_lan_member_settings($)	{
    return $_[0]->virt_table("virt_lan_member_settings"); }

# 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 quiet($)		{ return $_[0]->flags() & $VTOP_FLAGS_QUIET; }
sub updating($)		{ return $_[0]->flags() & $VTOP_FLAGS_UPDATE; }
sub fixcurrent($)	{ return $_[0]->flags() & $VTOP_FLAGS_FIXNODES; }
sub impotent($)		{ return $_[0]->flags() & $VTOP_FLAGS_IMPOTENT; }
sub alloconly($)	{ return $_[0]->flags() & $VTOP_FLAGS_ALLOCONLY; }
sub regression($)	{ return $_[0]->flags() & $VTOP_FLAGS_REGRESSION; }
sub printdb($$)		{ print $_[1] if ($_[0]->verbose()); return 1; }

# We name delay nodes internally as they are needed.
sub nextdelayname($)    { return "tbdelay" . $_[0]->{'DELAYID'}++; }
# For when the user wants a specific delay os. Use a desire.
# sub delay_desire($)	{ return $_[0]->option("delay_desire_string"); }
sub delay_desire_type($)	{ return $_[0]->option("delay_desire_type"); }
sub delay_desire_name($)	{ return $_[0]->option("delay_desire_name"); }
sub delay_desire_penalty($)	{ return $_[0]->option("delay_desire_penalty"); }
# For XML
sub nextifacenumber($)  { return $_[0]->{'IFACEID'}++; }
sub nextphostnumber($)  { return $_[0]->{'PHOSTID'}++; }

# Virtual Types. 
sub virttypeisvtype($$) { return $_[0]->virt_vtypes()->Find($_[1]); }
sub VirtTypes($)        { return $_[0]->virt_vtypes()->Rows(); }

# Caller will want these.
sub minimum_nodes($)    { return $_[0]->counter("minimum_nodes"); }
sub maximum_nodes($)    { return $_[0]->counter("maximum_nodes"); }
sub nodecount($)	{ return $_[0]->counter("nodecount"); }
sub plabcount($)	{ return $_[0]->counter("plabcount"); }
sub genicount($)	{ return $_[0]->counter("genicount"); }
sub virtnodecount($)	{ return $_[0]->counter("virtcount"); }
sub simnodecount($)	{ return $_[0]->counter("simcount"); }
sub remotenodecount($)	{ return $_[0]->counter("remotecount"); }
sub sharednodecount($)	{ return $_[0]->counter("sharedcount"); }

sub createLink($$$$$$$$$)
{
    # $others here will be a hashtable for the link flags.  The table
    # could also contain non-default values for latency and
    # packet_loss
    my ($self, $name, $plink, $cm, $src, $dst, $bw, $type, $others) = @_;
    my $ref = {
	'virtual_id'     => $name,
	'plink'		 => $plink,
	'manager_urn'    => $cm,
	'link_type'      => $type,
	'interface_ref'  => [$src, $dst],
	'capacity'       => $bw,
	'packet_loss'    => "0",
	'latency'        => "0"
    };
    
    if ($others) {
	while ( my ($key, $value) = each %{$others} ) {
	    $ref->{$key} = $value;
	}
    }
    if (!exists($self->rspec()->{'link'})) {
	$self->rspec()->{'link'} = [];
    }
    push(@{ $self->rspec()->{'link'} }, $ref);
}

sub createNode ($$$$$$$;$)
{
    # $others here will be a hashtable for the desires
    # The key will be the desire name and the value will be a pair
    # of the desire type and the penalty
    my ($self, $name, $cm, $type, $typecount, $desires, $others, $ifaces) = @_;
    my $ref = {
	'virtual_id'    => $name,
	'manager_urn'   => $cm,
    };
    
    my $typename = $type;
    my $typeslots = $typecount;
    my $isstatic = 0;
    if ($typename =~ /^\*([-\w]*)$/) {
	$typename = $1;
	$isstatic = 1;
    }
    if ($typecount eq '*') {
	$typeslots = 'unlimited';
    }

    # We will need this to generate interface names later
    $ref->{'interface_count'} = 0;
    $ref->{'interfaces'} = $ifaces;

    $ref->{'node_type'} = $typename;
    $ref->{'type_slots'} = $typecount;
    $ref->{'node_static'} = $isstatic;

    my $desiretable = {};
    if ($desires) {
	while ( my ($key, $value) = each %{$desires} ) {
	    $desiretable->{$key} = $value;
	}
    }
    $ref->{'desires'} = $desiretable;
    
    if ($others) {
	while ( my ($key, $value) = each %{$others} ) {
	    $ref->{$key} = $value;
	}
    }
    
    if (!exists($self->rspec()->{'node'})) {
	$self->rspec()->{'node'} = [];
    }
    push(@{ $self->rspec()->{'node'} }, $ref);
}

sub createVClass ($$$$)
{
    my ($self, $name, $weight, $members) = @_;
    my $ref = {
	'name'    => $name,
	'weight'  => $weight,
	'members' => $members
    };
    if (!exists($self->rspec()->{'vclass'})) {
	$self->rspec()->{'vclass'} = [];
    }
    push(@{ $self->rspec()->{'vclass'} }, $ref);
}

sub createFixedNode ($$$)
{
    my ($self, $vnode, $pnode) = @_;
    my $ref = { 'vnode' => $vnode,
		# XXX Going to need a URN in rspec output ...
		'pnode' => $pnode,
    };
    if (!exists($self->rspec()->{'fixed'})) {
	$self->rspec()->{'fixed'} = [];
    }
    push(@{ $self->rspec()->{'fixed'} }, $ref);
}

###############################################################################
# Virtual Nodes. A separate package so we can create objects for each one
# and then add local stuff to them.
#
package libvtop::virt_node;
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_node()->$name();
    }
}

#
# Wrap up a virt node.
#
sub Create($$$)
{
    my ($class, $vtop, $virt_node) = @_;

    my $self = {};
    bless($self, $class);

    $self->{'VIRTNODE'}   = $virt_node;
    $self->{'VTOP'}       = $vtop;
    $self->{'HASH'}       = {};
    # The virtlans this virtnode is a member of. 
    $self->{'MEMBERSHIP'} = {};
    
    return $self;
}
# accessors
sub virt_node($)	{ return $_[0]->{'VIRTNODE'}; }
sub vtop($)		{ return $_[0]->{'VTOP'}; }
sub hash($)		{ return $_[0]->{'HASH'}; }
sub membership($)       { return $_[0]->{'MEMBERSHIP'}; }
sub memberlist($)       { return values(%{ $_[0]->{'MEMBERSHIP'} }); }

# Break circular reference someplace to avoid exit errors.
sub DESTROY {
    my $self = shift;

    $self->{'VIRTNODE'}   = undef;
    $self->{'VTOP'}       = undef;
    $self->{'HASH'}       = undef;
    $self->{'MEMBERSHIP'} = 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->{'MEMBERHASH'}    = {};
    $self->{'MEMBERLIST'}    = [];
    $self->{'SHAPEDMEMBERS'} = {};
    $self->{'HASH'}          = {};

    return $self;
}
# accessors
sub virt_lanlan($)	{ return $_[0]->{'VIRTLANLAN'}; }
sub members($)		{ return $_[0]->{'MEMBERHASH'}; }
sub memberlist($)       { return @{ $_[0]->{'MEMBERLIST'} }; }
sub member($$)          { return @{ $_[0]->{'MEMBERLIST'} }[$_[1]]; }
sub shapedmembers($)	{ return $_[0]->{'SHAPEDMEMBERS'}; }
sub vtop($)		{ return $_[0]->{'VTOP'}; }
sub hash($)		{ return $_[0]->{'HASH'}; }
sub islink($)           { return (@{ $_[0]->{'MEMBERLIST'} } == 2 ? 1 : 0); }

# Break circular reference someplace to avoid exit errors.
sub DESTROY {
    my $self = shift;

    $self->{'VIRTLANLAN'} = undef;
    $self->{'MEMBERHASH'} = undef;
    $self->{'MEMBERLIST'} = undef;
    $self->{'VTOP'}       = undef;
    $self->{'HASH'}       = undef;
}

sub Stringify($)
{
    my ($self) = @_;
    my $vname  = $self->vname();

    return "[vlan:$vname]";
}

sub addmember($$)
{
    my ($self, $vlanmember) = @_;
    
    $self->members()->{$vlanmember->member()} = $vlanmember;

    @{ $self->{'MEMBERLIST'} }[$vlanmember->vindex()] = $vlanmember;

    return 0;
}

#
# Other support functions.
#
sub usevirtiface($)
{
    my ($self) = @_;
    my $encap  = $self->_encapstyle();

    return ($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;
    $member->_shaped(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', 'eq' => 'StringEQ');

# 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";
}

sub StringEQ($$)
{
    my ($self, $other) = @_;

    return ($self->Stringify() eq "$other" ? 1 : 0);
}

sub usevirtiface($)
{
    my ($self) = @_;
    my $encap  = $self->_encapstyle();

    return ($encap eq "veth-ne" || $encap eq "vlan");
}

###############################################################################
# Virtual Paths This wraps up the virt_paths table
#
package libvtop::virt_path;
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_path()->$name();
    }
}

#
# Wrap up a virt path
#
sub Create($$$$)
{
    my ($class, $vtop, $pathname, $layer) = @_;

    my $self = {};
    bless($self, $class);

    $self->{'PATHNAME'}      = $pathname;
    $self->{'LAYER'}         = $layer;
    $self->{'VTOP'}          = $vtop;
    $self->{'MEMBERHASH'}    = {};
    $self->{'MEMBERLIST'}    = [];
    $self->{'VIRTLANHASH'}   = {};
    $self->{'VIRTLANLIST'}   = [];
    $self->{'IMPLEMENTS'}    = {};
    $self->{'HASH'}          = {};

    return $self;
}
# accessors
sub pathname($)		{ return $_[0]->{'PATHNAME'}; }
sub layer($)		{ return $_[0]->{'LAYER'}; }
sub members($)		{ return $_[0]->{'MEMBERHASH'}; }
sub memberlist($)       { return @{ $_[0]->{'MEMBERLIST'} }; }
sub virtlanlist($)      { return @{ $_[0]->{'VIRTLANLIST'} }; }
sub member($$)		{ return $_[0]->{'MEMBERLIST'}->[$_[1]]; }
sub lanlink($$)		{ return $_[0]->{'VIRTLANLIST'}->[$_[1]]; }
sub vtop($)		{ return $_[0]->{'VTOP'}; }
sub hash($)		{ return $_[0]->{'HASH'}; }
sub implements($)	{ return $_[0]->{'IMPLEMENTS'}; }

# Break circular reference someplace to avoid exit errors.
sub DESTROY {
    my $self = shift;

    $self->{'LAYER'}      = undef;
    $self->{'PATHNAME'}   = undef;
    $self->{'MEMBERHASH'} = undef;
    $self->{'MEMBERLIST'} = undef;
    $self->{'VIRTLANHASH'} = undef;
    $self->{'VIRTLANLIST'} = undef;
    $self->{'VTOP'}       = undef;
    $self->{'IMPLEMENTS'} = undef;
    $self->{'HASH'}       = undef;
}

sub Stringify($)
{
    my ($self) = @_;
    my $vname  = $self->pathname();
    my $layer  = $self->layer();

    return "[vpath:$vname:$layer]";
}

sub addmember($$$)
{
    my ($self, $vpath, $virtlan) = @_;
    
    $self->members()->{$vpath->segmentname()} = $vpath;
    $self->{'VIRTLANHASH'}->{$vpath->segmentname()} = $virtlan;
    # We care about this ordering.
    $self->{'MEMBERLIST'}->[$vpath->segmentindex()]  = $vpath;
    $self->{'VIRTLANLIST'}->[$vpath->segmentindex()] = $virtlan;
    return 0;
}

sub firstmember($)
{
    my ($self) = @_;

    # The lanlink for the first segment.
    my $virtlan = $self->lanlink(0);

    # Both members of a link.
    my ($member0,$member1) = $virtlan->memberlist();

    # The first member.
    return $member0;
}

sub lastmember($)
{
    my ($self) = @_;

    # The lanlink for the last segment.
    my $virtlan = $self->lanlink(scalar($self->memberlist()) - 1);

    # Both members of a link.
    my ($member0,$member1) = $virtlan->memberlist();

    # The last member.
    return $member1;
}

sub addimplements($$)
{
    my ($self, $virtlan) = @_;

    $self->implements()->{$virtlan->vname()} = $virtlan;
}
sub doesimplement($$)
{
    my ($self, $virtlan) = @_;

    return exists($self->implements()->{$virtlan->vname()});
}

#############################################################################
# Back to the main package.
#
package libvtop_test;

#
# 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)) {
	    warn("No type info for node type $node_type\n");
	    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"})) {
	    warn("No protocols listed in capabilities for $iface_type!\n");
	    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)) {
		warn("No default speed in capabilites for $iface_type!\n");
		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;
		}
	    }
	}
    }

    #
    # Ug, it just gets worse and worse. We also need to map between the
    # auxtypes that a node (its physical type) can take on. For example,
    # a link between two pcvm nodes is really a link between a pc600 and
    # pc850.
    #
    $query_result =
	DBQueryFatal("select distinct n.type,at.type from node_auxtypes as at ".
		     "left join nodes as n on n.node_id=at.node_id");

    while (my ($phystype, $auxtype) = $query_result->fetchrow()) {
	next
	    if (!exists($node_type_linkbw{$phystype}));
	
	$node_type_linkbw{$auxtype} = $node_type_linkbw{$phystype};
    }

    #
    # Here it goes getting even worse - we have to do a similar thing for
    # vtypes.
    #
    foreach my $ref ($self->VirtTypes()) {
	my $vtype   = $ref->name();
	my @members = split(" ", $ref->members());

	foreach my $phystype (@members) {
	    next
		if (!exists($node_type_linkbw{$phystype}));

	    $node_type_linkbw{$vtype} = {}
	        if (!defined($node_type_linkbw{$vtype}));

	    foreach my $protocol (keys(%{ $node_type_linkbw{$phystype} })) {
		my @list = keys(%{ $node_type_linkbw{$phystype}{$protocol} });
		foreach my $speed (@list) {
		    $node_type_linkbw{$vtype}{$protocol}->{$speed} = 1;
		}
	    }
	}
    }

    if ($self->verbose()) {
	$self->printdb("Interface Speeds:\n");
	foreach my $type (keys(%node_type_linkbw)) {
	    foreach my $protocol (keys(%{ $node_type_linkbw{$type} })) {
		my @list = keys(%{ $node_type_linkbw{$type}{$protocol} });

		$self->printdb(" $type:$protocol - @list\n");
	    }
	}
    }
    
    $self->{'IFACECAPS'}  = \%interface_capabilities;
    $self->{'TYPELINKBW'} = \%node_type_linkbw;
    
    return 0;
}
sub interfacespeedmbps($$$)
{
    my ($self, $type, $which) = @_;
        
    return $self->{'IFACECAPS'}->{$type}->{"${which}_defspeed"}/1000.0;
}

#
# When updating with fixednodes turned on, we need the current set
# of nodes that need to be fixed.
#
sub LoadCurrentResources($)
{
    my ($self) = @_;

    $self->counters()->{'reserved_simcount'}  = 0;
    $self->counters()->{'reserved_virtcount'} = 0;
    $self->counters()->{'reserved_physcount'} = 0;

    $self->printdb("Loading current resources" .
		   ($self->regression() ? " in regression mode" : "") . "\n");

    my @nodelist = $self->experiment()->NodeList(0, 1);
    return 0
	if (!@nodelist);

    if ($self->regression()) {
	#
	# In regression mode, we just store the p2v mapping for fixnode.
	#
	foreach my $pnode (@nodelist) {
	    my $vname   = $pnode->vname();
	    my $node_id = $pnode->node_id();

	    if ($pnode->isvirtnode()) {
		$node_id = $pnode->phys_nodeid();
	    }
	    $self->fixednodes()->{$vname} = $node_id;
	    $self->printdb("  fixing $vname -> $node_id\n");
	}
	return 0;
    }

    foreach my $pnode (@nodelist) {
	my $vname   = $pnode->vname();
	my $node_id = $pnode->node_id();
	my $rsrv    = $pnode->ReservedTableEntry();

	# A list of vnodes on this pnode.
	$self->current_p2v()->{$pnode->phys_nodeid()} = []
	    if (! exists($self->current_p2v()->{$pnode->phys_nodeid()}));
	$self->pnodes()->{$node_id} = $pnode;

	#
	# WIDEAREA nodes are going to break.
	#
	if ($pnode->isremotenode() &&
	    !($pnode->isplabdslice() || $pnode->isfednode() ||
	      $pnode->isdedicatedremote())) {
	    tberror("Cannot update widearea nodes yet!\n");
	    return -1;
	}
	if ($pnode->isvirtnode()) {
	    $self->counters()->{'reserved_virtcount'}++;

	    # Get the underlying physical node.
	    my $ppnode = Node->Lookup($pnode->phys_nodeid());
	    if (!defined($ppnode)) {
		tberror("Cannot map $pnode to its real physnode");
		return -1;
	    }
	    my $ppnode_id = $ppnode->node_id();

	    $self->fixednodes()->{$vname} = $ppnode_id
		if ($self->fixcurrent());
	    
	    #
	    # Record the mappings. 
	    #
	    $self->current_v2v()->{$vname} = $pnode->node_id();
	    $self->current_v2p()->{$vname} = $ppnode->node_id();
	    push(@{ $self->current_p2v()->{$ppnode->node_id()} }, $vname);
	    
	    # Mark the node as unused until later.
	    $pnode->_reuse("unused");
	    $ppnode->_reuse("unused");

	    #
	    # Add the pnode node to the oldreserved list for nfree.
	    # See the comment below. We cannot use p2v because we
	    # might not own all those nodes, if on a shared node.
	    # We do not add the ppnode. It will get added in the
	    # next clause if we actually own it.
	    #
	    $self->oldreservednodes()->{$pnode->node_id()} = $pnode;
	    
	    $self->printdb("current v2p: $node_id ($ppnode_id) -> $vname\n");
	}
	else {
	    #
	    # All the sim stuff is bit rotting cause no one understands it.
	    #
	    if ($rsrv->{'erole'} eq TBDB_RSRVROLE_SIMHOST) {
		tberror("Cannot update sim nodes yet!\n");
		return -1;
	    }
	    else {
		$self->fixednodes()->{$vname} = $pnode->node_id()
		    if ($self->fixcurrent());
		
		$self->counters()->{'reserved_physcount'}++;

		#
		# Record the mapping. 
		#
		$self->current_v2p()->{$vname} = $pnode->node_id();
		push(@{ $self->current_p2v()->{$node_id} }, $vname);
		# Mark the node as unused until later.
		$pnode->_reuse("unused");

		#
		# Add the pnode node to the oldreserved list for nfree.
		# See the comment below. We cannot use p2v because we
		# might not own all those nodes, if on a shared node.
		#
		$self->oldreservednodes()->{$pnode->node_id()} = $pnode;

		$self->printdb("current v2p: $node_id -> $vname\n");
	    }
	}
    }
    return 0;
}

sub LoadVirtNodes($)
{
    my ($self) = @_;
    my $gotgeninodes = 0;

    $self->printdb("Loading virtual nodes\n");

    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 $desires  = {};
	my $startloc = undef;

	# Other fields we need.
	my $ips     = $vnode->ips() || "";
	my $type    = $vnode->type();
	my $fixed   = $vnode->fixed();
	my $osname  = $vnode->osname();
	my $parent_osname  = $vnode->parent_osname();

	# XXX
	# If its a vtype, there will not be any node_type data. This
	# can break things, if one were to mix a virt/remote type with
	# a nonvirt/local type! Need to actually verify the vtypes
	# for consistency. 
	#
	my $isremote= 0;
	my $isvirt  = 0;
	my $issub   = 0;
	my $isplab  = 0;
	my $issim   = 0;
	my $isdyn   = 0;	# Only virtnodes are dynamic.
	my $isvtyped= 0;
	my $isded   = 0;
	my $isgeni  = 0;

	# If we have a real type or auxtype ...
	my $nodetype = NodeType->LookupAny($type);
	if (!defined($nodetype)) {
	    my $vtype = $self->virttypeisvtype($type);
	    if (!defined($vtype)) {
		warn("Improper type $type for node $vnode!\n");
		return -1;
	    }
	    #
	    # For now, just pick the first member type.
	    #
	    my @memberlist = split(" ", $vtype->members());
	    my $vtypename  = $memberlist[0];

	    $nodetype = NodeType->LookupAny($vtypename);
	    if (!defined($nodetype)) {
		warn("Improper type $vtypename in vtypes for node $vnode!\n");
		return -1;
	    }
	    $isvtyped = 1;
	}
	$vnode->_typeinfo($nodetype);
	
	$isremote = $nodetype->isremotenode();
	$isvirt   = $nodetype->isvirtnode();
	$issub    = $nodetype->issubnode();
	$isplab   = $nodetype->isplabdslice();
	$isgeni   = $nodetype->isfednode();
	$issim    = $nodetype->issimnode();
	$isdyn    = $nodetype->isdynamic();
	$isded    = $nodetype->isdedicatedremote();

	# Mark this as being a virtual typed node.
	$vnode->_isvtyped($isvtyped);

	# dynamic inclusion below.
	$gotgeninodes++ if ($isgeni);

	# All this info is stashed in our local object.
	$vnode->_nodeweight(undef);
	$vnode->_isremotenode($isremote);
	$vnode->_isvirtnode($isvirt);
	$vnode->_issubnode($issub);
	$vnode->_isplabnode($isplab);
	$vnode->_isgeninode($isgeni);
	$vnode->_issimnode($issim);
	$vnode->_isdynamic($isdyn);
	$vnode->_isdedremote($isded);
	# Set below from a desire.
	$vnode->_sharedokay(0);
	$vnode->_fixedvm(undef);
	$vnode->_isbridge(($vnode->role() eq "bridge" ? 1 : 0));

	# For a list of interfaces on this node, as for rspec generation
	$vnode->_virtifaces([]);

	# dynamic inclusion below.
	$gotgeninodes++ if ($isgeni);

	# The mapped osname to actual osinfo structure.
	$vnode->_osinfo(undef);
	# If the virtnode tries to specify its parent os in addition
	# to its own, store that osinfo here.
	$vnode->_parent_osinfo(undef);
	# Eventual physical mapping. 
	$vnode->_physnode(undef);
	# Handy to combine these.
	$vnode->_settings([ $vnode->cmd_line(),
			    $vnode->rpms(),
			    $vnode->startupcmd(),
			    $vnode->tarfiles(),
			    $vnode->loadlist(),
			    $vnode->failureaction(),
			    $vnode->routertype() ]);

	#
	# If a subnode, kill the fixed mapping. That was just to
	# tell us the connection. We do not want to overload "fixed"
	# within assign wrapper since its already overloaded.
	#
	if ($issub) {
	    # Must be a parent. Set in the parser, either explicitly, or else
	    # one is created if the user leaves it out.
	    if (!defined($fixed) || $fixed eq "") {
		warn("Subnode $vname must be fixed to its parent!\n");
		return -1;
	    }
	    $vnode->_parent($fixed);
	    $vnode->fixed(undef);
	    undef($fixed);
	}

	# Can fixed really get set to ""?
	if (defined($fixed) && $fixed ne "") {
	    # Store the name since we use FIXED_NODES for delay nodes too.
	    $self->fixednodes()->{$vname} = $fixed;

	    # We do not know until all the nodes are loaded, if fixing
	    # to a physical node or another node in the topology. See
	    # the post pass loop below.
	    $vnode->_fixedvm($fixed)
		if ($isvirt && !$isgeni);
	}
	else {
	    $vnode->fixed(undef);
	    undef($fixed);
	}

	# For the moment, geni nodes must be bound to a CM.
	if ($isgeni) {
	    if (!defined($fixed) || $fixed eq "") {
		tberror("Geninode $vnode must be fixed to a CM.");
		return -1;
	    }
	    my ($authority,$gtype,undef) = GeniHRN::Parse($fixed);
	    #
	    # We allow an authority instead of a node urn. This is just a
	    # kludge so I can test against the AM interface. 
	    #
	    if ($gtype eq "node") {
		$vnode->_cmurn(GeniHRN::Generate($authority,
						 "authority", "cm"));
	    }
	    elsif ($gtype eq "authority") {
		$vnode->_cmurn($fixed);
		$fixed = GeniHRN::Generate($authority, "node", "*");
		$vnode->fixed($fixed);
	    }
	}
	else {
	    $vnode->_cmurn($mycmurn);
	}

	$self->printdb("  $vname type:$type ips:$ips\n");
	$self->printdb("         isrem:$isremote isvirt:$isvirt");
	$self->printdb(" fixed:$fixed")
	    if (defined($fixed) && $fixed ne "");
	$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);
	}

	# Take apart the IP list.
	my @iplist  = split(" ", $ips);
	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);
	}
	elsif ($isvirt) {
	    my $osinfo;
	    if ($nodetype->type() eq "pcvm") {
		# Silly default.
		$osinfo = OSinfo->LookupByName("OPENVZ-STD");
	    }
	    else {
		# Grab it from the typeinfo.
		$osinfo = OSinfo->Lookup($nodetype->default_osid());
	    }
	    $vnode->_osinfo($osinfo);
	}

	#
	# Map the parent_osname to an OSID now.
	#
	if (defined($parent_osname) && $parent_osname ne "") {
	    my $osinfo = OSinfo->Lookup("$pid,$parent_osname");
	    if (!defined($osinfo)) {
		$osinfo = OSinfo->LookupByName($parent_osname);

		if (!defined($osinfo)) {
		    tberror({cause => 'user', type => 'primary',
			     severity => SEV_ERROR,
			     error => ['invalid_os', undef, $parent_osname, $pid]},
			    "Invalid parent OS $parent_osname in project $pid!");
		    return -1;
		}
	    }
	    $vnode->_parent_osinfo($osinfo);
	}

	#
	# Add in desires.
	#
	foreach my $desire ($self->virt_desires()->Rows()) {
	    next
		if ($desire->vname() ne $vname);
	    
	    $desires->{$desire->desire()} = $desire->weight();

	    # User says a shared node is okay. We need this info later
	    # when generating links/lans for the vtop.
	    $vnode->_sharedokay(1)
		if ($isvirt && $desire->desire() eq "pcshared");
	}
	$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);

	# Counters
	$self->{'COUNTERS'}->{'nodecount'}++;
	$self->{'COUNTERS'}->{'simcount'}++
	    if ($issim);
	$self->{'COUNTERS'}->{'remotecount'}++
	    if ($isremote);
	$self->{'COUNTERS'}->{'virtcount'}++
	    if ($isvirt);
	$self->{'COUNTERS'}->{'plabcount'}++
	    if ($isplab);
	$self->{'COUNTERS'}->{'genicount'}++
	    if ($isgeni);
	$self->{'COUNTERS'}->{'physcount'}++
	    if (!$issim && !$isvirt);
	$self->{'COUNTERS'}->{'sharedcount'}++
	    if ($isvirt && $vnode->_sharedokay());
	# stats
	my $ipcount = scalar(@iplist);

	$self->exptstats()->{"maxlinks"} = $ipcount
	    if ($ipcount > $self->exptstats()->{"maxlinks"});
	$self->exptstats()->{"minlinks"} = $ipcount
	    if ($ipcount < $self->exptstats()->{"minlinks"});

	# Add to the list.
	$self->vnodes()->{$vname} = $vnode;
    }
    if ($gotgeninodes) {
	if ($PGENISUPPORT) {
	    require libGeni;
	    require GeniXML;
	    import GeniXML;
	}
	else {
	    tberror("Using geni nodes but PROTOGENI_SUPPORT is not defined\n");
	    return -1;
	}
    }

    #
    # Go back and look for any VMs that were fixed to nodes. Need to make
    # the OS consistent.
    #
    foreach my $vname (sort(keys(%{ $self->{'VNODES'} }))) {
	my $vnode = $self->vnodes()->{$vname};
	my $osid;

	next
	    if ($vnode->_isgeninode());

	next
	    if (! ($vnode->_isvirtnode() && $vnode->_fixedvm()));
	
	my $fixnode = $self->vnodes()->{$vnode->_fixedvm()};
	#
	# If the node is fixed to a physical node, skip. This is a
	# plain old fixnode operation, not our new support for fixing
	# a VM to a real node in the topology.
	#
	if (!defined($fixnode)) {
	    # Lets make sure its a real node.
	    my $fixvname = $vnode->_fixedvm();
	    
	    if (!defined(Node->Lookup($fixvname))) {
		tberror("Cannot fix $vnode to $fixvname; No such node\n");
		return -1;
	    }
	    $vnode->_fixedvm(undef);
	    next;
	}

	if (defined($vnode->_parent_osinfo())) {
	    $osid = $vnode->_parent_osinfo()->osid();
	}
	else {
	    $osid  = ($self->option("jail_osid") ||
		      $self->nodejailosid($vnode));
	}
	return -1
	    if (!defined($osid));
	my $osinfo = OSinfo->Lookup($osid);
	return -1
	    if (!defined($osinfo));
	
	$fixnode->_osinfo($osinfo);
	# Convert from the name to the local object.
	$vnode->_fixedvm($fixnode);

	$self->printdb("Fixing VM $vname to $fixnode, $osinfo\n");
    }
    
    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;
	    $virtlan->_accesspoint(undef);
	}

	# 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->addmember($vlanmember);

	# Global map from vnode:port back to the lan object
	$self->memberof()->{$vlanmember->member()} = $virtlan;

	# Each virt_node has a list of all virt_lans it belongs to.
	$vlanmember->virt_node()->membership()->{"$virtlan"} = $virtlan;

	# Other fields we need below
	my $delay          = $vlanmember->delay();
	my $bandwidth      = $vlanmember->bandwidth();
	my $est_bandwidth  = $vlanmember->est_bandwidth();
	my $backfill       = $vlanmember->backfill();
	my $lossrate       = $vlanmember->lossrate();
	my $rdelay         = $vlanmember->rdelay();
	my $rbandwidth     = $vlanmember->rbandwidth();
	my $rest_bandwidth = $vlanmember->rest_bandwidth();
	my $rbackfill      = $vlanmember->rbackfill();
	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();
	my $ip             = $vlanmember->ip();
	my $layer          = $vlanmember->layer();
	my $implemented_by = $vlanmember->implemented_by_path();
	my $fixed_iface    = $vlanmember->fixed_iface();
	my ($vname,$vport) = split(":", $vlanmember->member());

	# virt_nodes:ips is actually deprecated; this overrides it.
	$self->{'IPS'}->{"$vname:$vport"} = $ip;

	#
	# 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->_layer($layer);
	$virtlan->_accesspoint($vlanmember)
	    if ($vlanmember->is_accesspoint());
	$virtlan->_sharednodes(0);
	$virtlan->_geninodes(0);
	$virtlan->_implemented_by($implemented_by);
	$virtlan->_vpath(undef);
	$virtlan->_bridged(0);
	
	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,
				  $backfill,
				  $lossrate,
				  $rdelay,
				  $rbandwidth,
				  $rest_bandwidth,
				  $rbackfill,
				  $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() ]);

	#
	# This will get set on a per-member basis when it is determined
	# that the link is getting a delaynode cause its really being
	# shaped, or because it is being traced or monitored.
	#
	$virtlan->shapedmembers()->{"$vlanmember"} = 0;
	$vlanmember->_shaped(0);
	$virtlan->_delayed(0);
	$vlanmember->_bridged(0);

	#
	# XXX - Whenever a delay node is inserted, port speeds are set to
	#       the next fastest interface type we have, even if they requested
	#       exactly some speed that can be done without a delay node such
	#       as 10Mbs or 100Mbs. This is a simplification. At some point we
	#       might want to force all the ports along the way to 10Mbs, and
	#       have the delay node worry about delay only, and not bandwidth.
	#       That will be harder to to do in this mess. See companion XXX
	#       below where the delays table is initialized. Initially, we set
	#       the speed to 10Mbs, if a delay node is insterted below, it
	#       resets this to 100Mbs.
	#
	my $portbw = $self->getbandwidth($vlanmember, $virtlan, $bandwidth);
	$self->portbw()->{"$vlanmember"} = $portbw;
	
	$self->printdb("  $vlanname $vlanmember portbw:$portbw - ".
		       "$delay $bandwidth $lossrate ".
		       "$rdelay $rbandwidth $rlossrate\n");

	# Temporary, for generating rspecs.
	push(@{ $vlanmember->virt_node()->_virtifaces() }, $vlanmember);

	# Terrible.
	$vlanmember->_reservebw(0);
	$vlanmember->_needtrunk(0);
	if ($vlanmember->virt_node()->type() eq "sppvm" ||
	    $vlanmember->virt_node()->type() eq "bbgenivm") {
	    $vlanmember->_reservebw($bandwidth);
	    $vlanmember->_needtrunk(1);
	    $vlanmember->_nobwshaping(1);
	    $self->printdb("  Forcing $vlanmember to reserve shared bandwidth\n");
	}
    }

    #
    # Load up the virt_bridges.
    #
    foreach my $virt_bridge ($self->virt_bridges()->Rows()) {
	my $bridgename = $virt_bridge->vname();
	my $bridgevlan = $virt_bridge->vlink();
	my $bridgeport = $virt_bridge->vport();

	if (!exists($self->vlans()->{$bridgevlan})) {
	    tberror("virt_bridge: no such vlan $bridgevlan\n");
	    return -1;
	}
	if (!exists($self->vnodes()->{$bridgename})) {
	    tberror("virt_bridge: no such node $bridgename\n");
	    return -1;
	}
	my $memberof = $self->memberof()->{"$bridgename:$bridgeport"};
	if (!defined($memberof)) {
	    tberror("virt_bridge: ".
		    "$bridgename:$bridgeport is not in $bridgevlan\n");
	    return -1;
	}
	my $vlan = $self->vlans()->{$bridgevlan};
	my $member = $vlan->members()->{"$bridgename:$bridgeport"};

	$self->bridges()->{$bridgename} = {}
	    if (!exists($self->bridges()->{$bridgename}));

	# Store the list of members of this bridge. We assume that
	# a lan is not in a bridge more then once.
	$self->bridges()->{$bridgename}->{"$member"} = $member;
    }

    #
    # Check the bridge requests and set the cross links.
    #
    foreach my $virtlan (values(%{ $self->vlans() })) {
	foreach my $member ($virtlan->memberlist()) {
	    next
		if (!defined($member->bridge_vname()));

	    my $bridge_vname = $member->bridge_vname();
	    if (!exists($self->bridges()->{$bridge_vname})) {
		tberror("$virtlan: no such bridge $bridge_vname\n");
		return -1;
	    }
	    if (!$member->virt_node()->_isbridge()) {
		tberror("$member is bridged but is not a bridge\n");
		return -1;
	    }
	    my $bridged_member = $self->bridges()->{$bridge_vname}->{"$member"};
	    if (!defined($bridged_member)) {
		tberror("$member is bridged to nonexistent member\n");
		return -1;
	    }
	    $member->_bridged(1);
	    $virtlan->_bridged(1);
	    $self->printdb("$virtlan bridge: $member to $bridged_member\n");

	    #
	    # Check tracing. Only on links attached to the bridge.
	    # One side might be a lan, but tracing is allowed on the
	    # link side only. This mirrors the delay node impl, where
	    # tracing is done only at ingress to the lan.
	    #
	    if ($member->traced() && !$virtlan->islink()) {
		tberror("$member is traced, but $virtlan is not a link\n");
		return -1;
	    }
	}
    }
    
    #
    # Load the virt paths.
    #
    foreach my $vpath ($self->virt_paths()->Rows()) {
	my $pathname     = $vpath->pathname();
	my $segmentname  = $vpath->segmentname();
	my $segmentindex = $vpath->segmentindex();
	my $layer        = $vpath->layer();

	# Local wrapper for virt_path table entry;
	my $virtpath = $self->vpaths()->{$pathname};
	if (!defined($virtpath)) {
	    $virtpath = libvtop::virt_path->Create($self, $pathname,$layer);
	    # Add it to the toplevel list of paths.
	    $self->vpaths()->{$pathname} = $virtpath;
	}

	# Find the link this path segment refers to.
	my $virtlan = $self->vlans()->{$vpath->segmentname()};
	if (!defined($virtlan)) {
	    tberror("Cannot virtlan $segmentname in $virtpath\n");
	    return -1;
	}
	# All the segments in the path must be the same layer.
	if ("$layer" ne $virtpath->layer()) {
	    tberror("Path layer mismatch: $segmentname in $virtpath\n");
	    return -1;
	}
	# MLE Constraint:
	#  * A link cannot be in two paths at once. 
	#
	if (defined($virtlan->_vpath())) {
	    my $ovpath = $virtlan->_vpath();
	    tberror("$vpath: $virtlan is already in path $ovpath\n")
	}
	$virtlan->_vpath($virtpath);
	$virtpath->addmember($vpath, $virtlan);

	$self->printdb("$virtpath segment: $virtlan\n");
    }
    #
    # Now sanity check the implemented_by relationships to make sure they
    # are layered properly.
    #
    foreach my $virtlan (values(%{ $self->vlans() })) {
	my $implemented_by = $virtlan->_implemented_by();

	next
	    if (!defined($implemented_by));

	my $vpath = $self->vpaths()->{$implemented_by};
	if (!defined($vpath)) {
	    tberror("Could not find path $implemented_by for $virtlan");
	    return -1;
	}
	if ($vpath->layer() == $virtlan->_layer() && $vpath->layer() != 2) {
	    tberror("Path $vpath at the same layer as $virtlan");
	    return -1;
	}
	if ($vpath->layer() > $virtlan->_layer()) {
	    tberror("Path $vpath at a higher layer then $virtlan");
	    return -1;
	}
	#
	# MLE Constraints;
	#  * Any link that is implemented by something can have only
	#    two members (a duplex link).
	#  * Endpoint equivalence: The first and last nodes of the link
	#    must be the same as the first and last nodes of the path.
	#    This constraint is very important; it means we have to solve
	#    *just* the lowest layer with assign, and everything is plopped
	#    down on top of that.
	#
	if (scalar($virtlan->memberlist()) != 2) {
	    tberror("$virtlan is implemented by $vpath, but is not a link");
	    return -1;
	}
	my ($member0,$member1) = $virtlan->memberlist();
	my $virtnode0 = $member0->virt_node();
	my $virtnode1 = $member1->virt_node();
	# Look for VMs that have been "fixed" to another node.
	if ($virtnode0->fixed()) {
	    $virtnode0 = $self->vnodes()->{$virtnode0->fixed()};
	}
	if ($virtnode1->fixed()) {
	    $virtnode1 = $self->vnodes()->{$virtnode1->fixed()};
	}
	my $firstnode = $vpath->firstmember()->virt_node();
	my $lastnode  = $vpath->lastmember()->virt_node();

	if ("$virtnode0" ne "$firstnode") {
	    tberror("First node of $vpath is not the same as $virtlan ".
		    "$virtnode0, $firstnode, $member0, $member1\n");
	    return -1;
	}
	if ("$virtnode1" ne "$lastnode") {