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

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_REGRESSION);

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

use libdb;
use libtblog;
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;

# 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@;

if ($PGENISUPPORT) {
    require libGeni;
    require GeniHRN;
}

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

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

#
# 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->{'VLANS'}      = {};
    $self->{'MEMBEROF'}   = {};
    $self->{'COUNTERS'}   = {};
    $self->{'EXPTSTATS'}  = {};
    $self->{'DELAYLINKS'} = {};
    $self->{'OPTIONS'}    = {};
    $self->{'DELAYID'}    = 0;
    $self->{'PHOSTID'}    = 0;
    $self->{'IFACEID'}    = 32768;
    $self->{'PORTBW'}     = {};
    $self->{'RESULTS'}    = { "nodes"  => [],
			      "links"  => [],
			      "class"  => [],
			      "fixed"  => [] };
    $self->{'RSPEC'}      = 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);

    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 lannodes($)         { return $_[0]->{'LANNODES'}; }
sub vlans($)            { return $_[0]->{'VLANS'}; }
sub memberof($)         { return $_[0]->{'MEMBEROF'}; }
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 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 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_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 regression($)	{ return $_[0]->flags() & $VTOP_FLAGS_REGRESSION; }
sub printdb($$)		{ print $_[1] if ($_[0]->verbose()); }

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

# Results are stored until they are spit out in one of several formats.
sub addvclass($$)	{ push(@{$_[0]->results()->{"class"}}, $_[1]); }
sub addfixed($$)	{ push(@{$_[0]->results()->{"fixed"}}, $_[1]); }
# The reason for this funkyness is so output order is consistent with
# assign_wrapper when running in regression mode. 
sub addnode($$)		{ push(@{$_[0]->results()->{"nodeslinks"}},
			       ["node", $_[1]]); }
sub addlink($$)		{ push(@{$_[0]->results()->{"nodeslinks"}},
			       ["link", $_[1]]); }

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

###############################################################################
# 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'}     = {};
    
    return $self;
}
# accessors
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->{'VIRTNODE'}   = undef;
    $self->{'VTOP'}       = undef;
    $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->{'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 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->{'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;
    push(@{ $self->{'MEMBERLIST'} }, $vlanmember);

    return 0;
}

#
# 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)) {
	    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()) {
		$self->fixednodes()->{$vname} = $pnode->phys_nodeid();
	    }
	    else {
		$self->fixednodes()->{$vname} = $node_id;
	    }
	}
	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->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) = @_;

    $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);

	# 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);

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

	# 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->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($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;
	}

	$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) {
	    # Silly default.
	    my $osinfo = OSinfo->LookupByName("OPENVZ-STD");
	    $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'}->{'simcount'}++
	    if ($issim);
	$self->{'COUNTERS'}->{'remotecount'}++
	    if ($isremote);
	$self->{'COUNTERS'}->{'virtcount'}++
	    if ($isvirt);
	$self->{'COUNTERS'}->{'plabcount'}++
	    if ($isplab);
	$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;
    }
    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;

	# 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 $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->_accesspoint($vlanmember)
	    if ($vlanmember->is_accesspoint());
	$virtlan->_sharednodes(0);
	$virtlan->_geninodes(0);
	$virtlan->_needvlan(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;
	$virtlan->_delayed(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->_reservebw($bandwidth);
	    $vlanmember->_needtrunk(1);
	    $virtlan->_needvlan(1);
	    $self->printdb("  Forcing $vlanmember to reserve shared bandwidth\n");
	}
    }
    return 0;
}

#
# Dump the vtype list.
#
sub GenVirtTypes($)
{
    my ($self) = @_;
    my @types  = $self->VirtTypes();
    
    foreach my $vtype (@types) {
	my $name    = $vtype->name();
	my $weight  = $vtype->weight();
	my @members = split(" ", $vtype->members());

	$self->addvclass("$name $weight @members");
    }
    return 0;
}

#
# Dump the virt nodes.
#
sub GenVirtNodes($)
{
    my ($self) = @_;
    my $experiment = $self->experiment();
    my $pid    = $experiment->pid();
    my $eid    = $experiment->eid();

    foreach my $vname (sort(keys(%{ $self->{'VNODES'} }))) {
	my $vnode = $self->vnodes()->{$vname};
	my $type  = $vnode->type();

	#
	# Temporary rpsec generation.
	#
	if ($vnode->_isgeninode()) {
	    my @ifaces = @{ $vnode->_virtifaces() };

	    if (!defined($vnode->fixed()) || $vnode->fixed() eq "") {
		tberror("Geninode $vnode must be fixed to a CM.\n");
		return -1;
	    }
	    my $ref = { 'virtual_id'    => $vname,
			'component_urn' => $vnode->fixed(),
		      };
	    if ($vnode->_isvirtnode()) {
		$ref->{'virtualization_type'} = 'emulab-vnode';
		$ref->{'virtualization_subtype'} = 'emulab-openvz';
	    }
	    else {
		$ref->{'virtualization_type'} = 'raw';
		$ref->{'exclusive'} = 1;
	    }

	    if (@ifaces) {
		my @refs = ();
		foreach my $vlanmember (@ifaces) {
		    my $iface = {'virtual_id'   => "$vlanmember"};
		    
		    if ($vlanmember->fixed_iface() ne "") {
			$iface->{'component_id'}  = $vlanmember->fixed_iface();
		    }
		    push(@refs, $iface);
		}
		$ref->{'interface'} = [ @refs ];
	    }
	    if (!defined($self->rspec())) {
		$self->{'RSPEC'} = {
		    'generated_by' => 'libvtop',
		    'type'  => 'request',
		    'xmlns' => 'http://www.protogeni.net/resources/rspec/0.1',
		    'node'  => [] };
	    }
	    push(@{ $self->rspec()->{'node'} }, $ref);
	    next;
	}

	my $subnodestr = "";
	if ($vnode->_issubnode()) {
	    my $parent  = $vnode->_parent();
	    $subnodestr = "subnode_of:$parent";
	}
	my $desirestr = "";
	foreach my $desirename (keys(%{ $vnode->_desires() })) {
	    my $weight = $vnode->_desires()->{$desirename};
	    $desirestr .= " "
		if ($desirestr ne "");
	    $desirestr .= "$desirename:" . sprintf("%f",$weight);
	}
	if ($vnode->_isplabnode() && $experiment->cpu_usage()) {
	    # Yuck
	    $desirestr .= " +load:" . (($experiment->cpu_usage() - 1) / 5.0);
	}
	if ($self->updating()) {
	    $desirestr .= " already_reserved:.2";
	}
	if (defined($vnode->_startloc())) {
	    $desirestr .= " area-" . $vnode->_startloc() . ":1";
	}
	# Require that this vnode be placed onto a pnode that supports
	# the OS it is going to run. However, if the OS is one with a
	# 'path' (like an OSKit kernel), we don't have an entry in
	# osidtoimageid for it, and thus we leave it off of the desire list
	if (defined($vnode->_osinfo())) {
	    my $osinfo = $vnode->_osinfo();
	    #
	    # Support subOSes with a multi-OS desire.  Since the pnodes
	    # will have features like OS-parent and OS-parent-subos, we 
	    # generate desire to match.  Parent is major since then this 
	    # all works seamlessly with non-subos stuff.
	    # 
	    my $posinfo = $vnode->_parent_osinfo();

	    if ($vnode->_sharedokay()) {
		if (!defined($posinfo)) {
		    my $jailosid = $self->nodejailosid($vnode);
		
		    $desirestr .= " OS-$jailosid:1";
		}
		else {
		    $desirestr .= " OS-" . $posinfo->osid() . ":1";
		    $desirestr .= " OS-" . $posinfo->osid() . 
			"-" . $osinfo->osid() . ":1";
		}
	    }
	    elsif (!defined($osinfo->path()) || $osinfo->path() eq "") {
		if (!defined($posinfo)) {
		    $desirestr .= " OS-" . $osinfo->osid() . ":1";
		}
		else {
		    $desirestr .= " OS-" . $posinfo->osid() . ":1";
		    $desirestr .= " OS-" . $posinfo->osid() . 
			"-" . $osinfo->osid() . ":1";
		}
	    }
	}

	#
	# Now the type string, which might include some stuff for
	# simnodes that I do not understand. 
	#
	my $typestr = $type;
	if ($vnode->_issimnode()) {
	    my $query_result =
		DBQueryWarn("select nodeweight from virt_simnode_attributes ".
			    "where pid='$pid' and eid='$eid' and ".
			    "      vname='$vname'");
	    if ($query_result && $query_result->numrows) {
		my ($nodeweight) = $query_result->fetchrow_array();
		if ($nodeweight) {
		    $typestr = "$type:$nodeweight";
		}
	    }
	}
	$self->addnode("$vname $typestr $subnodestr $desirestr");
    }

    #
    # Now that the node list is out, set OSID for nodes
    #
    # Huh?
    #
    foreach my $vnode (values(%{ $self->{'VNODES'} })) {
	my $vname  = $vnode->vname();
	my $type   = $vnode->type();
	my $osinfo = $vnode->_osinfo();

	if ($vnode->_issubnode() && $type eq "ixp-bveil" && !defined($osinfo)){
	    my $osinfo = OSinfo->LookupByName("RHL73-IXPHOST");
	    $vnode->_osinfo($osinfo);
	}
    }
    return 0;
}

#
# Print out the fix nodes.
#
sub GenFixNodes($)
{
    my ($self) = @_;

    #
    # Be sure NOT to print out nodes which are no longer in the experiment.
    #
    # XXX This must be done last since we create internal nodes above.
    #
    foreach my $vname (sort(keys(%{ $self->fixednodes() }))) {
	my $vnode = $self->vnodes()->{$vname};
	my $fixed = $self->fixednodes()->{$vname};

	if (!defined($fixed)) {
	    tbwarn("GenFixNodes: No fixed node for $vname\n");
	}

	# Normal nodes have a vnodem but delay nodes do not.
	if (!defined($vnode) && !$self->isadelaynode($vname)) {
	    tbwarn("GenFixNodes: No vnode for $vname\n");
	}

	#
	# Temporary rspec generation.
	#
	next
	    if (defined($vnode) && $vnode->_isgeninode());
	
	if ($self->isatoponode($vname) || $self->isadelaynode($vname)) {
	    $self->addfixed("$vname $fixed");
	}
    }
    return 0;
}

#
# Print out some summary stats.
#
sub PrintSummaryStats($)
{
    my ($self) = @_;

    # Set estimations
    my $minimum_nodes = $self->counters()->{'physcount'} +
	$self->delaynodecount() / $self->options()->{'delay_capacity'};
    my $maximum_nodes = $self->counters()->{'physcount'} +
	$self->delaynodecount();
    $minimum_nodes = POSIX::ceil($minimum_nodes);

    # For the caller.
    $self->counters()->{'minimum_nodes'}  = $minimum_nodes;
    $self->counters()->{'maximum_nodes'}  = $maximum_nodes;

    my $virtnode_count = $self->counters()->{'virtcount'};
    my $simnode_count  = $self->counters()->{'simcount'};
    my $reserved_virtcount = $self->counters()->{'reserved_virtcount'};
    my $reserved_physcount = $self->counters()->{'reserved_physcount'};

    if (!$self->quiet()) {
	print "Minimum nodes   = $minimum_nodes\n";
	print "Maximum nodes   = $maximum_nodes\n";
	if ($virtnode_count) {
	    print "Virtual nodes     = $virtnode_count\n";
	}
	if ($simnode_count) {
	    print "Simulated nodes   = $simnode_count\n";
	}
	if ($reserved_virtcount) {
	    print "Reserved vnodes   = $reserved_virtcount\n";
	}
	if ($reserved_physcount) {
	    print "Reserved pnodes   = $reserved_physcount\n";
	}
    }
    return 0;
}

#
# Dump the virt lans
#
sub GenVirtLans($)
{
    my ($self) = @_;
    my $experiment = $self->experiment();
    my $pid    = $experiment->pid();
    my $eid    = $experiment->eid();

    my $errors	         = 0;
    my %osdoesveth       = ();
    my %osdoesvethEN     = ();	# Encapsulated veth
    my %osdoesvethNE     = ();  # Non-Encapsulated veth
    my %osdoesvlan       = ();
    my %osdoesmlink      = ();
    my %osdoeslinkdelays = ();

    foreach my $vname (sort(keys(%{ $self->{'VLANS'} }))) {
	my $vlan = $self->vlans()->{$vname};

	# Tunnels are handled elsewhere.
	next
	    if ($vlan->_tunnel());

	my @members = $vlan->memberlist();
	$self->printdb("$vname: " . join(" ",@members) . "\n");

	my $simnodes     = 0;
	my $realnodes    = 0;
	my $virtnodes    = 0;
	my $nonvirtnodes = 0;
	my $sharednodes  = 0;
	my $geninodes    = 0;
	my %nodesdo      = ("alias"=>0, "veth"=>0, "vlan"=>0, "ldelay"=>0,
			    "veth-ne"=>0, "veth-en"=>0);
	my $trivial_ok   = 0;
	my $emulated     = $vlan->_emulated();
        my $uselinkdelay = $vlan->_uselinkdelay();
	my $mustdelay    = $vlan->_mustdelay();
	my $nobwshaping  = $vlan->_nobwshaping();
	my $protocol     = $vlan->_protocol();
	my $encap        = $vlan->_encapstyle();

	#
	# Count the types of nodes (simulated, virtual, real, etc.) in this
	# LAN
	#
	foreach my $member (@members) {
	    my $osid;
	    my $virtnode = $member->virt_node();

	    if ($virtnode->_sharedokay()) {
		$sharednodes++;
		$vlan->_sharednodes($sharednodes);
	    }
	    if ($virtnode->_isgeninode()) {
		$geninodes++;
		$vlan->_geninodes($geninodes);
	    }

	    if ($virtnode->_issimnode()) {
		$simnodes++;

		if (defined($virtnode->_osinfo())) {
		    $osid = $virtnode->_osinfo()->osid();
		} else {
		    $osid = "<SIM>";
		}
		# XXX apparently all simnodes can do veths
		if (!exists($osdoesmlink{$osid})) {
		    $osdoesmlink{$osid} = 0;
		    $osdoesveth{$osid} = 1;
		    $osdoesvethNE{$osid} = 1;
		    $osdoesvethEN{$osid} = 1;
		    $osdoesvlan{$osid} = 0;
		    $osdoeslinkdelays{$osid} = 1;
		}
	    }
	    else {
		my $osinfo;
		
		if ($virtnode->_isvirtnode()) {
		    $virtnodes++;

		    # For virtnodes, we have to map the osid of the vnode
		    # to the osid of the physical machine it will reside on.
		    # Doing this before assign chooses the node, is silly
		    # but no choice right now.
		    #
		    # And now, we only map in this way IF the parent_osid
		    # is not set (it gets set if the user chooses a subOS and
		    # a parent is assigned by default in the parser, or
		    # if they choose both a subOS and a specific parent OS).
		    #
		    if (defined($virtnode->_parent_osinfo())) {
			$osinfo = $virtnode->_parent_osinfo();
			$osid = $osinfo->osid();
		    }
		    elsif (defined($virtnode->_osinfo())) {
			$osid = $self->nodejailosid($virtnode);
			if (!defined($osid)) {
			    tberror("No jailosid for $virtnode\n");
			    return -1;
			}
			$osinfo = OSinfo->Lookup($osid);
			if (!defined($osinfo)) {
			    tberror("No mapping for osid $osid\n");
			    return -1;
			}
		    }
		}
		else {
		    $nonvirtnodes++;

		    $osinfo = $virtnode->_osinfo()
			if (defined($virtnode->_osinfo()));
		}
		
		#
		# Check os feature list emulated/veth/vlan support.
		#
		if (defined($osinfo)) {
		    $osid = $osinfo->osid();
		    
		    if (!exists($osdoesmlink{$osid})) {
			$osdoesmlink{$osid} =
			    $osinfo->FeatureSupported('mlinks');
			$osdoesveth{$osid} =
			    $osinfo->FeatureSupported('veths');
			$osdoesvethNE{$osid} =
			    $osinfo->FeatureSupported('veth-ne');
			$osdoesvethEN{$osid} =
			    $osinfo->FeatureSupported('veth-en');
			$osdoesvlan{$osid} =
			    $osinfo->FeatureSupported('vlans');
			# Need this for phys nodes requesting lindelays.
			$osdoeslinkdelays{$osid} =
			    $osinfo->FeatureSupported('linkdelays');
		    }
		} else {
		    # XXX If the user doesn't explicitly set an OS on a PC.
		    # Be conservative and assume minimum features.
		    $osid = "<DEFAULT>";
		    if (!exists($osdoesmlink{$osid})) {
			$osdoesmlink{$osid} = 0;
			$osdoesveth{$osid} = 0;
			$osdoesvethNE{$osid} = 0;
			$osdoesvethEN{$osid} = 0;
			$osdoesvlan{$osid} = 0;
			$osdoeslinkdelays{$osid} = 0;
		    }
		}
		$realnodes++;
	    }
	    # Figure out how many nodes support a feature
	    $nodesdo{"alias"}++
		if ($osdoesmlink{$osid});
	    $nodesdo{"veth"}++
		if ($osdoesveth{$osid});
	    $nodesdo{"veth-ne"}++
		if ($osdoesvethNE{$osid});
	    $nodesdo{"veth-en"}++
		if ($osdoesvethEN{$osid});
	    $nodesdo{"vlan"}++
		if ($osdoesvlan{$osid});
	    $nodesdo{"ldelay"}++
		if ($osdoeslinkdelays{$osid});
	}

	$self->printdb("$vname: members = ".
		       scalar(@members) .
		       " real/virt/sim = ".
		       "$nonvirtnodes/$virtnodes/$simnodes ".
		       "mlink/veth-ne/veth-en/vlan/ldelay = ".
		       $nodesdo{"alias"} . "/".
		       $nodesdo{"veth-en"} . "/".
		       $nodesdo{"veth-ne"} . "/".
		       $nodesdo{"vlan"} . "/".
		       $nodesdo{"ldelay"} . "\n");

	#
	# Determine the emulation/encapsulation style for the link.
	# The goal is to come up with a compatible emulation style
	# for all members of the virt_lan.  Note that it is not stictly
	# necessary for all members of the virt_lan to emulate in the
	# same way; e.g., one node could be doing an 802.1q tagged VLAN
	# while another could just be doing IP aliasing or veths without
	# encapsulation.  In fact, it is not even necesary in some cases
	# for all vlinks on a physical link to use the same style!
	# But we don't want to go there right now, so for simplicity,
	# we require that the user specify identical values for all
	# members of a virt_lan.  For now, we do this by ignoring per-link
	# settings ($encap) and using only the global setting ($encapstyle)
	# except for backward compat (see next paragraph).
	#
	# XXX this is made hideous by having both global and per-link
	# encapsulation values that were previously used for two
	# different purposes.  The per-link value was used to
	# specify using "veth" devices for non-vnode emulated links
	# (as opposed to using IP aliases).  The global value
	# was used to specify using veth devices without encapsulation
	# for vnode emulated links.
	#
	# So the simplified semantics look like:
	#
	# global  per-link  in vnode?  meaning
	#
	# default default   no         alias; non-vnode mpx links (historic)
	# default alias     no         alias; non-vnode mpx links (historic)
	# default veth      no         veth; non-vnode mpx links (historic)
	#
	# default default   yes        veth; vnode vlinks (historic)
	# veth    default   yes        veth; vnode vlinks (historic)
	# veth-ne default   yes        veth-noencap; vnode vlinks (historic)
	#
	# default *         yes        veth
	# default *         no         alias
	# alias   *         yes        ERROR; we could support this
	# alias   *         no         alias
	# veth    *         *          veth
	# veth-ne *         *          veth-noencap
	# vlan    *         *          vlan
	#
	my $encapval;

        #
	# Notes on virtual interfaces.
	#
	# If a link is EMULATED (virtlanemulated) then it will have an
	# "encapsulation style" (virtlanencapstyle).  That value is
	# one of:
	#
	# "alias"	emulation is done with IP aliases on a physical
	#               interface; there is no packet encapsulation. Works on
	#		FreeBSD or Linux.
	#
	# "veth"	emulation is done with "veth" virtual devices;
	#		encapsulation is standard veth style.
	#		Works on FreeBSD only.
	#
	# "veth-ne"	emulation is done with "veth" devices;
	#		no encapsulation is used (uses made-up MAC addresses
	#		instead).
	#		Works on FreeBSD only.
	#
	# "vlan"	emulation is done with "vlan" devices;
	#		uses 802.1q VLAN tagging.
	#		Works on FreeBSD or Linux.
	#
	# "default"	emulation style was not explicitly set by the users;
	#		encap style depends on context ("veth" for vnode,
	#		"alias" ow)
	#
	# Note that the encapsulation style for "default" depends on
	# the node type.  For non-vnodes the default is "alias".  For
	# vnodes the default is "veth" since they must always have
	# some pseudo-device on which to hang a route table ID; i.e.,
	# we cannot just do IP aliasing.
	#
	#
        # Encapsulation can be specified per link.  The default link
        # encapsulation can also be specified by a per-experiment
        # setting.  At the moment, only the latter (global) is
        # implemented.
        #
	my $encapstyle = $experiment->encap_style();

	#
	# Historic case O: if simulated nodes are involved, use veth
	# as necessary.  XXX don't know if this is correct in all cases!
	#
	if ($simnodes > 0) {
	    $encapval = "veth";
	}
	#
	# Historic case I: non-vnode emulated links use IP aliases 
	# unless per-link value is 'veth', in which case veths are used.
	# This is currently the only place where we care about the
	# per-link value.
	#
	elsif ($encapstyle eq "default" && $virtnodes == 0) {
	    if ($encap eq "veth") {
		$encapval = "veth";
	    } else {
		$encapval = "alias";
	    }
	}
	#
	# Historic case II: vnode emulated links use veth devices with
	# encapsulation unless global encap is set to 'veth-ne'.
	#
	elsif ($encap eq "default" && $virtnodes > 0) {
	    if ($encapstyle eq "default" || $encapstyle eq "veth") {
		$encapval = "veth";
	    } elsif ($encapstyle eq "veth-ne") {
		$encapval = "veth-ne";
	    }
	}

	if (!defined($encapval)) {
	    if ($encapstyle eq "default") {
		# must involve vnodes, non-vnodes handled in "case I" above
		$encapval = "veth";
	    } elsif ($encapstyle =~ /^(alias|veth|veth-ne|vlan)$/) {
		$encapval = $encapstyle;
	    } else {
		tberror("unknown encapsulation style '$encapstyle'\n");
		$errors++;
	    }
	    if ($encap ne "default" && $encap ne $encapval) {
		tbwarn("per-link emulation style not supported right now".
		       "'$encap' overridden by global '$encapval'");
	    }
	}

	$self->printdb("$vname: global/link = ".
		       "$encapstyle/$encap => $encapval\n");

	#
	# Ensure the per-link value is set correctly for emulated links.
	#
	if ($emulated) {
	    $vlan->_encapstyle($encapval);
	}

	#
	# For links involving virtnodes, we prefer to use virtual links.
	# But we can only do this if all involved nodes support a common
	# emulation style.
	#
	my $allnodes = $simnodes + $realnodes;
	if ($virtnodes > 0) {
	    $trivial_ok = $vlan->_trivial_ok();

	    if ($sharednodes) {
		my $newencap;

		if ($sharednodes != $allnodes || $vlan->_needvlan()) {
		    #
		    # Change the encap type to vlan since that is supported.
		    #
		    if ($nodesdo{"vlan"} == $allnodes) {
			$newencap = "vlan";
		    }
		    # Force this on.
		    $emulated   = 1;
		}
		else {
		    if ($nodesdo{"veth-en"} == $allnodes) {
			# Veth means encapsulated.
			$newencap = "veth";
		    }
		    elsif ($nodesdo{"veth-ne"} == $allnodes) {
			$newencap = "veth-ne";
		    }
		    elsif ($nodesdo{"vlan"} == $allnodes) {
			$newencap = "vlan";
		    }
		    # Force this on.
		    $emulated   = 1;
		}
		if (defined($newencap)) {
		    $encapval = $newencap;
		    $vlan->_emulated($emulated);
		    $vlan->_encapstyle($newencap);

		    $self->printdb("Converting encapstyle to ".
				   "$encapval on $vname\n");
		}
		else {
		    tberror("Cannot find a common encapstyle for $vname\n");
		    $errors++;
		}
	    }
	    elsif ($nodesdo{$encapval} == $allnodes) {
		#
		# All members support the encapsulation style, use it.
		#
		$emulated = 1;
		$vlan->_emulated(1);
		$vlan->_encapstyle($encapval);
	    } else {
		$vlan->_encapstyle($encapval);

		#
		# Not all members support the desired encapsulation.
		# This means we have to turn off emulation options
		# even if the user explicitly asked for them.
		# If the user had explicitly asked for these, we
		# print a warning.
		#
		if ($emulated) {
		    tbwarn "tb-set-multiplexed not supported on ".
			   "$vname since at least one of the nodes in $vname ".
			   "does not support multiplexed links.";
		}
		if ($vlan->usevirtiface()) {
		    tbwarn "tb-set-vlink-emulation not supported on ".
	         	   "$vname since at least one of the nodes in $vname ".
			   "does not support '$encapval' link emulation\n";
		}
		$emulated = 0;
		$vlan->_emulated(0);
		$vlan->_encapstyle("none");

		# cannot do colocated vnode trivial links without veths
		$trivial_ok = 0;
	    }
	}
	elsif ($simnodes > 0 && $realnodes == 0) {
	    #
	    # If all nodes in a lan/link are simulated, the lan/link
	    # could certainly be hosted on the same physical
	    # node. Also, if the lan/link is cut and members mapped to
	    # different physical nodes, we will use emulated links
	    # i.e. veth devices.
	    #
	    $trivial_ok = 1;
	    $emulated = 1;
	    $vlan->_emulated(1);
	    $vlan->_encapstyle("veth");
	    $vlan->_allsim(1);
	}

	if ($protocol !~ /^ethernet/) {
	    #
	    # This arrangement is temporary. For now, if its not a
	    # regular ethernet, then create a lan attached to a fake
	    # switch. See ptopgen.  We label them differently though,
	    # since these do not get vlans.  Some other special
	    # treatment applies as well.
	    #
	    $self->addnode("fakelan/$vname $protocol");
	    
	    # So we ignore it when it comes back from assign.
	    $self->lannodes()->{"fakelan/$vname"} = 1;
	    
	    # XXX If not ethernet, assume wireless. Need more info someplace.
	    $self->exptstats()->{'wirelesslans'} += 1;

	    foreach my $member (@members) {
		my $plink = "fakelan/$vname/$member";
		my $vnode = $member->virt_node()->vname();
		    
		my ($top_bw, $top_rbw) = $self->virtlantopbw($vlan, $member);
	
		$self->addlink("$plink $vnode fakelan/$vname $top_bw " .
			       "0 0 $protocol");
	    }
	}
	elsif (@members == 2) {
	    #
	    # We treat LANs with two members specially - they are just links
	    #
	    $self->exptstats()->{'links'} += 1;

	    my ($member0,$member1) = @members;
	    my $virtnode0 = $member0->virt_node();
	    my $virtnode1 = $member1->virt_node();
	    my $vname0    = $virtnode0->vname();
	    my $vname1    = $virtnode1->vname();

	    my ($delay0,$bw0,$ebw0,$backfill0,$loss0,
		$rdelay0,$rbw0,$rebw0,$rbackfill0,$rloss0) =
		    @{$member0->_delayinfo()};
	    my ($delay1,$bw1,$ebw1,$backfill1,$loss1,
		$rdelay1,$rbw1,$rebw1,$rbackfill1,$rloss1) =
		    @{$member1->_delayinfo()};

	    # Here the r's are going to be 1->0 and the others 0->1
	    my $delay      = $delay0+$rdelay1;
	    my $loss       = 1-(1-$loss0)*(1-$rloss1);
	    my $bw         = min($bw0,$rbw1);
 	    my $backfill   = max($backfill0,$rbackfill1);
	    my $rdelay     = $rdelay0+$delay1;
	    my $rloss      = 1-(1-$rloss0)*(1-$loss1);
	    my $rbw        = min($rbw0,$bw1);
 	    my $rbackfill  = max($rbackfill0,$backfill1);
	    my $bandwidth  = $self->getbandwidth($member0, $vlan, $bw);
	    my $rbandwidth = $self->getbandwidth($member1, $vlan, $bw);

	    # Need to know about tracing on a per queue basis, since the
	    # user can specify tracing asymmetrically.
	    my ($traced,$trace_endnode)   = @{$member0->_traceinfo()};
	    my ($rtraced,$rtrace_endnode) = @{$member1->_traceinfo()};

	    #
	    # Geni links and lans are dead simple right now. 
	    #
	    if ($vlan->_geninodes()) {
		my $ref = {
		    'virtual_id'    => $vname,
		    # The list references are so XML::Simple does not
		    # turn them into attributes. Need a better solution.
		    'bandwidth'     => [$bw],
		    'latency'       => [0],
		    'packet_loss'   => [0],
		    'link_type'     => {"type_name" => "ethernet"},
		    'interface_ref' =>
			[ {'virtual_node_id' => $vname0,
			   'virtual_interface_id' => "$member0" },
			  {'virtual_node_id' => $vname1,
			   'virtual_interface_id' => "$member1" },
			],
		};
		if (!exists($self->rspec()->{'link'})) {
		    $self->rspec()->{'link'} = [];
		}
		push(@{ $self->rspec()->{'link'} }, $ref);
		next;
	    }

	    #
	    # See if the link is really being shaped, or if the we just
	    # need a delay node cause of tracing/monitoring.
	    #
	    my $shaped = 0;

	    if (((($delay >= $DELAYTHRESH) ||
		  (!$nobwshaping &&
		   ($self->requires_delay($member0, $vlan, $bw) ||
		    $self->requires_delay($member1, $vlan, $bw))) ||
		  ($loss != 0)) ||
		 (($rdelay >= $DELAYTHRESH) ||
		  (!$nobwshaping &&
		   ($self->requires_delay($member0, $vlan, $rbw) ||
		    $self->requires_delay($member1, $vlan, $rbw))) ||
		  ($rloss != 0)) ||
		 # Link must be shaped for other reasons (q_red).
		 $mustdelay ||
		 # Global force, or per-link force. 
		 $self->option('forcelinkdelays') || $uselinkdelay)) {
		# Need a delay node and its really a shaped link.
		$shaped = 1;
		# Mark the links as shaped for later.
		$vlan->setmembershaped($member0);
		$vlan->setmembershaped($member1);
	    }

	    #
	    # Check to make sure that both nodes support linkdelays.  This
	    # check is only made for links comprised of physical nodes,
	    # since if the OS supports virtual nodes, it supports linkdelays.
	    #
	    if ($shaped && $virtnodes == 0 &&
		$self->virtlan_use_linkdelay($vlan, $shaped)) {
		#
		# The user had to specify the OS.
		#
		if (! (defined($virtnode0->_osinfo()) &&
		       defined($virtnode1->_osinfo()))) {
		    tberror("You must specify the OSID for all nodes in ".
			    "lan $vlan, when using linkdelays ".
			    "(endnode traffic shaping)\n");
		    $errors++;
		}
		#
		# All the OS's have to support linkdelays.
		#
		foreach my $virtnode ($virtnode0, $virtnode1) {
		    my $osinfo = $virtnode->_osinfo();

		    if (!defined($osinfo)) {
			tbreport(SEV_ERROR, 'node_lacks_linkdelay_support',
				 $virtnode, $vlan);
		    }
		    elsif (! $osdoeslinkdelays{$osinfo->osid()}) {
			my $osname = $osinfo->osname();
			tberror({type => 'primary', severity => SEV_ERROR,
				 error => ['node_lacks_linkdelay_support',
					   $virtnode, $vlan]},
				"$virtnode in link $vlan is running an OS ".
				"($osname) that does not support linkdelays ".
				"(endnode traffic shaping)\n");
			$errors++;
		    }
		}
	    }

	    #
	    # Get the bandwidth we're supposed to put into the top file, which
	    # may be different that what we're limiting the link to
	    #
	    my ($top_bw0, $top_rbw0) = $self->virtlantopbw($vlan, $member0);
	    my ($top_bw1, $top_rbw1) = $self->virtlantopbw($vlan, $member1);

	    #
            # Get the fix-interface info for the members and setup the 
            # fix string.
            #
	    my $fixi0 = $member0->fixed_iface();
	    my $fixi1 = $member1->fixed_iface();
	    my ($fixsrc0,$fixdst0,$fixsrc1,$fixdst1,$fixall)=('','','','','');

	    if (defined($fixi0) && $fixi0 ne '') {
		$fixsrc0 = "fixsrciface:$fixi0";
		$fixdst0 = "fixdstiface:$fixi0";
		$fixall .= "fixsrciface:$fixi0";
	    }
	    if (defined($fixi1) && $fixi1 ne '') {
		if ($fixall ne "") {
		    $fixall .= " ";
		}
		$fixsrc1 = "fixsrciface:$fixi1";
		$fixdst1 = "fixdstiface:$fixi1";
		$fixall .= "fixdstiface:$fixi1";
	    }

	    my $top_bw  = min($top_bw0, $top_rbw1);
	    my $top_rbw = min($top_rbw0, $top_bw1);

	    if (($shaped ||
		 (($traced || $rtraced) &&
		  !($trace_endnode && $rtrace_endnode))) &&
		# XXX simulated nodes hack. We don't want to put delay nodes
		# between simulated nodes. If there is a link between a
		# simulated and a real node, we might need to put in delay
		# nodes.
		($realnodes != 0)) {
		$self->exptstats()->{"shapedlinks"} += 1;
		
		#
		# We use a linkdelay if the link is emulated, globally forced,
		# globally preferred if the link is shaped, or if the per-link
		# flag was set (which means to put in a link delay regardless
		# of whether the link is shaped).
		#
		if ($self->virtlan_use_linkdelay($vlan, $shaped)) {
		    my $plink = "linksimple/$vname/$member0,$member1";

		    $self->addlink("$plink $vname0 $vname1 ".
				   max($top_bw,$top_rbw) . " 0 0 $protocol" .
				   ($emulated ? " emulated" : "") .
				   ($trivial_ok ? " trivial_ok" : "") .
				   " $fixall");
		    
		    my @delayinfo = ($delay,$bw,$backfill,$loss,
				     $rdelay,$rbw,$rbackfill,$rloss, 0);
		    
		    $self->printdb("Delay link $plink = " . 
				   join(" ", @delayinfo) . "\n");

		    # Save for the post pass.
		    $self->delaylinks()->{$plink} = \@delayinfo;
		}
		else {
		    my $delayname   = $self->nextdelayname();
		    my $plink       = "linksdelaysrc/$vname/$member0,$member1";
		    my $delaydesire = $self->delay_desire();

		    my @delayinfo = ($delay,$bw,$backfill,$loss,
				     $rdelay,$rbw,$rbackfill,$rloss,0);

		    $self->addnode("$delayname delay $delaydesire");
		    
		    $self->addlink("linksdelaysrc/$vname/$member0,$member1 ".
				   "$vname0 $delayname $top_bw 0 0 ".
				   "$protocol $fixsrc0");
		    $self->addlink("linksdelaydst/$vname/$member1,$member0 ".
				   "$vname1 $delayname $top_bw 0 0 ".
				   "$protocol $fixdst1");

		    $self->printdb("Delay node $plink ($delayname) = " . 
				   join(" ", @delayinfo) . "\n");

		    # Save for the post pass.
		    $self->delaylinks()->{$plink} = \@delayinfo;
		    $self->delaynodes()->{$delayname} = $delayname;
		}
		#
		# Ports are set to the next-fastest speed when a link gets a
		# delay node.  This can override initialization above cause we
		# could not tell earlier if the link was going to get a real
		# delay node or just a delaywithswitch.
		#
		$self->portbw()->{$member0} =
		    $self->getbandwidth($member0,$vlan,$bandwidth);
		$self->portbw()->{$member1} =
		    $self->getbandwidth($member1,$vlan,$rbandwidth);
	    }
	    else {
		my $plink = "linksimple/$vname/$member0,$member1";

		my $spec = "$plink $vname0 $vname1";

		if ($emulated) {
		    $spec .= " " . max($top_bw,$top_rbw) .
			" 0 0 $protocol emulated";
		}
		else {
		    $spec .= " $top_bw 0 0 $protocol";
		}
		if ($trivial_ok) {
		    $spec .= " trivial_ok";
		    #
		    # We store this info in case assign actually does turn it
		    # into a trivial link. If that happens, we have to insert
		    # a link delay if the link is between two vnodes. Why?
		    # Cause a trivial link (using loopback) would have much
		    # more bandwidth (400+ Mb) then your typical 100Mb link.
		    # Note the final member of the array, which indicates this
		    # delay should be inserted only if assign makes it a
		    # trivial link.		    
		    #
		    if (!$nobwshaping && !$vlan->_allsim()) {
			$self->delaylinks()->{$plink} = 
			    [$delay,$bw,$backfill,$loss,
			     $rdelay,$rbw,$rbackfill,$rloss,1];
		    }
		}
		if ($fixall ne '') {
		    $spec .= " $fixall";
		}
		$self->addlink($spec);
	    }
	}
	elsif ($#members != 0) {
	    $self->exptstats()->{"lans"} += 1;

	    # Lan node for assign.
	    $self->addnode("lan/$vname lan");
	    # So we ignore it when it comes back from assign.
	    $self->lannodes()->{"lan/$vname"} = 1;

	    #
	    # Geni links and lans are dead simple right now. 
	    #
	    if ($vlan->_geninodes()) {
		# Different naming for geni.
		$self->lannodes()->{"lan-$vname"} = 1;

		#
		# Need a node for the fake lan node.
		#
		my $noderef = {
		    'virtual_id'          => "lan-$vname",
		    'virtualization_type' => 'raw',
		    'exclusive'           => 1,
		    'node_type'           => {"type_name"  => "lan",
					      "type_slots" => 1},
		};
		if (!exists($self->rspec()->{'link'})) {
		    $self->rspec()->{'link'} = [];
		}
		my @nrefs = ();

		foreach my $member (@members) {
		    my (undef,$bw) = @{$member->_delayinfo()};
		    my $virtnode   = $member->virt_node();
		    my $fixed      = $virtnode->fixed();

		    #
		    # Need to tie the fake lan node to the same CM.
		    # Should probably sanity check that all the nodes
		    # in the lan have the same CM.
		    #
		    if (defined($fixed) && $fixed ne "") {
			my ($authority,$type,$nodeid) = GeniHRN::Parse($fixed);
			
			$noderef->{'component_urn'} =
			    GeniHRN::Generate($authority, "node", "*");
		    }

		    push(@{ $self->rspec()->{'link'} },
			 { 'virtual_id'    => "$vname:$member",
			   # The list references are so XML::Simple does not
			   # turn them into attributes. Need a better solution.
			   'latency'       => [0],
			   'packet_loss'   => [0],
			   'link_type'     => {"type_name" => "ethernet"},
			   'bandwidth'     => [$bw],
			   'interface_ref' =>
			       [
				{ 'virtual_node_id' => $virtnode->vname(),
				  'virtual_interface_id' => "$member" },
				{ 'virtual_node_id' => "lan-$vname",
				  'virtual_interface_id' => "$member" }
			       ]
			       });
		    
		    push(@nrefs, { 'virtual_id' => "$member"});
		}
		$noderef->{'interface'} = \@nrefs;
		push(@{ $self->rspec()->{'node'} }, $noderef);
		next;
	    }
	    
	    foreach my $member (@members) {
		my $virtnode   = $member->virt_node();
		my $vnodevname = $virtnode->vname();
		
		my ($delay,$bw,$ebw,$backfill,$loss,
		    $rdelay,$rbw,$rebw,$rbackfill,$rloss) =
			@{$member->_delayinfo()};

		# Need to know about tracing on a per queue basis, since the
		# user can specify tracing asymmetrically.
		my ($traced,$trace_endnode)  = @{$member->_traceinfo()};
		
		#
		# See if the link is really being shaped, or if the we just
		# need a delay node cause of tracing/monitoring.
		#
		my $shaped = 0;

                # XXX The expression below should be modified for
                # better bandwidth support.  Probably needs to happen
                # post assign somehow.
		if (((($delay >= $DELAYTHRESH) ||
		      (!$nobwshaping &&
		       $self->requires_delay($member, $vlan, $bw)) ||
		      ($loss != 0)) || 
		     (($rdelay >= $DELAYTHRESH) ||
		      (!$nobwshaping &&
		       $self->requires_delay($member, $vlan, $rbw)) ||
		      ($rloss != 0)) ||
		     # Link must be shaped for other reasons (q_red).
		     $mustdelay ||
		     # Global force, or per-lan force. 
		     $self->option('forcelinkdelays') || $uselinkdelay)) {
		    $shaped = 1;
		    # Mark the link as shaped for later.
		    $vlan->setmembershaped($member);
		}

		#
		# Check to make sure that this node supports linkdelays.
		# This check is only made for links comprised of physical
		# nodes, since if the OS supports virtual nodes, it
		# supports linkdelays.
		#
		if ($shaped && $virtnodes == 0 &&
		    $self->virtlan_use_linkdelay($vlan, $shaped)) {
		    #
		    # The user had to specify the OS.
		    #
		    if (! defined($virtnode->_osinfo())) {
			tberror("You must specify the OSID for all nodes in ".
				"lan $vlan, when using linkdelays ".
				"(endnode traffic shaping)\n");
			$errors++;
		    }
		    else {
			#
			# All the OSes have to support linkdelays.
			#
			my $osinfo = $virtnode->_osinfo();

			if (!defined($osinfo)) {
			    tbreport(SEV_ERROR, 'node_lacks_linkdelay_support',
				     $virtnode, $vlan);
			}
			elsif (! $osdoeslinkdelays{$osinfo->osid()}) {
			    my $osname = $osinfo->osname();
			    tbwarn("$virtnode in lan $vlan is running an OSID".
				 " ($osname) that does not support linkdelays".
				 " (endnode traffic shaping)\n");
			    $errors++;
			}
		    }
		}

		#
		# Get the fix-interface info for the member.
		#
		my $fixi0 = $member->fixed_iface();
		my ($fixsrc0) = ('');

		if (defined($fixi0) && $fixi0 ne '') {
		    $fixsrc0 = "fixsrciface:$fixi0";
		}

		my ($top_bw, $top_rbw) = $self->virtlantopbw($vlan, $member);
		my $bandwidth  = $self->getbandwidth($member,$vlan,$bw);
		my $rbandwidth = $self->getbandwidth($member,$vlan,$rbw);

		if (($shaped || ($traced && !$trace_endnode)) &&
		    # if we have 1 real node in the LAN, we may need to create
		    # a lan
		    ($realnodes != 0)) {
		    $self->exptstats()->{"shapedlans"} += 1;
		    
		    #
		    # We use a linkdelay if the link is emulated,
		    # globally forced, globally preferred if the link
		    # is shaped, or if the per-link flag was set
		    # (which means to put in a link delay regardless
		    # of whether the link is shaped).
		    #
		    if ($self->virtlan_use_linkdelay($vlan, $shaped)) {
			my $plink = "linklan/$vname/$member";
			
			my @delayinfo = ($delay,$bw,$backfill,$loss,
					 $rdelay,$rbw,$rbackfill,$rloss,0);

			$self->addlink("$plink $vnodevname lan/$vname " .
				       max($top_bw,$top_rbw) .
				       " 0 0 $protocol" .
				       ($emulated ? " emulated" : "") .
				       ($trivial_ok ? " trivial_ok" : "") . 
				       ($fixsrc0 ? " $fixsrc0" : ""));

			$self->printdb("Delay link $plink = " .
				       join(" ", @delayinfo) . "\n");

			# Save for the post pass.
			$self->delaylinks()->{$plink} = \@delayinfo;
		    }
		    else {
			my $delayname   = $self->nextdelayname();
			my $plink       = "linkdelaysrc/$vname/$member";
			my $delaydesire = $self->delay_desire();
			my @delayinfo   = ($delay,$bw,$backfill,$loss,
					   $rdelay,$rbw,$rbackfill,$rloss,0);
			
			$self->addnode("$delayname delay $delaydesire");
			
			$self->addlink("linkdelaysrc/$vname/$member " .
				       "$vnodevname $delayname $top_bw 0 0 ".
				       "$protocol $fixsrc0");
			$self->addlink("linkdelaydst/$vname/$member " .
				       "lan/$vname $delayname $top_bw 0 0 ".
				       "$protocol");

			$self->printdb("Delay node $plink ($delayname) = " .
				       join(" ", @delayinfo) . "\n");

			# Save for the post pass.
			$self->delaylinks()->{$plink} = \@delayinfo;
			$self->delaynodes()->{$delayname} = $delayname;

			# XXX Mark the lan as having delayed members so that
			# we create a delayed protolan. Bogus.
			$vlan->_delayed(1);
		    }
		    #
		    # Port is set to the next-fastest speed when the link
		    # gets a delay node.  This can override initialization
		    # above cause we could not tell earlier if the link was
		    # going to get a real delay node or just a
		    # delaywithswitch.
		    #
		    $self->portbw()->{$member} = $bandwidth;	    
		}
		else {
		    my $plink = "linklan/$vname/$member";

		    my $spec = "$plink $vnodevname lan/$vname $top_bw " .
			"0 0 $protocol";
		    if ($emulated) {
			$spec .= " emulated";
		    }
		    if ($trivial_ok) {
			$spec .= " trivial_ok";

			#
			# We store this info in case assign actually does
			# turn it into a trivial link. If that happens, we
			# have to insert a link delay if the link is
			# between two vnodes. Why?  Cause a trivial link
			# (using loopback) would have much more bandwidth
			# (400+ Mb) then your typical 100Mb link. Note the
			# final member of the array, which indicates this
			# delay should be inserted only if assign makes it
			# a trivial link.
			#
			if (!$nobwshaping) {
			    $self->delaylinks()->{$plink} = 
				[$delay,$bw,$backfill,$loss,
				 $rdelay,$rbw,$rbackfill,$rloss,1];
			}
		    }
		    if ($fixsrc0) {
			$spec .= " $fixsrc0";
		    }
		    $self->addlink($spec);
		}
	    }
	}
    }
    return $errors;
}

#
# Print the results in plain text top file format.
#
sub PrintTop($;$)
{
    my ($self, $output) = @_;
    $output = *STDOUT
	if (!defined($output));

#    print Dumper($self);

    foreach my $vclass (@{$self->results->{'class'}}) {
	print $output "make-vclass $vclass\n";
    }
    foreach my $ref (@{$self->results->{'nodeslinks'}}) {
	my ($which, $what) = @{ $ref };
	if ($which eq "node") {
	    print $output "node $what\n";
	}
	else {
	    print $output "link $what\n";
	}
    }
    foreach my $fixed (@{$self->results->{'fixed'}}) {
	print $output "fix-node $fixed\n";
    }
    return 0;
}

#
# Print the rspec part of the topo. Eventually the whole thing needs
# to be in rspec.
#
sub PrintRspec($;$)
{
    my ($self, $output) = @_;
    $output = *STDOUT
	if (!defined($output));

    my $reqstring =
	eval { XMLout($self->rspec(), "NoAttr" => 0, RootName => "rspec") };
    if ($@) {
	print STDERR "XMLout error: $@\n";
	print STDERR Dumper($self->rspec());
	return -1;
    }
    print $output $reqstring;
    return 0;
}

#
# Print in XML.
#
sub PrintXML($;$)
{
    my ($self, $output) = @_;
    $output = *STDOUT
	if (!defined($output));

    my $pid = $self->experiment()->pid();
    my $eid = $self->experiment()->eid();

    my $doc = XML::LibXML::Document->new();

    my $root = $doc->createElement("vtop");
    $root->setAttribute("xmlns", "http://emulab.net/resources/vtop/0.2");
    $doc->setDocumentElement($root);

    foreach my $vclass (@{$self->results->{'class'}}) {
	$self->processVClass($doc, $root, $vclass);
    }
    foreach my $ref (@{$self->results->{'nodeslinks'}}) {
	my ($which, $what) = @{ $ref };
	if ($which eq "node") {
	    $self->processNode($doc, $root, $what);
	}
	else {
	    $self->processLink($doc, $root, $what);
	}
    }
    print $output $doc->toString(1) . "\n";

    return 0;
}

#
# One time initializaton for a vtop. 
#
sub CreateVtop($)
{
    my ($self) = @_;
    my $pid = $self->experiment()->pid();

    #
    # This is for stats gathering. It might duplicate other stuff, but
    # thats okay.
    #
    $self->{'EXPTSTATS'} =
    {
        # pnodes include jailnodes and delaynodes.
	# We let the wrapper determine pnodes once the
	# experiment is fully swapped in so that the record
	# is not "committed" until successful swapin.
	'jailnodes'   => 0,
	'vnodes'      => 0,
	# vnodes include wanodes.
	'wanodes'     => 0,
	# wanodes includes plabnodes.
	'plabnodes'   => 0,
	'simnodes'    => 0,
	'delaynodes'  => 0,
	'linkdelays'  => 0,
	'links'       => 0,
	'walinks'     => 0,
	'lans'        => 0,
	'wirelesslans' => 0,
	'shapedlinks' => 0,
	'shapedlans'  => 0,
	'minlinks'    => 100000,
	# includes emulated links. Maybe thats wrong.
	'maxlinks'    => 0,
    };

    # Initialize counters.
    $self->{'COUNTERS'}->{'simcount'}    = 0;
    $self->{'COUNTERS'}->{'remotecount'} = 0;
    $self->{'COUNTERS'}->{'virtcount'}   = 0;
    $self->{'COUNTERS'}->{'plabcount'}   = 0;
    $self->{'COUNTERS'}->{'physcount'}   = 0;
    $self->{'COUNTERS'}->{'sharedcount'} = 0;

    #
    # Experiment wide options.
    #
    # Set this when forcing linkdelays instead of delay nodes. NS file.
    $self->options()->{'uselinkdelays'} =
	($self->virtexperiment()->uselinkdelays() ? 1 : 0);

    # Force a link delay, even when no delay would otherwise be inserted.
    $self->options()->{'forcelinkdelays'} =
	($self->virtexperiment()->forcelinkdelays() ? 1 : 0);

    # Allow override of delay capacity.
    $self->options()->{'delay_capacity'} = ($DELAYCAPACITY || 1);
    if ($self->virtexperiment()->delay_capacity()) {
	$self->options()->{'delay_capacity'} =
	    $self->virtexperiment()->delay_capacity();
	$self->options()->{'delaycap_override'} = 1;
	# Record this in the stats only when overridden.
	$self->exptstats()->{'delay_capacity'}  =
	    $self->options()->{'delay_capacity'};
    }

    # Allow override of delay osid.
    if (defined($self->virtexperiment()->delay_osname())) {
	my $osname = $self->virtexperiment()->delay_osname();
	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', 'delay', $osname, $pid]},
			"Invalid OS $osname in project $pid!");
		return -1;
	    }
	}
	my $osid = $osinfo->osid();
	$self->options()->{'delay_osid'} = $osid;
	# Keep a desire string we can use to make sure that the node
	# type picked for the delay node can load the right OS.
	$self->options()->{'delay_desire_string'} = "OS-$osid:1";
    }
    else {
	$self->options()->{'delay_desire_string'} = "";
    }

    # Allow override of jail osid.
    if (defined($self->virtexperiment()->jail_osname())) {
	my $osname = $self->virtexperiment()->jail_osname();
	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', 'jail', $osname, $pid]},
			"Invalid OS $osname in project $pid!");
		return -1;
	    }
	}
	$self->options()->{'jail_osid'} = $osinfo->osid();
    }

    # XXX woeful NSE hack
    my $sim_osname = "FBSD-NSE";
    if (defined($sim_osname)) {
	my $osinfo = OSinfo->Lookup($pid, $sim_osname);
	if (!defined($osinfo)) {
	    $osinfo = OSinfo->LookupByName($sim_osname);
	}
	if (defined($osinfo)) {
	    $self->options()->{'sim_osid'} = $osinfo->osid();
	}
	elsif (exists($self->options()->{'jail_osid'})) {
	    $self->options()->{'sim_osid'} = $self->options()->{'jail_osid'};
	}
    }

    # Option to fix current resources. Command line overrides experiment.
    # This option does not make sense unless updating is also on.
    if ($self->updating() && !$self->fixcurrent() &&
	$self->virtexperiment()->allowfixnode()) {
	$self->{'FLAGS'} |= $VTOP_FLAGS_FIXNODES;
    }

    #
    # If updating, load current experiment resources. We have to be
    # careful of how this is merged in with the (new) desired
    # topology. Fixnodes might also be set independently of updating.
    #
    if ($self->updating() || $self->fixcurrent()) {
	return -1
	    if ($self->LoadCurrentResources());
    }
    
    return -1
	if ($self->LoadPhysInfo() ||
	    $self->LoadVirtNodes() ||
	    $self->LoadVirtLans());
    
    return -1
	if ($self->GenVirtTypes() ||
	    $self->GenVirtNodes() ||
	    $self->GenVirtLans() ||
	    $self->GenFixNodes() ||
	    $self->PrintSummaryStats());

    # Stats for the caller.
    $self->exptstats()->{"vnodes"}    = $self->counters()->{'virtcount'};
    $self->exptstats()->{"wanodes"}   = $self->counters()->{'remotecount'};
    $self->exptstats()->{"plabnodes"} = $self->counters()->{'plabcount'};
    $self->exptstats()->{"simnodes"}  = $self->counters()->{'simcount'};

    if ($self->verbose() && defined($self->rspec())) {
	$self->printdb(Dumper($self->rspec()));
    }
    
    return 0;
}

#
# getbandwidth(bw)
# Returns the lowest ok bandwidth that is greater than or equal to
# the one passed. Takes a virtual node, from which it grabs a type - only
# consideres bandwidths on the node types the virtual node can be mapped to.
# Very similar to requires_delay().
#
sub getbandwidth($$$$)
{
    my ($self, $virtlanmember, $virtlan, $targetbw) = @_;
    my $best = 10000000000;

    my $virtnode  = $virtlanmember->virt_node();
    my $node_type = $virtnode->type();
    my $protocol  = protocolbasetype($virtlan->_protocol());
    my $linkbws   = $self->{'TYPELINKBW'};
	
    foreach my $bw (keys(%{ $linkbws->{$node_type}{$protocol} })) {
	if (($bw >= $targetbw) && ($bw < $best)) {
	    $best = $bw;
	}
    }

    if (! $virtnode->_isvtyped()) {
	my $node_class = $virtnode->_typeinfo()->class();
	
	foreach my $bw (keys(%{ $linkbws->{$node_class}{$protocol} })) {
	    if (($bw >= $targetbw) && ($bw < $best)) {
		$best = $bw;
	    }
	}
    }
    return $best;

}

# requires_delay()
# Returns 1 if the given bandwidth requires that a delay node be inserted, 0
# if it can be handled by some interface in the testbed
#
# Way bogus! We have to guess if we need to insert a delay node (assign should
# really be doing this). We need a delay node if the desired bw does not
# match the native hardware link speed. Of course, we do not know what assign
# will map the node too, but we do know generally what interface speeds are
# supported on each type/class of hardware that the user might request. If
# a 50Mb link on a "pc" is requested, we know we need a delay node cause
# pcs support just 100Mb and 1000Mb links. assign might pick either one, but
# we know we need a delay node no matter what. The problem is what happens if
# the user asks for 100Mb (no delay node), but assign maps it to a 1000Mb link?
# Well, we are screwed since we needed a delay node. We are ignoring that
# problem for now since no one has access to 1gig interfaces at the moment.
# 
sub requires_delay($$$$)
{
    my ($self, $virtlanmember, $virtlan, $targetbw) = @_;

    my $virtnode  = $virtlanmember->virt_node();
    my $node_type = $virtnode->type();
    my $protocol  = protocolbasetype($virtlan->_protocol());
    my $linkbws   = $self->{'TYPELINKBW'};
    my $node_class;

    if (!exists($linkbws->{$node_type}{$protocol})) {    
	warn("requires_delay(): $virtnode - invalid type $node_type!\n");
	return 0;
    }

    if (! $virtnode->_isvtyped()) {
	$node_class = $virtnode->_typeinfo()->class();
	
	if (!exists($linkbws->{$node_class}{$protocol})) {
	    warn("requires_delay(): $virtnode - invalid class $node_class!\n");
	    return 0;
	}
    }

    foreach my $bw (keys(%{ $linkbws->{$node_type}{$protocol} })) {
	return 0
	    if ($targetbw == $bw);
    }
    if (defined($node_class)) {
	foreach my $bw (keys(%{ $linkbws->{$node_class}{$protocol} })) {
	    return 0
		if ($targetbw == $bw);
	}
    }
    return 1;
}

#
# Return the (bandwidth, rbandwidth) to put into a top file for this link -
# this is _NOT_ the hard limit on bandwidth that the user asked for us to
# set up traffic shaping for.
#
sub virtlantopbw($$$) {
    my ($self, $virtlan, $member) = @_;
    my $node = $member->virt_node()->vname();

    my ($delay,$bw,$ebw,$backfill,$loss,
	$rdelay,$rbw,$rebw,$rbackfill,$rloss) = @{$member->_delayinfo()};

    # Return the estimated bw if it was given; otherwise, return the normal
    # bandwidth, 
    my ($return_bw, $return_rbw);
    
    if (defined($ebw)) {
	$return_bw = $ebw;
    }
    else {
	#
	# If this is an emulated link, or one on which we are doing end node
        # shaping we put in only the bandwidth from the virtual topology -
	# otherwise, we put in the bandwidth of the type of physical interface
	# it is likely to get mapped to.
	#
        my $shaped = $virtlan->membershaped($member);
	
	if ($virtlan->_emulated() ||
	    $self->virtlan_use_linkdelay($virtlan, $shaped)) {
	    $return_bw = $bw;
	}
	else {
	    $return_bw = $self->getbandwidth($member, $virtlan, $bw);
	}
    }

    if (defined($rebw)) {
	$return_rbw = $rebw;
    }
    else {
	#
	# If this is an emulated link, we put in only the reported
	# bandwidth - otherwise, we put in the bandwidth of the type
	# of physical interface it is likely to get mapped to
	#
	if ($virtlan->_emulated()) {
	    $return_rbw = $rbw;
	}
	else {
	    $return_rbw = $self->getbandwidth($member, $virtlan, $bw);
	}
    }
    return ($return_bw, $return_rbw);
}

#
# Determine if a given link/lan uses linkdelays
#
sub virtlan_use_linkdelay($$$) {
    my ($self, $virtlan, $shaped) = @_;

    #print Dumper($virtlan);

    #
    # Here are the conditions for using linkdelays on each link/lan
    # Note: $forcelinkdelays and $uselinkdelays are global
    #
    if ( # linkdelays can be globally forced
         $self->option('forcelinkdelays') ||
         # We use linkdelays on emulated virtlans
         $virtlan->_emulated() ||
	 # Some of the nodes are on shared pnodes.
	 $virtlan->_sharednodes() ||
         # The user requested linkdelays, and this is a virtlan that gets
         # shaped (note - in this case, non-shaped virtlans don't get
         # linkdelays)
         ($self->option('uselinkdelays') && $shaped) ||
         # The user forced linkdelays for this specific virtlan
         $virtlan->_uselinkdelay()) {
        # Yep, use linkdelays
	#$self->printdb("Using linkdelay for $virtlan\n");
        return 1;
    } else {
        # No - either won't be delayed at all, or we'll use a delay node
        return 0;
    }
}

# We do not actually store information about the protocol heirarchy in the
# database, so we use a simple conventions for now - <basetype>[-subtype]
sub protocolbasetype($) {
    if ($_[0] =~ /^([^-]+)-/) {
        return $1;
    } else {
        return $_[0];
    }
}

#############################################################################
#
# Solution. Now we get into the code to process the solution. 
#
# Stuff for the solution and interpretation.
sub solution($)           { return $_[0]->{'SOLUTION'}; }
sub solution_p2v($)       { return $_[0]->{'SOLUTION'}->{'P2V'}; }
sub solution_v2p($)	  { return $_[0]->{'SOLUTION'}->{'V2P'}; }
sub solution_v2v($)	  { return $_[0]->{'SOLUTION'}->{'V2V'}; }
sub solution_plinks($)	  { return $_[0]->{'SOLUTION'}->{'PLINKS'}; }
sub solution_virtnodes($) { return $_[0]->{'SOLUTION'}->{'VIRTNODES'}; }
sub solution_rtabmap($)	  { return $_[0]->{'SOLUTION'}->{'RTABMAP'}; }
sub solution_vethmap($)   { return $_[0]->{'SOLUTION'}->{'VETHMAP'}; }
sub solution_vethpatch($) { return $_[0]->{'SOLUTION'}->{'VETHPATCHES'}; }
sub solution_portmap($)   { return $_[0]->{'SOLUTION'}->{'PORTMAP'}; }
sub solution_vifacemap($) { return $_[0]->{'SOLUTION'}->{'VIFACEMAP'}; }
sub solution_ifacemap($)  { return $_[0]->{'SOLUTION'}->{'IFACEMAP'}; }

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

    if (defined($self->rspec())) {
	$self->printdb("Mapping geni resources ...\n");
	
	if (libGeni::MapResources($self->experiment(),
				  $self->user(), $self->rspec())) {
	    tberror("Could not map Geni resources\n");
	    return -1;
	}
	if ($self->ReadRspecSolution($self->rspec()) != 0) {
	    tberror("Could not parse rspec solution! $!\n");
	    return -1;
	}
    }
    return 0;
}

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

    # Start with a new solution vector each time.
    $self->{'SOLUTION'} = {};
    $self->{'SOLUTION'}->{'TORESERVE'}   = {};
    $self->{'SOLUTION'}->{'V2P'}         = {};
    $self->{'SOLUTION'}->{'P2V'}         = {};
    $self->{'SOLUTION'}->{'V2V'}         = {};
    $self->{'SOLUTION'}->{'PLINKS'}      = {};
    $self->{'SOLUTION'}->{'VIRTNODES'}   = {};
    $self->{'SOLUTION'}->{'RTABMAP'}     = {};
    $self->{'SOLUTION'}->{'VETHMAP'}     = {};
    $self->{'SOLUTION'}->{'VETHPATCHES'} = {};
    $self->{'SOLUTION'}->{'PORTMAP'}     = undef;
    $self->{'SOLUTION'}->{'VIFACEMAP'}   = {};
    $self->{'SOLUTION'}->{'IFACEMAP'}    = {};

    return 0;
}

sub AddNodeToSolution($$$)
{
    my ($self, $virtual, $physical) = @_;

    # Skip LAN/Fake nodes.
    return 0
	if (exists($self->lannodes()->{$virtual}));

    # All we do in this stage is store the results.
    $self->solution()->{'V2P'}->{$virtual}  = $physical;
    $self->solution()->{'P2V'}->{$physical} = []
	if (!exists($self->solution()->{'P2V'}->{$physical}));

    push(@{ $self->solution()->{'P2V'}->{$physical} }, $virtual);
    $self->printdb("  $virtual $physical\n");

    return 0;
}

sub AddLinkToSolution($$$$$$$)
{
    my ($self, $vlink, $trivial, $nodeA, $portA, $nodeB, $portB) = @_;
	
    #
    # Map the solution back to our objects and store the results.
    #
    my ($linktag) = ($vlink =~ m|^(\w+)/|);
    my $virtlan;
    my $member0;
    my $member1;
    my ($lan,$virtA,$virtB) = undef;

    if (($lan,$virtA,$virtB) =
	($vlink =~ m|^linksdelaysrc/(.+)/(.+),(.+)$|)) {
	$virtlan = $self->vlans()->{$lan};
	$member0 = $virtlan->members()->{$virtA};
	$member1 = $virtlan->members()->{$virtB};
	$member0->_pnode($nodeA);
	$member0->_pport($portA);
	$member0->_delaynode($nodeB);
	$member0->_delayport($portB);
    }
    elsif (($lan,$virtA) =
	   ($vlink =~ m|^linkdelaysrc/([^/]+)/(.+)$|)) {
	$virtlan = $self->vlans()->{$lan};
	$member0 = $virtlan->members()->{$virtA};
	$member0->_pnode($nodeA);
	$member0->_pport($portA);
	$member0->_delaynode($nodeB);
	$member0->_delayport($portB);
    }
    elsif (($lan,$virtA,$virtB) =
	   ($vlink =~ m|^linksimple/(.+)/(.+),(.+)$|)) {
	$virtlan = $self->vlans()->{$lan};
	$member0 = $virtlan->members()->{$virtA};
	$member1 = $virtlan->members()->{$virtB};
	if (!$trivial) {
	    $member0->_pnode($nodeA);
	    $member0->_pport($portA);
	    $member1->_pnode($nodeB);
	    $member1->_pport($portB);
	}
    }
    elsif (($lan,$virtA) =
	   ($vlink =~ m|^linklan/([^/]+)/(.+)$|)) {
	$virtlan = $self->vlans()->{$lan};
	$member0 = $virtlan->members()->{$virtA};
	if (!$trivial) {
	    $member0->_pnode($nodeA);
	    $member0->_pport($portA);
	    # For a special case, see below.
	    $member0->_lannode($nodeB);
	    $member0->_lanport($portB);
	}
    }
    elsif (($lan,$virtA) =
	   ($vlink =~ m|^fakelan/([^/]+)/(.+)$|)) {
	$virtlan = $self->vlans()->{$lan};
	$member0 = $virtlan->members()->{$virtA};
	$member0->_pnode($nodeA);
	$member0->_pport($portA);
    }
    elsif (($lan,$virtA) =
	   ($vlink =~ m|^linkdelaydst/([^/]+)/(.+)$|)) {
	$virtlan = $self->vlans()->{$lan};
	# Special case since the other side is a lannode.
	$member0 = $virtlan->members()->{$virtA};
	$member0->_delayportB($portB);
    }
    elsif (($lan,$virtA,$virtB) =
	   ($vlink =~ m|^linksdelaydst/(.+)/(.+),(.+)$|)) {
	$virtlan = $self->vlans()->{$lan};
	$member0 = $virtlan->members()->{$virtA};
	$member1 = $virtlan->members()->{$virtB};
	$member0->_pnode($nodeA);
	$member0->_pport($portA);
	$member0->_delaynode($nodeB);
	$member0->_delayport($portB);
    }
    else {
	tberror("Bad vlink in solution: $vlink\n");
	return -1;
    }
	
    $self->solution_plinks()->{$vlink} =
	[$linktag,$virtlan,$trivial,$member0,$member1];
    if (!$trivial) {
	$self->printdb("  $vlink $nodeA$portA,$nodeB$portB\n");
    }
    else {
	$self->printdb("  $vlink trivial\n");
    }
    return 0;
}

sub ReadTextSolution($$)
{
    my ($self, $input) = @_;

    $self->ClearSolution();

    #
    # Still using the old assign format.
    #
    my $found_nodes_section = 0;
    
    while (<$input>) {
	# find the 'BEST SCORE' line and print that out for informational
	# purposes
	if (/BEST SCORE/) {
	    chomp($_);
	    $self->solution()->{"BEST SCORE"} = $_;
	}
        if (/^Nodes:/) {
            $found_nodes_section = 1;
            last;
        }
    }
    if (!$found_nodes_section) {
        tbwarn("Unable to find Nodes section in assign output");
        return -1;
    }
    $self->printdb("Nodes:\n");
    while (<$input>) {
	chomp;
	/^End Nodes$/ && last;
	my @info = split;
	my ($virtual,$physical) = @info[0,1];

	$self->AddNodeToSolution($virtual, $physical);
    }

    # read Edges
    # By convention, in plinks, the delay node is always the second
    # entry.
    my $found_edges_section = 0;
    while (<$input>) {
        if (/^Edges:/) {
            $found_edges_section = 1;
            last;
        }
    }
    if (!$found_edges_section) {
        tbwarn("Unable to find Edges section in assign output");
        return -1;
    }

    $self->printdb("Edges:\n");
    EDGEWHILE: while (<$input>) {
	my ($vlink,$rawA,$rawB) = undef;
	my $trivial = 0;

	/^End Edges$/ && last EDGEWHILE;
        my @info = split;
	my $line = $_;
	$_ = $info[1]; # type
        SWITCH1: {
	    /^intraswitch$/ && do {
		($vlink,$rawA,$rawB) = @info[0,3,5];
		last SWITCH1;
	    };
	    /^interswitch$/ && do {
		($vlink,$rawA,$rawB) = @info[0,3,$#info];
		last SWITCH1;
	    };
	    /^direct$/ && do {
		($vlink,$rawA,$rawB) = @info[0,3,5];
		last SWITCH1;
	    };
	    /^trivial$/ && do {
		# we don't have plinks for trivial links
		$vlink   = $info[0];
		$trivial = 1;
		last SWITCH1;
	    };
	    tberror("Found garbage: $line\n");
	    return -1;
	}

	my ($nodeportA,$nodeportB) = undef;
	my ($nodeA,$portA,$nodeB,$portB) = undef;
	
	if (!$trivial) {
	    $nodeportA = getnodeport($rawA);
	    $nodeportB = getnodeport($rawB);
	    # Convert them back to node:iface format.
	    $nodeportA =~ s/\//:/;
	    $nodeportB =~ s/\//:/;
	    ($nodeA,$portA) = split(":", $nodeportA);
	    ($nodeB,$portB) = split(":", $nodeportB);
	}
	$self->AddLinkToSolution($vlink, $trivial,
				 $nodeA, $portA, $nodeB, $portB);
    }
    return 0;
}

sub ReadRspecSolution($$)
{
    my ($self, $rspec) = @_;
    my %ifacemap = ();
	
    $self->printdb("Processing rspec\n");
    $self->printdb("Nodes:\n");

    foreach my $ref (@{ $self->rspec()->{'node'} }) {
	my $node_urn = $ref->{'component_urn'};
	my $virtual  = $ref->{'virtual_id'};

	# Skip LAN/Fake nodes.
	return 0
	    if (exists($self->lannodes()->{$virtual}));
	
	#
	# We need the local node object which is essentially a
	# proxy for the real node at the remote component manager.
	#
	my $proxynode = libGeni::LookupProxyNode($node_urn);
	if (!defined($proxynode)) {
	    tberror("Could not find proxynode for $node_urn\n");
	    return -1;
	}
	my $physical = $proxynode->node_id();

	$self->AddNodeToSolution($virtual, $physical);
	    
	$ifacemap{$virtual} = {};
	foreach my $linkref (@{$ref->{'interface'}}) {
	    my $component_id  = $linkref->{"component_id"};
	    my $virtual_id    = $linkref->{"virtual_id"};

	    if (GeniHRN::IsValid($component_id)) {
		my ($urn_authority,$urn_node,$urn_iface) =
		    GeniHRN::ParseInterface($component_id);
		$component_id = $urn_iface;
	    }
	    $ifacemap{$virtual}->{$virtual_id} = $component_id;
	}
    }
    $self->printdb("Links:\n");
    foreach my $ref (@{ $self->rspec()->{'link'} }) {
	my $virtual_id = $ref->{"virtual_id"};
	my $istunnel   = (exists($ref->{'link_type'}) &&
			  $ref->{'link_type'} eq "tunnel");

	next
	    if ($istunnel);
	    
	my $virtlan = $self->vlans()->{$virtual_id};
	if (!defined($virtlan)) {
	    tberror("Could not find lan $virtual_id\n");
	    return -1;
	}
	my @ifacerefs = @{ $ref->{'interface_ref'} };

	if (scalar(@ifacerefs) == 2) {
	    my ($ifaceA,$ifaceB) = @ifacerefs;

	    my $virtA  = $ifaceA->{'virtual_interface_id'};
	    my $virtB  = $ifaceB->{'virtual_interface_id'};
	    my $vnodeA = $ifaceA->{'virtual_node_id'};
	    my $vnodeB = $ifaceB->{'virtual_node_id'};
	    my $nodeA  = $self->solution()->{'V2P'}->{$vnodeA};
	    my $nodeB  = $self->solution()->{'V2P'}->{$vnodeB};
	    my $portA  = $ifacemap{$vnodeA}->{$virtA};
	    my $portB  = $ifacemap{$vnodeB}->{$virtB};
	    
	    my $vlink = "linksimple/$virtual_id/$virtA,$virtB";
	    
	    $self->AddLinkToSolution($vlink, 0,
				     $nodeA, $portA, $nodeB, $portB);
	}
	else {
	    foreach my $ifaceref (@{ $ref->{'interface_ref'} }) {
		my $virtA  = $ifaceref->{'virtual_interface_id'};
		my $vnodeA = $ifaceref->{'virtual_node_id'};
		my $nodeA  = $self->solution()->{'V2P'}->{$vnodeA};
		my $portA  = $ifacemap{$vnodeA}->{$virtA};
	    
		my $vlink = "linklan/$virtual_id/$virtA";
	    
		$self->AddLinkToSolution($vlink, 0, $nodeA, $portA);
	    }
	}
    }
    return 0;
}

#
# Interpret the results. This is really just the first stage.
#
sub InterpNodes($)
{
    my ($self) = @_;

    foreach my $virtual (keys(%{ $self->solution()->{'V2P'} })) {
	my $physical = $self->solution()->{'V2P'}->{$virtual};
	my $pnode    = $self->pnodes()->{$physical};

	# This might not exist, as for internal nodes.
	my $virtnode = $self->vnodes()->{$virtual};

	#
	# A node already allocated to this experiment, and still wanted.
	# We also have to watch for shared nodes; we will not have the
	# pnode loaded cause it is not actually ours. Instead, have to
	# look in the current_p2v table to see if we are using it. 
	#
	if (defined($pnode) ||
	    exists($self->current_p2v()->{$physical})) {
	    #
	    # Mark pnode as being reused.
	    #
	    # Look at node being mapped to the pnode;
	    # if it not in the previous map, mark node for reboot.
	    #
	    if (defined($pnode) && $pnode->_reuse() eq "reboot") {
		# No changes once it goes into reboot.
		;
	    }
	    elsif (defined($virtnode) && $virtnode->_isvirtnode()) {
		#
		# A new virtual node on an existing physical node
		# does not force the physnode to be rebooted; we can
		# set up a new virtnode on it without a reboot. If its
		# an existing virtual on the same physnode, then mark
		# both as reused; no need to reboot either. If the 
		# virtnode has moved here from someplace else, no
		# reboot of the physnode either, but obviously the
		# vnode will be released and a new one allocated.  What
		# we cannot determine is if its just a renamed node
		# (which would require a reboot of the the virtual
		# node). 
		#
		$pnode->_reuse("reused")
		    if (defined($pnode));

		if (exists($self->current_v2p()->{$virtual}) &&
		    $self->current_v2p()->{$virtual} eq $physical) {
		    # This is the virtual pnode allocated on the real pnode.
		    my $virtpname = $self->current_v2v()->{$virtual};
		    my $virtpnode = $self->pnodes()->{$virtpname};

		    $virtpnode->_reuse("reused");
		}
	    }
	    else {
		#
		# If a new node mapped to this physnode (maybe
		# even the luser changed the name of the node), or if an
		# existing virtual node moved to this physnode, must
		# reboot the physnode. Else, the physnode is being
		# reused as is, and no need to mess with it. If the
		# user requested reboot, that will be handled outside
		# of this script.
		#
		if (!exists($self->current_v2p()->{$virtual}) ||
		    $self->current_v2p()->{$virtual} ne $physical) {
		    $pnode->_reuse("reboot");
		}
		else {
		    $pnode->_reuse("reused");
		}
	    }
	}
	else {
	    my $pnodeobj = Node->Lookup($physical);

	    #
	    # This is a new node; we have to reserve it. Note that
	    # we do not reserve a widearea physnode when a virtual node
	    # is mapped to it; they are special.
	    #
	    # If there is no virtnode, then its an internal node, like
	    # a delay.
	    #
	    $self->solution()->{'TORESERVE'}->{$physical} = 1
		if ((!defined($virtnode) ||
		     !$virtnode->_isvirtnode() ||
		     !($virtnode->_isremotenode() &&
		       !$virtnode->_isdedremote())) &&
		    # Avoid allocating local shared physical node.
		    !(defined($virtnode) && $virtnode->_isvirtnode() &&
		      defined($pnodeobj->sharing_mode())));
	}

	if (!defined($virtnode)) {
	    # Internally created node. We need to deal with internally
	    # created nodes in a different way.
	}
	elsif ($virtnode->_isvirtnode()) {
	    #
	    # If mapping a virtual node, then record that, since we need
	    # to allocate the virtnodes on that physnode, later.
	    #
	    if (!exists($self->solution_virtnodes()->{$physical})) {
		$self->solution_virtnodes()->{$physical} = [];
	    }
	    push(@{$self->solution_virtnodes()->{$physical}}, $virtual);
	}
	elsif ($virtnode->_issubnode()) {
	    #
	    # Subnodes are currently not dynamically created, and there
	    # is only one subnode per physical host. That physical host
	    # needs to be allocated, if we do not already have it.
	    #
	    my $subnode_pnode = Node->Lookup($physical);
	    if (!defined($subnode_pnode)) {
		tbwarn("Could not lookup subnode host $physical\n");
		return -1;
	    }
	    my $parentname = $subnode_pnode->phys_nodeid();
	    
	    if (! exists($self->solution()->{'P2V'}->{$parentname})) {
		# Make up a name and add to the reserve list.
		my $newvname = $self->newvname($parentname, "phost");

		$self->solution()->{'TORESERVE'}->{$parentname} = 1;
		$self->solution()->{'V2P'}->{$newvname}   = $parentname;
		$self->solution()->{'P2V'}->{$parentname} = [ $newvname ];

		$self->printdb("  Adding subnode: $newvname $parentname\n");
	    }
	}
    }
}

#
# Allocate nodes.
#
sub AllocNodes($)
{
    my ($self) = @_;
    my $experiment = $self->experiment();
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();
    my $idx = $experiment->idx();
	
    if ($self->impotent()) {
	my @nodeids = keys(%{ $self->solution()->{'TORESERVE'} });

	tbinfo("Pretending to allocate @nodeids\n")
	    if (@nodeids);
	goto skip;
    }

    #
    # Move existing nodes into a holding experiment and then back.
    #
    # Why? We will avoid any UNIQUE key issues when a virt_node in the
    # topology moves from one pnode to another, or from previous to new
    # mapping.
    #
    # Another reason to do this just before nalloc of a new toreserve
    # nodes is that, we can get into name clashes. For example, lets
    # say the user called his node pc2 and it was actually mapped to
    # pc99 in the initial swapin. If this was a swapmod where the user
    # asked for another node node0 which got mapped to pc2. nalloc of
    # pc2 will result in UNIQUE key problems since there exists a
    # reserved vname pc2 (virtual name). By having this operation of
    # moving the nodes into a holding experiment and back before a new
    # nalloc, we avoid this UNIQUE key problem. Also note that simply
    # updating the vname to be the same as the node_id field also does
    # not work all the time i.e. in the example discussed above.
    #
    #
    # We need to only once during a mapping.  If it gets repeatedly
    # called coz only some pnode resources got nalloced, we do not
    # have to do the above again.
    #
    # XXX Is there a race with the shared pool deamon; the shared node
    # could get deallocated.
    # 
    my @nodeids = keys(%{ $self->oldreservednodes() });
    if (@nodeids && !$self->{'OLDRSRVCLEAN_FLAG'}) {
	system("$NFREE -o $pid $eid @nodeids");
	if ($?) {
	    tberror("Could not move nodes to old reserved holding\n");
	    return -1;
	}
	system("$NALLOC $pid $eid @nodeids");
	if ($?) {
	    tberror("Could not move nodes back from old reserved holding\n");
	    return -1;
	}
	$self->{'OLDRSRVCLEAN_FLAG'} = 1;
    }

    #
    # Now alloc new nodes. This might include nodes already allocated
    # in a previous iteration. That is okay; nalloc will ignore them.
    #
    @nodeids = keys(%{ $self->solution()->{'TORESERVE'} });
    $self->printdb("Trying to allocate @nodeids\n");
    system("$NALLOC -p $pid $eid @nodeids");
    my $exitval  = $? >> 8;

    #
    # If nalloc failed with a fatal error, lets give it up. No retry.
    # 
    if ($exitval < 0) {
	tberror("Failed to reserve any nodes.\n");
	return -1; 
    }

    #
    # Okay, if nalloc got anything, we have to set the norecover bit,
    # since tbswap operates on the principle that once new nodes are
    # reserved, recovery is no longer possible. However, if we exit
    # cleanly enough that we can deallocate the new nodes, recovery
    # is still possible. In the old assign_wrapper that was handled
    # in the Fatal(). In the new version ... 
    #
    $self->{'NORECOVER'} = 1;

    #
    # Got some, perhaps not all nodes.
    #
    my @reserved  = $experiment->NodeList(0, 1);	# objects, virtual.

    #
    # All newly allocated nodes MUST go to the INIT_DIRTY allocstate
    # since the user now has control of them. If we eventually fail,
    # nodes not in RES_READY are deallocated (retry/modify).
    #
    foreach my $pnode (@reserved) {
	my $nodeid = $pnode->node_id();
	    
	if (exists($self->solution()->{'TORESERVE'}->{$nodeid})) {
	    $self->newreserved()->{$nodeid} = $nodeid;
	    $pnode->SetAllocState(TBDB_ALLOCSTATE_RES_INIT_DIRTY())
		if (!$self->impotent());

	    #
	    # Fix all of the nodes assigned to the pnode.
	    #
	    foreach my $vname (@{ $self->solution_p2v()->{$nodeid} }) {
		$self->fixednodes()->{$vname} = $nodeid;

		# And add to the results for the next vtop print.
		$self->addfixed("$vname $nodeid");
	    }
	}
    }
    
    if ($exitval > 0) {
	#
	# We got some but no all the nodes.
	#
	my $rcount    = scalar(@reserved);
	my $tcount    = scalar(@nodeids);
	my @justnames = map { $_->node_id() } @reserved;


	# We got only some. Need to figure out which.
	tbinfo("Reserved some nodes ($rcount) we needed, ".
	       "but not all ($exitval).\n");
	
	#
	# We check to see if we were able to reserve all the fixed
	# nodes we needed. If we could not get the fixed list, then
	# this experiment is unlikely to map in the "near" future, so
	# give up now (no retry).
	#
	my @fixed = values(%{ $self->fixednodes() });
	foreach my $fixname (@fixed) {
	    if (! grep {$_ eq $fixname} @justnames) {
		tbwarn("  Could not allocate fixed node $fixname!\n");
		return -1;
	    }
	}
	
	#
	# Must extend the fixed list with newly allocated nodes so
	# that we can recreate the top file, and try again with a new
	# set.
	#
	foreach my $pnode (@reserved) {
	    my $nodeid = $pnode->node_id();
	    
	    if (exists($self->solution()->{'TORESERVE'}->{$nodeid})) {
		#
		# Fix all of the nodes assigned to the pnode.
		#
		foreach my $vname (@{ $self->solution_p2v()->{$nodeid} }) {
		    $self->fixednodes()->{$vname} = $nodeid;

		    # And add to the results for the next vtop print.
		    $self->addfixed("$vname $nodeid");
		}
	    }
	}

	#
	# Return indicator that we made forward progress (got some nodes).
	# Caller will decide if appropriate to keep trying. We made progress
	# if the return value of nalloc (number of nodes not allocated) does
	# not equal the number of nodes we tried to allocate.
	#
	return (($tcount == $exitval) ? -1 : 1);
    }

    #
    # Lets do a check to see if the shared nodes are still shared. This
    # check is advisory; we will not really know until CreateVnodes()
    # locks the tables, but if the node is not shared now cause the pool
    # daemon released it, we can still recover with another run. 
    #
    my $rerun = 0;
    
    foreach my $physical (sort(keys(%{ $self->solution_virtnodes() }))) {
	my $pnode = Node->Lookup($physical);
	if (!defined($pnode)) {
	    tberror("Could not get object for $physical\n");
	    return -1;
	}
	# Remote node. Not our problem.
	next
	    if ($pnode->isfednode());
	
	$pnode->FlushReserved();
	my $reservation = $pnode->Reservation();
	if (!defined($reservation) ||
	    (! $reservation->SameExperiment($self->experiment()) &&
	     ! $pnode->erole() eq "sharedhost")) {
	    tbinfo("$pnode is not in shared mode.\n");
	    $rerun++;
	}
    }
    return 1
	if ($rerun);

    #
    # Set the node allocstate for unused/dirty nodes.
    #
    foreach my $pnode (values(%{ $self->oldreservednodes() })) {
	if ($pnode->_reuse() eq "unused") {
	    #
	    # Node was used in previous incarnation, but not any more.
	    # Mark it for teardown by the caller (tbswap currently).
	    #
	    $pnode->SetAllocState(TBDB_ALLOCSTATE_RES_TEARDOWN())
		if (!$self->impotent());
	}
	elsif ($pnode->_reuse() eq "reboot") {
	    #
	    # Node is being reused, but for a different purpose, so
	    # it should be rebooted.
	    #
	    $pnode->SetAllocState(TBDB_ALLOCSTATE_RES_INIT_DIRTY())
		if (!$self->impotent());
	}
    }
  skip:
    #
    # Allocate Geni nodes (get tickets). Eventually we want to retry
    # the assignment and replace tickets that we could not get. 
    #
    if (defined($self->rspec()) && !$self->impotent()) {
	$self->printdb("Requesting geni tickets ...\n");
	
	if (libGeni::GetTickets($self->experiment(), $self->impotent,
				$self->user(), $self->rspec())) {
	    tberror("Could not allocate Geni Tickets\n");
	    return -1;
	}
	tbinfo("Successfully got all geni tickets we needed.\n");
    }
    
    if ($self->AllocVirtNodes() != 0) {
	tberror("Could not allocate virtual nodes\n");
	return -1;
    }
    if (!$self->impotent()) {
	#
	# Redeem the tickets. If this fails, we are going to be
	# really hosed.
	#
	if (defined($self->rspec())) {
	    $self->printdb("Redeeming geni tickets ...\n");
	    
	    if (libGeni::RedeemTickets($self->experiment(),
				       $self->user(), $self->rspec())) {
		tberror("Could not redeem Geni Tickets\n");
		return -1;
	    }
	    tbinfo("Successfully redeemed all geni tickets.\n");
	}
	tbinfo("Successfully reserved all physical nodes we needed.\n");
    }

    #
    # Update the pnodes() array with the newly allocated nodes.
    #
    foreach my $physical (keys(%{ $self->solution_p2v() })) {
	my @vlist = @{ $self->solution_p2v()->{$physical} };

	my $pnode = Node->Lookup($physical);
	if (!defined($pnode)) {
	    tberror("Could not get object for $physical\n");
	    return -1;
	}
	$self->pnodes()->{$physical} = $pnode;

	# Node might need the link delay kernel.
	$pnode->_needslinkdelay(0);
	# ipfw pipe numbers.
	$pnode->_pipenumber(110);
	# Routing table id for each vnode on a pnode. Do not use 0.
	$pnode->_rtabid(1);
	# For assigning dynamic ports.
	$pnode->_portnext(TBDB_LOWVPORT);
	$pnode->_porthigh(TBDB_MAXVPORT);
	# To avoid unitialized access.
	$pnode->_reuse("used");
	
	#
	# The node might not have a reservation entry if in
	# impotent mode. But if the node is shared, it *will*
	# so if there is no erole, we know the node is not shared.
	#
	$pnode->_sharedhost((defined($pnode->erole()) &&
			     $pnode->erole() eq "sharedhost") ? 1 : 0);
	
	#
	# Typically, its one-to-one, unless its a physnode hosting
	# virtnodes, in which case the mapping is one-to-many.
	#
	foreach my $virtual (@vlist) {
	    #
	    # Nodes that we create in assign_wrapper, like delays
	    # nodes (tbdelayXX) and jail hosts (vhost-XX) do not have
	    # entries in the virt_nodes table. Should we form one, so
	    # that we can refer to all nodes consistently?
	    #
	    next
		if (!exists($self->vnodes()->{$virtual}));

	    my $virtnode = $self->vnodes()->{$virtual};
	    
	    if ($virtnode->_isvirtnode()) {
		#
		# The physical node is the virtual node on the physical.
		#
		my $vpnode = Node->Lookup($self->solution_v2v()->{$virtual});
		if (!defined($vpnode)) {
		    tberror("Could not get object for $physical\n");
		    return -1;
		}
		$self->pnodes()->{$vpnode->node_id()} = $vpnode;
		$virtnode->_onsharednode($pnode->_sharedhost());
		$virtnode->_pnode($vpnode);
	    }
	    else {
		# Default this for physnodes.
		$virtnode->_onsharednode(0);
		$virtnode->_pnode($pnode);
	    }
	}
    }
    $self->SetPortRange() == 0
	or return -1;
    
    #
    # Set the sshd ports. Its complicated by the fact that a single
    # experiment could have multiple jailed nodes on the same physical
    # node, and so a per-experiment wide sshd port is not going to
    # work unless there happens to be just one jail per node, but
    # thats not likely in the local area case.
    #
    foreach my $vnodename (sort(keys(%{ $self->solution_v2v() }))) {
	my $vpnodename = $self->solution_v2v()->{$vnodename};
	my $vpnode     = $self->pnodes()->{$vpnodename};
	
	if ($vpnode->isjailed() || $vpnode->isremotenode()) {
	    my $pnodename = $self->solution_v2p()->{$vnodename};
	    my $pnode     = $self->pnodes()->{$pnodename};
	    my $sshdport  = nextipportnum($pnode);

	    return -1
		if ($sshdport < 0);

	    $self->printdb("sshdport: ".
			   "$vnodename $vpnodename $pnodename $sshdport\n");

	    DBQueryWarn("update nodes set sshdport=$sshdport ".
			"where node_id='$vpnodename'")
		or return -1 if (!$self->impotent());
	}
    }

    #
    # Must post pass the trafgens list to make sure no ip port collisions.
    #
    foreach my $virt_trafgen ($self->virt_trafgens()->Rows()) {
	my $vnodename = $virt_trafgen->vnode();
	my $pnodename = $self->solution_v2p()->{$vnodename};
	my $pnode     = $self->pnodes()->{$pnodename};
	my $ipport    = nextipportnum($pnode);

	my $trafname         = $virt_trafgen->vname();
	my $target_vnodename = $virt_trafgen->target_vnode();
	my $target_trafname  = $virt_trafgen->target_vname();

	$self->printdb("Setting $virt_trafgen port to $ipport\n");

	if (!$self->impotent()) {
	    DBQueryWarn("update virt_trafgens set port=$ipport ".
			"where exptidx='$idx' and ".
			"      vnode='$vnodename' and vname='$trafname'")
		or return -1;
	
	    DBQueryWarn("update virt_trafgens set target_port=$ipport ".
			"where exptidx='$idx' and ".
			"      vnode='$target_vnodename' and ".
			"      vname='$target_trafname'")
		or return -1;
	}
    }

    #
    # Upload the v2pmap table. The only place I know that cares about
    # this table is dohosts() in tmcd.c
    #
    foreach my $vnodename (keys(%{ $self->solution_v2p() })) {
	#
	# If a virtual node, the pnode is the virtual node, not the
	# underlying physical node.
	#
	my $pnodename = (exists($self->solution_v2v()->{$vnodename}) ?
			 $self->solution_v2v()->{$vnodename} :
			 $self->solution_v2p()->{$vnodename});

	$self->printdb("v2pmap: $vnodename $pnodename\n");

	DBQueryWarn("insert into v2pmap set ".
		    "  pid='$pid', eid='$eid', exptidx='$idx', ".
		    "  vname='$vnodename', node_id='$pnodename'")
	    or return -1 if (!$self->impotent());
    }
    
    return 0;
}

# Allocate virtnodes. This is a little hokey in that the virtnodes
# just need to be allocated from the pool that is on the real node. We
# know they are free, but we should go through nalloc anyway. If
# anything fails, no point in retry.
#
sub AllocVirtNodes($)
{
    my ($self) = @_;
    my $experiment = $self->experiment();
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();

    foreach my $physical (sort(keys(%{ $self->solution_virtnodes() }))) {
	my @vlist = sort(@{ $self->solution_virtnodes()->{$physical} });
	my $numvs = @vlist;
	my @plist = ();
	my @oplist = ();
	my @ovlist = ();
	my @delvlist = ();

	$self->printdb("On pnode $physical: vnodes @vlist\n");

	#
	# If updating, need to watch for nodes that are already reserved.
	# We save that info in oplist/ovlist, and build a new vlist for
	# avail, of just the nodes we need in this run. 
	#
	if ($self->updating()) {
	    my @oldvlist = ();
	    if (exists($self->current_p2v()->{$physical})) {
		@oldvlist = @{ $self->current_p2v()->{$physical} };
	    } 
	    $self->printdb("On pnode $physical: oldvlist: @oldvlist\n");

	    # newvlist = elements in vlist but not in oldvlist
	    #            i.e. newly mapped to this pnode
	    my @newvlist = array_diff( \@vlist, \@oldvlist );
	    $self->printdb("On pnode $physical: newvlist: @newvlist\n");

	    # curvlist = elements in both vlist and oldvlist
	    #            i.e. vnodes mapped the same way from previous
	    #            to current
	    # This is the same as @vlist intersection @oldvlist
	    # since the lists have no duplicates
	    my @curvlist = array_diff( \@vlist, \@newvlist );
	    $self->printdb("On pnode $physical: curvlist: @curvlist\n");

	    foreach my $virtual (@curvlist) {
		if (exists($self->current_v2v()->{$virtual}) ) {
		    push(@oplist, $self->current_v2v()->{$virtual});
		    push(@ovlist, $virtual);
		}
	    }

	    # delvlist = elements in oldvlist not in vlist
	    #            i.e. vnodes that moved to another pnode or
	    #            went away
	    @delvlist = array_diff( \@oldvlist, \@vlist );
	    $self->printdb("On pnode $physical: delvlist: @delvlist\n");

	    while (scalar(@newvlist) && scalar(@delvlist)) {
		my $del_vnode = pop(@delvlist);
		if (exists($self->current_v2v->{$del_vnode})) {
		    my $reserved_node = $$self->current_v2v()->{$del_vnode};
		    push(@oplist, $reserved_node);
		    my $new_vnode = pop(@newvlist);
		    push(@ovlist, $new_vnode);
		}
	    }
	
	    # These are the new nodes we need to allocate
	    @vlist = @newvlist;
	    $numvs = scalar(@vlist);

	    if (@oplist) {
		$self->printdb("Reusing vnodes @oplist\n"); 
	    }
	}

	#
	# Still need to allocate some virtnodes?
	#
	if ($numvs) {
	    #
	    # All vnodes on pnode are dynamic if the first one is.
	    # We also assume that we do not mix vnode types on a pnode; bad.
	    #
	    my $virtnode = $self->vnodes()->{$vlist[0]};
	    
	    if ($virtnode->_isdynamic()) {
		# Always use the base type ... node type system sucks.
		my $basetype = $virtnode->_typeinfo->type();

		#
		# We might be expecting to allocate a shared vnode on
		# a shared host. We cannot be sure until CreateVnodes
		# does the table locking, and so it might actually
		# fail (CreateVnodes will make sure).  At this time I
		# am not going to worry about rerunning the
		# assignment; we will fail with a temp resource
		# shortage and let the user try again.
		#
		my $sharedokay = $virtnode->_sharedokay();
		
		#
		# Call into library. Be sure to pass impotent mode along.
		#
		if (Node::CreateVnodes(\@plist,
				       {"pid"      => "$pid",
					"eid"      => "$eid",
					"count"    => $numvs,
					"vtype"    => $basetype,
					"nodeid"   => $physical,
					"debug"    => 0,
					"verbose"  => $self->verbose(),
					"impotent" => $self->impotent(),
					"sharedokay" => $sharedokay,
					"regression" => $self->regression()})
		    < 0) {
		    tberror("Could not allocate vnodes on $physical\n");
		    return -1;
		}
	    }
	    else {
		#
		# Run avail to get the list of virtnodes on the phys node. We
		# already know there are enough, since assign knows that.
		#
		$self->printdb("Asking avail for $numvs for vnodes: ".
			       "@vlist on $physical\n");
		if (! open(AVAIL, "$AVAIL ".
			   "virtonly=$physical rand limit=$numvs|")) {
		    tberror("Could not start avail\n");
		    return -1;
		}
		while (<AVAIL>) {
		    next
			if (! /^\|/);
		    next
			if (/node_id/);

		    if ($_ =~ /^\|([-a-zA-Z0-9]+)\s*\|(\w+)\s*\|(\w+)\s*\|$/) {
			push(@plist, $1);
		    }
		    else {
			tberror("Bad line from avail: $_\n");
			return -1;
		    }
		}
		close(AVAIL);

		# Sanity check.
		if (scalar(@vlist) != scalar(@plist)) {
		    $self->printdb("avail gave " . scalar(@plist) .
				   " vnodes: @plist on $physical\n");
		    tberror("Could not map some virtual nodes on $physical\n");
		    return -1;
		}

		#
		# Try to allocate. Note, if this fails we are done
		# for. Okay for now since it is never the case that it
		# should fail!
		#
		if ($self->impotent()) {
		    tbinfo("Selected for $physical: @plist\n");
		    tbinfo("Skipping physical reservation, as directed.\n");
		}
		else {
		    tbinfo("Reserving on $physical: @plist ...\n");
		    system("$NALLOC $pid $eid @plist");
		    if ($?) {
			tberror("Failed to reserve @plist (on $physical)\n");
			return -1;
		    }
		}
	    }
	}

	if ($self->updating()) {
	    #
	    # Append the lists we created above, so that we get all of them
	    # in the loop below.
	    #
	    @plist = (@plist, @oplist);
	    @vlist = (@vlist, @ovlist);
	}
    
	while (@plist) {
	    my $virtphys = pop(@plist);
	    my $virtual  = pop(@vlist);
	    my $pnode    = Node->Lookup($virtphys);
	    if (!defined($pnode)) {
		tberror("Could not get node object for $virtphys\n");
		return -1;
	    }

	    $self->solution_v2v()->{$virtual}  = $virtphys;
	    $self->printdb("  Mapping $virtual to $virtphys on $physical\n");

	    #
	    # New virtual nodes are always clean. Old ones stay in whatever
	    # state they were in so that os_setup/vnode_setup know they
	    # need to reboot them.
	    #
	    if (!$self->impotent()) {
		if (!exists($self->current_v2v()->{$virtual})) {
		    $pnode->SetAllocState(TBDB_ALLOCSTATE_RES_INIT_CLEAN());
		}
		elsif ($self->current_v2v()->{$virtual} ne $virtphys) {
		    # Node has moved!
		    $pnode->SetAllocState(TBDB_ALLOCSTATE_RES_INIT_DIRTY());
		}
	    }
	}

	# Since we have some extra physical vnodes reserved on this pnode,
	# we will let tbswap tear them down.
	while (@delvlist) {
	    my $del_vnode = pop(@delvlist);

	    if (exists($self->current_v2v()->{$del_vnode})) {
		my $pname = $self->current_v2v()->{$del_vnode};
		my $pnode = $self->pnodes()->{$pname};

		$pnode->SetAllocState(TBDB_ALLOCSTATE_RES_TEARDOWN())
		    if (!$self->impotent());
	    }		
	}
    }

    return 0;
}

#
# Now interpret the plinks. This comes out of assign_wrapper, no way
# I would try to mess with it, not yet.
#
sub InterpLinks($)
{
    my ($self) = @_;
    my $experiment = $self->experiment();
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();

    $self->printdb("Interpreting link/lan results from assign\n");

    my $vlanid     = 0;
    my %portmap    = ();
    my %protovlans = ();

    my %plinks = %{ $self->solution_plinks() };

    foreach my $plink (sort(keys(%plinks))) {
	my ($linktag,$virtlan,$trivial,$member0,$member1) = @{$plinks{$plink}};
	my $lan = $virtlan->vname();

	#
	# trivial links do not have physical links, so no delay
	# nodes. But, we *do* use trivial links for intranode links,
	# and thus there could be link delays (ie: two jailed nodes on
	# a link/lan assigned to the same phys node).
	#
	if ($trivial) {
	    $self->printdb("plink $plink - trivial\n");
	}
	else {
	    $self->printdb("plink $plink\n");
	}

	# There is always a member0.
	my $virtA  = $member0;
	my $vnodeA = $member0->vnode();
	my $vportA = $member0->vport();
	my ($nodeA,$portA) = undef;
	# But it might be trivial, so no portinfo.
	if (!$trivial) {
	    $nodeA  = $member0->_pnode();
	    $portA  = $member0->_pport();
	}
	my $virtnodeA = $self->vnodes()->{$vnodeA};

	if ($linktag eq "linksdelaysrc") {
	    # trivial links do not have physical links, so no delay nodes.
	    next
		if ($trivial);

	    # The other node in the link that correspond to the topology.
	    my $virtC  = $member1;
	    my $nodeC  = $member1->_pnode();
	    my $portC  = $member1->_pport();
	    my $vnodeC = $member1->vnode();
	    my $vportC = $member1->vport();
	    # The delay node port/links
	    my $nodeB = $member0->_delaynode();
	    my $portB = $member0->_delayport();
	    my $nodeD = $member1->_delaynode();
	    my $portD = $member1->_delayport();

	    $self->printdb("LINK delay: $virtA,$virtC - ".
			   "$nodeA:$portA,$nodeB:$portB,".
			   "$nodeD:$portD,$nodeC:$portC\n");

	    my $protolan    = ProtoLan->Create($experiment, "$lan",
					       $self->impotent());
	    my $protolansrc = ProtoLan->Create($experiment,
					       "$lan" . "-delaysrc",
					       $self->impotent(),
					       $protolan);
	    my $protolandst = ProtoLan->Create($experiment,
					       "$lan" . "-delaydst",
					       $self->impotent(),
					       $protolan);
	    $protolansrc->SetType("vlan");
	    $protolandst->SetType("vlan");
	    $protolansrc->SetRole("delay");
	    $protolandst->SetRole("delay");
	    $protolan->SetRole("link/lan");
	    $protolan->AddInterface($nodeC, $vnodeC, $vportC, $portC);
	    $protolan->AddInterface($nodeA, $vnodeA, $vportA, $portA);
	    $protolansrc->AddMember($nodeA, $portA);
	    $protolansrc->AddMember($nodeB, $portB);
	    $protolandst->AddMember($nodeC, $portC);
	    $protolandst->AddMember($nodeD, $portD);
	
	    $self->AddDelay($virtlan, $member0, $member1,
			    $nodeB,$portB,$portD,0,
			    $self->delaylinks()->{$plink});
	    
	    #
	    # Setup portmap using virt members in plink name.
	    #
	    $portmap{$virtA} = $portA;
	    $portmap{$virtC} = $portC;

	    #
	    # Set up tracing across the delay node (both directions).
	    #
	    $self->SetUpTracing($virtlan, $member0, $nodeB, $portB, $portD);
	    $self->SetUpTracing($virtlan, $member1, $nodeB, $portD, $portB);
	}
	elsif ($linktag eq "linkdelaysrc") {
	    # trivial links do not have physical links, so no delay nodes.
	    next
		if ($trivial);

	    # The delay node port/links
	    my $nodeB = $member0->_delaynode();
	    my $portB = $member0->_delayport();
	    my $nodeD = $nodeB;
	    my $portD = $member0->_delayportB();

	    $self->printdb("LAN delay: $virtA - ".
			   "$nodeA:$portA,$nodeB:$portB,$nodeD:$portD\n");

	    #
	    # Construct a name for the delay link. This has to be unique
	    # since now (with virtual nodes) we can have multiple vnodes
	    # from the same lan, on the same pnode, without using veths.
	    # Multiple routing tables made this possible.
	    #
	    my $dlink = $lan . "/dlink/$vnodeA";

	    my $protolan = ProtoLan->Lookup($experiment, $lan);
	    if (!defined($protolan)) {
		$protolan = ProtoLan->Create($experiment, "$lan",
					     $self->impotent());
		$protolan->SetRole("link/lan");
	    }
	    $protolan->AddInterface($nodeA, $vnodeA, $vportA, $portA);

	    my $protolanlan = ProtoLan->Lookup($experiment,
					       $lan . "-delaylan");
	    if (!defined($protolanlan)) {
		$protolanlan = ProtoLan->Create($experiment,
						$lan . "-delaylan",
						$self->impotent(),
						$protolan);
		$protolanlan->SetType("vlan");
		$protolanlan->SetRole("delay");
	    }
	    $protolanlan->AddMember($nodeD, $portD);
	
	    my $protolanlink = ProtoLan->Create($experiment, $dlink,
						$self->impotent(),
						$protolan);
	    $protolanlink->SetType("vlan");
	    $protolanlink->SetRole("delay");
	    $protolanlink->AddMember($nodeA, $portA);
	    $protolanlink->AddMember($nodeB, $portB);

	    $self->AddDelay($virtlan, $member0, $member0,
			    $nodeB,$portB,$portD,1,
			    $self->delaylinks()->{$plink});
	    
	    # Setup portmap using virt members in plink name.
	    $portmap{$virtA} = $portA;

	    #
	    # Set up tracing across the delay node (one direction
	    # cause its a lan).
	    #
	    $self->SetUpTracing($virtlan, $member0, $nodeB, $portB, $portD);
	}
	elsif ($linktag eq "linksimple") {
	    # The other node in the link that correspond to the topology.
	    my $virtB  = $member1;
	    my $vnodeB = $member1->vnode();
	    my $vportB = $member1->vport();
	    my ($nodeB,$portB) = undef;
	    my $protolink;
	    my $virtnodeB = $self->vnodes()->{$vnodeB};
	
	    #
	    # If the link is delayed, its with endpoint delays, not a
	    # delay node.
	    #
	    # trivial links do not have physical links, but could be using
	    # virtual interfaces on the same node. 
	    #
	    if (! $trivial) {
		$nodeB  = $member1->_pnode();
		$portB  = $member1->_pport();
		
		$self->printdb("LINK simple: $virtA,$virtB - ".
			       "$nodeA:$portA,$nodeB:$portB\n");

		if ($virtlan->usevirtiface()) {
		    my $protovlan;
		    
		    #
		    # When using virtual interfaces we need to create a
		    # protolan for the underlying vlan, and then another link
		    # for the endpoints that run over that vlan. Note though
		    # that there might be multiple emulated links running on
		    # on this physical link. Once we have everything created
		    # there is a postpass to merge the vlans into a single
		    # supervlan since a nodeport can be in just a single vlan.
		    #
		    # If both nodes shared, do not need the vlan.
		    # If only one of the nodes is shared, must still create
		    # an underlying vlan. 
		    # 
		    #
		    if ((!($virtnodeA->_onsharednode() &&
			   $virtnodeB->_onsharednode())) ||
			$virtlan->_needvlan()) {
			my $lanid = "v" . "$lan" . $vlanid++;

			$protovlan = ProtoLan->Create($experiment, $lanid,
						      $self->impotent());
			$protovlan->SetRole("encapsulation");
			$protovlan->SetType("vlan");
			$protovlan->SetEncapStyle($virtlan->_encapstyle());
			$protovlan->SetAttribute("link/lan", $lan);

			$protovlan->AddMember($nodeA, $portA)
			    if (!$protovlan->IsMember($nodeA, $portA));
			$protovlan->AddMember($nodeB, $portB)
			    if (!$protovlan->IsMember($nodeB, $portB));
		    }

		    #
		    # Create some new virtual devices.
		    #
		    my $virtifaceA = $self->NewVirtIface($virtlan, $member0,
							 $nodeA, $portA);
		    return -1
			if (!defined($virtifaceA));
		    my $virtifaceB = $self->NewVirtIface($virtlan, $member1,
							 $nodeB, $portB);
		    return -1
			if (!defined($virtifaceB));

		    #
		    # We need to reserve the shared bandwidth.
		    #
		    if (exists($self->delaylinks()->{$plink}) ||
			$member0->_reservebw() || $member1->_reservebw()) {
			my ($bandwidth,$rbandwidth) = 0;
			
			if (exists($self->delaylinks()->{$plink})) {
			    (undef,$bandwidth,undef,undef,
			     undef,$rbandwidth,undef) =
				 @{$self->delaylinks()->{$plink}};
			}
			else {
			    $bandwidth  = $member0->_reservebw();
			    $rbandwidth = $member1->_reservebw();
			}

			if ($virtnodeA->_onsharednode() &&
			    !$self->impotent() && 
			    $virtifaceA->ReserveSharedBandwidth($bandwidth)) {
			    tbinfo("Could not reserve shared bandwidth: ".
				   "$member0,$bandwidth,$virtifaceA\n");
			    return -1;
			}
			if ($virtnodeB->_onsharednode() &&
			    !$self->impotent() && 
			    $virtifaceB->ReserveSharedBandwidth($rbandwidth)) {
			    tbinfo("Could not reserve shared bandwidth: ".
				   "$member1,$rbandwidth,$virtifaceB\n");
			    return -1;
			}
		    }
		    $portA = $virtifaceA->viface();
		    $portB = $virtifaceB->viface();

		    $protolink = ProtoLan->Create($experiment, $lan,
						  $self->impotent(),
						  $protovlan);
		    $protolink->SetType((defined($protovlan) ?
					"emulated" : "emulated-shared"));
		    $protolink->SetRole("link/lan");
		    $protolink->AddInterface($nodeA, $vnodeA, $vportA, $portA);
 		    $protolink->AddInterface($nodeB, $vnodeB, $vportB, $portB);
		}
		else {
		    $protolink = ProtoLan->Create($experiment, $lan,
						  $self->impotent());
		    $protolink->SetType("vlan");
		    $protolink->SetRole("link/lan");
		    $protolink->AddInterface($nodeA, $vnodeA, $vportA, $portA);
		    $protolink->AddInterface($nodeB, $vnodeB, $vportB, $portB);
		}
	    }
	    else {
		# If the trivial link has all simulated members, we
		# don't want a veth interface
		if (! $virtlan->_allsim()) {
		    # No phys mapping. We create a veth, but there is
		    # no phys mapping for the port and no underlying
		    # (linked) vlan.
		    $nodeA = $self->solution_v2p()->{$vnodeA};
		    $nodeB = $self->solution_v2p()->{$vnodeB};

		    my $virtifaceA = $self->NewVirtIface($virtlan,
							 $member0, $nodeA);
		    return -1
			if (!defined($virtifaceA));
		    my $virtifaceB = $self->NewVirtIface($virtlan, $member1,
							 $nodeB);
		    return -1
			if (!defined($virtifaceB));
		    
		    $portA = $virtifaceA->viface();
		    $portB = $virtifaceB->viface();

		    $self->printdb("LINK simple (trivial): $virtA,$virtB - ".
				   "$nodeA:$portA,$nodeB:$portB\n");
		    
		    $protolink = ProtoLan->Create($experiment, $lan,
						  $self->impotent());
		    $protolink->SetType("trivial");
		    $protolink->SetRole("link/lan");
		    $protolink->AddInterface($nodeA, $vnodeA, $vportA, $portA);
		    $protolink->AddInterface($nodeB, $vnodeB, $vportB, $portB);
		}
		else {
		    # next plink
		    next;
		}
	    }
	
	    # Setup portmap using virt members in plink name.
	    $portmap{$virtA} = $portA;
	    $portmap{$virtB} = $portB;
	
	    if (exists($self->delaylinks()->{$plink})) {
		my ($delay,$bandwidth,$backfill,$loss,
		    $rdelay,$rbandwidth,$rbackfill,$rloss,$trivial_ok) =
			@{$self->delaylinks()->{$plink}};
		
		if (!$trivial_ok || ($trivial_ok && $trivial)) {
		    #
		    # Two entries, one for each side of the duplex link.
		    #
		    $self->AddLinkDelay($virtlan,$member0,$nodeA,$portA,0,
					[$delay,$bandwidth,$backfill,$loss]);

		    $self->AddLinkDelay($virtlan,$member1,$nodeB,$portB,0,
				       [$rdelay,$rbandwidth,$rbackfill,$rloss]);
		}
	    }
	    #
	    # Set up tracing across the link. There is trace on each end node,
	    # on the output (after the linkdelay above).
	    #
	    $self->SetUpTracing($virtlan, $member0, $nodeA, undef, $portA);
	    $self->SetUpTracing($virtlan, $member1, $nodeB, undef, $portB);
	}
	elsif ($linktag eq "linklan") {
	    # A single node in a lan, no delay node.
	    my $protolan;

	    #
	    # trivial links do not have physical links, but could be using
	    # virtual interfaces on the same node. 
	    #
	    if (! $trivial) {
		$self->printdb("LAN node: $virtA - $nodeA:$portA\n");
		
		if ($virtlan->usevirtiface()) {
		    #
		    # Look for the underlying protovlan for this lan. Create
		    # new one otherwise.
		    #
		    my $protovlan;
		    
		    if (!$virtlan->_sharednodes() ||
			$virtlan->_sharednodes() != $virtlan->memberlist() ||
			$virtlan->_needvlan()) {
			if (exists($protovlans{$lan})) {
			    $protovlan = $protovlans{$lan};
			}
			else {
			    my $lanid = "v" . "$lan" . $vlanid++;
			    $protovlan = ProtoLan->Create($experiment, $lanid,
							  $self->impotent());
			    $protovlan->SetRole("encapsulation");
			    $protovlan->SetType("vlan");
			    $protovlan->SetEncapStyle($virtlan->_encapstyle());
			    $protovlan->SetAttribute("link/lan", $lan);
			    $protovlans{$lan} = $protovlan;
			}
			$protovlan->AddMember($nodeA, $portA)
			    if (!$protovlan->IsMember($nodeA, $portA));
		    }
		
		    #
		    # Create new veth device.
		    #
		    my $virtiface = $self->NewVirtIface($virtlan, $member0,
							$nodeA, $portA);
		    return -1
			if (!defined($virtiface));
		    #
		    # We need to reserve the shared bandwidth.
		    #
		    if (exists($self->delaylinks()->{$plink}) ||
			$member0->_reservebw()) {
			my ($bandwidth,$rbandwidth) = 0;
			
			if (exists($self->delaylinks()->{$plink})) {
			    (undef,$bandwidth,undef,undef,
			     undef,$rbandwidth,undef) =
				 @{$self->delaylinks()->{$plink}};
			}
			else {
			    $bandwidth = $rbandwidth = $member0->_reservebw();
			}
			my $maxbw = max($bandwidth, $rbandwidth);
			if ($virtnodeA->_onsharednode() &&
			    !$self->impotent() && 
			    $virtiface->ReserveSharedBandwidth($maxbw)) {
			    tbinfo("Could not reserve shared bandwidth: ".
				   "$member0,$maxbw,$virtiface\n");
			    return -1;
			}
		    }
		    $portA = $virtiface->viface();

		    $protolan = ProtoLan->Lookup($experiment, $lan);
		    if (defined($protolan)) {
			#
			# Watch for a lan that mixes trivial links and
			# actual vlan encapsulated links. We might
			# have processed a trivial member first, in
			# which case we have to set its link pointer
			# to the protovlan.
			#
			if ($protolan->type() eq "trivial") {
			    $protolan->SetLink($protovlan);
			}
		    }
		    else {
			$protolan = ProtoLan->Create($experiment, $lan,
						     $self->impotent(),
						     $protovlan);
		    }
		    $protolan->SetType((defined($protovlan) ?
				       "emulated" : "emulated-shared"));

		    $protolan->SetRole("link/lan");
		    $protolan->AddInterface($nodeA, $vnodeA, $vportA, $portA);
		
		    #
		    # If the "lannode" is placed on a node, and that node is
		    # different than the current node, we have to connect the
		    # two in the vlan. Typically, the lannode is placed on a
		    # switch, and this is not an issue. Rob understands this!
		    #
		    if (!$virtnodeA->_onsharednode() &&
			! ($member0->_lannode() ne "null" &&
			   $member0->_lanport() ne "null" &&
			   $member0->_lannode() eq $nodeA &&
			   $member0->_lanport() eq $portA)) {
			$protovlan->AddMember($member0->_lannode(),
					      $member0->_lanport())
			    if (!$protovlan->IsMember($member0->_lannode(),
						      $member0->_lanport()));
			$self->AddVirtPatch($lan,
					    $member0->_lannode(),
					    $member0->_lanport());
		    }
		}
		else {
		    $protolan = ProtoLan->Lookup($experiment, $lan);
		    if (!defined($protolan)) {
			#
			# XXX Watch for a lan that mixes delayed and
			# non-delayed members. We should create the
			# protolans earlier.
			#
			$protolan = ProtoLan->Create($experiment, $lan,
						     $self->impotent());
		    
			if ($virtlan->_delayed()) {
			    my $protolanlan =
				ProtoLan->Create($experiment,
						 $lan . "-delaylan",
						 $self->impotent(),
						 $protolan);
			    $protolanlan->SetType("vlan");
			    $protolanlan->SetRole("delay");
			}
			else {
			    $protolan->SetType("vlan");
			}
			$protolan->SetRole("link/lan");
		    }
		    $protolan->AddInterface($nodeA, $vnodeA, $vportA, $portA);
		    if ($virtlan->_delayed()) {
			my $protolanlan =
			    ProtoLan->Lookup($experiment,
					     $lan . "-delaylan");
			$protolanlan->AddMember($nodeA, $portA);
		    }
		}
	    }
	    else {
		# If the trivial lan has all simulated members, we
		# don't want a veth interface
		if (! $virtlan->_allsim()) {
		    # No phys mapping. We create a veth, but there is
		    # no phys port.
		    $nodeA = $self->solution_v2p()->{$vnodeA};
		    my $virtiface = $self->NewVirtIface($virtlan, $member0,
							$nodeA);
		    return -1
			if (!defined($virtiface));
		    
		    $portA = $virtiface->viface();

		    $self->printdb("LAN node (trivial): ".
				   "$virtA - $nodeA:$portA\n");

		    $protolan = ProtoLan->Lookup($experiment, $lan);
		    if (!defined($protolan)) {
			$protolan = ProtoLan->Create($experiment, $lan,
						     $self->impotent());
			$protolan->SetType("trivial");
			$protolan->SetRole("link/lan");
		    }
		    $protolan->AddInterface($nodeA, $vnodeA, $vportA, $portA);
		}
		else {
		    # next plink
		    next;
		}
	    }
	    # Setup portmap using virt members in plink name.
	    $portmap{$virtA} = $portA;
	
	    if (exists($self->delaylinks()->{$plink})) {
		my ($delay,$bandwidth,$backfill,$loss,
		    $rdelay,$rbandwidth,$rbackfill,$rloss,$trivonly) =
			@{$self->delaylinks()->{$plink}};

		if (!$trivonly || $trivonly && $trivial) {
		    #
		    # One entry, comprising each side of the link to lan.
		    #
		    $self->AddLinkDelay($virtlan,$member0,$nodeA,$portA,1,
					$self->delaylinks()->{$plink});
		}
	    }
	    #
	    # Set up tracing on the end node (one direction cause its a lan).
	    #
	    $self->SetUpTracing($virtlan, $member0, $nodeA, undef, $portA);
	}
	elsif ($linktag eq "fakelan") {
	    #
	    # No trivial links, emulated links, delays, vlans. We do
	    # however need to come up with an ssid?
	    #
	    $self->printdb("FakeLan - $virtA - $nodeA:$portA\n");
	    
	    my $protolan = ProtoLan->Lookup($experiment, $lan);
	    $protolan = ProtoLan->Create($experiment, $lan, $self->impotent())
		if (!defined($protolan));
	    $protolan->SetType("fakelan");
	    $protolan->SetRole("link/lan");
	    $protolan->AddInterface($nodeA, $vnodeA, $vportA, $portA);
	
	    $portmap{$virtA} = $portA;

	    #
	    # Set up tracing on the end node (one direction cause its a lan).
	    #
	    $self->SetUpTracing($virtlan, $member0, $nodeA, undef, $portA);
	}
	elsif ($plink =~ m|^linkdelaydst/([^/]+)/(.+)$| ||
	       $plink =~ m|^linksdelaydst/(.+)/(.+),(.+)$|) {
	    next;
	}
	else {
	    warn("Bad plink: $plink\n");
	}
    }
    $self->{'SOLUTION'}->{'PORTMAP'} = \%portmap;

    #
    # Locally shared nodes.
    #
    # This should go elsewhere ...
    #
    my @sharedpnodes = ();

    foreach my $virtual (keys(%{ $self->solution_v2p() })) {
	my $pnode = $self->pnodes()->{$self->solution_v2p()->{$virtual}};
	my $virtnode = $self->vnodes()->{$virtual};

	# internally created node ...
	next
	    if (!defined($virtnode));
	next
	    if ($pnode->_reuse() eq "unused");
	next
	    if ($pnode->isvirtnode());

	if (defined($virtnode->sharing_mode()) &&
	    $virtnode->sharing_mode() eq "shared_local") {
	    push(@sharedpnodes, $pnode);
	}
    }
    if (@sharedpnodes > 1) {
	my $protovlan = ProtoLan->Create($experiment, "sharedlan",
					 $self->impotent());
	$protovlan->SetRole("encapsulation");
	$protovlan->SetType("vlan");
	$protovlan->SetEncapStyle("default");
	# Total hack ... see snmpit.
	$protovlan->SetAttribute("trunk_mode", "dual");
	
	foreach my $pnode (@sharedpnodes) {
	    my $pnodename = $pnode->node_id();
	    my @interfaces;
	    if ($pnode->AllInterfaces(\@interfaces)) {
		tberror("Could not get interface list for $pnode\n");
		return -1;
	    }
	    foreach my $interface (@interfaces) {
		my $iface = $interface->iface();
		my $type  = $interface->type();
		
		next
		    if ($interface->role() ne TBDB_IFACEROLE_EXPERIMENT());

		$protovlan->AddMember($pnodename, $iface);
		
		my $speed = $self->interfacespeedmbps($type, "ethernet");
		DBQueryWarn("update interfaces set " .
			    "   current_speed='$speed',trunk=1 " .
			    "where node_id='$pnodename' and iface='$iface'")
		    or return -1 if (!$self->impotent());

		#
		# Do not do this for nodes already in the shared experiment.
		# It would reset the in-use bandwidth. Bad.
		#
		if (!exists($self->current_p2v()->{$pnodename})) {
		    # Must convert this to kbps like everything else is.
		    $speed = $speed * 1000;
		
		    DBQueryWarn("update interface_state set " .
				"   remaining_bandwidth='$speed' " .
				"where node_id='$pnodename' and ".
				"      iface='$iface'")
			or return -1 if (!$self->impotent());
		}
	    }
	}
    }

    # Write the vlans to the DB.
    $self->UploadVlans() == 0
	or return -1;
    $self->UpLoadTunnels() == 0
	or return -1;
    $self->UpLoadInterfaceSettings() == 0
	or return -1;

    return 0;
}

#
# Initialize the nodes.
#
sub InitializePhysNodes($)
{
    my ($self) = @_;
    
    #
    # Init each pnode.
    #
    foreach my $pnodename (keys(%{ $self->solution_p2v() })) {
    	#
	# When initializing physical nodes, we can determine
	# everything we need from the first virtual node (since
	# there will be multiple vnodes/simnodes on each pnode).
	#
    	my $vnodename = $self->solution_p2v()->{$pnodename}[0];
	    
	$self->InitializePhysNode($pnodename, $vnodename) == 0
	    or return -1;
    }
    # Now do virtual nodes on each pnode.
    foreach my $vnodename (keys(%{ $self->solution_v2v() })) {
	my $vpnodename = $self->solution_v2v()->{$vnodename};

	$self->InitializePhysNode($vpnodename, $vnodename) == 0
	    or return -1;
    }
    #
    # XXX This is here cause vnames were not set until now. Need to move.
    #
    if (defined($self->rspec()) && !$self->impotent()) {
	if (libGeni::MapNodes($self->experiment())) {
	    tberror("Could not map geni nodes to local nodes.\n");
	    return -1;
	}
    }
    return 0;
}

#
# Initialize a physical (or virtual physical) node. A lot of magic
# in this function
#
sub InitializePhysNode($$$)
{
    my ($self, $pnodename, $vnodename) = @_;
    my $pnode  = $self->pnodes()->{$pnodename};

    $self->printdb("InitPnode: $pnodename,$vnodename\n");

    # If this is a node in the topology (in the vnodes() array) then
    # there must be a virtual physical node.
    my $virtnode;
    my $vpnode;
    if (exists($self->vnodes()->{$vnodename})) {
	$virtnode = $self->vnodes()->{$vnodename};
	$vpnode   = $virtnode->_pnode();
	if (!defined($vpnode)) {
	    tberror("No virtual physical node for $vnodename on $pnodename\n");
	    return -1;
	}
    }
    $pnode->FlushReserved();
    my $reservation = $pnode->Reservation();
    
    my %nodesets = ();
    my %rsrvsets = ();
    my $osid;

    # XXX NSE hack. The pnode is hosting simnodes.
    if (defined($vpnode) && $vpnode->issimnode()) {
	my $osid = $self->options()->{'sim_osid'};
	my $cmdline = $self->osidbootcmd($osid, "vnodehost", "/kernel.jail");
	if (!defined($cmdline)) {
	    tberror("Error determining boot command line for $pnode");
	    return -1;
	}
	%nodesets = ("def_boot_cmd_line" => $cmdline,
		     "startstatus"       => 'none',
		     "bootstatus"        => 'unknown',
		     "ready"             => 0,
		     "rpms"              => '',
		     "deltas"            => '',
		     "tarballs"          => '',
		     "startupcmd"        => '',
		     "failureaction"     => '',
		     "routertype"        => TBDB_ROUTERTYPE_STATIC());

	%rsrvsets = ("vname"             => $self->newvname($pnodename,
							    "simhost"),
		     "erole"             => TBDB_RSRVROLE_SIMHOST,
		     "simhost_violation" => 0);
    }
    elsif ($pnode->isremotenode() &&
	   !$pnode->isvirtnode() &&
	   !$pnode->isdedicatedremote() &&
	   (!defined($reservation) || 
	    !$self->experiment()->SameExperiment($reservation))) {
	#
	# Certain kinds of nodes are not actually allocated to the
	# experiment. 
	#
	return 0;
    }
    elsif (!$pnode->isremotenode() &&
	   (!defined($vpnode) ||
	    exists($self->solution_virtnodes()->{$pnodename}))) {

	#
	# Watch for a local shared node that is not actually part of
	# this experiment; just skip it since it was setup when its
	# holding experiment swapped it in.
	#
	if (defined($pnode->sharing_mode()) && !$pnode->isvirtnode() &&
	    $pnode->erole() eq "sharedhost") {
	    $self->printdb("InitPnode: Skipping shared host $pnode\n");
	    return 0;
	}
    
	#
	# One of our internally created nodes. 
	#
	my $routertype;
	my $cmdline_role = "default";
	my $cmdline      = "";
	my $vname;
	my $role;

	if (exists($self->delaynodes()->{$vnodename})) {
	    #
	    # A delay node.
	    #
	    $osid = ($self->option("delay_osid") || $pnode->delay_osid());
	    $vname        = $vnodename;
	    $role         = TBDB_RSRVROLE_DELAYNODE;
	    $routertype   = TBDB_ROUTERTYPE_NONE;
	    $cmdline      = "/kernel.delay";
	    $cmdline_role = "delay";

	    $self->exptstats()->{"delaynodes"} += 1;
	}
	else {
	    #
	    # A node hosting virtnodes (like jails).
	    #
	    if (defined($virtnode->_parent_osinfo())) {
		$osid = $virtnode->_parent_osinfo()->osid();
	    }
	    else {
		$osid  = ($self->option("jail_osid") ||
			  $self->nodejailosid($virtnode));
	    }
	    return -1
		if (!defined($osid));
	    my $osinfo = OSinfo->Lookup($osid);
	    return -1
		if (!defined($osinfo));
	    
	    $vname        = $self->newvname($pnodename, "vhost");
	    $role         = TBDB_RSRVROLE_VIRTHOST;
	    $routertype   = TBDB_ROUTERTYPE_MANUAL;
	    $cmdline_role = "vnodehost";
	    $cmdline      = "/kernel.jail" if ($osinfo->OS() eq "FreeBSD");

	    $self->exptstats()->{"jailnodes"} += 1;
	}
	if (!defined($osid)) {
	    tberror("No OSID is defined for internal node $vname!\n");
	    return -1;
	}
	$cmdline = $self->osidbootcmd($osid, $cmdline_role, $cmdline);
	if (!defined($cmdline)) {
	    tberror("Error determining boot command line for $pnode\n");
	    return -1;
	}
	%nodesets = ("def_boot_cmd_line" => $cmdline,
		     "startstatus"       => 0,
		     "bootstatus"        => 'unknown',
		     # This is no longer used for anything.
		     "deltas"            => '', 
		     "ready"             => 0,
		     "routertype"        => $routertype);

	%rsrvsets = ("vname"             => $vname,
		     "erole"             => $role);

	if (!$self->impotent() &&
	    $self->experiment()->AddInternalProgramAgent($vname)) {
	    tberror("Error determining boot command line for $pnode\n");
	    return -1;
	}
    }
    else {
	#
	# A normal user node (physical or virtual).
	#
	my ($cmdline,$rpms,$startupcmd,$tarfiles,
	    $failureaction,$routertype) = @{ $virtnode->_settings() };

	$osid = (defined($virtnode->_osinfo()) ?
		 $virtnode->_osinfo()->osid() : $pnode->default_osid());
	my $vname           = $vnodename;
	my $role            = TBDB_RSRVROLE_NODE;
	my $inner_elab_role = $virtnode->inner_elab_role();
	my $plab_role       = $virtnode->plab_role();
	my $sharing_mode;

	if (!$pnode->isvirtnode() &&
	    (!defined($cmdline) || $cmdline eq "")) {
	    # If the user has not overridden the command line, try to
	    # find a default for this OSID. Only test real physical node.
	    if ($pnode->_needslinkdelay()) {
		$cmdline = $self->osidbootcmd($osid, "linkdelay", "");
	    }
	    elsif (defined($inner_elab_role) &&
		   ($inner_elab_role eq "boss" ||
		    $inner_elab_role eq "boss+router")) {
		$cmdline = $self->osidbootcmd($osid, "linkdelay", "");
	    }
	    if (!defined($cmdline)) {
		tberror("Error determining boot command line for $pnode\n");
		return -1;
	    }
	}
	elsif ($pnode->isvirtnode() || defined($virtnode->sharing_mode())) {
	    # in some situations we don't allow a user-specified command line
	    $cmdline = "";
	}
	if (!$pnode->isvirtnode() &&
	    defined($virtnode->sharing_mode()) &&
	    $virtnode->sharing_mode() eq "shared_local") {
	    $role = "sharedhost";
	    $sharing_mode = "shared_local";
	    $cmdline = $self->osidbootcmd($osid, "vnodehost", "")
		if (!defined($cmdline) || $cmdline eq "");
	}
	#
	# NOTE: We no longer include tarballs and RPMs in this update,
	# because they are now handled by tarfiles_setup
	#
	%nodesets = ("def_boot_cmd_line" => $cmdline,
		     "startstatus"       => 'none',
		     "bootstatus"        => 'unknown',
		     # This is no longer used for anything.
		     "deltas"            => '', 
		     "ready"             => 0,
		     "startupcmd"        => $startupcmd || '',
		     "failureaction"     => $failureaction,
		     "routertype"        => $routertype);

	%rsrvsets = ("vname"             => $vnodename,
		     "erole"             => $role,
		     "plab_role"         => $plab_role);
	$rsrvsets{"inner_elab_role"} = $inner_elab_role
	    if (defined($inner_elab_role));
	$rsrvsets{"sharing_mode"} = $sharing_mode
	    if (defined($sharing_mode));

    }
    $self->printdb("InitPnode: Storing info for $pnodename,$vnodename\n");

    # Do this in regression mode to avoid timestamp diffs
    if ($self->regression()) {
	$rsrvsets{"rsrv_time"} = 0;
    }
    my $setstr = join(",", map("$_='" . $nodesets{$_} . "'", keys(%nodesets)));
    $self->printdb("  $setstr\n");

    DBQueryWarn("update nodes set $setstr where node_id='$pnodename'")
	or return -1 if (!$self->impotent());

    $setstr = join(",", map("$_='" . $rsrvsets{$_} . "'", keys(%rsrvsets)));
    
    $self->printdb("  $setstr\n");

    DBQueryWarn("update reserved set $setstr where node_id='$pnodename'")
	or return -1 if (!$self->impotent());
    
    #
    # Now call os_select.
    #
    if (defined($osid) && !$pnode->isremotenode()) {
	if ($self->impotent()) {
	    $self->printdb("  pretending to os_select $osid\n");
	}
	else {
	    $self->printdb("  os_select $osid\n");

	    # osselect wants an osinfo object.
	    my $tmposinfo = OSinfo->Lookup($osid);
	    if (!defined($tmposinfo)) {
		tberror("Could not map $osid to osinfo object\n");
		return -1;
	    }
	    if ($pnode->OSSelect($tmposinfo, "def_boot_osid",
				 $self->verbose())) {
		tberror("OSSelect($pnode,$tmposinfo) failed\n");
		return -1;
	    }
	}
    }
    # Clear this after os_select.
    if ($self->regression()) {
	DBQueryFatal("update nodes set state_timestamp=0, ".
		     "    op_mode_timestamp=0,allocstate_timestamp=0 ".
		     "where node_id='$pnodename'");
    }
    return 0;
}

#
# This is special. Look at the osid of the virtnodes on this pnode and
# map to a suitable osid using the nextosid field. This overloads nextosid
# to some extent ...
#
sub nodejailosid($$)
{
    my ($self, $virtnode) = @_;

    #
    # We know at this point that all vnodes on this pnode want the same
    # osid (at least, the same vhost osid :-)) cause of assign (osid 
    # features/desires). 
    #
    my $osinfo    = $virtnode->_osinfo();
    my $posinfo    = $virtnode->_parent_osinfo();
    my $nextosid;

    if (!defined($posinfo)) {
	return undef
	    if (!defined($osinfo->nextosid()));
	$osinfo = $osinfo->ResolveNextOSID($self->experiment());
	return undef
	    if (!defined($osinfo));
	$nextosid = $osinfo->osid();
    
	if (defined($nextosid)) {
	    $self->printdb("Mapping VM osinfo $osinfo to ".
			   "$nextosid on $virtnode\n");
	}
	else {
	    tbwarn("Could not map jail osid to real osid on $virtnode\n");
	}
    }
    else {
	# Don't try resolving nextosid if the vnode is booting a subOS.
	$nextosid = $osinfo->osid();
	$self->printdb("Mapping VM osinfo to subOS $osinfo".
		       " on $virtnode\n");
    }

    return $nextosid;
}

sub osidbootcmd($$$$)
{
    my ($self, $osid, $role, $default) = @_;

    my $osinfo = OSinfo->Lookup($osid);
    if (!defined($osinfo)) {
	tbwarn("No such OSID $osid\n");
	return undef;
    }
    if (defined($osinfo->nextosid())) {
	$osinfo = $osinfo->ResolveNextOSID($self->experiment());
	return undef
	    if (!defined($osinfo));
    }
    return undef
	if ($osinfo->OSBootCmd($role, \$default) != 0);
    return $default;
}

#
# Takes vnode, pnode as arguments
# and determines the correct routing table id
#
sub getrtabid($$$)
{
    my ($self, $pnode, $member) = @_;
    my $rtabid;
    my $vnodename = $member->vnode();
    my $numvnodesonpnode =
	scalar(@{ $self->solution_p2v()->{$pnode->node_id()} });

    if ($numvnodesonpnode > 1 || $pnode->_sharedhost()) {
	if (! exists($self->solution_rtabmap()->{$vnodename})) {
	    if ($pnode->_sharedhost() && !$self->impotent()) {
		$rtabid = $pnode->Nextrtabid();
	    }
	    else {
		$rtabid = $pnode->_rtabid();
		$pnode->_rtabid($rtabid + 1);
	    }
	    $self->solution_rtabmap()->{$vnodename} = $rtabid;
	}
	else {
	    $rtabid = $self->solution_rtabmap()->{$vnodename};
	}
    }
    else {
	$rtabid = $self->solution_rtabmap()->{$vnodename} = 0;
    }
    return $rtabid;
}


sub NewVirtIface($$$$;$)
{
    my ($self, $virtlan, $member, $pnodename, $pport) = @_;

    my $lan       = $virtlan->vname();
    my $pnode     = $self->pnodes()->{$pnodename};
    my $vnodename = $member->vnode();
    my $ip        = $member->ip();
    my $mask      = $member->mask();
    my $encap     = $virtlan->_encapstyle();
    my $isveth    = ($encap eq "veth" || $encap eq "veth-ne");
    my $vllidx    = $virtlan->idx();
    my $rtabid    = $self->getrtabid($pnode, $member);
    my $exptidx   = $self->experiment()->idx();
    my $isvnode   = exists($self->solution_v2v()->{$vnodename});
    my $vvnode;
    my $isvdev;
    my $type;
    my $mac;

    #
    # Special actions for virtnodes (as opposed to just emulated links).
    #
    if ($isvnode) {
	#
	# XXX type should be either veth or vlan
	#
	$type = $encap;
	if (!$isveth && $type ne "vlan") {
	    tbwarn("whacked encap type '$type' for vnode, ".
		   "setting to 'veth' instead\n");
	    $type = "veth";
	    $isveth = 1;
	}
	$isvdev = 1;

	# to the nodes table entry for the virtnode. 
	$vvnode = $self->solution_v2v()->{$vnodename};
    }
    else {
	#
	# For multiplexed links, the default is no encapsulation,
	# aka "alias".
	#
	$type = $encap;
	if ($type eq "default" || $type eq "alias") {
	    $type = "alias";
	    $isvdev = 0;
	}
	else {
	    $isvdev = 1;
	}
    }

    #
    # Make up a MAC address.  For now, just derive it from the assigned
    # IP address.
    #
    if ($ip =~ /^\d+\.\d+\.\d+\.\d+$/) {
	$mac = sprintf "0000%.2x%.2x%.2x%.2x", split(/\./, $ip);
    } else {
	$mac = "000000000000";
    }

    #
    # Create new virtiface in the DB.
    #
    my %argref = ("mac"    => $mac,
		  "IP"     => $ip,
		  "mask"   => $mask,
		  "type"   => $type,
		  "rtabid" => $rtabid,
		  "exptidx" => $exptidx,
		  "virtlanidx" => $vllidx,
	      );
    $argref{"iface"} = $pport
	if (defined($pport));
    $argref{"vnode_id"} = $vvnode
	if (defined($vvnode));

    my $virtiface = ($self->impotent() ?
		     Interface::VInterface->MakeFake($pnodename, \%argref) :
		     Interface::VInterface->Create($pnodename, \%argref));
    if (!defined($virtiface)) {
	return undef;
    }
    $self->printdb("$virtiface: $member, isvdev:$isvdev, isveth:$isveth\n");
    my $newid = $virtiface->unit();

    # Record this vinterface mapping.
    $self->solution_vifacemap()->{$member} = $virtiface;
    
    #
    # For veth and vlan interfaces, we need to set the characteristics
    # of the underlying physical interface, but only if we actually own
    # the node; it might be a veth on a shread physical node.
    #
    # If the pnode is a shared host, we do not want to do this; the physical
    # interfaces are all set up the right way, do not mess it up. 
    #
    if (defined($pport) && $isvdev &&
	(!$pnode->_sharedhost() || $member->_needtrunk())) {
	my $speed = $self->interfacespeedmbps(physinterfacetype($pnode,$pport),
					      "ethernet");
	my $trunk = ($type eq "vlan" ? 1 : 0);

	$self->printdb("  Setting port speed/trunk for $pnodename: ".
		       "$pport:$speed/$trunk\n");
	
	DBQueryWarn("update interfaces set " .
		     "   current_speed='$speed',trunk=$trunk " .
		     "where node_id='$pnodename' and iface='$pport'")
	    or return -1 if (!$self->impotent());
    }

    #
    # XXX hackery that only Rob and Leigh understand.
    # A LAN of vnodes split across multiple physical machines may
    # not have the correct physical LAN info coming out of assign
    # and may need to be patched up later.
    #
    if (!defined($pport) && $isvnode) {
	$self->solution_vethmap()->{$lan} = {}
	  if (!exists($self->solution_vethmap()->{$lan}));
	$self->solution_vethmap()->{$lan}->{$pnodename} = []
	  if (!exists($self->solution_vethmap()->{$lan}->{$pnodename}));
	
	push(@{ $self->solution_vethmap()->{$lan}->{$pnodename} }, $newid);
    }
    return $virtiface;
}

sub AddVirtPatch($$$$)
{
    my ($self, $lan, $pnodename, $pport) = @_;

    $self->printdb("Adding Virt Patch: $lan, $pnodename, $pport\n");

    $self->solution_vethpatch()->{$lan} = {}
        if (!exists($self->solution_vethpatch()->{$lan}));
    
    $self->solution_vethpatch()->{$lan}->{$pnodename} = $pport;
}

#
# Add a delay node entry.
#
sub AddDelay($$$$$$$$$)
{
    my ($self, $virtlan, $member0, $member1, $pnodename,
	$iface0, $iface1, $islan, $params) = @_;

    # Delay Info. 
    my ($delay,$bandwidth,$backfill,$lossrate,
	$rdelay,$rbandwidth,$rbackfill,$rlossrate) = @{$params};

    my $pnode =  $self->pnodes()->{$pnodename};

    # ipfw pipe numbers so we can control it remotely.
    my $pipe0 = $pnode->_pipenumber();
    my $pipe1 = $pipe0 + 10;
    $pnode->_pipenumber($pipe1 + 10);

    my $vnodename0 = $member0->vnode();
    my $vnodename1 = $member1->vnode();
    my $experiment = $self->experiment();
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();
    my $idx = $experiment->idx();
    my $lan = $virtlan->vname();
    my $nobwshaping = $virtlan->_nobwshaping();

    #
    # We allow users to oversubscribe by letting them turn off the
    # bandwidth shaping. If however, if the link was shaped for some
    # other reason (like a delay), then turn off just the bw shaping
    # part by setting them to 0.  This is special; means no limits in
    # ipfw.
    #
    if ($nobwshaping) {
	$bandwidth = $rbandwidth = 0;
    }

    $self->printdb("  Delay: \[$iface0:$pnodename:$iface1 ".
		   "pipes:$pipe0+$pipe1,".
		   "$delay,$bandwidth,$backfill,$lossrate,".
		   "$rdelay,$rbandwidth,$rbackfill,$rlossrate]\n");
    
    #
    # We need to find the queue info. If its a member of a lan, there
    # is just one queue, towards the lan. A duplex link has two queues,
    # one for each member (outgoing side).
    #
    if (!$islan) {
	my ($q0_limit,$q0_maxthresh,$q0_minthresh,$q0_weight,$q0_linterm,
	    $q0_qinbytes,$q0_bytes,$q0_meanpsize,$q0_wait,$q0_setbit,
	    $q0_droptail,$q0_red,$q0_gentle) = @{ $member0->_queueinfo() };

	my ($q1_limit,$q1_maxthresh,$q1_minthresh,$q1_weight,$q1_linterm,
	    $q1_qinbytes,$q1_bytes,$q1_meanpsize,$q1_wait,$q1_setbit,
	    $q1_droptail,$q1_red,$q1_gentle) = @{ $member1->_queueinfo() };

	#
	# See if this delaynode was inserted strictly for tracing/monitoring.
	#
	my $noshaping = (($virtlan->membershaped($member0) ||
			  $virtlan->membershaped($member1)) ? 0 : 1);
    
	DBQueryWarn("insert into delays " .
	     " (pid,eid,exptidx,node_id,vname,noshaping,iface0,iface1" .
	     ",vnode0,pipe0,delay0,bandwidth0,backfill0,lossrate0" .
	     ",vnode1,pipe1,delay1,bandwidth1,backfill1,lossrate1" .
	     ",q0_limit,q0_maxthresh,q0_minthresh,q0_weight,q0_linterm" .
	     ",q0_qinbytes,q0_bytes,q0_meanpsize,q0_wait,q0_setbit" .
	     ",q0_droptail,q0_red,q0_gentle" .
	     ",q1_limit,q1_maxthresh,q1_minthresh,q1_weight,q1_linterm" .
	     ",q1_qinbytes,q1_bytes,q1_meanpsize,q1_wait,q1_setbit" .
	     ",q1_droptail,q1_red,q1_gentle)" .
	     " values ('$pid','$eid','$idx','$pnodename','$lan' ".
	     ",$noshaping,'$iface0','$iface1'".
	     ",'$vnodename0',$pipe0,$delay,$bandwidth,$backfill,$lossrate".
	     ",'$vnodename1',$pipe1,$rdelay,$rbandwidth,$rbackfill,$rlossrate".
	     ",$q0_limit,$q0_maxthresh,$q0_minthresh,$q0_weight,$q0_linterm".
	     ",$q0_qinbytes,$q0_bytes,$q0_meanpsize,$q0_wait,$q0_setbit".
	     ",$q0_droptail,$q0_red,$q0_gentle".
  	     ",$q1_limit,$q1_maxthresh,$q1_minthresh,$q1_weight,$q1_linterm".
	     ",$q1_qinbytes,$q1_bytes,$q1_meanpsize,$q1_wait,$q1_setbit".
	     ",$q1_droptail,$q1_red,$q1_gentle)")
	    or return -1 if (!$self->impotent());
    }
    else {
	my ($q0_limit,$q0_maxthresh,$q0_minthresh,$q0_weight,$q0_linterm,
	    $q0_qinbytes,$q0_bytes,$q0_meanpsize,$q0_wait,$q0_setbit,
	    $q0_droptail,$q0_red,$q0_gentle) = @{ $member0->_queueinfo() };

	#
	# See if this delaynode was inserted strictly for tracing/monitoring.
	#
	my $noshaping = ($virtlan->membershaped($member0) ? 0 : 1);
    
	#
	# Obviously, its implied that the q0 params are towards the lan,
	# For the reverse side, force the queue to 2 slots (should be 1
	# but dummynet not quite precise enough) to avoid excess queuing
	# delay since the traffic should already be at the proper bandwidth
	# when it gets to the node.
	#
	DBQueryWarn("insert into delays" .
	     " (pid,eid,exptidx,node_id,vname,noshaping,iface0,iface1," .
	     "  vnode0,pipe0,delay0,bandwidth0,backfill0,lossrate0," .
	     "  vnode1,pipe1,delay1,bandwidth1,backfill1,lossrate1," .
	     "  q0_limit,q0_maxthresh,q0_minthresh,q0_weight,q0_linterm," .
	     "  q0_qinbytes,q0_bytes,q0_meanpsize,q0_wait,q0_setbit," .
	     "  q0_droptail,q0_red,q0_gentle,q1_limit,q1_qinbytes) " .
	     " values ('$pid','$eid','$idx','$pnodename','$lan', ".
	     "  $noshaping,'$iface0','$iface1',".
	     "  '$vnodename0',$pipe0,$delay,$bandwidth,$backfill,$lossrate,".
	     "  '$vnodename1',$pipe1,$rdelay,$rbandwidth,$rbackfill,$rlossrate,".
	     "  $q0_limit,$q0_maxthresh,$q0_minthresh,$q0_weight,$q0_linterm,".
	     "  $q0_qinbytes,$q0_bytes,$q0_meanpsize,$q0_wait,$q0_setbit,".
	     "  $q0_droptail,$q0_red,$q0_gentle,2,0)")
	    or return -1 if (!$self->impotent());
    }

    #
    # XXX - Whenever a delay node is inserted, port speeds are set to
    #       their maximum speed on the delay node ports. This is to ensure that
    #       they get a valid number instead of something left over, but
    #       also because 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 above where portbw hash
    #       is set.
    #
    my $speed0 =
	$self->interfacespeedmbps(physinterfacetype($pnode, $iface0),
				  "ethernet");
    my $speed1 =
	$self->interfacespeedmbps(physinterfacetype($pnode, $iface1),
				  "ethernet");

    $self->printdb("  Setting port speeds on $pnodename: ".
		   "$iface0:$speed0 $iface1:$speed1\n");

    DBQueryWarn("update interfaces set " .
		"current_speed='$speed0' " .
		"where node_id='$pnodename' and ".
		"iface='$iface0'")
	or return -1 if (!$self->impotent());

    DBQueryWarn("update interfaces set " .
		"current_speed='$speed1' " .
		"where node_id='$pnodename' and ".
		"iface='$iface1'")
	or return -1 if (!$self->impotent());

    return 0;
}

#
# Link delays. These are done differently than delays. A link delay is
# a delay that is established at the endpoints of the link, instead of
# on a delay node. So, in a duplex link, there would be a traffic
# shaping rule on each output side of the link. On a lan, there are
# two rules, one for traffic to the switch, and one for traffic from
# the switch. Like above, there are also queues associated with output
# side (to the switch) of a link.
#
sub AddLinkDelay($$$$$$)
{
    my ($self, $virtlan, $member, $pnodename, $iface, $islan, $params) = @_;

    # backfill unsupported for linkdelays so ignore its entry in params.
    my ($delay,$bandwidth,$backfill,$lossrate,
	$rdelay,$rbandwidth,$rbackfill,$rlossrate) = @{$params};

    #
    # We need to find the queue info. If its a member of a lan, there
    # is just one queue, *towards* the lan. A duplex link has two queues,
    # one for each member (outgoing side).
    #
    my ($q_limit,$q_maxthresh,$q_minthresh,$q_weight,$q_linterm,
	$q_qinbytes,$q_bytes,$q_meanpsize,$q_wait,$q_setbit,
	$q_droptail,$q_red,$q_gentle) = @{ $member->_queueinfo() };

    my $pnode =  $self->pnodes()->{$pnodename};

    # Mark pnode for alternate kernel.
    $pnode->_needslinkdelay(1);
    # Stats.
    $self->exptstats()->{"linkdelays"} += 1;

    # ipfw pipe numbers so we can control it remotely.
    my $pipe  = $pnode->_pipenumber();
    my $rpipe = $pipe + 10;
    $pnode->_pipenumber($rpipe + 10);

    my $vnodename  = $member->vnode();
    my $mask       = $member->mask();
    my $ip         = $member->ip();
    my $experiment = $self->experiment();
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();
    my $idx = $experiment->idx();
    my $lan = $virtlan->vname();
    my $nobwshaping = $virtlan->_nobwshaping();

    #
    # We allow users to oversubscribe by letting them turn off the
    # bandwidth shaping. If however, if the link was shaped for some
    # other reason (like a delay), then turn off just the bw shaping
    # part by setting them to 0.  This is special; means no limits in
    # ipfw.
    #
    if ($nobwshaping) {
	$bandwidth = $rbandwidth = 0;
    }

    $self->printdb("  LinkDelay: \[$pipe,$rpipe," .
		   "$virtlan,$delay,$bandwidth,$backfill,$lossrate".
		   ($islan ? "$rdelay,$rbandwidth,$rbackfill,$rlossrate" : "").
		   "\]\n");

    return 0
	if ($self->impotent());

    DBQueryWarn("insert into linkdelays " .
		" (node_id,iface,type,ip,netmask,exptidx,pid,eid,vlan, ".
		"  vnode,pipe,delay,bandwidth,lossrate, ".
		"  q_limit,q_maxthresh,q_minthresh,q_weight, ".
		"  q_linterm,q_qinbytes,q_bytes,q_meanpsize, ".
		"  q_wait,q_setbit,q_droptail,q_red,q_gentle) ".
		" values " .
		" ('$pnodename','$iface','simplex','$ip','$mask', ".
		"  '$idx', '$pid','$eid', ".
		"  '$lan','$vnodename',$pipe,$delay,$bandwidth,$lossrate, ".
		"  $q_limit,$q_maxthresh,$q_minthresh,$q_weight, ".
		"  $q_linterm,$q_qinbytes,$q_bytes,$q_meanpsize, ".
		"  $q_wait,$q_setbit,$q_droptail,$q_red,$q_gentle)")
	or return -1;
    
    #
    # If its a lan, add the from-switch stuff. On the node, the ipfw
    # pipe that is built for this will need to specify a queue size of 1.
    #
    if ($islan) {
	DBQueryWarn("update linkdelays set ".
		    " rpipe=$rpipe,rdelay=$rdelay,rbandwidth=$rbandwidth, ".
		    " rlossrate=$rlossrate,type='duplex' ".
		    "where node_id='$pnodename' and ".
		    "      vlan='$lan' and vnode='$vnodename'")
	    or return -1;
    }
    return 0;
}

#
# Setup tracing on a link.
#
sub SetUpTracing($$$$$)
{
    my ($self, $virtlan, $member, $pnodename, $iface0, $iface1) = @_;
    my $vnodename = $member->vnode();

    #
    # Handle virtual nodes - in some cases (ie. PlanetLab), we have to
    # look in v2vmap to find out which node we got placed on.
    #
    if (exists($self->solution_v2v()->{$vnodename})) {
        $pnodename = $self->solution_v2v()->{$vnodename};
    }

    #
    # First see if this member of the lan wanted tracing. 
    #
    my ($traced, $endnode, $trace_type, $trace_expr,
	$trace_snaplen, $trace_db) = @{ $member->_traceinfo() };

    return 0
	if (!$traced);

    # This means its on an end node.
    $iface0 = ""
	if (!defined($iface0));

    $self->printdb("Trace: $virtlan, $member, ".
		   "$endnode, $pnodename, $iface0, $iface1\n");

    return 0
	if ($self->impotent());

    my $experiment = $self->experiment();
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();
    my $idx = $experiment->idx();
    my $lan = $virtlan->vname();

    DBQueryWarn("insert into traces ".
		 " (node_id, idx, iface0, iface1, pid, eid, exptidx, ".
		 "  linkvname, vnode, trace_type, trace_expr, trace_snaplen, ".
		 "  trace_db) ".
		 "values ".
		 "  ('$pnodename', 0, '$iface0', '$iface1', '$pid', '$eid', ".
		 "   '$idx', '$lan', '$vnodename', ".
		 "   '$trace_type', '$trace_expr', $trace_snaplen, ".
		 "   '$trace_db')")
	or return -1;
    
    return 0;
}

#
# Write the vlans table to the DB.
#
sub UploadVlans($)
{
    my ($self) = @_;
    my $experiment = $self->experiment();
    my $exptidx = $experiment->idx();
    
    #
    # Post process; mark vlans on federated nodes with a different type
    # so that we do not try to create them locally.
    #
    foreach my $protolanA (ProtoLan->ProtoLanList()) {
	next
	    if ($protolanA->type() ne "vlan");

	foreach my $member ($protolanA->MemberList()) {
	    my $node = $protolanA->MemberNode($member);
	    if ($node->isfednode()) {
		$protolanA->SetType("geni-vlan");
		last;
	    }
	}
	foreach my $member ($protolanA->IfaceList()) {
	    my $node = $protolanA->IfaceNode($member);
	    if ($node->isfednode()) {
		$protolanA->SetType("geni-vlan");
		last;
	    }
	}
    }
    
    #
    # Emulated vlans will result in node:port pairs being in more than
    # one vlan since that link is shared for several lans. For hardware
    # implemented 802.1q tagged vlans (type "vlan"), this is ok. But for
    # "veth" implemented vlans, we have to merge the overlapping vlans
    # into "supervlans". Must be done iteratively of course.
    #
    $self->printdb("Dumping vlans before merging.\n");
    ProtoLan->DumpAll()
	if ($self->verbose());
    
    $self->printdb("Merging vlans ...\n");
  again:
    foreach my $protolanA (ProtoLan->ProtoLanList()) {
	my @membersA = $protolanA->MemberList();
	my $keyA     = $protolanA->vname();

	next
	    if (! ($protolanA->type() eq "vlan" &&
		   $protolanA->role() eq "encapsulation" &&
		   $protolanA->encapstyle() ne "vlan"));

	foreach my $protolanB (ProtoLan->ProtoLanList()) {
	    my @membersB = $protolanB->MemberList();
	    my $keyB     = $protolanB->vname();

	    next
		if (! ($protolanB->type() eq "vlan" &&
		       $protolanB->role() eq "encapsulation" &&
		       $protolanB->encapstyle() ne "vlan"));
	    
	    if ($keyA ne $keyB) {
		foreach my $memberA (@membersA) {
		    if (grep {$_ eq $memberA} $protolanB->MemberList()) {
			foreach my $memberB (@membersB) {
			    if (! grep {$_ eq $memberB}
				$protolanA->MemberList()) {
				$protolanA->AddMember(split(":", $memberB));
			    }
			}
			# Must reset the links before killing the old one.
			foreach my $protolan (ProtoLan->ProtoLanList()) {
			    if (defined($protolan->link()) &&
				$protolan->link()->vname()
				   eq $protolanB->vname()) {
				$protolan->SetLink($protolanA);
			    }
			}
			$self->printdb("Merged $protolanB into $protolanA\n");
			$protolanB->Destroy();
			goto again;
		    }
		}
	    }
	}
    }
    
    if (!$self->impotent()) {
	$self->printdb("Uploading vlans table.\n");
	ProtoLan->DumpAll()
	    if ($self->verbose());
	if (ProtoLan->InstantiateAll($self->regression()) != 0) {
	    tberror("Could not instantiate protolans!\n");
	    return -1;
	}

	# Once the lans are instantiated we have to go back and update the
	# vinterfaces table. Eventually I want to roll vinterface creation
	# into lan instantiation.
	#
	my @lans;
	if (Lan->ExperimentLans($experiment, \@lans) != 0) {
	    tberror("Could not get list of all lans for $experiment\n");
	    return -1;
	}
	foreach my $lan (@lans) {
	    # Only care about encapsulated links.
	    next
		if ($lan->type() ne "emulated");

	    my $linkedlan = $lan->GetLinkedLan();
	    if (!defined($linkedlan)) {
		tberror("Emulated lan $lan does not have a linked vlan!\n");
		return -1;
	    }
	    my $virtlan     = $self->vlans()->{$lan->vname()};
	    if (!defined($virtlan)) {
		tberror("Could not find lan $lan in local lan list!\n");
		return -1;
	    }
	    my $virtlanidx  = $virtlan->idx();
	    my $linkedlanid = $linkedlan->lanid();
	    
	    $self->printdb("Update vinterfaces: $virtlan: ".
			   "$virtlanidx -> $linkedlanid\n");
	    
	    DBQueryWarn("update vinterfaces set vlanid='$linkedlanid' ".
			"where virtlanidx='$virtlanidx' and ".
			"      exptidx='$exptidx'")
		or return -1;
	}
    }
    else {
	$self->printdb("Dumping final vlans table.\n");
	ProtoLan->DumpAll()
	    if ($self->verbose());
    }

    #
    # Upload the port bw to the interfaces table for each iface.
    #
    foreach my $virtlan (values(%{ $self->vlans() })) {
	my $vlanname = $virtlan->vname();

	foreach my $member ($virtlan->memberlist()) {
	    # Will this happen?
	    next
		if (!exists($self->solution_portmap()->{$member}));

	    # XXX NSE checks I do not understand.
	    next
		if (! (exists($self->portbw()->{$member}) &&
		       exists($self->solution_v2p()->{$member->vnode()})));

	    # Skip anything that was turned into a vinterface; the
	    # port speed will get set elsewhere.
	    next
		if (exists($self->solution_vifacemap()->{$member}));

	    my $iface     = $self->solution_portmap()->{$member};
	    my $pnodename = $self->solution_v2p()->{$member->vnode()};
	    my $speed     = $self->portbw()->{$member};
	    
	    # XXX - the following converts from bps to Mbps
	    $speed = $speed / 1000;

	    $self->printdb("Interface speed: $pnodename:$iface $speed\n");
	    
	    DBQueryWarn("update interfaces set current_speed='$speed' ".
			"where node_id='$pnodename' and iface='$iface'")
		or return -1 if (!$self->impotent());
	}
    }

    #
    # Patch up virts.
    #
    foreach my $vname (keys(%{ $self->vlans() })) {
	next
	    if (!exists($self->solution_vethpatch()->{$vname}));

	foreach my $pname (keys(%{ $self->solution_vethmap()->{$vname} })) {
	    next
		if (!exists($self->solution_vethpatch()->{$vname}->{$pname}));

	    my $pport = $self->solution_vethpatch()->{$vname}->{$pname};
	    my $pnode = $self->pnodes()->{$pname};

	    foreach my $vid (@{$self->solution_vethmap()->{$vname}->{$pname}}) {
		#
		# For veth and vlan interfaces, we need to set the
		# characteristics of the underlying physical
		# interface.
		#
		my $speed =
		    $self->interfacespeedmbps(physinterfacetype($pnode, $pport),
					      "ethernet");
		$self->printdb("Virt Patch: ".
			       "$vname $pname $vid $pport $speed\n");
	
		if (!$self->impotent()) {
		    DBQueryWarn("update vinterfaces set iface='$pport' ".
				"where node_id='$pname' and unit='$vid'")
			or return -1;

		    DBQueryWarn("update interfaces set " .
				"   current_speed='$speed' " .
				"where node_id='$pname' and iface='$pport'")
			or return -1;
		}
	    }
	}
    }
    $self->UpLoadIPAddresses() == 0
	or return -1;
    return 0;
}

#
# Upload the IP addresses to the interfaces table.
#
sub UpLoadIPAddresses($)
{
    my ($self) = @_;

    # For recording IPs we have seen already.
    my %IPs = ();

    foreach my $virtlan (values(%{ $self->vlans() })) {
	my $vlanname = $virtlan->vname();
	my $mask     = $virtlan->_mask();

	foreach my $member ($virtlan->memberlist()) {
	    # Will this happen?
	    next
		if (!exists($self->solution_portmap()->{$member}));

	    my $iface = $self->solution_portmap()->{$member};
	    my $vnodename = $member->vnode();

	    if ($virtlan->usevirtiface()) {
		#
		# Emulated links on local virtual nodes use the new
		# veth device.
		#
		# See NewVirtIface() calls. Everything was set up then.
		#
		my $pnodename = $self->solution_v2p()->{$vnodename};
		my $ip        = $member->ip();

		$self->printdb("IP: $member - $pnodename:$iface $ip\n");
	    }
	    else {
		#
		# Use IPs above to catch if we have inserted an entry
		# for this pnode/iface yet. If not, insert a normal
		# entry. If so, we want to add a new ipalias for the
		# interface. That is cause assign can cause an interface
		# to be shared between multiple links, and so we need
		# ipaliases on the client side.
		#
		my $pnodename  = $self->solution_v2p()->{$vnodename};
		my $pnode      = $self->pnodes()->{$pnodename};
		my $ip         = $member->ip();
		my $rtabid     = $self->getrtabid($pnode, $member);
		my $pvnodename = undef;

		# Mark as being a jail interface by establishing a connection
		# to the nodes table entry for the virtnode.
		if (exists($self->solution_v2v()->{$vnodename})) {
		    my $pvnode =
			$self->pnodes()->{$self->solution_v2v()->{$vnodename}};

		    if ($pvnode->isjailed()) {
			$pvnodename = $self->solution_v2v()->{$vnodename};
		    }
		}

		if (! exists($IPs{"$pnodename:$iface"})) {
		    $self->printdb("IP: $member - ".
				   (defined($pvnodename) ? "$pvnodename:" : "").
				   "$pnodename:$iface $ip\n");
		    
		    #
		    # Never update control net interfaces. This is so
		    # that we can consider them for mapping purposes
		    # (ie. PlanetLab), but don't have to worry about
		    # their IPs getting changed, since that's
		    # important persistent state!
		    #
		    if (physinterfacerole($pnode,$iface) eq
			TBDB_IFACEROLE_CONTROL) {
			$self->printdb("Not setting IP for control interface: ".
				       "$pnode:$iface\n");
		    }
		    else {
			my $vnode_id = (defined($pvnodename) ?
					"'$pvnodename'" : "NULL");
			
			DBQueryWarn("update interfaces set ".
				    "   IP='$ip',IPaliases=NULL,mask='$mask',".
				    "   vnode_id=$vnode_id,rtabid='$rtabid' ".
				    "where node_id='$pnodename' and ".
				    "      iface='$iface'")
			    or return -1 if (!$self->impotent());
			    
			$IPs{"$pnodename:$iface"} = 1;
		    }
		}
		else {
		    #
		    # Rather then an IP aliases like we used to do,
		    # tie a virtual interface to it.
		    #
		    my $viface =
			$self->NewVirtIface($virtlan, $member,
					    $pnodename, $iface);

		    $self->printdb("IP: $member - ".
				   "$pnodename:$iface $ip ($viface)\n");
		}
	    }
	}
    }
    return 0;
}

#
# Upload the tunnels table. These are built for remote node links.
#
sub UpLoadTunnels($)
{
    my ($self) = @_;

    #
    # First need to assign ports to the servers. To do that need to
    # figure out who is a server! We put the server on a real emulab
    # node if possible, and otherwise one of the virtual nodes. Also,
    # we want to share the server amongst more than one link, if
    # possible, since a server can handle more than one tunnel. So,
    # make sure that only one port is assigned per server node.
    #
    my %lantotunnelserver = ();
    my %rnodetotunnelport = ();
    my $secretkey;

    foreach my $virtlan (values(%{ $self->vlans() })) {
	my $server;
	
	next
	    if (! $virtlan->_tunnel());

	my @members = $virtlan->memberlist();
	if (@members != 2) {
	    tberror("Too many members for a tunnel!\n");
	    return -1;
	}

	#
	# Pick one of the members to be the server.
	# 
	foreach my $member (@members) {
	    my $virtnode = $member->virt_node();

	    # Start with the first node, but overwrite if better choice.
	    $server = $virtnode
		if (!defined($server) ||
		    (! $virtnode->_isremotenode() &&
		     ! exists($lantotunnelserver{$virtlan})));
	}
	$lantotunnelserver{$virtlan} = $server;

	# Assign a port, but only the first time chosen.
	if (! $rnodetotunnelport{$server}) {
	    my $pnodename = $self->solution_v2p()->{$server->vname()};
	    my $pnode = $self->pnodes()->{$pnodename};
	
	    $rnodetotunnelport{$server} = nextipportnum($pnode);
	}
    }
    foreach my $virtlan (values(%{ $self->vlans() })) {
	next
	    if (! $virtlan->_tunnel());

	my $server    = $lantotunnelserver{$virtlan};
	my $ipport    = $rnodetotunnelport{$server};
	my $mask      = $virtlan->_mask();
	my $secretkey = TBGenSecretKey();

	my ($member0,$member1) = $virtlan->memberlist();
	my $virtnode0 = $member0->virt_node();
	my $virtnode1 = $member1->virt_node();
	my $ip0       = $member0->ip();
	my $ip1       = $member1->ip();
	
	my $pnodename0 = ($virtnode0->_isvirtnode() ?
			  $self->solution_v2v()->{$virtnode0->vname()} :
			  $self->solution_v2p()->{$virtnode0->vname()});
	my $pnodename1 = ($virtnode1->_isvirtnode() ?
			  $self->solution_v2v()->{$virtnode1->vname()} :
			  $self->solution_v2p()->{$virtnode1->vname()});
	my $pnode0 = $self->pnodes()->{$pnodename0};
	my $pnode1 = $self->pnodes()->{$pnodename1};
	my ($peerip0,$peerip1);
    
	#
	# Need to map the server to the control net interface of the
	# physical node.
	#
	if (! TBControlNetIP($pnodename0, \$peerip0)) {
	    tberror("No Control Network IP for $pnodename0!\n");
	    return -1;
	}
	if (! TBControlNetIP($pnodename1, \$peerip1)) {
	    tberror("No Control Network IP for $pnodename1!\n");
	    return -1;
	}
	$self->printdb("Tunnel: $member0 <-> $member1, ".
		       "$ip0 <-> $ip1, $peerip0 <-> $peerip1\n");

	next
	    if ($self->impotent());

	my $tunnel = Tunnel->Create($self->experiment(),
				    $virtlan->vname(), $secretkey,
				    $virtlan->_encapstyle(), $mask, $ipport);
	if (!defined($tunnel)) {
	    tberror("Could not create tunnel for $virtlan\n");
	    return -1;
	}
	my $iface0 = $tunnel->AddInterface($pnodename0,
					   $member0->vnode(),
					   $member0->vport());
	if (!defined($iface0)) {
	    tberror("Could not add $member0 to $tunnel\n");
	    return -1;
	}
	my $iface1 = $tunnel->AddInterface($pnodename1,
					   $member1->vnode(),
					   $member1->vport());
	if (!defined($iface1)) {
	    tberror("Could not add $member1 to $tunnel\n");
	    return -1;
	}

	# Need to set a bunch of attributes later returned by tmcd.
	if ($iface0->SetAttribute("tunnel_ip", $ip0) ||
	    $iface0->SetAttribute("tunnel_peerip", $ip1) ||
	    $iface0->SetAttribute("tunnel_srcip", $peerip0) ||
	    $iface0->SetAttribute("tunnel_dstip", $peerip1) ||
	    $iface0->SetAttribute("tunnel_isserver",
			  ($server->vname() eq $virtnode0->vname() ? 1 : 0)) ||
	    $iface0->SetAttribute("tunnel_secretkey", $secretkey) ||
	    $iface0->SetAttribute("tunnel_ipmask", $mask) ||
	    $iface0->SetAttribute("tunnel_serverport", $ipport) ||
	    $iface0->SetAttribute("tunnel_lan", $virtlan->vname()) ||
	    $iface0->SetAttribute("tunnel_unit", $iface0->memberid() + 1) ||
	    $iface0->SetAttribute("tunnel_style", $virtlan->_encapstyle())) {
	    tberror("Could not set attributes for $iface0 in $tunnel\n");
	    return -1;
	}
	if ($iface1->SetAttribute("tunnel_ip", $ip1) ||
	    $iface1->SetAttribute("tunnel_peerip", $ip0) ||
	    $iface1->SetAttribute("tunnel_srcip", $peerip1) ||
	    $iface1->SetAttribute("tunnel_dstip", $peerip0) ||
	    $iface1->SetAttribute("tunnel_isserver",
			  ($server->vname() eq $virtnode1->vname() ? 1 : 0)) ||
	    $iface1->SetAttribute("tunnel_secretkey", $secretkey) ||
	    $iface1->SetAttribute("tunnel_ipmask", $mask) ||
	    $iface1->SetAttribute("tunnel_serverport", $ipport) ||
	    $iface1->SetAttribute("tunnel_lan", $virtlan->vname()) ||
	    $iface1->SetAttribute("tunnel_unit", $iface1->memberid() + 1) ||
	    $iface1->SetAttribute("tunnel_style", $virtlan->_encapstyle())) {
	    tberror("Could not set attributes for $iface1 in $tunnel\n");
	    return -1;
	}
    }
    return 0;
}

#
# Upload interface settings.
#
sub UpLoadInterfaceSettings($)
{
    my ($self) = @_;

    my $experiment = $self->experiment();
    my $pid = $experiment->pid();
    my $eid = $experiment->eid();
    my $idx = $experiment->idx();

    foreach my $virtlan (values(%{ $self->vlans() })) {
	my $protocol = $virtlan->_protocol();
	my $vlanname = $virtlan->vname();

	next
	    if (! ($protocol =~ /^(80211|flex900)/));

	my @members = $virtlan->memberlist();
	my $ssid    = "${vlanname}_${idx}";
	my $apmac;

	if (defined($virtlan->_accesspoint())) {
	    my $member    = $virtlan->_accesspoint();
	    my $vnodename = $member->vnode();
	    my $pnodename = $self->solution_v2p()->{$vnodename};
	    my $iface     = $self->solution_portmap()->{$member};
	    my $pnode     = $self->pnodes()->{$pnodename};
	    my $interface;

	    if ($pnode->GetInterface($iface, \$interface) != 0) {
		tberror("Could not find interface $pnodename:$iface\n");
		return -1;
	    }
	    $apmac = $interface->mac();
	}

	foreach my $member (@members) {
	    my $vnodename = $member->vnode();
	    my $pnodename = $self->solution_v2p()->{$vnodename};
	    my $iface     = $self->solution_portmap()->{$member};

	    #
	    # First copy over the lan settings.
	    #
	    foreach my $lan_setting ($self->virt_lan_settings()->Rows()) {
		my $capkey = DBQuoteSpecial($lan_setting->capkey());
		my $capval = DBQuoteSpecial($lan_setting->capval());

		$self->printdb("interface_setting: ".
			       "$pnodename $iface $capkey $capval\n");
	    
		DBQueryWarn("insert into interface_settings ".
			    "       (node_id, iface, capkey, capval) ".
			    "values ('$pnodename', '$iface', ".
			    "        $capkey, $capval)")
		    or return -1 if (!$self->impotent());
	    }

	    #
	    # Next do the per-member settings, which override lan settings.
	    #
	    foreach my $setting ($self->virt_lan_member_settings()->Rows()) {
		next
		    if ($member ne $setting->member());

		my $capkey = DBQuoteSpecial($setting->capkey());
		my $capval = DBQuoteSpecial($setting->capval());

		$self->printdb("interface_setting: ".
			       "$pnodename $iface $capkey $capval\n");
	    
		DBQueryWarn("replace into interface_settings ".
			    "       (node_id, iface, capkey, capval) ".
			    "values ('$pnodename', '$iface', ".
			    "        $capkey, $capval)")
		    or return -1 if (!$self->impotent());
	    }

	    #
	    # And lastly, these override anything the user says to do.
	    # 
	    DBQueryWarn("replace into interface_settings ".
			 "       (node_id, iface, capkey, capval) ".
			 "values ('$pnodename', '$iface', ".
			 "        'protocol', '$protocol')")
		or return -1 if (!$self->impotent());
		
	    $self->printdb("interface_setting: ".
			   "$pnodename $iface protocol $protocol\n");

	    DBQueryWarn("replace into interface_settings ".
			"       (node_id, iface, capkey, capval) ".
			"values ('$pnodename', '$iface', 'ssid', '$ssid')")
		or return -1 if (!$self->impotent());
	
	    $self->printdb("interface_setting: ".
			   "$pnodename $iface ssid $ssid\n");

	    if (defined($apmac)) {
		DBQueryWarn("replace into interface_settings ".
			    "       (node_id, iface, capkey, capval) ".
			    "values ('$pnodename', '$iface', ".
			    "        'accesspoint', '$apmac')")
		    or return -1 if (!$self->impotent());
		    
		$self->printdb("interface_setting: ".
			       "$pnodename $iface accesspoint $apmac\n");
	    }
	}
    }
    return 0;
}

# getnodeport(s)
# Takes a ports result from assign (mac0,mac1) and returns the
# first non-null one.
sub getnodeport($)
{
    my $macstring=$_[0];
    my ($A,$B) = ($macstring =~ /^\(([^,]+),([^,]+)\)$/);

    return (($A ne "(null)") ? $A : (($B ne "(null)") ? $B : "null/null"));
}

# Get the type for an interface.
sub physinterfacetype($$)
{
    my ($pnode, $iface) = @_;

    my $interface;
    if ($pnode->GetInterface($iface, \$interface) != 0) {
	tberror("Could not get interface: $pnode:$iface\n");
	return -1;
    }
    return $interface->type();
}
# Get the role for an interface.
sub physinterfacerole($$)
{
    my ($pnode, $iface) = @_;

    my $interface;
    if ($pnode->GetInterface($iface, \$interface) != 0) {
	tberror("Could not get interface: $pnode:$iface\n");
	return -1;
    }
    return $interface->role();
}

#
# Give me a new vname for an internally allocated node. We have to
# watch for names that were made up previously (say, if this is an
# update).  Not allowed to reuse names of course. We do not mark nodes
# as hosting, so have to infer this from reserved_pnodes. I'm sure
# there is a better way to do this.
#
sub newvname($$$)
{
    my ($self, $pnodename, $prefix) = @_;

    #
    # First check to see if this pnode was already allocated (update)
    #
    my @vnames = keys(%{ $self->current_v2p() });
	
    foreach my $vname (@vnames) {
	# Skip the v mappings.
	next
	    if (exists($self->current_v2v->{$vname}));

	return $vname
	    if ($pnodename eq $self->current_v2p->{$vname});
    }
    
    while (1) {
	my $newname = $prefix . "-" . $self->nextphostnumber();

	return $newname
	    if (!exists($self->current_v2p->{$newname}));
    }
}

sub array_diff($$)
{
    my ($a, $b) = @_;

    my %seen; # lookup table
    my @aonly;# answer
    
    # build lookup table
    @seen{@$b} = ();

    foreach my $item (@$a) {
	push(@aonly, $item) unless exists $seen{$item};
    }
    return @aonly;
}

#
# If there are no virtual nodes, then there is no port sharing, and it
# makes no difference, as long as there are no collisions on a
# node. If there are virtual nodes, then assign a port range for the
# experiment, and all port allocations need to be shared within that
# range on each phys node. That is, if there are 2 virtual nodes on
# physical node, then must allocated from the one range.  There is
# never any overlap between experiements of course.
# 
sub SetPortRange($)
{
    my ($self) = @_;
    
    #
    # See if any virtual nodes. If not, no need to do anything since
    # all port allocations will come from the physical node. 
    #
    return 0
	if (! scalar(keys(%{ $self->solution_v2v() })));

    #
    # Otherwise find a free slot in the table.
    #
    my ($newlow,$newhigh) =
	$self->experiment()->SetPortRange($self->impotent());

    $self->printdb("SetPortRange: $newlow,$newhigh\n");

    #
    # Now set the port range for those nodes hosting virtual nodes.
    # This prevents overlap with other vnodes from other experiments
    # on that nodes. Since you cannot share a node unless you are using
    # virtual nodes, there is no need to worry about phys nodes that
    # are dedicated. That might change of course. 
    #
    foreach my $vnodename (keys(%{ $self->solution_v2v() })) {
	my $vpnodename = $self->solution_v2v()->{$vnodename};
	my $vpnode     = $self->pnodes()->{$vpnodename};
	my $pnodename  = $self->solution_v2p()->{$vnodename};
	my $pnode      = $self->pnodes()->{$pnodename};

	$vpnode->_portnext($newlow + 10);
	$vpnode->_porthigh($newhigh);
	$pnode->_portnext($newlow + 10);
	$pnode->_porthigh($newhigh);

	# We only set the vpnodes. tmcd sends that to the client.
	DBQueryWarn("update nodes set ipport_low=$newlow, ".
		    " ipport_next=ipport_low+1, ipport_high=$newhigh ".
		    "where node_id='$vpnodename'")
	    or return -1 if (!$self->impotent());
    }
    return 0;
}

#
# Bump and return the IP port number for a node. This is
# required for multiplexing virtual nodes on a physical node. 
# 
sub nextipportnum($)
{
    my ($pnode)  = @_;
    my $port     = $pnode->_portnext();

    if ($port >= $pnode->_porthigh()) {
	tberror("No more dynamic ports available for $pnode!\n");
	return -1;
    }
    $pnode->_portnext($port + 1);
    return $port;
}

#############################################################################
# XML support that will move elsewhere. Note that this code is entirely
# derived from the code that Tarun wrote to convert top files in XML.
# It is currently operating in the same fashion; parsing the text lines
# that are created above. This is silly extra work, but I do not want to
# diverge too far from the original code yet.
#

#
# Creates a child node with name "nodeName" whose parent is "parent"
# in the XML document "document"
#
sub addNode($$$)
{
    my ($document, $parent, $nodeName) = @_;
    
    my $newNode = $document->createElement($nodeName);
    $parent->appendChild($newNode);
    return $newNode;
}

#
# Creates a child node with name "nodeName" whose parent is "parent"
# in the XML document "document" The child node has a textnode within
# it with the text "nodeText"
#
sub addNodeWithText($$$$)
{
    my ($document, $parent, $nodeName, $nodeText) = @_;
    
    my $newNode = $document->createElement($nodeName);
    my $newTextNode = $document->createTextNode($nodeText);
    $newNode->appendChild($newTextNode);
    $parent->appendChild($newNode);
    return $newNode;
}

#
# Processes a node
#
sub processNode($$$$)
{
    my ($self, $xmlDocument, $root, $line) = @_;

    my ($nodename, $nodetype, @tokens) = split(/\s+/, $line);
    
    # To keep track of whether or not a features and desires element
    # has been added to the current node
    my $addedFeatureDesireSpecNode = 0;

    my $newNode = addNode($xmlDocument, $root, "node");
    $newNode->setAttribute("name", $nodename);

    my $NodeTypeNode = addNode($xmlDocument, $newNode, "node_type");

    # The number of type_slots is optional. Default to 1. If there is
    # no ':' in the name, then the number of slots is 1, else it is
    # whatever number follows the ':'
    my ($nodeTypeName, $nodeTypeSlots) = split(":", $nodetype);
    $nodeTypeSlots = 1
	if (!defined($nodeTypeSlots));
    
    # If the name starts with a *, the the node is to be marked static
    my $isNodeStatic = 0;
    if ($nodeTypeName =~ /^\*([-\w]*)$/) {
	$nodeTypeName = $1;
	$isNodeStatic = 1;
    }
    $NodeTypeNode->setAttribute("type_name", $nodeTypeName);
    
    # If the number of slots is *, then the number of slots is unlimited
    if ($nodeTypeSlots eq "*") {
	$NodeTypeNode->setAttribute("type_slots", "unlimited");
    }
    else {
	$NodeTypeNode->setAttribute("type_slots", $nodeTypeSlots);
    }
    if ($isNodeStatic) {
	$NodeTypeNode->setAttribute("static", "true");
    }

    # Handle fixed node.
    if (exists($self->fixednodes()->{$nodename}) &&
	($self->isatoponode($nodename) || $self->isadelaynode($nodename))) {
	my $fixed = $self->fixednodes()->{$nodename};
	
	$newNode->setAttribute("assigned_to", $fixed);
    }

    # Iterate through all the optional parameters on the line
    foreach my $token (@tokens) {
	# If disallow_trivial_mix is present, put it under the NodeFlagSpec
	if ($token eq "disallow_trivial_mix") {
	    addNode($xmlDocument, $newNode, $token);
	}
	# If subnode_of is present, find the parent node and add the
	# appropriate node under NodeFlagSpec
	elsif ($token =~ /^subnode_of/) {
	    my ($subNodeOf, $parentNode) = split(":", $token);
	    addNodeWithText($xmlDocument, $newNode, "subnode_of", $parentNode);
	}
	# If an optional desire is present, put it under the
	# features and desires node
	elsif ($token =~ /:/) {
	    my $FeatureDesireSpecNode = addNode($xmlDocument, $newNode, "fd");
								
	    # The feature name is optionally prepended with a 2
	    # character prefix.  Detect the prefix and remove it from
	    # the feature name as appropriate
	    my ($featureName, $featureWeight) = split(":", $token);
	    my ($a, $b, $rest) = ($featureName =~ /^(.)(.)(.*)?/);

	    if (! ("$a" eq "*" || "$a" eq "?")) {
		$FeatureDesireSpecNode->setAttribute("fd_name", $featureName);
	    }
	    else {
		$FeatureDesireSpecNode->setAttribute("fd_name", $rest);
	    }
	    $FeatureDesireSpecNode->setAttribute("fd_weight", $featureWeight);
	    
	    if ($featureWeight >= 1.000000) {
		$FeatureDesireSpecNode->setAttribute("violatable", "true");
	    }

	    # The desire prefix is "*!"
	    if ("$b" eq "!") {
		$FeatureDesireSpecNode->setAttribute("global_operator",
						     "OnceOnly");
	    }
	    # The desire prefix is "*&"
	    elsif ("$b" eq "&") {
		$FeatureDesireSpecNode->setAttribute("global_operator",
						     "FirstFree");
	    }
	    # The desire prefix is "?+"
	    elsif ("$b" eq "+") {
		$FeatureDesireSpecNode->setAttribute("local_operator",
						     "+");
	    }
	}
    }
    return 0;
}

#
# Processes a link
#
sub processLink($$$$)
{
    my ($self, $xmlDocument, $root, $line) = @_;

    my ($linkname,
	$srcNameInterface, $destNameInterface, @tokens) = split(/\s+/, $line);
    
    my $newLinkNode = addNode($xmlDocument, $root, "link");
    $newLinkNode->setAttribute("name", $linkname);
	
    # Find the source name and the source interface.
    # If the node has no interface specified, assign it a "safe" interface
    # number. Increment the interface number.
    my ($srcName,$srcInterface) = split(":", $srcNameInterface);
    if (!defined($srcInterface)) {
	$srcInterface = $self->nextifacenumber();
    }
    # Do the same thing for the destination interface
    my ($destName,$destInterface) = split(":", $destNameInterface);
    if (!defined($destInterface)) {
	$destInterface = $self->nextifacenumber();
    }

    # Add a source interface element
    my $sourceInterfaceNode =
	addNode($xmlDocument, $newLinkNode, "source_interface");
    $sourceInterfaceNode->setAttribute("node_name", $srcName);
    $sourceInterfaceNode->setAttribute("interface_name", $srcInterface);
	
    # Add a destination interface element
    my $destinationInterfaceNode =
	addNode($xmlDocument, $newLinkNode, "destination_interface");
    $destinationInterfaceNode->setAttribute("node_name", $destName);
    $destinationInterfaceNode->setAttribute("interface_name", $destInterface);
	
    # Add other stuff that appears on the line
    addNodeWithText($xmlDocument, $newLinkNode, "bandwidth", shift(@tokens));
    addNodeWithText($xmlDocument, $newLinkNode, "latency", shift(@tokens));
    addNodeWithText($xmlDocument, $newLinkNode, "packet_loss", shift(@tokens));
	
    # Add a link_type element
    my $newLinkTypeNode = addNode($xmlDocument, $newLinkNode, "link_type");
    $newLinkTypeNode->setAttribute("type_name", shift(@tokens));
	
    # Run through the optional parameters at the end of the line
    foreach my $token (@tokens) {
	# If fixsrciface or fixdstiface are found
	if ($token =~ /:/) {
	    my ($fixIface, $ifaceName) = split(":", $token);
	    addNodeWithText($xmlDocument, $newLinkNode, $fixIface, $ifaceName);
	}
	elsif ($token eq "emulated") {
	    addNode($xmlDocument, $newLinkNode, "multiplex_ok");
	}
	elsif ($token ne "") {
	    addNode($xmlDocument, $newLinkNode, $token);
	}
    }
}

#
# Process a v-class.
#
sub processVClass($$$$)
{
    my ($self, $xmlDocument, $root, $line) = @_;
    
    my ($classname, $classweight, @tokens) = split(/\s+/, $line);

    my $newVClassNode = addNode($xmlDocument, $root, "vclass");
    $newVClassNode->setAttribute("name", $classname);
	
    # TODO: Need to take care of the hard case later
    addNode($xmlDocument, $newVClassNode, "soft");
    addNodeWithText($xmlDocument, $newVClassNode, "weight", $classweight);
	
    # The remaining entries on this line will be physical_types.
    foreach my $token (@tokens) {
	addNodeWithText($xmlDocument, $newVClassNode,
			"physical_type", $token);
    }
    return 0;
}

################################################################################
# Print the solution as an rspec. 
#
sub PrintSolution($$)
{
    my ($self, $output) = @_;
    $output = *STDOUT
	if (!defined($output));

    my $pid = $self->experiment()->pid();
    my $eid = $self->experiment()->eid();

    my $doc = XML::LibXML::Document->new();

    my $root = $doc->createElement("rspec");
    $root->setAttribute("pid", "$pid");
    $root->setAttribute("eid", "$eid");
    $root->setAttribute("xmlns:rspec", "http://emulab.net/resources/rspec/0.1");
    $doc->setDocumentElement($root);

    foreach my $pnodename (keys(%{ $self->solution_p2v() })) {
	my @vnodenames = @{ $self->solution_p2v()->{$pnodename} };
	my $pnode = $self->pnodes()->{$pnodename};

	foreach my $vnodename (@vnodenames) {
	    my $newNode = addNode($doc, $root, "node");
	    
	    $newNode->setAttribute("virtual_id", $vnodename);
	    $newNode->setAttribute("component_uuid", $pnode->uuid());
	}
    }
    foreach my $virtlan (values(%{ $self->vlans() })) {
	my $vlanname = $virtlan->vname();

	my $newLink = addNode($doc, $root, "link");
	$newLink->setAttribute("virtual_id", $vlanname);
	    
	foreach my $member ($virtlan->memberlist()) {
	    # Will this happen?
	    next
		if (!exists($self->solution_portmap()->{$member}));
		
	    my $vnode  = $member->vnode();
	    my $vport  = $member->vport();
	    my $pport  = $member->_pport();

	    my $newMember = addNode($doc, $newLink, "interface_ref");
	    $newMember->setAttribute("virtual_node_id", $vnode);
	    $newMember->setAttribute("virtual_port_id", $vport);
	    #
	    # XXX Ignore for now. Need to fix.
	    #
	    $newMember->setAttribute("component_id", $pport)
		if (defined($pport));
	}
    }
    print $output $doc->toString(1) . "\n";

    return 0;
}

1;