# # 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 <> "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 \ "popupPluginsCapConfigHelper $wi down $wlan" bind $wi.avail.plugins \ "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 $cancel_cmd bind $wi $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 $apply_cmd bind $wi $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 $conn_cmd bind $wi $close_cmd bind $wi.tree <> "sessionConfigSelect $wi {$thumbs}" bind $wi.tree "$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 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] } }