#
# Support for managing CORE plugins from the GUI.
#
# possible types of plugins, indicating messaging type
array set g_plugin_types {
0 "none"
1 "CORE API"
}
array set g_plugin_status_types {
0 "disconnected"
1 "connected"
}
# array index is "name"
# 0ip 1port 2type 3auto 4status 5capabilities 6sock
# 127.0.0.1 4038 1 0 1 (reglist) -1
array set g_plugins_default {
{"GUI"}
{ 0 0 1 0 1 "gui=core" -1 }
{"core-daemon"}
{ 127.0.0.1 4038 1 1 0 "emul=core-daemon" -1 }
}
array set g_plugins {
{"GUI"}
{ 0 0 1 0 1 "gui=core" -1 }
}
# TODO: move all shared image resources to a centralized place
if { $execMode == "interactive" } {
set iconpath "$CORE_DATA_DIR/icons/tiny"
set plugin_img_add [image create photo -file "$iconpath/document-new.gif"]
set plugin_img_edit [image create photo \
-file "$iconpath/document-properties.gif"]
set plugin_img_save [image create photo -file "$iconpath/document-save.gif"]
set plugin_img_open [image create photo -file "$iconpath/fileopen.gif"]
set plugin_img_del [image create photo -file "$iconpath/edit-delete.gif"]
set plugin_img_conn [image create photo -file "$iconpath/stock_connect.gif"]
set plugin_img_disc [image create photo -file "$iconpath/stock_disconnect.gif"]
set plugin_img_refr [image create photo -file "$iconpath/view-refresh.gif"]
set plugin_img_folder [image create photo -file "$iconpath/folder.gif"]
}
array set g_plugin_button_tooltips {
add "add a new plugin"
edit "edit the selected plugin"
del "remove the selected plugin"
conn "connect to this plugin"
disc "disconnect from this plugin"
refr "refresh plugin data"
}
###############################################################################
# Plugins and Capabilities GUI functions #
###############################################################################
#
# Configure remote plugins. Popup a dialog box for editing the remote plugin
# list; results are stored in plugins.conf file.
#
proc popupPluginsConfig {} {
global g_plugins g_plugin_types g_plugin_button_tooltips
set wi .pluginConfig
catch {destroy $wi}
toplevel $wi
wm transient $wi .
wm resizable $wi 0 1
wm title $wi "CORE Plugins"
# list of plugins
labelframe $wi.s -borderwidth 0 -text "Plugins"
listbox $wi.s.plugins -selectmode single -height 5 -width 50 \
-yscrollcommand "$wi.s.plugins_scroll set" -exportselection 0
scrollbar $wi.s.plugins_scroll -command "$wi.s.plugins yview"
pack $wi.s.plugins $wi.s.plugins_scroll -fill y -side left
pack $wi.s -padx 4 -pady 4 -fill both -side top -expand true
# image button bar
frame $wi.bbar
set buttons "add edit del conn refr"
foreach b $buttons {
global plugin_img_$b
button $wi.bbar.$b -image [set plugin_img_$b]
pack $wi.bbar.$b -side left
balloon $wi.bbar.$b $g_plugin_button_tooltips($b)
}
pack $wi.bbar -padx 4 -pady 4 -fill x -side top
$wi.bbar.add configure -command "popupPluginsConfigEdit $wi new"
$wi.bbar.edit configure -command "popupPluginsConfigEdit $wi edit"
$wi.bbar.del configure -command "pluginsConfigDelete $wi"
$wi.bbar.conn configure -command "pluginsConfigConnect $wi"
$wi.bbar.refr configure -command "pluginsConfigRefresh $wi"
# plugin information
labelframe $wi.si -borderwidth 0 -text "Plugin information"
entry $wi.si.info -width 50
pack $wi.si.info -fill x -side left
pack $wi.si -padx 4 -pady 4 -fill x -side top
# capabilities
labelframe $wi.cap -borderwidth 0 -text "Capabilities"
listbox $wi.cap.caps -selectmode single -height 5 -width 50 \
-yscrollcommand "$wi.cap.caps_scroll set" -exportselection 0
scrollbar $wi.cap.caps_scroll -command "$wi.cap.caps yview"
pack $wi.cap.caps $wi.cap.caps_scroll -fill y -side left
pack $wi.cap -padx 4 -pady 4 -fill both -side top -expand true
# populate the list
pluginsConfigRefreshList $wi
bind $wi.s.plugins <<ListboxSelect>> "pluginsConfigSelect $wi"
pluginsConfigSelect $wi
# close button
frame $wi.b -borderwidth 0
button $wi.b.save -text "Save" -command "writePluginsConf; destroy $wi"
button $wi.b.cancel -text "Cancel" -command "destroy $wi"
pack $wi.b.cancel $wi.b.save -side right
pack $wi.b -side bottom
# uncomment to make modal
# after 100 { catch { grab .pluginConfig } }
}
#
# Helper for pluginConfig when new/edit buttons are pressed.
#
proc popupPluginsConfigEdit { parent action } {
global g_plugins g_plugin_types plugin_config_type plugin_config_autoconn
set wi .pluginConfig.popup
catch {destroy $wi}
toplevel $wi
wm transient $wi .pluginConfig
wm resizable $wi 0 0
if { $action == "new" } {
set title "Add"
set selected_idx -1
set selected_name -1
} else {
set title "Edit"
set selected_idx [$parent.s.plugins curselection]
if { $selected_idx == "" } { destroy $wi; return }
set selected_name [$parent.s.plugins get $selected_idx]
set plugin_data $g_plugins("$selected_name")
}
# default values
set plugin_config_type $g_plugin_types(1)
set plugin_config_autoconn 0
wm title $wi "$title Plugin"
# controls for editing entries
labelframe $wi.c -text "Plugin configuration"
frame $wi.c.a -borderwidth 4
label $wi.c.a.namelab -text "Name"
entry $wi.c.a.name -bg white -width 35
pack $wi.c.a.namelab $wi.c.a.name -side left
pack $wi.c.a -fill x -side top
frame $wi.c.b -borderwidth 4
label $wi.c.b.typelab -text "Type"
set plugin_types_list {}
foreach type_num [lsort -dictionary [array names g_plugin_types]] {
lappend plugin_types_list "$g_plugin_types($type_num)"
}
eval tk_optionMenu $wi.c.b.type plugin_config_type $plugin_types_list
label $wi.c.b.iplab -text "IP"
entry $wi.c.b.ip -bg white -width 15
label $wi.c.b.portlab -text "port"
entry $wi.c.b.port -bg white -width 10
pack $wi.c.b.typelab $wi.c.b.type -side left
pack $wi.c.b.iplab $wi.c.b.ip -side left
pack $wi.c.b.portlab $wi.c.b.port -side left
pack $wi.c.b -fill x -side top
frame $wi.c.c -borderwidth 4
checkbutton $wi.c.c.autoconn -variable plugin_config_autoconn -text \
"Automatically connect to this plugin at startup"
pack $wi.c.c.autoconn -side left
pack $wi.c.c -fill x -side top
pack $wi.c -fill x -side top
frame $wi.btm
button $wi.btm.ok -text "OK" \
-command "popupPluginConfigEditApply $wi $selected_idx \"$selected_name\"; pluginsConfigRefreshList $parent; destroy $wi"
button $wi.btm.cancel -text "Cancel" -command "destroy $wi"
pack $wi.btm.cancel $wi.btm.ok -side right
pack $wi.btm -fill x -side top
# fill in values for editing
if { $action != "new" } {
$wi.c.a.name insert 0 $selected_name
$wi.c.b.ip insert 0 [lindex $plugin_data 0]
$wi.c.b.port insert 0 [lindex $plugin_data 1]
if { [info exists g_plugin_types([lindex $plugin_data 2])] } {
set plugin_config_type $g_plugin_types([lindex $plugin_data 2])
}
set plugin_config_autoconn [lindex $plugin_data 3]
}
}
#
# Helper for .pluginConfig.popup dialog when apply button is pressed.
# selected_idx = -1 indicates adding a new entry
#
proc popupPluginConfigEditApply { wi selected_idx selected_name } {
global g_plugins g_plugin_types plugin_config_type plugin_config_autoconn
# get values from the dialog
set name "\"[string trim [$wi.c.a.name get]]\""
set ip [string trim [$wi.c.b.ip get]]
set port [string trim [$wi.c.b.port get]]
set type $plugin_config_type
set typenum -1
foreach t [array names g_plugin_types] {
if { $g_plugin_types($t) == "$type" } { set typenum $t; break; }
}
if { $typenum == -1 } { set typenum 1 }
set status 0
set cap ""
set sock -1
set ac $plugin_config_autoconn
# replace (replace items 0-3, preserve 4-6)
if { $selected_idx != -1 } {
if { ![info exists g_plugins("$selected_name")] } { return }
set plugin_data $g_plugins("$selected_name")
set status [lindex $plugin_data 4]
set cap [lindex $plugin_data 5]
set sock [lindex $plugin_data 6]
if { $name != $selected_name } { ;# name change
array unset g_plugins "\"$selected_name\""
}
}
# manipulate the g_plugins array
set plugin_data [list $ip $port $typenum $ac $status $cap $sock]
array set g_plugins [list $name $plugin_data]
}
#
# Helper to refresh the list of plugins. Called from various places.
#
proc pluginsConfigRefreshList { wi } {
global g_plugins
set selected_idx [$wi.s.plugins curselection]
$wi.s.plugins delete 0 end
foreach plugin [lsort -dictionary [array names g_plugins]] {
$wi.s.plugins insert end [string trim $plugin \"]
}
if { $selected_idx != "" } {
$wi.s.plugins selection set $selected_idx
pluginsConfigSelect $wi
}
}
#
# Helper to populate the plugin info and capabilities frame.
#
proc pluginsConfigRefreshInfo { wi plugin_data } {
global g_plugin_types g_plugin_status_types
set ip [lindex $plugin_data 0]
set port [lindex $plugin_data 1]
set tnum [lindex $plugin_data 2]
set ac [lindex $plugin_data 3]
set snum [lindex $plugin_data 4]
set caps [lindex $plugin_data 5]
set sock [lindex $plugin_data 6]
set type $g_plugin_types($tnum)
set stat $g_plugin_status_types($snum)
# plugin information text
set txt "($type)://$ip:$port status=$stat"
$wi.si.info delete 0 end
$wi.si.info insert 0 $txt
# update the connect/disconnect button
set c "conn"
if { $snum == 1 } { set c "disc" }
global plugin_img_$c
$wi.bbar.conn configure -image [set plugin_img_$c]
# capabilities list
$wi.cap.caps delete 0 end
foreach cap $caps {
addPluginCapToListbox $wi.cap.caps $cap end
}
}
#
# Helper for adding a capability to the given listbox control.
#
proc addPluginCapToListbox { listb cap idx } {
global regtxttypes
set cap [split $cap =]
set captype [lindex $cap 0]
set capname [lindex $cap 1]
if { ![info exists regtxttypes($captype)] } {
set txt "Unknown($captype)"
} else {
set txt $regtxttypes($captype)
}
$listb insert $idx "$txt - $capname"
}
#
# Helper for pluginConfig dialog when plugin list items are selected.
#
proc pluginsConfigSelect { wi } {
global g_plugins g_plugin_types g_plugin_status_types regtxttypes
# initialize the default state
set buttons "edit del conn refr"
set buttons_state disabled
set name ""
if { ![winfo exists $wi.s.plugins] } { return }
set selected_idx [$wi.s.plugins curselection]
if { $selected_idx != "" } {
set buttons_state normal
set name "\"[$wi.s.plugins get $selected_idx]\""
}
# enable or disable the editing/control buttons
if { $name == "\"GUI\"" } {
# this program is the GUI, you cannot change this connection
set buttons_state disabled
global plugin_img_disc
$wi.bbar.conn configure -image $plugin_img_disc
}
foreach b $buttons { $wi.bbar.$b configure -state $buttons_state }
# fill in plugin info frame
if { [info exists g_plugins($name)] } {
set plugin_data $g_plugins($name)
pluginsConfigRefreshInfo $wi $plugin_data
}
}
#
# Helper for pluginConfig dialog when delete button is pressed.
#
proc pluginsConfigDelete { wi } {
global g_plugins
set selected_idx [$wi.s.plugins curselection]
if { $selected_idx == "" } { return }
set name "\"[$wi.s.plugins get $selected_idx]\""
set title "Delete CORE plugin"
set msg "Are you sure you want to delete the plugin $name?"
set choice [tk_messageBox -type yesno -default no -icon warning \
-title $title -message $msg]
if { $choice == "yes" } {
array unset g_plugins $name
pluginsConfigRefreshList $wi
}
}
#
# Helper for pluginConfig dialog when connect button is pressed.
#
proc pluginsConfigConnect { wi } {
global g_plugins g_plugin_types
set selected_idx [$wi.s.plugins curselection]
if { $selected_idx == "" } { return }
set name "\"[$wi.s.plugins get $selected_idx]\""
pluginConnect $name toggle true
}
#
# Helper for pluginConfig dialog when refresh button is pressed.
#
proc pluginsConfigRefresh { wi } {
set selected_idx [$wi.s.plugins curselection]
if { $selected_idx == "" } { return }
set name "\"[$wi.s.plugins get $selected_idx]\""
pluginRefresh $name
}
#
# Helper called from api.tcl when register message is parsed.
#
proc pluginsConfigRefreshCallback { } {
global execMode
if { $execMode != "interactive"} { return } ; # batch mode
# callback if CORE Plugins window is open, refresh it...
if { [winfo exists .pluginConfig] } {
pluginsConfigRefreshList .pluginConfig
}
# callback if CORE WLAN window is open, refresh it...
if { [winfo exists .pluginCapConfig] } {
pluginsCapConfigRefreshList .pluginCapConfig
}
}
#
# Dialog to assign capabilities from plugin to WLAN.
#
proc popupPluginsCapConfig { wlan parent } {
global g_plugins CORE_DATA_DIR g_cap_in_use
set wi .pluginCapConfig
catch {destroy $wi}
toplevel $wi
wm transient $parent .
wm title $wi "Available Plugins"
# update dialog
if { [winfo exists $parent.mod.plugins.coreapi] } {
global mobmodel
set mobmodel "coreapi"
}
# active plugins
set name [getNodeName $wlan]
labelframe $wi.active -text "Active capabilities for $name" -borderwidth 0
listbox $wi.active.plugins -selectmode single -width 55 -height 5 \
-yscrollcommand "$wi.active.scroll set" -exportselection 0
scrollbar $wi.active.scroll -command "$wi.active.plugins yview"
pack $wi.active.plugins -fill both -side left
pack $wi.active.scroll -fill y -side left
pack $wi.active -side top -fill both -expand true -padx 4 -pady 4
# buttons
frame $wi.mid
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 endis "Enable" } else { set endis "Disable" }
button $wi.mid.$b -image [set img${b}] \
-text "$endis" -compound left \
-command "popupPluginsCapConfigHelper $wi $b $wlan"
pack $wi.mid.$b -side left -pady 2 -fill y
}
button $wi.mid.conf -text "Configure..." \
-command "popupPluginsCapConfigHelper $wi config $wlan"
button $wi.mid.plugins -text "Manage plugins..." \
-command "popupPluginsConfig; after 100 { catch {grab .pluginConfig } }"
pack $wi.mid.conf $wi.mid.plugins -side left -pady 2
pack $wi.mid -side top -fill x -expand true -padx 4 -pady 4
# available plugins
labelframe $wi.avail -text "Available capabilities" -borderwidth 0
listbox $wi.avail.plugins -selectmode single -width 55 -height 5 \
-yscrollcommand "$wi.avail.scroll set" -exportselection 0
scrollbar $wi.avail.scroll -command "$wi.avail.plugins yview"
pack $wi.avail.plugins -fill both -side left
pack $wi.avail.scroll -fill y -side left
pack $wi.avail -side top -fill both -expand true -padx 4 -pady 4
bind $wi.active.plugins <Double-Button-1> \
"popupPluginsCapConfigHelper $wi down $wlan"
bind $wi.avail.plugins <Double-Button-1> \
"popupPluginsCapConfigHelper $wi up $wlan"
# this reads from the existing wlan config
if { $g_cap_in_use == "" } {
set g_cap_in_use [getCapabilities $wlan "mobmodel"]
}
# populate the plugins list
pluginsCapConfigRefreshList $wi
$wi.active.plugins selection set 0
# OK button
set cancel_cmd "destroy $wi"
frame $wi.btn
button $wi.btn.cancel -text "OK" -command $cancel_cmd
pack $wi.btn.cancel -side left -padx 4 -pady 4
pack $wi.btn -side bottom
bind $wi <Key-Return> $cancel_cmd
bind $wi <Key-Escape> $cancel_cmd
# grab the window due to interactions with node configuration dialog
after 100 {
grab .pluginCapConfig
raise .pluginCapConfig
}
}
#
# Up/down/configure buttons helper.
#
proc popupPluginsCapConfigHelper { wi cmd wlan} {
global g_cap_in_use g_cap_in_use_set
if { $cmd == "up" } {
set l $wi.avail.plugins
set l2 $wi.active.plugins
} else {
set l $wi.active.plugins
set l2 $wi.avail.plugins
}
set selected_idx [$l curselection]
if { $selected_idx == "" } { return } ;# nothing was selected
if { $cmd == "config" } { ;# configure button pressed
set capstr [$l get $selected_idx]
set cap [string trim [lindex [split $capstr -] 1]]
if { $cap == "" } { return } ;# error
set plch [pluginChannelByCap $cap]
set plugin [lindex $plch 0]
set channel [lindex $plch 1]
set flags 0x1 ;# request - a response to this message is requested
set netid -1 ;# no netid because node not necessarily instantiated
set opaque "" ;# unused
set channel [pluginConnect $plugin connect 1]
if { $cap == "location" } {
# hack to map location capabilities with canvas size/scale dialog
resizeCanvasPopup
return
}
if { $channel != -1 && $channel != "" } {
sendConfRequestMessage $channel $wlan $cap $flags $netid $opaque
}
return
} else { ;# up/down enable/disable button preseed
set capstr [$l get $selected_idx]
$l delete $selected_idx $selected_idx
$l2 insert end $capstr
$l2 selection set end
# put the capabilities from the active list into the g_cap_in_use list
# this list will be read in wlanConfigDialogHelper when Apply pressed
set g_cap_in_use {}
set g_cap_in_use_set 1
foreach capstr [$wi.active.plugins get 0 end] {
set cap [string trim [lindex [split $capstr -] 1]]
lappend g_cap_in_use $cap
}
}
}
#
# Send a configure message to request a capabilities configuration parameters.
#
proc configCap { node models } {
set plch [pluginChannelByCap [lindex $models 0]]
set plugin [lindex $plch 0]
set channel [lindex $plch 1]
set flags 0x1 ;# request - a response to this message is requested
set netid -1 ;# no netid because node not necessarily instantiated
set opaque "" ;# unused
set channel [pluginConnect $plugin connect 1]
if { $channel != -1 && $channel != "" } {
sendConfRequestMessage $channel $node $models $flags $netid $opaque
}
}
#
# Refresh the capabilities in-use and available listboxes.
#
proc pluginsCapConfigRefreshList { wi } {
# global list of capabilities in use for the current config dialog
# (this is global because parseRegMessage does not know which WLAN is being
# configured)
global g_cap_in_use
# clear the listboxes
$wi.avail.plugins delete 0 end
$wi.active.plugins delete 0 end
# refresh the listboxes
set caplist [getPluginsCapList]
foreach cap $caplist {
set captype [lindex [split $cap =] 0]
set capname [lindex [split $cap =] 1]
# skip CORE daemons
if { [lsearch -exact "openvz core-daemon" $capname] != -1 } { continue }
# skip gui, exec, util capabilities
if { [lsearch -exact "gui exec util" $captype] != -1 } { continue }
# add capability to active or available lists
if { [lsearch -exact $g_cap_in_use $capname] < 0 } {
addPluginCapToListbox $wi.avail.plugins $cap end
} else {
addPluginCapToListbox $wi.active.plugins $cap end
}
}
}
#
# Helper to convert a capability name to a text title,
# e.g. emane_rfpipe -> rfpipe
#
proc capTitle { cap } {
if { [string range $cap 0 5] == "emane_" } {
return [string range $cap 6 end]
}
return $cap
}
#
# Popup a capability configuration dialog box.
# This is used for these dynamic dialogs:
# Session options
# EMANE options
# EMANE model options, per-WLAN/per-interface
#
proc popupCapabilityConfig { channel wlan model types values captions bmp possible_values groups } {
global node_list g_node_type_services_hint g_popupcap_keys g_prefs
set wi .popupCapabilityConfig
catch {destroy $wi}
toplevel $wi
set modelname [capTitle $model]
wm maxsize $wi 710 600
wm minsize $wi 710 600
wm transient $wi .
wm title $wi "$modelname configuration"
array unset g_popupcap_keys ;# hint for supporting key=value w/apply button
set titletxt "$modelname"
set customcfg ""
if { [lsearch $node_list $wlan] != -1 } {
set titletxt "node $wlan $titletxt"
# check for existing saved parameters in custom-config
set customcfg [getCapabilityConfig $wlan $model]
} else {
set titletxt "$titletxt parameters"
}
ttk::label $wi.top -text "$titletxt"
pack $wi.top -side top -padx 4 -pady 4
if { $model == "emane" } {
# EMANE global config uses node None, but is saved with minEmaneNode
set wlan [minEmaneNode]
if { $wlan == "" } {
# WLAN configure dialog but "Apply" hasn't been pressed yet
# so there is no EMANE node in node_list
if { [winfo exists .popup.butt.apply] } {
# grab the currently configured WLAN ID
set wlan [lindex [.popup.butt.apply cget -command] 3]
}
}
if { $wlan != "" } {
set customcfg [getCapabilityConfig $wlan $model]
} else {
puts "*** Error: emane config with no EMANE nodes!"
}
}
if { $customcfg != "" } {
set cfg [lindex [lindex $customcfg 2] 1]
} else {
set cfg ""
}
# session options stored in array, not custom-config
if { $model == "session" } { set cfg [getSessionOptionsList] }
frame $wi.frame
set windowFrame $wi.frame
canvas $windowFrame.c -width 700 -height 600
set windowCanvas $windowFrame.c
scrollbar $windowFrame.sb -orient vert -command "$windowCanvas yview"
set windowScroll $windowFrame.sb
$windowCanvas config -yscrollcommand "$windowScroll set"
pack $windowScroll -fill y -side right
pack $windowCanvas -expand yes -fill both -side top
frame $windowCanvas.notebookFrame -width 700 -height 1200
set notebookFrame $windowCanvas.notebookFrame
pack $notebookFrame -fill both -expand yes -padx 5 -pady 5
ttk::notebook $notebookFrame.vals -width 690 -height 1200
set configNotebook $notebookFrame.vals
ttk::notebook::enableTraversal $configNotebook
pack $configNotebook -fill both -expand yes
set n 0
set gn 0
set lastgn -1
foreach type $types {
set kv [splitKeyValue [lindex $values $n]]
set key [lindex $kv 0]
set value [lindex $kv 1]
if { $cfg != "" } { ;# possibly use existing config value
if { $key == "" } { ;# support old "value" format
set value [lindex $cfg $n]
} else {
set value [getKeyValue $key $cfg $value]
}
}
array set g_popupcap_keys [list $n $key] ;# remember key for apply
if {$type == 1 || $type == 5} {set w 4}
if {$type == 2 || $type == 6} {set w 8}
if {$type == 3 || $type == 7 || $type == 9} {set w 8}
if {$type == 4 || $type == 8 || $type == 10} {set w 16}
# group values into frames based on groups TLV
set groupinfo [popupCapabilityConfigGroup $groups [expr {$n + 1}]]
set gn [lindex $groupinfo 0]
set groupcaption [lindex $groupinfo 1]
if { $lastgn != $gn } {
ttk::frame $configNotebook.$gn
$configNotebook add $configNotebook.$gn -text $groupcaption -underline 0
set lastgn $gn
}
set fr $configNotebook.$gn.item$n
ttk::frame $fr
if {$type == 11} { ;# boolean value
global $fr.entval $fr.entvalhint
set optcmd [list tk_optionMenu $fr.ent \
$fr.entval]
if { [lindex $possible_values $n] != "" } {
set possible [lindex $possible_values $n]
set opts [split $possible ,]
} else {
set opts [list True False]
}
set optcmd "$optcmd $opts"
eval $optcmd
set $fr.entval [lindex $opts 0]
# store the first value so we know how to interpret the option menu
# value later as 0 or 1 instead of the text labels
set $fr.entvalhint [lindex $opts 0]
if { $value == "0" } {
set $fr.entval [lindex $opts 1]
}
} else {
# dropdown control
if { [lindex $possible_values $n] != "" } {
global $fr.entval
set optcmd [list tk_optionMenu $fr.ent \
$fr.entval]
set possible [lindex $possible_values $n]
set opts [split $possible ,]
set optcmd [concat $optcmd $opts]
eval $optcmd
set $fr.entval [lindex $opts 0]
for { set i 0 } { $i < [llength $opts] } { incr i } {
set opt [lindex $opts $i]
set optval [lindex [split $opt] 0]
if { $value == $optval } {
set $fr.entval $opt
break
}
}
# plain old text entry
} else {
ttk::entry $fr.ent -width $w -justify right
$fr.ent insert 0 $value
}
}
ttk::label $fr.lab -text "[lindex $captions $n]"
# file browse button "..."
if { [winfo class $fr.ent] == "TEntry" && \
[string first "file" "[lindex $captions $n]"] > -1 } {
ttk::button $fr.browse -width 5 -text "..." \
-command "fileButtonPopup $fr.ent $g_prefs(default_conf_path)"
pack $fr.browse $fr.ent $fr.lab -side right -padx 4 -pady 4
} else {
pack $fr.ent $fr.lab -side right -padx 4 -pady 4
}
pack $fr -side top -anchor e
incr n
}; # end foreach
if { $bmp != "" && [file exists $bmp] } {
if { [string range $bmp end-2 end] == "gif" } {
set bitmap [image create photo -file $bmp]
} else {
set bitmap [image create bitmap -file $bmp]
}
ttk::label $wi.bitmap -image $bitmap
pack $wi.bitmap -side top -padx 4 -pady 4
} elseif { $bmp != "" } {
puts "bitmap not found: $bmp"
}
# TODO: any captions beyond count
# Apply / Cancel buttons
set apply_cmd \
"popupCapabilityConfigApply $wi $channel $wlan $model {$types} {$groups}"
set cancel_cmd "destroy $wi"
ttk::frame $wi.btn
ttk::button $wi.btn.apply -text "Apply" -command $apply_cmd
ttk::button $wi.btn.cancel -text "Cancel" -command $cancel_cmd
pack $wi.btn.apply $wi.btn.cancel -side left -padx 4 -pady 4
pack $wi.btn -side bottom
bind $wi <Key-Return> $apply_cmd
bind $wi <Key-Escape> $cancel_cmd
# pack notebook
$windowCanvas create window 0 0 -anchor nw -window $notebookFrame
$windowCanvas configure -scrollregion [$windowCanvas bbox all]
pack $windowFrame -fill both -expand yes -side top
after 100 {
grab .popupCapabilityConfig
raise .popupCapabilityConfig
}
}
# Helper to retrieve the group number and caption for the current item based
# on the list from the groups TLV.
#
proc popupCapabilityConfigGroup { groups n } {
set num 0
set caption ""
# groups are in the form caption:a-b
# the caption is optional
foreach group $groups {
set i [string first ":" $group]
# here it is possible that i = -1, and caption will become ""
set caption [string range $group 0 $i]
if { [string index $caption end] == ":" } {
# remove the ":" character
set caption [string replace $caption end end]
}
incr i
set groupitems [split [string range $group $i end] -]
set a [lindex $groupitems 0]
set b [lindex $groupitems 1]
# check if the current item belongs to this group
if { $n >= $a && $n <= $b } {
return [list $num $caption]
}
incr num
}
return [list $num $caption]
}
# apply button for Wireless model configuration dialog
proc popupCapabilityConfigApply { wi channel wlan model types groups } {
global node_list MACHINE_TYPES g_popupcap_keys
set configNotebook $wi.frame.c.notebookFrame.vals
set n 0
set vals {}
foreach type $types {
set groupinfo [popupCapabilityConfigGroup $groups [expr {$n + 1}]]
set gn [lindex $groupinfo 0]
if { ![winfo exists $configNotebook.$gn.item$n.ent] } {
puts "warning: missing dialog value $n for $model"
continue
}
if { [catch { set val [$configNotebook.$gn.item$n.ent get] }] } {
if { $type == 11 } {
# convert textual value from tk_optionMenu to boolean 0/1
# using hint
global $configNotebook.$gn.item$n.entval $configNotebook.$gn.item$n.entvalhint
if { [set $configNotebook.$gn.item$n.entval] == \
[set $configNotebook.$gn.item$n.entvalhint] } {
set val 1 ;# true
} else {
set val 0 ;# false
}
} else {
# convert textual dropdown value to numeric using first word
# e.g. "0 11 Mbps" has a value of 0
global $configNotebook.$gn.item$n.entval
set selectedopt [set $configNotebook.$gn.item$n.entval]
set val [lindex $selectedopt 0]
}
}
if { $g_popupcap_keys($n) != "" } {
set val [join [list $g_popupcap_keys($n) $val] =] ;# key=value
}
lappend vals $val
incr n
}
set opaque ""
# node doesn't exist, we are changing the node type or session options
if { [lsearch $node_list $wlan] == -1 } {
if { [lsearch -exact $MACHINE_TYPES $model] != -1 } {
set opaque [popupNodeProfileConfigApply $vals]
} elseif { $model == "session" } {
setSessionOptions $types $vals
} elseif { $model == "emane" } {
set minemane [minEmaneNode]
setCustomConfig $minemane $model $types $vals 0
}
# overload the use of custom-config: store each external model config here
} else {
setCustomConfig $wlan $model $types $vals 0
}
destroy $wi
sendConfReplyMessage $channel $wlan $model $types $vals $opaque
}
#
# Popup a session configuration dialog box.
#
proc popupSessionConfig { channel sessionids sessionnames sessionfiles nodecounts sessiondates thumbs opaque } {
catch { package require Img }
global g_current_session node_list currentFile
global plugin_img_add plugin_img_del plugin_img_open
set wi .popupSessionConfig
catch {destroy $wi}
toplevel $wi
wm transient $wi .
wm title $wi "CORE Sessions"
ttk::frame $wi.top
set txt "Below is a list of active CORE sessions."
set txt "$txt Double-click to connect to an existing session."
set txt "$txt Usually, only sessions in the RUNTIME state persist in the"
set txt "$txt daemon, except for the one you may be currently editing."
ttk::label $wi.msg -wraplength 4i -justify left -anchor n \
-padding {10 2 20 6} -text $txt
#pack $wi.msg -fill x
canvas $wi.preview -background white -relief sunken -bd 2 \
-width 100 -height 100
pack $wi.top -fill both -expand 1
grid $wi.msg $wi.preview -in $wi.top -padx 4 -pady 4
# tree view -- list of sessions
set cols {sid name nc fn dt}
ttk::frame $wi.container
# TODO: allow multiple selections (-selectmode extended) for shutting down
# multiple sessions
ttk::treeview $wi.tree -columns $cols -show headings \
-selectmode browse -height 5 \
-yscroll "$wi.vsb set" -xscroll "$wi.hsb set"
ttk::scrollbar $wi.vsb -orient vertical -command "$wi.tree yview"
ttk::scrollbar $wi.hsb -orient horizontal -command "$wi.tree xview"
pack $wi.container -fill both -expand 1
grid $wi.tree $wi.vsb -in $wi.container -sticky nsew
grid $wi.hsb -in $wi.container -sticky nsew
grid column $wi.container 0 -weight 1
grid row $wi.container 0 -weight 1
array set thumbnails {}
# populate headers
set font [ttk::style lookup [$wi.tree cget -style] -font]
foreach col $cols name {ID Name {Node Count} Filename Date} {
$wi.tree heading $col -text $name
$wi.tree column $col -width [font measure $font $name]
}
# populate tree items
foreach sid $sessionids name $sessionnames fn $sessionfiles nc $nodecounts dt $sessiondates th $thumbs {
if {$sid == $g_current_session} {
set nc [llength $node_list]
set fn [file tail $currentFile]
set dt "(current session)"
}
array set thumbnails [list $sid $th]
$wi.tree insert {} end -values [list $sid $name $nc $fn $dt] \
-tags "sess"
foreach col {sid name nc fn dt} {
set len [font measure $font "[set $col] "]
if { [$wi.tree column $col -width] < $len } {
$wi.tree column $col -width $len
}
}
}
# buttons - new connect shutdown cancel
set close_cmd "destroy $wi"
set conn_cmd "sessionConfig connect $wi -1; $close_cmd"
set shut_cmd "sessionConfig shutdown $wi $channel; $close_cmd"
set new_cmd "sessionConfig new $wi $channel; $close_cmd"
ttk::frame $wi.btn
ttk::separator $wi.btn.sep
grid $wi.btn.sep -columnspan 4 -row 0 -sticky ew -pady 2
ttk::button $wi.btn.cancel -text "Cancel" -command $close_cmd
ttk::button $wi.btn.shut -text "Shutdown" -image $plugin_img_del \
-compound left -command $shut_cmd
ttk::button $wi.btn.conn -text "Connect" -image $plugin_img_open \
-compound left -command $conn_cmd
ttk::button $wi.btn.new -text "New" -image $plugin_img_add \
-compound left -command $new_cmd
grid $wi.btn.new $wi.btn.conn $wi.btn.shut $wi.btn.cancel -padx 4 -pady 4
grid columnconfigure $wi 0 -weight 1
pack $wi.btn -side bottom -fill x
bind $wi <Key-Return> $conn_cmd
bind $wi <Key-Escape> $close_cmd
bind $wi.tree <<TreeviewSelect>> "sessionConfigSelect $wi {$thumbs}"
bind $wi.tree <Double-1> "$conn_cmd; break"
}
# update the preview thumbnail when a session has been clicked
proc sessionConfigSelect { wi thumbs } {
set item [$wi.tree selection]
set i [$wi.tree index $item]
set thumb [lindex $thumbs $i]
set thumbimg [image create photo -file $thumb]
set w [image width $thumbimg]; set h [image height $thumbimg]
$wi.preview delete -withtags "thumbnail"
$wi.preview create image [expr $w / 2] [expr $h / 2] -image $thumbimg \
-tags "thumbnail"
}
# send Session API message to connect or shutdown a session
proc sessionConfig { cmd wi channel } {
global g_current_session
# sid = 0 is new session, or the session number of an existing session
set sid 0
set fn ""
foreach item [$wi.tree selection] {
array set vals [$wi.tree set $item]
set sid $vals(sid)
set fn $vals(fn)
break; # TODO: loop on multiple selection for shutdown
}
if { $sid == $g_current_session } {
return
}
if { $cmd == "new" } {
set cmd "connect"
set sid 0
}
connectShutdownSession $cmd $channel $sid $fn
}
# switch sessions or shutdown the specified session
# sid=0 indicates switching to a new session (disconnect from old and start a
# new file)
proc connectShutdownSession { cmd channel sid fn } {
global g_current_session CORE_USER currentFile
switch -exact -- $cmd {
connect {
newFile
# start a new session and return
if { $sid == 0 } {
return
} else {
set g_current_session $sid
}
# connect to an existing session
set currentFile $fn
setOperMode exec connect
set flags 0x11 ;# add flag, status req flag
}
shutdown {
if { $sid == 0 } { return }
set flags 0x2 ;# delete flag
}
}
set name ""
set f ""
set nodecount ""
set thumb ""
set user $CORE_USER
sendSessionMessage $channel $flags $sid $name $f $nodecount $thumb $user
}
proc requestSessions {} {
global g_session_dialog_hint
set channel [lindex [getEmulPlugin "*"] 2]
set flags 0x10 ;# status request flag
set sid "0"
set name ""
set f ""
set nodecount ""
set thumb ""
set user ""
set g_session_dialog_hint 1 ;# show session dialog upon response
sendSessionMessage $channel $flags $sid $name $f $nodecount $thumb $user
}
###############################################################################
# Plugins and Capabilities helper functions #
###############################################################################
#
# Given a channel, return the plugin associated with it.
#
proc pluginByChannel { sock } {
global g_plugins
foreach plugin [array names g_plugins] {
set plugin_data $g_plugins($plugin)
if { [lindex $plugin_data 6] == $sock } {
return $plugin
}
}
return ""
}
#
# Given a capability, return the plugin/socket associated with it.
#
proc pluginChannelByCap { cap } {
global g_plugins
foreach plugin [array names g_plugins] {
set plugin_data $g_plugins($plugin)
set caps [lindex $plugin_data 5]
set sock [lindex $plugin_data 6]
if { [lsearch $caps "*=$cap"] > -1 } {
return [list $plugin $sock]
}
}
return "" ;# not found
}
#
# Return a list of all known capabilities from all plugins.
#
proc getPluginsCapList { } {
global g_plugins
set r {}
foreach p_name [lsort -dictionary [array names g_plugins]] {
set p $g_plugins($p_name)
set p_caps [lindex $p 5]
foreach cap $p_caps { lappend r $cap }
}
return $r
}
#
# Set the list of capabilities for a plugin.
#
proc setPluginCapList { plugin caps } {
global g_plugins
if { ![info exists g_plugins($plugin)] } {
return -1 ;# unknown plugin
}
set plugin_data $g_plugins($plugin)
set plugin_data [lreplace $plugin_data 5 5 $caps]
array set g_plugins [list $plugin $plugin_data]
return 0
}
#
# Get the configuration for a capability associated with a node.
#
proc getCapabilityConfig { node model } {
# check for existing saved parameters in custom-config
set customCfgList [getCustomConfig $node]
foreach element $customCfgList {
set cid [lindex [lsearch -inline $element "custom-config-id *"] 1]
if { $cid == $model } {
if { [lindex $element 0] == {} } {;# remove empty first elemnt
set element [lreplace $element 0 0]
}
return $element
}
}
return ""
}
#
# Return a list of active capabilities for a node.
#
proc getCapabilities { node section } {
# for wlan, the capabilities are stored in the "mobmodel" section
set cfg [split [netconfFetchSection $node $section]]
set r {}
if { [lindex $cfg 0] == "coreapi" } {
# list of active capabilities
set r [join [join [lreplace $cfg 0 0]]]
}
return $r
}
#
# Return the first <plugin,capname,sock> that provides emulation capability.
#
proc getEmulPlugin { node } {
# TODO: in the future, may associate certain nodes with certain plugins
global g_plugins
foreach p_name [lsort -dictionary [array names g_plugins]] {
set p $g_plugins($p_name)
set p_caps [lindex $p 5]
set sock [lindex $p 6]
foreach cap $p_caps {
set captype [lindex [split $cap =] 0]
set capname [lindex [split $cap =] 1]
if { $captype == "emul" } {
return [list $p_name $capname $sock]
}
}
}
return ""
}
#
# Automatically connect to plugins whose auto-connect=1 on startup
#
proc autoConnectPlugins { } {
global g_plugins
foreach plugin [lsort -dictionary [array names g_plugins]] {
set plugin_data $g_plugins($plugin)
set ac [lindex $plugin_data 3]
set status [lindex $plugin_data 4]
if { $ac == 1 && $status == 0 } {
set server [lindex $plugin_data 0]
set port [lindex $plugin_data 1]
pluginConnect $plugin connect 0
}
}
}
#
#
# Connect to a plugin using its configured ip/port and set its sock member.
# The cmd parameter can be connect, disconnect, or toggle.
# The retry parameter is passed to openAPIChannel for prompting the user to
# retry the connection. Returns the channel.
#
proc pluginConnect { name cmd retry } {
global g_plugins
if { $name == "" } { set name \"core-daemon\" }
if { ![info exists g_plugins($name)] } {
puts "pluginConnect error: $name does not exist!"
return -1
}
set plugin_data $g_plugins($name)
set ip [lindex $plugin_data 0]
set port [lindex $plugin_data 1]
set type [lindex $plugin_data 2]
set ac [lindex $plugin_data 3]
set snum [lindex $plugin_data 4]
set cap [lindex $plugin_data 5]
set sock [lindex $plugin_data 6]
set do_refresh false
switch -exact -- $type {
0 { ;# none
puts "Warning: plugin type 0 '$g_plugin_types(0)' cannot be connected."
}
1 { ;# CORE API
if { $cmd == "toggle" } {
if { $snum == 0 } {
set cmd connect
} elseif { $snum == 1 } {
set cmd disconnect
}
}
# connect, disconnect, or do nothing
if { $cmd == "connect" && $snum != 1} {
puts -nonewline "Connecting to $name ($ip:$port)..."
flush stdout
set sock [openAPIChannel $ip $port $retry]
if { "$sock" <= -1 } { return -1 };# user pressed cancel
set snum 1 ;# status connected
set do_refresh true
} elseif { $cmd == "disconnect" && $snum == 1 } {
if { "$sock" != -1 } {
catch { flush $sock }
close $sock
pluginChannelClosed $sock
return -1
}
set snum 0 ;# status disconnected
} else {
return $sock; # do nothing, already (dis)connected
}
}
default {
puts "Warning: don't know how to connect to plugin type $type."
return $sock;
}
}; # end switch
# update the g_plugins array
set plugin_data [list $ip $port $type $ac $snum $cap $sock]
array set g_plugins [list $name $plugin_data]
if { $do_refresh } { pluginRefresh $name }
return $sock
}
#
# Refresh a connected plugin by sending a register message.
#
proc pluginRefresh { plugin } {
global g_plugins DEFAULT_GUI_REG
if { ![info exists g_plugins($plugin)] } { return }
set plugin_data $g_plugins($plugin)
set type [lindex $plugin_data 2]
set status [lindex $plugin_data 4]
set sock [lindex $plugin_data 6]
switch -exact -- $type {
0 { ;# none
puts "Warning: plugin type 0 '$g_plugin_types(0)' cannot be refreshed."
}
1 { ;# CORE API
if { "$status" != 1 } {
puts -nonewline "Plugin $plugin is disconnected and cannot be "
puts "refreshed."
return
}
sendRegMessage $sock 0 $DEFAULT_GUI_REG
}
default {
if { [info exists g_plugin_type($type)] } {
set txt $g_plugin_types($type)
} else {
set txt "unknown"
}
puts "Warning: plugin type $type '$txt' cannot be refreshed."
return
}
}; # end switch
}
#
# Update the sock member of a plugin when its channel has been closed.
#
proc pluginChannelClosed { sock } {
global g_plugins
set plugin [pluginByChannel $sock]
if { $plugin == "" } { return } ;# channel not found
set plugin_data $g_plugins($plugin)
set plugin_data [lreplace $plugin_data 6 6 -1]; # sock = -1
set plugin_data [lreplace $plugin_data 4 4 0]; # status = 0 disconnected
array set g_plugins [list $plugin $plugin_data]
set ip [lindex $plugin_data 0]
set port [lindex $plugin_data 1]
puts "Connection to $plugin ($ip:$port) closed."
if { $plugin == "\"core-daemon\"" } {
global g_current_session
set g_current_session 0
setGuiTitle ""
}
}
#
# Load the plugins.conf file into the g_plugins array
#
proc loadPluginsConf { } {
global CONFDIR g_plugins g_plugins_default
set confname "$CONFDIR/plugins.conf"
if { [catch { set f [open $confname r] } ] } {
puts "Creating a default $confname"
unset g_plugins
array set g_plugins [array get g_plugins_default]
writePluginsConf
return
}
array unset g_plugins
while { [ gets $f line ] >= 0 } {
if { [string range $line 0 0] == "#" } { continue } ;# skip comments
set l [split $line ,] ;# parse fields separated by commas
set plugin [lindex $l 0]
set plugin_data [lindex $l 1]
# update legacy daemon names - may be removed in the future
if { $plugin == {"cored.py"} || $plugin == {"cored"} } {
set plugin {"core-daemon"}
}
if { $plugin == "" } { continue } ;# blank name
# special entry: GUI (entry for this program) cannot be modified
if { $plugin == "GUI" || $plugin == {"GUI"} } {
set plugin_data $g_plugins_default($plugin)
} else {
set plugin_data [lreplace $plugin_data 4 4 0]; # force status=0
set plugin_data [lreplace $plugin_data 6 6 -1]; # force sock=-1
}
# load into array of plugins
if { [catch {array set g_plugins [list $plugin $plugin_data]} e] } {
puts "Error reading plugin line '$plugin': $e"
}
}
close $f
}
#
# Write the plugins.conf file from the g_plugins array.
#
proc writePluginsConf { } {
global CONFDIR g_plugins
set confname "$CONFDIR/plugins.conf"
if { [catch { set f [open "$confname" w] } ] } {
puts "***Warning: could not write plugins file: $confname"
return
}
set header "# plugins.conf: CORE Plugins customization file."
puts $f $header
foreach plugin [lsort -dictionary [array names g_plugins]] {
set plugin_data $g_plugins($plugin)
set plugin_data [lreplace $plugin_data 4 4 0]; # force status=0
set plugin_data [lreplace $plugin_data 6 6 -1]; # force sock=-1
puts $f "$plugin, $plugin_data"
}
close $f
}
#
# Perform capability initialization when a plugin capability has been configured
# for a node. This is called during node instantiation.
#
proc pluginCapsInitialize { node config_name } {
global eid ngnodeidmap
set active_caps [getCapabilities $node $config_name]
foreach cap $active_caps {
set plugin_sock [pluginChannelByCap $cap]
set plugin [lindex $plugin_sock 0]
set sock [lindex $plugin_sock 1]
if { $sock == "" || $sock == -1 } {
puts "Warning: plugin $plugin with capability $cap is not connected"
continue
}
# update any config
# this updates a custom config that may have been loaded from a file
set customcfg [getCapabilityConfig $node $cap]
if { $customcfg != "" } { ;# push existing config
set vals [lindex [lindex $customcfg 2] 1]
set types [lindex [lindex $customcfg 1] 1]
if { [string is digit [lindex $types 0]] } {;# protect against
# older conf -- remove in the future
sendConfReplyMessage $sock $node $cap $types $vals ""
}
}
# update ID mapping
# this is required to associate a model with a node when the
# configure button has not been pressed yet (i.e. customcfg == "")
sendConfRequestMessage $sock $node $cap 0x2 -1 ""
# for link-layer nodes, find capability config on connected interfaces
if { [[typemodel $node].layer] == "LINK" } {
foreach ifc [ifcList $node] {
set peer [peerByIfc $node $ifc]
set ifccfg [getCapabilityConfig $peer $cap]
if { $ifccfg == "" } { continue }
set vals [lindex [lindex $ifccfg 2] 1]
set types [lindex [lindex $ifccfg 1] 1]
sendConfReplyMessage $sock $peer $cap $types $vals ""
}
# send global EMANE options if configured for WLANs
set emanecfg [getCapabilityConfig $node "emane"]
if { $emanecfg != "" } { ;# push existing config
set vals [lindex [lindex $emanecfg 2] 1]
set types [lindex [lindex $emanecfg 1] 1]
sendConfReplyMessage $sock -1 "emane" $types $vals ""
}
}
} ;# end foreach cap
}
#
# Perform capability de-initialization. This is called during node destruction.
#
proc pluginCapsDeinitialize { node config_name } {
global eid ngnodeidmap
set socks {}
# Get a list of active plugin sockets
set active_caps [getCapabilities $node $config_name]
foreach cap $active_caps {
set plugin_sock [pluginChannelByCap $cap]
set sock [lindex $plugin_sock 1]
if { $sock == "" || $sock == -1 } {
continue
}
if { [lsearch -exact $socks $sock] == -1 } {
lappend socks $sock
}
}
# Send config message with reset flag to flush the plugin.
foreach sock $socks {
sendConfRequestMessage $sock $node "all" 0x3 -1 ""
}
}
# empty the session config array when loading a new scenario
proc resetSessionOptions {} {
global g_session_options
array unset g_session_options
array set g_session_options ""
}
# apply button pressed for session config (types is currently unused)
proc setSessionOptions { types vals } {
global g_session_options
foreach kv $vals {
set kvs [splitKeyValue $kv]
if {[llength $kvs] < 2} {
puts "error with session option: $kv"
continue
}
set key [string trim [lindex $kvs 0]]
set value [lindex $kvs 1]
array set g_session_options [list $key $value]
}
}
# return list of key=value pairs from the session options array
proc getSessionOptionsList {} {
global g_session_options
set values ""
foreach key [lsort [array names g_session_options]] {
set val [join [list $key $g_session_options($key)] =]
lappend values $val ;# append key=value
}
return $values
}
proc getSessionOption { key defaultval } {
set opts [getSessionOptionsList]
return [getKeyValue $key $opts $defaultval]
}
proc setSessionOption { key value notify } {
global g_session_options
array set g_session_options [list $key $value]
if { $notify } { sendSessionOptions -1 }
}
# split value input whether it has 'key=value' format or just 'value'
# return a list of the key (if any) and value.
proc splitKeyValue { keyvalue } {
set key ""
set value ""
set kv [split $keyvalue =]
if { [llength $kv] > 1 } { ;# "key=value" format
set key [lindex $kv 0]
set value [join [lrange $kv 1 end] =]
} else { ;# "value" format
set value $keyvalue
}
return [list $key $value]
}
# extract a value from cfg matching the given key, or return supplied default
proc getKeyValue { key cfg defaultval } {
set i [lsearch $cfg "$key=*"]
if {$i < 0 } { ;# key not present in cfg
return $defaultval
} else { ;# key found in cfg
set kv [splitKeyValue [lindex $cfg $i]]
return [lindex $kv 1]
}
}
# returns true if the supplied values list contains "key=value" strings
proc hasKeyValues { values } {
if { $values == "" } { return false }
foreach v $values {
if { [string first = $v 1] < 0 } { ;# look for '=' separator
return false
}
}
return true
}
# turn list of "key value key value..." into list of "key=value key=value..."
proc listToKeyValues { keyvalues } {
set r ""
set key ""
foreach item $keyvalues {
if { $key == "" } {
set key $item
} else {
set value $item
lappend r "$key=$value"
set key ""
}
}
return $r
}
# parse command-line parameters for address/port to connect with
proc checkCommandLineAddressPort {} {
global argv g_plugins
set addr ""; set port ""
set addri [lsearch -regexp $argv "(^\[-\]\[-\]address$|^\[-\]a$)"]
#set addri [lsearch -exact $argv "--address"]
if { $addri > -1 } {
set argv [lreplace $argv $addri $addri]
set addr [lindex $argv $addri]
if { ![checkIPv4Addr $addr] } {
puts "error: invalid address '$addr'"; exit;
}
set argv [lreplace $argv $addri $addri]
}
#set porti [lsearch -exact $argv "--port"]
set porti [lsearch -regexp $argv "(^\[-\]\[-\]port$|^\[-\]p$)"]
if { $porti > -1 } {
set argv [lreplace $argv $porti $porti]
set port [lindex $argv $porti]
if { $port == "" || ![string is integer $port] || $port > 65535 } {
puts "error: invalid port '$port'"; exit;
}
set argv [lreplace $argv $porti $porti]
}
# update the auto-connect plugin (core-daemon entry)
if { $addri > -1 || $porti > -1 } {
set key [lindex [getEmulPlugin "*"] 0]
set plugin_data $g_plugins($key)
if { $addri > -1 } { set plugin_data [lreplace $plugin_data 0 0 $addr] }
if { $porti > -1 } { set plugin_data [lreplace $plugin_data 1 1 $port] }
array set g_plugins [list $key $plugin_data]
}
}