From: marko Date: Tue, 5 Jul 2005 00:06:47 +0000 (+0000) Subject: Initial revision X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=920252fb1c24c0b44c18b9290db9ef556c2f49ea;p=imunes.git Initial revision --- diff --git a/editor.tcl b/editor.tcl new file mode 100755 index 0000000..663fe57 --- /dev/null +++ b/editor.tcl @@ -0,0 +1,1901 @@ +# +# 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 " + } + } + 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 { }] { + 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 { }] { + 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 " + } + if { $showIfIPaddrs && $ifipaddr != "" } { + set labelstr "$labelstr$ifipaddr " + } + 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] " + if { "$delstr" != "" } { + set labelstr "$labelstr$delstr " + } + if { "$ber" != "" } { + set berstr "ber=$ber" + set labelstr "$labelstr$berstr " + } + if { "$dup" != "" } { + set dupstr "dup=$dup%" + set labelstr "$labelstr$dupstr " + } + 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 " + } + 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 " + } + + $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] { }] + 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 +} + diff --git a/exec.tcl b/exec.tcl new file mode 100755 index 0000000..508a02f --- /dev/null +++ b/exec.tcl @@ -0,0 +1,406 @@ +# +# 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] " "] + 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 } }" +} diff --git a/imunes.tcl b/imunes.tcl new file mode 100755 index 0000000..4900e33 --- /dev/null +++ b/imunes.tcl @@ -0,0 +1,141 @@ +# +# 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 Croatian Ministry of Science +# and Technology through the research contract #IP-2003-143. +# + +if {[lindex $argv 0] == "-b" || [lindex $argv 0] == "--batch"} { + set argv [lrange $argv 1 end] + set execMode batch +} else { + set execMode interactive +} + +# +# Include procedure definitions from external files. There must be +# some better way to accomplish the same goal, but that's how we do it +# for the moment. +# +# The ROOTDIR and LIBDIR variables will be automatically set to the proper +# value by the installation script. +# + +set LIBDIR "" +set ROOTDIR "." + +source "$ROOTDIR/$LIBDIR/exec.tcl" +source "$ROOTDIR/$LIBDIR/linkcfg.tcl" +source "$ROOTDIR/$LIBDIR/nodecfg.tcl" +source "$ROOTDIR/$LIBDIR/editor.tcl" +source "$ROOTDIR/$LIBDIR/help.tcl" +source "$ROOTDIR/$LIBDIR/filemgmt.tcl" + +source "$ROOTDIR/$LIBDIR/quagga.tcl" +source "$ROOTDIR/$LIBDIR/xorp.tcl" +source "$ROOTDIR/$LIBDIR/static.tcl" +source "$ROOTDIR/$LIBDIR/pc.tcl" +source "$ROOTDIR/$LIBDIR/host.tcl" +source "$ROOTDIR/$LIBDIR/hub.tcl" +source "$ROOTDIR/$LIBDIR/lanswitch.tcl" +source "$ROOTDIR/$LIBDIR/rj45.tcl" + + +# +# Global variables are initialized here +# + +set eid e0 + +set nodes {} +set links {} +set prefs {} + +set def_router_model quagga +set newlink "" +set selectbox "" +set selected "" + +set undolevel 0 +set redolevel 0 +set undolog(0) "" +set changed 0 +set badentry 0 +set cursorState 0 +set clock_seconds 0 +set oper_mode edit +set grid 24 +set sizex 1024 +set sizey 768 + +# Some default values +set defLinkColor red +set defLinkWidth 2 +set defEthBandwidth 100000000 +set defSerBandwidth 2048000 +set defSerDelay 2500 +set showIfNames 1 +set showIfIPaddrs 1 +set showNodeLabels 1 +set showLinkLabels 1 + +set nmbufs [lindex [split [exec sysctl kern.ipc.nmbufs]] 1] +set nmbclusters [lindex [split [exec sysctl kern.ipc.nmbclusters]] 1] + +set supp_router_models "quagga static" +if { [file exists /usr/local/xorp/bin/xorp_rtrmgr] } { + set supp_router_models "xorp $supp_router_models" +} + + +# +# Initialization should be complete now, so let's start doing something... +# + +if {$execMode == "interactive"} { + source "$ROOTDIR/$LIBDIR/initgui.tcl" + setOperMode edit + fileOpenStartUp +} else { + if {$argv != ""} { + set fileId [open $argv r] + set cfg "" + foreach entry [read $fileId] { + lappend cfg $entry + } + close $fileId + loadCfg $cfg + deployCfg + } else { + vimageCleanup + } +} +