--- /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 Croatian Ministry of Science
+# and Technology through the research contract #IP-2003-143.
+#
+
+
+#
+# The IMUNES configuration file contains declarations of IMUNES objects.
+# Each object declaration contains exactly the following three fields:
+#
+# object_class object_id class_specific_config_string
+#
+# Currently only two object classes are supported: node and link. In the
+# future we plan to implement a canvas object, which should allow placing
+# other objects into multiple visual maps.
+#
+# "node" objects are further divided by their type, which can be one of
+# the following:
+#
+# router
+# host
+# pc
+# lan-switch
+# rj45
+#
+# The following node types are to be implemented in the future:
+#
+# fr-switch
+# pseudo
+# text
+# image
+#
+
+
+#
+# Routines for manipulation of per-node network configuration files
+#
+# IMUNES keeps per-node network configuration in an IOS / Zebra / Quagga
+# style format.
+#
+# Network configuration is embedded in each node's config section via the
+# "network-config" statement. The following functions can be used to
+# manipulate the per-node network config:
+#
+# netconfFetchSection { node_id sectionhead }
+# Returns a section of a config file starting with the $sectionhead
+# line, and ending with the first occurence of the "!" sign.
+#
+# netconfClearSection { node_id sectionhead }
+# Removes the appropriate section from the config.
+#
+# netconfInsertSection { node_id section }
+# Inserts a section in the config file. Sections beginning with the
+# "interface" keyword are inserted at the head of the config, and
+# all other sequences are simply appended to the config tail.
+#
+# getIfcOperState { node_id ifc }
+# Returns "up" or "down".
+#
+# setIfcOperState { node_id ifc state }
+# Sets the new interface state.
+#
+# getIfcQDisc { node_id ifc }
+# Returns "FIFO", "WFQ" or "DRR".
+#
+# setIfcQDisc { node_id ifc qdisc }
+# Sets the new queuing discipline. Implicit default is FIFO.
+#
+# getIfcQDrop { node_id ifc }
+# Returns "drop-tail" or "drop-head".
+#
+# setIfcQDrop { node_id ifc qdrop }
+# Sets the new queuing discipline. Implicit default is "drop-tail".
+#
+# getIfcQLen { node_id ifc }
+# Returns the queue length limit in packets.
+#
+# setIfcQLen { node_id ifc len }
+# Sets the new queue length limit.
+#
+# getIfcMTU { node_id ifc }
+# Returns the configured MTU, or an empty string if default MTU is used.
+#
+# setIfcMTU { node_id ifc mtu }
+# Sets the new MTU. Zero MTU value denotes the default MTU.
+#
+# getIfcIPaddr { node_id ifc }
+# Returns a list of all IP addresses assigned to an interface.
+#
+# setIfcIPaddr { node_id ifc addr }
+# Sets a new IP address(es) on an interface. The correctness of the
+# IP address format is not checked / enforced.
+#
+# getStatIProutes { node_id }
+# Returns a list of all static IP routes as a list of
+# {destination gateway} pairs.
+#
+# setStatIProutes { node_id route_list }
+# Replace all current static route entries with a new one, in form of
+# a list, as described above.
+#
+# getNodeName { node_id }
+# Returns node's logical name.
+#
+# setNodeName { node_id name }
+# Sets a new node's logical name.
+#
+# nodeType { node_id }
+# Returns node's type.
+#
+# getNodeModel { node_id }
+# Returns node's optional model identifyer.
+#
+# setNodeModel { node_id model }
+# Sets the node's optional model identifyer.
+#
+# getNodeCoords { node_id }
+# Return icon coords.
+#
+# setNodeCoords { node_id coords }
+# Sets the coords.
+#
+# getNodeLabelCoords { node_id }
+# Return node label coords.
+#
+# setNodeLabelCoords { node_id coords }
+# Sets the label coords.
+#
+# getNodeCPUConf { node_id }
+# Returns node's CPU scheduling parameters { minp maxp weight }.
+#
+# setNodeCPUConf { node_id param_list }
+# Sets the node's CPU scheduling parameters.
+#
+# ifcList { node_id }
+# Returns a list of all interfaces present in a node.
+#
+# peerByIfc { node_id ifc }
+# Returns id of the node on the other side of the interface
+#
+# ifcByPeer { local_node_id peer_node_id }
+# Returns the name of the interface connected to the specified peer.
+#
+# All of the above functions are independent to any Tk objects. This means
+# they can be used for implementing tasks external to GUI, so inside the
+# GUI any updating of related Tk objects (such as text labels etc.) will
+# have to be implemented by additional Tk code.
+#
+# Additionally, an alternative configuration can be specified in
+# "custom-config" section.
+#
+# getCustomConfig { node_id }
+#
+# setCustomConfig { node_id cfg }
+#
+# getCustomEnabled { node_id }
+#
+# setCustomEnabled { node_id state }
+#
+
+
+proc typemodel { node } {
+ set type [nodeType $node]
+ set model [getNodeModel $node]
+ if { $model != {} } {
+ return $type.$model
+ } else {
+ return $type
+ }
+}
+
+
+proc getCustomEnabled { node } {
+ global $node
+
+ if { [lindex [lsearch -inline [set $node] "custom-enabled *"] 1] == true } {
+ return true
+ } else {
+ return false
+ }
+}
+
+
+proc setCustomEnabled { node enabled } {
+ global $node
+
+ set i [lsearch [set $node] "custom-enabled *"]
+ if { $i >= 0 } {
+ set $node [lreplace [set $node] $i $i]
+ }
+ if { $enabled == true } {
+ lappend $node [list custom-enabled $enabled]
+ }
+ return
+}
+
+
+proc getCustomCmd { node } {
+ global $node
+
+ return [lindex [lsearch -inline [set $node] "custom-command *"] 1]
+}
+
+
+proc setCustomCmd { node cmd } {
+ global $node
+
+ set i [lsearch [set $node] "custom-command *"]
+ if { $i >= 0 } {
+ set $node [lreplace [set $node] $i $i]
+ }
+ lappend $node [list custom-command $cmd]
+ return
+}
+
+
+proc getCustomConfig { node } {
+ global $node
+
+ return [lindex [lsearch -inline [set $node] "custom-config *"] 1]
+}
+
+
+proc setCustomConfig { node cfg } {
+ global $node
+
+ set i [lsearch [set $node] "custom-config *"]
+ if { $i >= 0 } {
+ set $node [lreplace [set $node] $i $i]
+ }
+ if { $cfg != {} } {
+ lappend $node [list custom-config $cfg]
+ }
+ return
+}
+
+
+proc netconfFetchSection { node sectionhead } {
+ global $node
+
+ set cfgmode global
+ set section {}
+ set netconf [lindex [lsearch -inline [set $node] "network-config *"] 1]
+ foreach line $netconf {
+ if { $cfgmode == "section" } {
+ if { "$line" == "!" } {
+ return $section
+ }
+ lappend section "$line"
+ continue
+ }
+ if { "$line" == "$sectionhead" } {
+ set cfgmode section
+ }
+ }
+}
+
+
+proc netconfClearSection { node sectionhead } {
+ global $node
+
+ set i [lsearch [set $node] "network-config *"]
+ set netconf [lindex [lindex [set $node] $i] 1]
+ set lnum_beg -1
+ set lnum_end 0
+ foreach line $netconf {
+ if { $lnum_beg == -1 && "$line" == "$sectionhead" } {
+ set lnum_beg $lnum_end
+ }
+ if { $lnum_beg > -1 && "$line" == "!" } {
+ set netconf [lreplace $netconf $lnum_beg $lnum_end]
+ set $node [lreplace [set $node] $i $i \
+ [list network-config $netconf]]
+ return
+ }
+ incr lnum_end
+ }
+}
+
+
+proc netconfInsertSection { node section } {
+ global $node
+
+ set sectionhead [lindex $section 0]
+ netconfClearSection $node $sectionhead
+ set i [lsearch [set $node] "network-config *"]
+ set netconf [lindex [lindex [set $node] $i] 1]
+ set lnum_beg end
+ if { "[lindex $sectionhead 0]" == "interface" } {
+ set lnum [lsearch $netconf "hostname *"]
+ if { $lnum >= 0 } {
+ set lnum_beg [expr $lnum + 2]
+ }
+ } elseif { "[lindex $sectionhead 0]" == "hostname" } {
+ set lnum_beg 0
+ }
+ if { "[lindex $section end]" != "!" } {
+ lappend section "!"
+ }
+ foreach line $section {
+ set netconf [linsert $netconf $lnum_beg $line]
+ if { $lnum_beg != "end" } {
+ incr lnum_beg
+ }
+ }
+ set $node [lreplace [set $node] $i $i [list network-config $netconf]]
+ return
+}
+
+
+proc getIfcOperState { node ifc } {
+ foreach line [netconfFetchSection $node "interface $ifc"] {
+ if { [lindex $line 0] == "shutdown" } {
+ return "down"
+ }
+ }
+ return "up"
+}
+
+
+proc setIfcOperState { node ifc state } {
+ set ifcfg [list "interface $ifc"]
+ if { $state == "down" } {
+ lappend ifcfg " shutdown"
+ }
+ foreach line [netconfFetchSection $node "interface $ifc"] {
+ if { [lindex $line 0] != "shutdown" && \
+ [lrange $line 0 1] != "no shutdown" } {
+ lappend ifcfg $line
+ }
+ }
+ netconfInsertSection $node $ifcfg
+ return
+}
+
+
+proc getIfcQDisc { node ifc } {
+ foreach line [netconfFetchSection $node "interface $ifc"] {
+ if { [lindex $line 0] == "fair-queue" } {
+ return WFQ
+ }
+ if { [lindex $line 0] == "drr-queue" } {
+ return DRR
+ }
+ }
+ return FIFO
+}
+
+
+proc setIfcQDisc { node ifc qdisc } {
+ set ifcfg [list "interface $ifc"]
+ if { $qdisc == "WFQ" } {
+ lappend ifcfg " fair-queue"
+ }
+ if { $qdisc == "DRR" } {
+ lappend ifcfg " drr-queue"
+ }
+ foreach line [netconfFetchSection $node "interface $ifc"] {
+ if { [lindex $line 0] != "fair-queue" && \
+ [lindex $line 0] != "drr-queue" } {
+ lappend ifcfg $line
+ }
+ }
+ netconfInsertSection $node $ifcfg
+ return
+}
+
+
+proc getIfcQDrop { node ifc } {
+ foreach line [netconfFetchSection $node "interface $ifc"] {
+ if { [lindex $line 0] == "drop-head" } {
+ return drop-head
+ }
+ }
+ return drop-tail
+}
+
+
+proc setIfcQDrop { node ifc qdrop } {
+ set ifcfg [list "interface $ifc"]
+ if { $qdrop == "drop-head" } {
+ lappend ifcfg " drop-head"
+ }
+ foreach line [netconfFetchSection $node "interface $ifc"] {
+ if { [lindex $line 0] != "drop-head" && \
+ [lindex $line 0] != "drop-tail" } {
+ lappend ifcfg $line
+ }
+ }
+ netconfInsertSection $node $ifcfg
+ return
+}
+
+
+proc getIfcQLen { node ifc } {
+ foreach line [netconfFetchSection $node "interface $ifc"] {
+ if { [lindex $line 0] == "queue-len" } {
+ return [lindex $line 1]
+ }
+ }
+ return 50
+}
+
+
+proc setIfcQLen { node ifc len } {
+ set ifcfg [list "interface $ifc"]
+ foreach line [netconfFetchSection $node "interface $ifc"] {
+ if { [lindex $line 0] != "queue-len" } {
+ lappend ifcfg $line
+ }
+ }
+ if { $len > 5 && $len != 50 } {
+ lappend ifcfg " queue-len $len"
+ }
+ netconfInsertSection $node $ifcfg
+ return
+}
+
+
+proc getIfcMTU { node ifc } {
+ foreach line [netconfFetchSection $node "interface $ifc"] {
+ if { [lindex $line 0] == "mtu" } {
+ return [lindex $line 1]
+ }
+ }
+ # Return defaults
+ switch -exact [string range $ifc 0 2] {
+ eth { return 1500 }
+ ser { return 2044 }
+ }
+}
+
+
+proc setIfcMTU { node ifc mtu } {
+ set ifcfg [list "interface $ifc"]
+ foreach line [netconfFetchSection $node "interface $ifc"] {
+ if { [lindex $line 0] != "mtu" } {
+ lappend ifcfg $line
+ }
+ }
+ switch -exact [string range $ifc 0 2] {
+ eth { set limit 1500 }
+ ser { set limit 2044 }
+ }
+ if { $mtu >= 256 && $mtu < $limit } {
+ lappend ifcfg " mtu $mtu"
+ }
+ netconfInsertSection $node $ifcfg
+ return
+}
+
+
+proc getIfcIPaddr { node ifc } {
+ set addrlist {}
+ foreach line [netconfFetchSection $node "interface $ifc"] {
+ if { [lrange $line 0 1] == "ip address" } {
+ lappend addrlist [lindex $line 2]
+ }
+ }
+ return $addrlist
+}
+
+
+proc setIfcIPaddr { node ifc addr } {
+ set ifcfg [list "interface $ifc"]
+ foreach line [netconfFetchSection $node "interface $ifc"] {
+ if { [lrange $line 0 1] != "ip address" } {
+ lappend ifcfg $line
+ }
+ }
+ lappend ifcfg " ip address $addr"
+ netconfInsertSection $node $ifcfg
+ return
+}
+
+
+proc getStatIProutes { node } {
+ global $node
+
+ set routes {}
+ set netconf [lindex [lsearch -inline [set $node] "network-config *"] 1]
+ foreach entry [lsearch -all -inline $netconf "ip route *"] {
+ lappend routes [lrange $entry 2 3]
+ }
+ return $routes
+}
+
+
+proc setStatIProutes { node routes } {
+ netconfClearSection $node "ip route [lindex [getStatIProutes $node] 0]"
+ set section {}
+ foreach route $routes {
+ lappend section "ip route $route"
+ }
+ netconfInsertSection $node $section
+ return
+}
+
+
+proc getNodeName { node } {
+ global $node
+
+ set netconf [lindex [lsearch -inline [set $node] "network-config *"] 1]
+ return [lindex [lsearch -inline $netconf "hostname *"] 1]
+}
+
+
+proc setNodeName { node name } {
+ netconfClearSection $node "hostname [getNodeName $node]"
+ netconfInsertSection $node [list "hostname $name"]
+ return
+}
+
+
+proc nodeType { node } {
+ global $node
+
+ return [lindex [lsearch -inline [set $node] "type *"] 1]
+}
+
+
+proc getNodeModel { node } {
+ global $node
+
+ return [lindex [lsearch -inline [set $node] "model *"] 1]
+}
+
+
+proc setNodeModel { node model } {
+ global $node
+
+ set i [lsearch [set $node] "model *"]
+ if { $i >= 0 } {
+ set $node [lreplace [set $node] $i $i "model $model"]
+ } else {
+ set $node [linsert [set $node] 1 "model $model"]
+ }
+ return
+}
+
+
+proc getNodeCoords { node } {
+ global $node
+
+ return [lindex [lsearch -inline [set $node] "iconcoords *"] 1]
+}
+
+
+proc setNodeCoords { node coords } {
+ global $node
+
+ set i [lsearch [set $node] "iconcoords *"]
+ if { $i >= 0 } {
+ set $node [lreplace [set $node] $i $i "iconcoords {$coords}"]
+ } else {
+ set $node [linsert [set $node] end "iconcoords {$coords}"]
+ }
+ return
+}
+
+
+proc getNodeLabelCoords { node } {
+ global $node
+
+ return [lindex [lsearch -inline [set $node] "labelcoords *"] 1]
+}
+
+
+proc setNodeLabelCoords { node coords } {
+ global $node
+
+ set i [lsearch [set $node] "labelcoords *"]
+ if { $i >= 0 } {
+ set $node [lreplace [set $node] $i $i "labelcoords {$coords}"]
+ } else {
+ set $node [linsert [set $node] end "labelcoords {$coords}"]
+ }
+ return
+}
+
+
+proc getNodeCPUConf { node } {
+ global $node
+
+ return [join [lrange [lsearch -inline [set $node] "cpu *"] 1 3]]
+}
+
+
+proc setNodeCPUConf { node param_list } {
+ global $node
+
+ set i [lsearch [set $node] "cpu *"]
+ if { $i >= 0 } {
+ if { $param_list != "{}" } {
+ set $node [lreplace [set $node] $i $i "cpu $param_list"]
+ } else {
+ set $node [lreplace [set $node] $i $i]
+ }
+ } else {
+ if { $param_list != "{}" } {
+ set $node [linsert [set $node] 1 "cpu $param_list"]
+ }
+ }
+ return
+}
+
+
+proc ifcList { node } {
+ global $node
+
+ set interfaces ""
+ foreach entry [lsearch -all -inline [set $node] "interface-peer *"] {
+ lappend interfaces [lindex [lindex $entry 1] 0]
+ }
+ return $interfaces
+}
+
+
+proc peerByIfc { node ifc } {
+ global $node
+
+ set entry [lsearch -inline [set $node] "interface-peer {$ifc *}"]
+ return [lindex [lindex $entry 1] 1]
+}
+
+
+proc ifcByPeer { node peer } {
+ global $node
+
+ set entry [lsearch -inline [set $node] "interface-peer {* $peer}"]
+ return [lindex [lindex $entry 1] 0]
+}
+
+
+#
+# The following should really go into a separate "editing" library
+#
+
+proc undo {} {
+ global undolevel undolog oper_mode
+
+ if {$oper_mode == "edit" && $undolevel > 0} {
+ incr undolevel -1
+ loadCfg $undolog($undolevel)
+ redrawAll
+ }
+ return
+}
+
+
+proc redo {} {
+ global undolevel redolevel undolog oper_mode
+
+ if {$oper_mode == "edit" && $redolevel > $undolevel} {
+ incr undolevel
+ loadCfg $undolog($undolevel)
+ redrawAll
+ }
+ return
+}
projects / imunes.git / commitdiff