set vtysh_cmd vtysh
set vtysh_search_path {/usr/bin /usr/local/bin /usr/lib/quagga}
set vtysh [auto_execok $vtysh_cmd]
if {$vtysh == ""} {
set vtysh $vtysh_cmd
foreach p $vtysh_search_path {
if {[file executable $p/$vtysh_cmd]} {
set vtysh $p/$vtysh_cmd
break
}
}
}
#
# Widgets are defined in this array.
# widget array: name, {config, init, periodic, move}
#
array set widgets {
"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
# 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
{{OSPFv2 neighbors} {$vtysh -c {show ip ospf neighbor}}}
6
{{OSPFv3 neighbors} {$vtysh -c {show ipv6 ospf6 neighbor}}}
13
{{OSPFv3 MDR level} {$vtysh -c {show ipv6 ospf6 mdrlevel}}}
14
{{PIM neighbors} {$vtysh -c {show ip pim neighbor}}}
}]
# Observer Widget definitions for Linux
array set widgets_obs_linux $widgets_obs_quagga
array set widgets_obs_linux {
1
{ "processes" "ps -e" }
2
{ "ifconfig" "/sbin/ifconfig" }
3
{ "IPv4 routes" "/sbin/ip -4 ro" }
4
{ "IPv6 routes" "/sbin/ip -6 ro" }
7
{ "Listening sockets" "netstat -tuwnl" }
8
{ "IPv4 MFC entries" "/sbin/ip -4 mroute show" }
9
{ "IPv6 MFC entries" "/sbin/ip -6 mroute show" }
10
{ "firewall rules" "/sbin/iptables -L" }
11
{ "IPSec policies" "setkey -DP" }
12
{ "docker logs" "bash -c 'docker logs $(docker ps -q) | tail -20'"}
}
set widget_loop_ID -1
#
# Set default Observer Widget array, used when widgets.conf is unvailable.
#
proc init_default_widgets_obs {} {
global systype widgets widgets_obs widget_obs last_widgetObserveNode
global widgets_obs_linux
setSystype
array unset widgets_obs
set arrayname widgets_obs_linux
# this works, but we will instead reset all indices:
#array set widgets_obs [array get widgets_obs_linux]
# this resets the array indices to be 1, 2, 3, etc.
set i 1
foreach {idx value} [array get $arrayname] {
set name [lindex $value 0]
set cmd [lindex $value 1]
array set widgets_obs [list $i [list $name $cmd]]
incr i
}
}
#
# Dynamically loads the widget menu from the widget array
#
proc init_widget_menu {} {
global widgets last_widgetObserveNode
menu .menubar.widgets -tearoff 1
menu .menubar.widgets.obs -tearoff 1
.menubar.widgets add cascade -label "Observer Widgets" \
-menu .menubar.widgets.obs
# standard widgets
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
if { $w == "Adjacency" } {
widget_adjacency_init_submenu .menubar.widgets
continue
}
#
.menubar.widgets add checkbutton -label "$w" -variable enable_$w \
-command "[lindex $widgets($w) 1] menu"
}
# observer widgets
init_widget_obs_menu
# configure each widget
.menubar.widgets add separator
foreach w [array names widgets] {
.menubar.widgets add command -label "Configure $w..." \
-command [lindex $widgets($w) 0]
}
}
proc init_widget_obs_menu {} {
global widgets_obs widget_obs last_widgetObserveNode
# clear the existing menu
.menubar.widgets.obs delete 0 end
# observer widgets
set widget_obs 0
set last_widgetObserveNode [clock clicks -milliseconds]
.menubar.widgets.obs add radiobutton -label "None" -variable widget_obs \
-value 0 -command "obsBtn default"
set obs [array names widgets_obs]
foreach w [lsort -integer $obs] {
set capt [lindex $widgets_obs($w) 0]
.menubar.widgets.obs add radiobutton -label "$capt" \
-variable widget_obs -value $w -command "obsBtn gray"
}
.menubar.widgets.obs add command -label "Edit..." \
-command configObsWidgets
}
#
# Calls the periodic proc for each enabled widget
#
# this loop fires periodically, started from exec.tcl/setOperMode(exec)
proc widget_loop { } {
global oper_mode widget_loop_ID
set c .c
set now [clock clicks -milliseconds]
set refresh_ms 1000
# terminates this event loop
if { $oper_mode != "exec" } {
# cleanup here
widgets_stop
return
}
# call periodic function for each widget
global widgets
foreach w [array names widgets] {
global enable_$w
if { [set enable_$w] } {
if {$widget_loop_ID == -1} { ;# first time: call initialize func
[lindex $widgets($w) 1] start
}
[lindex $widgets($w) 2] $now
}
}
update ;# let the GUI process things
# account for time elapsed doing periodic functions
set now2 [clock clicks -milliseconds]
set refresh_ms [expr {$refresh_ms - ($now2-$now)}]
if { $refresh_ms <= 0 } {
# puts "warning: widget periodic functions are unable to keep up ($refresh_ms ms lost)"
set refresh_ms 100
}
set widget_loop_ID [after $refresh_ms { widget_loop }]
}
#
# De-initialize widgets
#
proc widgets_stop { } {
# call periodic function for each widget
global widgets widget_loop_ID
after cancel $widget_loop_ID ;# prevent the widget loop from executing
set widget_loop_ID -1
foreach w [array names widgets] {
global enable_$w
if { [set enable_$w] } {
[lindex $widgets($w) 1] "stop"
}
}
}
#
# Calls the node movement handler each enabled widget
#
# called from editor.tcl, button1-motion
proc widgets_move_node { c node done } {
global oper_mode
if { $oper_mode != "exec" } {
return
}
# call node move function for each widget
global widgets
foreach w [array names widgets] {
global enable_$w
if { [set enable_$w] } {
[lindex $widgets($w) 3] $c $node $done
}
}
}
# popup the widget menu from a button
proc popupObserverWidgets {} {
global activetool
set activetool select
set x [expr [winfo rootx .left.observe] + 10]
set y [expr [winfo rooty .left.observe] + 10]
.menubar.widgets.obs post $x $y
}
# change the color of the observer widget toolbar button
proc obsBtn { color } {
# default color is efebe7, but theme dependent?
if { $color == "default" } {
set color [.left.select cget -bg]
floatingInfo .c "" ""
}
catch { .left.observe configure -bg $color }
}
# dummy functions for widgets that don't define
proc widget_config_none {} {
return
}
proc widget_init_none {command} {
return
}
proc widget_periodic_none {now} {
return
}
proc widget_move_none {c node done} {
return
}
# observer widget support
proc widgetObserveNode {c node} {
global oper_mode eid widget_obs widgets_obs
# not running, no observer selected
if { $oper_mode != "exec" } { return }
if { ![info exists widgets_obs($widget_obs)] } { return }
global last_widgetObserveNode
if { [winfo pointerxy .] == $last_widgetObserveNode} {
return; # cursor has not really moved -- avoid callback loop
}
# delete popup
if { $node == "" } {
floatingInfo $c "" ""
return
}
# observe layer3 NETWORK nodes only
if { [[typemodel $node].layer] == "LINK" && \
[getNodeModel $node] != "remote" } {
return
}
set last_widgetObserveNode [winfo pointerxy .]
set obsinfo $widgets_obs($widget_obs)
set sock [lindex [getEmulPlugin $node] 2]
set exec_num [newExecCallbackRequest observer]
set cmd [lindex $obsinfo 1]
set cmd [string map { \{ ' \} ' } $cmd] ;# replace brackets with quotes
sendExecMessage $sock $node $cmd $exec_num 0x30
}
# popup a dialog box for editing the Observer Widget list
# results are stored in widgets.conf file and widget_obs array
proc configObsWidgets {} {
global widgets_obs last_obswidget_selected CORE_DATA_DIR
set wi .obsWidgetsConfig
catch {destroy $wi}
toplevel $wi
wm transient $wi .
wm resizable $wi 0 0
wm title $wi "Observer Widgets"
set last_obswidget_selected -1
# turn on/off remote execution
frame $wi.t -borderwidth 4
set img [image create photo -file "$CORE_DATA_DIR/icons/tiny/observe.gif"]
radiobutton $wi.t.img -indicatoron 0 -activebackground gray \
-selectcolor [.left cget -bg] -image $img
label $wi.t.help -wraplength 350 -text "Observer Widgets are commands run on a node upon mouse-over with their result displayed in a popup box. Their associated commands should exit quickly in order to avoid display delay."
pack $wi.t.img $wi.t.help -side left
pack $wi.t -fill x -side top
# controls for editing entries
labelframe $wi.c -text "Widget settings"
frame $wi.c.c -borderwidth 4
label $wi.c.c.namelab -text "Name "
entry $wi.c.c.name -bg white -width 30
bind $wi.c.c.name <KeyPress> "$wi.c.c3.add configure -state normal"
pack $wi.c.c.namelab $wi.c.c.name -side left
pack $wi.c.c -fill x -side top
frame $wi.c.c2 -borderwidth 4
label $wi.c.c2.cmdlab -text "Command"
entry $wi.c.c2.cmd -bg white -width 40
pack $wi.c.c2.cmdlab $wi.c.c2.cmd -side left
pack $wi.c.c2 -fill x -side top
frame $wi.c.c3 -borderwidth 4
button $wi.c.c3.add -text "new" \
-command "configObsWidgetsHelper $wi 1"
button $wi.c.c3.mod -text "modify" \
-command "configObsWidgetsHelper $wi 2"
button $wi.c.c3.del -text "delete" \
-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
pack $wi.c -fill x -side top
# list of widgets
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"
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"
# up/down buttons
frame $wi.buttons2
foreach b {up down} {
set fn "$CORE_DATA_DIR/icons/tiny/arrow.${b}.gif"
set img$b [image create photo -file $fn]
if { $b=="up" } { set cmd 4 } else { set cmd 5 }
button $wi.buttons2.$b -image [set img${b}] \
-command "configObsWidgetsHelper $wi $cmd"
}
pack $wi.buttons2.up $wi.buttons2.down -side left -expand 1
pack $wi.buttons2 -side top -fill x -pady 2
# populate the list
foreach w [lsort -integer [array names widgets_obs]] {
set name [lindex $widgets_obs($w) 0]
$wi.s.servers insert end $name
}
# apply/cancel buttons
frame $wi.b -borderwidth 4
button $wi.b.apply -text "Apply" -command \
"writeWidgetsConf; destroy $wi; init_widget_obs_menu"
button $wi.b.reset -text "Reset All" -command "resetObsWidgets"
button $wi.b.cancel -text "Cancel" -command "loadWidgetsConf; destroy $wi"
pack $wi.b.cancel $wi.b.reset $wi.b.apply -side right
pack $wi.b -side bottom
focus $wi.b.apply
after 100 { catch { set wi .obsWidgetsConfig; grab $wi; \
$wi.s.servers selection set 0; \
selectObsWidgetConf $wi } }
}
#
# Load the widgets.conf file into the widgets_obs array.
#
proc loadWidgetsConf { } {
global CONFDIR widgets_obs
set confname "$CONFDIR/widgets.conf"
if { [catch { set f [open "$confname" r] } ] } {
init_default_widgets_obs
if { [catch { set f [open "$confname" w+] } ] } {
puts "***Warning: could not create a default $confname file."
return
}
foreach w [lsort -integer [array names widgets_obs]] {
set name [lindex $widgets_obs($w) 0]
set cmd [lindex $widgets_obs($w) 1]
puts $f "$w {{$name} {$cmd}}"
}
close $f
if { [catch { set f [open "$confname" r] } ] } {
return
}
}
array unset widgets_obs
while { [ gets $f line ] >= 0 } {
if { [string range $line 0 0] == "#" } { continue } ;# skip comments
array set widgets_obs $line
}
close $f
}
#
# Write the widgets.conf file from the widgets_obs array.
#
proc writeWidgetsConf { } {
global CONFDIR widgets_obs
set confname "$CONFDIR/widgets.conf"
if { [catch { set f [open "$confname" w] } ] } {
puts "***Warning: could not write widgets file: $confname"
return
}
set header "# widgets.conf: CORE Observer Widgets customization file."
puts $f $header
foreach w [lsort -integer [array names widgets_obs]] {
puts $f "$w { [string trim $widgets_obs($w)] }"
}
close $f
}
# add/modify/remove server in list
proc configObsWidgetsHelper { wi action } {
global widgets_obs last_obswidget_selected
set index end
set arrindex [expr {[array size widgets_obs] + 1}] ;# index for new items
# delete from list, array
if { $action > 1 } { ;# delete/modify
if { $last_obswidget_selected < 0 } { return }
if { $action > 3 } { ;# move up/down
if { $action == 4 && $last_obswidget_selected == 0 } { return }
if { $action == 5 && $last_obswidget_selected > \
[expr {[array size widgets_obs] - 2}] } { return }
}
set server [$wi.s.servers get $last_obswidget_selected]
$wi.s.servers delete $last_obswidget_selected
# listbox index 0 item is array item 1
set index $last_obswidget_selected
set arrindex [expr { $last_obswidget_selected + 1 }]
array unset widgets_obs $arrindex
set oldarrindex $arrindex
if { $action == 3 } { ;# delete
$wi.c.c3.add configure -state normal
return
} elseif { $action == 4 } { ;# move up
incr index -1
incr arrindex -1
} elseif { $action == 5 } { ;# move down
incr index
incr arrindex
}
}
# new widget item
set newwidget [$wi.c.c.name get]
$wi.s.servers insert $index $newwidget
# update the array
set cmd [$wi.c.c2.cmd get]
if { $action > 3 } {
# move widgets_obs(arrindex) to widgets_obs(oldarrindex)
set tmp $widgets_obs($arrindex)
array set widgets_obs [list $oldarrindex $tmp]
}
array set widgets_obs [list $arrindex [list $newwidget $cmd]]
# update the list
$wi.s.servers selection set $index
set last_obswidget_selected $index
$wi.c.c3.add configure -state disabled
}
# connects the widgets listbox with entry elements
proc selectObsWidgetConf { wi } {
global widgets_obs last_obswidget_selected
set selected [$wi.s.servers curselection]
# clear entries
$wi.c.c.name delete 0 end
$wi.c.c2.cmd delete 0 end
set w [$wi.s.servers get $selected]
set si -1
foreach i [array names widgets_obs] {
if { [lindex $widgets_obs($i) 0] == $w } { set si $i; break }
}
if { $si < 0 } { return }
$wi.c.c3.add configure -state disabled
set last_obswidget_selected $selected
# insert entries from array
$wi.c.c.name insert 0 [lindex $widgets_obs($si) 0]
$wi.c.c2.cmd insert 0 [lindex $widgets_obs($si) 1]
}
proc resetObsWidgets {} {
set m "Reset to the default list of Observer Widgets?"
set m "$m\nYou will lose any custom widgets."
set choice [tk_messageBox -type yesno -default no -icon warning -message $m]
if { $choice == "no" } { return }
init_default_widgets_obs
init_widget_obs_menu
configObsWidgets
}
proc exec_observer_callback { node execnum cmd result status } {
set c .c
if { $result == "" } { return }
floatingInfo $c $node $result
}
################################################################################
##### #####
##### Throughput Widget #####
##### #####
################################################################################
array set thruConfig { show 1 up 1 down 1 avg 1 thresh 250.0 width 10 color #FF0000 }
# netgraph names of pipe nodes
array set throughput_cache { }
#
# Throughput widget config dialog
#
proc widget_thru_config {} {
set wi .thru_config
catch {destroy $wi}
toplevel $wi
wm transient $wi .
wm resizable $wi 0 0
wm title $wi "Throughput config"
global thruConfig
# Show throughput
frame $wi.tlab -borderwidth 4
checkbutton $wi.tlab.show_thru \
-text "Show throughput label on every link" -variable thruConfig(show)
checkbutton $wi.tlab.avg \
-text "Use exponentially weighted moving average" \
-variable thruConfig(avg)
checkbutton $wi.tlab.down \
-text "Include transmissions" -variable thruConfig(down)
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
pack $wi.tlab -side top
frame $wi.msg -borderwidth 4
global systype
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 "
pack $wi.hi.lab1 -side top -anchor w
frame $wi.hi.t
label $wi.hi.t.lab1 -text "threshold (0 for disabled):"
entry $wi.hi.t.thresh -bg white -width 8 -textvariable thruConfig(thresh)
label $wi.hi.t.lab2 -text "kbps"
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
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) \
-from 0 -to 40
pack $wi.hi.w.width $wi.hi.w.lab3 -side right -padx 4 -pady 4
pack $wi.hi.w -side top
frame $wi.hi.co -borderwidth 4
label $wi.hi.co.lab1 -text "Highlight color:"
set color $thruConfig(color)
label $wi.hi.co.color -fg black -bg $color -text $color
button $wi.hi.co.colbtn -text "Color..." -command \
"popupColor bg $wi.hi.co.color true"
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
frame $wi.butt -borderwidth 6
button $wi.butt.apply -text "OK" -command "widget_thru_config_apply $wi"
pack $wi.butt.apply -side right
pack $wi.butt -side bottom
bind $wi <Key-Escape> "destroy $wi"
bind $wi <Key-Return> "destroy $wi"
after 100 {
catch { grab .thru_config }
}
}
proc widget_thru_config_apply { wi } {
# this is needed because label textvariable won't update
global thruConfig
set thruConfig(color) [$wi.hi.co.color cget -bg]
destroy $wi
}
#
# Throughput widget de/initialization
#
proc widget_thru_init {command} {
global showLinkLabels enable_Throughput g_execRequests
global link_thru_stats link_thru_avg_stats link_thru_last_time
array set g_execRequests { thru "" }
if {[array exists link_thru_stats]} { array unset link_thru_stats }
array set link_thru_stats {}
if {[array exists link_thru_avg_stats]} { array unset link_thru_avg_stats }
array set link_thru_avg_stats {}
set link_thru_last_time [clock clicks -milliseconds]
# Initialize
if { $enable_Throughput } {
set showLinkLabels 1
foreach object [.c find withtag linklabel] {
.c itemconfigure $object -state normal
}
if { $command != "stop" } {
widget_thru_init_cache
}
}
# De-initialize
if { !$enable_Throughput || $command == "stop" } {
global link_list
foreach link $link_list {
set lnode1 [lindex [linkPeers $link] 0]
set lnode2 [lindex [linkPeers $link] 1]
updateLinkLabel $link
set width [getLinkWidth $link]
.c itemconfigure "link && $link" -width $width
if { [nodeType $lnode1] == "wlan" } {
.c delete -withtag "$lnode2 && rangecircles"
}
}
}
}
# build an array of netgraph IDs of pipe nodes, using node/interface
# names as the key
proc widget_thru_init_cache { } {
global throughput_cache systype
if { [lindex $systype 0] == "Linux" } { return }
array unset throughput_cache *
set ngctlout [nexec localnode sudo ngctl l]
foreach ngctlline [split $ngctlout "\n"] {
set ngtype [lindex $ngctlline 3]
if { $ngtype != "pipe" } { continue }
set ngname [lindex $ngctlline 1]
if { $ngname == "<unnamed>" } { continue }
set ngpipeout [split [nexec localnode sudo ngctl show $ngname:] "\n"]
set if1 [ngctl_output_to_ifname [lindex $ngpipeout 3]]
set if2 [ngctl_output_to_ifname [lindex $ngpipeout 4]]
array set throughput_cache [list $if1 $ngname]
array set throughput_cache [list $if2 $ngname]
}
}
# helper to convert a line from 'ngctl show' output into an interface name
proc ngctl_output_to_ifname { line } {
set ngname [lindex $line 1]
# chop off "_148" portion of "n2_0_148"
set i [string last "_" $ngname]
if { $i < 0 } { return $ngname }
incr i -1
set name [string range $ngname 0 $i]
return $name
}
#
# Throughput widget periodic procedure
#
proc widget_thru_periodic { now } {
global systype eid link_list
global link_thru_stats link_thru_avg_stats link_thru_last_time thruConfig
global throughput_cache
set alpha 0.4
# get the number of seconds elapsed since we were last here
if {![info exists link_thru_last_time]} { return }
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 {}
# TODO: use CORE API so we don't need to read the local filesystem to
# retrieve the interface statistics; also a publish/subscribe model
# may be better than this periodic polling
if { [lindex $systype 0] == "Linux" } {
# read /proc/net/dev
if { [catch {set f [open "/proc/net/dev" r]} e] } {
puts "error opening /proc/net/dev: $e"
return
}
set stats [read $f]
close $f
set stats [split $stats "\n"]
}
foreach link $link_list {
set lnode1 [lindex [linkPeers $link] 0]
set lnode2 [lindex [linkPeers $link] 1]
set if1n [string range [ifcByPeer $lnode1 $lnode2] 3 end]
set if2n [string range [ifcByPeer $lnode2 $lnode1] 3 end]
set key "${lnode1}_${if1n}-${lnode2}_${if2n}"
# get stats from /proc/dev/net that we already read
if { [lindex $systype 0] == "Linux" } {
set ifname [getstats_link_ifname $link]
set bytes [getstats_bytes_proc $stats $ifname]
# read stats per link from Netgraph pipes
} else {
set cache_key "${lnode1}_${if1n}"
if { ![info exists throughput_cache($cache_key)] } {
puts "throughput: skipping link $link ($cache_key)"; continue;
}
set ngname $throughput_cache($cache_key)
set stats [nexec $lnode1 sudo ngctl msg $ngname: getstats]
set bytes [getstats_bytes_netgraph $stats]
}
# init new stats bucket
if { ![info exists link_thru_stats($key)] } {
set link_thru_stats($key) $bytes
continue
}
set bytes2 $link_thru_stats($key)
set link_thru_stats($key) $bytes
# convert to kilobits per second
set div [expr { (1000.0 / 8.0) * $dt }]
set kbps_down [expr { ([lindex $bytes 0]-[lindex $bytes2 0]) / $div }]
set kbps_up [expr { ([lindex $bytes 1]-[lindex $bytes2 1]) / $div }]
set kbps 0.0
if { $thruConfig(up) } {
set kbps [expr {$kbps + $kbps_up}]
}
if { $thruConfig(down) } {
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
} else {
set s2 $link_thru_avg_stats($key)
set s [expr {($alpha*$kbps) + (1.0-$alpha)*$s2}]
set link_thru_avg_stats($key) $s
set kbps $s
}
}
set kbps_str [format "%.3f" $kbps]
# wireless link - keep total of wireless throughput for this node
# (supports membership to multiple wlans)
if { [nodeType $lnode1] == "wlan" } {
if {![info exists wireless_stats($lnode2)]} {
set wireless_stats($lnode2) 0
}
set wireless_stats($lnode2) [expr {$kbps+$wireless_stats($lnode2)}]
# normal wired links
} else {
if { $thruConfig(thresh) > 0.0 && \
$kbps_str > $thruConfig(thresh) } {
set width $thruConfig(width)
set color $thruConfig(color)
} else {
set width [getLinkWidth $link]
set color [getLinkColor $link]
}
if { $thruConfig(show) } {
.c itemconfigure "linklabel && $link" -text "$kbps_str kbps"
}
.c itemconfigure "link && $link" -width $width -fill $color
}
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
if { $thruConfig(thresh) > 0.0 && $kbps_str > $thruConfig(thresh) } {
global zoom
#set radius [expr {$zoom * [getNodeRange $lnode1]/2}]
set radius [expr {$zoom * 45.0}]
set coords [getNodeCoords $node]
set x [expr {[lindex $coords 0] * $zoom}]
set y [expr {[lindex $coords 1] * $zoom}]
set x1 [expr $x - $radius]
set y1 [expr $y - $radius]
set x2 [expr $x + $radius]
set y2 [expr $y + $radius]
set newcircle [.c create oval $x1 $y1 $x2 $y2 \
-width 4 -outline $thruConfig(color) -dash {10 4} \
-tags "$node circle rangecircles"]
}
# wireless kbps label
if { $thruConfig(show) } {
global zoom
set coords [getNodeCoords $node]
set x [expr {([lindex $coords 0] + 55) * $zoom}]
set y [expr {([lindex $coords 1] + 10) * $zoom}]
set newtext [.c create text $x $y -justify center -fill black \
-text "$kbps_str kbps" -tags "$node rangecircles"]
}
}; # end foreach wireless node
}
# 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 }
# 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]
# downstream FwdOctets
set down_bytes [lindex [split $down "="] 1]
# upstream FwdOctets
set up_bytes [lindex [split $up "="] 1]
if { $down_bytes == "" } { set down_bytes 0 }
if { $up_bytes == "" } { set up_bytes 0 }
return [list $down_bytes $up_bytes]
}
proc getstats_link_ifname { link } {
global g_current_session
set lnode1 [lindex [linkPeers $link] 0]
set lnode2 [lindex [linkPeers $link] 1]
# choose the interface name
set node_num -1
if { [[typemodel $lnode1].layer] == "NETWORK" } {
set node_num [string range $lnode1 1 end]
set ifname [ifcByPeer $lnode1 $lnode2]
} elseif { [[typemodel $lnode2].layer] == "NETWORK" } {
set node_num [string range $lnode2 1 end]
set ifname [ifcByPeer $lnode2 $lnode1]
}
if { $node_num < 0 } { return "" }
set ssid [shortSessionID $g_current_session]
set hex [format "%x" $node_num]
set ifnum [string range $ifname 3 end]
set ifname "veth$hex.$ifnum.$ssid"
return $ifname
}
# helper to convert /proc/net/dev stats into upstream/downstream bytes
proc getstats_bytes_proc { raw_input ifname } {
set ifname_len [string length $ifname]
foreach statline $raw_input {
# when ifname ends with '*' treat it as a regular expression
if { [string index $ifname end] == "*" } {
set statifname [lindex [split $statline ":"] 0]
if { [regexp $ifname $statifname] } {
break
}
# match the ifname exactly
} elseif { [string range $statline 0 $ifname_len] == "$ifname:" } {
break
}
set statline ""
}
# statline looks like: "veth1004.1:134998400 101150 0 ..."
# store the numbers into stats
set statline [split $statline ":"]
set stats [lindex $statline 1]
set down_bytes [lindex $stats 0]
set up_bytes [lindex $stats 8]
if { $down_bytes == "" } { set down_bytes 0 }
if { $up_bytes == "" } { set up_bytes 0 }
return [list $down_bytes $up_bytes]
}
# Node movement for throughput widget
proc widget_thru_move { c node done } {
#$c delete -withtag "$node && rangecircles"
}
# Create a new throughput plot.
proc thruPlot { c link x y height width isresize} {
global widgets enable_Throughput thruPlotColor curPlotBgColor
global plot_list
# 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
set g "$c.${link}thruplot"
}
# update plot_list
# Plot info to be stored :
# - canvas coords
# - 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}
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"
# 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"
lappend ${link}thruplot "color blue"
} else {
set scheme [dict get $thruPlotColor $g]
thruPlotSetScheme $scheme
lappend ${link}thruplot "color $scheme"
}
# add plot to global plot_list
if {[lsearch $plot_list ${link}thruplot] eq -1} {
lappend plot_list ${link}thruplot
}
# set global
global $g
# if resize, we need to delete old instances of thruplot in canvas
if { ([winfo exists $g] && $isresize == false) || $isresize == true} {
$c delete $g
destroy $g # TODO: support multiple plots for the same link
}
canvas $g -height $height -width $width -bg $curPlotBgColor
$c create window $x $y -window $g -tags "thruplot $g"
# set link interface title
set lnode1 [lindex [linkPeers $link] 0]
set lnode2 [lindex [linkPeers $link] 1]
set if1 [ifcByPeer $lnode1 $lnode2]
set if2 [ifcByPeer $lnode2 $lnode1]
# 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"
#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
thruPlotDrawScale $g 10.0
set w "Throughput"
if { ![set enable_$w] } {
set enable_$w 1 ;# turn on the Throughput Widget
[lindex $widgets($w) 1] menu
}
}
# Right click menu from thruplot
proc thruPlotPopup {g xclick yclick } {
# find coord of top left corner of thruplot
global .button3menu
global plot_list
.button3menu 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
.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 .]
tk_popup .button3menu $x $y
}
# remove thruplot
proc deletePlot { g } {
global plot_list
regexp {.c.(.*thruplot)} $g match plotname
set idx [lsearch $plot_list $plotname]
.c delete $g
destroy $g
set plot_list [lreplace $plot_list $idx $idx]
}
# 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]
# check if resizeMode
if {$cursorMode != "left_ptr" && $cursorMode != "crosshair"} {
global oldX1 oldY1 oldX2 oldY2
# save old top left and bottom right points
set bbox [$c bbox $g]
set oldX1 [lindex $bbox 0]
set oldY1 [lindex $bbox 1]
set oldX2 [lindex $bbox 2]
set oldY2 [lindex $bbox 3]
# set resizeobj and resize mode
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
}
}
# 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
set cursorMode [$c cget -cursor]
# 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
}
}
proc thruPlotHandleRelease { c g x y what} {
global thruplotResize thruPlotDragStart
# Only drag if not in resize mode
if {$thruplotResize == false} {
set thruPlotDragStart false
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
# resize based on resize mode
switch $resizemode {
ld {
# 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
}
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
}
rd {
# 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
}
lu {
# if the left bottom corner clicked
lassign [calcDimensions [expr {$oldX1 + $x}] [expr {$oldY1 + $y}] $oldX2 $oldY2] cx cy h w
thruPlot $c $g $cx $cy $h $w true
}
r {
# if the right side clicked
lassign [calcDimensions $oldX1 $oldY1 [expr {$oldX1 + $x}] $oldY2] cx cy h w
thruPlot $c $g $cx $cy $h $w true
}
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
}
u {
# 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
}
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
}
default {
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
}
# Calculate center, height, width based on top left and bot right corners
proc calcDimensions { x1 y1 x2 y2 } {
set h [expr {$y2 - $y1}]
set w [expr {$x2 - $x1}]
# enforce min size
if {$h < 100} {
set h 100
}
if {$w < 100} {
set w 100
}
list [expr {$x1 + ($w/2)}] [expr {$y1 + ($h/2)}] $h $w
}
# Mouse drag a throughput plot.
proc thruPlotDrag { c g x y what fromCanvas} {
global thruPlotDragStart thruPlotCur
global plot_list
set pad 60
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
}
if {$thruPlotDragStart == false} {
if { [expr abs($x)] > $maxjump || [expr abs($y)] > $maxjump} {
puts "ERROR can not drag too far at one time"
return
}
} else {
set curx [lindex [$c coords $g] 0]
set cury [lindex [$c coords $g] 1]
# perform the actual drag
set newx [expr {$x - $pad + $curx}]
set newy [expr {$y- $pad + $cury}]
$c coords $thruPlotCur $newx $newy
# save new coords DYL
regexp {.c.(l.*thruplot)} $g match name
# global ${name}
# find and replace x coord
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 :
# 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 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
}
}
# 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
set i [lsearch [set ${plot}] "$attr *"]
# puts " found at $i"
if { $i >= 0 } {
set ${plot} [lreplace [set ${plot}] $i $i "$attr $val"]
} else {
set ${plot} [linsert [set ${plot}] end "$attr $val"]
}
}
# this will return an attribute from the plotlist
proc getPlotAttr {plot attr} {
global ${plot}
return [lindex [lsearch -inline [set $plot] "$attr *"] 1]
}
# plot TODO:
# pause plot
# scroll back plot history
# save/log plot data to file
# up/down throughput
# Change thruplot color
proc setThruPlotColor { g color} {
global curPlotLineColor curPlotFillColor curPlotBgColor thruPlotColor
# update dictionary update global var
dict set thruPlotColor $g $color
regexp {.c.(.*thruplot)} $g match plotname
updatePlotAttr $plotname color $color
# set global variables that determine color scheme
thruPlotSetScheme $color
# update old data
$g itemconfigure "filler" -fill $curPlotFillColor
$g itemconfigure "line" -fill $curPlotLineColor
$g configure -bg $curPlotBgColor
}
# Set global vars colorscheme for thruplot
proc thruPlotSetScheme { color } {
global curPlotLineColor curPlotFillColor curPlotBgColor
switch $color {
blue {
set curPlotLineColor blue
set curPlotFillColor "#7f9eee"
set curPlotBgColor "#EEEEFF"
}
red {
set curPlotLineColor red
set curPlotFillColor "#ee7e9e"
set curPlotBgColor "#ffeeee"
}
green {
set curPlotLineColor green
set curPlotFillColor "#9eee7e"
set curPlotBgColor "#eeffee"
}
default {
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
# Check if window exists
if { ![winfo exists $g] } {
return
}
# lookup scheme for thruplot and set scheme
set scheme [dict get $thruPlotColor $g]
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]
# 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"]
set x1 [expr {$maxx - $dt}]
set x2 $maxx ;# right side
if { $last == "" } {
set y1 $maxy
} else {
set y1 [lindex [$g coords $last] end]
$g dtag $last "last"
}
set y2 [thruValtoY $kbps $yscale $maxy]
$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
}
# return the existing y-value scale; if the given value is off the scale,
# increase the scale and auto-adjust all data items
proc thruPlotAutoScale { g val } {
set yscale [lindex [$g itemcget "ticks && scalemax" -text] 0]
global thruPlotMaxKBPS
# update global max
if { $val > $thruPlotMaxKBPS} {
set thruPlotMaxKBPS $val
} else {
set val $thruPlotMaxKBPS
}
# 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}]
thruPlotDrawScale $g $newyscale
# adjust all data items
foreach item [$g find withtag "data"] {
set coords [$g coords $item]
# only change lines (2 x,y pairs) and polygons (4 x,y pairs)
if {[llength $coords] != 4 && [llength $coords] != 8} { continue }
# adjust all y coordinates to the new scale
for { set i 1 } { $i < [llength $coords] } { incr i 2 } {
set val [thruYtoVal [lindex $coords $i] $yscale $maxy]
set coords [lreplace $coords $i $i \
[thruValtoY $val $newyscale $maxy]]
}
$g coords $item $coords
}
return $newyscale
}
# this is experimental -- support for plot zooming in/out
proc testscale {scale} {
set maxy [.c.l1thruplot cget -height];
set yscale [lindex [.c.l1thruplot itemcget "ticks && scalemax" -text] 0];
set newyscale $scale;
foreach item [.c.l1thruplot find withtag "data"] {
set coords [.c.l1thruplot coords $item];
# only change lines (2 x,y pairs) and polygons (4 x,y pairs)
if {[llength $coords] != 4 && [llength $coords] != 8} { continue; }
# adjust all y coordinates to the new scale
for { set i 1 } { $i < [llength $coords] } { incr i 2 } {
set val [thruYtoVal [lindex $coords $i] $yscale $maxy];
set coords [lreplace $coords $i $i \
[thruValtoY $val $newyscale $maxy]];
}
.c.l1thruplot coords $item $coords;
}
}
# convert a value to Y value given the scale and max Y
proc thruValtoY { val yscale maxy } {
#return [expr {$maxy - (($val * $yscale)/$maxy)}]
return [expr {$maxy - ($val * ($maxy / $yscale))}]
}
# convert a Y value to value given the scale and max Y
proc thruYtoVal { y yscale maxy } {
#return [expr {$maxy + ($val / $yscale)}]
return [expr {($maxy - $y) / ($maxy / $yscale)}]
}
# draw graph tick marks and max y value to show the graph scale
proc thruPlotDrawScale { g max } {
set color #aaaaaa ;# gray
set ticks 3
set maxx [$g cget -width]
set maxy [$g cget -height]
set dy [expr {[$g cget -height] / $ticks}]
$g delete withtag "ticks"
for {set i 0} {$i < $ticks} {incr i} {
set y [expr {1 + ($i * $dy)}]
$g create line 0 $y 5 $y -width 1 -fill $color -tags "ticks"
$g create line [expr {$maxx-5}] $y $maxx $y -width 1 \
-fill $color -tags "ticks"
}
$g create text 35 10 -text "$max kbps" -fill $color -tags "ticks scalemax"
}
# delete data items that have scrolled off the canvas
# is there a better way to do this?
proc thruPlotDeleteOldData { g dt } {
foreach i [$g find withtag "data"] {
if { [lindex [$g coords $i] 0] < [expr { -2.0 * $dt }] } {
$g delete $i
}
}
}
################################################################################
##### #####
##### CPU Widget #####
##### #####
################################################################################
array set cpuConfig { show 1 loc lr thresh 75.0 radius 30 color #FFFF00 }
#
# CPU widget config dialog
#
proc widget_cpu_config {} {
set wi .cpu_config
catch {destroy $wi}
toplevel $wi
wm transient $wi .
wm resizable $wi 0 0
wm title $wi "CPU config"
global cpuConfig
# Show CPU
labelframe $wi.disp -text "CPU Display Options"
frame $wi.disp.tlab -borderwidth 4
checkbutton $wi.disp.tlab.show_cpu \
-text "Show CPU usage label on every node" -variable cpuConfig(show)
pack $wi.disp.tlab.show_cpu -side right -padx 4 -pady 4
pack $wi.disp.tlab -side top
frame $wi.disp.loc -borderwidth 4
label $wi.disp.loc.lab -text "Location of CPU label:"
radiobutton $wi.disp.loc.a -text "upper-left" -variable cpuConfig(loc) \
-value ul
radiobutton $wi.disp.loc.b -text "upper-right" -variable cpuConfig(loc) \
-value ur
radiobutton $wi.disp.loc.c -text "lower-left" -variable cpuConfig(loc) \
-value ll
radiobutton $wi.disp.loc.d -text "lower-right" -variable cpuConfig(loc) \
-value lr
pack $wi.disp.loc.lab -side top
pack $wi.disp.loc.a $wi.disp.loc.b -side left -anchor n
pack $wi.disp.loc.c $wi.disp.loc.d -side left -anchor s
pack $wi.disp.loc -side top
pack $wi.disp -side top -fill x
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
frame $wi.hi.t
label $wi.hi.t.lab1 -text "threshold (0 for disabled):"
entry $wi.hi.t.thresh -bg white -width 8 -textvariable cpuConfig(thresh)
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:"
spinbox $wi.hi.w.width -bg white -width 8 -textvariable cpuConfig(radius) \
-from 1 -to 150 -increment 5
pack $wi.hi.w.width $wi.hi.w.lab3 -side right -padx 4 -pady 4
label $wi.hi.w.lab1 -text "Highlight color:"
set color $cpuConfig(color)
label $wi.hi.w.color -fg black -bg $color -text $color
button $wi.hi.w.colbtn -text "Color..." -command \
"popupColor bg $wi.hi.w.color true"
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
frame $wi.butt -borderwidth 6
button $wi.butt.apply -text "OK" -command "widget_cpu_config_apply $wi"
pack $wi.butt.apply -side right
pack $wi.butt -side bottom
bind $wi <Key-Escape> "destroy $wi"
bind $wi <Key-Return> "destroy $wi"
after 100 {
catch { grab .cpu_config }
}
}
proc widget_cpu_config_apply { wi } {
# this is needed because label textvariable won't update
global cpuConfig
set cpuConfig(color) [$wi.hi.w.color cget -bg]
destroy $wi
}
#
# CPU widget de/initialization
#
proc widget_cpu_init {command} {
global enable_CPU systype g_execRequests
array set g_execRequests { cpu "" }
# Initialize
if { $enable_CPU } {
}
# De-initialize
if { !$enable_CPU || $command == "stop" } {
.c delete -withtag "cpulabel || cpuhi"
}
}
#
# CPU widget periodic procedure
#
proc widget_cpu_periodic { now } {
global systype
puts "warning: the CPU widget is not functional for this platform yet"
return
}
proc widget_cpu_periodic_vimage { now } {
global eid node_list cpuConfig zoom
# TODO: collect from all exec hosts
set vimageout [nexec localnode vimage -l]
array set cpustats [getstats_cpu_vimage $vimageout]
foreach node $node_list {
# this skips all nodes that are not vimages
if { ![info exists cpustats($eid\_$node)] } { continue }
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 existing [.c find withtag "cpulabel && $node"]
if { [llength $existing] == 0 } { ;# create new label
set cpulabel [.c create text $x $y -text $newtext \
-tags "cpulabel && $node"]
} else { ;# use existing label
set cpulabel [lindex $existing 0]
.c itemconfigure $cpulabel -text $newtext
}
.c raise $cpulabel
# perform highlighting
set existing [.c find withtag "cpuhi && $node"]
if { $cpustats($eid\_$node) >= $cpuConfig(thresh) } {
if { [llength $existing] == 0 } {
set color $cpuConfig(color)
set rad $cpuConfig(radius)
set cpuhi [.c create oval [expr {$basex - $rad}] \
[expr {$basey - $rad}] [expr {$basex + $rad}] \
[expr {$basey + $rad}] -fill $color -outline $color \
-tag "cpuhi $node" ]
.c raise $cpulabel
#.c raise "link && $node"
.c raise "node && $node"
}
} elseif { [llength $existing] > 0 } {
.c delete $existing
}
.c raise floatinfo;# fix observer widget raise order
}
}
# helper to return x,y of CPU label based on config
proc getCPUcoords { node } {
global cpuConfig zoom
set coords [getNodeCoords $node]
set basex [lindex $coords 0]
set basey [lindex $coords 1]
switch -exact $cpuConfig(loc) {
ul { set xoff -25; set yoff -25 }
ur { set xoff 25; set yoff -25 }
ll { set xoff -25; set yoff 25 }
lr { set xoff 25; set yoff 25 }
}
set x [expr { ([lindex $coords 0] + $xoff) * $zoom }]
set y [expr { ([lindex $coords 1] + $yoff) * $zoom }]
return [list $x $y $basex $basey]
}
# helper to convert `vimage -l` output to node_name/cpu list
proc getstats_cpu_vimage { raw_input} {
set tmp [split $raw_input "\n"]
set numlines [llength $tmp]
if { $numlines <= 4 } {
return [list 0 0]
}
# add node_name/cpu to a list
set ret {}
set i 0
set node_name ""
while { $numlines > 0 } {
set line [lindex $tmp $i]
incr i
if { $node_name == "" } {
if { [string range $line 0 3] != " " } {
set node_name [lindex [split $line \"] 1]
lappend ret $node_name
}
} elseif { [string range $line 0 6] == " CPU" } {
set cpu [lindex [split $line :] 1]
set cpu [string trim $cpu " %"]
lappend ret $cpu
set node_name ""
}
incr numlines -1
}
return $ret
}
# helper to convert /proc/vz/vestat output to node_name/cpu list
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
if { [catch {set f [open "/proc/vz/vestat" r]} e] } {
puts "error opening /proc/vz/vestat: $e"
return
}
set vestat [read $f]
close $f
set lines [split $vestat "\n"]
if { [llength $lines] <= 2 } {
return [list 0 0]
}
# read /proc/uptime
if { [catch {set f [open "/proc/uptime" r]} e] } {
puts "error opening /proc/uptime: $e"
return
}
set uptime [read $f]
close $f
set uptime_now [lindex $uptime 1]
if { ![info exists cpu_vestat_history(uptime)] } {
set uptime_old $uptime_now
} else {
set uptime_old $cpu_vestat_history(uptime)
}
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 } {
set line [lindex $lines $i]
set node_num [lindex $line 0]
# skip text lines
if { $node_num == "" } { continue }
if { ![string is integer $node_num] } { continue }
set user [lindex $line 1]
set nice [lindex $line 2]
set system [lindex $line 3]
set jiffies_now [expr {$user+$nice+$system}]
if { ![info exists cpu_vestat_history($node_num)] } {
set jiffies_old $jiffies_now
} else {
set jiffies_old $cpu_vestat_history($node_num)
}
array set cpu_vestat_history [list $node_num $jiffies_now]
# s = j / hz
set cpu [expr { ($jiffies_now - $jiffies_old) / ($Hertz * $elapsed) }]
#puts "num=$node_num user=$user nice=$nice sys=$system cpu=$cpu"
lappend ret $node_num
lappend ret $cpu
}
return $ret
}
# Node movement for CPU widget
proc widget_cpu_move { c node done } {
$c delete -withtag "cpulabel && $node"
$c delete -withtag "cpuhi && $node"
}
################################################################################
##### #####
##### Adjaceny Widget #####
##### #####
################################################################################
array set adjacency_config { proto "ipv6 ospf6" offset 1 colors \
{ Down black Init yellow Twoway green \
ExChan red Loadin orange Full blue \
default gray } }
array set adjacency_cache { }
#
# Adjacency widget config dialog
#
proc widget_adjacency_config {} {
set wi .adj_config
catch {destroy $wi}
toplevel $wi
wm transient $wi .
wm resizable $wi 0 0
wm title $wi "Adjacency config"
global adjacency_config
labelframe $wi.po -text "Protocol options"
frame $wi.po.p -borderwidth 4
label $wi.po.p.help -text "Show adjacencies for:"
radiobutton $wi.po.p.pr -text "OSPFv2" -variable adjacency_config(proto) \
-value "ip ospf" -command ".c delete -withtags adjline"
radiobutton $wi.po.p.pr2 -text "OSPFv3" -variable adjacency_config(proto) \
-value "ipv6 ospf6" -command ".c delete -withtags adjline"
pack $wi.po.p.help -side top
pack $wi.po.p.pr $wi.po.p.pr2 -side left -padx 4 -pady 4
pack $wi.po.p $wi.po -side top -fill x
labelframe $wi.do -text "Display options"
frame $wi.do.d
checkbutton $wi.do.d.offset -text "slightly offset adjaency lines" \
-variable adjacency_config(offset) \
-command ".c delete -withtags adjline"
pack $wi.do.d.offset -side left
pack $wi.do.d -side top -fill x
# configurable state colors
frame $wi.do.c
array set colors $adjacency_config(colors)
foreach adj [lsort -dictionary [array names colors]] {
frame $wi.do.c.c$adj
label $wi.do.c.c$adj.lab -text "$adj"
set color $colors($adj)
label $wi.do.c.c$adj.col -fg black -bg $color -text $color
pack $wi.do.c.c$adj.lab $wi.do.c.c$adj.col -side left -fill x
pack $wi.do.c.c$adj -side top -anchor w
bind $wi.do.c.c$adj.col \
<Button-1> "popupColor bg $wi.do.c.c$adj.col true"
}
pack $wi.do.c -side top
pack $wi.do -side top -fill x
# OK button at bottom
frame $wi.butt -borderwidth 6
button $wi.butt.apply -text "OK" \
-command "widget_adjacency_config_apply $wi"
pack $wi.butt.apply -side right
pack $wi.butt -side bottom
bind $wi <Key-Escape> "destroy $wi"
bind $wi <Key-Return> "destroy $wi"
after 100 {
catch { grab .cpu_config }
}
}
proc widget_adjacency_config_apply { wi } {
global adjacency_config
set changed 0
array set colors $adjacency_config(colors)
foreach adj [array names colors] {
set color $colors($adj)
set newcolor [$wi.do.c.c$adj.col cget -text]
if { $color != $newcolor } {
array set colors [list $adj $newcolor]
set changed 1
}
}
if { $changed } {
set adjacency_config(colors) [array get colors]
.c delete -withtags "adjline"
}
destroy $wi
}
proc get_router_id {node} {
global oper_mode vtysh
# search custom-config
if { [getCustomEnabled $node] == true } {
set rid_string [regexp -inline \
{router-id [0-9]+\.[0-9]+\.[0-9]+\.[0-9]+} \
[getCustomConfig $node]]
if {[string range $rid_string 1 9] == "router-id" } {
return [string range $rid_string 11 end-1]
}
}
# search network config
# search OSPFv3 config for router ID
foreach line [netconfFetchSection $node "router ospf6"] {
if {[string range $line 0 9] == " router-id"} {
return [string range $line 11 end]
}
}
# search OSPFv2 config for router ID
foreach line [netconfFetchSection $node "router ospf"] {
if {[string range $line 0 9] == " router-id"} {
return [string range $line 11 end]
}
}
if {[lsearch [getNodeServices $node true] "OLSR"] != -1 } {
set sock [lindex [getEmulPlugin $node] 2]
set exec_num [newExecCallbackRequest adjacencyrouterid]
set name [getNodeName $node]
set cmd "nrlConsole.py ${name}_olsr i"
sendExecMessage $sock $node $cmd $exec_num 0x30
return ""
} elseif {[lsearch [getNodeServices $node true] "OLSRv2"] != -1 } {
set sock [lindex [getEmulPlugin $node] 2]
set exec_num [newExecCallbackRequest adjacencyrouterid]
set name [getNodeName $node]
set cmd "nrlConsole.py ${name}_olsrv2 i"
sendExecMessage $sock $node $cmd $exec_num 0x30
return ""
}
if { $oper_mode != "exec" } { return }
# use exec message here for retrieving router ID
set sock [lindex [getEmulPlugin $node] 2]
set exec_num [newExecCallbackRequest adjacencyrouterid]
set cmd "$vtysh -c 'show ipv6 ospf6'"
sendExecMessage $sock $node $cmd $exec_num 0x30
set exec_num [newExecCallbackRequest adjacencyrouterid]
set cmd "$vtysh -c 'show ip ospf'"
sendExecMessage $sock $node $cmd $exec_num 0x30
return ""
}
#
# Adjacency widget de/initialization
#
proc widget_adjacency_init {command} {
global enable_Adjacency enable_Adjacency_OSPFv2 enable_Adjacency_OSPFv3 enable_Adjacency_OLSR enable_Adjacency_OLSRv2
global node_list adjacency_cache adjacency_config adjacency_lock
global g_execRequests
set c .c
set adjacency_lock 0
array set g_execRequests [list adjacency ""]
# Menu item selected on/off
if { $command == "menu2" || $command == "menu3" || $command == "menu4" || $command == "menu5" } {
# set global enable flag for v2/v3 adjacency display
set enable_Adjacency \
[expr {$enable_Adjacency_OSPFv2 | $enable_Adjacency_OSPFv3 | $enable_Adjacency_OLSR | $enable_Adjacency_OLSRv2}]
# toggle other OSPFv2/v3 menu items off
if { $command == "menu2" && $enable_Adjacency_OSPFv2 } {
set enable_Adjacency_OSPFv3 0
set enable_Adjacency_OLSR 0
set enable_Adjacency_OLSRv2 0
set adjacency_config(proto) "ip ospf"
} elseif { $command == "menu3" && $enable_Adjacency_OSPFv3 } {
set enable_Adjacency_OSPFv2 0
set enable_Adjacency_OLSR 0
set enable_Adjacency_OLSRv2 0
set adjacency_config(proto) "ipv6 ospf6"
} elseif { $command == "menu4" && $enable_Adjacency_OLSR } {
set enable_Adjacency_OSPFv2 0
set enable_Adjacency_OSPFv3 0
set enable_Adjacency_OLSRv2 0
set adjacency_config(proto) "OLSR_proto"
} elseif { $command == "menu5" && $enable_Adjacency_OLSRv2 } {
set enable_Adjacency_OSPFv2 0
set enable_Adjacency_OSPFv3 0
set enable_Adjacency_OLSR 0
set adjacency_config(proto) "OLSRv2_proto"
}
}
# Initialize
if { $enable_Adjacency && $command != "stop" } {
array unset adjacency_cache *
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] "OLSRv2"] < 0} {
continue
}
set rtrid [get_router_id $node]
if {$rtrid != ""} {
array set adjacency_cache [list $rtrid $node]
}
} ;# end foreach node
}
# De-initialize
if { !$enable_Adjacency || $command == "stop" } {
set enable_Adjacency 0
set enable_Adjacency_OSPFv2 0
set enable_Adjacency_OSPFv3 0
set enable_Adjacency_OLSR 0
set enable_Adjacency_OLSRv2 0
$c delete -withtags "adjline"
after 200 { .c delete -withtags "adjline" }
}
}
#
# Adjacency widget periodic procedure
#
proc widget_adjacency_periodic { now } {
global node_list adjacency_config adjacency_cache adjacency_lock
global enable_Adjacency curcanvas vtysh
set changed 0
set proto $adjacency_config(proto)
if { $proto == "OLSR_proto" } {
foreach node $node_list {
if { [nodeType $node] != "router" } { continue }
if { [getNodeCanvas $node] != $curcanvas } { continue }
if {[lsearch [getNodeServices $node true] "OLSR"] < 0} {
continue
}
if { $adjacency_lock == $node } { continue }
# when using daemon, send Execute Message and draw line using
# widget_adjacency_callback after the response has been received
set sock [lindex [getEmulPlugin $node] 2]
set exec_num [newExecCallbackRequest adjacency]
set name [getNodeName $node]
set cmd "nrlConsole.py ${name}_olsr n"
sendExecMessage $sock $node $cmd $exec_num 0x30
}
} elseif { $proto == "OLSRv2_proto" } {
foreach node $node_list {
if { [nodeType $node] != "router" } { continue }
if { [getNodeCanvas $node] != $curcanvas } { continue }
if {[lsearch [getNodeServices $node true] "OLSRv2"] < 0} {
continue
}
if { $adjacency_lock == $node } { continue }
# when using daemon, send Execute Message and draw line using
# widget_adjacency_callback after the response has been received
set sock [lindex [getEmulPlugin $node] 2]
set exec_num [newExecCallbackRequest adjacency]
set name [getNodeName $node]
set cmd "nrlConsole.py ${name}_olsrv2 n"
sendExecMessage $sock $node $cmd $exec_num 0x30
}
} else {
foreach node $node_list {
if { [nodeType $node] != "router" } { continue }
if { [getNodeCanvas $node] != $curcanvas } { continue }
if {[lsearch [getNodeServices $node true] "zebra"] < 0} {
continue
}
if { $adjacency_lock == $node } { continue }
# when using daemon, send Execute Message and draw line using
# widget_adjacency_callback after the response has been received
set sock [lindex [getEmulPlugin $node] 2]
set exec_num [newExecCallbackRequest adjacency]
set cmd "$vtysh -c 'show $proto neighbor'"
sendExecMessage $sock $node $cmd $exec_num 0x30
}
}
}
# Execute Message callback
proc exec_adjacency_callback { node execnum cmd result status } {
global eid node_list adjacency_config adjacency_cache adjacency_lock
global enable_Adjacency
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
set adjs [getadj_from_neighbors $result $proto]
foreach adj $adjs {
set peer [lindex $adj 0]
set line [$c find withtag "adjline && $node && $peer"]
if { ![info exists adjacency_cache($peer)] } {
puts "adjacency: node $node skipping $peer"; continue;
}
# change color of the line based on adjacency state
set adjstate [lindex $adj 1]
if { ![info exists colors($adjstate)] } {
set color $colors(default)
} else {
set color $colors($adjstate)
}
if { $line == "" } {; # draw a half line if none
set coords [getNodeCoords $node]
set node2 $adjacency_cache($peer)
if { $adjacency_lock == $node2 } { continue }
set coords2 [getNodeCoords $node2]
set x [lindex $coords 0]; set y [lindex $coords 1]
set x2 [lindex $coords2 0]; set y2 [lindex $coords2 1]
# these tags are later used in widget_adjacency_move()
set a [$c create line $x $y [expr {$o + $x + (($x2 - $x)/2) }] \
[expr {$o + $y + (($y2 - $y)/2) }] \
-fill $color -width 3 \
-tags "adjline $node $peer peer_$node2"]
$c lower $a "node && $node"
} else {; # update existing half line
$c itemconfigure $line -fill $color ;# update the color
$c dtag $line "adjdelete" ;# don't delete this adjline
$c lower $line "node && $node"
}
}
$c delete -withtags "adjdelete && $node" ;# delete stale adjlines
}
# Execute Message callback for getting the router ID
proc exec_adjacencyrouterid_callback { node execnum cmd result status } {
global adjacency_cache
#check if olsr or olsrv2 are running
if {[lsearch [getNodeServices $node true] "OLSR"] != -1 ||
[lsearch [getNodeServices $node true] "OLSRv2"] != -1 } {
set lines [split $result "\n"]
set rtrid [lindex $lines 1]
array set adjacency_cache [list $rtrid $node]
} else {
# match both OSPFv2 and OSPFv3 responses
set rid [regexp -inline {Router[- ]ID[:]? [0-9]+\.[0-9]+\.[0-9]+\.[0-9]+} \
$result]
if {$rid != ""} {
set rtrid [eval lindex $rid end]
array set adjacency_cache [list $rtrid $node]
}
}
}
# helper to convert neighbor list into adjacencies list
proc getadj_from_neighbors { raw_input proto } {
set ret { }
#OLSR conversions
if { $proto == "OLSRv2_proto" || $proto == "OLSR_proto"} {
foreach line [split $raw_input "\n"] {
if { $line == "neighbors" } { continue }
if { $line == "end-neighbors" } { continue }
if { $line == "" } { continue }
set fields [split $line " "]
lassign $fields rtrid state metric mpr
# convert to OSPFv3 to simplify coloring
switch -exact -- "$state" {
"SYM" { set state "Full" }
"ASYM" { set state "Init" }
"LOST" { set state "Down" }
"MPR" { set state "Full" }
"PENDING" { set state "Init" }
"INVALID" { set state "Down" }
}
lappend ret [list $rtrid $state]
}
return $ret
}
#OSPF converstion
#Neighbor ID Pri DeadTime State/IfState Duration I/F[State]
#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
foreach line [split $raw_input "\n"] {
set rtrid [string trim [string range $line 0 14]]
if { $rtrid == "Neighbor ID" } { continue }
set parts [split $rtrid .]
if {[llength $parts] != 4} { continue }; # not in A.B.C.D format!
if { $proto == "ipv6 ospf6" } { ;# string offsets depend on protocol
set state [string trim [string range $line 32 37 ]]
} else { ;# ipv4
set state [string trim [string range $line 19 23 ]]
# convert some OSPFv2 states to OSPFv3 to simplify coloring
switch -exact -- "$state" {
"Dele" { set state "Down" }
"Atte" { set state "Init" }
"2-Wa" { set state "Twoway" }
"ExSt" { set state "ExChan" }
"Exch" { set state "ExChan" }
"Load" { set state "Loadin" }
}
}
lappend ret [list $rtrid $state]
}
return $ret
}
# Node movement for adjacency widget
proc widget_adjacency_move { c node done } {
global adjacency_lock adjacency_config adjacency_cache
set c .c
if { $adjacency_config(offset) } { set o 5 } else { set o 0 }
set adjacency_lock $node
foreach line [$c find withtag "adjline && $node"] {
set n1 [lindex [$c gettags $line] 1]
set peer [lindex [$c gettags $line] 2]
if { ![info exists adjacency_cache($peer)] } { continue }
set n2 $adjacency_cache($peer) ;# convert peer router ID to node
set coords [getNodeCoords $n1]
set coords2 [getNodeCoords $n2]
set x [lindex $coords 0]; set y [lindex $coords 1]
set x2 [lindex $coords2 0]; set y2 [lindex $coords2 1]
$c coords $line $x $y [expr {$o + $x + (($x2 - $x)/2) }] \
[expr {$o + $y + (($y2 - $y)/2) }]
$c lower $line "node && $n1"
# move any half line coming from peer to this moved node
foreach peerline [$c find withtag "adjline && $n2 && peer_$n1"] {
set peer2 [lindex [$c gettags $peerline] 1]
$c coords $peerline $x2 $y2 \
[expr {$o + $x2 + (($x - $x2)/2) }] \
[expr {$o + $y2 + (($y - $y2)/2) }]
$c lower $peerline "node && $n2"
}
} ;# end foreach line
if { $done } { set adjacency_lock 0 }
}
#
# Build Adjacency Widget menu items
#
proc widget_adjacency_init_submenu { m } {
global widgets
menu $m.adj -tearoff 1
$m add cascade -label "Adjacency" -menu $m.adj
set w "Adjacency"
# foreach v [list 2 3] {
# global enable_${w}_v${v}
# set enable_${w}_v${v} 0
# $m.adj add checkbutton -label "OSPFv$v" -variable enable_${w}_v${v} \
# -command "[lindex $widgets($w) 1] menu$v"
# }
global enable_Adjacency_OSPFv2
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 \
-command "[lindex $widgets(Adjacency) 1] menu5"
}
# load the widgets.conf file when this file is loaded
loadWidgetsConf