Add support for fixing interfaces for node/link pairs:

  tb-fix-interface $node $link "iface"

sql/database-create.sql

@@ -3340,6 +3340,7 @@ CREATE TABLE `virt_lans` (
   `trace_snaplen` int(11) NOT NULL default '0',
   `trace_endnode` tinyint(1) NOT NULL default '0',
   `trace_db` tinyint(1) NOT NULL default '0',
+  `fixed_iface` varchar(16) default '',
   PRIMARY KEY  (`exptidx`,`vname`,`vnode`,`vport`),
   UNIQUE KEY `vport` (`pid`,`eid`,`vname`,`vnode`,`vport`),
   KEY `pid` (`pid`,`eid`,`vname`),

sql/database-fill.sql

@@ -662,6 +662,7 @@ REPLACE INTO table_regex VALUES ('virt_lans','trace_expr','text','redirect','def
 REPLACE INTO table_regex VALUES ('virt_lans','trace_snaplen','int','redirect','default:int',0,0,NULL);
 REPLACE INTO table_regex VALUES ('virt_lans','trace_endnode','int','redirect','default:tinyint',0,1,NULL);
 REPLACE INTO table_regex VALUES ('virt_lans','trace_db','int','redirect','default:tinyint',0,1,NULL);
+REPLACE INTO table_regex VALUES ('virt_lans','fixed_iface','text','redirect','default:tinytext',0,0,NULL);
 REPLACE INTO table_regex VALUES ('virt_lans','modbase','int','redirect','default:boolean',0,0,NULL);
 REPLACE INTO table_regex VALUES ('virt_lans','compat','int','redirect','default:boolean',0,0,NULL);
 

sql/database-migrate.txt

@@ -4202,3 +4202,10 @@ last_net_act,last_cpu_act,last_ext_act);
 	
 4.136: Fix to previous revision; skip to next entry.
 
+4.137: Add support for fixing link interfaces:
+
+       alter table virt_lans add `fixed_iface` varchar(16) default '';
+
+       insert into table_regex values \
+         ('virt_lans','fixed_iface','text','redirect','default:tinytext',0,0,'');
+

tbsetup/assign_wrapper.in

@@ -360,6 +360,10 @@ sub virtlanusevirtiface($) {
 sub virtlanwireless($) {
     return (virtlanprotocol($_[0]) =~ /^(80211|flex900)/);
 }
+# Quick way to get to any fixed iface info for the lan and member.
+sub virtlanfixediface($$) { 
+    return $virt_lans{$_[0]}->{"MEMBERS"}->{$_[1]}->{"fixed_iface"};
+}
 # We don't actually store information about the protocol heirarchy in the
 # database, so we use a simple conventions for now - <basetype>[-subtype]
 sub protocolbasetype($) {
@@ -4900,6 +4904,28 @@ sub CreateTopFile()
 	    my ($top_bw0, $top_rbw0) = virtlantopbw($lan,$nodeport0);
 	    my ($top_bw1, $top_rbw1) = virtlantopbw($lan,$nodeport1);
 
+	    #
+            # Get the fix-interface info for the members and setup the 
+            # fix string.
+            #
+	    my $fixi0 = virtlanfixediface($lan,$nodeport0);
+	    my $fixi1 = virtlanfixediface($lan,$nodeport1);
+	    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";
+	    }
+
 	    $top_bw  = &min($top_bw0,$top_rbw1);
 	    $top_rbw = &min($top_rbw0, $top_bw1);
 
@@ -4925,7 +4951,7 @@ sub CreateTopFile()
 		    print(TOPFILE "link $plink $node0 $node1 ".
 			  max($top_bw,$top_rbw) . " 0 0 $protocol " .
 			  ($emulated ? " emulated" : "") .
-			  ($trivial_ok ? " trivial_ok\n" : "\n"));
+			  ($trivial_ok ? " trivial_ok" : "") . " $fixall\n");
 		    
 		    #
 		    # We allow users to oversubscribe by letting them turn
@@ -4955,10 +4981,10 @@ sub CreateTopFile()
 		    print TOPFILE "node $delayname delay $delay_osid_desire\n";
 		    print TOPFILE
 			"link linksdelaysrc/$lan/$nodeport0,$nodeport1 ".
-			"$node0 $delayname $top_bw 0 0 $protocol\n";
+			"$node0 $delayname $top_bw 0 0 $protocol $fixsrc0\n";
 		    print TOPFILE
 			"link linksdelaydst/$lan/$nodeport1,$nodeport0 ".
-			"$node1 $delayname $top_bw 0 0 $protocol\n";
+			"$node1 $delayname $top_bw 0 0 $protocol $fixdst1\n";
 
 		    $delaynodes{$delayname} = $delayname;
 		    
@@ -5003,6 +5029,9 @@ sub CreateTopFile()
 					       $nodeport1,$rdelay,$rbw,$rloss,1];
 		    }
 		}
+		if ($fixall ne '') {
+		    print TOPFILE " $fixall";
+		}
 		print TOPFILE "\n";
 	    }
 	} elsif ($#members != 0) {
@@ -5072,7 +5101,17 @@ sub CreateTopFile()
 			}
 		    }
 		}
-		
+
+		#
+		# Get the fix-interface info for the member.
+		#
+		my $fixi0 = virtlanfixediface($lan,$member);
+		my ($fixsrc0) = ('');
+
+		if (defined($fixi0) && $fixi0 ne '') {
+		    $fixsrc0 = "fixsrciface:$fixi0";
+		}
+
 		my ($top_bw, $top_rbw) = virtlantopbw($lan,$member);
 
 		$bandwidth = &getbandwidth($node,$lan,$bw);
@@ -5111,7 +5150,8 @@ sub CreateTopFile()
 			print(TOPFILE "link $plink $node lan/$lan " .
 			      max($top_bw,$top_rbw) . " 0 0 $protocol" .
 			      ($emulated ? " emulated" : "") .
-			      ($trivial_ok ? " trivial_ok\n" : "\n"));
+			      ($trivial_ok ? " trivial_ok" : "") . 
+			      ($fixsrc0 ? " $fixsrc0" : "") . "\n");
 
 			printdb "Delay link $plink = " .
 			    join(" ", @{$delaylinks{$plink}}) . "\n";
@@ -5127,7 +5167,7 @@ sub CreateTopFile()
 			print TOPFILE "node $delayname delay " .
                             "$delay_osid_desire\n";
 			print TOPFILE "link linkdelaysrc/$lan/$member" .
-			    " $node $delayname $top_bw 0 0 $protocol\n";
+			    " $node $delayname $top_bw 0 0 $protocol $fixsrc0\n";
 			print TOPFILE "link linkdelaydst/$lan/$member" .
 			    " lan/$lan $delayname $top_bw 0 0 $protocol\n";
 			
@@ -5171,6 +5211,9 @@ sub CreateTopFile()
 					   $member,$rdelay,$rbw,$rloss,1];
 			}
 		    }
+		    if ($fixsrc0) {
+			print TOPFILE " $fixsrc0";
+		    }
 		    print TOPFILE "\n";
 		}
 	    }

tbsetup/ns2ir/lanlink.tcl

@@ -262,6 +262,7 @@ LanLink instproc init {s nodes bw d type} {
     $self instvar rloss
     $self instvar cost
     $self instvar linkq
+    $self instvar fixed_iface
 
     $self instvar iscloud
     $self set iscloud 0
@@ -278,6 +279,7 @@ LanLink instproc init {s nodes bw d type} {
 	set loss($nodepair) 0
 	set rloss($nodepair) 0
 	set cost($nodepair) 1
+	set fixed_iface($nodepair) 0
 	lappend nodelist $nodepair
 
 	set lq q[incr new_counter]
@@ -646,6 +648,26 @@ LanLink instproc rename_queue {old new} {
     }
 }
 
+LanLink instproc set_fixed_iface {node iface} {
+    $self instvar nodelist
+    $self instvar fixed_iface
+
+    # find this node
+    set found 0
+    foreach nodeport $nodelist {
+	if {$node == [lindex $nodeport 0]} {
+	    set fixed_iface($nodeport) $iface
+	    set found 1
+	    break
+	}
+    }
+
+    if {!$found} {
+	perror "\[set_fixed_iface] $node is not the specified link/lan!"
+    }
+}
+
+
 Link instproc updatedb {DB} {
     $self instvar toqueue
     $self instvar fromqueue
@@ -672,6 +694,7 @@ Link instproc updatedb {DB} {
     $self instvar netmask
     $self instvar protocol
     $self instvar mustdelay
+    $self instvar fixed_iface
 
     $sim spitxml_data "virt_lan_lans" [list "vname"] [list $self]
 
@@ -751,6 +774,11 @@ Link instproc updatedb {DB} {
  	    lappend fields "trace_db"
 	}
 
+	# fixing ifaces
+	if {$fixed_iface($nodeport) != 0} {
+	    lappend fields "fixed_iface"
+	}
+
 	set values [list $self $nodeportraw $netmask $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $encap $limit_  $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_}  $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok $protocol $node $port $ip $mustdelay]
 
 	if { [info exists ebandwidth($nodeport)] } {
@@ -771,6 +799,11 @@ Link instproc updatedb {DB} {
 	    lappend values [$linkqueue set trace_mysql]
 	}
 
+	# fixing ifaces
+	if {$fixed_iface($nodeport) != 0} {
+	    lappend values $fixed_iface($nodeport)
+	}
+
 	$sim spitxml_data "virt_lans" $fields $values
     }
 }
@@ -804,6 +837,7 @@ Lan instproc updatedb {DB} {
     $self instvar settings
     $self instvar member_settings
     $self instvar mustdelay
+    $self instvar fixed_iface
 
     if {$modelnet_cores > 0 || $modelnet_edges > 0} {
 	perror "Lans are not allowed when using modelnet; just duplex links."
@@ -899,7 +933,12 @@ Lan instproc updatedb {DB} {
  	    lappend fields "trace_endnode"
  	    lappend fields "trace_db"
 	}
-	
+
+	# fixing ifaces
+        if {$fixed_iface($nodeport) != 0} {
+            lappend fields "fixed_iface"
+        }
+
 	set values [list $self $nodeportraw $netmask $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $encap $limit_  $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_}  $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok $protocol $is_accesspoint $node $port $ip $mustdelay]
 
 	if { [info exists ebandwidth($nodeport)] } {
@@ -920,6 +959,11 @@ Lan instproc updatedb {DB} {
 	    lappend values [$linkqueue set trace_mysql]
 	}
 
+	# fixing ifaces
+        if {$fixed_iface($nodeport) != 0} {
+            lappend values $fixed_iface($nodeport)
+        }
+
 	$sim spitxml_data "virt_lans" $fields $values
 
 	foreach setting_key [array names member_settings] {

tbsetup/ns2ir/nstb_compat.tcl

@@ -87,6 +87,7 @@ proc tb-set-node-lan-est-bandwidth {node lan bw} {}
 proc tb-set-node-plab-role {node role} {}
 proc tb-set-node-plab-plcnet {node lanlink} {}
 proc tb-set-dpdb {onoff} {}
+proc tb-fix-interface {vnode lanlink iface} {}
 
 proc tb-set-security-level {level} {
 

tbsetup/ns2ir/tb_compat.tcl.in

@@ -1691,3 +1691,19 @@ proc tb-set-node-id {vnode myid} {
     }
     $vnode set_numeric_id $myid
 }
+
+#
+# Fix a particular node interface to a lanlink
+#
+proc tb-fix-interface {vnode lanlink iface} {
+    if {[$vnode info class] != "Node"} {
+        perror "\[tb-fix-interface] $vnode is not a node."
+        return
+    }
+    if {[$lanlink info class] != "Link" && [$lanlink info class] != "Lan"} {
+        perror "\[tb-fix-interface] $lanlink must be a link or lan!"
+        return
+    }
+
+    $lanlink set_fixed_iface $vnode $iface
+}