initial pass at removing bsd and code related to using bsd nodes
This commit is contained in:
Blake J. Harnden
parent
4858151d7c
commit
bc1e3e70c9
62 changed files with 720 additions and 18008 deletions
|
|
@ -33,8 +33,6 @@ CONFIG_FILES = configs/sample1.imn configs/sample1.scen \
|
|||
configs/sample9-vpn.imn \
|
||||
configs/sample10-kitchen-sink.imn
|
||||
|
||||
OTHER_FILES = core-bsd-cleanup.sh
|
||||
|
||||
#
|
||||
# CORE GUI script (/usr/local/bin/core-gui)
|
||||
#
|
||||
|
|
@ -44,7 +42,7 @@ dist_bin_SCRIPTS = core-gui
|
|||
# Tcl/Tk scripts (/usr/local/lib/core)
|
||||
#
|
||||
coredir = $(CORE_LIB_DIR)
|
||||
dist_core_DATA = $(TCL_FILES)
|
||||
dist_core_DATA = $(TCL_FILES)
|
||||
dist_core_SCRIPTS = $(OTHER_FILES)
|
||||
|
||||
#
|
||||
|
|
@ -57,7 +55,7 @@ dist_coreaddons_DATA = $(ADDONS_FILES)
|
|||
# Sample configs (/usr/local/share/core/examples/configs)
|
||||
#
|
||||
coreconfigsdir = $(datadir)/core/examples/configs
|
||||
dist_coreconfigs_DATA = $(CONFIG_FILES)
|
||||
dist_coreconfigs_DATA = $(CONFIG_FILES)
|
||||
|
||||
dist-hook:
|
||||
rm -rf $(distdir)/addons/.svn
|
||||
|
|
|
|||
96
gui/api.tcl
96
gui/api.tcl
|
|
@ -135,7 +135,7 @@ proc receiveMessage { channel } {
|
|||
|
||||
#
|
||||
# Open an API socket to the specified server:port, prompt user for retry
|
||||
# if specified; set the readable file event and parameters;
|
||||
# if specified; set the readable file event and parameters;
|
||||
# returns the channel name or -1 on error.
|
||||
#
|
||||
proc openAPIChannel { server port retry } {
|
||||
|
|
@ -186,7 +186,7 @@ proc openAPIChannel { server port retry } {
|
|||
|
||||
# now we have a valid socket, set up encoding and receive event
|
||||
fconfigure $s -blocking 0 -encoding binary -translation { binary binary } \
|
||||
-buffering full -buffersize 4096
|
||||
-buffering full -buffersize 4096
|
||||
fileevent $s readable [list receiveMessage $s]
|
||||
return $s
|
||||
}
|
||||
|
|
@ -299,7 +299,7 @@ proc parseNodeMessage { data len flags } {
|
|||
# verbose debugging
|
||||
#puts "tlv type=$type length=$length pad=$pad current=$current"
|
||||
incr current 2
|
||||
|
||||
|
||||
if {![info exists typenames($type)] } { ;# unknown TLV type
|
||||
if { $prmsg } { puts -nonewline "unknown=$type," }
|
||||
incr current $length
|
||||
|
|
@ -352,11 +352,11 @@ proc parseNodeMessage { data len flags } {
|
|||
} else {
|
||||
set exists true
|
||||
}
|
||||
|
||||
|
||||
if { $vals(name) == "" } {; # make sure there is a node name
|
||||
set name $node
|
||||
if { $exists } { set name [getNodeName $node] }
|
||||
array set vals [list name $name]
|
||||
array set vals [list name $name]
|
||||
}
|
||||
if { $exists } {
|
||||
if { $flags == 1 } {
|
||||
|
|
@ -384,9 +384,7 @@ proc parseNodeMessage { data len flags } {
|
|||
|
||||
set wlans_needing_update { }
|
||||
if { $vals(emuid) != -1 } {
|
||||
# For Linux (FreeBSD populates ngnodeidmap in l3node.instantiate/
|
||||
# buildInterface when the netgraph ID is known)
|
||||
# populate ngnodeidmap for later use with wireless; it is treated as
|
||||
# For Linux populate ngnodeidmap for later use with wireless; it is treated as
|
||||
# a hex value string (without the leading "0x")
|
||||
global ngnodeidmap
|
||||
foreach wlan [findWlanNodes $node] {
|
||||
|
|
@ -484,7 +482,7 @@ proc apiNodeCreate { node vals_ref } {
|
|||
return
|
||||
}
|
||||
set canv "c$canv"
|
||||
if { [lsearch $canvas_list $canv] < 0 && $canv == "c0" } {
|
||||
if { [lsearch $canvas_list $canv] < 0 && $canv == "c0" } {
|
||||
# special case -- support old imn files with Canvas0
|
||||
global $canv
|
||||
lappend canvas_list $canv
|
||||
|
|
@ -787,12 +785,12 @@ proc apiLinkAddModify { node1 node2 vals_ref add } {
|
|||
updateLinkGuiAttr $wired_link $vals(guiattr)
|
||||
return
|
||||
# if add flag is set and a wired link already exists, assume wlan linkage
|
||||
# special case: rj45 model=1 means link via wireless
|
||||
# special case: rj45 model=1 means link via wireless
|
||||
} elseif {[nodeType $node1] == "rj45" || [nodeType $node2] == "rj45"} {
|
||||
if { [nodeType $node1] == "rj45" } {
|
||||
set rj45node $node1; set othernode $node2;
|
||||
} else { set rj45node $node2; set othernode $node1; }
|
||||
if { [netconfFetchSection $rj45node model] == 1 } {
|
||||
if { [netconfFetchSection $rj45node model] == 1 } {
|
||||
set wlan [findWlanNodes $othernode]
|
||||
if {$wlan != ""} {newGUILink $wlan $rj45node};# link rj4node to wlan
|
||||
}
|
||||
|
|
@ -1034,7 +1032,7 @@ proc parseRegMessage { data len flags channel } {
|
|||
# TLV header
|
||||
if { [binary scan $data @${current}cc type length] != 2 } {
|
||||
puts "TLV header error"
|
||||
break
|
||||
break
|
||||
}
|
||||
set length [expr {$length & 0xFF}]; # convert signed to unsigned
|
||||
if { $length == 0 } {
|
||||
|
|
@ -1078,9 +1076,9 @@ proc parseRegMessage { data len flags channel } {
|
|||
if { $session != "" } {
|
||||
# The channel passed to here is soon after discarded for
|
||||
# sessions that are started from XML or Python scripts. This causes
|
||||
# an exception in the GUI when responding back to daemon if the
|
||||
# response is sent after the channel has been destroyed. Setting
|
||||
# the channel to -1 basically disables the GUI response to the daemon,
|
||||
# an exception in the GUI when responding back to daemon if the
|
||||
# response is sent after the channel has been destroyed. Setting
|
||||
# the channel to -1 basically disables the GUI response to the daemon,
|
||||
# but it turns out the daemon does not need the response anyway.
|
||||
set channel -1
|
||||
# assume session string only contains one session number
|
||||
|
|
@ -1432,7 +1430,7 @@ proc parseEventMessage { data len flags channel } {
|
|||
2 {
|
||||
incr current $pad
|
||||
binary scan $data @${current}I eventtype
|
||||
if { $prmsg == 1} {
|
||||
if { $prmsg == 1} {
|
||||
set typestr ""
|
||||
foreach t [array names eventtypes] {
|
||||
if { $eventtypes($t) == $eventtype } {
|
||||
|
|
@ -1493,7 +1491,7 @@ proc parseEventMessage { data len flags channel } {
|
|||
set name [lindex [getEmulPlugin "*"] 0]
|
||||
if { [getAssignedRemoteServers] == "" } {
|
||||
# start a new session if not distributed
|
||||
# otherwise we need to allow time for node delete messages
|
||||
# otherwise we need to allow time for node delete messages
|
||||
# from other servers
|
||||
pluginConnect $name disconnect 1
|
||||
pluginConnect $name connect 1
|
||||
|
|
@ -1529,7 +1527,7 @@ proc parseSessionMessage { data len flags channel } {
|
|||
set typelength [parseTLVHeader $data current]
|
||||
set type [lindex $typelength 0]
|
||||
set length [lindex $typelength 1]
|
||||
if { $length == 0 || $length == "" } {
|
||||
if { $length == 0 || $length == "" } {
|
||||
puts "warning: zero-length TLV, discarding remainder of message!"
|
||||
break
|
||||
}
|
||||
|
|
@ -1737,7 +1735,7 @@ proc sendNodePosMessage { channel node nodeid x y wlanid force } {
|
|||
if {$wlanid > -1} { incr len 8 }
|
||||
if {$force == 1 } { set crit 0x4 } else { set crit 0x0 }
|
||||
#puts "sending [expr $len+4] bytes: $nodeid $x $y $wlanid"
|
||||
if { $prmsg == 1 } {
|
||||
if { $prmsg == 1 } {
|
||||
puts -nonewline ">NODE(flags=$crit,$node,x=$x,y=$y" }
|
||||
set msg [binary format ccSc2sIc2Sc2S \
|
||||
1 $crit $len \
|
||||
|
|
@ -1805,8 +1803,8 @@ proc sendNodeAddMessage { channel node } {
|
|||
} else {
|
||||
set canv ""
|
||||
}
|
||||
|
||||
# services
|
||||
|
||||
# services
|
||||
set svc [getNodeServices $node false]
|
||||
set svc [join $svc "|"]
|
||||
set svc_len [string length $svc]
|
||||
|
|
@ -1854,7 +1852,7 @@ proc sendNodeAddMessage { channel node } {
|
|||
set mac [join [split $macstr ":"] ""]
|
||||
puts -nonewline $channel [binary format c2x2W {0x5 8} 0x$mac]
|
||||
}
|
||||
|
||||
|
||||
# IPv6 address
|
||||
if { $ipv6 != 0 } {
|
||||
if { $prmsg == 1 } { puts -nonewline "$ipv6str," }
|
||||
|
|
@ -1943,7 +1941,7 @@ proc sendNodeDelMessage { channel node } {
|
|||
proc sendLinkMessage { channel link type {sendboth true} } {
|
||||
global showAPI
|
||||
set prmsg $showAPI
|
||||
|
||||
|
||||
set node1 [lindex [linkPeers $link] 0]
|
||||
set node2 [lindex [linkPeers $link] 1]
|
||||
set if1 [ifcByPeer $node1 $node2]; set if2 [ifcByPeer $node2 $node1]
|
||||
|
|
@ -2207,7 +2205,7 @@ proc getIfcAddrs { node ifc ipv4p ipv6p macp ipv4maskp ipv6maskp lenp } {
|
|||
|
||||
# IPv4 address
|
||||
set ipv4str [getIfcIPv4addr $node $ifc]
|
||||
if {$ipv4str != ""} {
|
||||
if {$ipv4str != ""} {
|
||||
set ipv4 [lindex [split $ipv4str /] 0]
|
||||
if { [info exists ipv4mask ] } {
|
||||
set ipv4mask [lindex [split $ipv4str / ] 1]
|
||||
|
|
@ -2222,7 +2220,7 @@ proc getIfcAddrs { node ifc ipv4p ipv6p macp ipv4maskp ipv6maskp lenp } {
|
|||
|
||||
# IPv6 address
|
||||
set ipv6str [getIfcIPv6addr $node $ifc]
|
||||
if {$ipv6str != ""} {
|
||||
if {$ipv6str != ""} {
|
||||
set ipv6 [lindex [split $ipv6str /] 0]
|
||||
if { [info exists ipv6mask ] } {
|
||||
set ipv6mask [lindex [split $ipv6str / ] 1]
|
||||
|
|
@ -2248,7 +2246,7 @@ proc getIfcAddrs { node ifc ipv4p ipv6p macp ipv4maskp ipv6maskp lenp } {
|
|||
|
||||
#
|
||||
# Register Message: (registration types)
|
||||
# This is a simple Register Message, types is an array of
|
||||
# This is a simple Register Message, types is an array of
|
||||
# <module TLV, string> tuples.
|
||||
proc sendRegMessage { channel flags types_list } {
|
||||
global showAPI regtypes
|
||||
|
|
@ -2361,7 +2359,7 @@ proc sendConfRequestMessage { channel node model flags netid opaque } {
|
|||
set msg4 [binary format c2sI {0x23 4} 0 0x$netid ]
|
||||
}
|
||||
|
||||
#catch {puts -nonewline $channel $msg1$model$model_pad$msg2$msg3$msg4$msg5}
|
||||
#catch {puts -nonewline $channel $msg1$model$model_pad$msg2$msg3$msg4$msg5}
|
||||
puts -nonewline $channel $msg1$msg1b$msg1c$model$model_pad$msg2$msg3$msg4
|
||||
if { $opaque_len > 0 } { puts -nonewline $channel $msgop }
|
||||
|
||||
|
|
@ -2436,7 +2434,7 @@ proc sendConfReplyMessage { channel node model types values opaque } {
|
|||
# session number
|
||||
set msg3 ""
|
||||
if { $session != "" } {
|
||||
incr len [expr {2 + $session_len + $session_pad_len }]
|
||||
incr len [expr {2 + $session_len + $session_pad_len }]
|
||||
set msg3 [binary format cc 0x0A $session_len]
|
||||
set msg3 $msg3$session$session_pad
|
||||
}
|
||||
|
|
@ -2472,7 +2470,7 @@ proc sendEventMessage { channel type nodenum name data flags } {
|
|||
set data_pad_len [pad_32bit $data_len]
|
||||
if { $data_len > 0 } { incr len [expr {2 + $data_len + $data_pad_len}] }
|
||||
|
||||
if { $prmsg == 1 } {
|
||||
if { $prmsg == 1 } {
|
||||
puts -nonewline ">EVENT(flags=$flags," }
|
||||
set msg [binary format ccS 8 $flags $len ] ;# message header
|
||||
|
||||
|
|
@ -2481,7 +2479,7 @@ proc sendEventMessage { channel type nodenum name data flags } {
|
|||
if { $prmsg == 1 } { puts -nonewline "node=$nodenum," }
|
||||
set msg2 [binary format c2sI {0x01 4} 0 $nodenum]
|
||||
}
|
||||
if { $prmsg == 1} {
|
||||
if { $prmsg == 1} {
|
||||
set typestr ""
|
||||
foreach t [array names eventtypes] {
|
||||
if { $eventtypes($t) == $type } { set typestr "-$t"; break }
|
||||
|
|
@ -2513,7 +2511,7 @@ proc sendEventMessage { channel type nodenum name data flags } {
|
|||
|
||||
|
||||
# deploy working configuration using CORE API
|
||||
# Deploys a current working configuration. It creates all the
|
||||
# Deploys a current working configuration. It creates all the
|
||||
# nodes and link as defined in configuration file.
|
||||
proc deployCfgAPI { sock } {
|
||||
global eid
|
||||
|
|
@ -2546,13 +2544,13 @@ proc deployCfgAPI { sock } {
|
|||
|
||||
sendSessionProperties $sock
|
||||
|
||||
# this tells the CORE services that we are starting to send
|
||||
# this tells the CORE services that we are starting to send
|
||||
# configuration data
|
||||
# clear any existing config
|
||||
sendEventMessage $sock $eventtypes(definition_state) -1 "" "" 0
|
||||
# inform CORE services about emulation servers, hook scripts, canvas info,
|
||||
# and services
|
||||
sendEventMessage $sock $eventtypes(configuration_state) -1 "" "" 0
|
||||
sendEventMessage $sock $eventtypes(configuration_state) -1 "" "" 0
|
||||
sendEmulationServerInfo $sock 0
|
||||
sendSessionOptions $sock
|
||||
sendHooks $sock
|
||||
|
|
@ -2567,7 +2565,7 @@ proc deployCfgAPI { sock } {
|
|||
set type [nodeType $node]
|
||||
set name [getNodeName $node]
|
||||
if { $type == "pseudo" } { continue }
|
||||
|
||||
|
||||
statgraph inc 1
|
||||
statline "Creating node $name"
|
||||
if { [[typemodel $node].layer] == "NETWORK" } {
|
||||
|
|
@ -2611,7 +2609,7 @@ proc deployCfgAPI { sock } {
|
|||
# status bar graph
|
||||
statgraph off 0
|
||||
statline "Network topology instantiated in [expr [clock seconds] - $t_start] seconds ([llength $node_list] nodes and [llength $link_list] links)."
|
||||
|
||||
|
||||
# TODO: turn on tcpdump if enabled; customPostConfigCommands;
|
||||
# addons 4 deployCfgHook
|
||||
|
||||
|
|
@ -2628,8 +2626,8 @@ proc deployCfgAPI { sock } {
|
|||
sendTrafficScripts $sock
|
||||
|
||||
# tell the CORE services that we are ready to instantiate
|
||||
sendEventMessage $sock $eventtypes(instantiation_state) -1 "" "" 0
|
||||
|
||||
sendEventMessage $sock $eventtypes(instantiation_state) -1 "" "" 0
|
||||
|
||||
set deployCfgAPI_lock 0 ;# unlock
|
||||
|
||||
statline "Network topology instantiated in [expr [clock seconds] - $t_start] seconds ([llength $node_list] nodes and [llength $link_list] links)."
|
||||
|
|
@ -2651,7 +2649,7 @@ proc shutdownSession {} {
|
|||
set plugin [lindex [getEmulPlugin "*"] 0]
|
||||
set sock [pluginConnect $plugin connect true]
|
||||
|
||||
sendEventMessage $sock $eventtypes(datacollect_state) -1 "" "" 0
|
||||
sendEventMessage $sock $eventtypes(datacollect_state) -1 "" "" 0
|
||||
|
||||
# shut down all links
|
||||
foreach link $link_list {
|
||||
|
|
@ -2712,7 +2710,7 @@ proc sendNodeTypeInfo { sock reset } {
|
|||
sendConfRequestMessage $sock -1 "all" 0x3 -1 ""
|
||||
return
|
||||
}
|
||||
# build a list of node types in use
|
||||
# build a list of node types in use
|
||||
set typesinuse ""
|
||||
foreach node $node_list {
|
||||
set type [nodeType $node]
|
||||
|
|
@ -2974,7 +2972,7 @@ proc sendFileMessage { channel node type f sf data data_len } {
|
|||
set prmsg $showAPI
|
||||
|
||||
set node_num [string range $node 1 end]
|
||||
|
||||
|
||||
set f_len [string length $f]
|
||||
set f_pad_len [pad_32bit $f_len]
|
||||
set f_pad [binary format x$f_pad_len]
|
||||
|
|
@ -3013,7 +3011,7 @@ proc sendFileMessage { channel node type f sf data data_len } {
|
|||
if { $prmsg == 1 } {
|
||||
puts -nonewline ">FILE(flags=$flags,$node,f=$f,"
|
||||
if { $type != "" } { puts -nonewline "type=$type," }
|
||||
if { $sf != "" } { puts "src=$sf)"
|
||||
if { $sf != "" } { puts "src=$sf)"
|
||||
} else { puts "data=($data_len))" }
|
||||
}
|
||||
|
||||
|
|
@ -3077,7 +3075,7 @@ proc sendSessionMessage { channel flags num name sfile nodecount tf user } {
|
|||
set user_pad_len [pad_32bit $user_len]
|
||||
if { $user_len > 0 } { incr len [expr { 2 + $user_len + $user_pad_len }] }
|
||||
|
||||
if { $prmsg == 1 } {
|
||||
if { $prmsg == 1 } {
|
||||
puts -nonewline ">SESSION(flags=$flags" }
|
||||
set msgh [binary format ccS 0x09 $flags $len ] ;# message header
|
||||
|
||||
|
|
@ -3089,7 +3087,7 @@ proc sendSessionMessage { channel flags num name sfile nodecount tf user } {
|
|||
set msg2 ""
|
||||
if { $name_len > 0 } {
|
||||
if { $prmsg == 1 } { puts -nonewline ",name=$name" }
|
||||
# TODO: name_len > 255
|
||||
# TODO: name_len > 255
|
||||
set name_hdr [binary format cc 0x02 $name_len]
|
||||
set name_pad [binary format x$name_pad_len]
|
||||
set msg2 "$name_hdr$name$name_pad"
|
||||
|
|
@ -3097,7 +3095,7 @@ proc sendSessionMessage { channel flags num name sfile nodecount tf user } {
|
|||
set msg3 ""
|
||||
if { $sfile_len > 0 } {
|
||||
if { $prmsg == 1 } { puts -nonewline ",file=$sfile" }
|
||||
# TODO: sfile_len > 255
|
||||
# TODO: sfile_len > 255
|
||||
set sfile_hdr [binary format cc 0x03 $sfile_len]
|
||||
set sfile_pad [binary format x$sfile_pad_len]
|
||||
set msg3 "$sfile_hdr$sfile$sfile_pad"
|
||||
|
|
@ -3150,11 +3148,11 @@ proc xmlFileLoadSave { cmd name } {
|
|||
# inform daemon about nodes and links when saving in edit mode
|
||||
if { $cmd == "save" && $oper_mode != "exec" } {
|
||||
sendSessionProperties $sock
|
||||
# this tells the CORE services that we are starting to send
|
||||
# this tells the CORE services that we are starting to send
|
||||
# configuration data
|
||||
# clear any existing config
|
||||
sendEventMessage $sock $eventtypes(definition_state) -1 "" "" 0
|
||||
sendEventMessage $sock $eventtypes(configuration_state) -1 "" "" 0
|
||||
sendEventMessage $sock $eventtypes(configuration_state) -1 "" "" 0
|
||||
sendEmulationServerInfo $sock 0
|
||||
sendSessionOptions $sock
|
||||
sendHooks $sock
|
||||
|
|
@ -3246,7 +3244,7 @@ proc buildStringTLV { type data len_ref } {
|
|||
}
|
||||
|
||||
if { $data_len > 255 } {
|
||||
set hdr [binary format ccS $type 0 $data_len]
|
||||
set hdr [binary format ccS $type 0 $data_len]
|
||||
set hdr_len 4
|
||||
} else {
|
||||
set hdr [binary format cc $type $data_len]
|
||||
|
|
@ -3274,7 +3272,7 @@ proc pad_32bit { len } {
|
|||
|
||||
proc macToString { mac_num } {
|
||||
set mac_bytes ""
|
||||
# convert 64-bit integer into 12-digit hex string
|
||||
# convert 64-bit integer into 12-digit hex string
|
||||
set mac_num 0x[format "%.12lx" $mac_num]
|
||||
while { $mac_num > 0 } {
|
||||
# append 8-bit hex number to list
|
||||
|
|
@ -3295,7 +3293,7 @@ proc macToString { mac_num } {
|
|||
set r {}
|
||||
set i [llength $mac_bytes]
|
||||
while { $i > 0 } { lappend r [lindex $mac_bytes [incr i -1]] }
|
||||
|
||||
|
||||
return [join $r :]
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -35,24 +35,24 @@
|
|||
# NAME
|
||||
# cfgparse.tcl -- file used for parsing the configuration
|
||||
# FUNCTION
|
||||
# This module is used for parsing the configuration, i.e. reading the
|
||||
# configuration from a file or a string and writing the configuration
|
||||
# to a file or a string. This module also contains a function for returning
|
||||
# This module is used for parsing the configuration, i.e. reading the
|
||||
# configuration from a file or a string and writing the configuration
|
||||
# to a file or a string. This module also contains a function for returning
|
||||
# a new ID for nodes, links and canvases.
|
||||
#****
|
||||
|
||||
#****f* nodecfg.tcl/dumpputs
|
||||
# NAME
|
||||
# dumpputs -- puts a string to a file or a string configuration
|
||||
# dumpputs -- puts a string to a file or a string configuration
|
||||
# SYNOPSIS
|
||||
# dumpputs $method $destination $string
|
||||
# FUNCTION
|
||||
# Puts a sting to the file or appends the string configuration (used for
|
||||
# Puts a sting to the file or appends the string configuration (used for
|
||||
# undo functions), the choice depends on the value of method parameter.
|
||||
# INPUTS
|
||||
# * method -- method used. Possiable values are file (if saving the string
|
||||
# * method -- method used. Possiable values are file (if saving the string
|
||||
# to the file) and string (if appending the string configuration)
|
||||
# * dest -- destination used. File_id for files, and string name for string
|
||||
# * dest -- destination used. File_id for files, and string name for string
|
||||
# configuration
|
||||
# * string -- the string that is inserted to a file or appended to the string
|
||||
# configuartion
|
||||
|
|
@ -73,7 +73,7 @@ proc dumpputs {method dest string} {
|
|||
|
||||
#****f* nodecfg.tcl/dumpCfg
|
||||
# NAME
|
||||
# dumpCfg -- puts the current configuraton to a file or a string
|
||||
# dumpCfg -- puts the current configuraton to a file or a string
|
||||
# SYNOPSIS
|
||||
# dumpCfg $method $destination
|
||||
# FUNCTION
|
||||
|
|
@ -81,7 +81,7 @@ proc dumpputs {method dest string} {
|
|||
# INPUTS
|
||||
# * method -- used method. Possiable values are file (saving current congif
|
||||
# to the file) and string (saving current config in a string)
|
||||
# * dest -- destination used. File_id for files, and string name for string
|
||||
# * dest -- destination used. File_id for files, and string name for string
|
||||
# configurations
|
||||
#****
|
||||
|
||||
|
|
@ -95,7 +95,7 @@ proc dumpCfg {method dest} {
|
|||
dumpputs $method $dest "\}"
|
||||
dumpputs $method $dest ""
|
||||
}
|
||||
|
||||
|
||||
foreach node $node_list {
|
||||
global $node
|
||||
upvar 0 $node lnode
|
||||
|
|
@ -129,7 +129,7 @@ proc dumpCfg {method dest} {
|
|||
}
|
||||
}
|
||||
dumpputs $method $dest " \}"
|
||||
} elseif { "[lindex $element 0]" == "ipsec-config" } {
|
||||
} elseif { "[lindex $element 0]" == "ipsec-config" } {
|
||||
dumpputs $method $dest " ipsec-config \{"
|
||||
foreach line [lindex $element 1] {
|
||||
if { $line != {} } {
|
||||
|
|
@ -228,24 +228,24 @@ proc dumpGlobalOptions { method dest } {
|
|||
global mac_addr_start
|
||||
|
||||
dumpputs $method $dest "option global \{"
|
||||
if {$showIfNames == 0} {
|
||||
dumpputs $method $dest " interface_names no"
|
||||
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"
|
||||
if {$showIfIPaddrs == 0} {
|
||||
dumpputs $method $dest " ip_addresses no"
|
||||
} else {
|
||||
dumpputs $method $dest " ip_addresses yes" }
|
||||
if {$showIfIPv6addrs == 0} {
|
||||
dumpputs $method $dest " ipv6_addresses no"
|
||||
if {$showIfIPv6addrs == 0} {
|
||||
dumpputs $method $dest " ipv6_addresses no"
|
||||
} else {
|
||||
dumpputs $method $dest " ipv6_addresses yes" }
|
||||
if {$showNodeLabels == 0} {
|
||||
dumpputs $method $dest " node_labels no"
|
||||
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"
|
||||
if {$showLinkLabels == 0} {
|
||||
dumpputs $method $dest " link_labels no"
|
||||
} else {
|
||||
dumpputs $method $dest " link_labels yes" }
|
||||
if {$showAPI == 0} {
|
||||
|
|
@ -290,7 +290,7 @@ proc setGlobalOption { field value } {
|
|||
global showIfIPaddrs showIfIPv6addrs
|
||||
global showBkgImage showGrid showAnnotations
|
||||
global showAPI
|
||||
global mac_addr_start
|
||||
global mac_addr_start
|
||||
global g_traffic_start_opt
|
||||
global g_view_locked
|
||||
|
||||
|
|
@ -400,8 +400,8 @@ proc cleanupGUIState {} {
|
|||
# SYNOPSIS
|
||||
# loadCfg $cfg
|
||||
# FUNCTION
|
||||
# Loads the configuration written in the cfg string to a current
|
||||
# configuration.
|
||||
# Loads the configuration written in the cfg string to a current
|
||||
# configuration.
|
||||
# INPUTS
|
||||
# * cfg -- string containing the new working configuration.
|
||||
#****
|
||||
|
|
@ -489,7 +489,7 @@ proc loadCfg { cfg } {
|
|||
# consume first two list elements from line
|
||||
set value [lindex $line 1]
|
||||
set line [lreplace $line 0 1]
|
||||
|
||||
|
||||
if {"$class" == "node"} {
|
||||
switch -exact -- $field {
|
||||
type {
|
||||
|
|
@ -561,7 +561,7 @@ proc loadCfg { cfg } {
|
|||
}
|
||||
ipsec-config {
|
||||
set cfg ""
|
||||
|
||||
|
||||
foreach zline [split $value {
|
||||
}] {
|
||||
if { [string index "$zline" 0] == " " } {
|
||||
|
|
@ -600,7 +600,8 @@ proc loadCfg { cfg } {
|
|||
custom-pre-config-commands {
|
||||
# Boeing - custom pre config commands
|
||||
set cfg ""
|
||||
foreach zline [split $value {
}] {
|
||||
foreach zline [split $value {
|
||||
}] {
|
||||
if { [string index "$zline" 0] == " " } {
|
||||
set zline [string replace "$zline" 0 0]
|
||||
}
|
||||
|
|
@ -612,7 +613,8 @@ proc loadCfg { cfg } {
|
|||
custom-post-config-commands {
|
||||
# Boeing - custom post config commands
|
||||
set cfg ""
|
||||
foreach zline [split $value {
}] {
|
||||
foreach zline [split $value {
|
||||
}] {
|
||||
if { [string index "$zline" 0] == " " } {
|
||||
set zline [string replace "$zline" 0 0]
|
||||
}
|
||||
|
|
@ -628,7 +630,8 @@ proc loadCfg { cfg } {
|
|||
ine-config {
|
||||
# Boeing - INE
|
||||
set cfg ""
|
||||
foreach zline [split $value {
}] {
|
||||
foreach zline [split $value {
|
||||
}] {
|
||||
if { [string index "$zline" 0] == " " } {
|
||||
set zline [string replace "$zline" 0 0]
|
||||
}
|
||||
|
|
@ -682,7 +685,7 @@ proc loadCfg { cfg } {
|
|||
switch -exact -- $field {
|
||||
name {
|
||||
lappend $object "name $value"
|
||||
}
|
||||
}
|
||||
height {
|
||||
lappend $object "height $value"
|
||||
}
|
||||
|
|
@ -695,10 +698,10 @@ proc loadCfg { cfg } {
|
|||
y {
|
||||
lappend $object "y $value"
|
||||
}
|
||||
color {
|
||||
color {
|
||||
lappend $object "color $value"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
} elseif {"$class" == "link"} {
|
||||
switch -exact -- $field {
|
||||
nodes {
|
||||
|
|
@ -863,20 +866,20 @@ proc loadCfg { cfg } {
|
|||
|
||||
#****f* nodecfg.tcl/newObjectId
|
||||
# NAME
|
||||
# newObjectId -- new object Id
|
||||
# newObjectId -- new object Id
|
||||
# SYNOPSIS
|
||||
# set obj_id [newObjectId $type]
|
||||
# FUNCTION
|
||||
# Returns the Id for a new object of the defined type. Supported types
|
||||
# are node, link and canvas. The Id is in the form $mark$number. $mark is the
|
||||
# are node, link and canvas. The Id is in the form $mark$number. $mark is the
|
||||
# first letter of the given type and $number is the first available number to
|
||||
# that can be used for id.
|
||||
# that can be used for id.
|
||||
# INPUTS
|
||||
# * type -- the type of the new object. Can be node, link or canvas.
|
||||
# RESULT
|
||||
# * obj_id -- object Id in the form $mark$number. $mark is the
|
||||
# * obj_id -- object Id in the form $mark$number. $mark is the
|
||||
# first letter of the given type and $number is the first available number to
|
||||
# that can be used for id.
|
||||
# that can be used for id.
|
||||
#****
|
||||
|
||||
proc newObjectId { type } {
|
||||
|
|
@ -950,7 +953,7 @@ proc loadServersConf { } {
|
|||
global CONFDIR exec_servers DEFAULT_API_PORT
|
||||
set confname "$CONFDIR/servers.conf"
|
||||
if { [catch { set f [open "$confname" r] } ] } {
|
||||
puts "Creating a default $confname"
|
||||
puts "Creating a default $confname"
|
||||
if { [catch { set f [open "$confname" w+] } ] } {
|
||||
puts "***Warning: could not create a default $confname file."
|
||||
return
|
||||
|
|
@ -1035,7 +1038,7 @@ proc popupPrefs {} {
|
|||
-command "addFileToMrulist \"\""
|
||||
pack $wi.dirs.mru.label $wi.dirs.mru.num $wi.dirs.mru.clear -side left
|
||||
pack $wi.dirs.mru -side top -anchor w -padx 4 -pady 4
|
||||
|
||||
|
||||
pack $wi.dirs -side top -fill x
|
||||
|
||||
#
|
||||
|
|
@ -1049,7 +1052,7 @@ proc popupPrefs {} {
|
|||
-variable g_prefs(gui_save_size)
|
||||
pack $wi.win.win.savepos $wi.win.win.savesiz -side left -anchor w -padx 4
|
||||
pack $wi.win.win -side top -anchor w -padx 4 -pady 4
|
||||
|
||||
|
||||
frame $wi.win.a
|
||||
checkbutton $wi.win.a.snaptogrid -text "snap to grid" \
|
||||
-variable g_prefs(gui_snap_grid)
|
||||
|
|
@ -1123,9 +1126,8 @@ proc initDefaultPrefs {} {
|
|||
# variable expansions must be done here
|
||||
array set g_prefs [list default_conf_path "$CONFDIR/configs"]
|
||||
array set g_prefs [list gui_canvas_refpt "$DEFAULT_REFPT"]
|
||||
if { $tcl_platform(os) == "FreeBSD" } { set shell "/usr/local/bin/bash"
|
||||
} else { set shell "bash" }
|
||||
array set g_prefs [list shell $shell]
|
||||
set shell "bash"
|
||||
array set g_prefs [list shell $shell]
|
||||
array set g_prefs [list gui_text_editor [get_text_editor true]]
|
||||
array set g_prefs [list gui_term_prog [get_term_prog true]]
|
||||
setDefaultAddrs ipv4
|
||||
|
|
|
|||
|
|
@ -86,11 +86,7 @@ node n2 {
|
|||
HN=`hostname`
|
||||
SCRIPTDIR=$SESSION_DIR
|
||||
LOGDIR=/var/log
|
||||
|
||||
if [ `uname` = "FreeBSD" ]; then
|
||||
SCRIPTDIR=/tmp/e0_$HN
|
||||
LOGDIR=$SCRIPTDIR
|
||||
fi
|
||||
|
||||
cd $SCRIPTDIR
|
||||
(
|
||||
cat << 'EOF'
|
||||
|
|
|
|||
276
gui/editor.tcl
276
gui/editor.tcl
|
|
@ -34,7 +34,7 @@
|
|||
#****h* imunes/editor.tcl
|
||||
# NAME
|
||||
# editor.tcl -- file used for defining functions that can be used in
|
||||
# edit mode as well as all the functions which change the appearance
|
||||
# edit mode as well as all the functions which change the appearance
|
||||
# of the imunes GUI.
|
||||
# FUNCTION
|
||||
# This module is used for defining all possible actions in imunes
|
||||
|
|
@ -71,8 +71,8 @@ proc animateCursor {} {
|
|||
# split links and links connecting nodes on different canvases.
|
||||
# INPUTS
|
||||
# * link_id -- the link id
|
||||
# * atomic -- defines if the remove was atomic action or a part
|
||||
# of a composed, non-atomic action (relevant for updating log
|
||||
# * atomic -- defines if the remove was atomic action or a part
|
||||
# of a composed, non-atomic action (relevant for updating log
|
||||
# for undo).
|
||||
#****
|
||||
|
||||
|
|
@ -137,7 +137,7 @@ proc removeGUINode { node } {
|
|||
# SYNOPSIS
|
||||
# updateUndoLog
|
||||
# FUNCTION
|
||||
# Updates the undo log. Writes the current configuration to the
|
||||
# Updates the undo log. Writes the current configuration to the
|
||||
# undolog array and updates the undolevel variable.
|
||||
#****
|
||||
|
||||
|
|
@ -161,7 +161,7 @@ proc updateUndoLog {} {
|
|||
# NAME
|
||||
# undo -- undo function
|
||||
# SYNOPSIS
|
||||
# undo
|
||||
# undo
|
||||
# FUNCTION
|
||||
# Undo the change. Reads the undolog and updates the current
|
||||
# configuration. Reduces the value of undolevel.
|
||||
|
|
@ -185,10 +185,10 @@ proc undo {} {
|
|||
# SYNOPSIS
|
||||
# redo
|
||||
# FUNCTION
|
||||
# Redo the change if possible (redolevel is greater than
|
||||
# Redo the change if possible (redolevel is greater than
|
||||
# undolevel). Reads the configuration from undolog and
|
||||
# updates the current configuration. Increases the value
|
||||
# of undolevel.
|
||||
# updates the current configuration. Increases the value
|
||||
# of undolevel.
|
||||
#****
|
||||
|
||||
proc redo {} {
|
||||
|
|
@ -244,7 +244,7 @@ proc redrawAll {} {
|
|||
"-$border -$border [expr {$e_sizex + $border}] \
|
||||
[expr {$e_sizey + $border}]"
|
||||
|
||||
|
||||
|
||||
saveRestoreWlanLinks .c save
|
||||
.c delete all
|
||||
set background [.c create rectangle 0 0 $e_sizex $e_sizey \
|
||||
|
|
@ -264,7 +264,7 @@ proc redrawAll {} {
|
|||
if { [getNodeCanvas $obj] == $curcanvas } {
|
||||
drawAnnotation $obj
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Grid
|
||||
|
|
@ -303,7 +303,7 @@ proc redrawAll {} {
|
|||
}
|
||||
}
|
||||
|
||||
redrawAllThruplots
|
||||
redrawAllThruplots
|
||||
foreach link $link_list {
|
||||
set nodes [linkPeers $link]
|
||||
if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas ||
|
||||
|
|
@ -330,7 +330,7 @@ proc redrawAll {} {
|
|||
# Draws the specified node. Draws node's image (router pc
|
||||
# host lanswitch rj45 hub pseudo) and label.
|
||||
# The visibility of the label depends on the showNodeLabels
|
||||
# variable for all types of nodes and on invisible variable
|
||||
# variable for all types of nodes and on invisible variable
|
||||
# for pseudo nodes.
|
||||
# INPUTS
|
||||
# * node_id -- node id
|
||||
|
|
@ -342,7 +342,7 @@ proc drawNode { c node } {
|
|||
global curcanvas zoom
|
||||
global wlan
|
||||
if { $c == "" } { set c .c } ;# default canvas
|
||||
|
||||
|
||||
set type [nodeType $node]
|
||||
set coords [getNodeCoords $node]
|
||||
set x [expr {[lindex $coords 0] * $zoom}]
|
||||
|
|
@ -361,7 +361,7 @@ proc drawNode { c node } {
|
|||
if { $tmp != "" } { set cimg $tmp }
|
||||
if { $cimg != "" } {
|
||||
# name of global variable storing the image is the filename without path
|
||||
set img [file tail $cimg]
|
||||
set img [file tail $cimg]
|
||||
# create the variable if the image hasn't been loaded before
|
||||
global [set img]
|
||||
if { ![info exists $img] } {
|
||||
|
|
@ -433,9 +433,9 @@ proc drawNode { c node } {
|
|||
# SYNOPSIS
|
||||
# drawLink link_id
|
||||
# FUNCTION
|
||||
# Draws the specified link. An arrow is displayed for links
|
||||
# Draws the specified link. An arrow is displayed for links
|
||||
# connected to pseudo nodes. If the variable invisible
|
||||
# is specified link connecting a pseudo node stays hidden.
|
||||
# is specified link connecting a pseudo node stays hidden.
|
||||
# INPUTS
|
||||
# * link_id -- link id
|
||||
#****
|
||||
|
|
@ -486,7 +486,7 @@ proc drawLink { link } {
|
|||
}
|
||||
foreach n [list $lnode1 $lnode2] {
|
||||
if { [getNodeHidden $n] } {
|
||||
hideNode $n
|
||||
hideNode $n
|
||||
statline "Hidden node(s) exist."
|
||||
}
|
||||
}
|
||||
|
|
@ -535,7 +535,7 @@ proc drawWlanLink { node1 node2 wlan } {
|
|||
# set ifcName [chooseIfName $lnode1 $lnode2]
|
||||
# FUNCTION
|
||||
# Choose intreface name. The name can be:
|
||||
# * eth -- for interface connecting pc, host and router
|
||||
# * eth -- for interface connecting pc, host and router
|
||||
# * e -- for interface connecting hub and lanswitch
|
||||
# INPUTS
|
||||
# * link_id -- link id
|
||||
|
|
@ -564,7 +564,7 @@ proc chooseIfName { lnode1 lnode2 } {
|
|||
return eth
|
||||
}
|
||||
rj45 {
|
||||
return
|
||||
return
|
||||
}
|
||||
tunnel {
|
||||
return e
|
||||
|
|
@ -589,8 +589,8 @@ proc chooseIfName { lnode1 lnode2 } {
|
|||
# SYNOPSIS
|
||||
# set l2peers [listLANNodes $l2node $l2peers]
|
||||
# FUNCTION
|
||||
# Recursive function for finding all link layer nodes that are
|
||||
# connected to node l2node. Returns the list of all link layer
|
||||
# Recursive function for finding all link layer nodes that are
|
||||
# connected to node l2node. Returns the list of all link layer
|
||||
# nodes that are on the same LAN as l2node.
|
||||
# INPUTS
|
||||
# * l2node -- node id of a link layer node
|
||||
|
|
@ -622,7 +622,7 @@ proc listLANnodes { l2node l2peers } {
|
|||
# FUNCTION
|
||||
# Calculates dx and dy variables of the calling function.
|
||||
# INPUTS
|
||||
# * lnode -- node id of a node whose dx and dy coordinates are
|
||||
# * lnode -- node id of a node whose dx and dy coordinates are
|
||||
# calculated
|
||||
#****
|
||||
|
||||
|
|
@ -680,8 +680,8 @@ proc calcDxDy { lnode } {
|
|||
# address and IPv6 address.
|
||||
# INPUTS
|
||||
# * lnode1 -- node id of a node where the interface resides
|
||||
# * lnode2 -- node id of the node that is connected by this
|
||||
# interface.
|
||||
# * lnode2 -- node id of the node that is connected by this
|
||||
# interface.
|
||||
#****
|
||||
proc updateIfcLabel { lnode1 lnode2 } {
|
||||
global showIfNames showIfIPaddrs showIfIPv6addrs
|
||||
|
|
@ -715,7 +715,7 @@ proc updateIfcLabel { lnode1 lnode2 } {
|
|||
.c itemconfigure "interface && $lnode1 && $link" \
|
||||
-text "$labelstr"
|
||||
# Boeing: hide ifc label on wlans
|
||||
if { [nodeType $lnode1] == "wlan" } {
|
||||
if { [nodeType $lnode1] == "wlan" } {
|
||||
.c itemconfigure "interface && $lnode1 && $link" -state hidden
|
||||
}
|
||||
}
|
||||
|
|
@ -876,11 +876,11 @@ proc redrawWlanLink { link } {
|
|||
|
||||
#****f* editor.tcl/splitGUILink
|
||||
# NAME
|
||||
# splitGUILink -- splits a links
|
||||
# splitGUILink -- splits a links
|
||||
# SYNOPSIS
|
||||
# splitGUILink $link
|
||||
# FUNCTION
|
||||
# Splits the link and draws new links and new pseudo nodes
|
||||
# Splits the link and draws new links and new pseudo nodes
|
||||
# on the canvas.
|
||||
# INPUTS
|
||||
# * link -- link id
|
||||
|
|
@ -925,7 +925,7 @@ proc splitGUILink { link } {
|
|||
|
||||
#****f* editor.tcl/selectNode
|
||||
# NAME
|
||||
# selectNode -- select node
|
||||
# selectNode -- select node
|
||||
# SYNOPSIS
|
||||
# selectNode $c $obj
|
||||
# FUNCTION
|
||||
|
|
@ -1019,11 +1019,11 @@ proc selectAdjacent {} {
|
|||
|
||||
#****f* editor.tcl/button3link
|
||||
# NAME
|
||||
# button3link
|
||||
# button3link
|
||||
# SYNOPSIS
|
||||
# button3link $c $x $y
|
||||
# FUNCTION
|
||||
# This procedure is called when a right mouse button is
|
||||
# This procedure is called when a right mouse button is
|
||||
# clicked on the canvas. If there is a link on the place of
|
||||
# mouse click this procedure creates and configures a popup
|
||||
# menu. The options in the menu are:
|
||||
|
|
@ -1099,7 +1099,7 @@ proc button3link { c x y } {
|
|||
|
||||
#****f* editor.tcl/movetoCanvas
|
||||
# NAME
|
||||
# movetoCanvas -- move to canvas
|
||||
# movetoCanvas -- move to canvas
|
||||
# SYNOPSIS
|
||||
# movetoCanvas $canvas
|
||||
# FUNCTION
|
||||
|
|
@ -1176,7 +1176,7 @@ proc mergeGUINode { node } {
|
|||
# SYNOPSIS
|
||||
# button3node $c $x $y
|
||||
# FUNCTION
|
||||
# This procedure is called when a right mouse button is
|
||||
# This procedure is called when a right mouse button is
|
||||
# clicked on the canvas. Also called when double-clicking
|
||||
# on a node during runtime.
|
||||
# If there is a node on the place of
|
||||
|
|
@ -1190,18 +1190,18 @@ proc mergeGUINode { node } {
|
|||
# that have mirror nodes on the same canvas (Pseudo nodes
|
||||
# created by splitting a link).
|
||||
# * Delete -- delete the node
|
||||
# * Shell window -- specifies the shell window to open in
|
||||
# exec mode. This option is available only to nodes on a
|
||||
# * Shell window -- specifies the shell window to open in
|
||||
# exec mode. This option is available only to nodes on a
|
||||
# network layer
|
||||
# * Ethereal -- opens a Ethereal program for the specified
|
||||
# node and the specified interface. This option is available
|
||||
# * Ethereal -- opens a Ethereal program for the specified
|
||||
# node and the specified interface. This option is available
|
||||
# only for network layer nodes in exec mode.
|
||||
# INPUTS
|
||||
# * c -- tk canvas
|
||||
# * x -- x coordinate for popup menu
|
||||
# * y -- y coordinate for popup menu
|
||||
#****
|
||||
#old proc button3node { c x y }
|
||||
#old proc button3node { c x y }
|
||||
#Boeing
|
||||
proc button3node { c x y button } {
|
||||
global oper_mode env eid canvas_list node_list curcanvas systype g_prefs
|
||||
|
|
@ -1242,7 +1242,7 @@ proc button3node { c x y button } {
|
|||
if { $button == "shift" } { ;# normal bash shell
|
||||
spawnShell $node $shell
|
||||
} else { ;# right-click vtysh shell
|
||||
set cmd [[typemodel $node].shellcmd $node]
|
||||
set cmd [[typemodel $node].shellcmd $node]
|
||||
if { $cmd != "/bin/sh" && $cmd != "" } { spawnShell $node $cmd }
|
||||
}
|
||||
return ;# open shell, don't post a menu
|
||||
|
|
@ -1437,7 +1437,7 @@ proc button3node { c x y button } {
|
|||
addInterfaceCommand $node .button3menu "Wireshark" "wireshark -k -i" \
|
||||
$execstate 0
|
||||
# wireshark on host veth pair -- need veth pair name
|
||||
#wireshark -k -i
|
||||
#wireshark -k -i
|
||||
if { [lindex $systype 0] == "Linux" } {
|
||||
set name [getNodeName $node]
|
||||
.button3menu add command -label "View log..." -state $execstate \
|
||||
|
|
@ -1464,7 +1464,7 @@ proc button3node { c x y button } {
|
|||
# This procedure spawns a new shell for a specified node.
|
||||
# The shell is specified in cmd parameter.
|
||||
# INPUTS
|
||||
# * node -- node id of the node for which the shell
|
||||
# * node -- node id of the node for which the shell
|
||||
# is spawned.
|
||||
# * cmd -- the path to the shell.
|
||||
#****
|
||||
|
|
@ -1527,9 +1527,9 @@ proc raiseAll {c} {
|
|||
# SYNOPSIS
|
||||
# button1 $c $x $y $button
|
||||
# FUNCTION
|
||||
# This procedure is called when a left mouse button is
|
||||
# This procedure is called when a left mouse button is
|
||||
# clicked on the canvas. This procedure selects a new
|
||||
# node or creates a new node, depending on the selected
|
||||
# node or creates a new node, depending on the selected
|
||||
# tool.
|
||||
# INPUTS
|
||||
# * c -- tk canvas
|
||||
|
|
@ -1563,7 +1563,7 @@ proc button1 { c x y button } {
|
|||
set curobj [$c find withtag current]
|
||||
set curtype [lindex [$c gettags current] 0]
|
||||
|
||||
|
||||
|
||||
if { $curtype == "node" || \
|
||||
$curtype == "oval" || $curtype == "rectangle" || $curtype == "text" \
|
||||
|| ( $curtype == "nodelabel" && \
|
||||
|
|
@ -1613,7 +1613,7 @@ proc button1 { c x y button } {
|
|||
if { $g_view_locked == 1 } { return }
|
||||
if { $activetoolp == "routers" } {
|
||||
if {$activetool != "OVS"} {
|
||||
set node [newNode router]
|
||||
set node [newNode router]
|
||||
} else {
|
||||
set node [newNode OVS]}
|
||||
setNodeModel $node $activetool
|
||||
|
|
@ -1666,7 +1666,7 @@ proc button1 { c x y button } {
|
|||
set newlink [$c create line $lastX $lastY $x $y \
|
||||
-fill $defLinkColor -width $defLinkWidth \
|
||||
-tags "link"]
|
||||
# twonode tool support
|
||||
# twonode tool support
|
||||
} elseif {$g_twoNodeSelect != "" && $curtype == "node"} {
|
||||
set curnode [lindex [$c gettags $curobj] 1]
|
||||
selectTwoNode $curnode
|
||||
|
|
@ -1683,14 +1683,14 @@ proc setResizeMode { c x y } {
|
|||
set isThruplot false
|
||||
set type1 notset
|
||||
|
||||
if {$c == ".c"} {
|
||||
if {$c == ".c"} {
|
||||
set t1 [$c gettags current]
|
||||
set o1 [lindex $t1 1]
|
||||
set type1 [nodeType $o1]
|
||||
} else {
|
||||
set o1 $c
|
||||
set c .c
|
||||
set isThruplot true
|
||||
set isThruplot true
|
||||
}
|
||||
#DYL
|
||||
#puts "RESIZE NODETYPE = $type1"
|
||||
|
|
@ -1743,11 +1743,11 @@ proc setResizeMode { c x y } {
|
|||
# NAME
|
||||
# button1-motion
|
||||
# SYNOPSIS
|
||||
# button1-motion $c $x $y
|
||||
# button1-motion $c $x $y
|
||||
# FUNCTION
|
||||
# This procedure is called when a left mouse button is
|
||||
# pressed and the mouse is moved around the canvas.
|
||||
# This procedure creates new select box, moves the
|
||||
# This procedure is called when a left mouse button is
|
||||
# pressed and the mouse is moved around the canvas.
|
||||
# This procedure creates new select box, moves the
|
||||
# selected nodes or draws a new link.
|
||||
# INPUTS
|
||||
# * c -- tk canvas
|
||||
|
|
@ -1767,8 +1767,8 @@ proc button1-motion { c x y } {
|
|||
|
||||
if {$thruPlotDragStart == "dragging"} {
|
||||
#puts "active tool is $activetool"
|
||||
thruPlotDrag $c $thruPlotCur $x $y null true
|
||||
return
|
||||
thruPlotDrag $c $thruPlotCur $x $y null true
|
||||
return
|
||||
}
|
||||
|
||||
# fix occasional error
|
||||
|
|
@ -1800,7 +1800,7 @@ proc button1-motion { c x y } {
|
|||
set dx [expr {$x-$lastX} ]
|
||||
set dy [expr {$y-$lastY} ]
|
||||
# this provides smoother drawing
|
||||
if { $dx > $markersize || $dy > $markersize } {
|
||||
if { $dx > $markersize || $dy > $markersize } {
|
||||
set mark [$c create line $lastX $lastY $x $y \
|
||||
-width $markersize -fill $markercolor -tags "marker"]
|
||||
$c raise $mark \
|
||||
|
|
@ -1886,7 +1886,7 @@ proc button1-motion { c x y } {
|
|||
}
|
||||
# resizing an annotation
|
||||
} elseif { $curtype == "selectmark" } {
|
||||
foreach o [$c find withtag "selected"] {
|
||||
foreach o [$c find withtag "selected"] {
|
||||
set node [lindex [$c gettags $o] 1]
|
||||
set tagovi [$c gettags $o]
|
||||
set koord [getNodeCoords $node]
|
||||
|
|
@ -1992,12 +1992,12 @@ proc button1-motion { c x y } {
|
|||
|
||||
#****f* editor.tcl/pseudo.layer
|
||||
# NAME
|
||||
# pseudo.layer
|
||||
# pseudo.layer
|
||||
# SYNOPSIS
|
||||
# set layer [pseudo.layer]
|
||||
# FUNCTION
|
||||
# Returns the layer on which the pseudo node operates
|
||||
# i.e. returns no layer.
|
||||
# i.e. returns no layer.
|
||||
# RESULT
|
||||
# * layer -- returns an empty string
|
||||
#****
|
||||
|
|
@ -2011,8 +2011,8 @@ proc pseudo.layer {} {
|
|||
# SYNOPSIS
|
||||
# newGUILink $lnode1 $lnode2
|
||||
# FUNCTION
|
||||
# This procedure is called to create a new link between
|
||||
# nodes lnode1 and lnode2. Nodes can be on the same canvas
|
||||
# This procedure is called to create a new link between
|
||||
# nodes lnode1 and lnode2. Nodes can be on the same canvas
|
||||
# or on different canvases. The result of this function
|
||||
# is directly visible in GUI.
|
||||
# INPUTS
|
||||
|
|
@ -2052,10 +2052,10 @@ proc newGUILink { lnode1 lnode2 } {
|
|||
# NAME
|
||||
# button1-release
|
||||
# SYNOPSIS
|
||||
# button1-release $c $x $y
|
||||
# button1-release $c $x $y
|
||||
# FUNCTION
|
||||
# This procedure is called when a left mouse button is
|
||||
# released.
|
||||
# This procedure is called when a left mouse button is
|
||||
# released.
|
||||
# The result of this function depends on the actions
|
||||
# during the button1-motion procedure.
|
||||
# INPUTS
|
||||
|
|
@ -2202,7 +2202,7 @@ proc button1-release { c x y } {
|
|||
nodeEnter $c
|
||||
|
||||
# $changed!=1
|
||||
} elseif {$activetool == "select" } {
|
||||
} elseif {$activetool == "select" } {
|
||||
if {$selectbox == ""} {
|
||||
set x1 $x
|
||||
set y1 $y
|
||||
|
|
@ -2243,10 +2243,10 @@ proc button1-release { c x y } {
|
|||
} else {
|
||||
# select tool resizing an object by dragging its handles
|
||||
# DYL bugfix. if x,y does not change, do not resize!
|
||||
# fixes a bug where the object dissappears
|
||||
if { $x != $x1 || $y != $y1 } {
|
||||
# fixes a bug where the object dissappears
|
||||
if { $x != $x1 || $y != $y1 } {
|
||||
setNodeCoords $resizeobj "$x $y $x1 $y1"
|
||||
}
|
||||
}
|
||||
set redrawNeeded 1
|
||||
set resizemode false
|
||||
}
|
||||
|
|
@ -2269,11 +2269,11 @@ proc button1-release { c x y } {
|
|||
# SYNOPSIS
|
||||
# nodeEnter $c
|
||||
# FUNCTION
|
||||
# This procedure prints the node id, node name and
|
||||
# This procedure prints the node id, node name and
|
||||
# node model (if exists), as well as all the interfaces
|
||||
# of the node in the status line.
|
||||
# of the node in the status line.
|
||||
# Information is presented for the node above which is
|
||||
# the mouse pointer.
|
||||
# the mouse pointer.
|
||||
# INPUTS
|
||||
# * c -- tk canvas
|
||||
#****
|
||||
|
|
@ -2314,7 +2314,7 @@ proc nodeEnter { c } {
|
|||
# This procedure prints the link id, link bandwidth
|
||||
# and link delay in the status line.
|
||||
# Information is presented for the link above which is
|
||||
# the mouse pointer.
|
||||
# the mouse pointer.
|
||||
# INPUTS
|
||||
# * c -- tk canvas
|
||||
#****
|
||||
|
|
@ -2351,13 +2351,13 @@ proc anyLeave {c} {
|
|||
}
|
||||
|
||||
|
||||
#****f* editor.tcl/checkIntRange
|
||||
#****f* editor.tcl/checkIntRange
|
||||
# NAME
|
||||
# checkIntRange -- check integer range
|
||||
# SYNOPSIS
|
||||
# set check [checkIntRange $str $low $high]
|
||||
# FUNCTION
|
||||
# This procedure checks the input string to see if it is
|
||||
# This procedure checks the input string to see if it is
|
||||
# an integer between the low and high value.
|
||||
# INPUTS
|
||||
# str -- string to check
|
||||
|
|
@ -2407,14 +2407,14 @@ proc checkHostname { str } {
|
|||
}
|
||||
|
||||
|
||||
#****f* editor.tcl/focusAndFlash
|
||||
#****f* editor.tcl/focusAndFlash
|
||||
# NAME
|
||||
# focusAndFlash -- focus and flash
|
||||
# SYNOPSIS
|
||||
# focusAndFlash $W $count
|
||||
# FUNCTION
|
||||
# This procedure sets the focus on the bad entry field
|
||||
# and on this filed it provides an effect of flashing
|
||||
# and on this filed it provides an effect of flashing
|
||||
# for approximately 1 second.
|
||||
# INPUTS
|
||||
# * W -- textbox field that caused the bed entry
|
||||
|
|
@ -2454,7 +2454,7 @@ proc focusAndFlash {W {count 9}} {
|
|||
# SYNOPSIS
|
||||
# popupConfigDialog $c
|
||||
# FUNCTION
|
||||
# Dynamically creates a popup dialog box for configuring
|
||||
# Dynamically creates a popup dialog box for configuring
|
||||
# links or nodes in IMUNES.
|
||||
# INPUTS
|
||||
# * c -- canvas id
|
||||
|
|
@ -2540,10 +2540,10 @@ proc popupConfigDialog { c } {
|
|||
$wi.ftop.name insert 0 [getNodeName $target]
|
||||
set img [getNodeImage $target]
|
||||
ttk::button $wi.ftop.img -image $img -command "popupCustomImage $target"
|
||||
|
||||
|
||||
if { $type == "rj45" } {
|
||||
rj45ifclist $wi $target 0
|
||||
}
|
||||
}
|
||||
# execution server
|
||||
global exec_servers node_location
|
||||
set node_location [getNodeLocation $target]
|
||||
|
|
@ -2556,7 +2556,7 @@ proc popupConfigDialog { c } {
|
|||
# end Boeing
|
||||
pack $wi.ftop -side top
|
||||
if { $type == "router" || $type == "OVS"} {
|
||||
|
||||
|
||||
ttk::frame $wi.model -borderwidth 4
|
||||
ttk::label $wi.model.label -text "Type:"
|
||||
set runstate "disabled"
|
||||
|
|
@ -2618,7 +2618,7 @@ proc popupConfigDialog { c } {
|
|||
global conntype
|
||||
set conntype [netconfFetchSection $target "tunnel-type"]
|
||||
if { $conntype == "" } { set conntype "UDP" }
|
||||
|
||||
|
||||
|
||||
# TODO: clean this up
|
||||
ttk::frame $wi.linfo
|
||||
|
|
@ -2804,7 +2804,7 @@ proc popupConfigDialog { c } {
|
|||
ttk::frame $wi.unilabel -borderwidth 4
|
||||
ttk::label $wi.unilabel.updown -text "Symmetric link effects:"
|
||||
pack $wi.unilabel.updown -side left -anchor w
|
||||
pack $wi.unilabel -side top -anchor w
|
||||
pack $wi.unilabel -side top -anchor w
|
||||
|
||||
ttk::frame $wi.bandwidth -borderwidth 4
|
||||
ttk::label $wi.bandwidth.label -anchor e -text "Bandwidth (bps):"
|
||||
|
|
@ -2932,11 +2932,11 @@ proc popupConfigDialog { c } {
|
|||
"popupConfigApply $wi $object_type $target 0"
|
||||
focus $wi.butt.apply
|
||||
# Boeing: remove range circles upon cancel
|
||||
if {$type == "wlan"} {
|
||||
if {$type == "wlan"} {
|
||||
set cancelcmd "set badentry -1 ; destroy $wi;"
|
||||
set cancelcmd "$cancelcmd updateRangeCircles $target 0"
|
||||
set cancelcmd "$cancelcmd updateRangeCircles $target 0"
|
||||
} else {
|
||||
set cancelcmd "set badentry -1 ; destroy $wi"
|
||||
set cancelcmd "set badentry -1 ; destroy $wi"
|
||||
}
|
||||
ttk::button $wi.butt.cancel -text "Cancel" -command $cancelcmd
|
||||
#end Boeing
|
||||
|
|
@ -3072,18 +3072,18 @@ proc macEntryHelper { wi ifc } {
|
|||
# SYNOPSIS
|
||||
# popupConfigApply $w $object_type $target $phase
|
||||
# FUNCTION
|
||||
# This procedure is called when the button apply is pressed in
|
||||
# This procedure is called when the button apply is pressed in
|
||||
# popup configuration dialog box. It reads different
|
||||
# configuration parameters depending on the object_type.
|
||||
# INPUTS
|
||||
# * w -- widget
|
||||
# * object_type -- describes the object type that is currently
|
||||
# * object_type -- describes the object type that is currently
|
||||
# configured. It can be either link or node.
|
||||
# * target -- node id of the configured node or link id of the
|
||||
# configured link
|
||||
# * phase -- This procedure is invoked in two diffenet phases
|
||||
# to enable validation of the entry that was the last made.
|
||||
# When calling this function always use the phase parameter
|
||||
# * phase -- This procedure is invoked in two diffenet phases
|
||||
# to enable validation of the entry that was the last made.
|
||||
# When calling this function always use the phase parameter
|
||||
# set to 0.
|
||||
#****
|
||||
proc popupConfigApply { wi object_type target phase } {
|
||||
|
|
@ -3131,12 +3131,12 @@ proc popupConfigApply { wi object_type target phase } {
|
|||
|
||||
# Boeing - added wlan, remote, tunnel, ktunnel items
|
||||
if { $type == "wlan" } {
|
||||
wlanConfigDialogHelper $wi $target 1
|
||||
wlanConfigDialogHelper $wi $target 1
|
||||
} elseif { $type == "tunnel" } {
|
||||
#
|
||||
# apply tunnel items
|
||||
#
|
||||
set ipaddr "$name/24" ;# tunnel name == IP address of peer
|
||||
set ipaddr "$name/24" ;# tunnel name == IP address of peer
|
||||
set oldipaddr [getIfcIPv4addr $target e0]
|
||||
if { $ipaddr != $oldipaddr } {
|
||||
setIfcIPv4addr $target e0 $ipaddr
|
||||
|
|
@ -3176,7 +3176,7 @@ proc popupConfigApply { wi object_type target phase } {
|
|||
if { $oldlocal != $local } {
|
||||
netconfInsertSection $target [list "local-hook" $local]
|
||||
}
|
||||
# Boeing changing to interface name for RJ45
|
||||
# Boeing changing to interface name for RJ45
|
||||
# } elseif { $type == "rj45" } {
|
||||
# #
|
||||
# # apply rj45 items
|
||||
|
|
@ -3240,7 +3240,7 @@ proc popupConfigApply { wi object_type target phase } {
|
|||
link {
|
||||
global g_link_config_uni_state
|
||||
set mirror [getLinkMirror $target]
|
||||
|
||||
|
||||
if { [setIfChanged $target $mirror $wi "bandwidth" "LinkBandwidth"] } {
|
||||
set changed 1
|
||||
}
|
||||
|
|
@ -3314,7 +3314,7 @@ proc setIfChanged { target mirror wi ctl procname } {
|
|||
# printCanvas $w
|
||||
# FUNCTION
|
||||
# This procedure is called when the print button in
|
||||
# print dialog box is pressed.
|
||||
# print dialog box is pressed.
|
||||
# INPUTS
|
||||
# * w -- print dialog widget
|
||||
#****
|
||||
|
|
@ -3335,12 +3335,12 @@ proc printCanvas { w } {
|
|||
# SYNOPSIS
|
||||
# deleteSelection
|
||||
# FUNCTION
|
||||
# By calling this procedure all the selected nodes in imunes will
|
||||
# By calling this procedure all the selected nodes in imunes will
|
||||
# be deleted.
|
||||
#****
|
||||
proc deleteSelection { } {
|
||||
global changed
|
||||
global background
|
||||
global background
|
||||
global viewid
|
||||
catch {unset viewid}
|
||||
.c config -cursor watch; update
|
||||
|
|
@ -3412,7 +3412,7 @@ proc align2grid {} {
|
|||
# FUNCTION
|
||||
# This procedure rearranges the position of nodes in imunes.
|
||||
# It can be used to rearrange all the nodes or only the selected
|
||||
# nodes.
|
||||
# nodes.
|
||||
# INPUTS
|
||||
# * mode -- when set to "selected" only the selected nodes will be
|
||||
# rearranged.
|
||||
|
|
@ -3594,16 +3594,16 @@ proc rearrange_off { } {
|
|||
}
|
||||
|
||||
|
||||
#****f* editor.tcl/switchCanvas
|
||||
#****f* editor.tcl/switchCanvas
|
||||
# NAME
|
||||
# switchCanvas -- switch canvas
|
||||
# SYNOPSIS
|
||||
# switchCanvas $direction
|
||||
# FUNCTION
|
||||
# This procedure switches the canvas in one of the defined
|
||||
# This procedure switches the canvas in one of the defined
|
||||
# directions (previous, next, first and last).
|
||||
# INPUTS
|
||||
# * direction -- the direction of switching canvas. Can be: prev --
|
||||
# * direction -- the direction of switching canvas. Can be: prev --
|
||||
# previus, next -- next, first -- first, last -- last.
|
||||
#****
|
||||
proc switchCanvas { direction } {
|
||||
|
|
@ -3706,7 +3706,7 @@ proc resizeCanvasPopup {} {
|
|||
|
||||
labelframe $w.size -text "Size"
|
||||
frame $w.size.pixels
|
||||
pack $w.size $w.size.pixels -side top -padx 4 -pady 4 -fill x
|
||||
pack $w.size $w.size.pixels -side top -padx 4 -pady 4 -fill x
|
||||
spinbox $w.size.pixels.x -bg white -width 5
|
||||
$w.size.pixels.x insert 0 $x
|
||||
$w.size.pixels.x configure -from 300 -to 5000 -increment 2
|
||||
|
|
@ -3717,10 +3717,10 @@ proc resizeCanvasPopup {} {
|
|||
label $w.size.pixels.label2 -text "H pixels"
|
||||
pack $w.size.pixels.x $w.size.pixels.label $w.size.pixels.y \
|
||||
$w.size.pixels.label2 -side left -pady 2 -padx 2 -fill x
|
||||
|
||||
|
||||
frame $w.size.meters
|
||||
pack $w.size.meters -side top -padx 4 -pady 4 -fill x
|
||||
spinbox $w.size.meters.x -bg white -width 7
|
||||
pack $w.size.meters -side top -padx 4 -pady 4 -fill x
|
||||
spinbox $w.size.meters.x -bg white -width 7
|
||||
$w.size.meters.x configure -from 300 -to 10000 -increment 100
|
||||
label $w.size.meters.label -text "x"
|
||||
spinbox $w.size.meters.y -bg white -width 7
|
||||
|
|
@ -3789,7 +3789,7 @@ proc resizeCanvasPopup {} {
|
|||
checkbutton $w.default.save -text "Save as default" \
|
||||
-variable resize_canvas_save_default
|
||||
pack $w.default.save -side left -pady 2 -padx 2 -fill x
|
||||
pack $w.default -side bottom -fill x
|
||||
pack $w.default -side bottom -fill x
|
||||
|
||||
# update the size in meters based on pixels
|
||||
syncSizeScale $w xp
|
||||
|
|
@ -3884,7 +3884,7 @@ proc resizeCanvasApply { w } {
|
|||
# SYNOPSIS
|
||||
# animate
|
||||
# FUNCTION
|
||||
# This function animates the selectbox. The animation looks
|
||||
# This function animates the selectbox. The animation looks
|
||||
# different for edit and exec mode.
|
||||
#****
|
||||
proc animate {} {
|
||||
|
|
@ -3929,7 +3929,7 @@ proc zoom { dir } {
|
|||
set newzoom $z
|
||||
}
|
||||
}
|
||||
set zoom $newzoom
|
||||
set zoom $newzoom
|
||||
}
|
||||
redrawAll
|
||||
}
|
||||
|
|
@ -3945,7 +3945,7 @@ proc zoom { dir } {
|
|||
break
|
||||
}
|
||||
}
|
||||
set zoom $newzoom
|
||||
set zoom $newzoom
|
||||
}
|
||||
redrawAll
|
||||
}
|
||||
|
|
@ -3965,7 +3965,7 @@ proc zoom { dir } {
|
|||
# SYNOPSIS
|
||||
# double1onGrid $c %x %y
|
||||
# FUNCTION
|
||||
# As grid is layered above annotations this procedure is used to find
|
||||
# As grid is layered above annotations this procedure is used to find
|
||||
# annotation object closest to cursor
|
||||
#****
|
||||
|
||||
|
|
@ -3977,7 +3977,7 @@ proc double1onGrid { c x y } {
|
|||
return
|
||||
}
|
||||
# Is this really necessary?
|
||||
set coords [getNodeCoords $node]
|
||||
set coords [getNodeCoords $node]
|
||||
set x1 [lindex $coords 0]
|
||||
set y1 [lindex $coords 1]
|
||||
set x2 [lindex $coords 2]
|
||||
|
|
@ -4065,7 +4065,7 @@ proc configRemoteServers {} {
|
|||
frame $wi.s -borderwidth 4
|
||||
listbox $wi.s.servers -selectmode single -width 60 \
|
||||
-yscrollcommand "$wi.s.servers_scroll set" -exportselection 0
|
||||
scrollbar $wi.s.servers_scroll -command "$wi.s.servers yview"
|
||||
scrollbar $wi.s.servers_scroll -command "$wi.s.servers yview"
|
||||
pack $wi.s.servers $wi.s.servers_scroll -fill both -side left
|
||||
pack $wi.s -fill both -side top
|
||||
# add scrollbar
|
||||
|
|
@ -4095,9 +4095,9 @@ proc configRemoteServers {} {
|
|||
button $wi.c.c.add -image $plugin_img_add \
|
||||
-command "configRemoteServersHelper $wi 1"
|
||||
button $wi.c.c.mod -image $plugin_img_save \
|
||||
-command "configRemoteServersHelper $wi 2"
|
||||
-command "configRemoteServersHelper $wi 2"
|
||||
button $wi.c.c.del -image $plugin_img_del \
|
||||
-command "configRemoteServersHelper $wi 3"
|
||||
-command "configRemoteServersHelper $wi 3"
|
||||
pack $wi.c.c.add $wi.c.c.mod $wi.c.c.del -side left
|
||||
pack $wi.c -fill x -side top
|
||||
# assignment buttons
|
||||
|
|
@ -4134,7 +4134,7 @@ proc configRemoteServers {} {
|
|||
# apply/cancel buttons
|
||||
frame $wi.b -borderwidth 4
|
||||
button $wi.b.apply -text "Apply" -command \
|
||||
"writeServersConf; redrawAll; destroy $wi"
|
||||
"writeServersConf; redrawAll; destroy $wi"
|
||||
button $wi.b.cancel -text "Cancel" -command "loadServersConf; destroy $wi"
|
||||
pack $wi.b.cancel $wi.b.apply -side right
|
||||
pack $wi.b -side bottom
|
||||
|
|
@ -4169,7 +4169,7 @@ proc configRemoteServersHelper { wi action } {
|
|||
set newserver [$wi.c.c.name get]
|
||||
$wi.s.servers insert $index $newserver
|
||||
# update the array
|
||||
set conf [list [$wi.c.c.ip get] [$wi.c.c.port get]]
|
||||
set conf [list [$wi.c.c.ip get] [$wi.c.c.port get]]
|
||||
array set exec_servers [list $newserver $conf]
|
||||
$wi.s.servers selection set $index
|
||||
set last_server_selected $index
|
||||
|
|
@ -4183,7 +4183,7 @@ proc selectRemoteServer { wi } {
|
|||
|
||||
# clear entries
|
||||
$wi.c.c.name delete 0 end; $wi.c.c.ip delete 0 end;
|
||||
$wi.c.c.port delete 0 end
|
||||
$wi.c.c.port delete 0 end
|
||||
|
||||
set server [$wi.s.servers get $selected]
|
||||
if { ![info exists exec_servers($server)] } { return }
|
||||
|
|
@ -4215,7 +4215,7 @@ proc popupCustomImage { node } {
|
|||
set wi .customimagedialog
|
||||
catch {destroy $wi}
|
||||
toplevel $wi -takefocus 1
|
||||
wm transient $wi .popup
|
||||
wm transient $wi .popup
|
||||
wm resizable $wi 0 0
|
||||
wm title $wi "[getNodeName $node] ($node) image"
|
||||
grab $wi
|
||||
|
|
@ -4228,11 +4228,11 @@ proc popupCustomImage { node } {
|
|||
|
||||
global configwin
|
||||
set configwin $wi
|
||||
button $wi.ftop.filebtn -text "..." -command {
|
||||
button $wi.ftop.filebtn -text "..." -command {
|
||||
global configwin g_imageFileTypes
|
||||
set f [tk_getOpenFile -filetypes $g_imageFileTypes \
|
||||
-initialdir "$CORE_DATA_DIR/icons/normal"]
|
||||
if { $f != "" } {
|
||||
if { $f != "" } {
|
||||
set node [string trim [lindex [wm title $configwin] 1] "()"]
|
||||
$configwin.ftop.filename delete 0 end
|
||||
$configwin.ftop.filename insert 0 $f
|
||||
|
|
@ -4271,7 +4271,7 @@ proc popupCustomImagePreview { wi node } {
|
|||
|
||||
setNodeCoords $node "150 50"
|
||||
setNodeLabelCoords $node "150 78"
|
||||
if { $img_save != $img_new } { setCustomImage $node $img_new }
|
||||
if { $img_save != $img_new } { setCustomImage $node $img_new }
|
||||
$wi.fmid.c delete all
|
||||
drawNode $wi.fmid.c $node
|
||||
|
||||
|
|
@ -4363,9 +4363,9 @@ proc markerOptions { show } {
|
|||
# Boeing: draw the marker sizes tool on a small canvas
|
||||
proc drawMarkerSizes { c sel } {
|
||||
# determine the coordinates of the selection box based on value of sel
|
||||
if { $sel == 1 } { set coords {0 0 16 16}
|
||||
} elseif { $sel == 2 } { set coords {16 0 32 16}
|
||||
} elseif { $sel == 3 } { set coords {0 16 16 32}
|
||||
if { $sel == 1 } { set coords {0 0 16 16}
|
||||
} elseif { $sel == 2 } { set coords {16 0 32 16}
|
||||
} elseif { $sel == 3 } { set coords {0 16 16 32}
|
||||
} else { set coords {16 16 32 32} }
|
||||
# draw the selection box
|
||||
$c create rectangle $coords -fill gray -tag square -width 0
|
||||
|
|
@ -4393,18 +4393,18 @@ proc markerSize { x y } {
|
|||
drawMarkerSizes .left.markeropt.sizes $sel
|
||||
}
|
||||
|
||||
# Boeing: set canvas wallpaper
|
||||
# Boeing: set canvas wallpaper
|
||||
proc wallpaperPopup {} {
|
||||
global curcanvas
|
||||
|
||||
set w .wallpaperDlg
|
||||
catch {destroy $w}
|
||||
toplevel $w
|
||||
|
||||
|
||||
wm transient $w .
|
||||
wm title $w "Set Canvas Wallpaper"
|
||||
grab $w
|
||||
|
||||
|
||||
# preview
|
||||
canvas $w.preview -background white -relief sunken -width 200 -height 100 \
|
||||
-borderwidth 1
|
||||
|
|
@ -4421,7 +4421,7 @@ proc wallpaperPopup {} {
|
|||
# file browse button
|
||||
global configwin
|
||||
set configwin $w
|
||||
button $w.f.filebtn -text "..." -command {
|
||||
button $w.f.filebtn -text "..." -command {
|
||||
global configwin showGrid adjustCanvas fileDialogBox_initial
|
||||
global g_imageFileTypes
|
||||
# use default conf file path upon first run
|
||||
|
|
@ -4443,7 +4443,7 @@ proc wallpaperPopup {} {
|
|||
}
|
||||
|
||||
# clear wallpaper button
|
||||
button $w.f.clear -text "clear" -command {
|
||||
button $w.f.clear -text "clear" -command {
|
||||
global configwin wallpaperStyle
|
||||
$configwin.f.file delete 0 end
|
||||
$configwin.preview delete "wallpaper"
|
||||
|
|
@ -4493,11 +4493,11 @@ proc wallpaperPopup {} {
|
|||
|
||||
# buttons
|
||||
frame $w.btns
|
||||
button $w.btns.apply -text "Apply" -command {
|
||||
button $w.btns.apply -text "Apply" -command {
|
||||
global configwin wallpaperStyle curcanvas adjustCanvas
|
||||
set f [$configwin.f.file get]
|
||||
if {$adjustCanvas} {
|
||||
wallpaperAdjustCanvas $curcanvas $f $wallpaperStyle
|
||||
if {$adjustCanvas} {
|
||||
wallpaperAdjustCanvas $curcanvas $f $wallpaperStyle
|
||||
}
|
||||
setCanvasWallpaper $curcanvas $f $wallpaperStyle
|
||||
redrawAll
|
||||
|
|
@ -4536,7 +4536,7 @@ proc wallpaperAdjustCanvas { c f style } {
|
|||
|
||||
#puts -nonewline "wallpaperAdjustCanvas img($imgx, $imgy) $cx, $cy -> "
|
||||
|
||||
# For scaled and tiled styles, expand canvas x and y to a multiple of
|
||||
# For scaled and tiled styles, expand canvas x and y to a multiple of
|
||||
# imgx, imgy for better stretching. If the image is larger than the canvas,
|
||||
# just increase the canvas size to accomodate it.
|
||||
if {$style == "scaled" || $style == "tiled"} {
|
||||
|
|
@ -4605,13 +4605,13 @@ proc drawWallpaper { c f style } {
|
|||
# grow image
|
||||
if { $cx >= $imgx || $cy > $imgy } {
|
||||
set x [expr 1+($cx / $imgx)]
|
||||
set y [expr 1+($cy / $imgy)]
|
||||
set y [expr 1+($cy / $imgy)]
|
||||
$img2 copy $img -zoom $x $y
|
||||
# shrink image
|
||||
} else {
|
||||
$img2 copy $img -subsample \
|
||||
[expr { int($imgx / $cx) }] \
|
||||
[expr { int($imgy / $cy) }]
|
||||
[expr { int($imgy / $cy) }]
|
||||
}
|
||||
$c create image [expr 1+$cx/2] [expr 1+$cy/2] -image $img2 \
|
||||
-tags "background wallpaper"
|
||||
|
|
@ -4635,7 +4635,7 @@ proc drawWallpaper { c f style } {
|
|||
}
|
||||
|
||||
raiseAll $c
|
||||
|
||||
|
||||
}
|
||||
|
||||
# helper for close/cancel buttons
|
||||
|
|
@ -4665,11 +4665,11 @@ proc rj45ifclist { wi node wasclicked } {
|
|||
listbox $wi.ftop.ifc.ifc_list -height 4 -width 30 \
|
||||
-selectmode browse -yscrollcommand "$wi.ftop.ifc.ifc_scroll set"
|
||||
scrollbar $wi.ftop.ifc.ifc_scroll \
|
||||
-command "$wi.ftop.ifc.ifc_list yview"
|
||||
-command "$wi.ftop.ifc.ifc_list yview"
|
||||
|
||||
set ifname ""
|
||||
set ifip ""
|
||||
# this handles differences between Linux and FreeBSD ifconfig
|
||||
# this handles differences between ifconfig
|
||||
foreach line [split [nexec localnode ifconfig -a] "\n"] {
|
||||
set char [string index $line 0]
|
||||
if { $char != " " && $char != " " } {
|
||||
|
|
@ -4924,7 +4924,7 @@ proc popupHookScript { name } {
|
|||
"genericOpenSaveButtonPress $c $wi.mid.script $wi.n.name"
|
||||
}
|
||||
ttk::combobox $wi.n.state -width 15 -state readonly -exportselection 0 \
|
||||
-values $CORE_STATES
|
||||
-values $CORE_STATES
|
||||
pack $wi.n.lab $wi.n.name -padx 4 -pady 4 -side left
|
||||
pack $wi.n.open $wi.n.save -pady 4 -side left
|
||||
pack $wi.n.state -padx 4 -pady 4 -side left
|
||||
|
|
@ -5081,7 +5081,7 @@ proc popupFileView { pathname } {
|
|||
ttk::label $wi.top.fnl -text "File:"
|
||||
ttk::entry $wi.top.fn
|
||||
#ttk::entry $wi.top.fn -state readonly
|
||||
pack $wi.top.fnl -padx 4 -side left
|
||||
pack $wi.top.fnl -padx 4 -side left
|
||||
pack $wi.top.fn -padx 4 -side left -fill both -expand true
|
||||
pack $wi.top -padx 4 -pady 4 -side top -fill both -expand true
|
||||
$wi.top.fn insert 0 $pathname
|
||||
|
|
|
|||
115
gui/exec.tcl
115
gui/exec.tcl
|
|
@ -38,10 +38,10 @@
|
|||
# SYNOPSIS
|
||||
# set result [nexec $args]
|
||||
# FUNCTION
|
||||
# Executes the sting given in args variable. The sting is not executed
|
||||
# Executes the sting given in args variable. The sting is not executed
|
||||
# if IMUNES is running in editor only mode. Execution of a string can
|
||||
# be local or remote. If socket can not be opened in try of a remote
|
||||
# execution, mode is switched to editor only mode.
|
||||
# execution, mode is switched to editor only mode.
|
||||
# INPUTS
|
||||
# * args -- the string that should be executed localy or remotely.
|
||||
# RESULT
|
||||
|
|
@ -80,7 +80,7 @@ proc acquireOperModeLock { mode } {
|
|||
if { $mode == "exec" } {
|
||||
set choice [tk_messageBox -type yesno -default no -icon warning \
|
||||
-message "You have selected to start the session while the previous one is still shutting down. Are you sure you want to interrupt the shutdown? (not recommended)"]
|
||||
if { $choice == "no" } {
|
||||
if { $choice == "no" } {
|
||||
set activetool select
|
||||
return; # return and allow previous setOperMode to finish...
|
||||
}
|
||||
|
|
@ -88,7 +88,7 @@ proc acquireOperModeLock { mode } {
|
|||
} elseif { $setOperMode_lock } { ;# mode == "edit"
|
||||
set choice [tk_messageBox -type yesno -default no -icon warning \
|
||||
-message "You are trying to stop the session while it is still starting. Are you sure you want to interrupt the startup? (not recommeded)"]
|
||||
if { $choice == "no" } {
|
||||
if { $choice == "no" } {
|
||||
set activetool select
|
||||
return; # return and allow previous setOperMode to finish...
|
||||
}
|
||||
|
|
@ -155,7 +155,7 @@ proc drawToolbar { mode } {
|
|||
# add buttons when in edit mode
|
||||
set imgf "$CORE_DATA_DIR/icons/tiny/$b.gif"
|
||||
set image [image create photo -file $imgf]
|
||||
catch {
|
||||
catch {
|
||||
radiobutton .left.$b -indicatoron 0 \
|
||||
-variable activetool -value $b -selectcolor $defSelectionColor \
|
||||
-width 32 -height 32 -image $image \
|
||||
|
|
@ -163,7 +163,7 @@ proc drawToolbar { mode } {
|
|||
leftToolTip $b .left
|
||||
pack .left.$b -side top
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
# popup toolbar buttons have submenus
|
||||
set buttons {routers hubs bgobjs}
|
||||
|
|
@ -192,7 +192,7 @@ proc drawToolbar { mode } {
|
|||
-borderwidth 1 -tearoff 0]
|
||||
# create the child menutbuttons
|
||||
drawToolbarSubmenu $b $menubuttons
|
||||
# tooltips for parent and submenu items
|
||||
# tooltips for parent and submenu items
|
||||
leftToolTip $b .left
|
||||
bind $buttonmenu <<MenuSelect>> {leftToolTipSubMenu %W}
|
||||
bind $buttonmenu <Leave> {
|
||||
|
|
@ -206,7 +206,7 @@ proc drawToolbar { mode } {
|
|||
}
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
# Exec mode button bar
|
||||
#
|
||||
if { "$mode" == "edit" } {
|
||||
|
|
@ -267,7 +267,7 @@ proc drawToolbarSubmenu { b menubuttons } {
|
|||
$buttonmenu add command -image $img -columnbreak 1 \
|
||||
-command "popupMenuChoose $b $menubutton $imgf"
|
||||
}
|
||||
# add an edit button to the end of the row
|
||||
# add an edit button to the end of the row
|
||||
if { $b == "routers" } {
|
||||
set imgf "$CORE_DATA_DIR/icons/normal/document-properties.gif"
|
||||
set img [createImageButton $imgf 0]
|
||||
|
|
@ -279,7 +279,7 @@ proc drawToolbarSubmenu { b menubuttons } {
|
|||
proc setSessionStartStopMenu { mode } {
|
||||
if { $mode == "exec" } {
|
||||
catch {.menubar.session entryconfigure "Start" \
|
||||
-label "Stop" -command "startStopButton edit"}
|
||||
-label "Stop" -command "startStopButton edit"}
|
||||
} else {
|
||||
catch {.menubar.session entryconfigure "Stop" \
|
||||
-label "Start" -command "startStopButton exec"}
|
||||
|
|
@ -339,8 +339,8 @@ proc startStopButton { mode } {
|
|||
# Sets imunes operating mode to the value of the parameter mode.
|
||||
# The mode can be set only to edit or exec.
|
||||
# When changing the mode to exec all the emulation interfaces are
|
||||
# checked (if they are nonexistent the message is displayed, and
|
||||
# mode is not changed), all the required buttons are disabled
|
||||
# checked (if they are nonexistent the message is displayed, and
|
||||
# mode is not changed), all the required buttons are disabled
|
||||
# (except the simulation/Terminate button, that is enabled) and
|
||||
# procedure deployCfg is called.
|
||||
# When changing the mode to edit, all required buttons are enabled
|
||||
|
|
@ -387,7 +387,7 @@ proc setOperMode { mode { type "" } } {
|
|||
|
||||
#
|
||||
# Start/stop the emulation
|
||||
#
|
||||
#
|
||||
### start button is pressed
|
||||
if { "$mode" == "exec" } {
|
||||
rearrange_off
|
||||
|
|
@ -395,11 +395,11 @@ proc setOperMode { mode { type "" } } {
|
|||
resetAllNodeCoords save
|
||||
clearExceptions "" ""
|
||||
throwCEL true
|
||||
|
||||
# Bind left mouse click to displaying the CPU usage in
|
||||
|
||||
# Bind left mouse click to displaying the CPU usage in
|
||||
# a graph format
|
||||
bind .bottom.cpu_load <1> {manageCPUwindow %X %Y 1}
|
||||
|
||||
|
||||
monitor_loop
|
||||
set plugin [lindex [getEmulPlugin "*"] 0]
|
||||
set emul_sock [pluginConnect $plugin connect false]
|
||||
|
|
@ -422,7 +422,7 @@ proc setOperMode { mode { type "" } } {
|
|||
clearWlanLinks ""
|
||||
widgets_stop
|
||||
set oper_mode edit
|
||||
|
||||
|
||||
# Bind left mouse click to clearing the CPU graph
|
||||
bind .bottom.cpu_load <1> {manageCPUwindow %X %Y 0}
|
||||
manageCPUwindow %X %Y 0
|
||||
|
|
@ -438,7 +438,7 @@ proc setOperMode { mode { type "" } } {
|
|||
# SYNOPSIS
|
||||
# statline $line
|
||||
# FUNCTION
|
||||
# Sets the string of the status line. If the execution mode is
|
||||
# Sets the string of the status line. If the execution mode is
|
||||
# set to batch the line is just printed on the standard output.
|
||||
# INPUTS
|
||||
# * line -- line to be displayed
|
||||
|
|
@ -475,15 +475,15 @@ proc getNextMac {} {
|
|||
# monitor_loop
|
||||
# FUNCTION
|
||||
# Calculates the usage of cpu, mbuffers and mbuf clusters.
|
||||
# The results are displayed in status line and updated
|
||||
# The results are displayed in status line and updated
|
||||
# every two seconds.
|
||||
#****
|
||||
proc monitor_loop {} {
|
||||
global oper_mode systype
|
||||
global server_cpuusage
|
||||
global exec_servers
|
||||
global exec_servers
|
||||
|
||||
|
||||
|
||||
if {$oper_mode != "exec"} {
|
||||
.bottom.cpu_load config -text ""
|
||||
.bottom.mbuf config -text ""
|
||||
|
|
@ -492,7 +492,7 @@ proc monitor_loop {} {
|
|||
|
||||
if { [lindex $systype 0] == "Linux" } {
|
||||
set cpuusage [getCPUUsage]
|
||||
|
||||
|
||||
#TODO: get the cpu usage on all the assigned server
|
||||
# store usage history for each server stored in an array list
|
||||
set assigned_servers [getAssignedRemoteServers]
|
||||
|
|
@ -509,22 +509,22 @@ proc monitor_loop {} {
|
|||
# TODO: receive CPU usage from other servers
|
||||
set cpuusageforserver 0
|
||||
}
|
||||
|
||||
|
||||
# append the latest cpu value to the end of list and
|
||||
# only keep and display the last 20 values for each server
|
||||
set server_cpuusage($ip) [lappend server_cpuusage($ip) $cpuusageforserver]
|
||||
set server_cpuusage($ip) [lappend server_cpuusage($ip) $cpuusageforserver]
|
||||
if { [llength $server_cpuusage($ip)] > 20 } {
|
||||
set server_cpuusage($ip) [lreplace $server_cpuusage($ip) 0 0]
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
#plot the usage data if cpu windows already opened
|
||||
# for all servers
|
||||
if { [winfo exists .cpu]} {
|
||||
plotCPUusage
|
||||
}
|
||||
|
||||
|
||||
set cputxt "CPU [lindex $cpuusage 0]% ("
|
||||
set cpuusage [lreplace $cpuusage 0 0]
|
||||
for { set n 0 } { $n < [llength $cpuusage] } { incr n } {
|
||||
|
|
@ -544,13 +544,8 @@ proc monitor_loop {} {
|
|||
return
|
||||
}
|
||||
|
||||
if { $systype == "FreeBSD 4.11-RELEASE" } {
|
||||
set defaultname "default"
|
||||
set cpun 3
|
||||
} else {
|
||||
set defaultname "."
|
||||
set defaultname "."
|
||||
set cpun 4
|
||||
}
|
||||
|
||||
# CPU usage from `vimage -l`
|
||||
set vimagetext [nexec localnode vimage -l $defaultname | xargs]
|
||||
|
|
@ -578,7 +573,7 @@ proc monitor_loop {} {
|
|||
# SYNOPSIS
|
||||
# execSetLinkParams $eid $link
|
||||
# FUNCTION
|
||||
# Sets the link parameters during execution.
|
||||
# Sets the link parameters during execution.
|
||||
# All the parameters are set at the same time.
|
||||
# INPUTS
|
||||
# eid -- experiment id
|
||||
|
|
@ -649,7 +644,7 @@ proc createImageButton { imgf style } {
|
|||
}
|
||||
}
|
||||
return $img
|
||||
|
||||
|
||||
}
|
||||
|
||||
# Boeing: status bar graph
|
||||
|
|
@ -689,7 +684,7 @@ proc statgraph { cmd n } {
|
|||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
proc popupConnectMessage { dst } {
|
||||
global CORE_DATA_DIR execMode
|
||||
|
||||
|
|
@ -751,21 +746,21 @@ proc manageCPUwindow {xpos ypos start} {
|
|||
|
||||
global exec_servers
|
||||
global server_cpuusage
|
||||
|
||||
|
||||
if {$start == 1} {
|
||||
if { ![winfo exists .cpu]} {
|
||||
if { ![winfo exists .cpu]} {
|
||||
toplevel .cpu
|
||||
wm geometry .cpu 200x210+$xpos+$ypos
|
||||
wm resizable .cpu 0 0
|
||||
wm title .cpu "CPU Usage"
|
||||
canvas .cpu.graph -width 200 -height 210
|
||||
wm title .cpu "CPU Usage"
|
||||
canvas .cpu.graph -width 200 -height 210
|
||||
pack .cpu.graph
|
||||
}
|
||||
}
|
||||
} else {
|
||||
if { [winfo exists .cpu]} {
|
||||
destroy .cpu
|
||||
set assigned_servers [getAssignedRemoteServers]
|
||||
|
||||
|
||||
for {set i 0} {$i <= [llength $assigned_servers]} {incr i} {
|
||||
if {$i == [llength $assigned_servers]} {
|
||||
set ip [getMyIP]
|
||||
|
|
@ -774,7 +769,7 @@ proc manageCPUwindow {xpos ypos start} {
|
|||
set srv [array get exec_servers $server]
|
||||
if { $srv == "" } { continue }
|
||||
set ip [lindex $srv 0]
|
||||
}
|
||||
}
|
||||
set server_cpuusage($ip) [lreplace $server_cpuusage($ip) 0 end]
|
||||
}
|
||||
}
|
||||
|
|
@ -789,7 +784,7 @@ proc getMyIP { } {
|
|||
set myIP [lindex [fconfigure $theServer -sockname] 0]
|
||||
close $theServer
|
||||
return $myIP
|
||||
|
||||
|
||||
}
|
||||
|
||||
# display all values stored in cpu usage history for each server
|
||||
|
|
@ -797,24 +792,24 @@ proc plotCPUusage { } {
|
|||
global cpu_palettes
|
||||
global exec_servers
|
||||
global server_cpuusage
|
||||
|
||||
.cpu.graph delete "all"
|
||||
|
||||
.cpu.graph delete "all"
|
||||
.cpu.graph create line 0 100 200 100 -width 2
|
||||
.cpu.graph create line 0 80 200 80 -width 1
|
||||
.cpu.graph create line 0 60 200 60 -width 1
|
||||
.cpu.graph create line 0 40 200 40 -width 1
|
||||
.cpu.graph create line 0 20 200 20 -width 1
|
||||
.cpu.graph create line 0 0 200 0 -width 1
|
||||
|
||||
|
||||
.cpu.graph create line 40 0 40 100 -width 1
|
||||
.cpu.graph create line 80 0 80 100 -width 1
|
||||
.cpu.graph create line 120 0 120 100 -width 1
|
||||
.cpu.graph create line 160 0 160 100 -width 1
|
||||
.cpu.graph create line 200 0 200 100 -width 1
|
||||
|
||||
# for each server create a plot of cpu usage
|
||||
set assigned_servers [getAssignedRemoteServers]
|
||||
for {set i 0} {$i <= [llength $assigned_servers]} {incr i} {
|
||||
# for each server create a plot of cpu usage
|
||||
set assigned_servers [getAssignedRemoteServers]
|
||||
for {set i 0} {$i <= [llength $assigned_servers]} {incr i} {
|
||||
if {$i == [llength $assigned_servers]} {
|
||||
set ip [getMyIP]
|
||||
} else {
|
||||
|
|
@ -823,9 +818,9 @@ proc plotCPUusage { } {
|
|||
if { $srv == "" } { continue }
|
||||
set ip [lindex $srv 0]
|
||||
}
|
||||
|
||||
|
||||
#need to add multiple cpuusgaehistory (array)
|
||||
for { set n 1 } { $n < [llength $server_cpuusage($ip)] } { incr n } {
|
||||
for { set n 1 } { $n < [llength $server_cpuusage($ip)] } { incr n } {
|
||||
set prevn [expr {$n - 1}]
|
||||
set x1 [expr {$prevn * 10}]
|
||||
set y1 [expr {100 - [lindex $server_cpuusage($ip) $prevn]}]
|
||||
|
|
@ -837,15 +832,15 @@ proc plotCPUusage { } {
|
|||
.cpu.graph create line $x1 $y1 $x2 $y2 -fill [lindex $cpu_palettes end]
|
||||
|
||||
}
|
||||
#debug
|
||||
#puts " cpu $x1 $y1 $x2 $y2"
|
||||
#debug
|
||||
#puts " cpu $x1 $y1 $x2 $y2"
|
||||
}
|
||||
|
||||
|
||||
#for each server create a legend (limited to 8)
|
||||
set legendtext $ip
|
||||
append legendtext " " [lindex $server_cpuusage($ip) end] "%"
|
||||
|
||||
set legendy [expr {($i * 10) + 120}]
|
||||
|
||||
set legendy [expr {($i * 10) + 120}]
|
||||
set legendx 10
|
||||
if {$i < [llength $cpu_palettes]} {
|
||||
.cpu.graph create rectangle $legendx $legendy \
|
||||
|
|
@ -861,9 +856,9 @@ proc plotCPUusage { } {
|
|||
.cpu.graph create text [expr {$legendx + 15}] [expr {$legendy + 4}]\
|
||||
-text $legendtext -fill [lindex $cpu_palettes end] \
|
||||
-anchor w -justify left
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -36,41 +36,41 @@
|
|||
# NAME
|
||||
# filemgmt.tcl -- file used for manipulation with files
|
||||
# FUNCTION
|
||||
# This module is used for all file manipulations. In this file
|
||||
# This module is used for all file manipulations. In this file
|
||||
# a file is read, a new file opened or existing file saved.
|
||||
# NOTES
|
||||
# variables:
|
||||
#
|
||||
#
|
||||
# currentFile
|
||||
# relative or absolute path to the current configuration file
|
||||
#
|
||||
#
|
||||
# fileTypes
|
||||
# types that will be displayed when opening new file
|
||||
# types that will be displayed when opening new file
|
||||
#
|
||||
# procedures used for loading and storing the configuration file:
|
||||
#
|
||||
# newFile
|
||||
# newFile
|
||||
# - creates an empty project
|
||||
#
|
||||
# openFile {filename}
|
||||
# - loads configuration from filename
|
||||
#
|
||||
# saveFile {selectedFile}
|
||||
# - saves current configuration to a file named selectedFile
|
||||
# saveFile {selectedFile}
|
||||
# - saves current configuration to a file named selectedFile
|
||||
# unless the file name is an empty string
|
||||
#
|
||||
# fileOpenStartUp
|
||||
# - opens the file named as command line argument
|
||||
#
|
||||
#
|
||||
# fileNewDialogBox
|
||||
# - opens message box to optionally save the changes
|
||||
# - opens message box to optionally save the changes
|
||||
#
|
||||
# fileOpenDialogBox
|
||||
# - opens dialog box for selecting a file to open
|
||||
#
|
||||
# fileSaveDialogBox
|
||||
# - opens dialog box for saving a file under new name if there is no
|
||||
# current file
|
||||
# current file
|
||||
#****
|
||||
|
||||
set currentFile ""
|
||||
|
|
@ -103,11 +103,6 @@ proc newFile {} {
|
|||
set g_view_locked 0
|
||||
|
||||
# flush daemon configuration
|
||||
if { [llength [findWlanNodes ""]] > 0 } {
|
||||
if { [lindex $systype 0] == "FreeBSD" } {
|
||||
catch { exec ngctl config wlan_ctl: flush=all }
|
||||
}
|
||||
}
|
||||
loadCfg ""
|
||||
resetGlobalVars newfile
|
||||
set curcanvas [lindex $canvas_list 0]
|
||||
|
|
@ -143,7 +138,7 @@ proc newFile {} {
|
|||
# Loads the configuration from the file named $filename.
|
||||
#****
|
||||
proc openFile { filename } {
|
||||
global currentFile
|
||||
global currentFile
|
||||
global undolog activetool
|
||||
global canvas_list curcanvas systype
|
||||
global changed
|
||||
|
|
@ -190,11 +185,6 @@ proc openFile { filename } {
|
|||
}
|
||||
|
||||
# flush daemon configuration
|
||||
if { [llength [findWlanNodes ""]] > 0 } {
|
||||
if { [lindex $systype 0] == "FreeBSD" } {
|
||||
catch { exec ngctl config wlan_ctl: flush=all }
|
||||
}
|
||||
}
|
||||
set cfg ""
|
||||
if { [catch { set fileId [open $currentFile r] } err] } {
|
||||
puts "error opening file $currentFile: $err"
|
||||
|
|
@ -209,7 +199,7 @@ proc openFile { filename } {
|
|||
|
||||
loadCfg $cfg
|
||||
switchCanvas none
|
||||
set undolog(0) $cfg
|
||||
set undolog(0) $cfg
|
||||
set activetool select
|
||||
|
||||
# remember opened files
|
||||
|
|
@ -236,11 +226,11 @@ proc resetGlobalVars { reason } {
|
|||
# FUNCTION
|
||||
# Loads the current configuration into the selectedFile file.
|
||||
# INPUTS
|
||||
# * selectedFile -- the name of the file where current
|
||||
# * selectedFile -- the name of the file where current
|
||||
# configuration is saved.
|
||||
#****
|
||||
proc saveFile { selectedFile } {
|
||||
global currentFile
|
||||
global currentFile
|
||||
global changed
|
||||
|
||||
if { $selectedFile == ""} {
|
||||
|
|
@ -275,7 +265,7 @@ proc saveFile { selectedFile } {
|
|||
# SYNOPSIS
|
||||
# fileOpenStartUp
|
||||
# FUNCTION
|
||||
# Loads configuration from batch input file to the current
|
||||
# Loads configuration from batch input file to the current
|
||||
# configuration.
|
||||
#****
|
||||
proc fileOpenStartUp {} {
|
||||
|
|
@ -310,7 +300,7 @@ proc fileNewDialogBox {} {
|
|||
if {$changed != 0 } {
|
||||
set choice [promptForSave]
|
||||
}
|
||||
|
||||
|
||||
if { $choice != "cancel"} {
|
||||
newFile
|
||||
}
|
||||
|
|
@ -370,7 +360,7 @@ proc fileSaveDialogBox { prompt } {
|
|||
set ft [lreplace $ft 0 0]
|
||||
set ft [linsert $ft 1 $imn]
|
||||
}
|
||||
|
||||
|
||||
set dir ""
|
||||
# use default conf file path upon first run
|
||||
if { $fileDialogBox_initial == 0} {
|
||||
|
|
@ -450,7 +440,7 @@ proc loadDotFile {} {
|
|||
set isfile 0
|
||||
if {[catch {set dotfile [open "$CONFDIR/prefs.conf" r]} ]} return
|
||||
close $dotfile
|
||||
|
||||
|
||||
if {[catch { source "$CONFDIR/prefs.conf" }]} {
|
||||
puts "The $CONFDIR/prefs.conf preferences file is invalid, ignoring it."
|
||||
#file delete "~/.core"
|
||||
|
|
@ -468,7 +458,7 @@ proc savePrefsFile { } {
|
|||
|
||||
# header
|
||||
puts $dotfile "# CORE ${CORE_VERSION} GUI preference file"
|
||||
|
||||
|
||||
# save the most-recently-used file list
|
||||
puts $dotfile "set g_mrulist \"$g_mrulist\""
|
||||
|
||||
|
|
@ -550,10 +540,6 @@ proc exit {} {
|
|||
if { [popupStopSessionPrompt]=="cancel" } {
|
||||
return
|
||||
}
|
||||
# Flush daemon configuration
|
||||
if { [lindex $systype 0] == "FreeBSD" } {
|
||||
catch { exec ngctl config wlan_ctl: flush=all }
|
||||
}
|
||||
# Prompt for save if file was changed
|
||||
if { $changed != 0 && [promptForSave] == "cancel" } {
|
||||
return
|
||||
|
|
@ -579,7 +565,7 @@ proc exit {} {
|
|||
|
||||
# save user preferences
|
||||
savePrefsFile
|
||||
|
||||
|
||||
exit.real
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -35,11 +35,11 @@
|
|||
# NAME
|
||||
# linkcfg.tcl -- file used for manipultaion with links in IMUNES
|
||||
# FUNCTION
|
||||
# This module is used to define all the actions used for configuring
|
||||
# links in IMUNES.
|
||||
# This module is used to define all the actions used for configuring
|
||||
# links in IMUNES.
|
||||
#
|
||||
# NOTES
|
||||
#
|
||||
#
|
||||
# linkPeers { link_id }
|
||||
# Returns node_ids of link endpoints
|
||||
#
|
||||
|
|
@ -53,7 +53,7 @@
|
|||
# ... in bits per second
|
||||
#
|
||||
# getLinkBandwidthString { link_id }
|
||||
# ... as string
|
||||
# ... as string
|
||||
#
|
||||
# getLinkDelay { link_id }
|
||||
# ... in microseconds
|
||||
|
|
@ -83,7 +83,7 @@
|
|||
# INPUTS
|
||||
# * link_id -- link id
|
||||
# RESULT
|
||||
# * link_peers -- returns nodes_ids of a link endpoints
|
||||
# * link_peers -- returns nodes_ids of a link endpoints
|
||||
# in a list {node1_id node2_id}
|
||||
#****
|
||||
|
||||
|
|
@ -100,14 +100,14 @@ proc linkPeers { link } {
|
|||
# SYNOPSIS
|
||||
# set link_id [linkByPeers $node1_id $node2_id]
|
||||
# FUNCTION
|
||||
# Returns link_id whose peers are node1 and node2.
|
||||
# Returns link_id whose peers are node1 and node2.
|
||||
# The order of input nodes is irrelevant.
|
||||
# INPUTS
|
||||
# * node1_id -- node id of the first node
|
||||
# * node2_id -- node id of the second node
|
||||
# RESULT
|
||||
# * link_id -- returns id of a link connecting endpoints
|
||||
# node1_id node2_id.
|
||||
# * link_id -- returns id of a link connecting endpoints
|
||||
# node1_id node2_id.
|
||||
#****
|
||||
|
||||
proc linkByPeers { node1 node2 } {
|
||||
|
|
@ -144,7 +144,7 @@ proc linkByPeersMirror { node1 node2 } {
|
|||
# removeLink $link_id
|
||||
# FUNCTION
|
||||
# Removes the link and related entries in peering node's configs.
|
||||
# Updates the default route for peer nodes.
|
||||
# Updates the default route for peer nodes.
|
||||
# INPUTS
|
||||
# * link_id -- link id
|
||||
#****
|
||||
|
|
@ -199,7 +199,7 @@ proc getLinkBandwidth { link {dir "down"} } {
|
|||
# INPUTS
|
||||
# * link_id -- link id
|
||||
# RESULT
|
||||
# * bandwidth_str -- The value of link bandwidth formated in a sting
|
||||
# * bandwidth_str -- The value of link bandwidth formated in a sting
|
||||
# containing a measure unit.
|
||||
#****
|
||||
|
||||
|
|
@ -332,7 +332,7 @@ proc getLinkDelay { link {dir "down"} } {
|
|||
# INPUTS
|
||||
# * link_id -- link id
|
||||
# RESULT
|
||||
# * delay -- The value of link delay formated in a string
|
||||
# * delay -- The value of link delay formated in a string
|
||||
# containing a measure unit.
|
||||
#****
|
||||
|
||||
|
|
@ -437,7 +437,7 @@ proc getLinkBERString { link } {
|
|||
if { $ber != "" } {
|
||||
set berstr "$berstr$ber%"
|
||||
}
|
||||
if { $berup != "" } {
|
||||
if { $berup != "" } {
|
||||
set berstr "$berstr / $berup%"
|
||||
}
|
||||
return $berstr
|
||||
|
|
@ -472,7 +472,7 @@ proc setLinkBER { link value } {
|
|||
|
||||
#****f* linkcfg.tcl/getLinkDup
|
||||
# NAME
|
||||
# getLinkDup -- get link packet duplicate value
|
||||
# getLinkDup -- get link packet duplicate value
|
||||
# SYNOPSIS
|
||||
# set duplicate [getLinkDup $link_id]
|
||||
# FUNCTION
|
||||
|
|
@ -508,7 +508,7 @@ proc getLinkDupString { link } {
|
|||
|
||||
#****f* linkcfg.tcl/setLinkDup
|
||||
# NAME
|
||||
# setLinkDup -- set link packet duplicate value
|
||||
# setLinkDup -- set link packet duplicate value
|
||||
# SYNOPSIS
|
||||
# setLinkDup $link_id $value
|
||||
# FUNCTION
|
||||
|
|
@ -547,7 +547,7 @@ proc isLinkUni { link } {
|
|||
|
||||
#****f* linkcfg.tcl/getLinkMirror
|
||||
# NAME
|
||||
# getLinkMirror -- get link's mirror link
|
||||
# getLinkMirror -- get link's mirror link
|
||||
# SYNOPSIS
|
||||
# set mirror_link_id [getLinkMirror $link_id]
|
||||
# FUNCTION
|
||||
|
|
@ -569,7 +569,7 @@ proc getLinkMirror { link } {
|
|||
|
||||
#****f* linkcfg.tcl/setLinkMirror
|
||||
# NAME
|
||||
# setLinkMirror -- set link's mirror link
|
||||
# setLinkMirror -- set link's mirror link
|
||||
# SYNOPSIS
|
||||
# setLinkMirror $link_id $mirror_link_id
|
||||
# FUNCTION
|
||||
|
|
@ -599,7 +599,7 @@ proc setLinkMirror { link value } {
|
|||
# SYNOPSIS
|
||||
# set nodes [splitLink $link_id $nodetype]
|
||||
# FUNCTION
|
||||
# Splits the link in two parts. Each part of the split link is one
|
||||
# Splits the link in two parts. Each part of the split link is one
|
||||
# pseudo link.
|
||||
# INPUTS
|
||||
# * link_id -- link id
|
||||
|
|
@ -674,7 +674,7 @@ proc splitLink { link nodetype } {
|
|||
# SYNOPSIS
|
||||
# set new_link_id [mergeLink $link_id]
|
||||
# FUNCTION
|
||||
# Rebuilts a link from two pseudo link.
|
||||
# Rebuilts a link from two pseudo link.
|
||||
# INPUTS
|
||||
# * link_id -- pseudo link id
|
||||
# RESULT
|
||||
|
|
@ -754,11 +754,11 @@ proc newLink { lnode1 lnode2 } {
|
|||
global systype
|
||||
if { ([nodeType $lnode1] == "lanswitch" ||[nodeType $lnode1] == "OVS") && \
|
||||
[nodeType $lnode2] != "router" && \
|
||||
([nodeType $lnode2] != "lanswitch" || [nodeType $lnode2] != "OVS") } {
|
||||
([nodeType $lnode2] != "lanswitch" || [nodeType $lnode2] != "OVS") } {
|
||||
set regular no }
|
||||
if { ([nodeType $lnode2] == "lanswitch" || [nodeType $lnode2] == "OVS") && \
|
||||
[nodeType $lnode1] != "router" && \
|
||||
([nodeType $lnode1] != "lanswitch" || [nodeType $lnode1] != "OVS" )} {
|
||||
([nodeType $lnode1] != "lanswitch" || [nodeType $lnode1] != "OVS" )} {
|
||||
#Khaled: puts "connecting '$lnode1' (type: '[nodeType $lnode1]') to '$lnode2' (type: '[nodeType $lnode2]') "
|
||||
set regular no }
|
||||
if { [nodeType $lnode1] == "hub" && \
|
||||
|
|
@ -839,15 +839,11 @@ proc newLink { lnode1 lnode2 } {
|
|||
if { [string range $model 0 6] == "coreapi" } {
|
||||
set delay 0; # delay controlled by wireless module
|
||||
} elseif {$delay != ""} {
|
||||
if { [lindex $systype 0] == "FreeBSD" } {
|
||||
lappend $link "delay [expr $delay/2]"
|
||||
} else {
|
||||
lappend $link "delay $delay"
|
||||
}
|
||||
}
|
||||
}
|
||||
# Exclude OVS from network layer nodes IP address asignments
|
||||
if { ([[typemodel $lnode2].layer] == "NETWORK") && ([nodeType $lnode2] != "OVS") } {
|
||||
|
||||
|
||||
#Khaled: puts "Assigning '$lnode2' (type: '[nodeType $lnode2]') an automatic IP address"
|
||||
|
||||
if { $ipv4_addr2 == "" } { autoIPv4addr $lnode2 $ifname2 }
|
||||
|
|
@ -872,7 +868,7 @@ proc newLink { lnode1 lnode2 } {
|
|||
if { [nodeType $lnode2] != "pseudo" &&
|
||||
[nodeType $lnode1] != "wlan" &&
|
||||
([[typemodel $lnode1].layer] == "NETWORK" && [nodeType $lnode1] != "OVS") } {
|
||||
|
||||
|
||||
if { $ipv4_addr1 == "" && $do_auto_addressing } {
|
||||
autoIPv4addr $lnode1 $ifname1
|
||||
}
|
||||
|
|
@ -884,16 +880,16 @@ proc newLink { lnode1 lnode2 } {
|
|||
if { [nodeType $lnode1] != "pseudo" &&
|
||||
[nodeType $lnode1] != "wlan" &&
|
||||
([[typemodel $lnode2].layer] == "NETWORK" && [nodeType $lnode2] != "OVS") } {
|
||||
|
||||
|
||||
if { $ipv4_addr2 == "" && $do_auto_addressing } {
|
||||
autoIPv4addr $lnode2 $ifname2
|
||||
autoIPv4addr $lnode2 $ifname2
|
||||
}
|
||||
if { $ipv6_addr2 == "" && $do_auto_addressing } {
|
||||
autoIPv6addr $lnode2 $ifname2
|
||||
}
|
||||
}
|
||||
|
||||
# tunnel address based on its name
|
||||
# tunnel address based on its name
|
||||
if { [nodeType $lnode1] == "tunnel" } {
|
||||
set ipaddr "[getNodeName $lnode1]/24"
|
||||
setIfcIPv4addr $lnode1 e0 $ipaddr
|
||||
|
|
@ -914,7 +910,7 @@ proc newLink { lnode1 lnode2 } {
|
|||
# FUNCTION
|
||||
# Returns the link id of the link connecting the node's interface
|
||||
# INPUTS
|
||||
# * node_id -- node id
|
||||
# * node_id -- node id
|
||||
# * ifc -- interface
|
||||
# RESULT
|
||||
# * link_id -- link id.
|
||||
|
|
@ -1021,7 +1017,7 @@ proc updateLinkGuiAttr { link attr } {
|
|||
}
|
||||
color {
|
||||
setLinkColor $link $value
|
||||
.c itemconfigure "link && $link" -fill [getLinkColor $link]
|
||||
.c itemconfigure "link && $link" -fill [getLinkColor $link]
|
||||
}
|
||||
dash {
|
||||
.c itemconfigure "link && $link" -dash $value
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
# shows the Two-node Tool
|
||||
proc popupTwoNodeDialog { } {
|
||||
global twonodePID lastTwoNodeHop g_twoNodeSelect g_twoNodeSelectCallback
|
||||
|
||||
|
||||
markerOptions off
|
||||
set wi .twonodetool
|
||||
catch {destroy $wi}
|
||||
|
|
@ -61,7 +61,7 @@ proc popupTwoNodeDialog { } {
|
|||
|
||||
# buttons on the bottom
|
||||
frame $wi.butt -borderwidth 6
|
||||
button $wi.butt.run -text "Run" -command "runTwoNodeCommand $wi"
|
||||
button $wi.butt.run -text "Run" -command "runTwoNodeCommand $wi"
|
||||
button $wi.butt.cancel -text "Clear" -command "clearTwoNodeDialog $wi 0"
|
||||
button $wi.butt.close -text "Close" -command "clearTwoNodeDialog $wi 1"
|
||||
pack $wi.butt.run $wi.butt.cancel $wi.butt.close -side left
|
||||
|
|
@ -83,11 +83,7 @@ proc clearTwoNodeDialog { wi done} {
|
|||
set emul [getEmulPlugin $node]
|
||||
set emulation_type [lindex $emul 1]
|
||||
catch {
|
||||
if { $os == "FreeBSD" } {
|
||||
exec sudo kill -9 $twonodePID 2> /dev/null
|
||||
} else {
|
||||
exec kill -9 $twonodePID 2> /dev/null
|
||||
}
|
||||
exec kill -9 $twonodePID 2> /dev/null
|
||||
}
|
||||
set twonodePID 0
|
||||
}
|
||||
|
|
@ -318,11 +314,11 @@ proc drawTwoNodeLine { node line type } {
|
|||
# search for hops matching this nexthop address
|
||||
set hops [findNextHops $lastTwoNodeHop $nexthop ""]
|
||||
if {[llength $hops] == 0} {
|
||||
puts "Couldn't highlight next hop: $nexthop";
|
||||
puts "Couldn't highlight next hop: $nexthop";
|
||||
return
|
||||
}
|
||||
|
||||
# highlight the path
|
||||
# highlight the path
|
||||
set a $lastTwoNodeHop
|
||||
foreach b $hops {
|
||||
highlightLink $a $b
|
||||
|
|
@ -372,7 +368,7 @@ proc nodeHasAddr { node addr } {
|
|||
if { $nodeaddr == $addr } {
|
||||
return 1
|
||||
}
|
||||
}
|
||||
}
|
||||
return 0
|
||||
}
|
||||
|
||||
|
|
@ -429,7 +425,7 @@ proc clearLinkHighlights { } {
|
|||
# Boeing: shows the Two-node Tool
|
||||
proc popupRunDialog { } {
|
||||
global node_list activetool systype
|
||||
|
||||
|
||||
set activetool select
|
||||
markerOptions off
|
||||
set wi .runtool
|
||||
|
|
@ -489,7 +485,7 @@ proc popupRunDialog { } {
|
|||
|
||||
# buttons on the bottom
|
||||
frame $wi.butt -borderwidth 6
|
||||
button $wi.butt.run -text "Run" -command "runToolCommand $wi \"\""
|
||||
button $wi.butt.run -text "Run" -command "runToolCommand $wi \"\""
|
||||
button $wi.butt.close -text "Close" -command "destroy $wi"
|
||||
pack $wi.butt.run $wi.butt.close -side left
|
||||
pack $wi.butt -side bottom
|
||||
|
|
@ -504,7 +500,7 @@ proc runToolCommand { wi node } {
|
|||
if { ![winfo exists $wi] } { return }; # user has closed window
|
||||
|
||||
# start running commands
|
||||
if { $node == "" } {
|
||||
if { $node == "" } {
|
||||
$wi.results.text delete 1.0 end
|
||||
set selected [$wi.n.nodes.nodes curselection]
|
||||
if { [llength $selected] == 0 } {
|
||||
|
|
@ -518,8 +514,8 @@ proc runToolCommand { wi node } {
|
|||
|
||||
set next ""
|
||||
set getnext 0
|
||||
foreach i [$wi.n.nodes.nodes curselection] { ;# find the next node
|
||||
set n [lindex $node_list $i]
|
||||
foreach i [$wi.n.nodes.nodes curselection] { ;# find the next node
|
||||
set n [lindex $node_list $i]
|
||||
if {$n == $node } {
|
||||
set getnext 1
|
||||
} elseif { $getnext == 1 } {
|
||||
|
|
@ -553,7 +549,7 @@ proc runToolCommand { wi node } {
|
|||
# callback after receiving exec message response
|
||||
proc exec_runtool_callback { node execnum cmd result status } {
|
||||
set wi .runtool
|
||||
|
||||
|
||||
if { ![winfo exists $wi] } { return }; # user has closed window
|
||||
|
||||
$wi.results.text insert end "> $node > $cmd:\n"
|
||||
|
|
|
|||
51
gui/util.tcl
51
gui/util.tcl
|
|
@ -9,14 +9,13 @@ set g_imageFileTypes {{"images" {.gif}} {"images" {.jpg}} {"images" {.png}}
|
|||
{"images" {.xbm}} {"All files" {*} }}
|
||||
|
||||
global execMode
|
||||
if { $execMode == "interactive"} {
|
||||
if { $execMode == "interactive"} {
|
||||
if { [catch { package require Img }] } {
|
||||
puts "warning: Tcl/Tk Img package not found"
|
||||
puts " Thumbnails and other image types (JPG, PNG, etc.) will not be supported."
|
||||
puts " Please install it with:"
|
||||
puts " yum install tkimg (RedHat/Fedora)"
|
||||
puts " sudo apt-get install libtk-img (Debian/Ubuntu)"
|
||||
puts " pkg_add -r libimg (FreeBSD)\n"
|
||||
puts " sudo apt-get install libtk-img (Debian/Ubuntu)\n"
|
||||
set g_imageFileTypes {{"images" {.gif}} {"All files" {*} }}
|
||||
}
|
||||
}
|
||||
|
|
@ -51,7 +50,7 @@ proc checkOS {} {
|
|||
set machine [exec uname -m]
|
||||
set kernel [exec uname -v]
|
||||
|
||||
set x11 0
|
||||
set x11 0
|
||||
catch { set x11 [winfo server .c] }
|
||||
|
||||
set os_ident "$os_name $os_ver"
|
||||
|
|
@ -203,7 +202,7 @@ proc upgradeNetworkConfigToServices { } {
|
|||
puts "updating Quagga services on node $node"
|
||||
} ;# end quagga services
|
||||
#
|
||||
# convert static model to router
|
||||
# convert static model to router
|
||||
#
|
||||
if { [getNodeModel $node] == "static" } {
|
||||
setNodeModel $node "router"
|
||||
|
|
@ -223,7 +222,7 @@ proc upgradeNetworkConfigToServices { } {
|
|||
setCustomConfig $node "service:UserDefined" "UserDefined" \
|
||||
$statvals 0
|
||||
setCustomConfig $node "service:UserDefined:$cfgname" $cfgname $cfg 0
|
||||
set services [getNodeServices $node true]
|
||||
set services [getNodeServices $node true]
|
||||
lappend services "UserDefined"
|
||||
setNodeServices $node $services
|
||||
puts "adding user-defined static routing service on node $node"
|
||||
|
|
@ -240,7 +239,7 @@ proc getCPUUsage { } {
|
|||
}
|
||||
|
||||
array set cpu {}
|
||||
|
||||
|
||||
while { [ gets $f line ] >= 0 } {
|
||||
set cpun [lindex $line 0]
|
||||
set user [lindex $line 1]; set nice [lindex $line 2]
|
||||
|
|
@ -264,14 +263,14 @@ proc getCPUUsage { } {
|
|||
|
||||
set usage_time [expr {($u-$lu) + ($n-$ln) + ($s-$ls)}]
|
||||
set total_time [expr {$usage_time + ($i-$li)}]
|
||||
if { $total_time <= 0 } {
|
||||
if { $total_time <= 0 } {
|
||||
set cpuusage "" ;# avoid div by zero
|
||||
} else {
|
||||
set cpuusage [expr { 100 * $usage_time / $total_time }]
|
||||
}
|
||||
lappend cpuusages $cpuusage
|
||||
}
|
||||
return $cpuusages
|
||||
return $cpuusages
|
||||
}
|
||||
|
||||
# Node selection dialog display given message 'msg' with initial node selection
|
||||
|
|
@ -294,7 +293,7 @@ proc popupSelectNodes { msg initsel callback } {
|
|||
listbox $wi.nodes.fr.nodelist -width 40 \
|
||||
-listvariable node_list -yscrollcommand "$wi.nodes.fr.scroll set" \
|
||||
-activestyle dotbox -selectmode extended
|
||||
scrollbar $wi.nodes.fr.scroll -command "$wi.nodes.fr.nodelist yview"
|
||||
scrollbar $wi.nodes.fr.scroll -command "$wi.nodes.fr.nodelist yview"
|
||||
pack $wi.nodes.fr.nodelist -fill both -expand true -side left
|
||||
pack $wi.nodes.fr.scroll -fill y -expand true -side left
|
||||
pack $wi.nodes.label $wi.nodes.fr -side top -padx 4 -pady 4 \
|
||||
|
|
@ -352,7 +351,7 @@ proc popupRenumberNodes { } {
|
|||
listbox $wi.nodes.left.fr.from -selectmode single -width 20 \
|
||||
-listvariable node_list -yscrollcommand "$wi.nodes.left.fr.scroll set" \
|
||||
-activestyle dotbox
|
||||
scrollbar $wi.nodes.left.fr.scroll -command "$wi.nodes.left.fr.from yview"
|
||||
scrollbar $wi.nodes.left.fr.scroll -command "$wi.nodes.left.fr.from yview"
|
||||
pack $wi.nodes.left.fr.from $wi.nodes.left.fr.scroll -fill y -side left
|
||||
pack $wi.nodes.left.label $wi.nodes.left.fr -side top -padx 4 -pady 4 \
|
||||
-anchor w
|
||||
|
|
@ -487,24 +486,16 @@ proc addStaticRoutesToConfig { node cfg_ref } {
|
|||
upvar 1 $cfg_ref cfg
|
||||
|
||||
foreach statrte [getStatIPv4routes $node] {
|
||||
if {[lindex $systype 0] == "Linux" } { ;# Linux
|
||||
set net [lindex [split $statrte] 0]
|
||||
set gw [lindex [split $statrte] 1]
|
||||
lappend cfg "/sbin/ip -4 route add $net via $gw"
|
||||
} else { ;# FreeBSD
|
||||
lappend cfg "route -q add -inet $statrte"
|
||||
}
|
||||
}
|
||||
|
||||
foreach statrte [getStatIPv6routes $node] {
|
||||
if { [lindex $systype 0] == "Linux" } { ;# Linux
|
||||
set net [lindex [split $statrte] 0]
|
||||
set gw [lindex [split $statrte] 1]
|
||||
if { $net == "::/0" } { set net "default" }
|
||||
lappend cfg "/sbin/ip -6 route add $net via $gw"
|
||||
} else { ;# FreeBSD
|
||||
lappend cfg "route -q add -inet6 $statrte"
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
|
@ -514,11 +505,7 @@ proc getServiceStartString { } {
|
|||
|
||||
setSystype
|
||||
|
||||
if { [lindex $systype 0] == "Linux" } { ;# Linux
|
||||
return "/etc/init.d/core-daemon start"
|
||||
} else { ;# FreeBSD
|
||||
return "/usr/local/etc/rc.d/core onestart"
|
||||
}
|
||||
}
|
||||
|
||||
proc popupBuildHostsFile { } {
|
||||
|
|
@ -540,7 +527,7 @@ proc popupBuildHostsFile { } {
|
|||
pack $wi.top.help -side top -fill both -expand true
|
||||
pack $wi.top -padx 4 -pady 4 -side top
|
||||
|
||||
# text box
|
||||
# text box
|
||||
frame $wi.mid
|
||||
text $wi.mid.hosts -relief sunken -bd 2 \
|
||||
-yscrollcommand "$wi.mid.scroll set" -setgrid 1 -height 30 -undo 1 \
|
||||
|
|
@ -585,7 +572,7 @@ proc popupBuildHostsFile { } {
|
|||
set wi .buildhostsdialog
|
||||
set hosts [string trim [$wi.mid.hosts get 0.0 end]]
|
||||
set filename [$wi.fil.filename get]
|
||||
set fileId [open $filename a]
|
||||
set fileId [open $filename a]
|
||||
puts $fileId $hosts
|
||||
close $fileId
|
||||
destroy $wi
|
||||
|
|
@ -707,7 +694,7 @@ proc addressConfigHelper { wi fam cmd } {
|
|||
}
|
||||
}
|
||||
|
||||
# set the default addresses for automatic allocation in the g_prefs array
|
||||
# set the default addresses for automatic allocation in the g_prefs array
|
||||
# for the given address family
|
||||
proc setDefaultAddrs { fam } {
|
||||
global g_prefs
|
||||
|
|
@ -737,8 +724,8 @@ proc popupMacAddressConfig { } {
|
|||
frame $wi.top
|
||||
set helptext "MAC addresses are automatically assigned starting with\n"
|
||||
set helptext "$helptext 00:00:00:aa:00:nn, where nn starts with the below"
|
||||
set helptext "$helptext value.\n You should change this value when tunneling"
|
||||
set helptext "$helptext between \nemulations to prevent MAC address conflicts."
|
||||
set helptext "$helptext value.\n You should change this value when tunneling"
|
||||
set helptext "$helptext between \nemulations to prevent MAC address conflicts."
|
||||
|
||||
label $wi.top.help -text $helptext
|
||||
pack $wi.top.help -side top -fill both -expand true
|
||||
|
|
@ -863,7 +850,7 @@ proc _launchBrowser url {
|
|||
|
||||
# helper for registering a callback with a tk_optionMenu variable, when a user
|
||||
# clicks on the menu and changes the value; if the global variable var is
|
||||
# cleared, this callback is cancelled
|
||||
# cleared, this callback is cancelled
|
||||
# NOTE: when closing the window that calls this, ensure that var is cleared
|
||||
proc tkOptionMenuCallback { ctl var cb args } {
|
||||
if { ![winfo exists $ctl] } { return }
|
||||
|
|
@ -1094,7 +1081,7 @@ proc get_text_editor { want_default } {
|
|||
if { $want_default } {
|
||||
return "EDITOR"
|
||||
} else {
|
||||
return $ed
|
||||
return $ed
|
||||
}
|
||||
}
|
||||
# return the first installed editor from EDITORS global
|
||||
|
|
@ -1203,7 +1190,7 @@ proc delAddrsFromNodes { fam nodes } {
|
|||
# fix for Tcl/Tk 8.5.8 and lower which doesn't have ttk::spinbox
|
||||
# set spinbox [getspinbox]
|
||||
# $spinbox $var -justify right -width 10 ...
|
||||
#
|
||||
#
|
||||
proc getspinbox {} {
|
||||
if { [info command ttk::spinbox] == "" } {
|
||||
return spinbox
|
||||
|
|
@ -1308,7 +1295,7 @@ proc findButton { w } {
|
|||
if { $first == "" } {
|
||||
$tree insert {} end -id none -values [list "" "" "" "no results found"]
|
||||
} else {
|
||||
$tree selection set $first
|
||||
$tree selection set $first
|
||||
}
|
||||
|
||||
. config -cursor left_ptr
|
||||
|
|
|
|||
373
gui/widget.tcl
373
gui/widget.tcl
|
|
@ -22,19 +22,19 @@ if {$vtysh == ""} {
|
|||
# widget array: name, {config, init, periodic, move}
|
||||
#
|
||||
array set widgets {
|
||||
"Throughput"
|
||||
{ widget_thru_config widget_thru_init widget_thru_periodic widget_thru_move }
|
||||
"Throughput"
|
||||
{ widget_thru_config widget_thru_init widget_thru_periodic widget_thru_move }
|
||||
"Adjacency"
|
||||
{ widget_adjacency_config widget_adjacency_init widget_adjacency_periodic widget_adjacency_move }
|
||||
}
|
||||
# TODO: fix CPU Widget; it is disabled because Linux network namespaces and
|
||||
# FreeBSD jails do not have a CPU usage reporting mechanism right now
|
||||
# "CPU"
|
||||
# TODO: fix CPU Widget; it is disabled because Linux network namespaces
|
||||
# do not have a CPU usage reporting mechanism right now
|
||||
# "CPU"
|
||||
# { widget_cpu_config widget_cpu_init widget_cpu_periodic widget_cpu_move }
|
||||
|
||||
# Common Observer Widget definitions
|
||||
set widgets_obs_quagga [subst {
|
||||
5
|
||||
5
|
||||
{{OSPFv2 neighbors} {$vtysh -c {show ip ospf neighbor}}}
|
||||
|
||||
6
|
||||
|
|
@ -47,31 +47,6 @@ set widgets_obs_quagga [subst {
|
|||
{{PIM neighbors} {$vtysh -c {show ip pim neighbor}}}
|
||||
}]
|
||||
|
||||
# Observer Widget definitions for FreeBSD
|
||||
array set widgets_obs_bsd $widgets_obs_quagga
|
||||
array set widgets_obs_bsd {
|
||||
1
|
||||
{ "processes" "ps ax" }
|
||||
2
|
||||
{ "ifconfig" "ifconfig" }
|
||||
3
|
||||
{ "IPv4 routes" "netstat -f inet -rn" }
|
||||
4
|
||||
{ "IPv6 routes" "netstat -f inet6 -rn" }
|
||||
7
|
||||
{ "IPv4 listening sockets" "sockstat -4l" }
|
||||
8
|
||||
{ "IPv6 listening sockets" "sockstat -6l" }
|
||||
9
|
||||
{ "IPv4 MFC entries" "ifmcstat -f inet" }
|
||||
10
|
||||
{ "IPv6 MFC entries" "ifmcstat -f inet6" }
|
||||
11
|
||||
{ "firewall rules" "ipfw -a list" }
|
||||
12
|
||||
{ "IPsec policies" "setkey -DP" }
|
||||
}
|
||||
|
||||
# Observer Widget definitions for Linux
|
||||
array set widgets_obs_linux $widgets_obs_quagga
|
||||
array set widgets_obs_linux {
|
||||
|
|
@ -104,17 +79,13 @@ set widget_loop_ID -1
|
|||
#
|
||||
proc init_default_widgets_obs {} {
|
||||
global systype widgets widgets_obs widget_obs last_widgetObserveNode
|
||||
global widgets_obs_bsd widgets_obs_linux
|
||||
global widgets_obs_linux
|
||||
|
||||
setSystype
|
||||
array unset widgets_obs
|
||||
if { [lindex $systype 0] == "Linux" } {
|
||||
set arrayname widgets_obs_linux
|
||||
# this works, but we will instead reset all indices:
|
||||
#array set widgets_obs [array get widgets_obs_linux]
|
||||
} else {
|
||||
set arrayname widgets_obs_bsd
|
||||
}
|
||||
|
||||
# this resets the array indices to be 1, 2, 3, etc.
|
||||
set i 1
|
||||
|
|
@ -142,7 +113,7 @@ proc init_widget_menu {} {
|
|||
foreach w [array names widgets] {
|
||||
global enable_$w
|
||||
set enable_$w 0
|
||||
# note that a more modular way to break out submenus would be nice here
|
||||
# note that a more modular way to break out submenus would be nice here
|
||||
if { $w == "Adjacency" } {
|
||||
widget_adjacency_init_submenu .menubar.widgets
|
||||
continue
|
||||
|
|
@ -374,9 +345,9 @@ proc configObsWidgets {} {
|
|||
button $wi.c.c3.add -text "new" \
|
||||
-command "configObsWidgetsHelper $wi 1"
|
||||
button $wi.c.c3.mod -text "modify" \
|
||||
-command "configObsWidgetsHelper $wi 2"
|
||||
-command "configObsWidgetsHelper $wi 2"
|
||||
button $wi.c.c3.del -text "delete" \
|
||||
-command "configObsWidgetsHelper $wi 3"
|
||||
-command "configObsWidgetsHelper $wi 3"
|
||||
pack $wi.c.c3.del $wi.c.c3.mod $wi.c.c3.add -side right
|
||||
pack $wi.c.c3 -fill x -side top
|
||||
|
||||
|
|
@ -386,7 +357,7 @@ proc configObsWidgets {} {
|
|||
frame $wi.s -borderwidth 4
|
||||
listbox $wi.s.servers -selectmode single -width 50 \
|
||||
-yscrollcommand "$wi.s.servers_scroll set" -exportselection 0
|
||||
scrollbar $wi.s.servers_scroll -command "$wi.s.servers yview"
|
||||
scrollbar $wi.s.servers_scroll -command "$wi.s.servers yview"
|
||||
pack $wi.s.servers $wi.s.servers_scroll -fill y -side left
|
||||
pack $wi.s -fill x -side top
|
||||
bind $wi.s.servers <<ListboxSelect>> "selectObsWidgetConf $wi"
|
||||
|
|
@ -531,7 +502,7 @@ proc selectObsWidgetConf { wi } {
|
|||
set selected [$wi.s.servers curselection]
|
||||
|
||||
# clear entries
|
||||
$wi.c.c.name delete 0 end
|
||||
$wi.c.c.name delete 0 end
|
||||
$wi.c.c2.cmd delete 0 end
|
||||
|
||||
set w [$wi.s.servers get $selected]
|
||||
|
|
@ -602,23 +573,18 @@ proc widget_thru_config {} {
|
|||
checkbutton $wi.tlab.up \
|
||||
-text "Include receptions" -variable thruConfig(up)
|
||||
pack $wi.tlab.show_thru $wi.tlab.avg $wi.tlab.down \
|
||||
$wi.tlab.up -side top -anchor w -padx 4
|
||||
$wi.tlab.up -side top -anchor w -padx 4
|
||||
pack $wi.tlab -side top
|
||||
|
||||
frame $wi.msg -borderwidth 4
|
||||
global systype
|
||||
if { [lindex $systype 0] == "FreeBSD" } {
|
||||
set lab1txt "Note: links with no impairments (bw, delay,\netc) "
|
||||
set lab1txt "${lab1txt}will display 0.0 throughput"
|
||||
} else {
|
||||
set lab1txt ""
|
||||
}
|
||||
label $wi.msg.lab1 -text $lab1txt
|
||||
pack $wi.msg.lab1 -side top -padx 4 -pady 4
|
||||
pack $wi.msg -side top
|
||||
|
||||
labelframe $wi.hi -padx 4 -pady 4 -text "Link highlighting"
|
||||
|
||||
|
||||
# Threshold (set to zero to disable)
|
||||
label $wi.hi.lab1 -text \
|
||||
"Highlight link if throuhgput exceeds this "
|
||||
|
|
@ -632,7 +598,7 @@ proc widget_thru_config {} {
|
|||
scale $wi.hi.threshscale -from 0.0 -to 1000.0 -orient horizontal \
|
||||
-showvalue false -sliderrelief raised -variable thruConfig(thresh)
|
||||
pack $wi.hi.threshscale -side top -fill x
|
||||
|
||||
|
||||
frame $wi.hi.w
|
||||
label $wi.hi.w.lab3 -text "Highlight link width:"
|
||||
spinbox $wi.hi.w.width -bg white -width 8 -textvariable thruConfig(width) \
|
||||
|
|
@ -649,7 +615,7 @@ proc widget_thru_config {} {
|
|||
pack $wi.hi.co.colbtn $wi.hi.co.color $wi.hi.co.lab1 \
|
||||
-side right -padx 4 -pady 4
|
||||
pack $wi.hi.co -side top
|
||||
|
||||
|
||||
pack $wi.hi -side top
|
||||
|
||||
# OK button at bottom
|
||||
|
|
@ -748,7 +714,7 @@ proc ngctl_output_to_ifname { line } {
|
|||
# Throughput widget periodic procedure
|
||||
#
|
||||
proc widget_thru_periodic { now } {
|
||||
global systype eid link_list
|
||||
global systype eid link_list
|
||||
global link_thru_stats link_thru_avg_stats link_thru_last_time thruConfig
|
||||
global throughput_cache
|
||||
|
||||
|
|
@ -759,7 +725,7 @@ proc widget_thru_periodic { now } {
|
|||
set dt [expr { ($now - $link_thru_last_time)/1000.0 }]
|
||||
set link_thru_last_time $now
|
||||
if { $dt <= 0.0 } { return }
|
||||
|
||||
|
||||
# keep wireless stats in an array
|
||||
array set wireless_stats {}
|
||||
|
||||
|
|
@ -820,7 +786,7 @@ proc widget_thru_periodic { now } {
|
|||
set kbps [expr {$kbps + $kbps_down}]
|
||||
}
|
||||
#set kbps [expr {$kbps_down + $kbps_up}]
|
||||
|
||||
|
||||
if { $thruConfig(avg) } {
|
||||
if { ![info exists link_thru_avg_stats($key)] } {
|
||||
set link_thru_avg_stats($key) $kbps
|
||||
|
|
@ -831,7 +797,7 @@ proc widget_thru_periodic { now } {
|
|||
set kbps $s
|
||||
}
|
||||
}
|
||||
set kbps_str [format "%.3f" $kbps]
|
||||
set kbps_str [format "%.3f" $kbps]
|
||||
|
||||
# wireless link - keep total of wireless throughput for this node
|
||||
# (supports membership to multiple wlans)
|
||||
|
|
@ -855,14 +821,14 @@ proc widget_thru_periodic { now } {
|
|||
}
|
||||
.c itemconfigure "link && $link" -width $width -fill $color
|
||||
}
|
||||
thruPlotUpdate .c $link $kbps
|
||||
thruPlotUpdate .c $link $kbps
|
||||
}; # end foreach link
|
||||
|
||||
# after summing all wireless link bandwidths, go back and perform
|
||||
# highlighting and label updating
|
||||
foreach node [array names wireless_stats] {
|
||||
set kbps_str [format "%.3f" $wireless_stats($node)]
|
||||
|
||||
|
||||
# erase any existing circles (otherwise we get duplicates)
|
||||
.c delete -withtag "$node && rangecircles"
|
||||
# wireless circle if exceeding threshold
|
||||
|
|
@ -897,13 +863,13 @@ proc widget_thru_periodic { now } {
|
|||
# helper to convert ng_pipe stats into upstream/downstream bytes
|
||||
proc getstats_bytes_netgraph { raw_input } {
|
||||
# Rec'd response "getstats" (1) from "e0_n0-n1:":
|
||||
# Args: { downstream={ FwdOctets=416 FwdFrames=6 }
|
||||
# Args: { downstream={ FwdOctets=416 FwdFrames=6 }
|
||||
# upstream={ FwdOctets=416 FwdFrames=6 } }
|
||||
set tmp [split $raw_input ":"]
|
||||
if { [llength $tmp] != 4 } {
|
||||
return [list 0 0]
|
||||
}
|
||||
|
||||
|
||||
set statline [lindex [lindex $tmp 3] 0]
|
||||
set down [lindex $statline 1]
|
||||
set up [lindex $statline 5]
|
||||
|
|
@ -952,8 +918,8 @@ proc getstats_bytes_proc { raw_input ifname } {
|
|||
break
|
||||
}
|
||||
# match the ifname exactly
|
||||
} elseif { [string range $statline 0 $ifname_len] == "$ifname:" } {
|
||||
break
|
||||
} elseif { [string range $statline 0 $ifname_len] == "$ifname:" } {
|
||||
break
|
||||
}
|
||||
set statline ""
|
||||
}
|
||||
|
|
@ -964,8 +930,8 @@ proc getstats_bytes_proc { raw_input ifname } {
|
|||
set stats [lindex $statline 1]
|
||||
|
||||
set down_bytes [lindex $stats 0]
|
||||
set up_bytes [lindex $stats 8]
|
||||
|
||||
set up_bytes [lindex $stats 8]
|
||||
|
||||
if { $down_bytes == "" } { set down_bytes 0 }
|
||||
if { $up_bytes == "" } { set up_bytes 0 }
|
||||
|
||||
|
|
@ -979,43 +945,43 @@ proc widget_thru_move { c node done } {
|
|||
|
||||
# Create a new throughput plot.
|
||||
proc thruPlot { c link x y height width isresize} {
|
||||
global widgets enable_Throughput thruPlotColor curPlotBgColor
|
||||
global widgets enable_Throughput thruPlotColor curPlotBgColor
|
||||
global plot_list
|
||||
|
||||
# if thruplot is called from resize, $link will hold full name
|
||||
|
||||
# if thruplot is called from resize, $link will hold full name
|
||||
if { $isresize == true } {
|
||||
set g $link
|
||||
|
||||
# extract linkname from full path
|
||||
regexp {l(.*)thruplot} $g match sub1
|
||||
set link "l$sub1"
|
||||
} else {
|
||||
# if new thruplot is created create full name
|
||||
} else {
|
||||
# if new thruplot is created create full name
|
||||
set g "$c.${link}thruplot"
|
||||
}
|
||||
|
||||
# update plot_list
|
||||
# Plot info to be stored :
|
||||
# Plot info to be stored :
|
||||
# - canvas coords
|
||||
# - size (height, width)
|
||||
# - color scheme
|
||||
# - linkname
|
||||
|
||||
# - size (height, width)
|
||||
# - color scheme
|
||||
# - linkname
|
||||
|
||||
# global plot variable that stores all plot info
|
||||
global ${link}thruplot
|
||||
|
||||
# reset global variable
|
||||
if {[info exists ${link}thruplot]} { unset ${link}thruplot}
|
||||
|
||||
# reset global variable
|
||||
if {[info exists ${link}thruplot]} { unset ${link}thruplot}
|
||||
set ${link}thruplot {}
|
||||
|
||||
lappend ${link}thruplot "name $g"
|
||||
lappend ${link}thruplot "height $height"
|
||||
lappend ${link}thruplot "width $width"
|
||||
lappend ${link}thruplot "x $x"
|
||||
lappend ${link}thruplot "y $y"
|
||||
|
||||
lappend ${link}thruplot "name $g"
|
||||
lappend ${link}thruplot "height $height"
|
||||
lappend ${link}thruplot "width $width"
|
||||
lappend ${link}thruplot "x $x"
|
||||
lappend ${link}thruplot "y $y"
|
||||
|
||||
# if not in color dict, add and set to default (blue)
|
||||
|
||||
# if not in color dict, add and set to default (blue)
|
||||
if {[dict exists $thruPlotColor $g] == 0} {
|
||||
dict set thruPlotColor $g blue
|
||||
set curPlotBgColor "#EEEEFF"
|
||||
|
|
@ -1025,11 +991,11 @@ proc thruPlot { c link x y height width isresize} {
|
|||
thruPlotSetScheme $scheme
|
||||
lappend ${link}thruplot "color $scheme"
|
||||
}
|
||||
|
||||
# add plot to global plot_list
|
||||
if {[lsearch $plot_list ${link}thruplot] eq -1} {
|
||||
|
||||
# add plot to global plot_list
|
||||
if {[lsearch $plot_list ${link}thruplot] eq -1} {
|
||||
lappend plot_list ${link}thruplot
|
||||
}
|
||||
}
|
||||
|
||||
# set global
|
||||
global $g
|
||||
|
|
@ -1040,7 +1006,7 @@ proc thruPlot { c link x y height width isresize} {
|
|||
destroy $g # TODO: support multiple plots for the same link
|
||||
}
|
||||
|
||||
canvas $g -height $height -width $width -bg $curPlotBgColor
|
||||
canvas $g -height $height -width $width -bg $curPlotBgColor
|
||||
$c create window $x $y -window $g -tags "thruplot $g"
|
||||
|
||||
# set link interface title
|
||||
|
|
@ -1049,21 +1015,21 @@ proc thruPlot { c link x y height width isresize} {
|
|||
|
||||
set if1 [ifcByPeer $lnode1 $lnode2]
|
||||
set if2 [ifcByPeer $lnode2 $lnode1]
|
||||
|
||||
# if too narrow, bring title down
|
||||
|
||||
# if too narrow, bring title down
|
||||
if {$width < 220} {
|
||||
$g create text $width 20 -anchor ne -text "$if1@$lnode1 - $if2@$lnode2"
|
||||
} else {
|
||||
$g create text $width 0 -anchor ne -text "$if1@$lnode1 - $if2@$lnode2"
|
||||
}
|
||||
}
|
||||
|
||||
# bind items
|
||||
bind $g <1> "thruPlotClick $c $g %x %y none"
|
||||
bind $g <B1-Motion> "thruPlotHandleB1Motion $c $g %x %y start"
|
||||
bind $g <3> "thruPlotPopup $g %x %y"
|
||||
bind $g <3> "thruPlotPopup $g %x %y"
|
||||
|
||||
#DYL trying to update cursor look
|
||||
bind $g <Motion> "selectmarkEnter $g %x %y"
|
||||
#DYL trying to update cursor look
|
||||
bind $g <Motion> "selectmarkEnter $g %x %y"
|
||||
bind $g <Any-Leave> "selectmarkLeave $c %x %y"
|
||||
bind $g <B1-ButtonRelease> "thruPlotHandleRelease $c $g %x %y done"
|
||||
#TODO when we are inside the thruplot, the graph hides the cursor
|
||||
|
|
@ -1085,27 +1051,27 @@ proc thruPlotPopup {g xclick yclick } {
|
|||
|
||||
.button3menu delete 0 end
|
||||
|
||||
.button3menu.color delete 0 end
|
||||
.button3menu.color delete 0 end
|
||||
.button3menu add cascade -label "Set Color" -menu .button3menu.color
|
||||
|
||||
# color red
|
||||
.button3menu.color add command -label "Red" -command "setThruPlotColor $g red"
|
||||
|
||||
# color blue
|
||||
.button3menu.color add command -label "Green" -command "setThruPlotColor $g green"
|
||||
|
||||
# color green
|
||||
# color red
|
||||
.button3menu.color add command -label "Red" -command "setThruPlotColor $g red"
|
||||
|
||||
# color blue
|
||||
.button3menu.color add command -label "Green" -command "setThruPlotColor $g green"
|
||||
|
||||
# color green
|
||||
.button3menu.color add command -label "Blue" -command "setThruPlotColor $g blue"
|
||||
|
||||
# delete
|
||||
.button3menu add command -label "Delete" -command "deletePlot $g"
|
||||
|
||||
|
||||
set x [winfo pointerx .]
|
||||
set y [winfo pointery .]
|
||||
set y [winfo pointery .]
|
||||
tk_popup .button3menu $x $y
|
||||
}
|
||||
|
||||
# remove thruplot
|
||||
# remove thruplot
|
||||
proc deletePlot { g } {
|
||||
global plot_list
|
||||
regexp {.c.(.*thruplot)} $g match plotname
|
||||
|
|
@ -1119,15 +1085,15 @@ proc deletePlot { g } {
|
|||
# Mouse click on a throughput plot.
|
||||
# check to see if resize
|
||||
proc thruPlotClick { c g x y modifier } {
|
||||
global thruplotResize cursorToResizemode resizemode resizeobj thruPlotDragStart thruPlotCur
|
||||
|
||||
set cursorMode [$c cget -cursor]
|
||||
|
||||
global thruplotResize cursorToResizemode resizemode resizeobj thruPlotDragStart thruPlotCur
|
||||
|
||||
set cursorMode [$c cget -cursor]
|
||||
|
||||
# check if resizeMode
|
||||
if {$cursorMode != "left_ptr" && $cursorMode != "crosshair"} {
|
||||
global oldX1 oldY1 oldX2 oldY2
|
||||
global oldX1 oldY1 oldX2 oldY2
|
||||
|
||||
# save old top left and bottom right points
|
||||
# save old top left and bottom right points
|
||||
set bbox [$c bbox $g]
|
||||
set oldX1 [lindex $bbox 0]
|
||||
set oldY1 [lindex $bbox 1]
|
||||
|
|
@ -1135,28 +1101,28 @@ proc thruPlotClick { c g x y modifier } {
|
|||
set oldY2 [lindex $bbox 3]
|
||||
|
||||
# set resizeobj and resize mode
|
||||
set resizeobj $g
|
||||
set resizeobj $g
|
||||
set resizemode [dict get $cursorToResizemode $cursorMode]
|
||||
set thruplotResize true
|
||||
} else {
|
||||
# update cursor to drag (crosshair)
|
||||
$c configure -cursor crosshair
|
||||
set thruPlotDragStart true
|
||||
set thruPlotCur $g
|
||||
$c configure -cursor crosshair
|
||||
set thruPlotDragStart true
|
||||
set thruPlotCur $g
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
# Must handle either a resize or a drag
|
||||
# Must handle either a resize or a drag
|
||||
# The plot canvas gets the B1-Motion event, not the parent canvas
|
||||
proc thruPlotHandleB1Motion {c g x y what} {
|
||||
global thruplotResize resizemode resizeobj
|
||||
global thruplotResize resizemode resizeobj
|
||||
set cursorMode [$c cget -cursor]
|
||||
# check if drag (center is clicked)
|
||||
# check if drag (center is clicked)
|
||||
if {($cursorMode == "left_ptr" || $cursorMode == "crosshair") && $thruplotResize == false} {
|
||||
thruPlotDrag $c $g $x $y $what false
|
||||
} else {
|
||||
# resize was clicked
|
||||
# resize was clicked
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -1168,30 +1134,30 @@ proc thruPlotHandleRelease { c g x y what} {
|
|||
thruPlotDrag $c $g $x $y $what false
|
||||
} else {
|
||||
thruPlotRescale $c $g $x $y
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# redraw thruplot
|
||||
# x y show coords relative to top left corner of thruplot
|
||||
proc thruPlotRescale { c g x y } {
|
||||
global thruplotResize resizemode oldX1 oldY1 oldX2 oldY2
|
||||
global thruplotResize resizemode oldX1 oldY1 oldX2 oldY2
|
||||
|
||||
# resize based on resize mode
|
||||
switch $resizemode {
|
||||
ld {
|
||||
# if the left bot corner is clicked just look at new x set new height
|
||||
# if the left bot corner is clicked just look at new x set new height
|
||||
lassign [calcDimensions [expr {$oldX1 + $x}] $oldY1 $oldX2 [expr {$oldY1 + $y}]] cx cy h w
|
||||
thruPlot $c $g $cx $cy $h $w true
|
||||
thruPlot $c $g $cx $cy $h $w true
|
||||
}
|
||||
ru {
|
||||
# if the right top corner is clicked just look at new x set new heigth
|
||||
lassign [calcDimensions $oldX1 [expr {$oldY1 + $y}] [expr {$oldX1 + $x}] $oldY2] cx cy h w
|
||||
thruPlot $c $g $cx $cy $h $w true
|
||||
thruPlot $c $g $cx $cy $h $w true
|
||||
}
|
||||
rd {
|
||||
# if the right bottom corner clicked
|
||||
# if the right bottom corner clicked
|
||||
lassign [calcDimensions $oldX1 $oldY1 [expr {$oldX1 + $x}] [expr {$oldY1 + $y}]] cx cy h w
|
||||
thruPlot $c $g $cx $cy $h $w true
|
||||
thruPlot $c $g $cx $cy $h $w true
|
||||
}
|
||||
lu {
|
||||
# if the left bottom corner clicked
|
||||
|
|
@ -1205,44 +1171,44 @@ proc thruPlotRescale { c g x y } {
|
|||
}
|
||||
l {
|
||||
# if the left side is clicked just look at new x
|
||||
lassign [calcDimensions [expr {$oldX1 + $x}] $oldY1 $oldX2 $oldY2] cx cy h w
|
||||
thruPlot $c $g $cx $cy $h $w true
|
||||
lassign [calcDimensions [expr {$oldX1 + $x}] $oldY1 $oldX2 $oldY2] cx cy h w
|
||||
thruPlot $c $g $cx $cy $h $w true
|
||||
}
|
||||
u {
|
||||
# if the top side is click just look at new y
|
||||
# if the top side is click just look at new y
|
||||
lassign [calcDimensions $oldX1 [expr {$oldY1 + $y}] $oldX2 $oldY2] cx cy h w
|
||||
thruPlot $c $g $cx $cy $h $w true
|
||||
thruPlot $c $g $cx $cy $h $w true
|
||||
}
|
||||
d {
|
||||
# if the top side is click just look at new y
|
||||
lassign [calcDimensions $oldX1 $oldY1 $oldX2 [expr {$oldY1 + $y}]] cx cy h w
|
||||
thruPlot $c $g $cx $cy $h $w true
|
||||
thruPlot $c $g $cx $cy $h $w true
|
||||
}
|
||||
default {
|
||||
puts "ERROR: should not come here. resize mode is invalid."
|
||||
}
|
||||
puts "ERROR: should not come here. resize mode is invalid."
|
||||
}
|
||||
}
|
||||
|
||||
# rescale is done reset rescale global variables
|
||||
set cursor left_ptr
|
||||
set thruplotResize false
|
||||
set resizemode false
|
||||
set resizemode false
|
||||
}
|
||||
|
||||
# Calculate center, height, width based on top left and bot right corners
|
||||
proc calcDimensions { x1 y1 x2 y2 } {
|
||||
set h [expr {$y2 - $y1}]
|
||||
set h [expr {$y2 - $y1}]
|
||||
set w [expr {$x2 - $x1}]
|
||||
|
||||
# enforce min size
|
||||
if {$h < 100} {
|
||||
set h 100
|
||||
set h 100
|
||||
}
|
||||
|
||||
if {$w < 100} {
|
||||
set w 100
|
||||
}
|
||||
list [expr {$x1 + ($w/2)}] [expr {$y1 + ($h/2)}] $h $w
|
||||
list [expr {$x1 + ($w/2)}] [expr {$y1 + ($h/2)}] $h $w
|
||||
}
|
||||
|
||||
# Mouse drag a throughput plot.
|
||||
|
|
@ -1250,67 +1216,67 @@ proc thruPlotDrag { c g x y what fromCanvas} {
|
|||
global thruPlotDragStart thruPlotCur
|
||||
global plot_list
|
||||
set pad 60
|
||||
set maxjump 500
|
||||
set maxjump 500
|
||||
|
||||
# this fixes a bug when thruplot is off screen
|
||||
if {$fromCanvas == true} {
|
||||
#puts "handling from canvas"
|
||||
$c coords $thruPlotCur [expr {$x - $pad}] [expr {$y- $pad}]
|
||||
return
|
||||
$c coords $thruPlotCur [expr {$x - $pad}] [expr {$y- $pad}]
|
||||
return
|
||||
}
|
||||
|
||||
if {$thruPlotDragStart == false} {
|
||||
if { [expr abs($x)] > $maxjump || [expr abs($y)] > $maxjump} {
|
||||
puts "ERROR can not drag too far at one time"
|
||||
return
|
||||
}
|
||||
} else {
|
||||
return
|
||||
}
|
||||
} else {
|
||||
set curx [lindex [$c coords $g] 0]
|
||||
set cury [lindex [$c coords $g] 1]
|
||||
|
||||
# perform the actual drag
|
||||
# perform the actual drag
|
||||
set newx [expr {$x - $pad + $curx}]
|
||||
set newy [expr {$y- $pad + $cury}]
|
||||
$c coords $thruPlotCur $newx $newy
|
||||
set newy [expr {$y- $pad + $cury}]
|
||||
$c coords $thruPlotCur $newx $newy
|
||||
|
||||
# save new coords DYL
|
||||
regexp {.c.(l.*thruplot)} $g match name
|
||||
# global ${name}
|
||||
regexp {.c.(l.*thruplot)} $g match name
|
||||
# global ${name}
|
||||
|
||||
# find and replace x coord
|
||||
updatePlotAttr ${name} "x" $newx
|
||||
updatePlotAttr ${name} "y" $newy
|
||||
updatePlotAttr ${name} "x" $newx
|
||||
updatePlotAttr ${name} "y" $newy
|
||||
|
||||
set thruPlotDragStart dragging
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc redrawAllThruplots {} {
|
||||
global plot_list
|
||||
|
||||
foreach tp $plot_list {
|
||||
# extract the following properties from the thruplot :
|
||||
# extract the following properties from the thruplot :
|
||||
# full path
|
||||
# height, width
|
||||
# x,y coords,
|
||||
# color scheme
|
||||
set fp [getPlotAttr $tp name]
|
||||
set height [getPlotAttr $tp height]
|
||||
set width [getPlotAttr $tp width]
|
||||
set width [getPlotAttr $tp width]
|
||||
set x [getPlotAttr $tp x]
|
||||
set y [getPlotAttr $tp y]
|
||||
set color [getPlotAttr $tp color]
|
||||
|
||||
thruPlot .c $fp $x $y $height $width true
|
||||
setThruPlotColor $fp $color
|
||||
}
|
||||
thruPlot .c $fp $x $y $height $width true
|
||||
setThruPlotColor $fp $color
|
||||
}
|
||||
}
|
||||
# this will update an attribute of the global thruplot variable
|
||||
# this will update an attribute of the global thruplot variable
|
||||
proc updatePlotAttr { plot attr val } {
|
||||
# puts "updating $attr of ${plot} to $val"
|
||||
global ${plot}
|
||||
|
||||
# find and replace attribute
|
||||
# find and replace attribute
|
||||
set i [lsearch [set ${plot}] "$attr *"]
|
||||
# puts " found at $i"
|
||||
if { $i >= 0 } {
|
||||
|
|
@ -1320,7 +1286,7 @@ proc updatePlotAttr { plot attr val } {
|
|||
}
|
||||
}
|
||||
|
||||
# this will return an attribute from the plotlist
|
||||
# this will return an attribute from the plotlist
|
||||
proc getPlotAttr {plot attr} {
|
||||
global ${plot}
|
||||
|
||||
|
|
@ -1345,7 +1311,7 @@ proc setThruPlotColor { g color} {
|
|||
# set global variables that determine color scheme
|
||||
thruPlotSetScheme $color
|
||||
|
||||
# update old data
|
||||
# update old data
|
||||
$g itemconfigure "filler" -fill $curPlotFillColor
|
||||
$g itemconfigure "line" -fill $curPlotLineColor
|
||||
$g configure -bg $curPlotBgColor
|
||||
|
|
@ -1372,15 +1338,15 @@ proc thruPlotSetScheme { color } {
|
|||
set curPlotBgColor "#eeffee"
|
||||
}
|
||||
default {
|
||||
puts "ERROR: invalid plot color '$color'"
|
||||
puts "ERROR: invalid plot color '$color'"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# update a throughput plot with a new data point
|
||||
proc thruPlotUpdate { c link kbps } {
|
||||
set g "$c.${link}thruplot"
|
||||
global $g curPlotLineColor curPlotFillColor curPlotBgColor thruPlotColor thruPlotMaxKBPS
|
||||
global $g curPlotLineColor curPlotFillColor curPlotBgColor thruPlotColor thruPlotMaxKBPS
|
||||
|
||||
# Check if window exists
|
||||
if { ![winfo exists $g] } {
|
||||
|
|
@ -1389,10 +1355,10 @@ proc thruPlotUpdate { c link kbps } {
|
|||
|
||||
# lookup scheme for thruplot and set scheme
|
||||
set scheme [dict get $thruPlotColor $g]
|
||||
thruPlotSetScheme $scheme
|
||||
# set bg to scheme
|
||||
$g configure -bg $curPlotBgColor
|
||||
|
||||
thruPlotSetScheme $scheme
|
||||
# set bg to scheme
|
||||
$g configure -bg $curPlotBgColor
|
||||
|
||||
set maxx [$g cget -width]
|
||||
set maxy [$g cget -height]
|
||||
set yscale [thruPlotAutoScale $g $kbps]
|
||||
|
|
@ -1400,7 +1366,7 @@ proc thruPlotUpdate { c link kbps } {
|
|||
# shift graph to the left by dt pixels
|
||||
set dt 5.0
|
||||
$g move "data" -$dt 0.0
|
||||
|
||||
|
||||
thruPlotDeleteOldData $g $dt
|
||||
set last [$g find withtag "data && last"]
|
||||
|
||||
|
|
@ -1416,8 +1382,8 @@ proc thruPlotUpdate { c link kbps } {
|
|||
|
||||
$g create polygon $x1 $y1 $x2 $y2 $x2 $maxy $x1 $maxy \
|
||||
-tags "data filler" -fill $curPlotFillColor -width 2
|
||||
|
||||
$g create line $x1 $y1 $x2 $y2 -tags "data last line" -fill $curPlotLineColor
|
||||
|
||||
$g create line $x1 $y1 $x2 $y2 -tags "data last line" -fill $curPlotLineColor
|
||||
}
|
||||
|
||||
# return the existing y-value scale; if the given value is off the scale,
|
||||
|
|
@ -1426,21 +1392,21 @@ proc thruPlotAutoScale { g val } {
|
|||
set yscale [lindex [$g itemcget "ticks && scalemax" -text] 0]
|
||||
global thruPlotMaxKBPS
|
||||
|
||||
# update global max
|
||||
# update global max
|
||||
if { $val > $thruPlotMaxKBPS} {
|
||||
set thruPlotMaxKBPS $val
|
||||
} else {
|
||||
} else {
|
||||
set val $thruPlotMaxKBPS
|
||||
}
|
||||
|
||||
# default
|
||||
# default
|
||||
if { $yscale == "" || $yscale < 1.0 } {
|
||||
set yscale 10.0
|
||||
}
|
||||
}
|
||||
|
||||
if { $val < $yscale } {
|
||||
return $yscale ;# value within bounds of existing scale
|
||||
}
|
||||
}
|
||||
|
||||
set maxy [$g cget -height]
|
||||
set newyscale [expr {ceil($val) + 5.0}]
|
||||
|
|
@ -1519,7 +1485,7 @@ proc thruPlotDrawScale { g max } {
|
|||
proc thruPlotDeleteOldData { g dt } {
|
||||
foreach i [$g find withtag "data"] {
|
||||
if { [lindex [$g coords $i] 0] < [expr { -2.0 * $dt }] } {
|
||||
$g delete $i
|
||||
$g delete $i
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -1571,7 +1537,7 @@ proc widget_cpu_config {} {
|
|||
|
||||
|
||||
labelframe $wi.hi -padx 4 -pady 4 -text "Node highlighting"
|
||||
|
||||
|
||||
# Threshold (set to zero to disable)
|
||||
label $wi.hi.lab1 -text "Highlight node if CPU usage exceeds this "
|
||||
pack $wi.hi.lab1 -side top -anchor w
|
||||
|
|
@ -1581,7 +1547,7 @@ proc widget_cpu_config {} {
|
|||
label $wi.hi.t.lab2 -text "% CPU"
|
||||
pack $wi.hi.t.lab2 $wi.hi.t.thresh $wi.hi.t.lab1 -side right -padx 4 -pady 4
|
||||
pack $wi.hi.lab1 $wi.hi.t -side top
|
||||
|
||||
|
||||
# Highlight color/width
|
||||
frame $wi.hi.w
|
||||
label $wi.hi.w.lab3 -text "radius:"
|
||||
|
|
@ -1597,7 +1563,7 @@ proc widget_cpu_config {} {
|
|||
pack $wi.hi.w.colbtn $wi.hi.w.color $wi.hi.w.lab1 \
|
||||
-side right -padx 4 -pady 4
|
||||
pack $wi.hi.w -side top
|
||||
|
||||
|
||||
pack $wi.hi -side top -fill x
|
||||
|
||||
# OK button at bottom
|
||||
|
|
@ -1642,13 +1608,8 @@ proc widget_cpu_init {command} {
|
|||
#
|
||||
proc widget_cpu_periodic { now } {
|
||||
global systype
|
||||
|
||||
if { [lindex $systype 0] == "FreeBSD" } {
|
||||
widget_cpu_periodic_vimage $now
|
||||
} else {
|
||||
puts "warning: the CPU widget is not functional for this platform yet"
|
||||
return
|
||||
}
|
||||
}
|
||||
|
||||
proc widget_cpu_periodic_vimage { now } {
|
||||
|
|
@ -1664,10 +1625,10 @@ proc widget_cpu_periodic_vimage { now } {
|
|||
|
||||
set newtext [format "%.2f %%" $cpustats($eid\_$node)]
|
||||
set coords [getCPUcoords $node]
|
||||
set x [lindex $coords 0]
|
||||
set y [lindex $coords 1]
|
||||
set basex [lindex $coords 2]
|
||||
set basey [lindex $coords 3]
|
||||
set x [lindex $coords 0]
|
||||
set y [lindex $coords 1]
|
||||
set basex [lindex $coords 2]
|
||||
set basey [lindex $coords 3]
|
||||
|
||||
set existing [.c find withtag "cpulabel && $node"]
|
||||
if { [llength $existing] == 0 } { ;# create new label
|
||||
|
|
@ -1678,7 +1639,7 @@ proc widget_cpu_periodic_vimage { now } {
|
|||
.c itemconfigure $cpulabel -text $newtext
|
||||
}
|
||||
.c raise $cpulabel
|
||||
# perform highlighting
|
||||
# perform highlighting
|
||||
set existing [.c find withtag "cpuhi && $node"]
|
||||
if { $cpustats($eid\_$node) >= $cpuConfig(thresh) } {
|
||||
if { [llength $existing] == 0 } {
|
||||
|
|
@ -1692,7 +1653,7 @@ proc widget_cpu_periodic_vimage { now } {
|
|||
#.c raise "link && $node"
|
||||
.c raise "node && $node"
|
||||
}
|
||||
|
||||
|
||||
} elseif { [llength $existing] > 0 } {
|
||||
.c delete $existing
|
||||
}
|
||||
|
|
@ -1726,7 +1687,7 @@ proc getstats_cpu_vimage { raw_input} {
|
|||
if { $numlines <= 4 } {
|
||||
return [list 0 0]
|
||||
}
|
||||
|
||||
|
||||
# add node_name/cpu to a list
|
||||
set ret {}
|
||||
set i 0
|
||||
|
|
@ -1756,7 +1717,7 @@ proc getstats_cpu_vestat { } {
|
|||
global cpu_vestat_history; # remember previous jiffies
|
||||
set Hertz 100.0; # from <asm/param.h>, varies per architecture
|
||||
|
||||
# read /proc/vz/vestat
|
||||
# read /proc/vz/vestat
|
||||
if { [catch {set f [open "/proc/vz/vestat" r]} e] } {
|
||||
puts "error opening /proc/vz/vestat: $e"
|
||||
return
|
||||
|
|
@ -1784,8 +1745,8 @@ proc getstats_cpu_vestat { } {
|
|||
array set cpu_vestat_history [list uptime $uptime_now]
|
||||
set elapsed [expr {$uptime_now - $uptime_old}]
|
||||
if { $elapsed == 0.0 } { set elapsed 1.0 }; # don't divide by zero
|
||||
|
||||
|
||||
|
||||
|
||||
# add node_name/cpu to a list
|
||||
set ret {}
|
||||
for { set i 0 } { $i < [llength $lines] } { incr i } {
|
||||
|
|
@ -1943,7 +1904,7 @@ proc get_router_id {node} {
|
|||
}
|
||||
}
|
||||
if {[lsearch [getNodeServices $node true] "OLSR"] != -1 } {
|
||||
|
||||
|
||||
set sock [lindex [getEmulPlugin $node] 2]
|
||||
set exec_num [newExecCallbackRequest adjacencyrouterid]
|
||||
set name [getNodeName $node]
|
||||
|
|
@ -2008,7 +1969,7 @@ proc widget_adjacency_init {command} {
|
|||
set enable_Adjacency_OSPFv3 0
|
||||
set enable_Adjacency_OLSR 0
|
||||
set adjacency_config(proto) "OLSRv2_proto"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Initialize
|
||||
|
|
@ -2017,7 +1978,7 @@ proc widget_adjacency_init {command} {
|
|||
foreach node $node_list { ;# save router-id node pairs for later lookup
|
||||
if { [nodeType $node] != "router" } { continue }
|
||||
if {[lsearch [getNodeServices $node true] "zebra"] < 0 &&
|
||||
[lsearch [getNodeServices $node true] "OLSR"] < 0 &&
|
||||
[lsearch [getNodeServices $node true] "OLSR"] < 0 &&
|
||||
[lsearch [getNodeServices $node true] "OLSRv2"] < 0} {
|
||||
continue
|
||||
}
|
||||
|
|
@ -2107,16 +2068,16 @@ proc exec_adjacency_callback { node execnum cmd result status } {
|
|||
global g_api_exec_num
|
||||
set changed 0
|
||||
set c .c
|
||||
|
||||
|
||||
set proto $adjacency_config(proto)
|
||||
array set colors $adjacency_config(colors)
|
||||
if { $adjacency_config(offset) } { set o 5 } else { set o 0 }
|
||||
|
||||
$c addtag adjdelete withtag "adjline && $node" ;# flag del all adjlines
|
||||
$c addtag adjdelete withtag "adjline && $node" ;# flag del all adjlines
|
||||
set adjs [getadj_from_neighbors $result $proto]
|
||||
|
||||
|
||||
foreach adj $adjs {
|
||||
|
||||
|
||||
set peer [lindex $adj 0]
|
||||
set line [$c find withtag "adjline && $node && $peer"]
|
||||
|
||||
|
|
@ -2193,7 +2154,7 @@ proc getadj_from_neighbors { raw_input proto } {
|
|||
"LOST" { set state "Down" }
|
||||
"MPR" { set state "Full" }
|
||||
"PENDING" { set state "Init" }
|
||||
"INVALID" { set state "Down" }
|
||||
"INVALID" { set state "Down" }
|
||||
}
|
||||
lappend ret [list $rtrid $state]
|
||||
}
|
||||
|
|
@ -2205,7 +2166,7 @@ proc getadj_from_neighbors { raw_input proto } {
|
|||
#10.0.0.2 1 00:00:06 Init/PointToPoint 00:00:00 eth0[PointToP
|
||||
#10.0.0.2 1 00:00:06 Twoway/PointToPoint 00:00:00 eth0[PointToP
|
||||
#10.0.0.2 1 00:00:06 Full/PointToPoint 00:00:38 eth0[PointToP
|
||||
#10.0.7.2 1 Full/Backup 37.240s 10.0.0.2 eth0:10.0.0.1
|
||||
#10.0.7.2 1 Full/Backup 37.240s 10.0.0.2 eth0:10.0.0.1
|
||||
foreach line [split $raw_input "\n"] {
|
||||
set rtrid [string trim [string range $line 0 14]]
|
||||
if { $rtrid == "Neighbor ID" } { continue }
|
||||
|
|
@ -2284,17 +2245,17 @@ proc widget_adjacency_init_submenu { m } {
|
|||
set enable_Adjacency_OSPFv2 0
|
||||
$m.adj add checkbutton -label "OSPFv2" -variable enable_Adjacency_OSPFv2 \
|
||||
-command "[lindex $widgets(Adjacency) 1] menu2"
|
||||
|
||||
|
||||
global enable_Adjacency_OSPFv3
|
||||
set enable_Adjacency_OSPFv3 0
|
||||
$m.adj add checkbutton -label "OSPFv3" -variable enable_Adjacency_OSPFv3 \
|
||||
-command "[lindex $widgets(Adjacency) 1] menu3"
|
||||
|
||||
|
||||
global enable_Adjacency_OLSR
|
||||
set enable_Adjacency_OLSR 0
|
||||
$m.adj add checkbutton -label "OLSR" -variable enable_Adjacency_OLSR \
|
||||
-command "[lindex $widgets(Adjacency) 1] menu4"
|
||||
|
||||
|
||||
global enable_Adjacency_OLSRv2
|
||||
set enable_Adjacency_OLSRv2 0
|
||||
$m.adj add checkbutton -label "OLSRv2" -variable enable_Adjacency_OLSRv2 \
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue