From: marko <marko>
Date: Mon, 4 Jul 2005 23:06:29 +0000 (+0000)
Subject: Initial revision
X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=6f5e3b3dd486f01606d89681f2aa79c9ae142f53;p=imunes.git

Initial revision
---

diff --git a/nodecfg.tcl b/nodecfg.tcl
new file mode 100755
index 0000000..16619e2
--- /dev/null
+++ b/nodecfg.tcl
@@ -0,0 +1,690 @@
+#
+# 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
+}
diff --git a/rj45.tcl b/rj45.tcl
new file mode 100755
index 0000000..00f82bc
--- /dev/null
+++ b/rj45.tcl
@@ -0,0 +1,48 @@
+#
+# Copyright 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.
+#
+
+
+proc rj45.instantiate { eid node } {
+    set ifname [getNodeName $node]
+    exec ifconfig $name up
+    return
+}
+
+
+proc rj45.nghook { eid node ifc } {
+    set nodename [getNodeName $node]
+    return [list $nodename lower]
+}
+