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} {
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
return $startup
}
running - running-config - running-configuration {
return $running
}
}
}
proc configure {args} {
set argd [punk::args::get_dict {
whichconfig -type string -choices {startup running}
} $args]
}
proc show {whichconfig} {
#todo - tables for console
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
return [punk::lib::showdict $startup]
}
running - running-config - running-configuration {
return [punk::lib::showdict $running]
}
}
}
#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
}]