}
return
}
+
+
+#****f* nodecfg.tcl/setNodeType
+# NAME
+# setNodeType -- set node's type.
+# SYNOPSIS
+# setNodeLabelCoords $node_id $coords
+# FUNCTION
+# Sets node's type and configuration. Conversion is possible between router
+# on the one side, and the pc or host on the other side.
+# INPUTS
+# * node_id -- node id
+# * newtype -- new type of node
+#****
+
+proc setNodeType { node newtype } {
+ global $node
+
+ set oldtype [nodeType $node]
+ if { [lsearch "rj45 hub lanswitch" $newtype] >= 0 } {
+ return
+ }
+ if { [lsearch "rj45 hub lanswitch" $oldtype] >= 0 } {
+ return
+ }
+ if { $oldtype == "router" && \
+ [lsearch "pc host" $newtype] >= 0 } {
+ setType $node $newtype
+ set i [lsearch [set $node] "model *"]
+ set $node [lreplace [set $node] $i $i]
+ setNodeName $node $newtype[string range $node 1 end]
+ netconfClearSection $node "router rip"
+ netconfClearSection $node "router ripng"
+ set interfaces [ifcList $node]
+ foreach ifc $interfaces {
+ autoIPv4addr $node $ifc
+ autoIPv6addr $node $ifc
+ }
+ } elseif { [lsearch "host pc" $oldtype] >= 0 \
+ && $newtype == "router" } {
+ setType $node $newtype
+ setNodeModel $node "quagga"
+ setNodeName $node $newtype[string range $node 1 end]
+ netconfClearSection $node "ip route *"
+ netconfClearSection $node "ipv6 route *"
+ netconfInsertSection $node [list "router rip" \
+ " redistribute static" \
+ " redistribute connected" \
+ " network 0.0.0.0/0" \
+ ! ]
+ netconfInsertSection $node [list "router ripng" \
+ " redistribute static" \
+ " redistribute connected" \
+ " network ::/0" \
+ ! ]
+ }
+}
+
+
+#****f* nodecfg.tcl/setType
+# NAME
+# setType -- set node's type.
+# SYNOPSIS
+# setType $node_id $type
+# FUNCTION
+# Sets node's type.
+# INPUTS
+# * node_id -- node id
+# * type -- type of node
+#****
+
+proc setType { node type } {
+ global $node
+
+ set i [lsearch [set $node] "type *"]
+ if { $i >= 0 } {
+ set $node [lreplace [set $node] $i $i "type $type"]
+ } else {
+ set $node [linsert [set $node] 1 "type $type"]
+ }
+ return
+}
--- /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.
+#
+#****h* imunes/ns2imunes.tcl
+# NAME
+# ns2imunes.tcl -- file used for converting from ns2 scripts to IMUNES conf
+# file
+# FUNCTION
+# This module implements functionality for converting ns2 scripts into
+# IMUNES conf file. Now, only basic ns2 functionalities are implemented, those
+# that can't be written in IMUNES config file or those that are not implemented
+# yet are ignored.
+#****
+
+#****f* ns2imunes.tcl/ns2im
+# NAME
+# ns2im -- converts ns2 script into IMUNES and draws topology
+# SYNOPSIS
+# ns2im $ns2script
+# FUNCTION
+# Implements basic logic for converting between formats.
+# INPUTS
+# * srcfile -- ns2 scripy
+#****
+
+proc ns2im { srcfile } {
+ global node_list
+ global link_list
+ global canvas_list
+ global curcanvas
+ puts $curcanvas
+ global cfg
+ set cfg {}
+ set node_list {}
+ set link_list {}
+ set canvas_list {}
+ source $srcfile
+ foreach node $node_list {
+ setNodeCanvas $node $curcanvas
+ }
+ changeNodeType
+ setDefaultRoutes
+ arrangeNodes
+ dumpCfg string cfg
+ loadCfg $cfg
+ redrawAll
+ if { [file exists out.nam] == 1 } {
+ file delete out.nam
+ }
+}
+
+#****f* ns2imunes.tcl/new
+# NAME
+# new -- basic/main ns2 function, invoked in ns2 script
+# SYNOPSIS
+# set ns [new Simulator]
+# FUNCTION
+# Points to our main function: root-func.
+# INPUTS
+# * object -- can be Simulator, Agent, Application.
+#****
+
+proc new {object} {
+ set arg [split $object "/"]
+ set typepc "TCP UDP RTP RTCP"
+ set typehost "TCPSink Null"
+ if {$object == "Simulator"} {
+ return root-func
+ } elseif {[lindex $arg 0] == "Agent"} {
+ return nullfunc
+ } elseif {[lindex $arg 0] == "Application"} {
+ return nullfunc
+ } else {
+ return nullfunc
+ }
+}
+
+#****f* ns2imunes.tcl/nullfunc
+# NAME
+# nullfunc -- does nothing; needed for avoiding errors.
+# SYNOPSIS
+# nullfunc args
+# INPUTS
+# * can be any number of inputs
+#****
+proc nullfunc {args} {
+}
+
+
+#****f* ns2imunes.tcl/root-func
+# NAME
+# root-func -- calls other functions
+# SYNOPSIS
+# root-func ns_command $args
+# FUNCTION
+# For input node this procedure enables or disables custom configuration.
+# INPUTS
+# * ns_command -- first arg is always name of the function
+# * args -- argument for function; there can be any number of arguments
+# RESULT
+# Returns result of function $ns_command
+#****
+proc root-func {ns_command args} {
+ catch {
+ if {$args == ""} {
+ set x [$ns_command]
+ return $x
+ } else {
+ set y [$ns_command $args]
+ return $y
+ }
+ } value
+ return $value
+}
+
+
+#****f* ns2imunes.tcl/node
+# NAME
+# node -- creates new node, ns_command invoked from root-func
+# SYNOPSIS
+# set node [node]
+# RESULT
+# * node_id -- node id of a new node of type router
+#****
+proc node {} {
+ set default "router"
+ return [newNode $default]
+}
+
+
+#not implemented yet in IMUNES
+proc simplex-link { linkdata } {
+}
+
+
+#****f* ns2imunes.tcl/duplex-link
+# NAME
+# duplex-link -- creates new link, ns_command invoked from root-func
+# SYNOPSIS
+# duplex-link $linkdata_list
+# INPUTS
+# * linkdata -- list that describes link
+# RESULT
+# * new_link_id -- new link id.
+#****
+proc duplex-link { linkdata } {
+ set node1 [lindex $linkdata 0]
+ set node2 [lindex $linkdata 1]
+ set bw [lindex $linkdata 2]
+ set dly [lindex $linkdata 3]
+ set type [lindex $linkdata 4]
+ set link [newLink $node1 $node2]
+
+ set bandwidth [getBandwidth $bw]
+ setLinkBandwidth $link $bandwidth
+
+ set delay [getDelay $dly]
+ setLinkDelay $link $delay
+
+ set queueingDiscipline [getQueingDiscipline $type]
+}
+
+
+#****f* ns2imunes.tcl/changeNodeType
+# NAME
+# changeNodeType -- passes through list node_list and changes type of node.
+# SYNOPSIS
+# changeNodeType
+# FUNCTION
+# Passes through list node_list and calls procedures for changing type of
+# node if node has more than one neighbour.
+#****
+proc changeNodeType {} {
+ global node_list
+ foreach node $node_list {
+ set ifc [ifcList $node]
+ set ifcnum [llength $ifc]
+ if { $ifcnum == 1 } {
+ setNodeType $node "pc"
+ }
+ }
+}
+
+
+#****f* ns2imunes.tcl/setDefaultRoutes
+# NAME
+# setDefaultRoutes -- sets default routes for non router nodes
+# SYNOPSIS
+# setDefaultRoutes
+#****
+proc setDefaultRoutes {} {
+ global node_list
+ foreach node $node_list {
+ set type [nodeType $node]
+ if { $type == "pc" || $type == "host" } {
+ set interfaces [ifcList $node]
+ foreach ifc $interfaces {
+ autoIPv4defaultroute $node $ifc
+ autoIPv6defaultroute $node $ifc
+ }
+ }
+ }
+}
+
+
+#****f* ns2imunes.tcl/getBandwidth
+# NAME
+# getBandwith -- returns bandwidth value in bits
+# SYNOPSIS
+# getBandwith $bandwith
+# FUNCTION
+# Detects input unit, and returns bandwidth value in bits.
+# INPUTS
+# * bw -- bandwidth
+#****
+proc getBandwidth { bw } {
+ regexp {[0-9]+} $bw value
+ regexp {[A-Za-z]+} $bw unit
+ switch $unit {
+ "Kb" "return [expr $value*1000]"
+ "Mb" "return [expr $value*1000000]"
+ "Gb" "return [expr $value*1000000000]"
+ }
+}
+
+#****f* ns2imunes.tcl/getDelay
+# NAME
+# getDelay -- returns delay value in microseconds
+# SYNOPSIS
+# getDelay $dly
+# FUNCTION
+# Detects input unit, and returns delay value in microseconds.
+# INPUTS
+# * dly -- delay
+#****
+proc getDelay { dly } {
+ regexp {[0-9]+} $dly value
+ regexp {[a-z]+} $dly unit
+ switch $unit {
+ "ms" " return [expr $value*1000] "
+ "us" " return $value "
+ }
+}
+
+#****f* ns2imunes.tcl/getQueingDiscipline
+# NAME
+# getQueingDiscipline -- returns queing discipline
+# SYNOPSIS
+# getQueingDiscipline $type
+# INPUTS
+# * type -- type of queing discipline written in ns2 format
+#****
+proc getQueingDiscipline { type } {
+ if {[string match "DropTail" $type]} {
+ return "droptail"
+ } elseif {[string match "CBQ" $type] ||\
+ [string match "WFQ" $type]} {
+ return "fair-queue"
+ } elseif {[string match "DRR" $type]} {
+ return "drr-queue"
+ }
+}
+
+
+#****f* ns2imunes.tcl/arrangeNodes
+# NAME
+# arrangeNodes -- calculates coordinates for nodes
+# SYNOPSIS
+# arrangeNodes
+# FUNCTION
+# Calculates and writes coordinates for every node in global variable
+# node_list.
+#****
+proc arrangeNodes {} {
+ global node_list
+ global activetool
+#with next foreach loop we divide nodes on layer3/router
+#nodes and peripheral (pc, host) nodes
+ set routers {}
+ set peripheralNodes {}
+ foreach node $node_list {
+ set type [nodeType $node]
+ if { $type == "router" } {
+ lappend routers $node
+ } else {
+ lappend peripheralNodes $node
+ }
+ }
+ set center {450 310}
+ set i 0
+ set rnum [llength $routers]
+ set pi [expr 2*asin(1.0)]
+#next foreach loop: we arrange nodes that we have denoted as
+#layer3/router nodes; we place them in a elipse circle and their
+#regular peers (pc or host) are placed above them
+ foreach rnode $routers {
+ set fi [expr $i*(2*$pi)/$rnum]
+ set r [expr 200*(1.0-0.5*abs(sin($fi)))]
+ set ximage [expr [lindex $center 0] - $r*cos($fi)]
+ set yimage [expr [lindex $center 1] - $r*sin($fi)]
+
+ setNodeCoords $rnode "$ximage $yimage"
+ setNodeLabelCoords $rnode "$ximage [expr $yimage + 24]"
+ set regularPeers [getRegularPeers $rnode]
+ set regpeernum [llength $regularPeers]
+ set j 0
+ foreach peer $regularPeers {
+ if { [hasCoords $peer] >= 0 } {
+ continue
+ }
+ set fi1 [expr ($j-$regpeernum/2)*(2*$pi/3)/$regpeernum]
+ set ximage1 [expr $ximage - 200*cos($fi+$fi1)]
+ set yimage1 [expr $yimage - 200*sin($fi+$fi1)]
+ setNodeCoords $peer "$ximage1 $yimage1"
+ set dy 32
+ setNodeLabelCoords $peer "$ximage1 [expr $yimage1 + $dy]"
+ incr j
+ }
+ incr i
+ }
+ if { $routers == "" } {
+ set fi [expr $i*(2*$pi)/[llength $peripheralNodes]]
+ set r [expr 200*(1.0-0.5*abs(sin($fi)))]
+ set ximage [expr [lindex $center 0] - $r*cos($fi)]
+ set yimage [expr [lindex $center 1] - $r*sin($fi)]
+ setNodeCoords $peer "$ximage1 $yimage1"
+ set dy 32
+
+ setNodeLabelCoords $peer "$ximage1 [expr $yimage1 + $dy]"
+ }
+}
+
+
+#****f* ns2imunes.tcl/getRegularPeers
+# NAME
+# getRegularPeers -- returns list of pc's and hosts connected with router $node
+# SYNOPSIS
+# getRegularPeers $node_id
+# INPUTS
+# * node -- node_id of router to which we are finding peers
+#****
+proc getRegularPeers { node } {
+ set interfaces [ifcList $node]
+ set regularpeers ""
+ foreach ifc $interfaces {
+ set peer [peerByIfc $node $ifc]
+ if { [nodeType $peer] == "pc" || [nodeType $peer] == "host"} {
+ lappend regularpeers $peer
+ }
+ }
+ return $regularpeers
+}
+
+
+#****f* ns2imunes.tcl/hasCoords
+# NAME
+# hasCoords -- detects existence of coords
+# SYNOPSIS
+# getRegularPeers $node_id
+# INPUTS
+# * node -- node_id of node.
+# RESULT
+# * >=0 -- coords are assigned to $node
+# * ==1 -- coords are not assigned to $node
+#****
+proc hasCoords {node} {
+ global $node
+ return [lsearch [set $node] "iconcoords *"]
+}
projects / imunes.git / commitdiff