You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
476 lines
23 KiB
476 lines
23 KiB
|
|
tcl::namespace::eval punk::config { |
|
variable loaded |
|
variable startup ;#include env overrides |
|
variable running |
|
variable punk_env_vars |
|
variable other_env_vars |
|
|
|
variable vars |
|
|
|
namespace export {[a-z]*} |
|
|
|
#todo - XDG_DATA_HOME etc |
|
#https://specifications.freedesktop.org/basedir-spec/latest/ |
|
# see also: http://hiphish.github.io/blog/2020/08/30/dotfiles-were-a-mistake/ |
|
|
|
proc init {} { |
|
variable defaults |
|
variable startup |
|
variable running |
|
variable punk_env_vars |
|
variable punk_env_vars_config |
|
variable other_env_vars |
|
variable other_env_vars_config |
|
|
|
set exename "" |
|
catch { |
|
#catch for safe interps |
|
#safe base will return empty string, ordinary safe interp will raise error |
|
set exename [tcl::info::nameofexecutable] |
|
} |
|
if {$exename ne ""} { |
|
set exefolder [file dirname $exename] |
|
#default file logs to logs folder at same level as exe if writable, or empty string |
|
set log_folder [file normalize $exefolder/../logs] |
|
#tcl::dict::set startup scriptlib $exefolder/scriptlib |
|
#tcl::dict::set startup apps $exefolder/../../punkapps |
|
|
|
#todo - use punk main.tcl location instead - exefolder doesn't work if system tclsh used etc |
|
set default_scriptlib $exefolder/scriptlib |
|
set default_apps $exefolder/../../punkapps |
|
if {[file isdirectory $log_folder] && [file writable $log_folder]} { |
|
#tcl::dict::set startup logfile_stdout $log_folder/repl-exec-stdout.txt |
|
#tcl::dict::set startup logfile_stderr $log_folder/repl-exec-stderr.txt |
|
set default_logfile_stdout $log_folder/repl-exec-stdout.txt |
|
set default_logfile_stderr $log_folder/repl-exec-stderr.txt |
|
} else { |
|
set default_logfile_stdout "" |
|
set default_logfile_stderr "" |
|
} |
|
} else { |
|
#probably a safe interp - which cannot access info nameofexecutable even if access given to the location via punk::island |
|
#review - todo? |
|
#tcl::dict::set startup scriptlib "" |
|
#tcl::dict::set startup apps "" |
|
set default_scriptlib "" |
|
set default_apps "" |
|
set default_logfile_stdout "" |
|
set default_logfile_stderr "" |
|
} |
|
|
|
# auto_exec_mechanism ;#whether to use exec instead of experimental shellfilter::run |
|
|
|
#optional channel transforms on stdout/stderr. |
|
#can sometimes be useful to distinguish eventloop stdout/stderr writes compared to those triggered directly from repl commands |
|
#If no distinction necessary - should use default_color_<chan> |
|
#The counterpart: default_color_<chan>_repl is a transform that is added and removed with each repl evaluation. |
|
#startup color_stdout - parameters as suitable for punk::ansi::a+ (test with 'punk::ansi::a?') e.g "cyan bold" ;#not a good idea to default |
|
set default_color_stdout brightwhite ;#stdout colour including background calls (after etc) |
|
set default_color_stdout_repl "" ;#stdout colour applied during direct repl call only |
|
#This wraps the stderr stream as it comes in with Ansi - probably best to default to empty.. but it's useful. |
|
#set default_color_stderr "red bold" |
|
#set default_color_stderr "web-lightsalmon" |
|
set default_color_stderr yellow ;#limit to basic colours for wider terminal support. yellow = term-olive |
|
set default_color_stderr_repl "" ;#during repl call only |
|
|
|
set homedir "" |
|
if {[catch { |
|
#depending on which build of tcl - some safe interps prior to bugfix https://core.tcl-lang.org/tcl/info/3aa487993f will return a homedir value in an unmodified safe interp |
|
#other 'safe' interps may have explicitly made this available - we shouldn't override that decision here using interp issafe so we can't compensate for versions which shouldn't really be returning this in the safe interp |
|
set homedir [file home] |
|
} errM]} { |
|
#tcl 8.6 doesn't have file home.. try again |
|
if {[info exists ::env(HOME)]} { |
|
set homedir $::env(HOME) |
|
} |
|
} |
|
|
|
|
|
# per user xdg vars |
|
# --- |
|
set default_xdg_config_home "" ;#config data - portable |
|
set default_xdg_data_home "" ;#data the user likely to want to be portable |
|
set default_xdg_cache_home "" ;#local cache |
|
set default_xdg_state_home "" ;#persistent user data such as logs, but not as important or as portable as those in xdg_data_home |
|
# --- |
|
set default_xdg_data_dirs "" ;#non-user specific |
|
#xdg_config_dirs ? |
|
#xdg_runtime_dir ? |
|
|
|
|
|
#review. we are assuming if we can't get a home dir - then all the xdg vars including xdg_data_dirs aren't likely to be useful (as presumably filesystem access is absent) |
|
#(safe interp generally won't have access to ::env either) |
|
#This coupling doesn't necessarily hold - its possible the relevant env vars were copied to a safe interp - although that would be a policy that would make disabling 'info home' inconsistent. |
|
if {$homedir ne ""} { |
|
if {"windows" eq $::tcl_platform(platform)} { |
|
#as much as I'd prefer to use ~/.local/share and ~/.config to keep them more consistent with unixlike platforms - the vast majority of apps put them where microsoft wants them. |
|
#we have a choice of LOCALAPPDATA vs APPDATA (local to machine vs potentially roaming/redirected in a corporate environment) |
|
#using the roaming location should not impact users who aren't using a domain controller but is potentially much more convenient for those who do. |
|
if {[info exists ::env(APPDATA)]} { |
|
set default_xdg_config_home $::env(APPDATA) |
|
set default_xdg_data_home $::env(APPDATA) |
|
} |
|
|
|
#The xdg_cache_home should be kept local |
|
if {[info exists ::env(LOCALAPPDATA)]} { |
|
set default_xdg_cache_home $::env(LOCALAPPDATA) |
|
set default_xdg_state_home $::env(LOCALAPPDATA) |
|
} |
|
|
|
if {[info exists ::env(PROGRAMDATA)]} { |
|
#- equiv env(ALLUSERSPROFILE) ? |
|
set default_xdg_data_dirs $::env(PROGRAMDATA) |
|
} |
|
|
|
} else { |
|
#follow defaults as specified on freedesktop.org e.g https://specifications.freedesktop.org/basedir-spec/latest/ar01s03.html |
|
set default_xdg_config_home [file join $homedir .config] |
|
set default_xdg_data_home [file join $homedir .local share] |
|
set default_xdg_cache_home [file join $homedir .cache] |
|
set default_xdg_state_home [file join $homedir .local state] |
|
set default_xdg_data_dirs /usr/local/share |
|
} |
|
} |
|
|
|
set defaults [dict create\ |
|
apps $default_apps\ |
|
config ""\ |
|
configset ".punkshell"\ |
|
scriptlib $default_scriptlib\ |
|
color_stdout $default_color_stdout\ |
|
color_stdout_repl $default_color_stdout_repl\ |
|
color_stderr $default_color_stderr\ |
|
color_stderr_repl $default_color_stderr_repl\ |
|
logfile_stdout $default_logfile_stdout\ |
|
logfile_stderr $default_logfile_stderr\ |
|
logfile_active 0\ |
|
syslog_stdout "127.0.0.1:514"\ |
|
syslog_stderr "127.0.0.1:514"\ |
|
syslog_active 0\ |
|
auto_exec_mechanism exec\ |
|
auto_noexec 0\ |
|
xdg_config_home $default_xdg_config_home\ |
|
xdg_data_home $default_xdg_data_home\ |
|
xdg_cache_home $default_xdg_cache_home\ |
|
xdg_state_home $default_xdg_state_home\ |
|
xdg_data_dirs $default_xdg_data_dirs\ |
|
theme_posh_override ""\ |
|
posh_theme ""\ |
|
posh_themes_path ""\ |
|
] |
|
|
|
set startup $defaults |
|
#load values from saved config file - $xdg_config_home/punk/punk.config ? |
|
#typically we want env vars to override the stored config - as env vars conventionally used on some commandlines. |
|
#that's possibly ok for the PUNK_ vars |
|
#however.. others like the xdg vars and NOCOLOR may apply to other apps.. and we may want to override them from the saved config? |
|
#making some env vars override saved config values and some not would be potentially confusing. may need one/more specific settings or env vars to determine which takes precedence? |
|
#simpler is probably just to let env vars take precedence - and warn when saving or viewing config that the saved values are being overridden |
|
#- requiring user to manually unset any unwanted env vars when launching? |
|
|
|
#we are likely to want the saved configs for subshells/decks to override them however. |
|
|
|
#todo - load/save config file |
|
|
|
#todo - define which configvars are settable in env |
|
#list of varname varinfo where varinfo is a sub dictionary (type key is mandatory, with value from: string,pathlist,boolean) |
|
set punk_env_vars_config [dict create \ |
|
PUNK_APPS {type pathlist}\ |
|
PUNK_CONFIG {type string}\ |
|
PUNK_CONFIGSET {type string}\ |
|
PUNK_SCRIPTLIB {type string}\ |
|
PUNK_AUTO_EXEC_MECHANISM {type string}\ |
|
PUNK_AUTO_NOEXEC {type string default 0 help "set 1 to set Tcl's ::auto_noexec true.\nStops 'unknown' from running external programs"}\ |
|
PUNK_COLOR_STDERR {type string help "stderr colour transform. Use 'punk::ansi::a?' to see colour names"}\ |
|
PUNK_COLOR_STDERR_REPL {type string help "stderr colour transform only while command running (not active during 'after')"}\ |
|
PUNK_COLOR_STDOUT {type string help "stdout colour transform. Use 'punk::ansi::a?' to see colour names"}\ |
|
PUNK_COLOR_STDOUT_REPL {type string help "stdout colour transform only while command running (not active during 'after')"}\ |
|
PUNK_LOGFILE_STDOUT {type string}\ |
|
PUNK_LOGFILE_STDERR {type string}\ |
|
PUNK_LOGFILE_ACTIVE {type string}\ |
|
PUNK_SYSLOG_STDOUT {type string}\ |
|
PUNK_SYSLOG_STDERR {type string}\ |
|
PUNK_SYSLOG_ACTIVE {type string}\ |
|
PUNK_THEME_POSH_OVERRIDE {type string}\ |
|
] |
|
set punk_env_vars [dict keys $punk_env_vars_config] |
|
|
|
#override with env vars if set |
|
foreach {evar varinfo} $punk_env_vars_config { |
|
if {[info exists ::env($evar)]} { |
|
set vartype [dict get $varinfo type] |
|
set f [set ::env($evar)] |
|
if {$f ne "default"} { |
|
#e.g PUNK_SCRIPTLIB -> scriptlib |
|
set varname [tcl::string::tolower [tcl::string::range $evar 5 end]] |
|
if {$vartype eq "pathlist"} { |
|
#colon vs semicolon path sep is problematic for windows environments where unix-like systems such as cygwin/wsl are used and a variable may be set for either the native path separator or the unix-like system |
|
#Even without the colon vs semicolon issue, native vs unix-like paths on windows mixed environment systems can cause grief. |
|
#For now at least, we will simply respect the platform pathSeparator and hope the user manages the environment variables appropriately. |
|
#some programs do automatic translation - which is a nice idea in principle - but is also prone to error as we don't know if it's already occurred or not depending on how things are launched. |
|
#An example of where this sort of thing can go wrong is env(TCLLIBPATH) - which is defined as a space separated list not requiring further splitting |
|
# - but some programs have been known to split this value on colon anyway, which breaks things on windows. |
|
set paths [split $f $::tcl_platform(pathSeparator)] |
|
set final [list] |
|
#eliminate empty values (leading or trailing or extraneous separators) |
|
foreach p $paths { |
|
if {[tcl::string::trim $p] ne ""} { |
|
lappend final $p |
|
} |
|
} |
|
tcl::dict::set startup $varname $final |
|
} else { |
|
tcl::dict::set startup $varname $f |
|
} |
|
} |
|
} |
|
} |
|
|
|
# https://no-color.org |
|
#if {[info exists ::env(NO_COLOR)]} { |
|
# if {$::env(NO_COLOR) ne ""} { |
|
# set colour_disabled 1 |
|
# } |
|
#} |
|
set other_env_vars_config [dict create\ |
|
NO_COLOR {type string}\ |
|
XDG_CONFIG_HOME {type string}\ |
|
XDG_DATA_HOME {type string}\ |
|
XDG_CACHE_HOME {type string}\ |
|
XDG_STATE_HOME {type string}\ |
|
XDG_DATA_DIRS {type pathlist}\ |
|
POSH_THEME {type string}\ |
|
POSH_THEMES_PATH {type string}\ |
|
TCLLIBPATH {type string}\ |
|
] |
|
lassign [split [info tclversion] .] tclmajorv tclminorv |
|
#don't rely on lseq or punk::lib for now.. |
|
set relevant_minors [list] |
|
for {set i 0} {$i <= $tclminorv} {incr i} { |
|
lappend relevant_minors $i |
|
} |
|
foreach minor $relevant_minors { |
|
set vname TCL${tclmajorv}_${minor}_TM_PATH |
|
if {$minor eq $tclminorv || [info exists ::env($vname)]} { |
|
dict set other_env_vars_config $vname {type string} |
|
} |
|
} |
|
set other_env_vars [dict keys $other_env_vars_config] |
|
|
|
foreach {evar varinfo} $other_env_vars_config { |
|
if {[info exists ::env($evar)]} { |
|
set vartype [dict get $varinfo type] |
|
set f [set ::env($evar)] |
|
if {$f ne "default"} { |
|
set varname [tcl::string::tolower $evar] |
|
if {$vartype eq "pathlist"} { |
|
set paths [split $f $::tcl_platform(pathSeparator)] |
|
set final [list] |
|
#eliminate empty values (leading or trailing or extraneous separators) |
|
foreach p $paths { |
|
if {[tcl::string::trim $p] ne ""} { |
|
lappend final $p |
|
} |
|
} |
|
tcl::dict::set startup $varname $final |
|
} else { |
|
tcl::dict::set startup $varname $f |
|
} |
|
} |
|
} |
|
} |
|
|
|
|
|
#unset -nocomplain vars |
|
|
|
#todo |
|
set running [tcl::dict::create] |
|
set running [tcl::dict::merge $running $startup] |
|
} |
|
init |
|
|
|
#todo |
|
proc Apply {config} { |
|
puts stderr "punk::config::Apply partially implemented" |
|
set configname [string map {-config ""} $config] |
|
if {$configname in {startup running}} { |
|
upvar ::punk::config::$configname applyconfig |
|
|
|
if {[dict exists $applyconfig auto_noexec]} { |
|
set auto [dict get $applyconfig auto_noexec] |
|
if {![string is boolean -strict $auto]} { |
|
error "config::Apply error - invalid data for auto_noexec:'$auto' - expected boolean" |
|
} |
|
if {$auto} { |
|
set ::auto_noexec 1 |
|
} else { |
|
#puts "auto_noexec false" |
|
unset -nocomplain ::auto_noexec |
|
} |
|
} |
|
|
|
} else { |
|
error "no config named '$config' found" |
|
} |
|
return "apply done" |
|
} |
|
Apply startup |
|
|
|
#todo - consider how to divide up settings, categories, 'devices', decks etc |
|
proc get_running_global {varname} { |
|
variable running |
|
if {[dict exists $running $varname]} { |
|
return [dict get $running $varname] |
|
} |
|
error "No such global configuration item '$varname' found in running config" |
|
} |
|
proc get_startup_global {varname} { |
|
variable startup |
|
if {[dict exists $startup $varname]} { |
|
return [dict get $startup $varname] |
|
} |
|
error "No such global configuration item '$varname' found in startup config" |
|
} |
|
|
|
proc get {whichconfig {globfor *}} { |
|
variable startup |
|
variable running |
|
switch -- $whichconfig { |
|
config - startup - startup-config - startup-configuration { |
|
#show *startup* config - different behaviour may be confusing to those used to router startup and running configs |
|
set configdata $startup |
|
} |
|
running - running-config - running-configuration { |
|
set configdata $running |
|
} |
|
default { |
|
error "Unknown config name '$whichconfig' - try startup or running" |
|
} |
|
} |
|
if {$globfor eq "*"} { |
|
return $configdata |
|
} else { |
|
set keys [dict keys $configdata [string tolower $globfor]] |
|
set filtered [dict create] |
|
foreach k $keys { |
|
dict set filtered $k [dict get $configdata $k] |
|
} |
|
return $filtered |
|
} |
|
} |
|
|
|
proc configure {args} { |
|
set argd [punk::args::get_dict { |
|
*values -min 1 -max 1 |
|
whichconfig -type string -choices {startup running stop} |
|
} $args] |
|
|
|
return "unimplemented - $argd" |
|
} |
|
|
|
proc show {whichconfig {globfor *}} { |
|
#todo - tables for console |
|
set configdata [punk::config::get $whichconfig $globfor] |
|
return [punk::lib::showdict $configdata] |
|
} |
|
|
|
#e.g |
|
# copy running-config startup-config |
|
# copy startup-config test-config.cfg |
|
# copy backup-config.cfg running-config |
|
#review - consider the merge vs overwrite feature of some routers.. where copy to running-config does a merge rather than an overwrite |
|
#This is to allow partial configs to be loaded to running, whereas a save of running to any target is always a complete configuration |
|
proc copy {args} { |
|
set argd [punk::args::get_dict { |
|
*proc -name punk::config::copy -help "Copy a partial or full configuration from one config to another |
|
If a target config has additional settings, then the source config can be considered to be partial with regards to the target. |
|
" |
|
-type -default "" -choices {replace merge} -help "Defaults to merge when target is running-config |
|
Defaults to replace when source is running-config" |
|
*values -min 2 -max 2 |
|
fromconfig -help "running or startup or file name (not fully implemented)" |
|
toconfig -help "running or startup or file name (not fully implemented)" |
|
} $args] |
|
set fromconfig [dict get $argd values fromconfig] |
|
set toconfig [dict get $argd values toconfig] |
|
set fromconfig [string map {-config ""} $fromconfig] |
|
set toconfig [string map {-config ""} $toconfig] |
|
|
|
set copytype [dict get $argd opts -type] |
|
|
|
|
|
#todo - warn & prompt if doing merge copy to startup |
|
switch -exact -- $fromconfig-$toconfig { |
|
running-startup { |
|
if {$copytype eq ""} { |
|
set copytype replace ;#full configuration |
|
} |
|
if {$copytype eq "replace"} { |
|
error "punk::config::copy error. full configuration copy from running to startup config not yet supported" |
|
} else { |
|
error "punk::config::copy error. merge configuration copy from running to startup config not yet supported" |
|
} |
|
} |
|
startup-running { |
|
#default type merge - even though it's not always what is desired |
|
if {$copytype eq ""} { |
|
set copytype merge ;#load in a partial configuration |
|
} |
|
|
|
#warn/prompt either way |
|
if {$copytype eq "replace"} { |
|
#some routers require use of a separate command for this branch. |
|
#presumably to ensure the user doesn't accidentally load partials onto a running system |
|
# |
|
error "punk::config::copy error. full configuration copy from startup to overwrite running config not supported" |
|
} else { |
|
error "punk::config::copy error. merge copy from possibly partial configuration: startup to running config not currently supported" |
|
} |
|
} |
|
default { |
|
error "punk::config::copy error. copy must from running to startup or startup to running. File sources/targets not yet supported" |
|
} |
|
} |
|
} |
|
|
|
|
|
|
|
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
|
|
#todo - move to cli? |
|
::tcl::namespace::eval punk::config { |
|
#todo - something better - 'previous' rather than reverting to startup |
|
proc channelcolors {{onoff {}}} { |
|
variable running |
|
variable startup |
|
|
|
if {![string length $onoff]} { |
|
return [list stdout [dict get $running color_stdout] stderr [dict get $running color_stderr]] |
|
} else { |
|
if {![string is boolean $onoff]} { |
|
error "channelcolors: invalid value $onoff - expected boolean: true|false|on|off|1|0|yes|no" |
|
} |
|
if {$onoff} { |
|
dict set running color_stdout [dict get $startup color_stdout] |
|
dict set running color_stderr [dict get $startup color_stderr] |
|
} else { |
|
dict set running color_stdout "" |
|
dict set running color_stderr "" |
|
} |
|
} |
|
return [list stdout [dict get $running color_stdout] stderr [dict get $running color_stderr]] |
|
} |
|
} |
|
|
|
package provide punk::config [tcl::namespace::eval punk::config { |
|
variable version |
|
set version 0.1 |
|
|
|
}] |