--- /dev/null
+#
+# Copyright 2004, 2005 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.
+#
+# This work was supported in part by the Croatian Ministry of Science
+# and Technology through the research contract #IP-2003-143.
+#
+
+
+proc animateCursor {} {
+ global cursorState
+ global clock_seconds
+
+ if { [clock seconds] == $clock_seconds } {
+ update
+ return
+ }
+ set clock_seconds [clock seconds]
+ if { $cursorState } {
+ .c config -cursor watch
+ set cursorState 0
+ } else {
+ .c config -cursor pirate
+ set cursorState 1
+ }
+ update
+ return
+}
+
+
+proc removeLink { link } {
+ global links $link
+ global .c
+
+ set nodes [lindex [lsearch -inline [set $link] "nodes *"] 1]
+ foreach node $nodes {
+ global $node
+ set i [lsearch $nodes $node]
+ set peer [lreplace $nodes $i $i]
+ set ifc [ifcByPeer $node $peer]
+ netconfClearSection $node "interface $ifc"
+ set i [lsearch [set $node] "interface-peer {$ifc $peer}"]
+ set $node [lreplace [set $node] $i $i]
+ }
+ unset $link
+ set i [lsearch -exact $links $link]
+ set links [lreplace $links $i $i]
+ .c delete $link
+ return
+}
+
+
+proc removeNode { node } {
+ global nodes $node
+ global .c
+
+ foreach ifc [ifcList $node] {
+ set peer [peerByIfc $node $ifc]
+ set link [lindex [.c gettags "link && $node && $peer"] 1]
+ removeLink $link
+ }
+ unset $node
+ set i [lsearch -exact $nodes $node]
+ set nodes [lreplace $nodes $i $i]
+ .c delete $node
+ return
+}
+
+
+proc dumpputs {method dest string} {
+ switch -exact -- $method {
+ file {
+ puts $dest $string
+ }
+ string {
+ global $dest
+ append $dest "$string\r"
+ }
+ }
+ return
+}
+
+
+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
+}
+
+
+proc dumpCfg {method dest} {
+ global nodes links
+ global showIfNames showIfIPaddrs showNodeLabels showLinkLabels
+
+ foreach node $nodes {
+ global $node
+ upvar 0 $node lnode
+ dumpputs $method $dest "node $node \{"
+ foreach element $lnode {
+ if { "[lindex $element 0]" == "network-config" } {
+ dumpputs $method $dest " network-config \{"
+ foreach line [lindex $element 1] {
+ dumpputs $method $dest " $line"
+ }
+ dumpputs $method $dest " \}"
+ } elseif { "[lindex $element 0]" == "custom-config" } {
+ dumpputs $method $dest " custom-config \{"
+ foreach line [lindex $element 1] {
+ dumpputs $method $dest " $line"
+ }
+ dumpputs $method $dest " \}"
+ } else {
+ dumpputs $method $dest " $element"
+ }
+ }
+ dumpputs $method $dest "\}"
+ dumpputs $method $dest ""
+ }
+
+ foreach link $links {
+ global $link
+ upvar 0 $link llink
+ dumpputs $method $dest "link $link \{"
+ foreach element $llink {
+ dumpputs $method $dest " $element"
+ }
+ dumpputs $method $dest "\}"
+ dumpputs $method $dest ""
+ }
+
+ dumpputs $method $dest "option show \{"
+ if {$showIfNames == 0} {
+ dumpputs $method $dest " interface_names no"
+ } else {
+ dumpputs $method $dest " interface_names yes" }
+ if {$showIfIPaddrs == 0} {
+ dumpputs $method $dest " ip_addresses no"
+ } else {
+ dumpputs $method $dest " ip_addresses yes" }
+ if {$showNodeLabels == 0} {
+ dumpputs $method $dest " node_labels no"
+ } else {
+ dumpputs $method $dest " node_labels yes" }
+ if {$showLinkLabels == 0} {
+ dumpputs $method $dest " link_labels no"
+ } else {
+ dumpputs $method $dest " link_labels yes" }
+ dumpputs $method $dest "\}"
+ dumpputs $method $dest ""
+
+ return
+}
+
+
+proc loadCfg { cfg } {
+ global nodes links
+ global showIfNames showIfIPaddrs showNodeLabels showLinkLabels
+
+ # Cleanup first - this also automatically deletes all associated links
+ foreach node $nodes {
+ removeNode $node
+ }
+
+ set class ""
+ set object ""
+ foreach entry $cfg {
+ if {"$class" == ""} {
+ set class $entry
+ continue
+ } elseif {"$object" == ""} {
+ set object $entry
+ global $object
+ if {"$class" == "node"} {
+ lappend nodes $object
+ }
+ if {"$class" == "link"} {
+ lappend links $object
+ }
+ if {"$class" == "option"} {
+ # for future use
+ lappend prefs $object
+ }
+ continue
+ } else {
+ set line [concat $entry]
+ while {[llength $line] >= 2} {
+ set field [lindex $line 0]
+ if {"$field" == ""} {
+ set line [lreplace $line 0 0]
+ continue
+ }
+ set value [lindex $line 1]
+ set line [lreplace $line 0 1]
+ if {"$class" == "node"} {
+ switch -exact -- $field {
+ type {
+ lappend $object "type $value"
+ }
+ model {
+ lappend $object "model $value"
+ }
+ cpu {
+ lappend $object "cpu {$value}"
+ }
+ interface-peer {
+ lappend $object "interface-peer {$value}"
+ }
+ network-config {
+ set cfg ""
+ foreach zline [split $value {\r}] {
+ if { [string index "$zline" 0] == " " } {
+ set zline [string replace "$zline" 0 0]
+ lappend cfg $zline
+ }
+ }
+ lappend $object "network-config {$cfg}"
+ }
+ custom-enabled {
+ lappend $object "custom-enabled {$value}"
+ }
+ custom-command {
+ lappend $object "custom-command {$value}"
+ }
+ custom-config {
+ set cfg ""
+ foreach zline [split $value {\r}] {
+ if { [string index "$zline" 0] == " " } {
+ set zline [string replace "$zline" 0 0]
+ lappend cfg $zline
+ }
+ }
+ lappend $object "custom-config {$cfg}"
+ }
+ iconcoords {
+ lappend $object "iconcoords {$value}"
+ }
+ labelcoords {
+ lappend $object "labelcoords {$value}"
+ }
+ }
+ } elseif {"$class" == "link"} {
+ switch -exact -- $field {
+ nodes {
+ lappend $object "nodes {$value}"
+ }
+ bandwidth {
+ lappend $object "bandwidth $value"
+ }
+ delay {
+ lappend $object "delay $value"
+ }
+ ber {
+ lappend $object "ber $value"
+ }
+ duplicate {
+ lappend $object "duplicate $value"
+ }
+ }
+ } elseif {"$class" == "option"} {
+ switch -exact -- $field {
+ interface_names {
+ if { $value == "no" } {
+ set showIfNames 0
+ } elseif { $value == "yes" } {
+ set showIfNames 1
+ }
+ }
+ ip_addresses {
+ if { $value == "no" } {
+ set showIfIPaddrs 0
+ } elseif { $value == "yes" } {
+ set showIfIPaddrs 1
+ }
+ }
+ node_labels {
+ if { $value == "no" } {
+ set showNodeLabels 0
+ } elseif { $value == "yes" } {
+ set showNodeLabels 1
+ }
+ }
+ link_labels {
+ if { $value == "no" } {
+ set showLinkLabels 0
+ } elseif { $value == "yes" } {
+ set showLinkLabels 1
+ }
+ }
+ }
+ }
+ }
+ }
+ set class ""
+ set object ""
+ }
+ return
+}
+
+
+proc redrawAll {} {
+ global nodes links
+
+ foreach node $nodes {
+ drawNode $node
+ }
+ foreach link $links {
+ drawLink $link
+ redrawLink $link
+ updateLinkLabel $link
+ }
+ return
+}
+
+
+proc drawNode { node } {
+ global showNodeLabels
+ global router pc host lanswitch frswitch rj45 hub
+
+ 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 coords [getNodeLabelCoords $node]
+ set x [lindex $coords 0]
+ set y [lindex $coords 1]
+ set label [.c create text $x $y -fill blue -text "[getNodeName $node]" \
+ -tags "nodelabel $node"]
+ if { $showNodeLabels == 0} {
+ .c itemconfigure $label -state hidden
+ }
+ return
+}
+
+
+proc drawLink {link} {
+ global defLinkWidth defLinkColor
+
+ set nodes [linkEndpoints $link]
+ set lnode1 [lindex $nodes 0]
+ set lnode2 [lindex $nodes 1]
+ set newlink [.c create line 0 0 0 0 \
+ -fill $defLinkColor -width $defLinkWidth \
+ -tags "link $link $lnode1 $lnode2"]
+ .c raise $newlink background
+ set newlink [.c create line 0 0 0 0 \
+ -fill white -width [expr $defLinkWidth * 4 ] \
+ -tags "link $link $lnode1 $lnode2"]
+ .c raise $newlink background
+ .c create text 0 0 -tags "linklabel $link" -justify center
+ .c create text 0 0 -tags "interface $lnode1 $link" -justify center
+ .c create text 0 0 -tags "interface $lnode2 $link" -justify center
+ .c raise linklabel "link || background"
+ .c raise interface "link || linklabel || background"
+ return
+}
+
+
+proc newId { type } {
+ global nodes links
+
+ set mark [string range [set type] 0 0]
+ set id 0
+ while {[lsearch [set [set type]s] "$mark$id"] != -1} {
+ incr id
+ }
+ return $mark$id
+}
+
+
+proc newIfc { type node } {
+ set interfaces [ifcList $node]
+ for { set id 0 } { [lsearch -exact $interfaces $type$id] >= 0 } {incr id} {}
+ return $type$id
+}
+
+
+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
+ } else {
+ return eth
+ }
+ }
+ rj45 {
+ return
+ }
+ }
+}
+
+
+proc findFreeIPnet { mask } {
+ global nodes
+
+ set ipnets {}
+ foreach node $nodes {
+ foreach ifc [ifcList $node] {
+ set ipnet [lrange [split [getIfcIPaddr $node $ifc] .] 0 2]
+ if {[lsearch $ipnets $ipnet] == -1} {
+ lappend ipnets $ipnet
+ }
+ }
+ }
+ for { set i 0 } { $i <= 255 } { incr i } {
+ for { set j 0 } { $j <= 255 } { incr j } {
+ if {[lsearch $ipnets "10 $i $j"] == -1} {
+ set ipnet "10.$i.$j"
+ return $ipnet
+ }
+ }
+ }
+}
+
+
+proc newLANIP { l3node bridge } {
+ switch -exact -- [nodeType $l3node] {
+ router {
+ set targetbyte 1
+ }
+ host {
+ set targetbyte 10
+ }
+ pc {
+ set targetbyte 20
+ }
+ }
+ set ipaddr ""
+ foreach pass {1 2} {
+ foreach ifc [ifcList $bridge] {
+ set peer [peerByIfc $bridge $ifc]
+ set peer_if [ifcByPeer $peer $bridge]
+ set peer_ipaddr [getIfcIPaddr $peer $peer_if]
+ if { $peer_ipaddr == "" } {
+ continue
+ }
+ set ipnums [split $peer_ipaddr .]
+ set net "[lindex $ipnums 0].[lindex $ipnums 1].[lindex $ipnums 2]"
+ set host "[lindex [split [lindex $ipnums 3] /] 0]"
+ if { $pass == 1} {
+ set ipaddr "$net.$targetbyte"
+ break
+ } elseif { $ipaddr == "$net.$host" } {
+ set ipaddr "$net.[expr $host + 1]"
+ }
+ }
+ }
+ if { $ipaddr == "" } {
+ return "[findFreeIPnet 24].$targetbyte/24"
+ } else {
+ return "$ipaddr/24"
+ }
+}
+
+
+proc findLANdgIP { bridge } {
+ foreach ifc [ifcList $bridge] {
+ set peer [peerByIfc $bridge $ifc]
+ set peer_if [ifcByPeer $peer $bridge]
+ set peer_ipaddr [getIfcIPaddr $peer $peer_if]
+ if { [nodeType $peer] == "router" } {
+ return [lindex [split $peer_ipaddr /] 0]
+ }
+ }
+}
+
+
+proc updateLANdg { bridge } {
+ set gw [findLANdgIP $bridge]
+ if { $gw == "" } {
+ return
+ }
+ foreach ifc [ifcList $bridge] {
+ set peer [peerByIfc $bridge $ifc]
+ if { [nodeType $peer] == "pc" || [nodeType $peer] == "host" } {
+ setStatIProutes $peer [list "0.0.0.0/0 $gw"]
+ }
+ }
+ return
+}
+
+
+
+proc calcDxDy { lnode } {
+ global showIfIPaddrs
+ 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 } {
+ set x 1.1
+ } else {
+ set x 1.4
+ }
+ set y 1.5
+ }
+ host {
+ if { $showIfIPaddrs } {
+ set x 1.0
+ } else {
+ set x 1.5
+ }
+ set y 1.5
+ }
+ rj45 {
+ set x 1
+ set y 1
+ }
+ }
+ return
+}
+
+
+proc updateIfcLabel { lnode1 lnode2 } {
+ global showIfNames showIfIPaddrs
+
+ set link [lindex [.c gettags "link && $lnode1 && $lnode2"] 1]
+ set ifc [ifcByPeer $lnode1 $lnode2]
+ set ifipaddr [getIfcIPaddr $lnode1 $ifc]
+ if { $ifc == 0 } {
+ set ifc ""
+ }
+ if { [getIfcOperState $lnode1 $ifc] == "down" } {
+ set labelstr "*"
+ } else {
+ set labelstr ""
+ }
+ if { $showIfNames } {
+ set labelstr "$labelstr$ifc\r"
+ }
+ if { $showIfIPaddrs && $ifipaddr != "" } {
+ set labelstr "$labelstr$ifipaddr\r"
+ }
+ set labelstr \
+ [string range $labelstr 0 [expr [string length $labelstr] - 2]]
+ .c itemconfigure "interface && $lnode1 && $link" \
+ -text "$labelstr"
+ return
+}
+
+
+proc updateLinkLabel { link } {
+ global showLinkLabels
+
+ set labelstr ""
+ set delstr [getLinkDelayString $link]
+ set ber [getLinkBER $link]
+ set dup [getLinkDup $link]
+ set labelstr "$labelstr[getLinkBandwidthString $link]\r"
+ if { "$delstr" != "" } {
+ set labelstr "$labelstr$delstr\r"
+ }
+ if { "$ber" != "" } {
+ set berstr "ber=$ber"
+ set labelstr "$labelstr$berstr\r"
+ }
+ if { "$dup" != "" } {
+ set dupstr "dup=$dup%"
+ set labelstr "$labelstr$dupstr\r"
+ }
+ 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
+ }
+ return
+}
+
+
+proc redrawAllLinks {} {
+ global links
+
+ foreach link $links {
+ redrawLink $link
+ }
+ return
+}
+
+
+proc redrawLink { link } {
+ global .c $link
+
+ set limages [.c find withtag "link && $link"]
+ set limage1 [lindex $limages 0]
+ set limage2 [lindex $limages 1]
+ set tags [.c gettags $limage1]
+ set link [lindex $tags 1]
+ set lnode1 [lindex $tags 2]
+ set lnode2 [lindex $tags 3]
+
+ set coords1 [.c coords "node && $lnode1"]
+ set coords2 [.c coords "node && $lnode2"]
+ set x1 [lindex $coords1 0]
+ set y1 [lindex $coords1 1]
+ set x2 [lindex $coords2 0]
+ set y2 [lindex $coords2 1]
+
+ .c coords $limage1 $x1 $y1 $x2 $y2
+ .c coords $limage2 $x1 $y1 $x2 $y2
+
+ set lx [expr ($x1 + $x2) / 2]
+ set ly [expr ($y1 + $y2) / 2]
+ .c coords "linklabel && $link" $lx $ly
+
+ set n [expr sqrt (($x1 - $x2) * ($x1 - $x2) + \
+ ($y1 - $y2) * ($y1 - $y2)) / 64]
+ 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]
+ .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]
+ .c coords "interface && $lnode2 && $link" $lx $ly
+ updateIfcLabel $lnode2 $lnode1
+ return
+}
+
+
+proc selectNode { c obj } {
+ set node [lindex [$c gettags $obj] 1]
+ $c addtag selected withtag "node && $node"
+ set ox [lindex [$c coords $obj] 0]
+ set oy [lindex [$c coords $obj] 1]
+ set image [$c itemcget $obj -image]
+ set h [image height $image]
+ set w [image width $image]
+ set bx1 [expr $ox - $w / 2 - 4]
+ set bx2 [expr $ox + $w / 2 + 4]
+ set by1 [expr $oy - $h / 2 - 4]
+ set by2 [expr $oy + $h / 2 + 4]
+ $c create line $bx1 $by1 $bx2 $by1 $bx2 $by2 $bx1 $by2 $bx1 $by1 \
+ -dash {6 4} -fill black -width 1 -tags "selectmark $node"
+}
+
+
+proc button3 { c x y } {
+ global oper_mode env eid
+
+ set node [lindex [$c gettags {node && current}] 1]
+ set node_id $eid\_$node
+ if { $node != "" && $oper_mode == "exec" } {
+ set cmd ""
+ set type [nodeType $node]
+ set model [getNodeModel $node]
+ switch -exact -- $type {
+ router {
+ switch -exact -- $model {
+ quagga {
+ set cmd "vtysh"
+ }
+ xorp {
+ set cmd "/usr/local/xorp/bin/xorpsh"
+ }
+ static {
+ set cmd "$env(SHELL)"
+ }
+ }
+ }
+ host {
+ set cmd "$env(SHELL)"
+ }
+ pc {
+ set cmd "$env(SHELL)"
+ }
+ }
+ if { $cmd != "" } {
+ exec xterm -sb -rightbar \
+ -T "IMUNES: [getNodeName $node] (console)" \
+ -e "vimage $node_id $cmd" &
+ }
+ }
+ return
+}
+
+
+proc startethereal { c } {
+ global oper_mode eid
+
+ if { $oper_mode != "exec" } {
+ return
+ }
+ set interface ""
+ set tk_type [lindex [$c gettags current] 0]
+ set target [lindex [$c gettags current] 1]
+ set n0 [lindex [linkEndpoints $target] 0]
+ set n1 [lindex [linkEndpoints $target] 1]
+ if { [lsearch {hub lanswitch rj45} [nodeType $n0]] < 0 } {
+ set interface "[ifcByPeer $n0 $n1]@$eid\_$n0"
+ } elseif { [lsearch {hub lanswitch rj45} [nodeType $n1]] < 0 } {
+ set interface "[ifcByPeer $n1 $n0]@$eid\_$n1"
+ }
+ if { $interface != "" } {
+ exec ethereal -i $interface &
+ }
+ return
+}
+
+
+proc button1 { c x y button} {
+ global nodes
+ global activetool newlink curobj changed def_router_model
+ global router pc host lanswitch frswitch rj45 hub
+ global lastX lastY
+ global defLinkColor defLinkWidth background selectbox
+
+ set x [$c canvasx $x]
+ set y [$c canvasy $y]
+
+ set lastX $x
+ set lastY $y
+
+ set curobj [$c find withtag current]
+ set curtype [lindex [$c gettags current] 0]
+ if {$curtype == "node"} {
+ set node [lindex [$c gettags {node && current}] 1]
+ set wasselected \
+ [expr [lsearch [$c find withtag "selected"] $curobj] > -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" || $activetool == "delete") && \
+ !$wasselected} {
+ $c delete -withtags "selectmark && $node"
+ selectNode $c $curobj
+ }
+ } elseif {$button != "ctrl" || \
+ ($activetool != "select" && $activetool != "delete") } {
+ $c dtag node selected
+ $c delete -withtags selectmark
+ }
+ if {$curobj == $background} {
+ if { [lsearch {router pc host hub lanswitch frswitch rj45} \
+ $activetool] >= 0 } {
+ set node [newId node]
+ global $node
+ lappend $node "type $activetool"
+ if { $activetool == "router" } {
+ lappend $node "model $def_router_model"
+ }
+ if {$activetool == "router"} {
+ set nconfig [list \
+ "hostname $activetool[string range $node 1 end]" \
+ ! \
+ "router rip" \
+ " redistribute static" \
+ " network 0.0.0.0/0" \
+ ! ]
+ } elseif {$activetool == "rj45"} {
+ set nconfig [list \
+ "hostname UNASSIGNED" \
+ ! ]
+ } else {
+ set nconfig [list \
+ "hostname $activetool[string range $node 1 end]" \
+ ! ]
+ }
+ lappend $node "network-config [list $nconfig]"
+ lappend nodes $node
+ 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" || $activetool == "delete") \
+ && $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 {$activetool == "delete" && $curtype != "nodelabel"} {
+ set node [lindex [$c gettags {node && current}] 1]
+ set link [lindex [$c gettags {link && current}] 1]
+ if { $link == "" } {
+ set link [lindex [$c gettags {linklabel && current}] 1]
+ }
+ if { $link != "" } {
+ removeLink $link
+ set changed 1
+ } elseif { $node != "" } {
+ foreach obj [$c find withtag "node && selected"] {
+ removeNode [lindex [$c gettags $obj] 1]
+ }
+ set changed 1
+ }
+ }
+ 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
+}
+
+
+proc button1-motion { c x y } {
+ global activetool newlink changed grid
+ global lastX lastY sizex sizey selectbox background
+
+ set x [$c canvasx $x]
+ set y [$c canvasy $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
+ } elseif {($activetool == "select" || $activetool == "delete") && \
+ ( $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
+ }
+ } elseif {$activetool == "select" && $curtype == "nodelabel"} {
+ $c move $curobj [expr $x-$lastX] [expr $y-$lastY]
+ set changed 1
+ set lastX $x
+ set lastY $y
+ } else {
+ foreach img [$c find withtag "selectmark"] {
+ $c move $img [expr $x-$lastX] [expr $y-$lastY]
+ set node [lindex [$c gettags $img] 1]
+ set img [$c find withtag "node && $node"]
+ $c move $img [expr $x-$lastX] [expr $y-$lastY]
+ set node [lindex [$c gettags $img] 1]
+ 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
+}
+
+
+proc button1-release { c x y } {
+ global links nodes
+ global activetool newlink curobj grid
+ global changed undolog undolevel redolevel selectbox selected
+ global lastX lastY sizex sizey
+ global defLinkColor defLinkWidth
+ global defEthBandwidth defSerBandwidth defSerDelay
+
+ set x [$c canvasx $x]
+ set y [$c canvasy $y]
+
+ $c config -cursor left_ptr
+ if {$activetool == "link" && $newlink != ""} {
+ $c delete $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 regular yes
+ set lnode1 [lindex [$c gettags $curobj] 1]
+ set lnode2 [lindex [$c gettags $destobj] 1]
+ global $lnode1 $lnode2
+ if { [nodeType $lnode1] == "frswitch" && \
+ [nodeType $lnode2] != "router" && \
+ [nodeType $lnode2] != "frswitch" } { set regular no }
+ if { [nodeType $lnode2] == "frswitch" && \
+ [nodeType $lnode1] != "router" && \
+ [nodeType $lnode1] != "frswitch" } { set regular no }
+ if { [nodeType $lnode1] == "hub" && \
+ [nodeType $lnode2] == "hub" } { set regular no }
+ if { [nodeType $lnode1] == "rj45" || \
+ [nodeType $lnode2] == "rj45" } {
+ if { [nodeType $lnode1] == "rj45" } {
+ set rj45node $lnode1
+ set othernode $lnode2
+ } else {
+ set rj45node $lnode2
+ set othernode $lnode1
+ }
+ if { [lsearch {router lanswitch hub pc host} \
+ [nodeType $othernode]] < 0} {
+ set regular no
+ }
+ if { [lsearch [set $rj45node] "interface-peer *"] > 0 } {
+ set regular no
+ }
+
+ }
+
+ foreach link $links {
+ global $link
+ if { [$c find withtag "link && $lnode1 && $lnode2"] != "" } {
+ set regular no
+ }
+ }
+
+ set x [lindex [$c coords $destobj] 0]
+ set y [lindex [$c coords $destobj] 1]
+ if { $regular == "yes" } {
+ set link [newId link]
+ global $link
+
+ set ipnet [findFreeIPnet 24]
+ set lannode ""
+
+ set ifname1 [newIfc [chooseIfName $lnode1 $lnode2] $lnode1]
+ lappend $lnode1 "interface-peer {$ifname1 $lnode2}"
+ if { [lsearch {lanswitch hub rj45} [nodeType $lnode1]] < 0 && \
+ [lsearch {lanswitch hub} [nodeType $lnode2]] >= 0 } {
+ setIfcIPaddr $lnode1 $ifname1 [newLANIP $lnode1 $lnode2]
+ set lannode $lnode2
+ } elseif { [lsearch {hub frswitch lanswitch rj45} \
+ [nodeType $lnode1]] < 0 } {
+ setIfcIPaddr $lnode1 $ifname1 $ipnet.1/24
+ if { [nodeType $lnode1] == "pc" || \
+ [nodeType $lnode1] == "host" } {
+ setStatIProutes $lnode1 [list "0.0.0.0/0 $ipnet.2"]
+ }
+ }
+
+ set ifname2 [newIfc [chooseIfName $lnode2 $lnode1] $lnode2]
+ lappend $lnode2 "interface-peer {$ifname2 $lnode1}"
+ if { [lsearch {lanswitch hub rj45} [nodeType $lnode2]] < 0 && \
+ [lsearch {lanswitch hub} [nodeType $lnode1]] >= 0 } {
+ setIfcIPaddr $lnode2 $ifname2 [newLANIP $lnode2 $lnode1]
+ set lannode $lnode1
+ } elseif { [lsearch {hub frswitch lanswitch rj45} \
+ [nodeType $lnode2]] < 0 } {
+ setIfcIPaddr $lnode2 $ifname2 $ipnet.2/24
+ if { [nodeType $lnode2] == "pc" || \
+ [nodeType $lnode2] == "host" } {
+ setStatIProutes $lnode2 [list "0.0.0.0/0 $ipnet.1"]
+ }
+ }
+
+ lappend $link "nodes {$lnode1 $lnode2}"
+ if { ([nodeType $lnode1] == "lanswitch" || \
+ [nodeType $lnode2] == "lanswitch" || \
+ [string first eth "$ifname1 $ifname2"] != -1) && \
+ [nodeType $lnode1] != "rj45" && \
+ [nodeType $lnode2] != "rj45" } {
+ lappend $link "bandwidth $defEthBandwidth"
+ } elseif { [string first ser "$ifname1 $ifname2"] != -1 } {
+ lappend $link "bandwidth $defSerBandwidth"
+ lappend $link "delay $defSerDelay"
+ }
+ lappend links $link
+ drawLink $link
+ updateLinkLabel $link
+ if { $lannode != "" } {
+ updateLANdg $lannode
+ }
+ set changed 1
+ nodeEnter $c
+
+ redrawLink $link
+ }
+ }
+ set newlink ""
+ }
+
+ 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]
+ 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
+ } elseif {$activetool == "select" || $activetool == "delete"} {
+ if {$selectbox == ""} {
+ set x1 $x
+ set y1 $y
+ } 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"
+ $c raise interface "linklabel || link || background"
+ $c raise node "interface || linklabel || link || background"
+ $c raise nodelabel "node || interface || linklabel || link || background"
+ update
+ updateUndoLog
+ return
+}
+
+
+proc nodeEnter { c } {
+ global activetool
+
+ set node [lindex [$c gettags current] 1]
+ set type [nodeType $node]
+ set name [getNodeName $node]
+ set model [getNodeModel $node]
+ if { $model != "" } {
+ set line "{$node} $name ($model):"
+ } else {
+ set line "{$node} $name:"
+ }
+ if { $type != "rj45" } {
+ foreach ifc [ifcList $node] {
+ set line "$line $ifc:[getIfcIPaddr $node $ifc]"
+ }
+ }
+ .bottom.textbox config -text "$line"
+ if {$activetool == "delete"} {
+ .c config -cursor pirate
+ }
+ return
+}
+
+
+proc linkEnter {c} {
+ global activetool links
+
+ set link [lindex [$c gettags current] 1]
+ if { [lsearch $links $link] == -1 } {
+ return
+ }
+ set line "$link: [getLinkBandwidthString $link] [getLinkDelayString $link]"
+ .bottom.textbox config -text "$line"
+ if {$activetool == "delete"} {
+ .c config -cursor pirate
+ }
+ return
+}
+
+
+proc anyLeave {c} {
+ global activetool
+
+ .bottom.textbox config -text ""
+ if {$activetool == "delete"} {
+ .c config -cursor left_ptr
+ }
+ return
+}
+
+
+proc checkIntRange { str low high } {
+ if { $str == "" } {
+ return 1
+ }
+ if { ![string is integer $str] } {
+ return 0
+ }
+ if { $str < $low || $str > $high } {
+ return 0
+ }
+ return 1
+}
+
+
+proc checkIPAddr { str } {
+ set n 0
+ while { $n < 4 } {
+ if { $n < 3 } {
+ set i [string first . $str]
+ } else {
+ set i [string length $str]
+ }
+ if { $i < 1 } {
+ return 0
+ }
+ set part [string range $str 0 [expr $i - 1]]
+ if { [string length [string trim $part]] != $i } {
+ return 0
+ }
+ if { ![string is integer $part] } {
+ return 0
+ }
+ if { $part < 0 || $part > 255 } {
+ return 0
+ }
+ set str [string range $str [expr $i + 1] end]
+ incr n
+ }
+ return 1
+}
+
+
+proc checkIPNet { str } {
+ if { ![checkIPAddr [lindex [split $str /] 0]]} {
+ return 0
+ }
+ set net [lindex [split $str /] 1]
+ if { [string length [string trim $net]] != [string length $net] } {
+ return 0
+ }
+ return [checkIntRange $net 0 32]
+}
+
+
+proc focusAndFlash {W {count 9}} {
+ global badentry
+
+ set fg black
+ set bg white
+
+ if { $badentry == -1 } {
+ return
+ } else {
+ 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
+ } else {
+ $W configure -foreground $fg -background $bg
+ }
+ after 200 [list focusAndFlash $W [expr {$count-1}]]
+ }
+ return
+}
+
+
+proc popupConfigDialog { c } {
+ global activetool router_model supp_router_models oper_mode
+ global badentry
+
+ set wi .popup
+ catch {destroy $wi}
+ toplevel $wi
+
+ wm transient $wi .
+ wm resizable $wi 0 0
+
+ set object_type ""
+ 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
+ }
+ if { [lsearch {link linklabel} $tk_type] > -1 } {
+ set object_type link
+ }
+ if { "$object_type" == ""} {
+ destroy $wi
+ return
+ }
+ if { $object_type == "link" } {
+ set n0 [lindex [linkEndpoints $target] 0]
+ set n1 [lindex [linkEndpoints $target] 1]
+ if { [nodeType $n0] == "rj45" || [nodeType $n1] == "rj45" } {
+ destroy $wi
+ return
+ }
+ }
+ $c dtag node selected
+ $c delete -withtags selectmark
+
+ switch -exact -- $object_type {
+ node {
+ set type [nodeType $target]
+ 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:"
+ } else {
+ label $wi.ftop.name_label -text "Node name:"
+ }
+ entry $wi.ftop.name -bg white -width 16 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.ftop.name insert 0 [getNodeName $target]
+ $wi.ftop.name configure -vcmd {string is alnum %P}
+ 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
+ }
+
+ 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 { $type != "lanswitch" } {
+ 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
+ pack $wi.if$ifc.label.up $wi.if$ifc.label.down \
+ -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
+
+ if { [nodeType [peerByIfc $target $ifc]] != "rj45" && \
+ [nodeType $target] != "rj45" } {
+ #
+ # 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} {
+ #
+ # IP address & MTU
+ #
+ frame $wi.if$ifc.cfg.ip
+ label $wi.if$ifc.cfg.ip.addrl -text "IP address" \
+ -anchor w
+ entry $wi.if$ifc.cfg.ip.addrv -bg white -width 16 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.if$ifc.cfg.ip.addrv insert 0 \
+ [getIfcIPaddr $target $ifc]
+ $wi.if$ifc.cfg.ip.addrv configure \
+ -vcmd {checkIPNet %P}
+ if { $model == "xorp" && $oper_mode != "edit" } {
+ $wi.if$ifc.cfg.ip.addrv configure \
+ -state readonly
+ }
+ label $wi.if$ifc.cfg.ip.mtul -text "MTU" \
+ -anchor e -width 5
+ spinbox $wi.if$ifc.cfg.ip.mtuv -bg white -width 4 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.if$ifc.cfg.ip.mtuv insert 0 \
+ [getIfcMTU $target $ifc]
+ if {![string first eth $ifc]} {
+ $wi.if$ifc.cfg.ip.mtuv configure \
+ -from 256 -to 1500 -increment 2 \
+ -vcmd {checkIntRange %P 256 1500}
+ } else {
+ $wi.if$ifc.cfg.ip.mtuv configure \
+ -from 256 -to 2044 -increment 2 \
+ -vcmd {checkIntRange %P 256 2044}
+ }
+ if { $model == "xorp" && $oper_mode != "edit" } {
+ $wi.if$ifc.cfg.ip.mtuv configure \
+ -state readonly
+ }
+ pack $wi.if$ifc.cfg.ip.addrl \
+ $wi.if$ifc.cfg.ip.addrv $wi.if$ifc.cfg.ip.mtul \
+ $wi.if$ifc.cfg.ip.mtuv -side left
+ pack $wi.if$ifc.cfg.ip -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 IP routes
+ #
+ set routes [getStatIProutes $target]
+ labelframe $wi.statrt -padx 4 -pady 4
+ label $wi.statrt.label -text "Static IP 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 -bg white \
+ -width 36 -height $h -takefocus 0
+ foreach route $routes {
+ $wi.statrt.cfg.text insert end "$route\r"
+ }
+ if { $model == "xorp" && $oper_mode != "edit" } {
+ $wi.statrt.cfg.text configure -state disabled
+ }
+ 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"
+ button $wi.custom.cfg.clear -text "Clear" \
+ -command "setCustomConfig $target {}"
+ 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
+
+ #
+ # 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 {
+ wm title $wi "link configuration"
+ frame $wi.ftop -borderwidth 6
+ set nam0 [getNodeName $n0]
+ set nam1 [getNodeName $n1]
+ label $wi.ftop.name_label -justify left -text \
+ "Link from $nam0 to $nam1"
+ pack $wi.ftop.name_label -side right
+ pack $wi.ftop -side top
+
+ frame $wi.bandwidth -borderwidth 4
+ label $wi.bandwidth.label -anchor e \
+ -text "Bandwidth (bps):"
+ spinbox $wi.bandwidth.value -bg white -justify right -width 10 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.bandwidth.value insert 0 [getLinkBandwidth $target]
+ $wi.bandwidth.value configure \
+ -vcmd {checkIntRange %P 0 1000000000} \
+ -from 0 -to 1000000000 -increment 1000
+ pack $wi.bandwidth.value $wi.bandwidth.label \
+ -side right
+ pack $wi.bandwidth -side top -anchor e
+
+ frame $wi.delay -borderwidth 4
+ label $wi.delay.label -anchor e -text "Delay (us):"
+ spinbox $wi.delay.value -bg white -justify right -width 10 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.delay.value insert 0 [getLinkDelay $target]
+ $wi.delay.value configure \
+ -vcmd {checkIntRange %P 0 10000000} \
+ -from 0 -to 10000000 -increment 5
+ pack $wi.delay.value $wi.delay.label -side right
+ pack $wi.delay -side top -anchor e
+
+ frame $wi.ber -borderwidth 4
+ label $wi.ber.label -anchor e -text "BER (1/N):"
+ spinbox $wi.ber.value -bg white -justify right -width 10 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.ber.value insert 0 [getLinkBER $target]
+ $wi.ber.value configure \
+ -vcmd {checkIntRange %P 0 10000000000000} \
+ -from 0 -to 10000000000000 -increment 1000
+ pack $wi.ber.value $wi.ber.label -side right
+ pack $wi.ber -side top -anchor e
+
+ frame $wi.dup -borderwidth 4
+ label $wi.dup.label -anchor e -text "Duplicate (%):"
+ spinbox $wi.dup.value -bg white -justify right -width 10 \
+ -validate focus -invcmd "focusAndFlash %W"
+ $wi.dup.value insert 0 [getLinkDup $target]
+ $wi.dup.value configure \
+ -vcmd {checkIntRange %P 0 50} \
+ -from 0 -to 50 -increment 1
+ pack $wi.dup.value $wi.dup.label -side right
+ pack $wi.dup -side top -anchor e
+ }
+ }
+
+ frame $wi.butt -borderwidth 6
+ button $wi.butt.apply -text "Apply" -command \
+ "popupConfigApply $wi $object_type $target close 0"
+ focus $wi.butt.apply
+ button $wi.butt.cancel -text "Cancel" -command \
+ "set badentry -1 ; destroy $wi"
+ pack $wi.butt.cancel $wi.butt.apply -side right
+ pack $wi.butt -side bottom
+ after 100 {
+ grab .popup
+ }
+ return
+}
+
+
+proc cfgGenerate { node } {
+ setCustomConfig $node [[typemodel $node].cfggen $node]
+ setCustomCmd $node [[typemodel $node].bootcmd $node]
+}
+
+
+proc editStartupCfg { node } {
+ 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"
+
+ frame $w.ftop -borderwidth 4
+ label $w.ftop.label -text "Startup command:"
+ entry $w.ftop.cmd -bg white -width 64
+ $w.ftop.cmd insert 0 [getCustomCmd $node]
+ 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 40 -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.cancel -text Cancel -command "destroy $w"
+ pack $w.buttons.apply $w.buttons.cancel -side left
+
+ pack $w.scroll -side right -fill y
+ pack $w.text -expand yes -fill both
+
+ foreach line [getCustomConfig $node] {
+ $w.text insert end "$line\r"
+ }
+
+ $w.text mark set insert 0.0
+ return
+}
+
+
+proc customConfigApply { w node } {
+ global changed
+
+ set newcmd [$w.ftop.cmd get]
+ set newconf [split [$w.text get @0,0 end] {\r}]
+ while { [lindex $newconf end] == {} } {
+ set newconf [lreplace $newconf end end]
+ }
+ if { [getCustomCmd $node] != $newcmd || \
+ [getCustomConfig $node] != $newconf } {
+ set changed 1
+ updateUndoLog
+ }
+ setCustomCmd $node $newcmd
+ setCustomConfig $node $newconf
+ destroy $w
+ return
+}
+
+
+proc popupConfigApply { wi object_type target close phase } {
+ global changed oper_mode router_model badentry customEnabled
+
+ $wi config -cursor watch
+ update
+ if { $phase == 0 } {
+ set badentry 0
+ focus .
+ after 100 "popupConfigApply $wi $object_type $target $close 1"
+ return
+ } elseif { $badentry } {
+ $wi config -cursor left_ptr
+ return
+ }
+ switch -exact -- $object_type {
+ node {
+ set type [nodeType $target]
+ set model [getNodeModel $target]
+ set name [lindex [split [$wi.ftop.name get]] 0]
+ if { $name != [getNodeName $target] } {
+ setNodeName $target $name
+ .c itemconfigure "nodelabel && $target" -text $name
+ set changed 1
+ }
+ if { $oper_mode == "edit" && $type == "router" && \
+ $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 {[lsearch {router pc host} [nodeType $target]] >= 0} {
+ set ifconfchanged 0
+ foreach ifc [ifcList $target] {
+ #
+ # Operational state
+ #
+ global [subst ifoper$ifc]
+ set ifoperstate [subst $[subst ifoper$ifc]]
+ set oldifoperstate [getIfcOperState $target $ifc]
+ if { $ifoperstate != $oldifoperstate } {
+ setIfcOperState $target $ifc $ifoperstate
+ updateIfcLabel $target [peerByIfc $target $ifc]
+ set changed 1
+ set ifconfchanged 1
+ }
+
+ #
+ # IP address & MTU
+ #
+ set ipaddr [$wi.if$ifc.cfg.ip.addrv get]
+ set oldipaddr [getIfcIPaddr $target $ifc]
+ if { $ipaddr != $oldipaddr } {
+ setIfcIPaddr $target $ifc $ipaddr
+ updateIfcLabel $target [peerByIfc $target $ifc]
+ set changed 1
+ set ifconfchanged 1
+ }
+ set mtu [$wi.if$ifc.cfg.ip.mtuv get]
+ set oldmtu [getIfcMTU $target $ifc]
+ if { $mtu != $oldmtu } {
+ setIfcMTU $target $ifc $mtu
+ set changed 1
+ }
+
+ }
+
+ set oldstatrtes [getStatIProutes $target]
+ set newstatrtes {}
+ set i 1
+ while { 1 } {
+ set text [$wi.statrt.cfg.text get $i.0 $i.end]
+ set text [string trim $text]
+ if { $text == "" } {
+ break
+ }
+ lappend newstatrtes $text
+ incr i
+ }
+ if { [lsort $oldstatrtes] != [lsort $newstatrtes] || \
+ $ifconfchanged == 1} {
+ setStatIProutes $target $newstatrtes
+ set changed 1
+ }
+
+ set oldcustomenabled [getCustomEnabled $target]
+ if {$oldcustomenabled != $customEnabled} {
+ setCustomEnabled $target $customEnabled
+ set changed 1
+ }
+
+ set oldcpuconf [getNodeCPUConf $target]
+ set newcpuconf {}
+ set cpumin [$wi.cpu.mine get]
+ set cpumax [$wi.cpu.maxe get]
+ set cpuweight [$wi.cpu.weighte get]
+ if { $cpumin != "" } {
+ lappend newcpuconf "min $cpumin"
+ }
+ if { $cpumax != "" } {
+ lappend newcpuconf "max $cpumax"
+ }
+ if { $cpuweight != "" } {
+ lappend newcpuconf "weight $cpuweight"
+ }
+ if { $oldcpuconf != $newcpuconf } {
+ setNodeCPUConf $target [list $newcpuconf]
+ set changed 1
+ }
+ }
+ }
+
+ link {
+ set bw [$wi.bandwidth.value get]
+ if { $bw != [getLinkBandwidth $target] } {
+ setLinkBandwidth $target [$wi.bandwidth.value get]
+ set changed 1
+ }
+ set dly [$wi.delay.value get]
+ if { $dly != [getLinkDelay $target] } {
+ setLinkDelay $target [$wi.delay.value get]
+ set changed 1
+ }
+ set ber [$wi.ber.value get]
+ if { $ber != [getLinkBER $target] } {
+ setLinkBER $target [$wi.ber.value get]
+ set changed 1
+ }
+ set dup [$wi.dup.value get]
+ if { $dup != [getLinkDup $target] } {
+ setLinkDup $target [$wi.dup.value get]
+ set changed 1
+ }
+ updateLinkLabel $target
+ }
+ }
+ updateUndoLog
+ if { $close == "close" } {
+ destroy $wi
+ } else {
+ $wi config -cursor left_ptr
+ }
+}
+
+
+proc printCanvas { w } {
+ global sizex sizey
+
+ set prncmd [$w.e1 get]
+ destroy $w
+ set p [open "|$prncmd" WRONLY]
+ puts $p [.c postscript -height $sizey -width $sizex -x 0 -y 0 -rotate yes -pageheight 297m -pagewidth 210m]
+ close $p
+}
+
+proc delete_object { c x y } {
+ global changed
+ global background
+
+ set node [lindex [$c gettags {node && current}] 1]
+ set link [lindex [$c gettags {link && current}] 1]
+ if { $link == "" } {
+ set link [lindex [$c gettags {linklabel && current}] 1]
+ }
+ if { $link != "" } {
+ removeLink $link
+ set changed 1
+ }
+ if { $node != "" } {
+ removeNode $node
+ set changed 1
+ }
+ foreach obj [$c find withtag "node && selected"] {
+ removeNode [lindex [$c gettags $obj] 1]
+ set changed 1
+ }
+ $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"
+ updateUndoLog
+}
+
--- /dev/null
+#
+# Copyright 2004 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.
+#
+# This work was supported in part by the Croatian Ministry of Science
+# and Technology through the research contract #IP-2003-143.
+#
+
+
+proc setOperMode { mode } {
+ global oper_mode activetool nodes
+
+ # Verify that links to external interfaces are properly configured
+ if { $mode == "exec" } {
+ set extifcs [exec ifconfig -l]
+ set extifcs \
+ [lreplace $extifcs [lsearch $extifcs lo0] [lsearch $extifcs lo0]]
+ foreach node $nodes {
+ if { [nodeType $node] == "rj45" } {
+ set i [lsearch $extifcs [getNodeName $node]]
+ if { $i < 0 } {
+ after idle {.dialog1.msg configure -wraplength 4i}
+ tk_dialog .dialog1 "IMUNES error" \
+ "Error: external interface \"[getNodeName $node]\" non-existant" \
+ info 0 Dismiss
+ return
+ }
+ }
+ }
+ }
+
+ foreach b {delete link router hub lanswitch host pc rj45} {
+ if { "$mode" == "exec" } {
+ .left.$b configure -state disabled
+ } else {
+ .left.$b configure -state normal
+ }
+ }
+ .bottom.oper_mode configure -text "$mode mode"
+ set activetool select
+ .left.select configure -state active
+ if { "$mode" == "exec" && [exec id -u] == 0} {
+ .menubar.experiment entryconfigure "Execute" -state disabled
+ .menubar.experiment entryconfigure "Terminate" -state normal
+ .menubar.edit entryconfigure "Undo" -state disabled
+ .menubar.edit entryconfigure "Redo" -state disabled
+ set oper_mode exec
+ monitor_loop
+ deployCfg
+ } else {
+ if {$oper_mode != "edit"} {
+ vimageCleanup
+ }
+ if {[exec id -u] == 0} {
+ .menubar.experiment entryconfigure "Execute" -state normal
+ } else {
+ .menubar.experiment entryconfigure "Execute" -state disabled
+ }
+ .menubar.experiment entryconfigure "Terminate" -state disabled
+ .menubar.edit entryconfigure "Undo" -state normal
+ .menubar.edit entryconfigure "Redo" -state normal
+ set oper_mode edit
+ }
+ .c config -cursor left_ptr
+}
+
+
+proc statline {line} {
+ global execMode
+
+ if {$execMode == "batch"} {
+ puts $line
+ } else {
+ .bottom.textbox config -text "$line"
+ animateCursor
+ }
+}
+
+
+proc createIfc {type hook} {
+ catch {exec ngctl mkpeer $type $hook $hook | tail -1} resp
+ foreach elem [split [lindex [split $resp "\{\}"] 1]] {
+ if {[string equal -length 6 $elem "name=\""]} {
+ set name [string range $elem 6 [expr [string length $elem] - 2]]
+ return $name
+ }
+ }
+}
+
+
+set mac_byte5 0
+proc l3node.instantiate { eid node } {
+ global mac_byte5
+ set node_id "$eid\_$node"
+ exec vimage -c $node_id
+ exec vimage $node_id hostname [getNodeName $node]
+
+ foreach ifc [ifcList $node] {
+ switch -exact [string range $ifc 0 2] {
+ eth {
+ set ifid [createIfc eiface ether]
+ exec vimage -i $node_id $ifid $ifc
+ exec vimage $node_id ifconfig $ifc
+ set ether 40:00:aa:aa:00:$mac_byte5
+ incr mac_byte5
+ exec vimage $node_id ifconfig $ifc link $ether
+ }
+ ser {
+ set ifnum [string range $ifc 3 end]
+ set ifid [createIfc iface inet]
+ exec ngctl mkpeer $ifid: cisco inet inet
+ exec ngctl connect $ifid: $ifid:inet inet6 inet6
+ exec ngctl msg $ifid: broadcast
+ exec ngctl name $ifid:inet hdlc$ifnum\@$node_id
+ exec vimage -i $node_id $ifid $ifc
+ exec vimage $node_id ifconfig $ifc
+ }
+ }
+ }
+
+ set cpuconf [getNodeCPUConf $node]
+ set cpumin [lindex [lsearch -inline $cpuconf {min *}] 1]
+ set cpumax [lindex [lsearch -inline $cpuconf {max *}] 1]
+ set cpuweight [lindex [lsearch -inline $cpuconf {weight *}] 1]
+ if { $cpumin != "" } {
+ exec vimage -m $node_id cpumin $cpumin
+ }
+ if { $cpumax != "" } {
+ exec vimage -m $node_id cpumax $cpumax
+ }
+ if { $cpuweight != "" } {
+ exec vimage -m $node_id cpuweight $cpuweight
+ }
+
+ exec vimage $node_id sysctl net.inet.icmp.bmcastecho=1
+ exec vimage $node_id sysctl net.inet.icmp.icmplim=0
+ exec vimage $node_id ifconfig lo0 inet localhost
+}
+
+
+proc l3node.nghook { eid node ifc } {
+ set ifnum [string range $ifc 3 end]
+ set node_id "$eid\_$node"
+ switch -exact [string range $ifc 0 2] {
+ eth {
+ return [list $ifc@$node_id ether]
+ }
+ ser {
+ return [list hdlc$ifnum@$node_id downstream]
+ }
+ }
+}
+
+
+proc deployCfg {} {
+ global eid
+ global nodes links supp_router_models
+
+ set t_start [clock seconds]
+
+ vimageCleanup
+
+ catch { exec mv /etc/resolv.conf /etc/resolv.conf.bak }
+ catch { exec kldload ng_ether }
+ catch { exec kldload ng_iface }
+ catch { exec kldload ng_eiface }
+
+ foreach node $nodes {
+ set node_id "$eid\_$node"
+ set type [nodeType $node]
+ set name [getNodeName $node]
+ statline "Creating node $name"
+ [typemodel $node].instantiate $eid $node
+ }
+
+ set mac 0
+ foreach link $links {
+ statline "Creating link $link"
+ set lnode1 [lindex [linkEndpoints $link] 0]
+ set lnode2 [lindex [linkEndpoints $link] 1]
+ set ifname1 [ifcByPeer $lnode1 $lnode2]
+ set ifname2 [ifcByPeer $lnode2 $lnode1]
+ set bandwidth [expr [getLinkBandwidth $link] + 0]
+ set delay [expr [getLinkDelay $link] + 0]
+ set ber [expr [getLinkBER $link] + 0]
+ set dup [expr [getLinkDup $link] + 0]
+ set lname $eid\_$lnode1-$lnode2
+
+ set ngpeer1 \
+ [lindex [[typemodel $lnode1].nghook $eid $lnode1 $ifname1] 0]
+ set nghook1 \
+ [lindex [[typemodel $lnode1].nghook $eid $lnode1 $ifname1] 1]
+ set ngpeer2 \
+ [lindex [[typemodel $lnode2].nghook $eid $lnode2 $ifname2] 0]
+ set nghook2 \
+ [lindex [[typemodel $lnode2].nghook $eid $lnode2 $ifname2] 1]
+ exec ngctl mkpeer $ngpeer1: pipe $nghook1 upper
+ exec ngctl name $ngpeer1:$nghook1 $lname
+ exec ngctl connect $lname: $ngpeer2: lower $nghook2
+
+#exec ngctl msg $lname: setcfg "{ header_offset=14 }" ethernet
+#exec ngctl msg $lname: setcfg "{ header_offset=14 }" HDLC ???
+
+ # Link parameters
+ exec ngctl msg $lname: setcfg \
+ "{ bandwidth=$bandwidth delay=$delay \
+ upstream={ BER=$ber duplicate=$dup } \
+ downstream={ BER=$ber duplicate=$dup } }"
+
+ # Queues
+ foreach node [list $lnode1 $lnode2] {
+ if { $node == $lnode1 } {
+ set ifc [ifcByPeer $lnode1 $lnode2]
+ } else {
+ set ifc [ifcByPeer $lnode2 $lnode1]
+ }
+ if { [nodeType $lnode1] != "rj45" && \
+ [nodeType $lnode2] != "rj45" } {
+ execSetIfcQDisc $eid $node $ifc [getIfcQDisc $node $ifc]
+ execSetIfcQDrop $eid $node $ifc [getIfcQDrop $node $ifc]
+ execSetIfcQLen $eid $node $ifc [getIfcQLen $node $ifc]
+ }
+ }
+ }
+
+ exec rm -fr /var/run/quagga
+ exec rm -f /usr/local/etc/quagga/Quagga.conf
+ exec ln -s /tmp/@ /var/run/quagga
+ exec ln -s /tmp/@/boot.conf /usr/local/etc/quagga/Quagga.conf
+ foreach file { bgpd.conf ospfd.conf ripd.conf vtysh.conf zebra.conf } {
+ exec cp /dev/null /usr/local/etc/quagga/$file
+ }
+
+ foreach node $nodes {
+ global $node
+ statline "Configuring node [getNodeName $node]"
+ set node_id "$eid\_$node"
+ set type [nodeType $node]
+ set model [getNodeModel $node]
+ if { [lsearch -exact {router pc host} $type] >= 0 } {
+ exec rm -fr /tmp/$node_id
+ exec mkdir /tmp/$node_id
+ exec chmod 1777 /tmp/$node_id
+ foreach ifc [ifcList $node] {
+ set mtu [getIfcMTU $node $ifc]
+ exec vimage $node_id ifconfig $ifc mtu $mtu
+ }
+
+ if { [getCustomEnabled $node] == true } {
+ set bootcmd [getCustomCmd $node]
+ set bootcfg [getCustomConfig $node]
+ } else {
+ set bootcmd ""
+ set bootcfg ""
+ }
+ if { $bootcmd == "" || $bootcfg =="" } {
+ set bootcfg [[typemodel $node].cfggen $node]
+ set bootcmd [[typemodel $node].bootcmd $node]
+ }
+ set fileId [open /tmp/$node_id/boot.conf w]
+ foreach line $bootcfg {
+ puts $fileId $line
+ }
+ close $fileId
+ catch "exec vimage $node_id $bootcmd /tmp/$node_id/boot.conf &"
+ }
+ }
+
+ statline "Network topology instantiated in [expr [clock seconds] - $t_start] seconds ([llength $nodes] nodes and [llength $links] links)."
+}
+
+
+proc vimageCleanup {} {
+ set t_start [clock seconds]
+ set vimages [join [exec vimage -l | fgrep -v " " | cut -d: -f 1]]
+ set defindex [lsearch $vimages default]
+ set vimages [lreplace $vimages $defindex $defindex]
+
+ # Detach / destroy / reassign interfaces pipe, eiface, iface, bridge
+ set ngnodes [split [exec ngctl l | tail -n +3] "\r"]
+ foreach ngline $ngnodes {
+ set node [lindex [eval list $ngline] 1]
+ statline "Shutting down netgraph node $node"
+ catch "exec ngctl msg $node: shutdown"
+ }
+
+ # Shut down all vimages
+ foreach vimage $vimages {
+ statline "Shutting down vimage $vimage"
+ catch {exec vimage $vimage kill -9 -1 2> /dev/null}
+ exec rm -fr /tmp/$vimage
+ exec vimage -d $vimage
+ }
+ catch { exec rm -f /usr/local/etc/quagga/Quagga.conf }
+ catch { exec rm -f /usr/local/xorp/config.boot }
+ catch { exec mv /etc/resolv.conf.bak /etc/resolv.conf }
+ statline "Cleanup completed in [expr [clock seconds] - $t_start] seconds."
+}
+
+
+proc monitor_loop {} {
+ global oper_mode
+ global nmbufs nmbclusters
+
+ if {$oper_mode != "exec"} {
+ .bottom.cpu_load config -text ""
+ .bottom.mbuf config -text ""
+ return
+ }
+
+ set cpu_load [expr ([lindex [split [exec sysctl kern.cp_time_avg]] end] + \
+ 5000) / 10000]
+ .bottom.cpu_load config -text "CPU $cpu_load%"
+
+ set nstout [split [exec netstat -m] ]
+ set mbufs [lindex [split [lindex $nstout 0] /] 0]
+ set clusts [lindex [split [lsearch -inline $nstout "*/$nmbclusters"] /] 0]
+ set mbufp [expr $mbufs * 100 / $nmbufs]
+ set clustp [expr $clusts * 100 / $nmbclusters]
+ .bottom.mbuf config -text "mbuf/clus $mbufp%/$clustp%"
+
+ after 2000 { monitor_loop }
+}
+
+
+proc linkByIfc { node ifc } {
+ global links
+
+ set peer [peerByIfc $node $ifc]
+ foreach link $links {
+ set endpoints [linkEndpoints $link]
+ if { $endpoints == "$node $peer" } {
+ set dir downstream
+ break
+ }
+ if { $endpoints == "$peer $node" } {
+ set dir upstream
+ break
+ }
+ }
+
+ return [list $link $dir]
+}
+
+
+proc execSetIfcQDisc { eid node ifc qdisc } {
+ set target [linkByIfc $node $ifc]
+ set peers [linkEndpoints [lindex $target 0]]
+ set dir [lindex $target 1]
+ set ngnode "$eid\_[lindex $peers 0]-[lindex $peers 1]"
+ switch -exact $qdisc {
+ FIFO { set qdisc fifo }
+ WFQ { set qdisc wfq }
+ DRR { set qdisc drr }
+ }
+ exec ngctl msg $ngnode: setcfg "{ $dir={ $qdisc=1 } }"
+}
+
+
+proc execSetIfcQDrop { eid node ifc qdrop } {
+ set target [linkByIfc $node $ifc]
+ set peers [linkEndpoints [lindex $target 0]]
+ set dir [lindex $target 1]
+ set ngnode "$eid\_[lindex $peers 0]-[lindex $peers 1]"
+ switch -exact $qdrop {
+ drop-head { set qdrop drophead }
+ drop-tail { set qdrop droptail }
+ }
+ exec ngctl msg $ngnode: setcfg "{ $dir={ $qdrop=1 } }"
+}
+
+
+proc execSetIfcQLen { eid node ifc qlen } {
+ set target [linkByIfc $node $ifc]
+ set peers [linkEndpoints [lindex $target 0]]
+ set dir [lindex $target 1]
+ set ngnode "$eid\_[lindex $peers 0]-[lindex $peers 1]"
+ exec ngctl msg $ngnode: setcfg "{ $dir={ queuelen=$qlen } }"
+}
projects / imunes.git / commitdiff