GUI support for unidirectional link effects; GUI support for link jitter
(Boeing r1796,1797)
This commit is contained in:
parent
536ff20fff
commit
f01ddd7c16
4 changed files with 533 additions and 145 deletions
143
gui/api.tcl
143
gui/api.tcl
|
@ -547,15 +547,15 @@ proc parseLinkMessage { data len flags } {
|
||||||
|
|
||||||
array set typenames { 1 node1num 2 node2num 3 delay 4 bw 5 per \
|
array set typenames { 1 node1num 2 node2num 3 delay 4 bw 5 per \
|
||||||
6 dup 7 jitter 8 mer 9 burst 10 session \
|
6 dup 7 jitter 8 mer 9 burst 10 session \
|
||||||
16 mburst 32 ltype 33 guiattr \
|
16 mburst 32 ltype 33 guiattr 34 uni \
|
||||||
35 emuid1 36 netid 37 key \
|
35 emuid1 36 netid 37 key \
|
||||||
48 if1num 49 if1ipv4 50 if1ipv4mask 51 if1mac \
|
48 if1num 49 if1ipv4 50 if1ipv4mask 51 if1mac \
|
||||||
52 if1ipv6 53 if1ipv6mask \
|
52 if1ipv6 53 if1ipv6mask \
|
||||||
54 if2num 55 if2ipv4 56 if2ipv4mask 57 if2mac \
|
54 if2num 55 if2ipv4 56 if2ipv4mask 57 if2mac \
|
||||||
64 if2ipv6 65 if2ipv6mask }
|
64 if2ipv6 65 if2ipv6mask }
|
||||||
array set typesizes { node1num 4 node2num 4 delay 8 bw 8 per -1 \
|
array set typesizes { node1num 4 node2num 4 delay 8 bw 8 per -1 \
|
||||||
dup -1 jitter 2 mer 2 burst 2 session -1 \
|
dup -1 jitter 8 mer 2 burst 2 session -1 \
|
||||||
mburst 2 ltype 4 guiattr -1 \
|
mburst 2 ltype 4 guiattr -1 uni 2 \
|
||||||
emuid1 4 netid 4 key 4 \
|
emuid1 4 netid 4 key 4 \
|
||||||
if1num 2 if1ipv4 4 if1ipv4mask 2 if1mac 8 \
|
if1num 2 if1ipv4 4 if1ipv4mask 2 if1mac 8 \
|
||||||
if1ipv6 16 if1ipv6mask 2 \
|
if1ipv6 16 if1ipv6mask 2 \
|
||||||
|
@ -563,7 +563,7 @@ proc parseLinkMessage { data len flags } {
|
||||||
if2ipv6 16 if2ipv6mask 2 }
|
if2ipv6 16 if2ipv6mask 2 }
|
||||||
array set vals { node1num -1 node2num -1 delay 0 bw 0 per "" \
|
array set vals { node1num -1 node2num -1 delay 0 bw 0 per "" \
|
||||||
dup "" jitter 0 mer 0 burst 0 session "" \
|
dup "" jitter 0 mer 0 burst 0 session "" \
|
||||||
mburst 0 ltype 0 guiattr "" \
|
mburst 0 ltype 0 guiattr "" uni 0 \
|
||||||
emuid1 -1 netid -1 key -1 \
|
emuid1 -1 netid -1 key -1 \
|
||||||
if1num -1 if1ipv4 -1 if1ipv4mask 24 if1mac -1 \
|
if1num -1 if1ipv4 -1 if1ipv4mask 24 if1mac -1 \
|
||||||
if1ipv6 -1 if1ipv6mask 64 \
|
if1ipv6 -1 if1ipv6mask 64 \
|
||||||
|
@ -726,20 +726,6 @@ proc apiLinkAddModify { node1 node2 vals_ref add } {
|
||||||
set c .c
|
set c .c
|
||||||
upvar $vals_ref vals
|
upvar $vals_ref vals
|
||||||
|
|
||||||
set labelstr ""; # build a label string
|
|
||||||
if {$vals(bw) > 0} { set labelstr "$labelstr$vals(bw)
" }
|
|
||||||
if {$vals(delay) > 0} { set labelstr \
|
|
||||||
"$labelstr[expr $vals(delay)/1000] ms
" }
|
|
||||||
if {$vals(per) > 0} { set labelstr "${labelstr}E=$vals(per)%
" }
|
|
||||||
if {$vals(dup) > 0} { set labelstr "${labelstr}D=$vals(dup)%
" }
|
|
||||||
if {$vals(jitter) > 0} {
|
|
||||||
set labelstr "${labelstr}J=[expr $vals(jitter)/1000] ms
" }
|
|
||||||
|
|
||||||
set params ""; # parameters to send to ng_wlan netgraph node
|
|
||||||
if { $labelstr != "" } {
|
|
||||||
set params "delay=$vals(delay) bandwidth=$vals(bw) per=$vals(per)"
|
|
||||||
set params "$params duplicate=$vals(dup) jitter=$vals(jitter)"
|
|
||||||
}
|
|
||||||
if {$vals(key) > -1} {
|
if {$vals(key) > -1} {
|
||||||
if { [nodeType $node1] == "tunnel" } {
|
if { [nodeType $node1] == "tunnel" } {
|
||||||
netconfInsertSection $node1 [list "tunnel-key" $vals(key)]
|
netconfInsertSection $node1 [list "tunnel-key" $vals(key)]
|
||||||
|
@ -753,11 +739,33 @@ proc apiLinkAddModify { node1 node2 vals_ref add } {
|
||||||
set wired_link [linkByPeers $node1 $node2]
|
set wired_link [linkByPeers $node1 $node2]
|
||||||
if { $wired_link != "" && $add == 0 } { ;# wired link exists, modify it
|
if { $wired_link != "" && $add == 0 } { ;# wired link exists, modify it
|
||||||
#puts "modify wired link"
|
#puts "modify wired link"
|
||||||
|
if { $vals(uni) == 1 } { ;# unidirectional link effects message
|
||||||
|
set peers [linkPeers $wired_link]
|
||||||
|
if { $node1 == [lindex $peers 0] } { ;# downstream n1 <-- n2
|
||||||
|
set bw [list $vals(bw) [getLinkBandwidth $wired_link up]]
|
||||||
|
set delay [list $vals(delay) [getLinkDelay $wired_link up]]
|
||||||
|
set per [list $vals(per) [getLinkBER $wired_link up]]
|
||||||
|
set dup [list $vals(dup) [getLinkBER $wired_link up]]
|
||||||
|
set jitter [list $vals(jitter) [getLinkJitter $wired_link up]]
|
||||||
|
} else { ;# upstream n1 --> n2
|
||||||
|
set bw [list [getLinkBandwidth $wired_link] $vals(bw)]
|
||||||
|
set delay [list [getLinkDelay $wired_link] $vals(delay)]
|
||||||
|
set per [list [getLinkBER $wired_link] $vals(per)]
|
||||||
|
set dup [list [getLinkBER $wired_link] $vals(dup)]
|
||||||
|
set jitter [list $vals(jitter) [getLinkJitter $wired_link]]
|
||||||
|
}
|
||||||
|
setLinkBandwidth $wired_link $bw
|
||||||
|
setLinkDelay $wired_link $delay
|
||||||
|
setLinkBER $wired_link $per
|
||||||
|
setLinkDup $wired_link $dup
|
||||||
|
setLinkJitter $wired_link $jitter
|
||||||
|
} else {
|
||||||
setLinkBandwidth $wired_link $vals(bw)
|
setLinkBandwidth $wired_link $vals(bw)
|
||||||
setLinkDelay $wired_link $vals(delay)
|
setLinkDelay $wired_link $vals(delay)
|
||||||
setLinkBER $wired_link $vals(per)
|
setLinkBER $wired_link $vals(per)
|
||||||
setLinkDup $wired_link $vals(dup)
|
setLinkDup $wired_link $vals(dup)
|
||||||
setLinkJitter $wired_link $vals(jitter)
|
setLinkJitter $wired_link $vals(jitter)
|
||||||
|
}
|
||||||
updateLinkLabel $wired_link
|
updateLinkLabel $wired_link
|
||||||
updateLinkGuiAttr $wired_link $vals(guiattr)
|
updateLinkGuiAttr $wired_link $vals(guiattr)
|
||||||
return
|
return
|
||||||
|
@ -1896,7 +1904,7 @@ proc sendNodeDelMessage { channel node } {
|
||||||
|
|
||||||
# send a message to build, modify, or delete a link
|
# send a message to build, modify, or delete a link
|
||||||
# type should indicate add/delete/link/unlink
|
# type should indicate add/delete/link/unlink
|
||||||
proc sendLinkMessage { channel link type } {
|
proc sendLinkMessage { channel link type {sendboth true} } {
|
||||||
global showAPI
|
global showAPI
|
||||||
set prmsg $showAPI
|
set prmsg $showAPI
|
||||||
|
|
||||||
|
@ -1915,6 +1923,12 @@ proc sendLinkMessage { channel link type } {
|
||||||
set node1_num [string range $node1 1 end]
|
set node1_num [string range $node1 1 end]
|
||||||
set node2_num [string range $node2 1 end]
|
set node2_num [string range $node2 1 end]
|
||||||
|
|
||||||
|
# flag for sending unidirectional link messages
|
||||||
|
set uni 0
|
||||||
|
if { $sendboth && [isLinkUni $link] } {
|
||||||
|
set uni 1
|
||||||
|
}
|
||||||
|
|
||||||
# set flags and link message type from supplied type parameter
|
# set flags and link message type from supplied type parameter
|
||||||
set flags 0
|
set flags 0
|
||||||
set ltype 1 ;# add/delete a link (not wireless link/unlink)
|
set ltype 1 ;# add/delete a link (not wireless link/unlink)
|
||||||
|
@ -1948,6 +1962,8 @@ proc sendLinkMessage { channel link type } {
|
||||||
set len [expr {8+8+8}]
|
set len [expr {8+8+8}]
|
||||||
set delay [getLinkDelay $link]
|
set delay [getLinkDelay $link]
|
||||||
if { $delay == "" } { set delay 0 }
|
if { $delay == "" } { set delay 0 }
|
||||||
|
set jitter [getLinkJitter $link]
|
||||||
|
if { $jitter == "" } { set jitter 0 }
|
||||||
set bw [getLinkBandwidth $link]
|
set bw [getLinkBandwidth $link]
|
||||||
if { $bw == "" } { set bw 0 }
|
if { $bw == "" } { set bw 0 }
|
||||||
set per [getLinkBER $link]; # PER and BER
|
set per [getLinkBER $link]; # PER and BER
|
||||||
|
@ -1959,16 +1975,20 @@ proc sendLinkMessage { channel link type } {
|
||||||
set dup_len 0
|
set dup_len 0
|
||||||
set dup_msg [buildStringTLV 0x6 $dup dup_len]
|
set dup_msg [buildStringTLV 0x6 $dup dup_len]
|
||||||
if { $type != "delete" } {
|
if { $type != "delete" } {
|
||||||
incr len [expr {12+12+$per_len+$dup_len}] ;# delay,bw,per,dup
|
incr len [expr {12+12+$per_len+$dup_len+12}] ;# delay,bw,per,dup,jitter
|
||||||
if {$prmsg==1 } {
|
if {$prmsg==1 } {
|
||||||
puts -nonewline "$delay,$bw,$per,$dup,"
|
puts -nonewline "$delay,$bw,$per,$dup,$jitter,"
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
# TODO: jitter, mer, burst, mburst
|
# TODO: mer, burst, mburst
|
||||||
if { $prmsg == 1 } { puts -nonewline "type=$ltype," }
|
if { $prmsg == 1 } { puts -nonewline "type=$ltype," }
|
||||||
|
if { $uni } {
|
||||||
|
incr len 4
|
||||||
|
if { $prmsg == 1 } { puts -nonewline "uni=$uni," }
|
||||||
|
}
|
||||||
if { $netid > -1 } {
|
if { $netid > -1 } {
|
||||||
incr len 8
|
incr len 8
|
||||||
if { $prmsg == 1 } { puts -nonewline ",netid=$netid" }
|
if { $prmsg == 1 } { puts -nonewline "netid=$netid," }
|
||||||
}
|
}
|
||||||
if { $key != "" } {
|
if { $key != "" } {
|
||||||
incr len 8
|
incr len 8
|
||||||
|
@ -2012,12 +2032,18 @@ proc sendLinkMessage { channel link type } {
|
||||||
puts -nonewline $channel [binary format c2sW {0x4 8} 0 $bw]
|
puts -nonewline $channel [binary format c2sW {0x4 8} 0 $bw]
|
||||||
puts -nonewline $channel $per_msg
|
puts -nonewline $channel $per_msg
|
||||||
puts -nonewline $channel $dup_msg
|
puts -nonewline $channel $dup_msg
|
||||||
|
puts -nonewline $channel [binary format c2sW {0x7 8} 0 $jitter]
|
||||||
}
|
}
|
||||||
# TODO: jitter, mer, burst, mburst
|
# TODO: mer, burst, mburst
|
||||||
|
|
||||||
# link type
|
# link type
|
||||||
puts -nonewline $channel [binary format c2sI {0x20 4} 0 $ltype]
|
puts -nonewline $channel [binary format c2sI {0x20 4} 0 $ltype]
|
||||||
|
|
||||||
|
# unidirectional flag
|
||||||
|
if { $uni } {
|
||||||
|
puts -nonewline $channel [binary format c2S {0x22 2} $uni]
|
||||||
|
}
|
||||||
|
|
||||||
# network ID
|
# network ID
|
||||||
if { $netid > -1 } {
|
if { $netid > -1 } {
|
||||||
puts -nonewline $channel [binary format c2sI {0x24 4} 0 $netid]
|
puts -nonewline $channel [binary format c2sI {0x24 4} 0 $netid]
|
||||||
|
@ -2061,6 +2087,73 @@ proc sendLinkMessage { channel link type } {
|
||||||
|
|
||||||
if { $prmsg==1 } { puts ")" }
|
if { $prmsg==1 } { puts ")" }
|
||||||
flushChannel channel "Error sending link message"
|
flushChannel channel "Error sending link message"
|
||||||
|
|
||||||
|
##########################################################
|
||||||
|
# send a second Link Message for unidirectional link effects
|
||||||
|
if { $uni < 1 } {
|
||||||
|
return
|
||||||
|
}
|
||||||
|
# first calculate length and possibly print the message
|
||||||
|
set flags 0
|
||||||
|
if { $prmsg == 1 } {
|
||||||
|
puts -nonewline ">LINK(flags=$flags,$node2_num-$node1_num,"
|
||||||
|
}
|
||||||
|
set len [expr {8+8+8}] ;# len = node2num, node1num (swapped), type
|
||||||
|
set delay [getLinkDelay $link up]
|
||||||
|
if { $delay == "" } { set delay 0 }
|
||||||
|
set jitter [getLinkJitter $link up]
|
||||||
|
if { $jitter == "" } { set jitter 0 }
|
||||||
|
set bw [getLinkBandwidth $link up]
|
||||||
|
if { $bw == "" } { set bw 0 }
|
||||||
|
set per [getLinkBER $link up]; # PER and BER
|
||||||
|
if { $per == "" } { set per 0 }
|
||||||
|
set per_len 0
|
||||||
|
set per_msg [buildStringTLV 0x5 $per per_len]
|
||||||
|
set dup [getLinkDup $link up]
|
||||||
|
if { $dup == "" } { set dup 0 }
|
||||||
|
set dup_len 0
|
||||||
|
set dup_msg [buildStringTLV 0x6 $dup dup_len]
|
||||||
|
incr len [expr {12+12+$per_len+$dup_len+12}] ;# delay,bw,per,dup,jitter
|
||||||
|
if {$prmsg==1 } {
|
||||||
|
puts -nonewline "$delay,$bw,$per,$dup,$jitter,"
|
||||||
|
}
|
||||||
|
if { $prmsg == 1 } { puts -nonewline "type=$ltype," }
|
||||||
|
incr len 4 ;# unidirectional flag
|
||||||
|
if { $prmsg == 1 } { puts -nonewline "uni=$uni," }
|
||||||
|
# note that if1num / if2num are reversed here due to reversed node nums
|
||||||
|
if { $if2num >= 0 && ([[typemodel $node2].layer] == "NETWORK" || \
|
||||||
|
[nodeType $node2] == "tunnel") } {
|
||||||
|
incr len 4
|
||||||
|
if { $prmsg == 1 } { puts -nonewline "if1n=$if2num," }
|
||||||
|
}
|
||||||
|
if { $if1num >= 0 && ([[typemodel $node1].layer] == "NETWORK" || \
|
||||||
|
[nodeType $node1] == "tunnel") } {
|
||||||
|
incr len 4
|
||||||
|
if { $prmsg == 1 } { puts -nonewline "if2n=$if1num," }
|
||||||
|
}
|
||||||
|
# build and send the link message
|
||||||
|
set msg [binary format ccSc2sIc2sI \
|
||||||
|
{0x2} $flags $len \
|
||||||
|
{0x1 4} 0 $node2_num \
|
||||||
|
{0x2 4} 0 $node1_num ]
|
||||||
|
puts -nonewline $channel $msg
|
||||||
|
puts -nonewline $channel [binary format c2sW {0x3 8} 0 $delay]
|
||||||
|
puts -nonewline $channel [binary format c2sW {0x4 8} 0 $bw]
|
||||||
|
puts -nonewline $channel $per_msg
|
||||||
|
puts -nonewline $channel $dup_msg
|
||||||
|
puts -nonewline $channel [binary format c2sW {0x7 8} 0 $jitter]
|
||||||
|
puts -nonewline $channel [binary format c2sI {0x20 4} 0 $ltype]
|
||||||
|
puts -nonewline $channel [binary format c2S {0x22 2} $uni]
|
||||||
|
if { $if2num >= 0 && ([[typemodel $node2].layer] == "NETWORK" || \
|
||||||
|
[nodeType $node2] == "tunnel") } {
|
||||||
|
puts -nonewline $channel [ binary format c2S {0x30 2} $if2num ]
|
||||||
|
}
|
||||||
|
if { $if1num >= 0 && ([[typemodel $node1].layer] == "NETWORK" || \
|
||||||
|
[nodeType $node1] == "tunnel") } {
|
||||||
|
puts -nonewline $channel [ binary format c2S {0x36 2} $if1num ]
|
||||||
|
}
|
||||||
|
if { $prmsg==1 } { puts ")" }
|
||||||
|
flushChannel channel "Error sending link message"
|
||||||
}
|
}
|
||||||
|
|
||||||
# helper to get IPv4, IPv6, MAC address and increment length
|
# helper to get IPv4, IPv6, MAC address and increment length
|
||||||
|
@ -2539,7 +2632,7 @@ proc shutdownSession {} {
|
||||||
continue; # remote routers are ctrl. by GUI; TODO: move to daemon
|
continue; # remote routers are ctrl. by GUI; TODO: move to daemon
|
||||||
}
|
}
|
||||||
|
|
||||||
sendLinkMessage $sock $link delete
|
sendLinkMessage $sock $link delete false
|
||||||
}
|
}
|
||||||
# shut down all nodes
|
# shut down all nodes
|
||||||
foreach node $node_list {
|
foreach node $node_list {
|
||||||
|
|
|
@ -704,21 +704,16 @@ proc loadCfg { cfg } {
|
||||||
mirror {
|
mirror {
|
||||||
lappend $object "mirror $value"
|
lappend $object "mirror $value"
|
||||||
}
|
}
|
||||||
bandwidth {
|
bandwidth -
|
||||||
lappend $object "bandwidth $value"
|
delay -
|
||||||
}
|
ber -
|
||||||
delay {
|
duplicate -
|
||||||
lappend $object "delay $value"
|
|
||||||
}
|
|
||||||
ber {
|
|
||||||
lappend $object "ber $value"
|
|
||||||
}
|
|
||||||
duplicate {
|
|
||||||
lappend $object "duplicate $value"
|
|
||||||
}
|
|
||||||
jitter {
|
jitter {
|
||||||
# Boeing - jitter
|
if { [llength $value] > 1 } { ;# down/up-stream
|
||||||
lappend $object "jitter $value"
|
lappend $object "$field {$value}"
|
||||||
|
} else {
|
||||||
|
lappend $object "$field $value"
|
||||||
|
}
|
||||||
}
|
}
|
||||||
color {
|
color {
|
||||||
lappend $object "color $value"
|
lappend $object "color $value"
|
||||||
|
|
297
gui/editor.tcl
297
gui/editor.tcl
|
@ -723,20 +723,21 @@ proc updateIfcLabel { lnode1 lnode2 } {
|
||||||
proc updateLinkLabel { link } {
|
proc updateLinkLabel { link } {
|
||||||
global showLinkLabels
|
global showLinkLabels
|
||||||
|
|
||||||
set labelstr ""
|
set bwstr [getLinkBandwidthString $link]
|
||||||
set delstr [getLinkDelayString $link]
|
set delstr [getLinkDelayString $link]
|
||||||
set ber [getLinkBER $link]
|
set berstr [getLinkBERString $link]
|
||||||
set dup [getLinkDup $link]
|
set dupstr [getLinkDupString $link]
|
||||||
set labelstr "$labelstr[getLinkBandwidthString $link]
"
|
set labelstr "
"
|
||||||
|
if { "$bwstr" != "" } {
|
||||||
|
set labelstr "$labelstr$bwstr
"
|
||||||
|
}
|
||||||
if { "$delstr" != "" } {
|
if { "$delstr" != "" } {
|
||||||
set labelstr "$labelstr$delstr
"
|
set labelstr "$labelstr$delstr
"
|
||||||
}
|
}
|
||||||
if { "$ber" != "" } {
|
if { "$berstr" != "" } {
|
||||||
set berstr "loss=$ber%"
|
|
||||||
set labelstr "$labelstr$berstr
"
|
set labelstr "$labelstr$berstr
"
|
||||||
}
|
}
|
||||||
if { "$dup" != "" } {
|
if { "$dupstr" != "" } {
|
||||||
set dupstr "dup=$dup%"
|
|
||||||
set labelstr "$labelstr$dupstr
"
|
set labelstr "$labelstr$dupstr
"
|
||||||
}
|
}
|
||||||
set labelstr \
|
set labelstr \
|
||||||
|
@ -2758,22 +2759,34 @@ proc popupConfigDialog { c } {
|
||||||
pack $wi.ftop -side top
|
pack $wi.ftop -side top
|
||||||
|
|
||||||
set spinbox [getspinbox]
|
set spinbox [getspinbox]
|
||||||
ttk::frame $wi.bandwidth -borderwidth 4
|
global g_link_config_uni_state
|
||||||
|
set g_link_config_uni_state "bid"
|
||||||
|
|
||||||
|
ttk::frame $wi.preset -borderwidth 4
|
||||||
global link_preset_val
|
global link_preset_val
|
||||||
set link_preset_val unlimited
|
set link_preset_val unlimited
|
||||||
set linkpreMenu [tk_optionMenu $wi.bandwidth.linkpre link_preset_val a]
|
set linkpreMenu [tk_optionMenu $wi.preset.linkpre link_preset_val a]
|
||||||
pack $wi.bandwidth.linkpre -side top
|
# unidirectional links not always supported
|
||||||
|
if { [isUniSupported $n0 $n1] } {
|
||||||
|
set unistate normal
|
||||||
|
} else {
|
||||||
|
set unistate disabled
|
||||||
|
}
|
||||||
|
ttk::button $wi.preset.uni -text "Unidir. >>" -state $unistate \
|
||||||
|
-command "linkConfigUni $wi"
|
||||||
|
pack $wi.preset.uni $wi.preset.linkpre -side right
|
||||||
linkPresets $wi $linkpreMenu init
|
linkPresets $wi $linkpreMenu init
|
||||||
ttk::label $wi.bandwidth.label -anchor e \
|
pack $wi.preset -side top -anchor e
|
||||||
-text "Bandwidth (bps):"
|
|
||||||
|
ttk::frame $wi.bandwidth -borderwidth 4
|
||||||
|
ttk::label $wi.bandwidth.label -anchor e -text "Bandwidth (bps):"
|
||||||
$spinbox $wi.bandwidth.value -justify right -width 10 \
|
$spinbox $wi.bandwidth.value -justify right -width 10 \
|
||||||
-validate focus -invalidcommand "focusAndFlash %W"
|
-validate focus -invalidcommand "focusAndFlash %W"
|
||||||
$wi.bandwidth.value insert 0 [getLinkBandwidth $target]
|
$wi.bandwidth.value insert 0 [getLinkBandwidth $target]
|
||||||
$wi.bandwidth.value configure \
|
$wi.bandwidth.value configure \
|
||||||
-validatecommand {checkIntRange %P 0 1000000000} \
|
-validatecommand {checkIntRange %P 0 1000000000} \
|
||||||
-from 0 -to 1000000000 -increment 1000000
|
-from 0 -to 1000000000 -increment 1000000
|
||||||
pack $wi.bandwidth.value $wi.bandwidth.label \
|
pack $wi.bandwidth.value $wi.bandwidth.label -side right
|
||||||
-side right
|
|
||||||
pack $wi.bandwidth -side top -anchor e
|
pack $wi.bandwidth -side top -anchor e
|
||||||
|
|
||||||
ttk::frame $wi.delay -borderwidth 4
|
ttk::frame $wi.delay -borderwidth 4
|
||||||
|
@ -2787,11 +2800,22 @@ proc popupConfigDialog { c } {
|
||||||
pack $wi.delay.value $wi.delay.label -side right
|
pack $wi.delay.value $wi.delay.label -side right
|
||||||
pack $wi.delay -side top -anchor e
|
pack $wi.delay -side top -anchor e
|
||||||
|
|
||||||
|
ttk::frame $wi.jitter -borderwidth 4
|
||||||
|
ttk::label $wi.jitter.label -anchor e -text "Jitter (us):"
|
||||||
|
$spinbox $wi.jitter.value -justify right -width 10 \
|
||||||
|
-validate focus -invalidcommand "focusAndFlash %W"
|
||||||
|
$wi.jitter.value insert 0 [getLinkJitter $target]
|
||||||
|
$wi.jitter.value configure \
|
||||||
|
-validatecommand {checkIntRange %P 0 10000000} \
|
||||||
|
-from 0 -to 10000000 -increment 5
|
||||||
|
pack $wi.jitter.value $wi.jitter.label -side right
|
||||||
|
pack $wi.jitter -side top -anchor e
|
||||||
|
|
||||||
ttk::frame $wi.ber -borderwidth 4
|
ttk::frame $wi.ber -borderwidth 4
|
||||||
if { [lindex $systype 0] == "Linux" } {
|
if { [lindex $systype 0] == "Linux" } {
|
||||||
set bertext "Loss (%):"
|
set bertext "Loss (%):"
|
||||||
set berinc 1
|
set berinc 0.1
|
||||||
set bermax 100
|
set bermax 100.0
|
||||||
} else { ;# netgraph uses BER
|
} else { ;# netgraph uses BER
|
||||||
set bertext "BER (1/N):"
|
set bertext "BER (1/N):"
|
||||||
set berinc 1000
|
set berinc 1000
|
||||||
|
@ -2802,8 +2826,8 @@ proc popupConfigDialog { c } {
|
||||||
-validate focus -invalidcommand "focusAndFlash %W"
|
-validate focus -invalidcommand "focusAndFlash %W"
|
||||||
$wi.ber.value insert 0 [getLinkBER $target]
|
$wi.ber.value insert 0 [getLinkBER $target]
|
||||||
$wi.ber.value configure \
|
$wi.ber.value configure \
|
||||||
-validatecommand "checkFloatRange %P 0 $bermax" \
|
-validatecommand "checkFloatRange %P 0.0 $bermax" \
|
||||||
-from 0 -to $bermax -increment $berinc
|
-from 0.0 -to $bermax -increment $berinc
|
||||||
pack $wi.ber.value $wi.ber.label -side right
|
pack $wi.ber.value $wi.ber.label -side right
|
||||||
pack $wi.ber -side top -anchor e
|
pack $wi.ber -side top -anchor e
|
||||||
|
|
||||||
|
@ -2836,6 +2860,7 @@ proc popupConfigDialog { c } {
|
||||||
set link_color [getLinkColor $target]
|
set link_color [getLinkColor $target]
|
||||||
tk_optionMenu $wi.color.value link_color \
|
tk_optionMenu $wi.color.value link_color \
|
||||||
Red Green Blue Yellow Magenta Cyan Black
|
Red Green Blue Yellow Magenta Cyan Black
|
||||||
|
$wi.color.value configure -width 8
|
||||||
pack $wi.color.value $wi.color.label -side right
|
pack $wi.color.value $wi.color.label -side right
|
||||||
pack $wi.color -side top -anchor e
|
pack $wi.color -side top -anchor e
|
||||||
|
|
||||||
|
@ -2849,6 +2874,26 @@ proc popupConfigDialog { c } {
|
||||||
-from 1 -to 8 -increment 1
|
-from 1 -to 8 -increment 1
|
||||||
pack $wi.width.value $wi.width.label -side right
|
pack $wi.width.value $wi.width.label -side right
|
||||||
pack $wi.width -side top -anchor e
|
pack $wi.width -side top -anchor e
|
||||||
|
|
||||||
|
# auto-expand upstream if values exist
|
||||||
|
set bw [getLinkBandwidth $target up]
|
||||||
|
set dl [getLinkDelay $target up]
|
||||||
|
set jt [getLinkJitter $target up]
|
||||||
|
set ber [getLinkBER $target up]
|
||||||
|
set dup [getLinkDup $target up]
|
||||||
|
if { $bw > 0 || $dl > 0 || $jt > 0 || $ber > 0 || $dup > 0 } {
|
||||||
|
linkConfigUni $wi
|
||||||
|
$wi.bandwidth.value2 delete 0 end
|
||||||
|
$wi.bandwidth.value2 insert 0 $bw
|
||||||
|
$wi.delay.value2 delete 0 end
|
||||||
|
$wi.delay.value2 insert 0 $dl
|
||||||
|
$wi.jitter.value2 delete 0 end
|
||||||
|
$wi.jitter.value2 insert 0 $jt
|
||||||
|
$wi.ber.value2 delete 0 end
|
||||||
|
$wi.ber.value2 insert 0 $ber
|
||||||
|
$wi.dup.value2 delete 0 end
|
||||||
|
$wi.dup.value2 insert 0 $dup
|
||||||
|
}
|
||||||
}
|
}
|
||||||
} ;# end switch
|
} ;# end switch
|
||||||
|
|
||||||
|
@ -2872,6 +2917,121 @@ proc popupConfigDialog { c } {
|
||||||
# bind $wi <Key-Return> "popupConfigApply $wi $object_type $target 0"
|
# bind $wi <Key-Return> "popupConfigApply $wi $object_type $target 0"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
proc linkConfigUni { wi } {
|
||||||
|
global g_link_config_uni_state
|
||||||
|
|
||||||
|
set capt [lindex [$wi.preset.uni configure -text] 4]
|
||||||
|
|
||||||
|
if { $capt == "Unidir. >>" } {
|
||||||
|
set g_link_config_uni_state "uni"
|
||||||
|
$wi.preset.uni configure -text "<< Bidir."
|
||||||
|
set spinbox [getspinbox]
|
||||||
|
|
||||||
|
if { ![winfo exists $wi.bandwidth.value2] } {
|
||||||
|
$spinbox $wi.bandwidth.value2 -justify right \
|
||||||
|
-width 10 -validate focus -invalidcommand "focusAndFlash %W"
|
||||||
|
$wi.bandwidth.value2 configure \
|
||||||
|
-validatecommand {checkIntRange %P 0 1000000000} \
|
||||||
|
-from 0 -to 1000000000 -increment 1000000
|
||||||
|
}
|
||||||
|
$wi.bandwidth.value2 delete 0 end
|
||||||
|
$wi.bandwidth.value2 insert 0 [$wi.bandwidth.value get]
|
||||||
|
pack $wi.bandwidth.value2 -side right
|
||||||
|
pack $wi.bandwidth.value2 -before $wi.bandwidth.value
|
||||||
|
|
||||||
|
if { ![winfo exists $wi.delay.value2] } {
|
||||||
|
$spinbox $wi.delay.value2 -justify right -width 10 \
|
||||||
|
-validate focus -invalidcommand "focusAndFlash %W"
|
||||||
|
$wi.delay.value2 configure \
|
||||||
|
-validatecommand {checkIntRange %P 0 10000000} \
|
||||||
|
-from 0 -to 10000000 -increment 5
|
||||||
|
}
|
||||||
|
$wi.delay.value2 delete 0 end
|
||||||
|
$wi.delay.value2 insert 0 [$wi.delay.value get]
|
||||||
|
pack $wi.delay.value2 -side right
|
||||||
|
pack $wi.delay.value2 -before $wi.delay.value
|
||||||
|
|
||||||
|
if { ![winfo exists $wi.jitter.value2] } {
|
||||||
|
$spinbox $wi.jitter.value2 -justify right -width 10 \
|
||||||
|
-validate focus -invalidcommand "focusAndFlash %W"
|
||||||
|
$wi.jitter.value2 configure \
|
||||||
|
-validatecommand {checkIntRange %P 0 10000000} \
|
||||||
|
-from 0 -to 10000000 -increment 5
|
||||||
|
}
|
||||||
|
$wi.jitter.value2 delete 0 end
|
||||||
|
$wi.jitter.value2 insert 0 [$wi.jitter.value get]
|
||||||
|
pack $wi.jitter.value2 -side right
|
||||||
|
pack $wi.jitter.value2 -before $wi.jitter.value
|
||||||
|
|
||||||
|
if { ![winfo exists $wi.ber.value2] } {
|
||||||
|
$spinbox $wi.ber.value2 -justify right -width 10 \
|
||||||
|
-validate focus -invalidcommand "focusAndFlash %W"
|
||||||
|
$wi.ber.value2 configure \
|
||||||
|
-validatecommand "checkFloatRange %P 0.0 100.0" \
|
||||||
|
-from 0.0 -to 100.0 -increment 0.1
|
||||||
|
}
|
||||||
|
$wi.ber.value2 delete 0 end
|
||||||
|
$wi.ber.value2 insert 0 [$wi.ber.value get]
|
||||||
|
pack $wi.ber.value2 -side right
|
||||||
|
pack $wi.ber.value2 -before $wi.ber.value
|
||||||
|
|
||||||
|
if { ![winfo exists $wi.dup.value2] } {
|
||||||
|
$spinbox $wi.dup.value2 -justify right -width 10 \
|
||||||
|
-validate focus -invalidcommand "focusAndFlash %W"
|
||||||
|
$wi.dup.value2 configure \
|
||||||
|
-validatecommand {checkFloatRange %P 0 50} \
|
||||||
|
-from 0 -to 50 -increment 1
|
||||||
|
}
|
||||||
|
$wi.dup.value2 delete 0 end
|
||||||
|
$wi.dup.value2 insert 0 [$wi.dup.value get]
|
||||||
|
pack $wi.dup.value2 -side right
|
||||||
|
pack $wi.dup.value2 -before $wi.dup.value
|
||||||
|
|
||||||
|
if { ![winfo exists $wi.unilabel] } {
|
||||||
|
ttk::frame $wi.unilabel
|
||||||
|
set txt " downstream / upstream "
|
||||||
|
ttk::label $wi.unilabel.updown -text $txt
|
||||||
|
}
|
||||||
|
pack $wi.unilabel.updown -side right -anchor e
|
||||||
|
pack $wi.unilabel -after $wi.preset
|
||||||
|
|
||||||
|
} else {
|
||||||
|
set g_link_config_uni_state "bid"
|
||||||
|
$wi.preset.uni configure -text "Unidir. >>"
|
||||||
|
pack forget $wi.bandwidth.value2
|
||||||
|
pack forget $wi.delay.value2
|
||||||
|
pack forget $wi.jitter.value2
|
||||||
|
pack forget $wi.ber.value2
|
||||||
|
pack forget $wi.dup.value2
|
||||||
|
pack forget $wi.unilabel.updown $wi.unilabel
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# unidirectional links are not always supported
|
||||||
|
proc isUniSupported { n1 n2 } {
|
||||||
|
set blacklist [list "hub" "lanswitch"]
|
||||||
|
set type1 [nodeType $n1]
|
||||||
|
set type2 [nodeType $n2]
|
||||||
|
# not yet supported for GRE tap device
|
||||||
|
if { $type1 == "tunnel" || $type2 == "tunnel" } {
|
||||||
|
return false
|
||||||
|
}
|
||||||
|
# unidirectional links are supported between two switches/hubs
|
||||||
|
if { [lsearch $blacklist $type1] != -1 && \
|
||||||
|
[lsearch $blacklist $type2] != -1 } {
|
||||||
|
return true
|
||||||
|
}
|
||||||
|
# unidirectional links not supported between hub/switch and something else
|
||||||
|
if { [lsearch $blacklist $type1] != -1 || \
|
||||||
|
[lsearch $blacklist $type2] != -1 } {
|
||||||
|
return false
|
||||||
|
}
|
||||||
|
# unidirectional links are supported between routers, rj45s, etc.
|
||||||
|
# WLANs not included here because they have no link dialog
|
||||||
|
return true
|
||||||
|
}
|
||||||
|
|
||||||
# toggle the state of the mac address entry, and insert MAC address template
|
# toggle the state of the mac address entry, and insert MAC address template
|
||||||
proc macEntryHelper { wi ifc } {
|
proc macEntryHelper { wi ifc } {
|
||||||
set fr $wi.ifaces.c.if$ifc
|
set fr $wi.ifaces.c.if$ifc
|
||||||
|
@ -3056,39 +3216,25 @@ proc popupConfigApply { wi object_type target phase } {
|
||||||
}
|
}
|
||||||
|
|
||||||
link {
|
link {
|
||||||
|
global g_link_config_uni_state
|
||||||
set mirror [getLinkMirror $target]
|
set mirror [getLinkMirror $target]
|
||||||
set bw [$wi.bandwidth.value get]
|
|
||||||
if { $bw != [getLinkBandwidth $target] } {
|
if { [setIfChanged $target $mirror $wi "bandwidth" "LinkBandwidth"] } {
|
||||||
setLinkBandwidth $target [$wi.bandwidth.value get]
|
|
||||||
if { $mirror != "" } {
|
|
||||||
setLinkBandwidth $mirror [$wi.bandwidth.value get]
|
|
||||||
}
|
|
||||||
set changed 1
|
set changed 1
|
||||||
}
|
}
|
||||||
set dly [$wi.delay.value get]
|
if { [setIfChanged $target $mirror $wi "delay" "LinkDelay"] } {
|
||||||
if { $dly != [getLinkDelay $target] } {
|
|
||||||
setLinkDelay $target [$wi.delay.value get]
|
|
||||||
if { $mirror != "" } {
|
|
||||||
setLinkDelay $mirror [$wi.delay.value get]
|
|
||||||
}
|
|
||||||
set changed 1
|
set changed 1
|
||||||
}
|
}
|
||||||
set ber [$wi.ber.value get]
|
if { [setIfChanged $target $mirror $wi "ber" "LinkBER"] } {
|
||||||
if { $ber != [getLinkBER $target] } {
|
|
||||||
setLinkBER $target [$wi.ber.value get]
|
|
||||||
if { $mirror != "" } {
|
|
||||||
setLinkBER $mirror [$wi.ber.value get]
|
|
||||||
}
|
|
||||||
set changed 1
|
set changed 1
|
||||||
}
|
}
|
||||||
set dup [$wi.dup.value get]
|
if { [setIfChanged $target $mirror $wi "dup" "LinkDup"] } {
|
||||||
if { $dup != [getLinkDup $target] } {
|
|
||||||
setLinkDup $target [$wi.dup.value get]
|
|
||||||
if { $mirror != "" } {
|
|
||||||
setLinkDup $mirror [$wi.dup.value get]
|
|
||||||
}
|
|
||||||
set changed 1
|
set changed 1
|
||||||
}
|
}
|
||||||
|
if { [setIfChanged $target $mirror $wi "jitter" "LinkJitter"] } {
|
||||||
|
set changed 1
|
||||||
|
}
|
||||||
|
|
||||||
if { $link_color != [getLinkColor $target] } {
|
if { $link_color != [getLinkColor $target] } {
|
||||||
setLinkColor $target $link_color
|
setLinkColor $target $link_color
|
||||||
if { $mirror != "" } {
|
if { $mirror != "" } {
|
||||||
|
@ -3098,9 +3244,9 @@ proc popupConfigApply { wi object_type target phase } {
|
||||||
}
|
}
|
||||||
set width [$wi.width.value get]
|
set width [$wi.width.value get]
|
||||||
if { $width != [getLinkWidth $target] } {
|
if { $width != [getLinkWidth $target] } {
|
||||||
setLinkWidth $target [$wi.width.value get]
|
setLinkWidth $target $width
|
||||||
if { $mirror != "" } {
|
if { $mirror != "" } {
|
||||||
setLinkWidth $mirror [$wi.width.value get]
|
setLinkWidth $mirror $width
|
||||||
}
|
}
|
||||||
set changed 1
|
set changed 1
|
||||||
}
|
}
|
||||||
|
@ -3114,6 +3260,30 @@ proc popupConfigApply { wi object_type target phase } {
|
||||||
popdownConfig $wi
|
popdownConfig $wi
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# helper for Link Config dialog
|
||||||
|
# ctl must exist as $wi.$ctl.value{2}, and {get,set}$procname must be valid
|
||||||
|
# returns true when value has changed, false otherwise
|
||||||
|
proc setIfChanged { target mirror wi ctl procname } {
|
||||||
|
global g_link_config_uni_state
|
||||||
|
|
||||||
|
set val [$wi.$ctl.value get]
|
||||||
|
if { $g_link_config_uni_state == "uni" } {
|
||||||
|
set val [list $val [$wi.$ctl.value2 get]]
|
||||||
|
}
|
||||||
|
set oldval [get$procname $target]
|
||||||
|
set oldval2 [get$procname $target "up"]
|
||||||
|
if { $oldval2 != "" } {
|
||||||
|
set oldval [list $oldval $oldval2]
|
||||||
|
}
|
||||||
|
if { $val != $oldval } {
|
||||||
|
set$procname $target $val
|
||||||
|
if { $mirror != "" } {
|
||||||
|
set$procname $mirror $val
|
||||||
|
}
|
||||||
|
return true
|
||||||
|
}
|
||||||
|
return false
|
||||||
|
}
|
||||||
|
|
||||||
#****f* editor.tcl/printCanvas
|
#****f* editor.tcl/printCanvas
|
||||||
# NAME
|
# NAME
|
||||||
|
@ -4400,8 +4570,8 @@ proc drawWallpaper { c f style } {
|
||||||
set cy [expr [lindex [getCanvasSize $curcanvas] 1]-2]
|
set cy [expr [lindex [getCanvasSize $curcanvas] 1]-2]
|
||||||
}
|
}
|
||||||
set f [absPathname $f]
|
set f [absPathname $f]
|
||||||
if { [ catch { set img [image create photo -file $f] } ] } {
|
if { [ catch { set img [image create photo -file $f] } e ] } {
|
||||||
puts "Error: couldn't open wallpaper file $f"
|
puts "Error: couldn't open wallpaper file $f: $e"
|
||||||
return
|
return
|
||||||
}
|
}
|
||||||
set imgx [image width $img]
|
set imgx [image width $img]
|
||||||
|
@ -4511,18 +4681,19 @@ proc rj45ifclist { wi node wasclicked } {
|
||||||
|
|
||||||
# link preset values - bandwidth delay ber duplicate
|
# link preset values - bandwidth delay ber duplicate
|
||||||
array set link_presets {
|
array set link_presets {
|
||||||
"unlimited" { 0 0 0 0 }
|
"unlimited" { 0 0 0 0 0 }
|
||||||
"1000M" { 1000000000 100 0 0}
|
"1000M" { 1000000000 100 0 0.0 0.0}
|
||||||
"100M" { 100000000 110 0 0}
|
"100M" { 100000000 110 0 0.0 0.0}
|
||||||
"10M" { 10000000 160 0 0}
|
"10M" { 10000000 160 0 0.0 0.0}
|
||||||
"512kbps" { 512000 50000 0 0}
|
"512kbps" { 512000 50000 0 0.0 0.0}
|
||||||
"256kbps" { 256000 75000 0 0}
|
"256kbps" { 256000 75000 0 0.0 0.0}
|
||||||
"64kbps" { 64000 80000 0 0}
|
"64kbps" { 64000 80000 0 0.0 0.0}
|
||||||
}
|
}
|
||||||
|
|
||||||
# link presets
|
# link presets
|
||||||
proc linkPresets { wi linkpreMenu cmd } {
|
proc linkPresets { wi linkpreMenu cmd } {
|
||||||
global link_presets link_preset_val
|
global link_presets link_preset_val
|
||||||
|
global g_link_config_uni_state
|
||||||
|
|
||||||
if { $cmd == "init" } { ;# populate the list with presets and exit
|
if { $cmd == "init" } { ;# populate the list with presets and exit
|
||||||
$linkpreMenu delete 0
|
$linkpreMenu delete 0
|
||||||
|
@ -4538,12 +4709,26 @@ proc linkPresets { wi linkpreMenu cmd } {
|
||||||
set params $link_presets($link_preset_val)
|
set params $link_presets($link_preset_val)
|
||||||
$wi.bandwidth.value delete 0 end
|
$wi.bandwidth.value delete 0 end
|
||||||
$wi.delay.value delete 0 end
|
$wi.delay.value delete 0 end
|
||||||
|
$wi.jitter.value delete 0 end
|
||||||
$wi.ber.value delete 0 end
|
$wi.ber.value delete 0 end
|
||||||
$wi.dup.value delete 0 end
|
$wi.dup.value delete 0 end
|
||||||
$wi.bandwidth.value insert 0 [lindex $params 0]
|
$wi.bandwidth.value insert 0 [lindex $params 0]
|
||||||
$wi.delay.value insert 0 [lindex $params 1]
|
$wi.delay.value insert 0 [lindex $params 1]
|
||||||
$wi.ber.value insert 0 [lindex $params 2]
|
$wi.jitter.value insert 0 [lindex $params 2]
|
||||||
$wi.dup.value insert 0 [lindex $params 3]
|
$wi.ber.value insert 0 [lindex $params 3]
|
||||||
|
$wi.dup.value insert 0 [lindex $params 4]
|
||||||
|
if { $g_link_config_uni_state == "uni" } {
|
||||||
|
$wi.bandwidth.value2 delete 0 end
|
||||||
|
$wi.delay.value2 delete 0 end
|
||||||
|
$wi.jitter.value2 delete 0 end
|
||||||
|
$wi.ber.value2 delete 0 end
|
||||||
|
$wi.dup.value2 delete 0 end
|
||||||
|
$wi.bandwidth.value2 insert 0 [lindex $params 0]
|
||||||
|
$wi.delay.value2 insert 0 [lindex $params 1]
|
||||||
|
$wi.jitter.value2 insert 0 [lindex $params 2]
|
||||||
|
$wi.ber.value2 insert 0 [lindex $params 3]
|
||||||
|
$wi.dup.value2 insert 0 [lindex $params 4]
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
set last_nodeHighlights [clock clicks -milliseconds]
|
set last_nodeHighlights [clock clicks -milliseconds]
|
||||||
|
|
199
gui/linkcfg.tcl
199
gui/linkcfg.tcl
|
@ -179,11 +179,13 @@ proc removeLink { link } {
|
||||||
# * bandwidth -- The value of link bandwidth in bits per second.
|
# * bandwidth -- The value of link bandwidth in bits per second.
|
||||||
#****
|
#****
|
||||||
|
|
||||||
proc getLinkBandwidth { link } {
|
proc getLinkBandwidth { link {dir "down"} } {
|
||||||
global $link
|
global $link
|
||||||
|
|
||||||
set entry [lsearch -inline [set $link] "bandwidth *"]
|
set entry [lsearch -inline [set $link] "bandwidth *"]
|
||||||
return [lindex $entry 1]
|
set val [lindex $entry 1] ;# one or more values
|
||||||
|
if { $dir == "up" } { return [lindex $val 1] }
|
||||||
|
return [lindex $val 0]
|
||||||
}
|
}
|
||||||
|
|
||||||
#****f* linkcfg.tcl/getLinkBandwidthString
|
#****f* linkcfg.tcl/getLinkBandwidthString
|
||||||
|
@ -204,25 +206,39 @@ proc getLinkBandwidth { link } {
|
||||||
proc getLinkBandwidthString { link } {
|
proc getLinkBandwidthString { link } {
|
||||||
global $link
|
global $link
|
||||||
set bandstr ""
|
set bandstr ""
|
||||||
|
set sep ""
|
||||||
set bandwidth [getLinkBandwidth $link]
|
set bandwidth [getLinkBandwidth $link]
|
||||||
if { $bandwidth > 0 } {
|
set bandwidthup [getLinkBandwidth $link up]
|
||||||
if { $bandwidth >= 660000000 } {
|
if { $bandwidthup > 0 } {
|
||||||
set bandstr "[format %.2f [expr {$bandwidth / 1000000000.0}]] Gbps"
|
set bandwidth [list $bandwidth $bandwidthup]
|
||||||
} elseif { $bandwidth >= 99000000 } {
|
set sep " / "
|
||||||
set bandstr "[format %d [expr {$bandwidth / 1000000}]] Mbps"
|
|
||||||
} elseif { $bandwidth >= 9900000 } {
|
|
||||||
set bandstr "[format %.2f [expr {$bandwidth / 1000000.0}]] Mbps"
|
|
||||||
} elseif { $bandwidth >= 990000 } {
|
|
||||||
set bandstr "[format %d [expr {$bandwidth / 1000}]] Kbps"
|
|
||||||
} elseif { $bandwidth >= 9900 } {
|
|
||||||
set bandstr "[format %.2f [expr {$bandwidth / 1000.0}]] Kbps"
|
|
||||||
} else {
|
|
||||||
set bandstr "$bandwidth bps"
|
|
||||||
}
|
}
|
||||||
|
foreach bw $bandwidth {
|
||||||
|
if { $bandstr != "" } { set bandstr "$bandstr$sep" }
|
||||||
|
set bandstr "$bandstr[getSIStringValue $bw "bps"]"
|
||||||
}
|
}
|
||||||
return $bandstr
|
return $bandstr
|
||||||
}
|
}
|
||||||
|
|
||||||
|
proc getSIStringValue { val suffix } {
|
||||||
|
if { $val <= 0 } {
|
||||||
|
return ""
|
||||||
|
}
|
||||||
|
if { $val >= 660000000 } {
|
||||||
|
return "[format %.2f [expr {$val / 1000000000.0}]] G$suffix"
|
||||||
|
} elseif { $val >= 99000000 } {
|
||||||
|
return "[format %d [expr {$val / 1000000}]] M$suffix"
|
||||||
|
} elseif { $val >= 9900000 } {
|
||||||
|
return "[format %.2f [expr {$val / 1000000.0}]] M$suffix"
|
||||||
|
} elseif { $val >= 990000 } {
|
||||||
|
return "[format %d [expr {$val / 1000}]] K$suffix"
|
||||||
|
} elseif { $val >= 9900 } {
|
||||||
|
return "[format %.2f [expr {$val / 1000.0}]] K$suffix"
|
||||||
|
} else {
|
||||||
|
return "$val $suffix"
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
#****f* linkcfg.tcl/setLinkBandwidth
|
#****f* linkcfg.tcl/setLinkBandwidth
|
||||||
# NAME
|
# NAME
|
||||||
# setLinkBandwidth -- set link bandwidth
|
# setLinkBandwidth -- set link bandwidth
|
||||||
|
@ -242,13 +258,11 @@ proc setLinkBandwidth { link value } {
|
||||||
if { $value <= 0 } {
|
if { $value <= 0 } {
|
||||||
set $link [lreplace [set $link] $i $i]
|
set $link [lreplace [set $link] $i $i]
|
||||||
} else {
|
} else {
|
||||||
|
if { [llength $value] > 1 } { set value "{$value}" }
|
||||||
set $link [lreplace [set $link] $i $i "bandwidth $value"]
|
set $link [lreplace [set $link] $i $i "bandwidth $value"]
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
#
|
|
||||||
# Marko - XXX document!
|
|
||||||
#
|
|
||||||
proc getLinkColor { link } {
|
proc getLinkColor { link } {
|
||||||
global $link defLinkColor
|
global $link defLinkColor
|
||||||
|
|
||||||
|
@ -298,11 +312,13 @@ proc setLinkWidth { link value } {
|
||||||
# * delay -- The value of link delay in microseconds.
|
# * delay -- The value of link delay in microseconds.
|
||||||
#****
|
#****
|
||||||
|
|
||||||
proc getLinkDelay { link } {
|
proc getLinkDelay { link {dir "down"} } {
|
||||||
global $link
|
global $link
|
||||||
|
|
||||||
set entry [lsearch -inline [set $link] "delay *"]
|
set entry [lsearch -inline [set $link] "delay *"]
|
||||||
return [lindex $entry 1]
|
set val [lindex $entry 1] ;# one or more values
|
||||||
|
if { $dir == "up" } { return [lindex $val 1] }
|
||||||
|
return [lindex $val 0]
|
||||||
}
|
}
|
||||||
|
|
||||||
#****f* linkcfg.tcl/getLinkDelayString
|
#****f* linkcfg.tcl/getLinkDelayString
|
||||||
|
@ -322,20 +338,49 @@ proc getLinkDelay { link } {
|
||||||
|
|
||||||
proc getLinkDelayString { link } {
|
proc getLinkDelayString { link } {
|
||||||
global $link
|
global $link
|
||||||
|
set plusminus "\261"
|
||||||
|
set delaystr ""
|
||||||
|
set sep ""
|
||||||
set delay [getLinkDelay $link]
|
set delay [getLinkDelay $link]
|
||||||
if { "$delay" != "" } {
|
set delayup [getLinkDelay $link up]
|
||||||
if { $delay >= 10000 } {
|
set jitter [getLinkJitter $link]
|
||||||
set delstr "[expr {$delay / 1000}] ms"
|
set jitterup [getLinkJitter $link up]
|
||||||
} elseif { $delay >= 1000 } {
|
if { $jitter > 0 && $delay == "" } { set delay 0 }
|
||||||
set delstr "[expr {$delay * .001}] ms"
|
if { $jitterup > 0 && $delayup == "" } { set delayup 0 }
|
||||||
} else {
|
if { $delayup > 0 || $jitterup > 0 } {
|
||||||
set delstr "$delay us"
|
set delay [list $delay $delayup]
|
||||||
|
set jitter [list $jitter $jitterup]
|
||||||
|
set sep " / "
|
||||||
}
|
}
|
||||||
|
set i 0
|
||||||
|
foreach d $delay {
|
||||||
|
if { $delaystr != "" } { set delaystr "$delaystr$sep" }
|
||||||
|
if { [lindex $jitter $i] != "" } {
|
||||||
|
set jstr " ($plusminus"
|
||||||
|
set jstr "$jstr[getSIMicrosecondValue [lindex $jitter $i]])"
|
||||||
} else {
|
} else {
|
||||||
set delstr ""
|
set jstr ""
|
||||||
|
}
|
||||||
|
#set dstr "[getSIMicrosecondValue $d]"
|
||||||
|
#if { $dstr == "" && $jstr != "" } { set dstr "0 us" }
|
||||||
|
#set delaystr "$delaystr$dstr$jstr"
|
||||||
|
set delaystr "$delaystr[getSIMicrosecondValue $d]$jstr"
|
||||||
|
incr i
|
||||||
|
}
|
||||||
|
return $delaystr
|
||||||
|
}
|
||||||
|
|
||||||
|
proc getSIMicrosecondValue { val } {
|
||||||
|
if { $val == "" } {
|
||||||
|
return ""
|
||||||
|
}
|
||||||
|
if { $val >= 10000 } {
|
||||||
|
return "[expr {$val / 1000}] ms"
|
||||||
|
} elseif { $val >= 1000 } {
|
||||||
|
return "[expr {$val * .001}] ms"
|
||||||
|
} else {
|
||||||
|
return "$val us"
|
||||||
}
|
}
|
||||||
return $delstr
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#****f* linkcfg.tcl/setLinkDelay
|
#****f* linkcfg.tcl/setLinkDelay
|
||||||
|
@ -354,9 +399,10 @@ proc setLinkDelay { link value } {
|
||||||
global $link
|
global $link
|
||||||
|
|
||||||
set i [lsearch [set $link] "delay *"]
|
set i [lsearch [set $link] "delay *"]
|
||||||
if { $value <= 0 } {
|
if { [checkEmptyZeroValues $value] } {
|
||||||
set $link [lreplace [set $link] $i $i]
|
set $link [lreplace [set $link] $i $i]
|
||||||
} else {
|
} else {
|
||||||
|
if { [llength $value] > 1 } { set value "{$value}" }
|
||||||
set $link [lreplace [set $link] $i $i "delay $value"]
|
set $link [lreplace [set $link] $i $i "delay $value"]
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -374,11 +420,27 @@ proc setLinkDelay { link value } {
|
||||||
# * BER -- The value of 1/BER of the link.
|
# * BER -- The value of 1/BER of the link.
|
||||||
#****
|
#****
|
||||||
|
|
||||||
proc getLinkBER { link } {
|
proc getLinkBER { link {dir "down"} } {
|
||||||
global $link
|
global $link
|
||||||
|
|
||||||
set entry [lsearch -inline [set $link] "ber *"]
|
set entry [lsearch -inline [set $link] "ber *"]
|
||||||
return [lindex $entry 1]
|
set val [lindex $entry 1] ;# one or more values
|
||||||
|
if { $dir == "up" } { return [lindex $val 1] }
|
||||||
|
return [lindex $val 0]
|
||||||
|
}
|
||||||
|
|
||||||
|
proc getLinkBERString { link } {
|
||||||
|
set ber [getLinkBER $link]
|
||||||
|
set berup [getLinkBER $link up]
|
||||||
|
if { $ber == "" && $berup == "" } { return "" }
|
||||||
|
set berstr "loss="
|
||||||
|
if { $ber != "" } {
|
||||||
|
set berstr "$berstr$ber%"
|
||||||
|
}
|
||||||
|
if { $berup != "" } {
|
||||||
|
set berstr "$berstr / $berup%"
|
||||||
|
}
|
||||||
|
return $berstr
|
||||||
}
|
}
|
||||||
|
|
||||||
#****f* linkcfg.tcl/setLinkBER
|
#****f* linkcfg.tcl/setLinkBER
|
||||||
|
@ -397,9 +459,13 @@ proc setLinkBER { link value } {
|
||||||
global $link
|
global $link
|
||||||
|
|
||||||
set i [lsearch [set $link] "ber *"]
|
set i [lsearch [set $link] "ber *"]
|
||||||
if { $value <= 0 } {
|
if { [llength $value] > 1 && [lindex $value 0] <= 0 && \
|
||||||
|
[lindex $value 1] <= 0 } {
|
||||||
|
set $link [lreplace [set $link] $i $i]
|
||||||
|
} elseif { $value <= 0 } {
|
||||||
set $link [lreplace [set $link] $i $i]
|
set $link [lreplace [set $link] $i $i]
|
||||||
} else {
|
} else {
|
||||||
|
if { [llength $value] > 1 } { set value "{$value}" }
|
||||||
set $link [lreplace [set $link] $i $i "ber $value"]
|
set $link [lreplace [set $link] $i $i "ber $value"]
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -417,11 +483,27 @@ proc setLinkBER { link value } {
|
||||||
# * duplicate -- The percentage of the link packet duplicate value.
|
# * duplicate -- The percentage of the link packet duplicate value.
|
||||||
#****
|
#****
|
||||||
|
|
||||||
proc getLinkDup { link } {
|
proc getLinkDup { link {dir "down"} } {
|
||||||
global $link
|
global $link
|
||||||
|
|
||||||
set entry [lsearch -inline [set $link] "duplicate *"]
|
set entry [lsearch -inline [set $link] "duplicate *"]
|
||||||
return [lindex $entry 1]
|
set val [lindex $entry 1] ;# one or more values
|
||||||
|
if { $dir == "up" } { return [lindex $val 1] }
|
||||||
|
return [lindex $val 0]
|
||||||
|
}
|
||||||
|
|
||||||
|
proc getLinkDupString { link } {
|
||||||
|
set dup [getLinkDup $link]
|
||||||
|
set dupup [getLinkDup $link up]
|
||||||
|
if { $dup == "" && $dupup == "" } { return "" }
|
||||||
|
set dupstr "dup="
|
||||||
|
if { $dup != "" } {
|
||||||
|
set dupstr "$dupstr$dup%"
|
||||||
|
}
|
||||||
|
if { $dupup != "" } {
|
||||||
|
set dupstr "$dupstr / $dupup%"
|
||||||
|
}
|
||||||
|
return $dupstr
|
||||||
}
|
}
|
||||||
|
|
||||||
#****f* linkcfg.tcl/setLinkDup
|
#****f* linkcfg.tcl/setLinkDup
|
||||||
|
@ -440,13 +522,29 @@ proc setLinkDup { link value } {
|
||||||
global $link
|
global $link
|
||||||
|
|
||||||
set i [lsearch [set $link] "duplicate *"]
|
set i [lsearch [set $link] "duplicate *"]
|
||||||
if { $value <= 0 || $value > 50 } {
|
if { [checkEmptyZeroValues $value] } {
|
||||||
set $link [lreplace [set $link] $i $i]
|
set $link [lreplace [set $link] $i $i]
|
||||||
} else {
|
} else {
|
||||||
|
if { [llength $value] > 1 } { set value "{$value}" }
|
||||||
set $link [lreplace [set $link] $i $i "duplicate $value"]
|
set $link [lreplace [set $link] $i $i "duplicate $value"]
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Returns true if link has unidirectional link effects, where
|
||||||
|
# upstream values may differ from downstream.
|
||||||
|
proc isLinkUni { link } {
|
||||||
|
set bw [getLinkBandwidth $link up]
|
||||||
|
set dl [getLinkDelay $link up]
|
||||||
|
set jt [getLinkJitter $link up]
|
||||||
|
set ber [getLinkBER $link up]
|
||||||
|
set dup [getLinkDup $link up]
|
||||||
|
if { $bw > 0 || $dl > 0 || $jt > 0 || $ber > 0 || $dup > 0 } {
|
||||||
|
return true
|
||||||
|
} else {
|
||||||
|
return false
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
#****f* linkcfg.tcl/getLinkMirror
|
#****f* linkcfg.tcl/getLinkMirror
|
||||||
# NAME
|
# NAME
|
||||||
# getLinkMirror -- get link's mirror link
|
# getLinkMirror -- get link's mirror link
|
||||||
|
@ -588,7 +686,7 @@ proc mergeLink { link } {
|
||||||
|
|
||||||
set mirror_link [getLinkMirror $link]
|
set mirror_link [getLinkMirror $link]
|
||||||
if { $mirror_link == "" } {
|
if { $mirror_link == "" } {
|
||||||
puts "XXX mergeLink called for non-pseudo link!!!"
|
puts "error: mergeLink called for non-pseudo link"
|
||||||
return
|
return
|
||||||
}
|
}
|
||||||
set link1_peers [linkPeers $link]
|
set link1_peers [linkPeers $link]
|
||||||
|
@ -836,25 +934,42 @@ proc linkByIfc { node ifc } {
|
||||||
return [list $link $dir]
|
return [list $link $dir]
|
||||||
}
|
}
|
||||||
|
|
||||||
# Boeing: jitter
|
proc getLinkJitter { link {dir "down"} } {
|
||||||
proc getLinkJitter { link } {
|
|
||||||
global $link
|
global $link
|
||||||
|
|
||||||
set entry [lsearch -inline [set $link] "jitter *"]
|
set entry [lsearch -inline [set $link] "jitter *"]
|
||||||
return [lindex $entry 1]
|
set val [lindex $entry 1] ;# one or more values
|
||||||
|
if { $dir == "up" } { return [lindex $val 1] }
|
||||||
|
return [lindex $val 0]
|
||||||
}
|
}
|
||||||
|
|
||||||
proc setLinkJitter { link value } {
|
proc setLinkJitter { link value } {
|
||||||
global $link
|
global $link
|
||||||
|
|
||||||
set i [lsearch [set $link] "jitter *"]
|
set i [lsearch [set $link] "jitter *"]
|
||||||
if { $value <= 0 } {
|
if { [llength $value] <= 1 && $value <= 0 } {
|
||||||
|
set $link [lreplace [set $link] $i $i]
|
||||||
|
} elseif { [llength $value] > 1 && [lindex $value 0] <= 0 && \
|
||||||
|
[lindex $value 1] <= 0 } {
|
||||||
set $link [lreplace [set $link] $i $i]
|
set $link [lreplace [set $link] $i $i]
|
||||||
} else {
|
} else {
|
||||||
|
if { [llength $value] > 1 } { set value "{$value}" }
|
||||||
set $link [lreplace [set $link] $i $i "jitter $value"]
|
set $link [lreplace [set $link] $i $i "jitter $value"]
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Check for empty or zero values in value.
|
||||||
|
# Value may be a single value or list where the first two values will be
|
||||||
|
# inspected; returns true for empty or zero values, false otherwise.
|
||||||
|
proc checkEmptyZeroValues { value } {
|
||||||
|
set isempty true
|
||||||
|
foreach v $value {
|
||||||
|
if { $v == "" } { continue } ;# this catches common case "{} {}"
|
||||||
|
if { $v > 0 } { set isempty false }
|
||||||
|
}
|
||||||
|
return $isempty
|
||||||
|
}
|
||||||
|
|
||||||
# get any type of link attribute
|
# get any type of link attribute
|
||||||
proc getLinkOpaque { link key } {
|
proc getLinkOpaque { link key } {
|
||||||
global $link
|
global $link
|
||||||
|
|
Loading…
Reference in a new issue