First-pass fixing of exec.tcl so that it can handle cross-canvas links.

This means cross-canvas linking now works, but we have to chase the bugs!

Bug found by:
Submitted by:
Requested by:
Reviewed by:
Approved by:
Obtained from:

diff --git a/exec.tcl b/exec.tcl
index 702d6ce5fe7d9b51bb1ef765f8a30d45865a0b95..970c39bdf9fee63697fd0af85220bd2696bc43fc 100755 (executable)
--- a/exec.tcl
+++ b/exec.tcl
@@ -226,13 +226,27 @@ proc deployCfg {} {
     for { set pending_links $link_list } { $pending_links != "" } {} {
        set link [lindex $pending_links 0]
        set i [lsearch -exact $pending_links $link]
-       set pending_links [lreplace XXXX]
+       set pending_links [lreplace $pending_links $i $i]
 
-       statline "Creating link $link"
        set lnode1 [lindex [linkPeers $link] 0]
        set lnode2 [lindex [linkPeers $link] 1]
        set ifname1 [ifcByPeer $lnode1 $lnode2]
        set ifname2 [ifcByPeer $lnode2 $lnode1]
+
+       if { [getLinkMirror $link] != "" } {
+           set mirror_link [getLinkMirror $link]
+           set i [lsearch -exact $pending_links $mirror_link]
+           set pending_links [lreplace $pending_links $i $i]
+
+           statline "Creating link $link/$mirror_link"
+
+           set p_lnode2 $lnode2
+           set lnode2 [lindex [linkPeers $mirror_link] 0]
+           set ifname2 [ifcByPeer $lnode2 [getNodeMirror $p_lnode2]]
+       } else {
+           statline "Creating link $link"
+       }
+
        set bandwidth [expr [getLinkBandwidth $link] + 0]
        set delay [expr [getLinkDelay $link] + 0]
        set ber [expr [getLinkBER $link] + 0]
@@ -263,9 +277,9 @@ proc deployCfg {} {
        # Queues
        foreach node [list $lnode1 $lnode2] {
            if { $node == $lnode1 } {
-               set ifc [ifcByPeer $lnode1 $lnode2]
+               set ifc $ifname1
            } else {
-               set ifc [ifcByPeer $lnode2 $lnode1]
+               set ifc $ifname2
            }
            if { [nodeType $lnode1] != "rj45" && \
                [nodeType $lnode2] != "rj45" } {
@@ -409,13 +423,22 @@ proc execSetIfcQDisc { eid node ifc qdisc } {
     set target [linkByIfc $node $ifc]
     set peers [linkPeers [lindex $target 0]]
     set dir [lindex $target 1]
-    set ngnode "$eid\_[lindex $peers 0]-[lindex $peers 1]"
+    set lnode1 [lindex $peers 0]
+    set lnode2 [lindex $peers 1]
+    if { [nodeType $lnode2] == "pseudo" } {
+       set mirror_link [getLinkMirror [lindex $target 0]]
+       set lnode2 [lindex [linkPeers $mirror_link] 0]
+    }
     switch -exact $qdisc {
        FIFO { set qdisc fifo }
        WFQ { set qdisc wfq }
        DRR { set qdisc drr }
     }
-    nexec ngctl msg $ngnode: setcfg "{ $dir={ $qdisc=1 } }"
+    set ngnode "$eid\_$lnode1-$lnode2"
+    if { [catch { nexec ngctl msg $ngnode: setcfg "{ $dir={ $qdisc=1 } }" }] } {
+       set ngnode "$eid\_$lnode2-$lnode1"
+       nexec ngctl msg $ngnode: setcfg "{ $dir={ $qdisc=1 } }"
+    }
 }
 
 
@@ -423,12 +446,22 @@ proc execSetIfcQDrop { eid node ifc qdrop } {
     set target [linkByIfc $node $ifc]
     set peers [linkPeers [lindex $target 0]]
     set dir [lindex $target 1]
-    set ngnode "$eid\_[lindex $peers 0]-[lindex $peers 1]"
+    set lnode1 [lindex $peers 0]
+    set lnode2 [lindex $peers 1]
+    if { [nodeType $lnode2] == "pseudo" } {
+       set mirror_link [getLinkMirror [lindex $target 0]]
+       set lnode2 [lindex [linkPeers $mirror_link] 0]
+    }
     switch -exact $qdrop {
        drop-head { set qdrop drophead }
        drop-tail { set qdrop droptail }
     }
-    nexec ngctl msg $ngnode: setcfg "{ $dir={ $qdrop=1 } }"
+    set ngnode "$eid\_$lnode1-$lnode2"
+    if { [catch { nexec ngctl msg $ngnode: setcfg "{ $dir={ $qdrop=1 } }" }] } {
+       # XXX dir should be reversed!
+       set ngnode "$eid\_$lnode2-$lnode1"
+       nexec ngctl msg $ngnode: setcfg "{ $dir={ $qdrop=1 } }"
+    }
 }
 
 
@@ -436,6 +469,15 @@ proc execSetIfcQLen { eid node ifc qlen } {
     set target [linkByIfc $node $ifc]
     set peers [linkPeers [lindex $target 0]]
     set dir [lindex $target 1]
-    set ngnode "$eid\_[lindex $peers 0]-[lindex $peers 1]"
-    nexec ngctl msg $ngnode: setcfg "{ $dir={ queuelen=$qlen } }"
+    set lnode1 [lindex $peers 0]
+    set lnode2 [lindex $peers 1]
+    if { [nodeType $lnode2] == "pseudo" } {
+       set mirror_link [getLinkMirror [lindex $target 0]]
+       set lnode2 [lindex [linkPeers $mirror_link] 0]
+    }
+    set ngnode "$eid\_$lnode1-$lnode2"
+    if { [catch { nexec ngctl msg $ngnode: setcfg "{ $dir={ queuelen=$qlen } }" }] } {
+       set ngnode "$eid\_$lnode2-$lnode1"
+       nexec ngctl msg $ngnode: setcfg "{ $dir={ queuelen=$qlen } }"
+    }
 }