From 5343ff467fafdea84d3bdbbf112fdb5cbb72c215 Mon Sep 17 00:00:00 2001 From: marko Date: Fri, 23 Mar 2007 03:58:58 +0000 Subject: [PATCH] Bug found by: Submitted by: Requested by: Reviewed by: Approved by: Obtained from: Import of several changes from a private tree: - Implement canvas (re)sizing; - Implement canvas zooming; - Implement several synthetic topology generators (chain, star, cycle, wheel, cube, clique, bipartite); - Implement a procedure and GUI hooks for selecting adjacent nodes; - Display a grid in the canvas; - Change the cursor to a "watch" icon during undo / redo / delete operations; - Link color and "thickness" can now be configured on individual link basis; - Extensive (yet not complete) indentation cleanup - we should use modulo 4 tab stops exclusively; - Enclose "expr" expressions in braces, per suggestion from manual pages for performance improvement (though it seems that no no improvements can be observed); - Remove the "Configure remote hosts" menu, given that we are considering different approaches for executing remote experiments. The "nexec" and related procedures are left untouched for now; - Adjust default window size to cover the entire default canvas surface, while is should still fit into 1024x768 displays. --- canvas.tcl | 26 +- cfgparse.tcl | 14 +- editor.tcl | 2489 ++++++++++++++++++++++++++----------------------- exec.tcl | 13 +- host.tcl | 4 - hub.tcl | 4 - imunes.tcl | 4 +- initgui.tcl | 80 +- install.sh | 3 +- ipv4.tcl | 3 +- ipv6.tcl | 1 - lanswitch.tcl | 4 - linkcfg.tcl | 61 +- nodecfg.tcl | 26 +- pc.tcl | 4 - quagga.tcl | 4 - rj45.tcl | 4 - static.tcl | 4 - topogen.tcl | 251 +++++ xorp.tcl | 4 - 20 files changed, 1737 insertions(+), 1266 deletions(-) create mode 100755 topogen.tcl diff --git a/canvas.tcl b/canvas.tcl index aa27a54..72cbb31 100755 --- a/canvas.tcl +++ b/canvas.tcl @@ -60,7 +60,6 @@ proc removeCanvas { canvas } { set i [lsearch $canvas_list $canvas] set canvas_list [lreplace $canvas_list $i $i] set $canvas {} - return } #****f* nodecfg.tcl/newCanvas @@ -94,6 +93,30 @@ proc newCanvas { name } { return $canvas } + +proc setCanvasSize { canvas x y } { + global $canvas + + set i [lsearch [set $canvas] "size *"] + if { $i >= 0 } { + set $canvas [lreplace [set $canvas] $i $i "size {$x $y}"] + } else { + set $canvas [linsert [set $canvas] 1 "size {$x $y}"] + } +} + +proc getCanvasSize { canvas } { + global $canvas + + set entry [lrange [lsearch -inline [set $canvas] "size *"] 1 end] + set size [string trim $entry \{\}] + if { $size == "" } { + return "900 620" + } else { + return $size + } +} + #****f* nodecfg.tcl/getCanvasName # NAME # getCanvasName -- get canvas name @@ -135,5 +158,4 @@ proc setCanvasName { canvas name } { } else { set $canvas [linsert [set $canvas] 1 "name {$name}"] } - return } diff --git a/cfgparse.tcl b/cfgparse.tcl index 3e8cef6..9bb2045 100755 --- a/cfgparse.tcl +++ b/cfgparse.tcl @@ -71,7 +71,6 @@ proc dumpputs {method dest string} { " } } - return } #****f* nodecfg.tcl/dumpCfg @@ -187,8 +186,6 @@ proc dumpCfg {method dest} { dumpputs $method $dest " ipsec_configs yes" } dumpputs $method $dest "\}" dumpputs $method $dest "" - - return } #****f* nodecfg.tcl/loadCfg @@ -276,7 +273,7 @@ proc loadCfg { cfg } { } lappend cfg $zline } - set cfg [lrange $cfg 1 [expr [llength $cfg] - 2]] + set cfg [lrange $cfg 1 [expr {[llength $cfg] - 2}]] lappend $object "network-config {$cfg}" } custom-enabled { @@ -295,7 +292,7 @@ proc loadCfg { cfg } { } lappend cfg $zline } - set cfg [lrange $cfg 1 [expr [llength $cfg] - 2]] + set cfg [lrange $cfg 1 [expr {[llength $cfg] - 2}]] lappend $object "custom-config {$cfg}" } ipsec-enabled { @@ -311,7 +308,7 @@ proc loadCfg { cfg } { } lappend cfg $zline } - set cfg [lrange $cfg 1 [expr [llength $cfg] - 2]] + set cfg [lrange $cfg 1 [expr {[llength $cfg] - 2}]] lappend $object "ipsec-config {$cfg}" } iconcoords { @@ -350,6 +347,9 @@ proc loadCfg { cfg } { name { lappend $object "name {$value}" } + size { + lappend $object "size {$value}" + } } } elseif {"$class" == "option"} { switch -exact -- $field { @@ -412,8 +412,6 @@ proc loadCfg { cfg } { setNodeCanvas $node $curcanvas } } - - return } #****f* nodecfg.tcl/newObjectId diff --git a/editor.tcl b/editor.tcl index d21522c..ef8b485 100755 --- a/editor.tcl +++ b/editor.tcl @@ -49,19 +49,18 @@ proc animateCursor {} { global clock_seconds if { [clock seconds] == $clock_seconds } { - update - return + update + return } set clock_seconds [clock seconds] if { $cursorState } { - .c config -cursor watch - set cursorState 0 + .c config -cursor watch + set cursorState 0 } else { - .c config -cursor pirate - set cursorState 1 + .c config -cursor pirate + set cursorState 1 } update - return } #****f* editor.tcl/removeGUILink @@ -86,26 +85,25 @@ proc removeGUILink { link atomic } { set node1 [lindex $nodes 0] set node2 [lindex $nodes 1] if { [nodeType $node1] == "pseudo" } { - removeLink [getLinkMirror $link] - removeLink $link - removeNode [getNodeMirror $node1] - removeNode $node1 - .c delete $node1 + removeLink [getLinkMirror $link] + removeLink $link + removeNode [getNodeMirror $node1] + removeNode $node1 + .c delete $node1 } elseif { [nodeType $node2] == "pseudo" } { - removeLink [getLinkMirror $link] - removeLink $link - removeNode [getNodeMirror $node2] - removeNode $node2 - .c delete $node2 + removeLink [getLinkMirror $link] + removeLink $link + removeNode [getNodeMirror $node2] + removeNode $node2 + .c delete $node2 } else { - removeLink $link + removeLink $link } .c delete $link if { $atomic == "atomic" } { - set changed 1 - updateUndoLog + set changed 1 + updateUndoLog } - return } #****f* editor.tcl/removeGUINode @@ -123,15 +121,14 @@ proc removeGUILink { link atomic } { proc removeGUINode { node } { set type [nodeType $node] foreach ifc [ifcList $node] { - set peer [peerByIfc $node $ifc] - set link [lindex [.c gettags "link && $node && $peer"] 1] - removeGUILink $link non-atomic + set peer [peerByIfc $node $ifc] + set link [lindex [.c gettags "link && $node && $peer"] 1] + removeGUILink $link non-atomic } if { $type != "pseudo" } { - removeNode $node - .c delete $node + removeNode $node + .c delete $node } - return } #****f* editor.tcl/updateUndoLog @@ -148,15 +145,14 @@ proc updateUndoLog {} { global changed undolog undolevel redolevel if { $changed } { - global t_undolog undolog - set t_undolog "" - dumpCfg string t_undolog - incr undolevel - set undolog($undolevel) $t_undolog - set redolevel $undolevel - set changed 0 - } - return + global t_undolog undolog + set t_undolog "" + dumpCfg string t_undolog + incr undolevel + set undolog($undolevel) $t_undolog + set redolevel $undolevel + set changed 0 + } } #****f* editor.tcl/undo @@ -173,11 +169,11 @@ proc undo {} { global undolevel undolog oper_mode if {$oper_mode == "edit" && $undolevel > 0} { - incr undolevel -1 - loadCfg $undolog($undolevel) - switchCanvas none + incr undolevel -1 + .c config -cursor watch + loadCfg $undolog($undolevel) + switchCanvas none } - return } #****f* editor.tcl/redo @@ -196,11 +192,11 @@ proc redo {} { global undolevel redolevel undolog oper_mode if {$oper_mode == "edit" && $redolevel > $undolevel} { - incr undolevel - loadCfg $undolog($undolevel) - switchCanvas none + incr undolevel + .c config -cursor watch + loadCfg $undolog($undolevel) + switchCanvas none } - return } #****f* editor.tcl/redrawAll @@ -213,30 +209,64 @@ proc redo {} { #**** proc redrawAll {} { - global node_list link_list background sizex sizey - global curcanvas + global node_list link_list background sizex sizey grid + global curcanvas zoom + + .bottom.zoom config -text "zoom [expr {int($zoom * 100)}]%" + set e_sizex [expr {int($sizex * $zoom)}] + set e_sizey [expr {int($sizey * $zoom)}] + set border 28 + .c configure -scrollregion \ + "-$border -$border [expr {$e_sizex + $border}] \ + [expr {$e_sizey + $border}]" .c delete all - set background [.c create rectangle 0 0 $sizex $sizey \ - -fill white -tags "background"] - .c lower $background + set background [.c create rectangle 0 0 $e_sizex $e_sizey \ + -fill white -tags "background"] + + # Grid + set e_grid [expr {int($grid * $zoom)}] + set e_grid2 [expr {$e_grid * 2}] + if { 1 } { + for { set x $e_grid } { $x < $e_sizex } { incr x $e_grid } { + if { [expr {$x % $e_grid2}] != 0 } { + .c create line $x 1 $x $e_sizey -fill gray -dash {1 7} \ + -tags "background" + } else { + .c create line $x 1 $x $e_sizey -fill gray -dash {1 3} \ + -tags "background" + } + } + for { set y $e_grid } { $y < $e_sizey } { incr y $e_grid } { + if { [expr {$y % $e_grid2}] != 0 } { + .c create line 1 $y $e_sizex $y -fill gray -dash {1 7} \ + -tags "background" + } else { + .c create line 1 $y $e_sizex $y -fill gray -dash {1 3} \ + -tags "background" + } + } + } + + .c lower -withtags background foreach node $node_list { - if { [getNodeCanvas $node] == $curcanvas } { - drawNode $node - } + if { [getNodeCanvas $node] == $curcanvas } { + drawNode $node + } } foreach link $link_list { - set nodes [linkPeers $link] - if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas || - [getNodeCanvas [lindex $nodes 1]] != $curcanvas } { - continue - } - drawLink $link - redrawLink $link - updateLinkLabel $link + set nodes [linkPeers $link] + if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas || + [getNodeCanvas [lindex $nodes 1]] != $curcanvas } { + continue + } + drawLink $link + redrawLink $link + updateLinkLabel $link } - return + + .c config -cursor left_ptr } #****f* editor.tcl/drawNode @@ -257,44 +287,42 @@ proc redrawAll {} { proc drawNode { node } { global showNodeLabels global router pc host lanswitch frswitch rj45 hub pseudo - global curcanvas + global curcanvas zoom set type [nodeType $node] set coords [getNodeCoords $node] - set x [lindex $coords 0] - set y [lindex $coords 1] - .c create image $x $y -image [set $type] \ - -tags "node $node" + set x [expr {[lindex $coords 0] * $zoom}] + set y [expr {[lindex $coords 1] * $zoom}] + .c create image $x $y -image [set $type] -tags "node $node" set coords [getNodeLabelCoords $node] - set x [lindex $coords 0] - set y [lindex $coords 1] + set x [expr {[lindex $coords 0] * $zoom}] + set y [expr {[lindex $coords 1] * $zoom}] if { [nodeType $node] != "pseudo" } { - set label [.c create text $x $y -fill blue \ - -text "[getNodeName $node]" \ - -tags "nodelabel $node"] - } else { - set pnode [getNodeName $node] - set pcanvas [getNodeCanvas $pnode] - set ifc [ifcByPeer $pnode [getNodeMirror $node]] - if { $pcanvas != $curcanvas } { - set label [.c create text $x $y -fill blue \ - -text "[getNodeName $pnode]:$ifc @[getCanvasName $pcanvas]" \ - -tags "nodelabel $node" -justify center] + set label [.c create text $x $y -fill blue \ + -text "[getNodeName $node]" \ + -tags "nodelabel $node"] } else { - set label [.c create text $x $y -fill blue \ - -text "[getNodeName $pnode]:$ifc" \ - -tags "nodelabel $node" -justify center] - } + set pnode [getNodeName $node] + set pcanvas [getNodeCanvas $pnode] + set ifc [ifcByPeer $pnode [getNodeMirror $node]] + if { $pcanvas != $curcanvas } { + set label [.c create text $x $y -fill blue \ + -text "[getNodeName $pnode]:$ifc @[getCanvasName $pcanvas]" \ + -tags "nodelabel $node" -justify center] + } else { + set label [.c create text $x $y -fill blue \ + -text "[getNodeName $pnode]:$ifc" \ + -tags "nodelabel $node" -justify center] + } } if { $showNodeLabels == 0} { - .c itemconfigure $label -state hidden + .c itemconfigure $label -state hidden } # XXX Invisible pseudo-node labels global invisible if { $invisible == 1 && [nodeType $node] == "pseudo" } { - .c itemconfigure $label -state hidden + .c itemconfigure $label -state hidden } - return } #****f* editor.tcl/drawLink @@ -311,29 +339,27 @@ proc drawNode { node } { #**** proc drawLink { link } { - global defLinkWidth defLinkColor - set nodes [linkPeers $link] set lnode1 [lindex $nodes 0] set lnode2 [lindex $nodes 1] + set lwidth [getLinkWidth $link] if { [getLinkMirror $link] != "" } { - set newlink [.c create line 0 0 0 0 \ - -fill $defLinkColor -width $defLinkWidth \ - -tags "link $link $lnode1 $lnode2" \ - -arrow both] + set newlink [.c create line 0 0 0 0 \ + -fill [getLinkColor $link] -width $lwidth \ + -tags "link $link $lnode1 $lnode2" -arrow both] } else { - set newlink [.c create line 0 0 0 0 \ - -fill $defLinkColor -width $defLinkWidth \ - -tags "link $link $lnode1 $lnode2"] + set newlink [.c create line 0 0 0 0 \ + -fill [getLinkColor $link] -width $lwidth \ + -tags "link $link $lnode1 $lnode2"] } # XXX Invisible pseudo-liks global invisible if { $invisible == 1 && [getLinkMirror $link] != "" } { - .c itemconfigure $link -state hidden + .c itemconfigure $link -state hidden } .c raise $newlink background set newlink [.c create line 0 0 0 0 \ - -fill white -width [expr $defLinkWidth * 3 ] \ + -fill white -width [expr {$lwidth + 4}] \ -tags "link $link $lnode1 $lnode2"] .c raise $newlink background .c create text 0 0 -tags "linklabel $link" -justify center @@ -341,7 +367,6 @@ proc drawLink { link } { .c create text 0 0 -tags "interface $lnode2 $link" -justify center .c raise linklabel "link || background" .c raise interface "link || linklabel || background" - return } #****f* editor.tcl/chooseIfName @@ -364,33 +389,27 @@ proc chooseIfName { lnode1 lnode2 } { global $lnode1 $lnode2 switch -exact -- [nodeType $lnode1] { - pc { - return eth - } - host { - return eth - } - hub { - return e - } - lanswitch { - return e - } - frswitch { - return f - } - router { - if { [nodeType $lnode2] == "router" || \ - [nodeType $lnode2] == "frswitch" } { - #return ser - return eth - } else { - return eth - } - } - rj45 { - return - } + pc { + return eth + } + host { + return eth + } + hub { + return e + } + lanswitch { + return e + } + frswitch { + return f + } + router { + return eth + } + rj45 { + return + } } } @@ -413,13 +432,13 @@ proc chooseIfName { lnode1 lnode2 } { proc listLANnodes { l2node l2peers } { lappend l2peers $l2node foreach ifc [ifcList $l2node] { - set peer [logicalPeerByIfc $l2node $ifc] - set type [nodeType $peer] - if { [ lsearch {lanswitch hub} $type] != -1 } { - if { [lsearch $l2peers $peer] == -1 } { - set l2peers [listLANnodes $peer $l2peers] - } - } + set peer [logicalPeerByIfc $l2node $ifc] + set type [nodeType $peer] + if { [ lsearch {lanswitch hub} $type] != -1 } { + if { [lsearch $l2peers $peer] == -1 } { + set l2peers [listLANnodes $peer $l2peers] + } + } } return $l2peers } @@ -437,49 +456,53 @@ proc listLANnodes { l2node l2peers } { #**** proc calcDxDy { lnode } { - global showIfIPaddrs showIfIPv6addrs + global showIfIPaddrs showIfIPv6addrs zoom upvar dx x upvar dy y - switch -exact -- [nodeType $lnode] { - frswitch { - set x 1.8 - set y 1.8 - } - hub { - set x 1.5 - set y 2.6 - } - lanswitch { - set x 1.5 - set y 2.6 - } - router { - set x 1 - set y 2 - } - pc { - if { $showIfIPaddrs || $showIfIPv6addrs } { - set x 1.1 - } else { - set x 1.4 - } - set y 1.5 - } - host { - if { $showIfIPaddrs || $showIfIPv6addrs } { - set x 1.0 - } else { - set x 1.5 - } - set y 1.5 - } - rj45 { - set x 1 - set y 1 + if { $zoom > 1.0 } { + set x 1 + set y 1 + return } + switch -exact -- [nodeType $lnode] { + frswitch { + set x [expr {1.8 / $zoom}] + set y [expr {1.8 / $zoom}] + } + hub { + set x [expr {1.5 / $zoom}] + set y [expr {2.6 / $zoom}] + } + lanswitch { + set x [expr {1.5 / $zoom}] + set y [expr {2.6 / $zoom}] + } + router { + set x [expr {1 / $zoom}] + set y [expr {2 / $zoom}] + } + pc { + if { $showIfIPaddrs || $showIfIPv6addrs } { + set x [expr {1.1 / $zoom}] + } else { + set x [expr {1.4 / $zoom}] + } + set y [expr {1.5 / $zoom}] + } + host { + if { $showIfIPaddrs || $showIfIPv6addrs } { + set x [expr {1 / $zoom}] + } else { + set x [expr {1.5 / $zoom}] + } + set y [expr {1.5 / $zoom}] + } + rj45 { + set x [expr {1 / $zoom}] + set y [expr {1 / $zoom}] + } } - return } #****f* editor.tcl/updateIfcLabel @@ -504,27 +527,26 @@ proc updateIfcLabel { lnode1 lnode2 } { set ifipv4addr [getIfcIPv4addr $lnode1 $ifc] set ifipv6addr [getIfcIPv6addr $lnode1 $ifc] if { $ifc == 0 } { - set ifc "" + set ifc "" } if { [getIfcOperState $lnode1 $ifc] == "down" } { - set labelstr "*" + set labelstr "*" } else { - set labelstr "" + set labelstr "" } if { $showIfNames } { - set labelstr "$labelstr$ifc " + set labelstr "$labelstr$ifc " } if { $showIfIPaddrs && $ifipv4addr != "" } { - set labelstr "$labelstr$ifipv4addr " + set labelstr "$labelstr$ifipv4addr " } if { $showIfIPv6addrs && $ifipv6addr != "" } { - set labelstr "$labelstr$ifipv6addr " + set labelstr "$labelstr$ifipv6addr " } set labelstr \ - [string range $labelstr 0 [expr [string length $labelstr] - 2]] + [string range $labelstr 0 [expr {[string length $labelstr] - 2}]] .c itemconfigure "interface && $lnode1 && $link" \ - -text "$labelstr" - return + -text "$labelstr" } @@ -548,22 +570,22 @@ proc updateLinkLabel { link } { set dup [getLinkDup $link] set labelstr "$labelstr[getLinkBandwidthString $link] " if { "$delstr" != "" } { - set labelstr "$labelstr$delstr " + set labelstr "$labelstr$delstr " } if { "$ber" != "" } { - set berstr "ber=$ber" - set labelstr "$labelstr$berstr " + set berstr "ber=$ber" + set labelstr "$labelstr$berstr " } if { "$dup" != "" } { - set dupstr "dup=$dup%" - set labelstr "$labelstr$dupstr " + set dupstr "dup=$dup%" + set labelstr "$labelstr$dupstr " } - set labelstr [string range $labelstr 0 [expr [string length $labelstr] - 2]] + set labelstr \ + [string range $labelstr 0 [expr {[string length $labelstr] - 2}]] .c itemconfigure "linklabel && $link" -text "$labelstr" if { $showLinkLabels == 0} { - .c itemconfigure "linklabel && $link" -state hidden + .c itemconfigure "linklabel && $link" -state hidden } - return } @@ -579,14 +601,13 @@ proc redrawAllLinks {} { global link_list curcanvas foreach link $link_list { - set nodes [linkPeers $link] - if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas || - [getNodeCanvas [lindex $nodes 1]] != $curcanvas } { - continue - } - redrawLink $link + set nodes [linkPeers $link] + if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas || + [getNodeCanvas [lindex $nodes 1]] != $curcanvas } { + continue + } + redrawLink $link } - return } @@ -621,26 +642,27 @@ proc redrawLink { link } { .c coords $limage1 $x1 $y1 $x2 $y2 .c coords $limage2 $x1 $y1 $x2 $y2 - set lx [expr 0.5 * ($x1 + $x2)] - set ly [expr 0.5 * ($y1 + $y2)] + set lx [expr {0.5 * ($x1 + $x2)}] + set ly [expr {0.5 * ($y1 + $y2)}] .c coords "linklabel && $link" $lx $ly - set n [expr sqrt (($x1 - $x2) * ($x1 - $x2) + \ - ($y1 - $y2) * ($y1 - $y2)) * 0.015] - if { $n < 1 } { set n 1 } + set n [expr {sqrt (($x1 - $x2) * ($x1 - $x2) + \ + ($y1 - $y2) * ($y1 - $y2)) * 0.015}] + if { $n < 1 } { + set n 1 + } calcDxDy $lnode1 - set lx [expr ($x1 * ($n * $dx - 1) + $x2) / $n / $dx] - set ly [expr ($y1 * ($n * $dy - 1) + $y2) / $n / $dy] + set lx [expr {($x1 * ($n * $dx - 1) + $x2) / $n / $dx}] + set ly [expr {($y1 * ($n * $dy - 1) + $y2) / $n / $dy}] .c coords "interface && $lnode1 && $link" $lx $ly updateIfcLabel $lnode1 $lnode2 calcDxDy $lnode2 - set lx [expr ($x1 + $x2 * ($n * $dx - 1)) / $n / $dx] - set ly [expr ($y1 + $y2 * ($n * $dy - 1)) / $n / $dy] + set lx [expr {($x1 + $x2 * ($n * $dx - 1)) / $n / $dx}] + set ly [expr {($y1 + $y2 * ($n * $dy - 1)) / $n / $dy}] .c coords "interface && $lnode2 && $link" $lx $ly updateIfcLabel $lnode2 $lnode1 - return } @@ -656,7 +678,7 @@ proc redrawLink { link } { # * link -- link id #**** proc splitGUILink { link } { - global changed + global changed zoom set peer_nodes [linkPeers $link] set new_nodes [splitLink $link pseudo] @@ -679,9 +701,11 @@ proc splitGUILink { link } { set y2 [lindex [getNodeCoords $orig_node2] 1] setNodeCoords $new_node1 \ - "[expr $x1 + 0.4 * ($x2 - $x1)] [expr $y1 + 0.4 * ($y2 - $y1)]" + "[expr {($x1 + 0.4 * ($x2 - $x1)) / $zoom}] \ + [expr {($y1 + 0.4 * ($y2 - $y1)) / $zoom}]" setNodeCoords $new_node2 \ - "[expr $x1 + 0.6 * ($x2 - $x1)] [expr $y1 + 0.6 * ($y2 - $y1)]" + "[expr {($x1 + 0.6 * ($x2 - $x1)) / $zoom}] \ + [expr {($y1 + 0.6 * ($y2 - $y1)) / $zoom}]" setNodeLabelCoords $new_node1 [getNodeCoords $new_node1] setNodeLabelCoords $new_node2 [getNodeCoords $new_node2] @@ -707,20 +731,51 @@ proc selectNode { c obj } { set node [lindex [$c gettags $obj] 1] $c addtag selected withtag "node && $node" if { [nodeType $node] == "pseudo" } { - set bbox [$c bbox "nodelabel && $node"] + set bbox [$c bbox "nodelabel && $node"] } else { - set bbox [$c bbox "node && $node"] + set bbox [$c bbox "node && $node"] } - set bx1 [expr [lindex $bbox 0] - 2] - set by1 [expr [lindex $bbox 1] - 2] - set bx2 [expr [lindex $bbox 2] + 1] - set by2 [expr [lindex $bbox 3] + 1] + set bx1 [expr {[lindex $bbox 0] - 2}] + set by1 [expr {[lindex $bbox 1] - 2}] + set bx2 [expr {[lindex $bbox 2] + 1}] + set by2 [expr {[lindex $bbox 3] + 1}] $c delete -withtags "selectmark && $node" $c create line $bx1 $by1 $bx2 $by1 $bx2 $by2 $bx1 $by2 $bx1 $by1 \ - -dash {6 4} -fill black -width 1 -tags "selectmark $node" - return + -dash {6 4} -fill black -width 1 -tags "selectmark $node" +} + +proc selectNodes { nodelist } { + foreach node $nodelist { + selectNode .c [.c find withtag "node && $node"] + } } +proc selectAdjacent {} { + global curcanvas + + set selected {} + set adjacent {} + foreach obj [.c find withtag "node && selected"] { + set node [lindex [.c gettags $obj] 1] + if { [getNodeCanvas $node] != $curcanvas || \ + [getNodeMirror $node] != "" } { + return + } + lappend selected $node + } + foreach node $selected { + foreach ifc [ifcList $node] { + set peer [peerByIfc $node $ifc] + if { [getNodeMirror $peer] != "" } { + return + } + if { [lsearch $adjacent $peer] < 0 } { + lappend adjacent $peer + } + } + } + selectNodes $adjacent +} #****f* editor.tcl/button3link # NAME @@ -748,10 +803,10 @@ proc button3link { c x y } { set link [lindex [$c gettags {link && current}] 1] if { $link == "" } { - set link [lindex [$c gettags {linklabel && current}] 1] - if { $link == "" } { - return - } + set link [lindex [$c gettags {linklabel && current}] 1] + if { $link == "" } { + return + } } .button3menu delete 0 end @@ -760,48 +815,45 @@ proc button3link { c x y } { # Configure link # .button3menu add command -label "Configure" \ - -command "popupConfigDialog $c" + -command "popupConfigDialog $c" # # Delete link # if { $oper_mode != "exec" } { - .button3menu add command -label "Delete" \ - -command "removeGUILink $link atomic" + .button3menu add command -label "Delete" \ + -command "removeGUILink $link atomic" } else { - .button3menu add command -label "Delete" \ - -state disabled + .button3menu add command -label "Delete" \ + -state disabled } # # Split link # if { $oper_mode != "exec" && [getLinkMirror $link] == "" } { - .button3menu add command -label "Split" \ - -command "splitGUILink $link" + .button3menu add command -label "Split" \ + -command "splitGUILink $link" } else { - .button3menu add command -label "Split" \ - -state disabled + .button3menu add command -label "Split" \ + -state disabled } # # Merge two pseudo nodes / links # if { $oper_mode != "exec" && [getLinkMirror $link] != "" && - [getNodeCanvas [getNodeMirror [lindex [linkPeers $link] 1]]] == - $curcanvas } { - .button3menu add command -label "Merge" \ - -command "mergeGUINode [lindex [linkPeers $link] 1]" + [getNodeCanvas [getNodeMirror [lindex [linkPeers $link] 1]]] == + $curcanvas } { + .button3menu add command -label "Merge" \ + -command "mergeGUINode [lindex [linkPeers $link] 1]" } else { - .button3menu add command -label "Merge" \ - -state disabled + .button3menu add command -label "Merge" -state disabled } set x [winfo pointerx .] set y [winfo pointery .] tk_popup .button3menu $x $y - - return } @@ -821,39 +873,39 @@ proc movetoCanvas { canvas } { set selected_nodes {} foreach obj [.c find withtag "node && selected"] { - set node [lindex [.c gettags $obj] 1] - lappend selected_nodes $node - setNodeCanvas $node $canvas - set changed 1 + set node [lindex [.c gettags $obj] 1] + lappend selected_nodes $node + setNodeCanvas $node $canvas + set changed 1 } foreach obj [.c find withtag "linklabel"] { - set link [lindex [.c gettags $obj] 1] - set link_peers [linkPeers $link] - set peer1 [lindex $link_peers 0] - set peer2 [lindex $link_peers 1] - set peer1_in_selected [lsearch $selected_nodes $peer1] - set peer2_in_selected [lsearch $selected_nodes $peer2] - if { ($peer1_in_selected == -1 && $peer2_in_selected != -1) || - ($peer1_in_selected != -1 && $peer2_in_selected == -1) } { - if { [nodeType $peer2] == "pseudo" } { - setNodeCanvas $peer2 $canvas - if { [getNodeCanvas [getNodeMirror $peer2]] == $canvas } { - mergeLink $link - } - continue - } - set new_nodes [splitLink $link pseudo] - set new_node1 [lindex $new_nodes 0] - set new_node2 [lindex $new_nodes 1] - setNodeMirror $new_node1 $new_node2 - setNodeMirror $new_node2 $new_node1 - setNodeName $new_node1 $peer2 - setNodeName $new_node2 $peer1 - set link1 [linkByPeers $peer1 $new_node1] - set link2 [linkByPeers $peer2 $new_node2] - setLinkMirror $link1 $link2 - setLinkMirror $link2 $link1 - } + set link [lindex [.c gettags $obj] 1] + set link_peers [linkPeers $link] + set peer1 [lindex $link_peers 0] + set peer2 [lindex $link_peers 1] + set peer1_in_selected [lsearch $selected_nodes $peer1] + set peer2_in_selected [lsearch $selected_nodes $peer2] + if { ($peer1_in_selected == -1 && $peer2_in_selected != -1) || + ($peer1_in_selected != -1 && $peer2_in_selected == -1) } { + if { [nodeType $peer2] == "pseudo" } { + setNodeCanvas $peer2 $canvas + if { [getNodeCanvas [getNodeMirror $peer2]] == $canvas } { + mergeLink $link + } + continue + } + set new_nodes [splitLink $link pseudo] + set new_node1 [lindex $new_nodes 0] + set new_node2 [lindex $new_nodes 1] + setNodeMirror $new_node1 $new_node2 + setNodeMirror $new_node2 $new_node1 + setNodeName $new_node1 $peer2 + setNodeName $new_node2 $peer1 + set link1 [linkByPeers $peer1 $new_node1] + set link2 [linkByPeers $peer2 $new_node2] + setLinkMirror $link1 $link2 + setLinkMirror $link2 $link1 + } } updateUndoLog redrawAll @@ -914,30 +966,41 @@ proc button3node { c x y } { set node [lindex [$c gettags {node && current}] 1] if { $node == "" } { - set node [lindex [$c gettags {nodelabel && current}] 1] - if { $node == "" } { - return - } + set node [lindex [$c gettags {nodelabel && current}] 1] + if { $node == "" } { + return + } } set mirror_node [getNodeMirror $node] if { [$c gettags "node && $node && selected"] == "" } { - $c dtag node selected - $c delete -withtags selectmark - selectNode $c [$c find withtag "current"] + $c dtag node selected + $c delete -withtags selectmark + selectNode $c [$c find withtag "current"] } .button3menu delete 0 end + # + # Select adjacent + # + if { [nodeType $node] != "pseudo" } { + .button3menu add command -label "Select adjacent" \ + -command "selectAdjacent" + } else { + .button3menu add command -label "Select adjacent" \ + -command "selectAdjacent" -state disabled + } + # # Configure node # if { [nodeType $node] != "pseudo" } { - .button3menu add command -label "Configure" \ - -command "popupConfigDialog $c" + .button3menu add command -label "Configure" \ + -command "popupConfigDialog $c" } else { - .button3menu add command -label "Configure" \ - -command "popupConfigDialog $c" -state disabled + .button3menu add command -label "Configure" \ + -command "popupConfigDialog $c" -state disabled } # @@ -945,34 +1008,34 @@ proc button3node { c x y } { # .button3menu.connect delete 0 end if { $oper_mode == "exec" || [nodeType $node] == "pseudo" } { - .button3menu add cascade -label "Create link to" \ - -menu .button3menu.connect -state disabled + .button3menu add cascade -label "Create link to" \ + -menu .button3menu.connect -state disabled } else { - .button3menu add cascade -label "Create link to" \ - -menu .button3menu.connect + .button3menu add cascade -label "Create link to" \ + -menu .button3menu.connect } .button3menu.connect add command -label "Canvas:" -state disabled foreach canvas $canvas_list { - destroy .button3menu.connect.$canvas - menu .button3menu.connect.$canvas -tearoff 0 - .button3menu.connect.$canvas add command \ - -label "Node:" -state disabled - .button3menu.connect add cascade -label [getCanvasName $canvas] \ - -menu .button3menu.connect.$canvas + destroy .button3menu.connect.$canvas + menu .button3menu.connect.$canvas -tearoff 0 + .button3menu.connect.$canvas add command \ + -label "Node:" -state disabled + .button3menu.connect add cascade -label [getCanvasName $canvas] \ + -menu .button3menu.connect.$canvas } foreach peer_node $node_list { - set canvas [getNodeCanvas $peer_node] - if { $node != $peer_node && [nodeType $node] != "rj45" && - [lsearch {pseudo rj45} [nodeType $peer_node]] < 0 && - [ifcByLogicalPeer $node $peer_node] == "" } { - .button3menu.connect.$canvas add command \ - -label [getNodeName $peer_node] \ - -command "newGUILink $node $peer_node" - } elseif { [nodeType $peer_node] != "pseudo" } { - .button3menu.connect.$canvas add command \ - -label [getNodeName $peer_node] \ - -state disabled - } + set canvas [getNodeCanvas $peer_node] + if { $node != $peer_node && [nodeType $node] != "rj45" && + [lsearch {pseudo rj45} [nodeType $peer_node]] < 0 && + [ifcByLogicalPeer $node $peer_node] == "" } { + .button3menu.connect.$canvas add command \ + -label [getNodeName $peer_node] \ + -command "newGUILink $node $peer_node" + } elseif { [nodeType $peer_node] != "pseudo" } { + .button3menu.connect.$canvas add command \ + -label [getNodeName $peer_node] \ + -state disabled + } } # @@ -980,43 +1043,42 @@ proc button3node { c x y } { # .button3menu.moveto delete 0 end if { $oper_mode == "exec" || [nodeType $node] == "pseudo" } { - .button3menu add cascade -label "Move to" \ - -menu .button3menu.moveto -state disabled + .button3menu add cascade -label "Move to" \ + -menu .button3menu.moveto -state disabled } else { - .button3menu add cascade -label "Move to" \ - -menu .button3menu.moveto + .button3menu add cascade -label "Move to" \ + -menu .button3menu.moveto } .button3menu.moveto add command -label "Canvas:" -state disabled foreach canvas $canvas_list { - if { $canvas != $curcanvas } { - .button3menu.moveto add command \ - -label [getCanvasName $canvas] \ - -command "movetoCanvas $canvas" - } else { - .button3menu.moveto add command \ - -label [getCanvasName $canvas] -state disabled - } + if { $canvas != $curcanvas } { + .button3menu.moveto add command \ + -label [getCanvasName $canvas] \ + -command "movetoCanvas $canvas" + } else { + .button3menu.moveto add command \ + -label [getCanvasName $canvas] -state disabled + } } # # Merge two pseudo nodes / links # if { $oper_mode != "exec" && [nodeType $node] == "pseudo" && \ - [getNodeCanvas $mirror_node] == $curcanvas } { - .button3menu add command -label "Merge" \ - -command "mergeGUINode $node" + [getNodeCanvas $mirror_node] == $curcanvas } { + .button3menu add command -label "Merge" \ + -command "mergeGUINode $node" } else { - .button3menu add command -label "Merge" \ - -state disabled + .button3menu add command -label "Merge" -state disabled } # # Delete selection # if { $oper_mode != "exec" } { - .button3menu add command -label "Delete" -command deleteSelection + .button3menu add command -label "Delete" -command deleteSelection } else { - .button3menu add command -label "Delete" -state disabled + .button3menu add command -label "Delete" -state disabled } # @@ -1024,18 +1086,18 @@ proc button3node { c x y } { # .button3menu.shell delete 0 end if { $oper_mode == "exec" && [[typemodel $node].layer] == "NETWORK" } { - .button3menu add cascade -label "Shell window" \ - -menu .button3menu.shell - set cmd [[typemodel $node].shellcmd $node] - if { $cmd != "/bin/sh" && $cmd != "" } { - .button3menu.shell add command -label "$cmd" \ - -command "spawnShell $node $cmd" - } - .button3menu.shell add command -label "/bin/sh" \ - -command "spawnShell $node /bin/sh" + .button3menu add cascade -label "Shell window" \ + -menu .button3menu.shell + set cmd [[typemodel $node].shellcmd $node] + if { $cmd != "/bin/sh" && $cmd != "" } { + .button3menu.shell add command -label "$cmd" \ + -command "spawnShell $node $cmd" + } + .button3menu.shell add command -label "/bin/sh" \ + -command "spawnShell $node /bin/sh" } else { - .button3menu add cascade -label "Shell window" \ - -menu .button3menu.shell -state disabled + .button3menu add cascade -label "Shell window" \ + -menu .button3menu.shell -state disabled } # @@ -1043,30 +1105,30 @@ proc button3node { c x y } { # .button3menu.ethereal delete 0 end if { $oper_mode == "exec" && [[typemodel $node].layer] == "NETWORK" } { - .button3menu add cascade -label "Ethereal" \ - -menu .button3menu.ethereal - foreach ifc [ifcList $node] { - set label "$ifc" - if { [getIfcIPv4addr $node $ifc] != "" } { - set label "$label ([getIfcIPv4addr $node $ifc])" - } - if { [getIfcIPv6addr $node $ifc] != "" } { - set label "$label ([getIfcIPv6addr $node $ifc])" - } - .button3menu.ethereal add command -label $label \ - -command "startethereal $node $ifc" - } - .button3menu add command -label Start \ - -command "[typemodel $node].start $eid $node" - .button3menu add command -label Stop \ - -command "[typemodel $node].shutdown $eid $node" + .button3menu add cascade -label "Ethereal" \ + -menu .button3menu.ethereal + foreach ifc [ifcList $node] { + set label "$ifc" + if { [getIfcIPv4addr $node $ifc] != "" } { + set label "$label ([getIfcIPv4addr $node $ifc])" + } + if { [getIfcIPv6addr $node $ifc] != "" } { + set label "$label ([getIfcIPv6addr $node $ifc])" + } + .button3menu.ethereal add command -label $label \ + -command "startethereal $node $ifc" + } + .button3menu add command -label Start \ + -command "[typemodel $node].start $eid $node" + .button3menu add command -label Stop \ + -command "[typemodel $node].shutdown $eid $node" } else { - .button3menu add cascade -label "Ethereal" \ - -menu .button3menu.ethereal -state disabled - .button3menu add command -label start \ - -command "[typemodel $node].start $eid $node" -state disabled - .button3menu add command -label stop \ - -command "[typemodel $node].stop $eid $node" -state disabled + .button3menu add cascade -label "Ethereal" \ + -menu .button3menu.ethereal -state disabled + .button3menu add command -label start \ + -command "[typemodel $node].start $eid $node" -state disabled + .button3menu add command -label stop \ + -command "[typemodel $node].stop $eid $node" -state disabled } # @@ -1075,8 +1137,6 @@ proc button3node { c x y } { set x [winfo pointerx .] set y [winfo pointery .] tk_popup .button3menu $x $y - - return } @@ -1102,15 +1162,15 @@ proc spawnShell { node cmd } { nexec vimageShellServer.sh $node_id 1234 $cmd & if { $gui_unix } { exec xterm -sb -rightbar \ - -T "IMUNES: [getNodeName $node] (console)" \ - -e "nc $exec_host 1234" & + -T "IMUNES: [getNodeName $node] (console)" \ + -e "nc $exec_host 1234" & } else { exec cmd /c nc $exec_host 1234 & } } else { - nexec xterm -sb -rightbar \ - -T "IMUNES: [getNodeName $node] (console)" \ - -e "vimage $node_id $cmd" & + nexec xterm -sb -rightbar \ + -T "IMUNES: [getNodeName $node] (console)" \ + -e "vimage $node_id $cmd" & } } @@ -1132,7 +1192,6 @@ proc startethereal { node iface } { set interface "$iface@$eid\_$node" nexec ethereal -i $interface & - return } @@ -1153,11 +1212,12 @@ proc startethereal { node iface } { # * button -- the keyboard button that is pressed. #**** proc button1 { c x y button } { - global node_list curcanvas + global node_list curcanvas zoom global activetool newlink curobj changed def_router_model global router pc host lanswitch frswitch rj45 hub global lastX lastY - global defLinkColor defLinkWidth background selectbox + global background selectbox + global defLinkColor defLinkWidth set x [$c canvasx $x] set y [$c canvasy $y] @@ -1168,70 +1228,70 @@ proc button1 { c x y button } { set curobj [$c find withtag current] set curtype [lindex [$c gettags current] 0] if { $curtype == "node" || ( $curtype == "nodelabel" && - [nodeType [lindex [$c gettags $curobj] 1]] == "pseudo") } { - set node [lindex [$c gettags current] 1] - set wasselected \ - [expr [lsearch [$c find withtag "selected"] \ - [$c find withtag "node && $node"]] > -1] - if { $button == "ctrl" } { - if { $wasselected } { - $c dtag $node selected - $c delete -withtags "selectmark && $node" - } - } elseif { !$wasselected } { - $c dtag node selected - $c delete -withtags selectmark - } - if { $activetool == "select" && !$wasselected} { - selectNode $c $curobj - } + [nodeType [lindex [$c gettags $curobj] 1]] == "pseudo") } { + set node [lindex [$c gettags current] 1] + set wasselected \ + [expr {[lsearch [$c find withtag "selected"] \ + [$c find withtag "node && $node"]] > -1}] + if { $button == "ctrl" } { + if { $wasselected } { + $c dtag $node selected + $c delete -withtags "selectmark && $node" + } + } elseif { !$wasselected } { + $c dtag node selected + $c delete -withtags selectmark + } + if { $activetool == "select" && !$wasselected} { + selectNode $c $curobj + } } elseif { $button != "ctrl" || $activetool != "select" } { - $c dtag node selected - $c delete -withtags selectmark - } - if { $curobj == $background } { - if { [lsearch {select link} $activetool] < 0 } { - set node [newNode $activetool] - setNodeCanvas $node $curcanvas - setNodeCoords $node "$x $y" - set dy 32 - if { [lsearch {router hub lanswitch rj45} $activetool] >= 0 } { - set dy 24 - } - setNodeLabelCoords $node "$x [expr $y + $dy]" - drawNode $node - selectNode $c [$c find withtag "node && $node"] - set changed 1 - } elseif { $activetool == "select" \ - && $curtype != "node" && $curtype != "nodelabel"} { - $c config -cursor cross - set lastX $x - set lastY $y - if {$selectbox != ""} { - # We actually shouldn't get here! - $c delete $selectbox - set selectbox "" - } - } + $c dtag node selected + $c delete -withtags selectmark + } + if { [lsearch [.c gettags $curobj] background] != -1 } { + if { [lsearch {select link} $activetool] < 0 } { + set node [newNode $activetool] + setNodeCanvas $node $curcanvas + setNodeCoords $node "[expr {$x / $zoom}] [expr {$y / $zoom}]" + set dy 32 + if { [lsearch {router hub lanswitch rj45} $activetool] >= 0 } { + set dy 24 + } + setNodeLabelCoords $node "[expr {$x / $zoom}] \ + [expr {$y / $zoom + $dy}]" + drawNode $node + selectNode $c [$c find withtag "node && $node"] + set changed 1 + } elseif { $activetool == "select" \ + && $curtype != "node" && $curtype != "nodelabel"} { + $c config -cursor cross + set lastX $x + set lastY $y + if {$selectbox != ""} { + # We actually shouldn't get here! + $c delete $selectbox + set selectbox "" + } + } } else { - if {$curtype == "node" || $curtype == "nodelabel"} { - $c config -cursor fleur - } - if {$activetool == "link" && $curtype == "node"} { - $c config -cursor cross - set lastX [lindex [$c coords $curobj] 0] - set lastY [lindex [$c coords $curobj] 1] - set newlink [$c create line $lastX $lastY $x $y \ - -fill $defLinkColor -width $defLinkWidth \ - -tags "link"] - } + if {$curtype == "node" || $curtype == "nodelabel"} { + $c config -cursor fleur + } + if {$activetool == "link" && $curtype == "node"} { + $c config -cursor cross + set lastX [lindex [$c coords $curobj] 0] + set lastY [lindex [$c coords $curobj] 1] + set newlink [$c create line $lastX $lastY $x $y \ + -fill $defLinkColor -width $defLinkWidth \ + -tags "link"] + } } $c raise link background $c raise linklabel "link || background" $c raise interface "linklabel || link || background" $c raise node "interface || linklabel || link || background" $c raise nodelabel "node || interface || linklabel || link || background" - return } @@ -1251,7 +1311,7 @@ proc button1 { c x y button } { # * y -- y coordinate #**** proc button1-motion { c x y } { - global activetool newlink changed grid + global activetool newlink changed global lastX lastY sizex sizey selectbox background set x [$c canvasx $x] @@ -1260,44 +1320,43 @@ proc button1-motion { c x y } { set curobj [$c find withtag current] set curtype [lindex [$c gettags current] 0] if {$activetool == "link" && $newlink != ""} { - $c coords $newlink $lastX $lastY $x $y + $c coords $newlink $lastX $lastY $x $y } elseif { $activetool == "select" && \ - ( $curobj == $selectbox || $curobj == $background )} { - if {$selectbox == ""} { - set selectbox [$c create line \ - $lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY \ - -dash {10 4} -fill black -width 1 -tags "selectbox"] - $c raise $selectbox "background || link || linklabel || interface" - } else { - $c coords $selectbox \ - $lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY - } + ( $curobj == $selectbox || $curtype == "background" )} { + if {$selectbox == ""} { + set selectbox [$c create line \ + $lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY \ + -dash {10 4} -fill black -width 1 -tags "selectbox"] + $c raise $selectbox "background || link || linklabel || interface" + } else { + $c coords $selectbox \ + $lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY + } } elseif { $activetool == "select" && $curtype == "nodelabel" \ && [nodeType [lindex [$c gettags $curobj] 1]] != "pseudo" } { - $c move $curobj [expr $x-$lastX] [expr $y-$lastY] + $c move $curobj [expr {$x - $lastX}] [expr {$y - $lastY}] set changed 1 set lastX $x set lastY $y } else { - foreach img [$c find withtag "selected"] { - set node [lindex [$c gettags $img] 1] - set img [$c find withtag "selectmark && $node"] - $c move $img [expr $x-$lastX] [expr $y-$lastY] + foreach img [$c find withtag "selected"] { + set node [lindex [$c gettags $img] 1] + set img [$c find withtag "selectmark && $node"] + $c move $img [expr {$x - $lastX}] [expr {$y - $lastY}] set img [$c find withtag "node && $node"] - $c move $img [expr $x-$lastX] [expr $y-$lastY] - set img [$c find withtag "nodelabel && $node"] - $c move $img [expr $x-$lastX] [expr $y-$lastY] - $c addtag need_redraw withtag "link && $node" - } - foreach link [$c find withtag "link && need_redraw"] { - redrawLink [lindex [$c gettags $link] 1] - } - $c dtag link need_redraw - set changed 1 - set lastX $x - set lastY $y + $c move $img [expr {$x - $lastX}] [expr {$y - $lastY}] + set img [$c find withtag "nodelabel && $node"] + $c move $img [expr {$x - $lastX}] [expr {$y - $lastY}] + $c addtag need_redraw withtag "link && $node" + } + foreach link [$c find withtag "link && need_redraw"] { + redrawLink [lindex [$c gettags $link] 1] + } + $c dtag link need_redraw + set changed 1 + set lastX $x + set lastY $y } - return } @@ -1335,28 +1394,27 @@ proc newGUILink { lnode1 lnode2 } { set link [newLink $lnode1 $lnode2] if { $link == "" } { - return + return } if { [getNodeCanvas $lnode1] != [getNodeCanvas $lnode2] } { - set new_nodes [splitLink $link pseudo] - set orig_nodes [linkPeers $link] - set new_node1 [lindex $new_nodes 0] - set new_node2 [lindex $new_nodes 1] - set orig_node1 [lindex $orig_nodes 0] - set orig_node2 [lindex $orig_nodes 1] - set new_link1 [linkByPeers $orig_node1 $new_node1] - set new_link2 [linkByPeers $orig_node2 $new_node2] - setNodeMirror $new_node1 $new_node2 - setNodeMirror $new_node2 $new_node1 - setNodeName $new_node1 $orig_node2 - setNodeName $new_node2 $orig_node1 - setLinkMirror $new_link1 $new_link2 - setLinkMirror $new_link2 $new_link1 + set new_nodes [splitLink $link pseudo] + set orig_nodes [linkPeers $link] + set new_node1 [lindex $new_nodes 0] + set new_node2 [lindex $new_nodes 1] + set orig_node1 [lindex $orig_nodes 0] + set orig_node2 [lindex $orig_nodes 1] + set new_link1 [linkByPeers $orig_node1 $new_node1] + set new_link2 [linkByPeers $orig_node2 $new_node2] + setNodeMirror $new_node1 $new_node2 + setNodeMirror $new_node2 $new_node1 + setNodeName $new_node1 $orig_node2 + setNodeName $new_node2 $orig_node1 + setLinkMirror $new_link1 $new_link2 + setLinkMirror $new_link2 $new_link1 } redrawAll set changed 1 updateUndoLog - return } @@ -1376,10 +1434,9 @@ proc newGUILink { lnode1 lnode2 } { # * y -- y coordinate #**** proc button1-release { c x y } { - global node_list - global activetool newlink curobj grid + global node_list activetool newlink curobj grid global changed undolog undolevel redolevel selectbox selected - global lastX lastY sizex sizey + global lastX lastY sizex sizey zoom global autorearrange_enabled set x [$c canvasx $x] @@ -1387,106 +1444,107 @@ proc button1-release { c x y } { $c config -cursor left_ptr if {$activetool == "link" && $newlink != ""} { - $c delete $newlink - set newlink "" - set destobj "" - foreach obj [$c find overlapping $x $y $x $y] { - if {[lindex [$c gettags $obj] 0] == "node"} { - set destobj $obj - break - } - } - if {$destobj != "" && $curobj != "" && $destobj != $curobj} { - set lnode1 [lindex [$c gettags $curobj] 1] - set lnode2 [lindex [$c gettags $destobj] 1] - if { [ifcByLogicalPeer $lnode1 $lnode2] == "" } { - set link [newLink $lnode1 $lnode2] - if { $link != "" } { - drawLink $link - redrawLink $link - updateLinkLabel $link - set changed 1 - } - } - } + $c delete $newlink + set newlink "" + set destobj "" + foreach obj [$c find overlapping $x $y $x $y] { + if {[lindex [$c gettags $obj] 0] == "node"} { + set destobj $obj + break + } + } + if {$destobj != "" && $curobj != "" && $destobj != $curobj} { + set lnode1 [lindex [$c gettags $curobj] 1] + set lnode2 [lindex [$c gettags $destobj] 1] + if { [ifcByLogicalPeer $lnode1 $lnode2] == "" } { + set link [newLink $lnode1 $lnode2] + if { $link != "" } { + drawLink $link + redrawLink $link + updateLinkLabel $link + set changed 1 + } + } + } } if { $changed == 1 } { - set regular true - if { [lindex [$c gettags $curobj] 0] == "nodelabel" } { - set node [lindex [$c gettags $curobj] 1] - selectNode $c [$c find withtag "node && $node"] - } - set selected {} - foreach img [$c find withtag "selected"] { - set node [lindex [$c gettags $img] 1] - lappend selected $node - set coords [$c coords $img] - set x [lindex $coords 0] - set y [lindex $coords 1] - if { $autorearrange_enabled } { - set dx 0 - set dy 0 - } else { - set dx [expr int($x / $grid + 0.5) * $grid - $x] - set dy [expr int($y / $grid + 0.5) * $grid - $y] - } - $c move $img $dx $dy - set coords [$c coords $img] - set x [lindex $coords 0] - set y [lindex $coords 1] - setNodeCoords $node "$x $y" - if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} { - set regular false - } - $c move "nodelabel && $node" $dx $dy - set coords [$c coords "nodelabel && $node"] - set x [lindex $coords 0] - set y [lindex $coords 1] - setNodeLabelCoords $node "$x $y" - if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} { - set regular false - } - $c move "selectmark && $node" $dx $dy - $c addtag need_redraw withtag "link && $node" - } - if {$regular == "true"} { - foreach link [$c find withtag "link && need_redraw"] { - redrawLink [lindex [$c gettags $link] 1] - } - } else { - loadCfg $undolog($undolevel) - redrawAll - foreach node $selected { - selectNode $c [$c find withtag "node && $node"] - } - set changed 0 - } - $c dtag link need_redraw + set regular true + if { [lindex [$c gettags $curobj] 0] == "nodelabel" } { + set node [lindex [$c gettags $curobj] 1] + selectNode $c [$c find withtag "node && $node"] + } + set selected {} + foreach img [$c find withtag "selected"] { + set node [lindex [$c gettags $img] 1] + lappend selected $node + set coords [$c coords $img] + set x [expr {[lindex $coords 0] / $zoom}] + set y [expr {[lindex $coords 1] / $zoom}] + if { $autorearrange_enabled == 0} { + set dx [expr {(int($x / $grid + 0.5) * $grid - $x) * $zoom}] + set dy [expr {(int($y / $grid + 0.5) * $grid - $y) * $zoom}] + $c move $img $dx $dy + set coords [$c coords $img] + set x [expr {[lindex $coords 0] / $zoom}] + set y [expr {[lindex $coords 1] / $zoom}] + } else { + set dx 0 + set dy 0 + } + setNodeCoords $node "$x $y" + if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} { + set regular false + } + $c move "nodelabel && $node" $dx $dy + set coords [$c coords "nodelabel && $node"] + set x [expr {[lindex $coords 0] / $zoom}] + set y [expr {[lindex $coords 1] / $zoom}] + setNodeLabelCoords $node "$x $y" + if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} { + set regular false + } + $c move "selectmark && $node" $dx $dy + $c addtag need_redraw withtag "link && $node" + } + if {$regular == "true"} { + foreach link [$c find withtag "link && need_redraw"] { + redrawLink [lindex [$c gettags $link] 1] + } + } else { + .c config -cursor watch + loadCfg $undolog($undolevel) + redrawAll + if {$activetool == "select" } { + selectNodes $selected + } + set changed 0 + } + $c dtag link need_redraw } elseif {$activetool == "select" } { - if {$selectbox == ""} { - set x1 $x - set y1 $y - set autorearrange_enabled 0 - } else { - set coords [$c coords $selectbox] - set x [lindex $coords 0] - set y [lindex $coords 1] - set x1 [lindex $coords 4] - set y1 [lindex $coords 5] - $c delete $selectbox - set selectbox "" - } - set enclosed {} - foreach obj [$c find enclosed $x $y $x1 $y1] { - set tags [$c gettags $obj] - if {[lindex $tags 0] == "node" && [lsearch $tags selected] == -1} { - lappend enclosed $obj - } - } - foreach obj $enclosed { - selectNode $c $obj - } + if {$selectbox == ""} { + set x1 $x + set y1 $y + set autorearrange_enabled 0 + } else { + set coords [$c coords $selectbox] + set x [lindex $coords 0] + set y [lindex $coords 1] + set x1 [lindex $coords 4] + set y1 [lindex $coords 5] + $c delete $selectbox + set selectbox "" + } + set enclosed {} + foreach obj [$c find enclosed $x $y $x1 $y1] { + set tags [$c gettags $obj] + if {[lindex $tags 0] == "node" && [lsearch $tags selected] == -1} { + lappend enclosed $obj + } + } + foreach obj $enclosed { + selectNode $c $obj + } } $c raise link background $c raise linklabel "link || background" @@ -1495,7 +1553,6 @@ proc button1-release { c x y } { $c raise nodelabel "node || interface || linklabel || link || background" update updateUndoLog - return } @@ -1521,17 +1578,16 @@ proc nodeEnter { c } { set name [getNodeName $node] set model [getNodeModel $node] if { $model != "" } { - set line "{$node} $name ($model):" + set line "{$node} $name ($model):" } else { - set line "{$node} $name:" + set line "{$node} $name:" } if { $type != "rj45" } { - foreach ifc [ifcList $node] { - set line "$line $ifc:[getIfcIPv4addr $node $ifc]" - } + foreach ifc [ifcList $node] { + set line "$line $ifc:[getIfcIPv4addr $node $ifc]" + } } .bottom.textbox config -text "$line" - return } @@ -1553,11 +1609,10 @@ proc linkEnter {c} { set link [lindex [$c gettags current] 1] if { [lsearch $link_list $link] == -1 } { - return + return } set line "$link: [getLinkBandwidthString $link] [getLinkDelayString $link]" .bottom.textbox config -text "$line" - return } @@ -1575,7 +1630,6 @@ proc anyLeave {c} { global activetool .bottom.textbox config -text "" - return } @@ -1597,17 +1651,17 @@ proc anyLeave {c} { #**** proc checkIntRange { str low high } { if { $str == "" } { - return 1 + return 1 } set str [string trimleft $str 0] if { $str == "" } { - set str 0 + set str 0 } if { ![string is integer $str] } { - return 0 + return 0 } if { $str < $low || $str > $high } { - return 0 + return 0 } return 1 } @@ -1634,24 +1688,23 @@ proc focusAndFlash {W {count 9}} { set bg white if { $badentry == -1 } { - return + return } else { - set badentry 1 + set badentry 1 } focus -force $W if {$count<1} { - $W configure -foreground $fg -background $bg - set badentry 0 - } else { - if {$count%2} { - $W configure -foreground $bg -background $fg + $W configure -foreground $fg -background $bg + set badentry 0 } else { - $W configure -foreground $fg -background $bg - } - after 200 [list focusAndFlash $W [expr {$count-1}]] + if {$count%2} { + $W configure -foreground $bg -background $fg + } else { + $W configure -foreground $fg -background $bg + } + after 200 [list focusAndFlash $W [expr {$count - 1}]] } - return } @@ -1667,7 +1720,7 @@ proc focusAndFlash {W {count 9}} { # * c -- canvas id #**** proc popupConfigDialog { c } { - global activetool router_model supp_router_models oper_mode + global activetool router_model link_color supp_router_models oper_mode global badentry curcanvas set wi .popup @@ -1681,22 +1734,22 @@ proc popupConfigDialog { c } { set tk_type [lindex [$c gettags current] 0] set target [lindex [$c gettags current] 1] if { [lsearch {node nodelabel interface} $tk_type] > -1 } { - set object_type node + set object_type node } if { [lsearch {link linklabel} $tk_type] > -1 } { - set object_type link + set object_type link } if { "$object_type" == ""} { - destroy $wi - return + destroy $wi + return } if { $object_type == "link" } { - set n0 [lindex [linkPeers $target] 0] - set n1 [lindex [linkPeers $target] 1] - if { [nodeType $n0] == "rj45" || [nodeType $n1] == "rj45" } { - destroy $wi - return - } + set n0 [lindex [linkPeers $target] 0] + set n1 [lindex [linkPeers $target] 1] + if { [nodeType $n0] == "rj45" || [nodeType $n1] == "rj45" } { + destroy $wi + return + } } $c dtag node selected $c delete -withtags selectmark @@ -1705,269 +1758,266 @@ proc popupConfigDialog { c } { node { set type [nodeType $target] if { $type == "pseudo" } { - # - # Hyperlink to another canvas - # - destroy $wi - set curcanvas [getNodeCanvas [getNodeMirror $target]] - switchCanvas none - return + # + # Hyperlink to another canvas + # + destroy $wi + set curcanvas [getNodeCanvas [getNodeMirror $target]] + switchCanvas none + return } set model [getNodeModel $target] set router_model $model wm title $wi "$type configuration" frame $wi.ftop -borderwidth 4 if { $type == "rj45" } { - label $wi.ftop.name_label -text "Physical interface:" + label $wi.ftop.name_label -text "Physical interface:" } else { - label $wi.ftop.name_label -text "Node name:" + label $wi.ftop.name_label -text "Node name:" } entry $wi.ftop.name -bg white -width 16 \ - -validate focus -invcmd "focusAndFlash %W" + -validate focus -invcmd "focusAndFlash %W" $wi.ftop.name insert 0 [getNodeName $target] pack $wi.ftop.name $wi.ftop.name_label -side right -padx 4 -pady 4 pack $wi.ftop -side top if { $type == "router" } { - frame $wi.model -borderwidth 4 - label $wi.model.label -text "Model:" - if { $oper_mode == "edit" } { - eval tk_optionMenu $wi.model.menu router_model \ - $supp_router_models - } else { - tk_optionMenu $wi.model.menu router_model $model - } - pack $wi.model.menu $wi.model.label -side right -padx 0 -pady 0 - pack $wi.model -side top + frame $wi.model -borderwidth 4 + label $wi.model.label -text "Model:" + if { $oper_mode == "edit" } { + eval tk_optionMenu $wi.model.menu router_model \ + $supp_router_models + } else { + tk_optionMenu $wi.model.menu router_model $model + } + pack $wi.model.menu $wi.model.label -side right -padx 0 -pady 0 + pack $wi.model -side top } if { $type != "rj45" } { - foreach ifc [lsort -ascii [ifcList $target]] { - labelframe $wi.if$ifc -padx 4 -pady 4 - frame $wi.if$ifc.label - label $wi.if$ifc.label.txt -text "Interface $ifc:" - pack $wi.if$ifc.label.txt -side left -anchor w - if {[[typemodel $target].layer] == "NETWORK"} { - global ifoper$ifc - set ifoper$ifc [getIfcOperState $target $ifc] - radiobutton $wi.if$ifc.label.up -text "up" \ - -variable ifoper$ifc -value up - radiobutton $wi.if$ifc.label.down -text "down" \ - -variable ifoper$ifc -value down - label $wi.if$ifc.label.mtul -text "MTU" \ - -anchor e -width 5 - spinbox $wi.if$ifc.label.mtuv -bg white -width 4 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.if$ifc.label.mtuv insert 0 \ - [getIfcMTU $target $ifc] - if {![string first eth $ifc]} { - $wi.if$ifc.label.mtuv configure \ - -from 256 -to 1500 -increment 2 \ - -vcmd {checkIntRange %P 256 1500} - } else { - $wi.if$ifc.label.mtuv configure \ - -from 256 -to 2044 -increment 2 \ - -vcmd {checkIntRange %P 256 2044} - } - pack $wi.if$ifc.label.up $wi.if$ifc.label.down \ - $wi.if$ifc.label.mtul $wi.if$ifc.label.mtuv \ - -side left -anchor w - } - pack $wi.if$ifc.label -side top -anchor w - frame $wi.if$ifc.tab -width 10 - frame $wi.if$ifc.cfg - - # - # Queue config - # - global ifqdisc$ifc ifqdrop$ifc - set ifqdisc$ifc [getIfcQDisc $target $ifc] - set ifqdrop$ifc [getIfcQDrop $target $ifc] - frame $wi.if$ifc.cfg.q - label $wi.if$ifc.cfg.q.l1 -text "Queue" \ - -anchor w - tk_optionMenu $wi.if$ifc.cfg.q.disc ifqdisc$ifc \ - FIFO DRR WFQ - tk_optionMenu $wi.if$ifc.cfg.q.drop ifqdrop$ifc \ - drop-tail drop-head - label $wi.if$ifc.cfg.q.l2 -text "len" \ - -anchor e -width 3 - spinbox $wi.if$ifc.cfg.q.len -bg white -width 4 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.if$ifc.cfg.q.len insert 0 [getIfcQLen $target $ifc] - $wi.if$ifc.cfg.q.len configure \ - -from 5 -to 4096 -increment 1 \ - -vcmd {checkIntRange %P 5 4096} - pack $wi.if$ifc.cfg.q.l1 $wi.if$ifc.cfg.q.disc \ - $wi.if$ifc.cfg.q.drop -side left -anchor w - pack $wi.if$ifc.cfg.q.l2 $wi.if$ifc.cfg.q.len \ - -side left -anchor e - pack $wi.if$ifc.cfg.q -side top -anchor w - - if {[lsearch {router pc host} $type] >= 0} { - # - # IPv4 address - # - frame $wi.if$ifc.cfg.ipv4 - label $wi.if$ifc.cfg.ipv4.addrl -text "IPv4 address" \ - -anchor w - entry $wi.if$ifc.cfg.ipv4.addrv -bg white -width 30 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.if$ifc.cfg.ipv4.addrv insert 0 \ - [getIfcIPv4addr $target $ifc] - $wi.if$ifc.cfg.ipv4.addrv configure \ - -vcmd {checkIPv4Net %P} - pack $wi.if$ifc.cfg.ipv4.addrl \ - $wi.if$ifc.cfg.ipv4.addrv -side left - pack $wi.if$ifc.cfg.ipv4 -side top -anchor w - - # - # IPv6 address - # - frame $wi.if$ifc.cfg.ipv6 - label $wi.if$ifc.cfg.ipv6.addrl -text "IPv6 address" \ - -anchor w - entry $wi.if$ifc.cfg.ipv6.addrv -bg white -width 30 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.if$ifc.cfg.ipv6.addrv insert 0 \ - [getIfcIPv6addr $target $ifc] - $wi.if$ifc.cfg.ipv6.addrv configure \ - -vcmd {checkIPv6Net %P} - pack $wi.if$ifc.cfg.ipv6.addrl \ - $wi.if$ifc.cfg.ipv6.addrv -side left - pack $wi.if$ifc.cfg.ipv6 -side top -anchor w - } - pack $wi.if$ifc.tab $wi.if$ifc.cfg -side left - pack $wi.if$ifc -side top -anchor w -fill both - } + foreach ifc [lsort -ascii [ifcList $target]] { + labelframe $wi.if$ifc -padx 4 -pady 4 + frame $wi.if$ifc.label + label $wi.if$ifc.label.txt -text "Interface $ifc:" + pack $wi.if$ifc.label.txt -side left -anchor w + if {[[typemodel $target].layer] == "NETWORK"} { + global ifoper$ifc + set ifoper$ifc [getIfcOperState $target $ifc] + radiobutton $wi.if$ifc.label.up -text "up" \ + -variable ifoper$ifc -value up + radiobutton $wi.if$ifc.label.down -text "down" \ + -variable ifoper$ifc -value down + label $wi.if$ifc.label.mtul -text "MTU" \ + -anchor e -width 5 + spinbox $wi.if$ifc.label.mtuv -bg white -width 4 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.if$ifc.label.mtuv insert 0 \ + [getIfcMTU $target $ifc] + if {![string first eth $ifc]} { + $wi.if$ifc.label.mtuv configure \ + -from 256 -to 1500 -increment 2 \ + -vcmd {checkIntRange %P 256 1500} + } else { + $wi.if$ifc.label.mtuv configure \ + -from 256 -to 2044 -increment 2 \ + -vcmd {checkIntRange %P 256 2044} + } + pack $wi.if$ifc.label.up $wi.if$ifc.label.down \ + $wi.if$ifc.label.mtul $wi.if$ifc.label.mtuv \ + -side left -anchor w + } + pack $wi.if$ifc.label -side top -anchor w + frame $wi.if$ifc.tab -width 10 + frame $wi.if$ifc.cfg + + # + # Queue config + # + global ifqdisc$ifc ifqdrop$ifc + set ifqdisc$ifc [getIfcQDisc $target $ifc] + set ifqdrop$ifc [getIfcQDrop $target $ifc] + frame $wi.if$ifc.cfg.q + label $wi.if$ifc.cfg.q.l1 -text "Queue" -anchor w + tk_optionMenu $wi.if$ifc.cfg.q.disc ifqdisc$ifc \ + FIFO DRR WFQ + tk_optionMenu $wi.if$ifc.cfg.q.drop ifqdrop$ifc \ + drop-tail drop-head + label $wi.if$ifc.cfg.q.l2 -text "len" \ + -anchor e -width 3 + spinbox $wi.if$ifc.cfg.q.len -bg white -width 4 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.if$ifc.cfg.q.len insert 0 [getIfcQLen $target $ifc] + $wi.if$ifc.cfg.q.len configure \ + -from 5 -to 4096 -increment 1 \ + -vcmd {checkIntRange %P 5 4096} + pack $wi.if$ifc.cfg.q.l1 $wi.if$ifc.cfg.q.disc \ + $wi.if$ifc.cfg.q.drop -side left -anchor w + pack $wi.if$ifc.cfg.q.l2 $wi.if$ifc.cfg.q.len \ + -side left -anchor e + pack $wi.if$ifc.cfg.q -side top -anchor w + + if {[lsearch {router pc host} $type] >= 0} { + # + # IPv4 address + # + frame $wi.if$ifc.cfg.ipv4 + label $wi.if$ifc.cfg.ipv4.addrl -text "IPv4 address" \ + -anchor w + entry $wi.if$ifc.cfg.ipv4.addrv -bg white -width 30 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.if$ifc.cfg.ipv4.addrv insert 0 \ + [getIfcIPv4addr $target $ifc] + $wi.if$ifc.cfg.ipv4.addrv configure \ + -vcmd {checkIPv4Net %P} + pack $wi.if$ifc.cfg.ipv4.addrl \ + $wi.if$ifc.cfg.ipv4.addrv -side left + pack $wi.if$ifc.cfg.ipv4 -side top -anchor w + + # + # IPv6 address + # + frame $wi.if$ifc.cfg.ipv6 + label $wi.if$ifc.cfg.ipv6.addrl -text "IPv6 address" \ + -anchor w + entry $wi.if$ifc.cfg.ipv6.addrv -bg white -width 30 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.if$ifc.cfg.ipv6.addrv insert 0 \ + [getIfcIPv6addr $target $ifc] + $wi.if$ifc.cfg.ipv6.addrv configure -vcmd {checkIPv6Net %P} + pack $wi.if$ifc.cfg.ipv6.addrl \ + $wi.if$ifc.cfg.ipv6.addrv -side left + pack $wi.if$ifc.cfg.ipv6 -side top -anchor w + } + pack $wi.if$ifc.tab $wi.if$ifc.cfg -side left + pack $wi.if$ifc -side top -anchor w -fill both + } } if {[lsearch {router pc host} $type] >= 0} { - # - # Static routes - # - set routes [concat [getStatIPv4routes $target] \ - [getStatIPv6routes $target]] - labelframe $wi.statrt -padx 4 -pady 4 - label $wi.statrt.label -text "Static routes:" - pack $wi.statrt.label -side top -anchor w - frame $wi.statrt.tab -width 10 - frame $wi.statrt.tab1 -width 10 - frame $wi.statrt.cfg - set h [expr [llength $routes] + 1] - if { $h < 2 } { - set h 2 - } - text $wi.statrt.cfg.text -font arial -bg white \ - -width 42 -height $h -takefocus 0 - foreach route $routes { - $wi.statrt.cfg.text insert end "$route " - } - pack $wi.statrt.cfg.text -expand yes - pack $wi.statrt.tab $wi.statrt.cfg $wi.statrt.tab1 -side left - pack $wi.statrt -side top -anchor w -fill both + # + # Static routes + # + set routes [concat [getStatIPv4routes $target] \ + [getStatIPv6routes $target]] + labelframe $wi.statrt -padx 4 -pady 4 + label $wi.statrt.label -text "Static routes:" + pack $wi.statrt.label -side top -anchor w + frame $wi.statrt.tab -width 10 + frame $wi.statrt.tab1 -width 10 + frame $wi.statrt.cfg + set h [expr {[llength $routes] + 1}] + if { $h < 2 } { + set h 2 + } + text $wi.statrt.cfg.text -font arial -bg white \ + -width 42 -height $h -takefocus 0 + foreach route $routes { + $wi.statrt.cfg.text insert end "$route " + } + pack $wi.statrt.cfg.text -expand yes + pack $wi.statrt.tab $wi.statrt.cfg $wi.statrt.tab1 -side left + pack $wi.statrt -side top -anchor w -fill both } if {[lsearch {router pc host} $type] >= 0} { - # - # Custom startup config - # - global customEnabled - labelframe $wi.custom -padx 4 -pady 4 - frame $wi.custom.label - label $wi.custom.label.txt -text "Custom startup config:" - pack $wi.custom.label.txt -side left -anchor w - set customEnabled [getCustomEnabled $target] - radiobutton $wi.custom.label.enabled -text "enabled" \ - -variable customEnabled -value true - radiobutton $wi.custom.label.disabled -text "disabled" \ - -variable customEnabled -value false - pack $wi.custom.label.enabled $wi.custom.label.disabled \ - -side left -anchor w - pack $wi.custom.label -side top -anchor w - frame $wi.custom.cfg - button $wi.custom.cfg.generate -text "Generate" \ - -command "cfgGenerate $target" - button $wi.custom.cfg.edit -text "Edit" \ - -command "editStartupCfg $target 0" - button $wi.custom.cfg.clear -text "Clear" \ - -command "setCustomConfig $target {} {} {} 0" - pack $wi.custom.cfg.generate $wi.custom.cfg.edit \ - $wi.custom.cfg.clear -side left - - pack $wi.custom.label -side top -anchor w - pack $wi.custom.cfg -side top - pack $wi.custom -side top -anchor w -fill both - - # - # IPsec configuration: - # - global ipsecEnabled - global showIPsecConfig - if { $showIPsecConfig == 1 } { + # + # Custom startup config + # + global customEnabled + labelframe $wi.custom -padx 4 -pady 4 + frame $wi.custom.label + label $wi.custom.label.txt -text "Custom startup config:" + pack $wi.custom.label.txt -side left -anchor w + set customEnabled [getCustomEnabled $target] + radiobutton $wi.custom.label.enabled -text "enabled" \ + -variable customEnabled -value true + radiobutton $wi.custom.label.disabled -text "disabled" \ + -variable customEnabled -value false + pack $wi.custom.label.enabled $wi.custom.label.disabled \ + -side left -anchor w + pack $wi.custom.label -side top -anchor w + frame $wi.custom.cfg + button $wi.custom.cfg.generate -text "Generate" \ + -command "cfgGenerate $target" + button $wi.custom.cfg.edit -text "Edit" \ + -command "editStartupCfg $target 0" + button $wi.custom.cfg.clear -text "Clear" \ + -command "setCustomConfig $target {} {} {} 0" + pack $wi.custom.cfg.generate $wi.custom.cfg.edit \ + $wi.custom.cfg.clear -side left + + pack $wi.custom.label -side top -anchor w + pack $wi.custom.cfg -side top + pack $wi.custom -side top -anchor w -fill both + + # + # IPsec configuration: + # + global ipsecEnabled + global showIPsecConfig + if { $showIPsecConfig == 1 } { labelframe $wi.ipsec -padx 4 -pady 4 - frame $wi.ipsec.label - label $wi.ipsec.label.txt -text "Manual IPsec configuration:" - pack $wi.ipsec.label.txt -side left -anchor w - set ipsecEnabled [getIpsecEnabled $target] - radiobutton $wi.ipsec.label.enabled -text "enabled" \ - -variable ipsecEnabled -value true - radiobutton $wi.ipsec.label.disabled -text "disabled" \ - -variable ipsecEnabled -value false - pack $wi.ipsec.label.enabled $wi.ipsec.label.disabled \ - -side left -anchor w - pack $wi.ipsec.label -side top -anchor w - frame $wi.ipsec.cfg - set delete "0" - set view "0" - button $wi.ipsec.cfg.add -text "Add SA/SP" \ - -command "viewIpsecCfg $target $delete $view" - set delete "0" - set view "1" - button $wi.ipsec.cfg.view -text "Edit SAs/SPs" \ - -command "viewIpsecCfg $target $delete $view" - pack $wi.ipsec.cfg.add \ - $wi.ipsec.cfg.view -side left - pack $wi.ipsec.label -side top -anchor w - pack $wi.ipsec.cfg -side top - pack $wi.ipsec -side top -anchor w -fill both - } + frame $wi.ipsec.label + label $wi.ipsec.label.txt -text "Manual IPsec configuration:" + pack $wi.ipsec.label.txt -side left -anchor w + set ipsecEnabled [getIpsecEnabled $target] + radiobutton $wi.ipsec.label.enabled -text "enabled" \ + -variable ipsecEnabled -value true + radiobutton $wi.ipsec.label.disabled -text "disabled" \ + -variable ipsecEnabled -value false + pack $wi.ipsec.label.enabled $wi.ipsec.label.disabled \ + -side left -anchor w + pack $wi.ipsec.label -side top -anchor w + frame $wi.ipsec.cfg + set delete "0" + set view "0" + button $wi.ipsec.cfg.add -text "Add SA/SP" \ + -command "viewIpsecCfg $target $delete $view" + set delete "0" + set view "1" + button $wi.ipsec.cfg.view -text "Edit SAs/SPs" \ + -command "viewIpsecCfg $target $delete $view" + pack $wi.ipsec.cfg.add $wi.ipsec.cfg.view -side left + pack $wi.ipsec.label -side top -anchor w + pack $wi.ipsec.cfg -side top + pack $wi.ipsec -side top -anchor w -fill both + } - # - # CPU scheduling parameters - # - labelframe $wi.cpu -padx 4 -pady 4 - label $wi.cpu.minl -text "CPU min%" -anchor w - spinbox $wi.cpu.mine -bg white -width 3 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.cpu.mine insert 0 [lindex \ - [lsearch -inline [getNodeCPUConf $target] {min *}] 1] - $wi.cpu.mine configure \ - -vcmd {checkIntRange %P 1 90} \ - -from 0 -to 90 -increment 1 - label $wi.cpu.maxl -text " max%" -anchor w - spinbox $wi.cpu.maxe -bg white -width 3 \ - -validate focus -invcmd "focusAndFlash %W" - set cpumax [lindex \ - [lsearch -inline [getNodeCPUConf $target] {max *}] 1] - if { $cpumax == "" } { - set cpumax 100 - } - $wi.cpu.maxe insert 0 $cpumax - $wi.cpu.maxe configure \ - -vcmd {checkIntRange %P 1 100} \ - -from 1 -to 100 -increment 1 - label $wi.cpu.weightl -text " weight" -anchor w - spinbox $wi.cpu.weighte -bg white -width 2 \ - -validate focus -invcmd "focusAndFlash %W" - $wi.cpu.weighte insert 0 [lindex \ - [lsearch -inline [getNodeCPUConf $target] {weight *}] 1] - $wi.cpu.weighte configure \ - -vcmd {checkIntRange %P 1 10} \ - -from 1 -to 10 -increment 1 - pack $wi.cpu.minl $wi.cpu.mine \ - $wi.cpu.maxl $wi.cpu.maxe \ - $wi.cpu.weightl $wi.cpu.weighte -side left - pack $wi.cpu -side top -anchor w -fill both + # + # CPU scheduling parameters + # + labelframe $wi.cpu -padx 4 -pady 4 + label $wi.cpu.minl -text "CPU min%" -anchor w + spinbox $wi.cpu.mine -bg white -width 3 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.cpu.mine insert 0 [lindex \ + [lsearch -inline [getNodeCPUConf $target] {min *}] 1] + $wi.cpu.mine configure \ + -vcmd {checkIntRange %P 1 90} \ + -from 0 -to 90 -increment 1 + label $wi.cpu.maxl -text " max%" -anchor w + spinbox $wi.cpu.maxe -bg white -width 3 \ + -validate focus -invcmd "focusAndFlash %W" + set cpumax [lindex \ + [lsearch -inline [getNodeCPUConf $target] {max *}] 1] + if { $cpumax == "" } { + set cpumax 100 + } + $wi.cpu.maxe insert 0 $cpumax + $wi.cpu.maxe configure \ + -vcmd {checkIntRange %P 1 100} \ + -from 1 -to 100 -increment 1 + label $wi.cpu.weightl -text " weight" -anchor w + spinbox $wi.cpu.weighte -bg white -width 2 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.cpu.weighte insert 0 [lindex \ + [lsearch -inline [getNodeCPUConf $target] {weight *}] 1] + $wi.cpu.weighte configure \ + -vcmd {checkIntRange %P 1 10} \ + -from 1 -to 10 -increment 1 + pack $wi.cpu.minl $wi.cpu.mine \ + $wi.cpu.maxl $wi.cpu.maxe \ + $wi.cpu.weightl $wi.cpu.weighte -side left + pack $wi.cpu -side top -anchor w -fill both } } link { @@ -2025,6 +2075,25 @@ proc popupConfigDialog { c } { -from 0 -to 50 -increment 1 pack $wi.dup.value $wi.dup.label -side right pack $wi.dup -side top -anchor e + + frame $wi.color -borderwidth 4 + label $wi.color.label -anchor e -text "Color:" + set link_color [getLinkColor $target] + tk_optionMenu $wi.color.value link_color \ + Red Green Blue Yellow Magenta Cyan Black + pack $wi.color.value $wi.color.label -side right + pack $wi.color -side top -anchor e + + frame $wi.width -borderwidth 4 + label $wi.width.label -anchor e -text "Width:" + spinbox $wi.width.value -bg white -justify right -width 10 \ + -validate focus -invcmd "focusAndFlash %W" + $wi.width.value insert 0 [getLinkWidth $target] + $wi.width.value configure \ + -vcmd {checkIntRange %P 1 8} \ + -from 1 -to 8 -increment 1 + pack $wi.width.value $wi.width.label -side right + pack $wi.width -side top -anchor e } } @@ -2037,9 +2106,8 @@ proc popupConfigDialog { c } { pack $wi.butt.cancel $wi.butt.apply -side right pack $wi.butt -side bottom after 100 { - grab .popup + grab .popup } - return } @@ -2056,9 +2124,9 @@ proc popupConfigDialog { c } { # * node_id -- node id #**** proc cfgGenerate { node } { - set id "generic" - set cmd [[typemodel $node].bootcmd $node] - set cfg [[typemodel $node].cfggen $node] + set id "generic" + set cmd [[typemodel $node].bootcmd $node] + set cfg [[typemodel $node].cfggen $node] setCustomConfig $node $id $cmd $cfg 0 } @@ -2072,116 +2140,114 @@ proc cfgGenerate { node } { # Creates an edit startup configuration dialog box. # INPUTS # * node_id -- node id -# * deleted -- if deleted is set to 1, editStartupCfg -# has been invoked after deleting custom-config -# with specified custom-config-id. +# * deleted -- if deleted is set to 1, editStartupCfg +# has been invoked after deleting custom-config +# with specified custom-config-id. #**** proc editStartupCfg { node deleted } { + global viewcustomid - set customCfgList "" - set customCfgList [getCustomConfig $node] - set customidlist {} - foreach customCfg $customCfgList { - set customid [lindex [lsearch -inline $customCfg \ - "custom-config-id *"] 1] - lappend customidlist $customid - } + set customCfgList "" + set customCfgList [getCustomConfig $node] + set customidlist {} + foreach customCfg $customCfgList { + set customid [lindex [lsearch -inline $customCfg \ + "custom-config-id *"] 1] + lappend customidlist $customid + } - global viewcustomid - set edit 1 + set edit 1 if { $deleted == "1" } { set viewcustomid [lindex $customidlist 0] } - if { $customidlist == "" } { - set warning "Custom config list is empty." + if { $customidlist == "" } { + set warning "Custom config list is empty." tk_messageBox -message $warning -type ok -icon warning \ - -title "Custom configuration warning" - } else { - - set w .cfgeditor - catch {destroy $w} - toplevel $w -takefocus 1 - #wm transient $w . - grab $w - wm title $w "Custom config $node" - wm iconname $w "$node" - + -title "Custom configuration warning" + } else { + set w .cfgeditor + catch {destroy $w} + toplevel $w -takefocus 1 + grab $w + wm title $w "Custom config $node" + wm iconname $w "$node" labelframe $w.custom -padx 4 -pady 4 - if { $edit == "1" } { - frame $w.custom.viewid -borderwidth 4 - label $w.custom.viewid.label -text "View custom-config:" - pack $w.custom.viewid.label -side left -anchor w - eval {tk_optionMenu $w.custom.viewid.optmenu viewcustomid} $customidlist - pack $w.custom.viewid.label $w.custom.viewid.optmenu \ - -side left -anchor w - pack $w.custom.viewid -side top -anchor w - button $w.custom.viewid.button -text View \ - -command "editStartupCfg $node 0" - pack $w.custom.viewid.button -side right - - foreach element $customCfgList { - set cid [lindex [lsearch -inline $element "custom-config-id *"] 1] + if { $edit == "1" } { + frame $w.custom.viewid -borderwidth 4 + label $w.custom.viewid.label -text "View custom-config:" + pack $w.custom.viewid.label -side left -anchor w + eval {tk_optionMenu $w.custom.viewid.optmenu viewcustomid} \ + $customidlist + pack $w.custom.viewid.label $w.custom.viewid.optmenu \ + -side left -anchor w + pack $w.custom.viewid -side top -anchor w + button $w.custom.viewid.button -text View \ + -command "editStartupCfg $node 0" + pack $w.custom.viewid.button -side right + + foreach element $customCfgList { + set cid \ + [lindex [lsearch -inline $element "custom-config-id *"] 1] if { $viewcustomid == $cid } { - set customCfg $element - } - } - } + set customCfg $element + } + } + } frame $w.custom.id -borderwidth 4 label $w.custom.id.label -text "Custom config id:" entry $w.custom.id.text -bg white -width 30 if { $customCfg != {} } { - set ccfg [getConfig $customCfg "custom-config-id"] + set ccfg [getConfig $customCfg "custom-config-id"] } else { - set ccfg "" + set ccfg "" } $w.custom.id.text insert 0 $ccfg pack $w.custom.id.text $w.custom.id.label -side right -padx 4 -pady 4 pack $w.custom.id -side top -anchor w pack $w.custom -side top -anchor w -fill both - frame $w.ftop -borderwidth 4 - label $w.ftop.label -text "Startup command:" - entry $w.ftop.cmd -bg white -width 64 + frame $w.ftop -borderwidth 4 + label $w.ftop.label -text "Startup command:" + entry $w.ftop.cmd -bg white -width 64 if { $customCfg != {} } { - set ccmd [getConfig $customCfg "custom-command"] + set ccmd [getConfig $customCfg "custom-command"] } else { - set ccmd "" + set ccmd "" } $w.ftop.cmd insert 0 $ccmd pack $w.ftop.cmd $w.ftop.label -side right -padx 4 -pady 4 - pack $w.ftop -side top -anchor w - - text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \ - -setgrid 1 -height 20 -undo 1 -autosep 1 -background white - focus $w.text - scrollbar $w.scroll -command "$w.text yview" - - frame $w.buttons - pack $w.buttons -side bottom - button $w.buttons.apply -text "Apply" \ - -command "customConfigApply $w $node" - button $w.buttons.close -text Close -command "destroy $w" + pack $w.ftop -side top -anchor w + + text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" \ + -setgrid 1 -height 20 -undo 1 -autosep 1 -background white + focus $w.text + scrollbar $w.scroll -command "$w.text yview" + + frame $w.buttons + pack $w.buttons -side bottom + button $w.buttons.apply -text "Apply" \ + -command "customConfigApply $w $node" + button $w.buttons.close -text Close -command "destroy $w" button $w.buttons.delete -text Delete -command \ - "deleteCustomConfig $w $node $viewcustomid {} {} 1" - pack $w.buttons.apply $w.buttons.close $w.buttons.delete -side left + "deleteCustomConfig $w $node $viewcustomid {} {} 1" + pack $w.buttons.apply $w.buttons.close $w.buttons.delete -side left - pack $w.scroll -side right -fill y - pack $w.text -expand yes -fill both + pack $w.scroll -side right -fill y + pack $w.text -expand yes -fill both if { $customCfg != {} } { - set ccfg [getConfig $customCfg "config"] + set ccfg [getConfig $customCfg "config"] } else { - set ccfg "" + set ccfg "" } - foreach line $ccfg { - $w.text insert end "$line\n" - } - $w.text mark set insert 0.0 + foreach line $ccfg { + $w.text insert end "$line\n" } - return + $w.text mark set insert 0.0 + } } #****f* editor.tcl/customConfigApply @@ -2201,20 +2267,18 @@ proc customConfigApply { w node } { global changed set newcmd [$w.ftop.cmd get] - set newid [$w.custom.id.text get] + set newid [$w.custom.id.text get] set newconf [split [$w.text get 0.0 end] "\n"] - while { [lindex $newconf end] == {} && $newconf != {} } { - set newconf [lreplace $newconf end end] + while { [lindex $newconf end] == {} && $newconf != {} } { + set newconf [lreplace $newconf end end] } - # TODO: if { [getCustomCmd $node] != $newcmd || \ - [getCustomConfig $node] != $newconf } { - set changed 1 + [getCustomConfig $node] != $newconf } { + set changed 1 } setCustomConfig $node $newid $newcmd $newconf 0 destroy $w - editStartupCfg $node 0 - return + editStartupCfg $node 0 } #****f* editor.tcl/popupConfigApply @@ -2238,21 +2302,21 @@ proc customConfigApply { w node } { # set to 0. #**** proc popupConfigApply { wi object_type target phase } { - global changed oper_mode router_model badentry + global changed oper_mode router_model link_color badentry global customEnabled ipsecEnabled global eid - global showIPsecConfig + global showIPsecConfig $wi config -cursor watch update if { $phase == 0 } { - set badentry 0 - focus . - after 100 "popupConfigApply $wi $object_type $target 1" - return + set badentry 0 + focus . + after 100 "popupConfigApply $wi $object_type $target 1" + return } elseif { $badentry } { - $wi config -cursor left_ptr - return + $wi config -cursor left_ptr + return } switch -exact -- $object_type { # @@ -2263,45 +2327,45 @@ proc popupConfigApply { wi object_type target phase } { set model [getNodeModel $target] set name [string trim [$wi.ftop.name get]] if { $name != [getNodeName $target] } { - setNodeName $target $name - set changed 1 + setNodeName $target $name + set changed 1 } if { $oper_mode == "edit" && $type == "router" && \ - $router_model != $model } { - setNodeModel $target $router_model - set changed 1 + $router_model != $model } { + setNodeModel $target $router_model + set changed 1 } # # Queue config # foreach ifc [ifcList $target] { - if { [nodeType [peerByIfc $target $ifc]] != "rj45" && \ - [nodeType $target] != "rj45" } { - global ifqdisc$ifc ifqdrop$ifc - set qdisc [subst $[subst ifqdisc$ifc]] - set oldqdisc [getIfcQDisc $target $ifc] - if { $qdisc != $oldqdisc } { - setIfcQDisc $target $ifc $qdisc - set changed 1 - } - set qdrop [subst $[subst ifqdrop$ifc]] - set oldqdrop [getIfcQDrop $target $ifc] - if { $qdrop != $oldqdrop } { - setIfcQDrop $target $ifc $qdrop - set changed 1 - } - set len [$wi.if$ifc.cfg.q.len get] - set oldlen [getIfcQLen $target $ifc] - if { $len != $oldlen } { - setIfcQLen $target $ifc $len - set changed 1 - } - } - } + if { [nodeType [peerByIfc $target $ifc]] != "rj45" && \ + [nodeType $target] != "rj45" } { + global ifqdisc$ifc ifqdrop$ifc + set qdisc [subst $[subst ifqdisc$ifc]] + set oldqdisc [getIfcQDisc $target $ifc] + if { $qdisc != $oldqdisc } { + setIfcQDisc $target $ifc $qdisc + set changed 1 + } + set qdrop [subst $[subst ifqdrop$ifc]] + set oldqdrop [getIfcQDrop $target $ifc] + if { $qdrop != $oldqdrop } { + setIfcQDrop $target $ifc $qdrop + set changed 1 + } + set len [$wi.if$ifc.cfg.q.len get] + set oldlen [getIfcQLen $target $ifc] + if { $len != $oldlen } { + setIfcQLen $target $ifc $len + set changed 1 + } + } + } if {[[typemodel $target].layer] == "NETWORK"} { - foreach ifc [ifcList $target] { + foreach ifc [ifcList $target] { # # Operational state # @@ -2429,43 +2493,58 @@ proc popupConfigApply { wi object_type target phase } { set mirror [getLinkMirror $target] set bw [$wi.bandwidth.value get] if { $bw != [getLinkBandwidth $target] } { - setLinkBandwidth $target [$wi.bandwidth.value get] - if { $mirror != "" } { - setLinkBandwidth $mirror [$wi.bandwidth.value get] - } - set changed 1 + setLinkBandwidth $target [$wi.bandwidth.value get] + if { $mirror != "" } { + setLinkBandwidth $mirror [$wi.bandwidth.value get] + } + set changed 1 } set dly [$wi.delay.value get] if { $dly != [getLinkDelay $target] } { - setLinkDelay $target [$wi.delay.value get] - if { $mirror != "" } { - setLinkDelay $mirror [$wi.delay.value get] - } - set changed 1 + setLinkDelay $target [$wi.delay.value get] + if { $mirror != "" } { + setLinkDelay $mirror [$wi.delay.value get] + } + set changed 1 } set ber [$wi.ber.value get] if { $ber != [getLinkBER $target] } { - setLinkBER $target [$wi.ber.value get] - if { $mirror != "" } { - setLinkBER $mirror [$wi.ber.value get] - } - set changed 1 + setLinkBER $target [$wi.ber.value get] + if { $mirror != "" } { + setLinkBER $mirror [$wi.ber.value get] + } + set changed 1 } set dup [$wi.dup.value get] if { $dup != [getLinkDup $target] } { - setLinkDup $target [$wi.dup.value get] - if { $mirror != "" } { - setLinkDup $mirror [$wi.dup.value get] - } - set changed 1 - } - if { $changed == 1 && $oper_mode == "exec" } { - execSetLinkParams $eid $target - } + setLinkDup $target [$wi.dup.value get] + if { $mirror != "" } { + setLinkDup $mirror [$wi.dup.value get] + } + set changed 1 + } + if { $link_color != [getLinkColor $target] } { + setLinkColor $target $link_color + if { $mirror != "" } { + setLinkColor $mirror $link_color + } + set changed 1 + } + set width [$wi.width.value get] + if { $width != [getLinkWidth $target] } { + setLinkWidth $target [$wi.width.value get] + if { $mirror != "" } { + setLinkWidth $mirror [$wi.width.value get] + } + set changed 1 + } + if { $changed == 1 && $oper_mode == "exec" } { + execSetLinkParams $eid $target + } } } if { $changed == 1 } { - redrawAll + redrawAll updateUndoLog } destroy $wi @@ -2506,15 +2585,16 @@ proc printCanvas { w } { proc deleteSelection { } { global changed global background - global viewid - catch {unset viewid} - + global viewid + catch {unset viewid} + .c config -cursor watch; update + foreach obj [.c find withtag "node && selected"] { - set lnode [lindex [.c gettags $obj] 1] - if { $lnode != "" } { - removeGUINode $lnode - } - set changed 1 + set lnode [lindex [.c gettags $obj] 1] + if { $lnode != "" } { + removeGUINode $lnode + } + set changed 1 } .c raise link background .c raise linklabel "link || background" @@ -2522,6 +2602,40 @@ proc deleteSelection { } { .c raise node "interface || linklabel || link || background" .c raise nodelabel "node || interface || linklabel || link || background" updateUndoLog + .c config -cursor left_ptr + .bottom.textbox config -text "" +} + + +proc align2grid {} { + global sizex sizey grid zoom + + set node_objects [.c find withtag node] + if { [llength $node_objects] == 0 } { + return + } + + set step [expr {$grid * 4}] + + for { set x $step } { $x <= [expr {$sizex - $step}] } { incr x $step } { + for { set y $step } { $y <= [expr {$sizey - $step}] } { incr y $step } { + if { [llength $node_objects] == 0 } { + set changed 1 + updateUndoLog + redrawAll + return + } + set node [lindex [.c gettags [lindex $node_objects 0]] 1] + set node_objects [lreplace $node_objects 0 0] + setNodeCoords $node "$x $y" + set dy 32 + if { [lsearch {router hub lanswitch rj45} \ + [nodeType $node]] >= 0 } { + set dy 24 + } + setNodeLabelCoords $node "$x [expr {$y + $dy}]" + } + } } @@ -2539,155 +2653,160 @@ proc deleteSelection { } { # rearranged. #**** proc rearrange { mode } { - global link_list autorearrange_enabled sizex sizey curcanvas + global link_list autorearrange_enabled sizex sizey curcanvas zoom set autorearrange_enabled 1 - .menubar.tools entryconfigure "Rearrange all" -state disabled - .menubar.tools entryconfigure "Rearrange selected" -state disabled + .menubar.tools entryconfigure "Auto rearrange all" -state disabled + .menubar.tools entryconfigure "Auto rearrange selected" -state disabled .bottom.mbuf config -text "autorearrange" if { $mode == "selected" } { - set tagmatch "node && selected" + set tagmatch "node && selected" } else { - set tagmatch "node" + set tagmatch "node" } set otime [clock clicks -milliseconds] while { $autorearrange_enabled } { - set ntime [clock clicks -milliseconds] - if { $otime == $ntime } { - set dt 0.001 - } else { - set dt [expr ($ntime - $otime) * 0.001] - if { $dt > 0.2 } { - set dt 0.2 - } - set otime $ntime - } - - set objects [.c find withtag $tagmatch] - set peer_objects [.c find withtag node] - foreach obj $peer_objects { - set node [lindex [.c gettags $obj] 1] - set coords [.c coords $obj] - set x [lindex $coords 0] - set y [lindex $coords 1] - set x_t($node) $x - set y_t($node) $y - - if { $x > 0 } { - set fx [expr 1000 / ($x * $x + 100)] - } else { - set fx 10 - } - set dx [expr $sizex - $x] - if { $dx > 0 } { - set fx [expr $fx - 1000 / ($dx * $dx + 100)] - } else { - set fx [expr $fx - 10] - } + set ntime [clock clicks -milliseconds] + if { $otime == $ntime } { + set dt 0.001 + } else { + set dt [expr {($ntime - $otime) * 0.001}] + if { $dt > 0.2 } { + set dt 0.2 + } + set otime $ntime + } - if { $y > 0 } { - set fy [expr 1000 / ($y * $y + 100)] - } else { - set fy 10 - } - set dy [expr $sizey - $y] - if { $dy > 0 } { - set fy [expr $fy - 1000 / ($dy * $dy + 100)] - } else { - set fy [expr $fy - 10] - } - set fx_t($node) $fx - set fy_t($node) $fy - } - - foreach obj $objects { - set node [lindex [.c gettags $obj] 1] - set i [lsearch -exact $peer_objects $obj] - set peer_objects [lreplace $peer_objects $i $i] - set x $x_t($node) - set y $y_t($node) - foreach other_obj $peer_objects { - set other [lindex [.c gettags $other_obj] 1] - set o_x $x_t($other) - set o_y $y_t($other) - set dx [expr $x - $o_x] - set dy [expr $y - $o_y] - set d [expr hypot($dx, $dy)] - set d2 [expr $d * $d] - set p_fx [expr 1000.0 * $dx / ($d2 * $d + 100)] - set p_fy [expr 1000.0 * $dy / ($d2 * $d + 100)] - if {[linkByPeers $node $other] != ""} { - set p_fx [expr $p_fx - $dx * $d2 * .0000000005] - set p_fy [expr $p_fy - $dy * $d2 * .0000000005] - } - set fx_t($node) [expr $fx_t($node) + $p_fx] - set fy_t($node) [expr $fy_t($node) + $p_fy] - set fx_t($other) [expr $fx_t($other) - $p_fx] - set fy_t($other) [expr $fy_t($other) - $p_fy] - } + set objects [.c find withtag $tagmatch] + set peer_objects [.c find withtag node] + foreach obj $peer_objects { + set node [lindex [.c gettags $obj] 1] + set coords [.c coords $obj] + set x [expr {[lindex $coords 0] / $zoom}] + set y [expr {[lindex $coords 1] / $zoom}] + set x_t($node) $x + set y_t($node) $y + + if { $x > 0 } { + set fx [expr {1000 / ($x * $x + 100)}] + } else { + set fx 10 + } + set dx [expr {$sizex - $x}] + if { $dx > 0 } { + set fx [expr {$fx - 1000 / ($dx * $dx + 100)}] + } else { + set fx [expr {$fx - 10}] + } + + if { $y > 0 } { + set fy [expr {1000 / ($y * $y + 100)}] + } else { + set fy 10 + } + set dy [expr {$sizey - $y}] + if { $dy > 0 } { + set fy [expr {$fy - 1000 / ($dy * $dy + 100)}] + } else { + set fy [expr {$fy - 10}] + } + set fx_t($node) $fx + set fy_t($node) $fy + } - foreach link $link_list { - set nodes [linkPeers $link] - if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas || - [getNodeCanvas [lindex $nodes 1]] != $curcanvas || - [getLinkMirror $link] != "" } { - continue - } - set peers [linkPeers $link] - set coords0 [getNodeCoords [lindex $peers 0]] - set coords1 [getNodeCoords [lindex $peers 1]] - set o_x [expr ([lindex $coords0 0] + [lindex $coords1 0]) * .5] - set o_y [expr ([lindex $coords0 1] + [lindex $coords1 1]) * .5] - set dx [expr $x - $o_x] - set dy [expr $y - $o_y] - set d [expr hypot($dx, $dy)] - set d2 [expr $d * $d] - set fx_t($node) \ - [expr $fx_t($node) + 500.0 * $dx / ($d2 * $d + 100)] - set fy_t($node) \ - [expr $fy_t($node) + 500.0 * $dy / ($d2 * $d + 100)] - } - } + foreach obj $objects { + set node [lindex [.c gettags $obj] 1] + set i [lsearch -exact $peer_objects $obj] + set peer_objects [lreplace $peer_objects $i $i] + set x $x_t($node) + set y $y_t($node) + foreach other_obj $peer_objects { + set other [lindex [.c gettags $other_obj] 1] + set o_x $x_t($other) + set o_y $y_t($other) + set dx [expr {$x - $o_x}] + set dy [expr {$y - $o_y}] + set d [expr {hypot($dx, $dy)}] + set d2 [expr {$d * $d}] + set p_fx [expr {1000.0 * $dx / ($d2 * $d + 100)}] + set p_fy [expr {1000.0 * $dy / ($d2 * $d + 100)}] + if {[linkByPeers $node $other] != ""} { + set p_fx [expr {$p_fx - $dx * $d2 * .0000000005}] + set p_fy [expr {$p_fy - $dy * $d2 * .0000000005}] + } + set fx_t($node) [expr {$fx_t($node) + $p_fx}] + set fy_t($node) [expr {$fy_t($node) + $p_fy}] + set fx_t($other) [expr {$fx_t($other) - $p_fx}] + set fy_t($other) [expr {$fy_t($other) - $p_fy}] + } + + foreach link $link_list { + set nodes [linkPeers $link] + if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas || + [getNodeCanvas [lindex $nodes 1]] != $curcanvas || + [getLinkMirror $link] != "" } { + continue + } + set peers [linkPeers $link] + set coords0 [getNodeCoords [lindex $peers 0]] + set coords1 [getNodeCoords [lindex $peers 1]] + set o_x \ + [expr {([lindex $coords0 0] + [lindex $coords1 0]) * .5}] + set o_y \ + [expr {([lindex $coords0 1] + [lindex $coords1 1]) * .5}] + set dx [expr {$x - $o_x}] + set dy [expr {$y - $o_y}] + set d [expr {hypot($dx, $dy)}] + set d2 [expr {$d * $d}] + set fx_t($node) \ + [expr {$fx_t($node) + 500.0 * $dx / ($d2 * $d + 100)}] + set fy_t($node) \ + [expr {$fy_t($node) + 500.0 * $dy / ($d2 * $d + 100)}] + } + } - foreach obj $objects { - set node [lindex [.c gettags $obj] 1] - if { [catch "set v_t($node)" v] } { - set vx 0.0 - set vy 0.0 - } else { - set vx [lindex $v_t($node) 0] - set vy [lindex $v_t($node) 1] - } - set vx [expr $vx + 1000.0 * $fx_t($node) * $dt] - set vy [expr $vy + 1000.0 * $fy_t($node) * $dt] - set dampk [expr 0.5 + ($vx * $vx + $vy * $vy) * 0.00001] - set vx [expr $vx * exp( - $dampk * $dt)] - set vy [expr $vy * exp( - $dampk * $dt)] - set dx [expr $vx * $dt] - set dy [expr $vy * $dt] - set x [expr $x_t($node) + $dx] - set y [expr $y_t($node) + $dy] - set v_t($node) "$vx $vy" - - setNodeCoords $node "$x $y" - .c move $obj $dx $dy - set img [.c find withtag "selectmark && $node"] - .c move $img $dx $dy - set img [.c find withtag "nodelabel && $node"] - .c move $img $dx $dy - setNodeLabelCoords $node [.c coords $img] - .c addtag need_redraw withtag "link && $node" - } - foreach link [.c find withtag "link && need_redraw"] { - redrawLink [lindex [.c gettags $link] 1] - } - .c dtag link need_redraw - update + foreach obj $objects { + set node [lindex [.c gettags $obj] 1] + if { [catch "set v_t($node)" v] } { + set vx 0.0 + set vy 0.0 + } else { + set vx [lindex $v_t($node) 0] + set vy [lindex $v_t($node) 1] + } + set vx [expr {$vx + 1000.0 * $fx_t($node) * $dt}] + set vy [expr {$vy + 1000.0 * $fy_t($node) * $dt}] + set dampk [expr {0.5 + ($vx * $vx + $vy * $vy) * 0.00001}] + set vx [expr {$vx * exp( - $dampk * $dt)}] + set vy [expr {$vy * exp( - $dampk * $dt)}] + set dx [expr {$vx * $dt}] + set dy [expr {$vy * $dt}] + set x [expr {$x_t($node) + $dx}] + set y [expr {$y_t($node) + $dy}] + set v_t($node) "$vx $vy" + + setNodeCoords $node "$x $y" + set e_dx [expr {$dx * $zoom}] + set e_dy [expr {$dy * $zoom}] + .c move $obj $e_dx $e_dy + set img [.c find withtag "selectmark && $node"] + .c move $img $e_dx $e_dy + set img [.c find withtag "nodelabel && $node"] + .c move $img $e_dx $e_dy + set x [expr {[lindex [.c coords $img] 0] / $zoom}] + set y [expr {[lindex [.c coords $img] 1] / $zoom}] + setNodeLabelCoords $node "$x $y" + .c addtag need_redraw withtag "link && $node" + } + foreach link [.c find withtag "link && need_redraw"] { + redrawLink [lindex [.c gettags $link] 1] + } + .c dtag link need_redraw + update } - .menubar.tools entryconfigure "Rearrange all" -state normal - .menubar.tools entryconfigure "Rearrange selected" -state normal + .menubar.tools entryconfigure "Auto rearrange all" -state normal + .menubar.tools entryconfigure "Auto rearrange selected" -state normal .bottom.mbuf config -text "" - return } @@ -2705,6 +2824,7 @@ proc rearrange { mode } { #**** proc switchCanvas { direction } { global canvas_list curcanvas + global sizex sizey set i [lsearch $canvas_list $curcanvas] switch -exact -- $direction { @@ -2739,15 +2859,15 @@ proc switchCanvas { direction } { -text "[getCanvasName $canvas]" -tags "text $canvas"] set ox [lindex [.hframe.t bbox $text] 2] set oy [lindex [.hframe.t bbox $text] 3] - set tab [.hframe.t create polygon $x 0 [expr $x + 7] 18 \ - [expr $x + 2 * $ox + 17] 18 [expr $x + 2 * $ox + 24] 0 $x 0 \ + set tab [.hframe.t create polygon $x 0 [expr {$x + 7}] 18 \ + [expr {$x + 2 * $ox + 17}] 18 [expr {$x + 2 * $ox + 24}] 0 $x 0 \ -fill gray -tags "tab $canvas"] - set line [.hframe.t create line 0 0 $x 0 [expr $x + 7] 18 \ - [expr $x + 2 * $ox + 17] 18 [expr $x + 2 * $ox + 24] 0 999 0 \ + set line [.hframe.t create line 0 0 $x 0 [expr {$x + 7}] 18 \ + [expr {$x + 2 * $ox + 17}] 18 [expr {$x + 2 * $ox + 24}] 0 999 0 \ -fill #808080 -width 2 -tags "line $canvas"] - .hframe.t coords $text [expr $x + $ox + 12] [expr $oy + 2] + .hframe.t coords $text [expr {$x + $ox + 12}] [expr {$oy + 2}] .hframe.t raise $text - incr x [expr 2 * $ox + 17] + incr x [expr {2 * $ox + 17}] } incr x 7 .hframe.t raise "$curcanvas" @@ -2757,17 +2877,19 @@ proc switchCanvas { direction } { set width [lindex [.hframe.t configure -width] 4] set lborder [lindex [.hframe.t bbox "tab && $curcanvas"] 0] set rborder [lindex [.hframe.t bbox "tab && $curcanvas"] 2] - set lmargin [expr [lindex [.hframe.t xview] 0] * $x - 1] - set rmargin [expr [lindex [.hframe.t xview] 1] * $x + 1] + set lmargin [expr {[lindex [.hframe.t xview] 0] * $x - 1}] + set rmargin [expr {[lindex [.hframe.t xview] 1] * $x + 1}] if { $lborder < $lmargin } { - .hframe.t xview moveto [expr 1.0 * ($lborder - 10) / $x] + .hframe.t xview moveto [expr {1.0 * ($lborder - 10) / $x}] } if { $rborder > $rmargin } { - .hframe.t xview moveto [expr 1.0 * ($rborder - $width + 10) / $x] + .hframe.t xview moveto [expr {1.0 * ($rborder - $width + 10) / $x}] } + set sizex [lindex [getCanvasSize $curcanvas] 0] + set sizey [lindex [getCanvasSize $curcanvas] 1] + redrawAll - return } @@ -2804,6 +2926,42 @@ proc renameCanvasPopup {} { pack $w.e1 -side top -pady 5 -padx 10 -fill x } +proc resizeCanvasPopup {} { + global curcanvas + + set w .entry1 + catch {destroy $w} + toplevel $w -takefocus 1 + update + grab $w + wm title $w "Canvas resize" + wm iconname $w "Canvas resize" + + label $w.msg -wraplength 5i -justify left -text "Canvas size:" + pack $w.msg -side top + + frame $w.buttons + pack $w.buttons -side bottom -fill x -pady 2m + button $w.buttons.print -text "Apply" -command "resizeCanvasApply $w" + button $w.buttons.cancel -text "Cancel" -command "destroy $w" + pack $w.buttons.print $w.buttons.cancel -side left -expand 1 + + frame $w.size + pack $w.size -side top -fill x -pady 2m + spinbox $w.size.x -bg white -width 4 \ + -validate focus -invcmd "focusAndFlash %W" + $w.size.x insert 0 [lindex [getCanvasSize $curcanvas] 0] + $w.size.x configure -from 800 -to 4096 -increment 2 \ + -vcmd {checkIntRange %P 800 4096} + label $w.size.label -text "*" + spinbox $w.size.y -bg white -width 4 \ + -validate focus -invcmd "focusAndFlash %W" + $w.size.y insert 0 [lindex [getCanvasSize $curcanvas] 1] + $w.size.y configure -from 600 -to 4096 -increment 2 \ + -vcmd {checkIntRange %P 600 4096} + + pack $w.size.x $w.size.label $w.size.y -side left -pady 5 -padx 2 -fill x +} #****f* editor.tcl/renameCanvasApply # NAME @@ -2822,13 +2980,26 @@ proc renameCanvasApply { w } { set newname [$w.e1 get] destroy $w if { $newname != [getCanvasName $curcanvas] } { - set changed 1 + set changed 1 } setCanvasName $curcanvas $newname switchCanvas none updateUndoLog } +proc resizeCanvasApply { w } { + global curcanvas changed + + set x [$w.size.x get] + set y [$w.size.y get] + destroy $w + if { "$x $y" != [getCanvasSize $curcanvas] } { + set changed 1 + } + setCanvasSize $curcanvas $x $y + switchCanvas none + updateUndoLog +} #****f* editor.tcl/animate # NAME @@ -2845,15 +3016,14 @@ proc animate {} { .c itemconfigure "selectmark || selectbox" -dashoffset $animatephase incr animatephase 2 if { $animatephase == 100 } { - set animatephase 0 + set animatephase 0 } if { $oper_mode == "edit" } { - after 250 animate + after 250 animate } else { - after 1500 animate + after 1500 animate } - return } @@ -2987,7 +3157,7 @@ proc configRemoteHosts {} { enable_disable $wi after 100 { - grab .popup + grab .popup } ;# Apply and Cancel explicitly destroy $wi vwait forever @@ -3070,3 +3240,24 @@ proc enable_disable { wi } { } } + +proc zoom { dir } { + global zoom + + set stops ".25 .5 .75 1.0 1.5 2.0 4.0" + set i [lsearch $stops $zoom] + switch -exact -- $dir { + "down" { + if { $i >0 } { + set zoom [lindex $stops [expr $i - 1]] + redrawAll + } + } + "up" { + if { $i < [expr [llength $stops] - 1] } { + set zoom [lindex $stops [expr $i + 1]] + redrawAll + } + } + } +} diff --git a/exec.tcl b/exec.tcl index 8ee1ee2..b994ea9 100755 --- a/exec.tcl +++ b/exec.tcl @@ -60,11 +60,10 @@ proc nexec { args } { } if { $editor_only } { - tk_messageBox -title "Editor only" \ - -message "Running in editor only mode. Cannot execute commands. Please report this problem." \ - -type ok - ;#exit 5 - return "" + tk_messageBox -title "Editor only" \ + -message "Running in editor only mode." \ + -type ok + return } if { $remote_exec } { @@ -187,8 +186,6 @@ proc setOperMode { mode } { .menubar.tools entryconfigure "Rearrange selected" -state disabled .menubar.experiment entryconfigure "Execute" -state disabled .menubar.experiment entryconfigure "Terminate" -state normal - .menubar.experiment entryconfigure "Configure remote hosts" \ - -state disabled .menubar.edit entryconfigure "Undo" -state disabled .menubar.edit entryconfigure "Redo" -state disabled set oper_mode exec @@ -217,8 +214,6 @@ proc setOperMode { mode } { .menubar.experiment entryconfigure "Execute" -state normal } .menubar.experiment entryconfigure "Terminate" -state disabled - .menubar.experiment entryconfigure "Configure remote hosts" \ - -state normal .menubar.edit entryconfigure "Undo" -state normal .menubar.edit entryconfigure "Redo" -state normal set oper_mode edit diff --git a/host.tcl b/host.tcl index 7ec829c..a06ec46 100755 --- a/host.tcl +++ b/host.tcl @@ -179,7 +179,6 @@ proc $MODULE.shellcmd { node } { #**** proc $MODULE.instantiate { eid node } { l3node.instantiate $eid $node - return } @@ -198,7 +197,6 @@ proc $MODULE.instantiate { eid node } { #**** proc $MODULE.start { eid node } { l3node.start $eid $node - return } @@ -216,7 +214,6 @@ proc $MODULE.start { eid node } { #**** proc $MODULE.shutdown { eid node } { l3node.shutdown $eid $node - return } @@ -234,7 +231,6 @@ proc $MODULE.shutdown { eid node } { #**** proc $MODULE.destroy { eid node } { l3node.destroy $eid $node - return } diff --git a/hub.tcl b/hub.tcl index 57f5f42..e1839e0 100755 --- a/hub.tcl +++ b/hub.tcl @@ -84,7 +84,6 @@ proc $MODULE.instantiate { eid node } { catch {nexec ngctl name \[$id\]: "$eid\_$node"} } } - return } #****f* hub.tcl/hub.start @@ -100,7 +99,6 @@ proc $MODULE.instantiate { eid node } { # * node_id - id of the node (type of the node is hub) #**** proc $MODULE.start { eid node } { - return } #****f* hub.tcl/hub.shutdown @@ -116,7 +114,6 @@ proc $MODULE.start { eid node } { # * node_id - id of the node (type of the node is hub) #**** proc $MODULE.shutdown { eid node } { - return } #****f* hub.tcl/hub.destroy @@ -133,7 +130,6 @@ proc $MODULE.shutdown { eid node } { #**** proc $MODULE.destroy { eid node } { catch { nexec ngctl msg $eid\_$node: shutdown } - return } #****f* hub.tcl/hub.nghook diff --git a/imunes.tcl b/imunes.tcl index da7acbc..ba2c406 100755 --- a/imunes.tcl +++ b/imunes.tcl @@ -88,9 +88,9 @@ source "$ROOTDIR/$LIBDIR/linkcfg.tcl" source "$ROOTDIR/$LIBDIR/nodecfg.tcl" source "$ROOTDIR/$LIBDIR/ipv4.tcl" source "$ROOTDIR/$LIBDIR/ipv6.tcl" +source "$ROOTDIR/$LIBDIR/ipsec.tcl" source "$ROOTDIR/$LIBDIR/cfgparse.tcl" source "$ROOTDIR/$LIBDIR/exec.tcl" -#source "$ROOTDIR/$LIBDIR/partition.tcl" source "$ROOTDIR/$LIBDIR/canvas.tcl" source "$ROOTDIR/$LIBDIR/quagga.tcl" @@ -108,7 +108,6 @@ source "$ROOTDIR/$LIBDIR/filemgmt.tcl" source "$ROOTDIR/$LIBDIR/ns2imunes.tcl" -source "$ROOTDIR/$LIBDIR/ipsec.tcl" # # Global variables are initialized here @@ -251,6 +250,7 @@ readConfigFile if {$execMode == "interactive"} { source "$ROOTDIR/$LIBDIR/initgui.tcl" + source "$ROOTDIR/$LIBDIR/topogen.tcl" setOperMode edit fileOpenStartUp } else { diff --git a/initgui.tcl b/initgui.tcl index 69c71cc..c470a76 100755 --- a/initgui.tcl +++ b/initgui.tcl @@ -116,25 +116,24 @@ set cursorState 0 set clock_seconds 0 set oper_mode edit set grid 24 -set sizex 900 -set sizey 620 +set zoom 1.0 set curcanvas [lindex $canvas_list 0] set autorearrange_enabled 0 # # Initialize a few variables to default values # -set defLinkColor red +set defLinkColor Red set defLinkWidth 2 set defEthBandwidth 100000000 set defSerBandwidth 2048000 set defSerDelay 2500 -set showIfNames 1 -set showIfIPaddrs 1 -set showIfIPv6addrs 1 + +set showIfNames 0 +set showIfIPaddrs 0 +set showIfIPv6addrs 0 set showNodeLabels 1 -set showLinkLabels 1 -global showIPsecConfig +set showLinkLabels 0 set showIPsecConfig 1 set supp_router_models "xorp quagga static" @@ -146,7 +145,7 @@ set def_router_model quagga # wm minsize . 640 400 -wm geometry . 800x600 +wm geometry . 1016x716 wm title . IMUNES menu .menubar @@ -155,8 +154,9 @@ menu .menubar .menubar add cascade -label File -underline 0 -menu .menubar.file .menubar add cascade -label Edit -underline 0 -menu .menubar.edit .menubar add cascade -label Canvas -underline 0 -menu .menubar.canvas -.menubar add cascade -label Tools -underline 0 -menu .menubar.tools .menubar add cascade -label View -underline 0 -menu .menubar.view +.menubar add cascade -label Tools -underline 0 -menu .menubar.tools +.menubar add cascade -label TopoGen -underline 0 -menu .menubar.t_g .menubar add cascade -label Experiment -underline 1 -menu .menubar.experiment .menubar add cascade -label Help -underline 0 -menu .menubar.help @@ -229,6 +229,9 @@ bind . { selectNode .c $obj } } +.menubar.edit add command -label "Select adjacent" \ + -accelerator "Ctrl+N" -command selectAdjacent +bind . selectAdjacent # @@ -261,6 +264,8 @@ menu .menubar.canvas -tearoff 0 updateUndoLog } .menubar.canvas add separator +.menubar.canvas add command -label "Resize" -command resizeCanvasPopup +.menubar.canvas add separator .menubar.canvas add command -label "Previous" -accelerator "PgUp" \ -command { switchCanvas prev } bind . { switchCanvas prev } @@ -279,11 +284,14 @@ bind . { switchCanvas last } # Tools # menu .menubar.tools -tearoff 0 -.menubar.tools add command -label "Rearrange all" -underline 0 \ +.menubar.tools add command -label "Auto rearrange all" -underline 0 \ -command { rearrange all } -.menubar.tools add command -label "Rearrange selected" -underline 0 \ +.menubar.tools add command -label "Auto rearrange selected" -underline 0 \ -command { rearrange selected } .menubar.tools add separator +.menubar.tools add command -label "Align to grid" -underline 0 \ + -command { align2grid } +.menubar.tools add separator .menubar.tools add command -label "ns2imunes converter" \ -underline 0 -command { toplevel .ns2im-dialog @@ -349,8 +357,7 @@ menu .menubar.view -tearoff 0 } } .menubar.view add command -label "Show All" \ - -underline 5 \ - -command { + -underline 5 -command { set showIfNames 1 set showIfIPaddrs 1 set showIfIPv6addrs 1 @@ -361,9 +368,30 @@ menu .menubar.view -tearoff 0 .c itemconfigure $object -state normal } } +.menubar.view add command -label "Show None" \ + -underline 6 -command { + set showIfNames 0 + set showIfIPaddrs 0 + set showIfIPv6addrs 0 + set showNodeLabels 0 + set showLinkLabels 0 + redrawAllLinks + foreach object [.c find withtag linklabel] { + .c itemconfigure $object -state hidden + } + } + +.menubar.view add separator +.menubar.view add command -label "Zoom In" -accelerator "+" \ + -command "zoom up" +bind . "+" "zoom up" +.menubar.view add command -label "Zoom Out" -accelerator "-" \ + -command "zoom down" +bind . "-" "zoom down" + .menubar.view add separator .menubar.view add checkbutton -label "Show IPsec config" \ - -underline 5 -variable showIPsecConfig + -variable showIPsecConfig # # Experiment @@ -373,9 +401,6 @@ menu .menubar.experiment -tearoff 0 -command "setOperMode exec" .menubar.experiment add command -label "Terminate" -underline 0 \ -command "setOperMode edit" -state disabled -.menubar.experiment add separator -.menubar.experiment add command -label "Configure remote hosts" -underline 0 \ - -command "configRemoteHosts" # @@ -404,7 +429,18 @@ foreach b {select link hub lanswitch router host pc rj45} { set image [image create photo -file $ROOTDIR/$LIBDIR/icons/tiny/$b.gif] radiobutton .left.$b -indicatoron 0 \ -variable activetool -value $b -selectcolor [.left cget -bg] \ - -width 32 -height 32 -activebackground gray -image $image + -width 32 -height 32 -activebackground gray -image $image \ + -command { + global activetool + if { [lsearch "router pc host" $activetool] <0 } { + set state disabled + } else { + set state normal + } + for { set i 0 } { $i <= [.menubar.t_g index last] } { incr i } { + .menubar.t_g entryconfigure $i -state $state + } + } pack .left.$b -side top } foreach b {router host pc hub lanswitch frswitch rj45} { @@ -420,7 +456,6 @@ frame .hframe frame .vframe set c [canvas .c -bd 0 -relief sunken -highlightthickness 0\ -background gray \ - -scrollregion "-32 -32 [expr $sizex + 32] [expr $sizey + 32]" \ -xscrollcommand ".hframe.scroll set" \ -yscrollcommand ".vframe.scroll set"] canvas .hframe.t -width 300 -height 18 -bd 0 -highlightthickness 0 \ @@ -466,11 +501,12 @@ grid .hframe -in .grid -row 1 -column 0 \ frame .bottom pack .bottom -side bottom -fill x label .bottom.textbox -relief sunken -bd 1 -anchor w -width 999 +label .bottom.zoom -relief sunken -bd 1 -anchor w -width 10 label .bottom.cpu_load -relief sunken -bd 1 -anchor w -width 9 label .bottom.mbuf -relief sunken -bd 1 -anchor w -width 15 label .bottom.oper_mode -relief sunken -bd 1 -anchor w -width 9 -pack .bottom.oper_mode .bottom.mbuf .bottom.cpu_load .bottom.textbox \ - -side right -padx 0 -fill both +pack .bottom.oper_mode .bottom.mbuf .bottom.cpu_load \ + .bottom.zoom .bottom.textbox -side right -padx 0 -fill both # diff --git a/install.sh b/install.sh index d136b97..93adb43 100755 --- a/install.sh +++ b/install.sh @@ -25,7 +25,8 @@ chmod 755 $ROOTDIR/$BINDIR/imunes lib_files="nodecfg.tcl linkcfg.tcl cfgparse.tcl ipv4.tcl ipv6.tcl exec.tcl \ canvas.tcl editor.tcl filemgmt.tcl help.tcl initgui.tcl \ quagga.tcl xorp.tcl static.tcl pc.tcl host.tcl \ - lanswitch.tcl rj45.tcl hub.tcl ns2imunes.tcl ipsec.tcl" + lanswitch.tcl rj45.tcl hub.tcl ns2imunes.tcl ipsec.tcl \ + topogen.tcl" tiny_icons="delete.gif hub.gif frswitch.gif host.gif \ lanswitch.gif link.gif pc.gif rj45.gif router.gif select.gif" diff --git a/ipv4.tcl b/ipv4.tcl index 6541492..dda20ae 100755 --- a/ipv4.tcl +++ b/ipv4.tcl @@ -97,7 +97,7 @@ proc autoIPv4addr { node iface } { # Shouldn't get called at all for link-layer nodes # puts "autoIPv4 called for a [[typemodel $node].layer] layer node" - return "" + return } setIfcIPv4addr $node $iface "" @@ -142,7 +142,6 @@ proc autoIPv4addr { node iface } { } else { setIfcIPv4addr $node $iface "[findFreeIPv4Net 24].$targetbyte/24" } - return } diff --git a/ipv6.tcl b/ipv6.tcl index 12ecfba..6a4e920 100755 --- a/ipv6.tcl +++ b/ipv6.tcl @@ -131,7 +131,6 @@ proc autoIPv6addr { node iface } { } else { setIfcIPv6addr $node $iface "[findFreeIPv6Net 64]::$targetbyte/64" } - return } #****f* ipv6.tcl/autoIPv6defaultroute diff --git a/lanswitch.tcl b/lanswitch.tcl index e977296..8a3ca7a 100755 --- a/lanswitch.tcl +++ b/lanswitch.tcl @@ -84,7 +84,6 @@ proc $MODULE.instantiate { eid node } { catch {nexec ngctl name \[$id\]: "$eid\_$node"} } } - return } @@ -101,7 +100,6 @@ proc $MODULE.instantiate { eid node } { # * node_id - id of the node (type of the node is lanswitch) #**** proc $MODULE.start { eid node } { - return } @@ -118,7 +116,6 @@ proc $MODULE.start { eid node } { # * node_id - id of the node (type of the node is lanswitch) #**** proc $MODULE.shutdown { eid node } { - return } #****f* lanswitch.tcl/lanswitch.destroy @@ -135,7 +132,6 @@ proc $MODULE.shutdown { eid node } { #**** proc $MODULE.destroy { eid node } { catch { nexec ngctl msg $eid\_$node: shutdown } - return } diff --git a/linkcfg.tcl b/linkcfg.tcl index 81ae411..59a097d 100755 --- a/linkcfg.tcl +++ b/linkcfg.tcl @@ -121,7 +121,6 @@ proc linkByPeers { node1 node2 } { return $link } } - return } #****f* linkcfg.tcl/removeLink @@ -157,7 +156,6 @@ proc removeLink { link } { } set i [lsearch -exact $link_list $link] set link_list [lreplace $link_list $i $i] - return } #****f* linkcfg.tcl/getLinkBandwidth @@ -201,15 +199,15 @@ proc getLinkBandwidthString { link } { set bandwidth [getLinkBandwidth $link] if { "$bandwidth" != "" } { if { $bandwidth >= 660000000 } { - set bandstr "[format %.2f [expr $bandwidth / 1000000000.0]] Gbps" + set bandstr "[format %.2f [expr {$bandwidth / 1000000000.0}]] Gbps" } elseif { $bandwidth >= 99000000 } { - set bandstr "[format %d [expr $bandwidth / 1000000]] Mbps" + set bandstr "[format %d [expr {$bandwidth / 1000000}]] Mbps" } elseif { $bandwidth >= 9900000 } { - set bandstr "[format %.2f [expr $bandwidth / 1000000.0]] Mbps" + set bandstr "[format %.2f [expr {$bandwidth / 1000000.0}]] Mbps" } elseif { $bandwidth >= 990000 } { - set bandstr "[format %d [expr $bandwidth / 1000]] Kbps" + set bandstr "[format %d [expr {$bandwidth / 1000}]] Kbps" } elseif { $bandwidth >= 9900 } { - set bandstr "[format %.2f [expr $bandwidth / 1000.0]] Kbps" + set bandstr "[format %.2f [expr {$bandwidth / 1000.0}]] Kbps" } else { set bandstr "$bandwidth bps" } @@ -240,6 +238,45 @@ proc setLinkBandwidth { link value } { } } +# +# Marko - XXX document! +# +proc getLinkColor { link } { + global $link defLinkColor + + set entry [lsearch -inline [set $link] "color *"] + if { $entry == "" } { + return $defLinkColor + } else { + return [lindex $entry 1] + } +} + +proc setLinkColor { link value } { + global $link + + set i [lsearch [set $link] "color *"] + set $link [lreplace [set $link] $i $i "color $value"] +} + +proc getLinkWidth { link } { + global $link defLinkWidth + + set entry [lsearch -inline [set $link] "width *"] + if { $entry == "" } { + return $defLinkWidth + } else { + return [lindex $entry 1] + } +} + +proc setLinkWidth { link value } { + global $link + + set i [lsearch [set $link] "width *"] + set $link [lreplace [set $link] $i $i "width $value"] +} + #****f* linkcfg.tcl/getLinkDelay # NAME # getLinkDelay -- get link delay @@ -281,9 +318,9 @@ proc getLinkDelayString { link } { set delay [getLinkDelay $link] if { "$delay" != "" } { if { $delay >= 10000 } { - set delstr "[expr $delay / 1000] ms" + set delstr "[expr {$delay / 1000}] ms" } elseif { $delay >= 1000 } { - set delstr "[expr (1.0 * $delay) / 1000] ms" + set delstr "[expr {$delay * .001}] ms" } else { set delstr "$delay us" } @@ -314,7 +351,6 @@ proc setLinkDelay { link value } { } else { set $link [lreplace [set $link] $i $i "delay $value"] } - return } #****f* linkcfg.tcl/getLinkBER @@ -358,7 +394,6 @@ proc setLinkBER { link value } { } else { set $link [lreplace [set $link] $i $i "ber $value"] } - return } #****f* linkcfg.tcl/getLinkDup @@ -402,7 +437,6 @@ proc setLinkDup { link value } { } else { set $link [lreplace [set $link] $i $i "duplicate $value"] } - return } #****f* linkcfg.tcl/getLinkMirror @@ -451,7 +485,6 @@ proc setLinkMirror { link value } { } else { set $link [lreplace [set $link] $i $i "mirror $value"] } - return } #****f* linkcfg.tcl/splitLink @@ -631,7 +664,7 @@ proc newLink { lnode1 lnode2 } { set othernode $lnode1 } if { [lsearch {router lanswitch hub pc host} \ - [nodeType $othernode]] < 0} { + [nodeType $othernode]] < 0} { return } if { [lsearch [set $rj45node] "interface-peer *"] > 0 } { diff --git a/nodecfg.tcl b/nodecfg.tcl index bb0894f..f8d0d42 100755 --- a/nodecfg.tcl +++ b/nodecfg.tcl @@ -306,7 +306,6 @@ proc setCustomEnabled { node enabled } { if { $enabled == true } { lappend $node [list custom-enabled $enabled] } - return } #****f* nodecfg.tcl/getCustomCmd @@ -349,7 +348,6 @@ proc setCustomCmd { node cmd } { } lappend $node [list custom-command $cmd] - return } #****f* nodecfg.tcl/getCustomConfig @@ -440,7 +438,6 @@ proc setCustomConfig { node id cmd cfg delete } { [list $newid $newcmd $newcfg] ] } } - return } #****f* nodecfg.tcl/deleteCustomConfig @@ -575,7 +572,6 @@ proc netconfInsertSection { node section } { } } set $node [lreplace [set $node] $i $i [list network-config $netconf]] - return } #****f* nodecfg.tcl/getIfcOperState @@ -627,7 +623,6 @@ proc setIfcOperState { node ifc state } { } } netconfInsertSection $node $ifcfg - return } #****f* nodecfg.tcl/getIfcQDisc @@ -685,7 +680,6 @@ proc setIfcQDisc { node ifc qdisc } { } } netconfInsertSection $node $ifcfg - return } #****f* nodecfg.tcl/getIfcQDrop @@ -739,7 +733,6 @@ proc setIfcQDrop { node ifc qdrop } { } } netconfInsertSection $node $ifcfg - return } #****f* nodecfg.tcl/getIfcQLen @@ -789,7 +782,6 @@ proc setIfcQLen { node ifc len } { lappend ifcfg " queue-len $len" } netconfInsertSection $node $ifcfg - return } #****f* nodecfg.tcl/getIfcMTU @@ -847,7 +839,6 @@ proc setIfcMTU { node ifc mtu } { lappend ifcfg " mtu $mtu" } netconfInsertSection $node $ifcfg - return } #****f* nodecfg.tcl/getIfcIPv4addr @@ -899,7 +890,6 @@ proc setIfcIPv4addr { node ifc addr } { lappend ifcfg " ip address $addr" } netconfInsertSection $node $ifcfg - return } #****f* nodecfg.tcl/getIfcIPv6addr @@ -951,7 +941,6 @@ proc setIfcIPv6addr { node ifc addr } { lappend ifcfg " ipv6 address $addr" } netconfInsertSection $node $ifcfg - return } #****f* nodecfg.tcl/getStatIPv4routes @@ -999,7 +988,6 @@ proc setStatIPv4routes { node routes } { lappend section "ip route $route" } netconfInsertSection $node $section - return } #****f* nodecfg.tcl/getStatIPv6routes @@ -1048,7 +1036,6 @@ proc setStatIPv6routes { node routes } { } netconfInsertSection $node $section - return } #****f* nodecfg.tcl/getNodeName @@ -1086,7 +1073,6 @@ proc getNodeName { node } { proc setNodeName { node name } { netconfClearSection $node "hostname [getNodeName $node]" netconfInsertSection $node [list "hostname $name"] - return } #****f* nodecfg.tcl/getNodeType @@ -1150,7 +1136,6 @@ proc setNodeModel { node model } { } else { set $node [linsert [set $node] 1 "model $model"] } - return } #****f* nodecfg.tcl/getNodeCoords @@ -1194,7 +1179,6 @@ proc setNodeCoords { node coords } { } else { set $node [linsert [set $node] end "iconcoords {$coords}"] } - return } #****f* nodecfg.tcl/getNodeLabelCoords @@ -1237,7 +1221,6 @@ proc setNodeLabelCoords { node coords } { } else { set $node [linsert [set $node] end "labelcoords {$coords}"] } - return } #****f* nodecfg.tcl/getNodeCPUConf @@ -1286,7 +1269,6 @@ proc setNodeCPUConf { node param_list } { set $node [linsert [set $node] 1 "cpu $param_list"] } } - return } #****f* nodecfg.tcl/ifcList @@ -1496,7 +1478,6 @@ proc removeNode { node } { } set i [lsearch -exact $node_list $node] set node_list [lreplace $node_list $i $i] - return } #****f* nodecfg.tcl/getNodeCanvas @@ -1539,7 +1520,6 @@ proc setNodeCanvas { node canvas } { } else { set $node [linsert [set $node] end "canvas $canvas"] } - return } #****f* nodecfg.tcl/newIfc @@ -1587,7 +1567,7 @@ proc newNode { type } { if { $type == "router" } { lappend $node "model $def_router_model" set nconfig [list \ - "hostname $type[string range $node 1 end]" \ + "hostname $node" \ ! \ "router rip" \ " redistribute static" \ @@ -1605,7 +1585,7 @@ proc newNode { type } { ! ] } else { set nconfig [list \ - "hostname $type[string range $node 1 end]" \ + "hostname $node" \ ! ] } lappend $node "network-config [list $nconfig]" @@ -1659,7 +1639,6 @@ proc setNodeMirror { node value } { } else { set $node [linsert [set $node] end "mirror $value"] } - return } @@ -1741,5 +1720,4 @@ proc setType { node type } { } else { set $node [linsert [set $node] 1 "type $type"] } - return } diff --git a/pc.tcl b/pc.tcl index 084d12f..8ce3b51 100755 --- a/pc.tcl +++ b/pc.tcl @@ -174,7 +174,6 @@ proc $MODULE.shellcmd { node } { proc $MODULE.instantiate { eid node } { l3node.instantiate $eid $node - return } @@ -193,7 +192,6 @@ proc $MODULE.instantiate { eid node } { #**** proc $MODULE.start { eid node } { l3node.start $eid $node - return } #****f* pc.tcl/pc.shutdown @@ -210,7 +208,6 @@ proc $MODULE.start { eid node } { #**** proc $MODULE.shutdown { eid node } { l3node.shutdown $eid $node - return } @@ -228,7 +225,6 @@ proc $MODULE.shutdown { eid node } { #**** proc $MODULE.destroy { eid node } { l3node.destroy $eid $node - return } diff --git a/quagga.tcl b/quagga.tcl index cf22535..4a070d5 100755 --- a/quagga.tcl +++ b/quagga.tcl @@ -192,7 +192,6 @@ proc $MODULE.instantiate { eid node } { l3node.instantiate $eid $node nexec vimage $node_id sysctl net.inet.ip.forwarding=1 catch { nexec vimage $node_id sysctl net.inet6.ip6.forwarding=1 } - return } @@ -211,7 +210,6 @@ proc $MODULE.instantiate { eid node } { #**** proc $MODULE.start { eid node } { l3node.start $eid $node - return } @@ -229,7 +227,6 @@ proc $MODULE.start { eid node } { #**** proc $MODULE.shutdown { eid node } { l3node.shutdown $eid $node - return } @@ -247,7 +244,6 @@ proc $MODULE.shutdown { eid node } { #**** proc $MODULE.destroy { eid node } { l3node.destroy $eid $node - return } diff --git a/rj45.tcl b/rj45.tcl index 40afff2..2986dd6 100755 --- a/rj45.tcl +++ b/rj45.tcl @@ -78,7 +78,6 @@ proc $MODULE.layer {} { proc $MODULE.instantiate { eid node } { set ifname [getNodeName $node] nexec ifconfig $ifname up promisc - return } @@ -95,7 +94,6 @@ proc $MODULE.instantiate { eid node } { # * node_id - id of the node (type of the node is rj45) #**** proc $MODULE.start { eid node } { - return } @@ -112,7 +110,6 @@ proc $MODULE.start { eid node } { # * node_id - id of the node (type of the node is rj45) #**** proc $MODULE.shutdown { eid node } { - return } @@ -130,7 +127,6 @@ proc $MODULE.shutdown { eid node } { proc $MODULE.destroy { eid node } { set ifname [getNodeName $node] nexec ifconfig $ifname up -promisc - return } #****f* rj45.tcl/rj45.nghook diff --git a/static.tcl b/static.tcl index 366aee9..0701b57 100755 --- a/static.tcl +++ b/static.tcl @@ -187,7 +187,6 @@ proc $MODULE.instantiate { eid node } { l3node.instantiate $eid $node nexec vimage $node_id sysctl net.inet.ip.forwarding=1 catch { nexec vimage $node_id sysctl net.inet6.ip6.forwarding=1 } - return } #****f* static.tcl/router.static.start @@ -205,7 +204,6 @@ proc $MODULE.instantiate { eid node } { #**** proc $MODULE.start { eid node } { l3node.start $eid $node - return } #****f* static.tcl/router.static.shutdown @@ -222,7 +220,6 @@ proc $MODULE.start { eid node } { #**** proc $MODULE.shutdown { eid node } { l3node.shutdown $eid $node - return } @@ -240,7 +237,6 @@ proc $MODULE.shutdown { eid node } { #**** proc $MODULE.destroy { eid node } { l3node.destroy $eid $node - return } diff --git a/topogen.tcl b/topogen.tcl new file mode 100755 index 0000000..02bb535 --- /dev/null +++ b/topogen.tcl @@ -0,0 +1,251 @@ +# +# Copyright 2007 University of Zagreb, Croatia. All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions +# are met: +# 1. Redistributions of source code must retain the above copyright +# notice, this list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright +# notice, this list of conditions and the following disclaimer in the +# documentation and/or other materials provided with the distribution. +# 3. All advertising materials mentioning features or use of this software +# must display the following acknowledgement: +# This product includes software developed by the University of Zagreb, +# Croatia and its contributors. +# 4. Neither the name of the University nor the names of its contributors +# may be used to endorse or promote products derived from this software +# without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY AND CONTRIBUTORS ``AS IS'' AND +# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +# ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +# SUCH DAMAGE. +# + +menu .menubar.t_g -tearoff 0 + +set m .menubar.t_g.chain +menu $m -tearoff 0 +.menubar.t_g add cascade -label "Chain" -menu $m -underline 0 -state disabled +for { set i 2 } { $i <= 24 } { incr i } { + $m add command -label "P($i)" -command "P $i" +} + +set m .menubar.t_g.star +menu $m -tearoff 0 +.menubar.t_g add cascade -label "Star" -menu $m -underline 0 -state disabled +for { set i 3 } { $i <= 25 } { incr i } { + $m add command -label "S($i)" -command "S $i" +} + +set m .menubar.t_g.cycle +menu $m -tearoff 0 +.menubar.t_g add cascade -label "Cycle" -menu $m -underline 0 -state disabled +for { set i 3 } { $i <= 24 } { incr i } { + $m add command -label "C($i)" -command "C $i" +} + +set m .menubar.t_g.wheel +menu $m -tearoff 0 +.menubar.t_g add cascade -label "Wheel" -menu $m -underline 0 -state disabled +for { set i 4 } { $i <= 25 } { incr i } { + $m add command -label "W($i)" -command "W $i" +} + +set m .menubar.t_g.cube +menu $m -tearoff 0 +.menubar.t_g add cascade -label "Cube" -menu $m -underline 0 -state disabled +for { set i 2 } { $i <= 6 } { incr i } { + $m add command -label "Q($i)" -command "Q $i" +} + +set m .menubar.t_g.clique +menu $m -tearoff 0 +.menubar.t_g add cascade -label "Clique" -menu $m -underline 0 -state disabled +for { set i 3 } { $i <= 24 } { incr i } { + $m add command -label "K($i)" -command "K $i" +} + +set m .menubar.t_g.bipartite +menu $m -tearoff 0 +.menubar.t_g add cascade -label "Bipartite" -menu $m -underline 0 \ + -state disabled +for { set i 1 } { $i <= 12 } { incr i } { + set n $m.$i + menu $n -tearoff 0 + $m add cascade -label "K($i,N)" -menu $n -underline 0 + for { set j $i } { $j <= [expr {24 - $i}] } { incr j } { + $n add command -label "K($i,$j)" -command "Kb $i $j" + } +} + + +proc newNodes { node_type n } { + global curcanvas grid sizex sizey + + set v {} + set r [expr {($n - 1) * (1 + 4 / $n) * $grid / 2}] + set x0 [expr {$sizex / 2}] + set y0 [expr {$sizey / 2}] + set twopidivn [expr {acos(0) * 4 / $n}] + if { $node_type == "router" } { + set dy 24 + } else { + set dy 32 + } + + for { set i 0 } { $i < $n } { incr i } { + set new_node [newNode $node_type] + set x [expr {$x0 + $r * cos($twopidivn * $i)}] + set y [expr {$y0 - $r * sin($twopidivn * $i)}] + setNodeCoords $new_node "$x $y" + setNodeLabelCoords $new_node "$x [expr {$y + $dy}]" + setNodeCanvas $new_node $curcanvas + lappend v $new_node + } + + return $v +} + +proc topoGenDone { nodes } { + global changed + + set changed 1 + updateUndoLog + redrawAll + selectNodes $nodes +} + +# +# Chain +# +proc P { n } { + global activetool + + .c config -cursor watch; update + + set v [newNodes $activetool $n] + for { set i 0 } { $i < [expr {$n - 1}] } { incr i } { + newLink [lindex $v $i] [lindex $v [expr {($i + 1) % $n}]] + } + + topoGenDone $v +} + +# +# Star +# +proc S { n } { + global activetool + + .c config -cursor watch; update + + incr n -1 + set cv [newNodes $activetool 1] + set v [newNodes $activetool $n] + for { set i 0 } { $i < $n } { incr i } { + newLink [lindex $v $i] $cv + } + + topoGenDone "$cv $v" +} + +# +# Cycle +# +proc C { n } { + global activetool + + .c config -cursor watch; update + + set v [newNodes $activetool $n] + for { set i 0 } { $i < $n } { incr i } { + newLink [lindex $v $i] [lindex $v [expr {($i + 1) % $n}]] + } + + topoGenDone $v +} + +# +# Wheel +# +proc W { n } { + global activetool + + .c config -cursor watch; update + + incr n -1 + set cv [newNodes $activetool 1] + set v [newNodes $activetool $n] + for { set i 0 } { $i < $n } { incr i } { + newLink [lindex $v $i] [lindex $v [expr {($i + 1) % $n}]] + newLink [lindex $v $i] $cv + } + + topoGenDone "$cv $v" +} + +# +# Cube +# +proc Q { order } { + global activetool + + .c config -cursor watch; update + + set n [expr {int(pow(2,$order))}] + set v [newNodes $activetool $n] + for { set i 0 } { $i < $order } { incr i } { + animateCursor + set d [expr {int(pow(2, $i))}] + for { set j 0 } { $j < $n } { incr j } { + if { [llength [ifcList [lindex $v $j]]] <= $i} { + newLink [lindex $v $j] [lindex $v [expr {($j + $d) % $n}]] + } + } + } + + topoGenDone $v +} + +# +# Clique +# +proc K { n } { + global activetool + + set v [newNodes $activetool $n] + for { set i 0 } { $i < [expr {$n - 1}] } { incr i } { + animateCursor + for { set j [expr {$i + 1}] } { $j < $n } {incr j } { + newLink [lindex $v $i] [lindex $v $j] + } + } + + topoGenDone $v +} + +# +# Bipartite +# +proc Kb { n m } { + global activetool + + set v [newNodes $activetool [expr {$n + $m}]] + for { set i 0 } { $i < $n } { incr i } { + animateCursor + for { set j 0 } { $j < $m } {incr j } { + newLink [lindex $v $i] [lindex $v [expr { $j + $n }]] + } + } + + topoGenDone $v +} diff --git a/xorp.tcl b/xorp.tcl index 146abe9..e4e63bc 100755 --- a/xorp.tcl +++ b/xorp.tcl @@ -270,7 +270,6 @@ proc $MODULE.instantiate { eid node } { l3node.instantiate $eid $node nexec vimage $node_id sysctl net.inet.ip.forwarding=1 catch { nexec vimage $node_id sysctl net.inet6.ip6.forwarding=1 } - return } @@ -289,7 +288,6 @@ proc $MODULE.instantiate { eid node } { #**** proc $MODULE.start { eid node } { l3node.start $eid $node - return } @@ -307,7 +305,6 @@ proc $MODULE.start { eid node } { #**** proc $MODULE.shutdown { eid node } { l3node.shutdown $eid $node - return } @@ -325,7 +322,6 @@ proc $MODULE.shutdown { eid node } { #**** proc $MODULE.destroy { eid node } { l3node.destroy $eid $node - return } -- 2.39.5