#!/usr/bin/perl -w

# This function as the main assign loop.  It converts the virtual
# topology into a top input including LAN and delay translation.  It
# then snapshots the current testbed physical state and runs assign,
# looping a couple times if assign fails.  When assign successfully
# completes it will interpret the results.  Attempt to match any
# existing portmap entries and then update the delays and vlans table.

# Syntax: assign_wrapper <pid> <eid>

# Caveats:
#  The support for direct and interswitch links has not been testbed much.

# Settings
# delaythresh is the maximum delay in ms above which a delay node is needed.
#  (Note that the DB represents delays as floating point numbers)
# maxrun is maximum number of times we run assign.
# delaywithswitch if 1 will use the switch to delay when possible.  Currently
#  this only works for 10mbit links.
$delaythresh = 2;
$maxrun = 20;
$delaywithswitch=0;

#
# Some handy constants. Speed in Mbits/sec and Kbits/sec units.
# The conversion routine is to make explicit that we operate with two
# different sets of units. One is the topology, which is in Kbps now.
# The second is the physical description, which has been changed to
# Kbps in the DB (and in ptopgen).
#
# Its probably a good idea to leave portbw (current_speed) in Mbs, since
# those numbers are used at the switch and the interfaces, which really
# only think in Mbps.
#
my $S10Mbs  = 10;
my $S100Mbs = 100;
my $S10Kbs  = 10000;
my $S100Kbs = 100000;
sub BWConvert($) {
    #
    # Use this if physical units are in Mbs (used to be).
    #
    #my $bw = $_[0] / 1000;
    
    my $bw = $_[0];
    return $bw;
}

$DELAYCAPACITY = @DELAYCAPACITY@;
$TBROOT = "@prefix@";
$ENV{'PATH'} = "/usr/bin:$TBROOT/libexec:$TBROOT/sbin:$TBROOT/bin";

use lib '@prefix@/lib';
use libdb;
use libtestbed;
require exitonwarn;

#
# Turn off line buffering on output
#
$| = 1;

use Getopt::Std;

getopts('v',\%opt);

sub usage {
	print "Usage: $0 [-v] pid eid\n";
	print "		-v enables verbose output\n";
	exit(-1);
}

my $verbose = 0;
if ($opt{v}) {
	$verbose = 1;
}

if (@ARGV != 2) {
	usage();
}

($pid,$eid) = @ARGV;

$ptopfile = "$pid-$eid-$$.ptop";

sub printdb {
    if ($verbose) {
	print $_[0];
    }
};

######################################################################
# Step 1 - Setup virtual topology
#
# Here we need to read the virtual topology in from the virt_nodes
# and virt_lans table.  We then need to add delay and lan nodes as
# necessary.
#
# Conversion details:
#   Let L be a LAN with N members.
#   If N == 2 
#      Let N1 be node 1
#      Let N2 be node 2
#      If L is delayed
#         Generate delay node D
#         Link N1 to D
#         Link N2 to D
#      Else
#         Link N1 to N2
#   Else
#      Generate lan node A
#      If L is delayed
#        Foreach node N in L
#           Generate delay node DN
#           Link A to DN
#           Link N to DN
#      Else
#        Foreach node N in L
#           Link N to A
#
# Datastructures:
#  nodes is indexed by virtual node and contains the node type.
#  isvirtnode is indexed by virtual node and says whether the node is "virtual"
#  nodelans is indexed by virtual node and contains a list of
#    <port>:<lan> that it is connected to.
#  ips is indexed by nodeport and contains the IP addresses.
#  lans is indexed by virtual lan and is a list of nodeport members.
#  delayinfo is indexed by virtual lan:node:port and is a list of delay,
#    bandwidth, lossrate, rdelay, rbandwidth, rlossrate.  Where r* indicates
#    switch->node and the others indicate node->switch.
#  okbandwidths is indexed by bandwidth and is just a set.
#  lannodes is indexed by physical name is the set of lan nodes.
#  interfacespeed is indexed by type and contains the bandwidth.
#  delaynodes is indexed by link name and contains [delay,bw,loss]
#  portbw is indexed by virtual nodeport and contains the bandwidth
#    of that port. Note that port bandwidth in the interfaces table is
#    left in Mbps units for now. Thats inconsistent, I know. For LANs with
#    other bandwidths the port speed will be 100 and a delay node will
#    be inserted.
#  fixed_nodes is indexed by virtual node name and points to physical node
#   name.
#  vtypes is indexed by vtype name and is a list of {weight types}.
#
# Delay node names:
#  delay nodes are named tbdelayXX N > 2
#   and tbsdelayXX for N == 2.
# 
# Lan node nameS:
#  lan nodes are named lan/<virtual lan>
######################################################################

# Shark Hack
# For each LAN we replace all the sharks in the LAN with a single
# shark shelf node.  After this goes through assign we pull them
# all back out.
#
# sharkshelves is indexed by virtual shelf name and is a list of
# the virtual nodes in it.
# sharkshelfid is used to generate ids for shark shelves.
$sharkshelfid = 0;

# delayid is used to generate ids for delay nodes.
$delayid = 0;

printdb "Generating TOP file.\n";

# Let's figure out what kind of links we have.
printdb "Finding interface speeds:";
my $result = DBQueryFatal("SELECT type,max_speed from interface_types");
while (($type,$bandwidth) = $result->fetchrow_array) {
    $okbandwidths{$bandwidth} = 1;
    $interfacespeed{$type} = $bandwidth;
    printdb " $bandwidth";
}
$result->finish;
printdb "\n";

printdb "Loading virt_nodes.\n";
$result =
    DBQueryFatal("select distinct vname,ips,vn.type,fixed,nt.isvirtnode ".
		 " from virt_nodes as vn ".
		 "left join node_types as nt on ".
		 " nt.type=vn.type or nt.class=vn.type ".
		 "where pid='$pid' and eid='$eid'");

while (($vname,$ips,$type,$fixed,$isvirt) = $result->fetchrow_array) {
    if (! defined($fixed))  {$fixed  = "";}
    #
    # if its a vtype, no entry in node_types. vtypes break virtual nodes.
    # Need to look inside the vtype and make sure no mixing of vnodes and
    # physnodes. Later ...
    #
    if (! defined($isvirt)) {$isvirt = 0;}
    
    printdb "  $vname $type $ips $fixed $isvirt\n";
    # We need to check the names to make sure they won't clash with
    # our internal delay node names.
    if (($vname =~ /^tbdelay\d+/) ||
	($vname =~ /^tbsdelay\d+/)) {
	print STDERR "Warning: $vname is a reserved name.  Working around.\n";
	($num) = ($vname =~ /(\d+)/);
	$delayid = $num + 1;
    }
    $nodes{$vname} = $type;
    $nodelans{$vname} = [];
    #
    # VIRTNODE HACK: For a virtual node, we want to ignore the link info.
    # 
    $isvirtnode{$vname} = $isvirt;
    if (! $isvirt) {
	foreach $ipinfo (split(" ",$ips)) {
	    ($port,$ip) = split(":",$ipinfo);
	    $ips{"$vname:$port"} = $ip;
	}
    }
    if ($fixed ne "") {
	$fixed_nodes{$vname} = $fixed;
    }
}
$result->finish;

printdb "Loading virt_lans.\n";
$result =
    DBQueryFatal("select vname,member,delay,bandwidth,lossrate," .
		 "rdelay,rbandwidth,rlossrate " .
		 "from virt_lans where pid='$pid' and eid='$eid'");

#
# VIRTNODE HACK: Virtual nodes are special.
#
# Prepass the table looking for those lans that have a virtual node
# as a member. We want to ignore those (both sides) if its a duplex
# link, but if its in a lan then we only want to ignore that particular
# member of the lan. So, record the number of times we see the lan.
# See below.
#
my %skiplans = ();
my %lancount = ();

while (($vname,$member) = $result->fetchrow_array) {
    ($node,$port) = split(":",$member);

    if (defined($lancount{$vname})) {
	$lancount{$vname} += 1;
    }
    else {
	$lancount{$vname} = 1;
    }
    
    if ($isvirtnode{$node}) {
	$skiplans{$vname} = 1;
    }
}
$result->dataseek(0);

#
# Now do the real pass.
# 
while (($vname,$member,$delay,$bandwidth,$lossrate,
	$rdelay,$rbandwidth,$rlossrate) = $result->fetchrow_array) {
    ($node,$port) = split(":",$member);

    #
    # VIRTNODE HACK: Virtual nodes are special.
    #
    # If its a duplex link involving a virtnode, skip it. 
    # If its a lan (not a duplex link) then drop just that member.
    # We do not want to have assign deal with these. The nodes are
    # allocated as unconnected, and we deal with it later.
    # 
    if ($skiplans{$vname} &&
	($lancount{$vname} == 2 || $isvirtnode{$node})) {
	    next;
    }
    
    if (! defined($lans{$vname})) {
	$lans{$vname} = [];
    }
    push(@{$lans{$vname}},$member);
    $delayinfo{"$vname:$member"} = [$delay,$bandwidth,$lossrate,
				    $rdelay,$rbandwidth,$rlossrate];

    #
    # Grab the Q stuff from virt_lans. I'm keeping this separate for
    # now until I understand whats going on. There are no "r" params
    # either. I have no idea how do to this stuff for lans, and for
    # duplex links the "r" params are not necessary. Each virt_lans
    # entry gives the params towards the switch, which equal the
    # reverse params for the other member. 
    #
    my $query_result =
	DBQueryFatal("select 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 ".
		     "from virt_lans ".
		     "where pid='$pid' and eid='$eid' and ".
		     "      vname='$vname' and member='$member'");
    
    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) = $query_result->fetchrow_array;
    
    $queueinfo{"$vname:$member"} =
	[$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];

    if ($q_red) {
	$mustdelay{$vname} = 1;
    }
    
    #
    # XXX - Whenever a delay node is inserted, port speeds are set to
    #       100Mbs, even if they requested exactly 10Mbs. 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.
    # 
    if ($bandwidth == $S10Kbs && $delaywithswitch) {
	$portbw{$member} = $S10Mbs;
    } else {
	$portbw{$member} = $S100Mbs;
    }
    push(@{$nodelans{$node}},"$port:$vname");
    printdb "  portbw of $member = $portbw{$member}\n";
    printdb "  $vname $member - $delay $bandwidth $lossrate $rdelay $rbandwidth $rlossrate\n";
    printdb "    Added $port:$vname to nodelans of $node\n";
}
$result->finish;

#
# Check event list. Anytime we find an event to control a link, we need
# to drop a delay node in. start/stop especially, since thats the easiest
# way to do that, even if the link has no other traffic shaping in it. 
# 
printdb "Checking events for LINK commands.\n";
$result =
    DBQueryFatal("select distinct vname from eventlist as ex ".
		 "left join event_eventtypes as et on ex.eventtype=et.idx ".
		 "left join event_objecttypes as ot on ex.objecttype=ot.idx ".
		 "where ot.type='LINK' and ex.pid='$pid' and ex.eid='$eid'");
while (($vname) = $result->fetchrow_array) {
    $mustdelay{$vname} = 1;
}

# Shark hack
foreach $lan (keys(%lans)) {
    $realmembers = [];
    $sharks = [];
    $hassharks = 0;
    foreach $member (@{$lans{$lan}}) {
	($node) = (split(":",$member))[0];
	if (($nodes{$node} eq "shark") || ($nodes{$node} eq "dnard")) {
	    push(@$sharks,$member);
	    $hassharks = 1;
	} else {
	    push(@$realmembers,$member);
	}
    }
    if ($hassharks) {
	$shelfid = "sharkshelf$sharkshelfid";
	printdb "  Creating shark shelf: $shelfid (" . 
	    join(" ",@$sharks) . ")\n";
	$sharkshelfid++;
	$sharkshelves{$shelfid} = $sharks;
	$delayinfo{"$lan:$shelfid:uplink"} = [0,$S100Kbs,0.0,
					      0,$S100Kbs,0.0];
	push(@$realmembers,"$shelfid:uplink");
	$nodes{$shelfid} = "shark-shelf";
    }
    $lans{$lan} = $realmembers;
}
# End shark hack

# Load virt types
printdb "Loading virt_vtypes.\n";
$result = DBQueryFatal("SELECT name,weight,members from virt_vtypes" .
		       " where pid=\"$pid\" and eid=\"$eid\"");
while (($name,$weight,$types) = $result->fetchrow_array) {
    printdb "  $name $weight $types\n";
    $vtypes{$name} = "$weight $types";
}

# Open the TOP file
$topfile = "$eid.top";
open(TOPFILE,"> $topfile") || do {
    die("*** $0:\n".
	"    Could not open $topfile.\n");
};

# Print out vtypes
foreach $vtype (keys(%vtypes)) {
    print TOPFILE "make-vclass $vtype $vtypes{$vtype}\n";
}

$nodes=0;
$delaynodes=0;

foreach $node (keys(%nodes)) {
    # Shark hack
    if (($nodes{$node} ne "shark") && ($nodes{$node} ne "dnard")) {
	print TOPFILE "node $node $nodes{$node}\n";
	if ($nodes{$node} ne "shark-shelf") {
	    $nodes++;
	}
    }
    # End Shark hack
}

foreach $lan (keys(%lans)) {
    @members = @{$lans{$lan}};
    printdb "$lan - " . join(" ",@members) . "\n";
    # Shark hack for rvr
    $sharks = 0;
    $nonsharks = 0;
    foreach $member (@members) {
	($node) = (split(":",$member))[0];
	if ($nodes{$node} eq "shark-shelf") {
	    $sharks++;
	} else {
	    $nonsharks++;
	}
    }
    if ($#members == 1) {
	($nodeport0,$nodeport1) = @members;
	$node0 = (split(":",$nodeport0))[0];
	$node1 = (split(":",$nodeport1))[0];
	($delay0,$bw0,$loss0,
	 $rdelay0,$rbw0,$rloss0) = @{$delayinfo{"$lan:$nodeport0"}};
	($delay1,$bw1,$loss1,
	 $rdelay1,$rbw1,$rloss1) = @{$delayinfo{"$lan:$nodeport1"}};
	# Here the r's aregoing to be 1->0 and the others 0->1
	$delay = $delay0+$rdelay1;
	$loss = 1-(1-$loss0)*(1-$rloss1);
	$bw = &min($bw0,$rbw1);
	$rdelay = $rdelay0+$delay1;
	$rloss = 1-(1-$rloss0)*(1-$loss1);
	$rbw = &min($rbw0,$bw1);
	$bandwidth = &getbandwidth(&min($bw0,$rbw1));
	$rbandwidth = &getbandwidth(&min($rbw0,$bw1));
	if ((($delay >= $delaythresh) ||
	     (($bw != $S100Kbs) && ($bw != $S10Kbs)) ||
	     (($delaywithswitch == 0) && 
	      (($bw != $S100Kbs) && (($sharks == 0) || ($nonsharks > 1)))) || 
	     ($loss != 0)) ||
	    (defined($mustdelay{$lan})) ||
	    (($rdelay >= $delaythresh) ||
	     (($rbw != $S100Kbs) && ($rbw != $S10Kbs)) ||
	     (($delaywithswitch == 0) && 
	      (($rbw != $S100Kbs) && (($sharks == 0) || ($nonsharks > 1)))) || 
	     ($rloss != 0))) {
	    $delayname = "tbsdelay$delayid";
	    $delaynodes{"linksdelaysrc/$lan"} = [$delay,$bw,$loss,
						 $rdelay,$rbw,$rloss];
	    printdb "Delay node linksdelaysrc/$lan ($delayname) = " . 
		join(" ",@{$delaynodes{"linksdelaysrc/$lan"}}) . "\n";
	    $delayid++;
	    print TOPFILE "node $delayname delay\n";
	    $delaynodes++;
	    print TOPFILE "link linksdelaysrc/$lan $node0 $delayname"
		. " $bandwidth\n";
	    print TOPFILE "link linksdelaydst/$lan $node1 $delayname"
		. " $bandwidth\n";
	    #
	    # Ports are set to 100Mbs 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.
	    #
	    $portbw{$nodeport0} = $S100Mbs;	    
	    $portbw{$nodeport1} = $S100Mbs;	    
	} else {
	    print TOPFILE "link linksimple/$lan $node0 $node1 $bandwidth\n";
	}
    } elsif ($#members != 0) {
	print TOPFILE "node lan/$lan lan\n";
	$lannodes{"lan/$lan"} = 1;
	foreach $member (@members) {
	    ($delay,$bw,$loss,
	     $rdelay,$rbw,$rloss) = @{$delayinfo{"$lan:$member"}};
	    $bandwidth = &getbandwidth($bw);
	    $rbandwidth = &getbandwidth($rbw);
	    ($node) = (split(":",$member))[0];
# XXX The expression below should be modified for better bandwidth support.
# Probably needs to happen post assign somehow.
	    if ((($delay >= $delaythresh) ||
		 (($bw != $S100Kbs) && ($bw != $S10Kbs))  ||
		 (($delaywithswitch == 0) && 
		  (($bw != $S100Kbs) && (($sharks == 0) ||
					 ($nonsharks > 1)))) ||
		 ($loss != 0)) || 
		(defined($mustdelay{$lan})) ||
		(($rdelay >= $delaythresh) ||
		 (($rbw != $S100Kbs) && ($rbw != $S10Kbs))  ||
		 (($delaywithswitch == 0) && 
		  (($rbw != $S100Kbs) && (($sharks == 0) ||
					 ($nonsharks > 1)))) ||
		 ($rloss != 0))) {
		$delayname = "tbdelay$delayid";
		$delaynodes{"linkdelaysrc/$lan/$member"} =
		    [$delay,$bw,$loss,$rdelay,$rbw,$rloss];
		printdb "Delay node linkdelaysrc/$lan/$member ($delayname) " .
		    " = " . join(" ",@{$delaynodes{"linkdelaysrc/$lan/$member"}}) . "\n";
		$delayid++;
		print TOPFILE "node $delayname delay\n";
		$delaynodes++;
		print TOPFILE "link linkdelaysrc/$lan/$member" .
		    " $node $delayname $bandwidth\n";
		print TOPFILE "link linkdelaydst/$lan/$member" .
		    " lan/$lan $delayname $bandwidth\n";
		#
		# Port is set to 100Mbs 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.
		#
		$portbw{$member} = $S100Mbs;	    
	    } else {
		print TOPFILE "link linklan/$lan/$member $node lan/$lan" .
		    " $bandwidth\n";
	    }
	}
    }
    # If a LAN has only one member we don't do anything.
}

# Print out fixed nodes
foreach $fixed (keys(%fixed_nodes)) {
    print TOPFILE "fix-node $fixed $fixed_nodes{$fixed}\n";
}

close TOPFILE;

# Set estimations
$minimum_nodes = $nodes + $delaynodes/$DELAYCAPACITY;
$maximum_nodes = $nodes + $delaynodes;
DBQueryFatal("UPDATE experiments set maximum_nodes=$maximum_nodes, " .
	 "minimum_nodes=$minimum_nodes where pid=\"$pid\" and eid=\"$eid\"");
print "Minumum nodes = $minimum_nodes\n";
print "Maximum nodes = $maximum_nodes\n";

######################################################################
# Step 2 - Assign Loop
# 
# Here we loop up to maxrun times.  In each loop we snapshot the
# current testbed state into a ptop file.  We then run assign.  If
# assign succeeds we attempt to reserve the resources.  If that works
# we're done with step 2 otherwise we loop again.
#
# v2pmap is indexed by virtual and contains the physical node.
# p2vmap is indexed by physical and contains the virtual node
# plinks is indexed by virtual name and contains 
#  (pnodeportA,pnodeportB) .  If one is a delay node it is always
#  the second.
#######################################################################

$currentrun = 1;
while (1) {
    print "Assign Run $currentrun\n";

    # Violation counts
    $unassigned = -1;
    $linkusers = -1;
    $bandwidth = -1;
    $desires = -1;

    # Clear v2pmap, p2vmap, and plinks
    undef %v2pmap;
    undef %p2vmap;
    undef %plinks;

    # Snapshot
    system("ptopgen > $ptopfile");

    # Get number of nodes
    my $numnodes_result = 
	DBQueryFatal("select a.node_id,a.type from" .
		     " nodes as a left join reserved as b" .
		     " on a.node_id=b.node_id" .
		     " where b.node_id is null" .
		     " and a.role='testnode' and a.type!='dnard'");
    $numnodes = $numnodes_result->numrows;
    
    if ($numnodes < $minimum_nodes) {
	print STDERR "$0: *** Insufficient nodes available.\n";
	exit(2);
    }

    # Run assign
    $fail = 0;
    print "assign -b -t $ptopfile $topfile\n";
    open(ASSIGNFP,"assign -b -t $ptopfile $topfile | tee assign.log |");
    $violations = 0;
    $score = -1;

    # read output
    # Header
    printdb "Reading assign results.\n";
    while (<ASSIGNFP>) {
	chop;
	/No physical nodes of type (.+)$/ && do {
	    $score=-2;
	    print $_ . "\n";
	};
	/^With ([0-9]+) violations$/ && do {
	    $violations = $1;
	    last;
	};
	/^[ \t]+BEST SCORE: [ \t]+([0-9]+\.[0-9]+)/ && ($score=$1);
    }
    if ($score == -2) {
	# Type error
	print "Giving up.\n";
	exit(2);
    }
    printdb "Found score $score, violations $violations.\n";

    # We don't bother reading anything else if violations occured.
    if (($violations == 0) && ($score != -1)) {
	# read nodes section
	while (<ASSIGNFP> !~ /^Nodes:/) {}
	printdb "Nodes:\n";
	while (<ASSIGNFP>) {
	    chop;
	    /^End Nodes$/ && last;
	    @info = split;
	    ($virtual,$physical) = @info[0,2];
	    $v2pmap{$virtual} = $physical;
	    $p2vmap{$physical} = $virtual;
	    printdb "  $virtual $physical\n";
	}

	# read Edges
	# By convention, in plinks, the delay node is always the second
	# entry.
	while (<ASSIGNFP> !~ /^Edges:/) {}
	printdb "Edges:\n";
	while (<ASSIGNFP>) {
	    /^End Edges$/ && last;
	    @info = split;
	    $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 {
		  die("*** $0:\n".
		      "    Unsupported link type: direct.\n");
	      };
	      print "Found garbage: $line\n";
	  }
	    $nodeportA = &getnodeport($rawA);
	    $nodeportB = &getnodeport($rawB);
	    $nodeportA =~ s/\//:/;
	    $nodeportB =~ s/\//:/;
	    if (&isdelay($nodeportB)) {
		$plinks{$vlink} = [$nodeportA,$nodeportB];
	    } else {
		$plinks{$vlink} = [$nodeportB,$nodeportA];
	    }
	    printdb "  $vlink " . join(" ",@{$plinks{$vlink}}) . "\n";
	}
    } else {
	# spit out up to nodes
	print "ASSIGN FAILED:\n";       
	while (<ASSIGNFP>) {
	    if (/link_users: (\d+)$/) {
		$linkusers = $1;
	    } elsif (/bandwidth: (\d+)$/) {
		$bandwidth = $1;
	    } elsif (/unassigned: (\d+)$/) {
		$unassigned = $1;
	    } elsif (/desires: (\d+)$/) {
		$desires = $1;
	    }
	    if (/^Nodes:/) {last;}
	    print "$_";
	}
	$fail = 1;
    }
    while (<ASSIGNFP>) { } # Read anything left in the pipe before closing
    close(ASSIGNFP);

    # Reserve resources
    if (!$fail) {
	print "Reserving resources.\n";
	@toreserve = ();
	# We don't reserve LAN nodes.
	foreach $node (keys(%p2vmap)) { 
	    if (! defined($lannodes{$p2vmap{$node}})) {
		push(@toreserve,$node);
	    }
	}
	if (system("nalloc $pid $eid " . join(" ",@toreserve))) {
	    print "Failed to reserve resources.  Trying again.\n";
	} else {
	    print "Successfully reserved resources.  Finishing setup.\n";
	    last;
	}
    }

    # Check for exit
    if ($currentrun >= $maxrun) {
	$exitcode = 1;
	if ($bandwidth > 0) {
	    $exitcode += 4;
	} 
	if ($linkusers > 0) {
	    $exitcode += 8;
	}
	if ($desires > 0) {
	    $exitcode += 16;
	}
	if ($unassigned > 0) {
	    $exitcode += 32;
	}
	print "$0: *** Reached run limit.  Giving up.\n";
	exit($exitcode);
    }
    $currentrun++;
}


######################################################################
# Step 3 - Convert to vlans, delays, and portmap
# 
# Here we convert the plinks into vlans, delays, and portmap.  We
# convert them first into internal datastructure.  After Step 4
# when we do some port swapping we'll upload the modified versions
# of these structures into the database.
#
# vlans is indexed by an internal ID contains:
#  [vname, members]
# delays is indexed by an internal ID and contains:
#  [pnode, int0, int1, vname, delay, bandwidth, lossrate]
# portmap is indexed by <virtual node>:<virtual port> and contains
#  the physical port.
# nodevlans is indexed by physical node and contains the VLANs
#  it's interfaces are in.  It does not contain entries for delay
#  nodes.
#
# vlan ids
#  vlan ids are increasing integers in the case of node<->delay connections.
#  In the case of actual LANs either of real node or of delay nodes
#  they are indexed by virtual lan name.
# delay ids
#  delay ids are increasing integers.  We could have used a list of
# delays just as well.  Having it as an array may prove useful for
# future changes however.
######################################################################

$vlanid = 0;
$delayid = 0;
foreach $pnode (keys(%p2vmap)) {
    $nodevlans{$pnode} = [];
}

printdb "Interpreting results.\n";
foreach $plink (keys(%plinks)) {
    ($nodeportA,$nodeportB) = @{$plinks{$plink}};
    ($nodeA,$portA) = split(":",$nodeportA);
    ($nodeB,$portB) = split(":",$nodeportB);
    printdb "plink $plink - $nodeportA $nodeportB\n";
    if (($lan) = ($plink =~ m|^linksdelaysrc/(.+)$|)) {
	# Node has a single entry in lan.
	# Node is nodeportA
	# Delay node is nodeportB
	# Other end of delay node will be given by plink
	#   linksdelaydst/lan where nodeportA will be the other node in
	#   the virtual LAN and nodeportB will be the other end of the
	#   delay node.

	($nodeportC,$nodeportD) = @{$plinks{"linksdelaydst/$lan"}};
	($nodeC,$portC) = split(":",$nodeportC);
	($nodeD,$portD) = split(":",$nodeportD);
	printdb "LINK delay: other end = $nodeportC $nodeportD\n";

	# assert nodeB == nodeD

	printdb "  VLANS:\n";
	$vlans{$vlanid} = [$lan,[$nodeportA, $nodeportB]];
	push(@{$nodevlans{$nodeA}},$vlanid);
	printdb "    $vlanid = $lan, \[$nodeportA, $nodeportB\]\n";
	$vlanid++;
	$vlans{$vlanid} = [$lan,[$nodeportC, $nodeportD]];
	push(@{$nodevlans{$nodeC}},$vlanid);
	printdb "    $vlanid = $lan, \[$nodeportC, $nodeportD\]\n";
	$vlanid++;

	($delay,$bandwidth,$lossrate,
	 $rdelay,$rbandwidth,$rlossrate) = @{$delaynodes{$plink}};
	$delays{$delayid} = [$nodeB,$portB,$portD,$lan,
			     $delay,$bandwidth,$lossrate,
			     $rdelay,$rbandwidth,$rlossrate,
			     $nodeportA,$nodeportC];
	printdb "  Delays: $delayid = \[$nodeB,$portB,$portD,$lan" .
	    ",$delay,$bandwidth,$lossrate,$rdelay,$rbandwidth," .
		"$rlossrate,$nodeportA,$nodeportC\]\n";
	$delayid++;
	
	$virtA = &find_vport($p2vmap{$nodeA},$lan);
	$virtC = &find_vport($p2vmap{$nodeC},$lan);
	$portmap{"$p2vmap{$nodeA}:$virtA"} = $portA;
	$portmap{"$p2vmap{$nodeC}:$virtC"} = $portC;
	printdb "  Portmap:\n";
	printdb "    $p2vmap{$nodeA}:$virtA = $portA\n";
	printdb "    $p2vmap{$nodeC}:$virtC = $portC\n";
    } elsif (($lan,$member) = ($plink =~ m|^linkdelaysrc/([^/]+)/(.+)$|)) {
	# Node may have multiple entries in lan.
	# Delay node is nodeB and portB.
	# Other end of delay node will be given by plink
	#  linkdelaydst/lan/node where nodeportA will the LAN node and
	#  nodeportB will be the other end of the delay node.
	($nodeportC,$nodeportD) = @{$plinks{"linkdelaydst/$lan/$member"}};
	($nodeC,$portC) = split(":",$nodeportC);
	($nodeD,$portD) = split(":",$nodeportD);
	printdb "LAN delay src: other end = $nodeportC $nodeportD\n";
	
	$vlans{$vlanid} = [$lan,[$nodeportA, $nodeportB]];
	push(@{$nodevlans{$nodeA}},$vlanid);
	printdb "  VLANS:\n";
	printdb "    $vlanid = $lan, \[$nodeportA $nodeportB\]\n";
	$vlanid++;
	
	if (! defined($vlans{$lan})) {
	    $vlans{$lan} = [$lan,[]];
	}
	$members = (@{$vlans{$lan}})[1];
	push(@$members,$nodeportD);
	printdb "    $lan = $lan, \[" . join(" ",@$members) . "\]\n"; 

	($delay,$bandwidth,$loss,
	 $rdelay,$rbandwidth,$rloss) = @{$delaynodes{$plink}};
	$delays{$delayid} = [$nodeB,$portB,$portD,$lan,
			     $delay,$bandwidth,$loss,
			     $rdelay,$rbandwidth,$rloss,
                             $nodeportA,$nodeportC];
	printdb "  Delays: $delayid = \[$nodeB,$portB,$portD,$lan," .
	    "$delay,$bandwidth,$loss,$rdelay,$rbandwidth,$rloss," .
             "$nodeportA,$nodeportC\]\n";
	$delayid++;
	
	$virt = &find_vport($p2vmap{$nodeA},$lan);
	$portmap{"$p2vmap{$nodeA}:$virt"} = $portA;
	printdb "  Portmap: $p2vmap{$nodeA}:$virt = $portA\n";
    } elsif (($lan) = ($plink =~ m|^linksimple/(.+)$|)) {
	# nodeportA and nodeportB are the only two nodes in the
	# virtual LAN and there are no delays.
	printdb "Simple Link\n";
	$vlans{$lan} = [$lan,[$nodeportA,$nodeportB]];
	printdb "  VLANS: $lan = $lan, \[$nodeportA $nodeportB\]\n";
	
	push(@{$nodevlans{$nodeA}},$lan);
	push(@{$nodevlans{$nodeB}},$lan);
	
	$virtA = &find_vport($p2vmap{$nodeA},$lan);
	$virtB = &find_vport($p2vmap{$nodeB},$lan);
	$portmap{"$p2vmap{$nodeA}:$virtA"} = $portA;
	$portmap{"$p2vmap{$nodeB}:$virtB"} = $portB;
	printdb "  Portmap:\n";
	printdb "    $p2vmap{$nodeA}:$virtA = $portA\n";
	printdb "    $p2vmap{$nodeB}:$virtB = $portB\n";
    } elsif (($lan) = ($plink =~ m|^linklan/([^/]+)/.+$|)) {
	# node may be the LAN multiple times.
	# nodeportA is the node.
	# nodeportB is the LAN
	# No delays
	printdb "LAN\n";
	if (! defined($vlans{$lan})) {
	    $vlans{$lan} = [$lan,[]];
	}
	$members = (@{$vlans{$lan}})[1];
	push(@$members,$nodeportA);
	printdb "  VLANS: $lan = $lan,\[" . join(" ",@$members) . "\]\n";

	$virt = &find_vport($p2vmap{$nodeA},$lan);
	$portmap{"$p2vmap{$nodeA}:$virt"} = $portA;
	printdb "  Portmap: $p2vmap{$nodeA}:$virt = $portA\n";
    }
    # Else delaysrc case, will be handled by one of the other cases.
}

######################################################################
# Step 4 - Upload to DB
#
# Nothing fancy.
######################################################################
printdb "Uploading to DB\n";
foreach $vlan (keys(%vlans)) {
    ($lan,$members) = @{$vlans{$vlan}};
    DBQueryFatal("insert into vlans (id,pid,eid,virtual,members) values" .
	     " (0,\"$pid\",\"$eid\",\"$lan\",\"" .
	     join(" ",@$members) . "\")");
}
my $pipeid = 100;

foreach $delay (keys(%delays)) {
    # So r* indicates int1->int0 and others are int0->int1
    ($pnode,$int0,$int1,$vname,$delay,$bandwidth,$lossrate,
     $rdelay,$rbandwidth,$rlossrate,$np0,$np1) = 
	@{$delays{$delay}};
    my $pipe0 = $pipeid;
    my $pipe1 = $pipeid + 10;
    $pipeid += 100;

    #
    # Okay, this is terible. If this is link (not a lan) then find the
    # the queue info. We do not support queues in lans yet.
    #
    my @members = @{$lans{$vname}};
    if (@members == 2) {
	my ($nodeport0,$nodeport1) = @members;

	$np0node = (split(":",$np0))[0];
	$np1node = (split(":",$np1))[0];
	$np0vnode = $p2vmap{$np0node};
	$np1vnode = $p2vmap{$np1node};

	$node0 = (split(":",$np0))[0];
	$node1 = (split(":",$np1))[0];

	printdb("np0 = $np0, np0vnode = $np0vnode, np1 = $np1, ".
		"np1vnode = $np1vnode, nodeport0 = $nodeport0, ".
		"nodeport1 = $nodeport1\n");

	# This is pretty hackish
	if ($node0 eq $np0node) {
	    $vnp0 = $nodeport0;
	    $vnp1 = $nodeport1;
	} else {
	    $vnp0 = $nodeport1;
	    $vnp1 = $nodeport0;
	}

	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) =
		@{$queueinfo{"$vname:$vnp0"}};

	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) =
		          @{$queueinfo{"$vname:$vnp1"}};
    
	DBQueryFatal("insert into delays " .
	     " (pid,eid,node_id,vname,iface0,iface1" .
	     ",pipe0,delay0,bandwidth0,lossrate0" .
	     ",pipe1,delay1,bandwidth1,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','$pnode','$vname','$int0','$int1'".
	     ",$pipe0,$delay,$bandwidth,$lossrate".
	     ",$pipe1,$rdelay,$rbandwidth,$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)");
    }
    else {
	DBQueryFatal("insert into delays" .
	     " (pid,eid,node_id,vname,iface0,iface1" .
	     ",pipe0,delay0,bandwidth0,lossrate0" .
	     ",pipe1,delay1,bandwidth1,lossrate1)" .
	     " values ('$pid','$eid','$pnode','$vname','$int0','$int1'".
	     ",$pipe0,$delay,$bandwidth,$lossrate".
	     ",$pipe1,$rdelay,$rbandwidth,$rlossrate)");
    }
    
    #
    # XXX - Whenever a delay node is inserted, port speeds are set to
    #       100Mbs 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.
    #
    DBQueryFatal("update interfaces set " .
		 "current_speed='$S100Mbs' " .
		 "where node_id='$pnode' and ".
		 "(iface='$int0' or iface='$int1')");
}

foreach $vnodeport (keys(%portmap)) {
    ($vnode,$vport) = split(":",$vnodeport);
    $pport = $portmap{$vnodeport};
    # Shark Hack
    if ($nodes{$vnode} eq "shark-shelf") {
	$shelf = $v2pmap{$vnode};
	$i = 1;
	foreach $shark (@{$sharkshelves{$vnode}}) {
	    DBQueryFatal("update interfaces set IPalias=\"$ips{$shark}\" " .
		    "where node_id = \"$shelf-$i\"");
	    $i++;
	}
    } else {
	DBQueryFatal("update interfaces set IP=\"$ips{$vnodeport}\" where" .
		 " node_id = \"$v2pmap{$vnode}\" and iface = \"$pport\"");
    }
    # End Shark Hack
}
# Load delay_osids and default osids for types
$result = DBQueryFatal("SELECT type,delay_osid,osid from node_types");
while (($type,$delayosid,$defosid) = $result->fetchrow_array) {
    $delayosids{$type} = $delayosid;
    $defosids{$type} = $defosid;
}
$result->finish;
@nodepairs = ();
foreach $pnode (keys(%p2vmap)) {
    if (defined($sharkshelves{$p2vmap{$pnode}})) {
	$i = 1;
	foreach $sharknodeport (@{$sharkshelves{$p2vmap{$pnode}}}) {
	    $shark = (split(":",$sharknodeport))[0];
	    push(@nodepairs,["$pnode-$i",$shark]);
	    $i++;
	}
    } else {
	push(@nodepairs,[$pnode,$p2vmap{$pnode}]);
    }
}
foreach $pair (@nodepairs) {
    ($pnode,$vnode) = @$pair;
    my $result = DBQueryFatal("SELECT osname,cmd_line,rpms,deltas," .
			 " startupcmd,tarfiles,failureaction,routertype " .
			 " from virt_nodes where pid=\"$pid\"" .
			 " and eid=\"$eid\" and vname=\"$vnode\"");
    # The if statement will cause us to skip nodes that belong to
    # the experiment but aren't virtual.  I.e. delay nodes.
    # Figure out type of pnode
    my $result2 = DBQueryFatal("SELECT type from nodes" .
			  " where node_id=\"$pnode\"");
    my ($type) = $result2->fetchrow_array;
    $result2->finish;
    if (($osname,$cmdline,$rpms,$deltas,$startupcmd,$tarfiles,
	 $failureaction,$routertype) = $result->fetchrow_array) {
	my $osid;
	if (!defined($osname) || $osname eq "") {
	    $osid = $defosids{$type};
	}
	#
	# Map the user name into a specific OSID in the project or in
	# the OPS project (a default image). 
	# 
	elsif (! ($osid = TBOSID($pid, $osname)) &&
	       ! ($osid = TBOSID(TB_OPSPID, $osname))) {
	    die("*** $0:\n".
		"    Invalid OS $osname in project $pid!\n");
	}
	DBQueryFatal("UPDATE nodes set def_boot_osid=\"$osid\"," .
		       " def_boot_cmd_line='$cmdline'," .
		       " startstatus='none'," .
		       " bootstatus='unknown'," .
		       " ready=0," .
		       " rpms='$rpms'," .
		       " deltas='$deltas'," .
		       " tarballs='$tarfiles'," .
		       " startupcmd='$startupcmd'," .
		       " failureaction='$failureaction'," .
		       " routertype='$routertype'" .
		       " where node_id='$pnode'");
    } elsif (! defined($lannodes{$p2vmap{$pnode}})) {
	# Delay node
	DBQueryFatal("UPDATE nodes set def_boot_osid=\"" .
		       $delayosids{$type} . "\"," .
		       " startstatus=\"none\"," .
		       " bootstatus=\"unknown\"," .
		       " ready=0" .
		       " where node_id=\"$pnode\"");
    }
    $result->finish;
}

foreach $pnode (keys(%p2vmap)) {
    $vnode = $p2vmap{$pnode};
    $i = 1;
    if (defined($nodes{$vnode}) && 
	($nodes{$vnode} eq "shark-shelf")) {
	foreach $shark (@{$sharkshelves{$vnode}}) {
	    $vname = (split(":",$shark))[0];
	    DBQueryFatal("update reserved set vname=\"$vname\" where" .
		     " node_id = \"$pnode-$i\"");
	    $i++;
	}
    } else {
	DBQueryFatal("update reserved set vname=\"$vnode\"" .
		 " where node_id = \"$pnode\"");
    }
}

foreach $vnodeport (keys(%portbw)) {
    ($vnode,$vport) = split(":",$vnodeport);
    # SHARK HACK
    if (defined($v2pmap{$vnode})) {
	$pnode = $v2pmap{$vnode};
	$pport = $portmap{$vnodeport};
	DBQueryFatal("update interfaces set " .
		" current_speed=\"$portbw{$vnodeport}\"" .
		" where node_id=\"$pnode\" and iface=\"$pport\"");
    }
}

#
# Post pass the event list. At present, all LINK operations apply to
# the delay node that is in the middle of it. Rewrite the vnode in
# the event list. This info becomes stale when the experiment is swapped
# out, but thats okay since it gets redone at swapin.
#
$eventlist_result =
    DBQueryFatal("select ex.idx,ex.vname,r.vname ".
		 " from eventlist as ex ".
		 "left join delays as d on ".
		 " ex.vname=d.vname and ex.pid=d.pid and ex.eid=d.eid ".
		 "left join reserved as r on r.node_id=d.node_id ".
		 "left join event_objecttypes as ob on ob.idx=ex.objecttype ".
		 "where ob.type='LINK' and ex.pid='$pid' and ex.eid='$eid'");

while (my ($idx,$vname,$vnode) = $eventlist_result->fetchrow_array) {
    DBQueryFatal("update eventlist set vnode='$vnode' ".
		 "where idx=$idx and pid='$pid' and eid='$eid'");
}

#
# Delay nodes also require that we augment the virt_agents list, since
# that holds the mapping between a link and the node where it is controlled.
# This is for the benefit of the event scheduler and dynamic events, which
# need to map a link name on the fly, instead of from the static list we
# munged above. 
#
foreach $delay (keys(%delays)) {
    ($pnode,undef,undef,$vname) = @{$delays{$delay}};
    $vnode = $p2vmap{$pnode};

    DBQueryFatal("replace into virt_agents ".
		 " (pid, eid, vname, vnode, objecttype) ".
		 " select '$pid', '$eid', '$vname', '$vnode', ".
		 "   idx from event_objecttypes where ".
		 "   event_objecttypes.type='LINK'");
}


######################################################################
# Subroutines
######################################################################

# min(a,b)
# Returns the minimum of a and b.
sub min {
    my ($a,$b) = @_;
    return ($a < $b ? $a : $b);
};

# getbandwidth(bw)
# Returns the lowest ok bandwidth that is greater than or equal to
# the one passed.
sub getbandwidth {
    my $targetbandwidth= BWConvert($_[0]);
    my $bandwidth;
    my $best = 10000000000;
    foreach $bandwidth (keys(%okbandwidths)) {
	if (($bandwidth >= $targetbandwidth) && ($bandwidth < $best)) {
	    $best = $bandwidth;
	}
    }
    return $best;
};

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

# isdelay(pnodeport)
# Takes a physical nodeport and retruns 1 if the node is a delay node.
sub isdelay {
    my $pnodeport = $_[0];

    my $node = (split(":",$pnodeport))[0];
    if (($p2vmap{$node} =~ m|^delay/|) ||
	($p2vmap{$node} =~ m|^sdelay.|)) {
	return 1;
    } 
    return 0;
};

# find_vport vnode virtlan
# This finds and returns the virtual port of vnode that it is
# virtlan and not in portmap.
sub find_vport {
    my ($vnode,$virtlan) = @_;
    my $portlan;
    my $vport;
    my $lan;
    # Shark Hack
    if ($nodes{$vnode} eq "shark-shelf") {
	return "0";
    }
    # End Shark Hack
    foreach $portlan (@{$nodelans{$vnode}}) {
	($vport,$lan) = split(":",$portlan);
	if (($virtlan eq $lan) &&
	    (! defined($portmap{"$vnode:$vport"}))) {
	    return $vport;
	}
    }
    return "";
};

# keys_equal A B
# Returns 1 if hashs A and B have the same keys.
sub keys_equal {
    my ($ARef,$BRef) = @_;
    my @AKeys = sort keys(%$ARef);
    my @BKeys = sort keys(%$BRef);
    if ($#AKeys != $#BKeys) {
	return 0;
    }
    my $i;
    for ($i=0;$i<=$#AKeys;++$i) {
	if ($AKeys[$i] ne $BKeys[$i]) {
	    return 0;
	}
    }
    return 1;
};

# swapok(pnode,portA,nodeportB)
# This returns 1 if it is ok to swap portA and portB on node pnode
# and 0 otherwise.
sub swapok {
    my ($pnode,$portA,$portB) = @_;
    # For the Utah testbed we just check to make sure they have
    # the same bandwidth.  In other testbeds we'd also want to make
    # sure they went to the same destination.
    my $result = DBQueryFatal("SELECT interface_type FROM interfaces" .
			     " where node_id = \"$pnode\"" .
			     " and iface = \"$portA\"");
    my ($Atype) = $result->fetchrow_array;
    $result->finish;
    $result = DBQueryFatal("SELECT interface_type FROM interfaces" .
			     " where node_id = \"$pnode\"" .
			     " and iface = \"$portB\"");
    my ($Btype) = $result->fetchrow_array;
    $result->finish;

    if ($interfacespeed{$Atype} != $interfacespeed{$Btype}) {
	return 0;
    }

    # It is illegal to swap ports if either is a control interface
    $result = DBQueryFatal("SELECT control_iface FROM nodes" .
    			     " LEFT JOIN node_types ON " .
			     " nodes.type = node_types.type " .
			     " WHERE node_id=\"$pnode\"");
    my ($control_iface) = $result->fetchrow_array;
    $result->finish;

    return (($portA ne $control_iface) && ($portB ne $control_iface));
	
};