tcl::namespace::eval punk::config { variable configdata [dict create] ;#key on config names. At least default, startup, running #variable startup ;#include env overrides #variable running variable punk_env_vars variable other_env_vars variable vars namespace export {[a-z]*} namespace ensemble create namespace eval punk {namespace export config} proc _homedir {} { if {[info exists ::env(HOME)]} { set home [file normalize $::env(HOME)] } else { #not available on 8.6? ok will error out here. set home [file tildeexpand ~] } return $home } lappend PUNKARGS [list { @id -id ::punk::config::dir @cmd -name punk::config::dir -help\ "Get the path for the default config folder Config files are in toml format. The XDG_CONFIG_HOME env var is the preferred choice of location. A folder under the user's home directory, at .config/punk/shell is chosen if XDG_CONFIG_HOME is not configured. " @leaders -min 0 -max 0 @opts -quiet -type none -help\ "Suppress warning given when the folder does not yet exist" @values -min 0 -max 0 }] proc dir {args} { if {"-quiet" in $args} { set be_quiet [dict exists $received -quiet] } set was_noisy 0 set config_home [punk::config::configure running xdg_config_home] set config_dir [file join $config_home punk shell] if {!$be_quiet && ![file exists $config_dir]} { set msg "punk::shell data storage folder at $config_dir does not yet exist." puts stderr $msg set was_noisy 1 } if {!$be_quiet && $was_noisy} { puts stderr "punk::config::dir - call with -quiet option to suppress these messages" } return $config_dir #if {[info exists ::env(XDG_CONFIG_HOME)]} { # set config_home $::env(XDG_CONFIG_HOME) #} else { # set config_home [file join [_homedir] .config] # if {!$be_quiet} { # puts stderr "Environment variable XDG_CONFIG_HOME does not exist - consider setting it if $config_home is not a suitable location" # set was_noisy 1 # } #} #if {!$be_quiet && ![file exists $config_home]} { # #parent folder for 'punk' config dir doesn't exist # set msg "configuration location (XDG_CONFIG_HOME or ~/.config) $config_home does not yet exist" # append msg \n " - please create it and/or set XDG_CONFIG_HOME env var." # puts stderr $msg # set was_noisy 1 #} #set config_dir [file join $config_home punk shell] #if {!$be_quiet && ![file exists $config_dir]} { # set msg "punk::shell data storage folder at $config_dir does not yet exist." # append msg \n " It will be created if api_context_save is called without specifying an alternate location." # puts stderr $msg # set was_noisy 1 #} #if {!$be_quiet && $was_noisy} { # puts stderr "punk::config::dir - call with -quiet option to suppress these messages" #} #return [file join $configdir config.toml] } #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 configdata #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] ;#~2ms #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_ #The counterpart: default_color__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)]} { #Typical existing/default value for env(APPDATA) on windows is c:\Users\\AppData\Roaming set default_xdg_config_home $::env(APPDATA) } #The xdg_cache_home should be kept local if {[info exists ::env(LOCALAPPDATA)]} { #Typical existing/default value for env(APPDATA) on windows is c:\Users\\AppData\Local set default_xdg_data_home $::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 } } dict set configdata defaults [dict create\ apps $default_apps\ config "startup"\ configset "main"\ 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 ""\ ] dict set configdata startup [dict get $configdata 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 configdata startup $varname $final } else { tcl::dict::set configdata 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 configdata startup $varname $final } else { tcl::dict::set configdata startup $varname $f } } } } set config_home [dict get $configdata startup xdg_config_home] if {![file exists $config_home]} { puts stderr "punk::config::init creating punk shell config dir: $config_home" if {[catch {file mkdir $config_home} errM]} { puts stderr "punk::config::init failed to create dir at $config_home\n$errM" } } set configset [dict get $configdata defaults configset] set config [dict get $configdata defaults config] set startupfile [file join $config_home $configset $config.toml] if {![file exists $startupfile]} { puts stderr "punk::config::init creating punk shell config file: $config for configset: $configset" puts stderr "(todo)" } #unset -nocomplain vars #todo set running [tcl::dict::create] dict set configdata running [tcl::dict::merge $running [dict get $configdata startup]] } #todo proc Apply {config} { variable configdata puts stderr "punk::config::Apply partially implemented" set configname [string map {-config ""} $config] if {$configname in {startup running}} { set applyconfig [dict get $configdata $configname] 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" } #todo - consider how to divide up settings, categories, 'devices', decks etc proc get_running_global {varname} { variable configdata set running [dict get $configdata 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 configdata set startup [dict get $configdata startup] if {[dict exists $startup $varname]} { return [dict get $startup $varname] } error "No such global configuration item '$varname' found in startup config" } lappend PUNKARGS [list { @id -id ::punk::config::get @cmd -name punk::config::get -help\ "Get configuration values from a config. Accepts globs eg XDG*" @leaders -min 1 -max 1 whichconfig -type string -choices {config startup-configuration running-configuration} @values -min 0 -max -1 globkey -type string -default * -optional 1 -multiple 1 }] proc get {args} { set argd [punk::args::parse $args withid ::punk::config::get] lassign [dict values $argd] leaders opts values received solos set whichconfig [dict get $leaders whichconfig] set globs [dict get $values globkey] ;#list variable configdata switch -- $whichconfig { config - startup-configuration { #review 'config' ?? #show *startup* config - different behaviour may be confusing to those used to router startup and running configs set configrecords [dict get $configdata startup] } running-configuration { set configrecords [dict get $configdata running] } default { error "Unknown config name '$whichconfig' - try startup or running" } } if {"*" in $globs} { return $configrecords } else { set keys [list] foreach g $globs { lappend keys {*}[dict keys $configrecords [string tolower $g]] ;#review tolower? } set filtered [dict create] foreach k $keys { dict set filtered $k [dict get $configrecords $k] } return $filtered } } lappend PUNKARGS [list { @id -id ::punk::config::configure @cmd -name punk::config::configure -help\ "Get/set configuration values from a config" @leaders -min 1 -max 1 whichconfig -type string -choices {defaults startup-configuration running-configuration} @values -min 0 -max 2 key -type string -optional 1 newvalue -optional 1 }] proc configure {args} { set argd [punk::args::parse $args withid ::punk::config::configure] lassign [dict values $argd] leaders opts values received solos set whichconfig [dict get $argd leaders whichconfig] variable configdata if {"running" ni [dict keys $configdata]} { init Apply startup } switch -- $whichconfig { defaults { set configrecords [dict get $configdata defaults] } startup-configuration { set configrecords [dict get $configdata startup] } running-configuration { set configrecords [dict get $configdata running] } } if {![dict exists $received key]} { return $configrecords } set key [dict get $values key] if {![dict exists $received newvalue]} { return [dict get $configrecords $key] } error "setting value not implemented" } lappend PUNKARGS [list { @dynamic @id -id ::punk::config::show @cmd -name punk::config::get -help\ "Display configuration values from a config. Accepts globs eg XDG*" @leaders -min 1 -max 1 }\ {${[punk::args::resolved_def -types leaders ::punk::config::get]}}\ "@values -min 0 -max -1"\ {${[punk::args::resolved_def -types values ::punk::config::get]}}\ ] proc show {args} { #todo - tables for console set configrecords [punk::config::get {*}$args] return [punk::lib::showdict $configrecords] } #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 argdef { @id -id ::punk::config::copy @cmd -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)" } set argd [punk::args::get_dict $argdef $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 configdata #variable running #variable startup if {![string length $onoff]} { return [list stdout [dict get $configdata running color_stdout] stderr [dict get $configdata 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 configdata running color_stdout [dict get $startup color_stdout] dict set configdata running color_stderr [dict get $startup color_stderr] } else { dict set configdata running color_stdout "" dict set configdata running color_stderr "" } } return [list stdout [dict get $configdata running color_stdout] stderr [dict get $configdata running color_stderr]] } } namespace eval ::punk::args::register { #use fully qualified so 8.6 doesn't find existing var in global namespace lappend ::punk::args::register::NAMESPACES ::punk::config } package provide punk::config [tcl::namespace::eval punk::config { variable version set version 0.1 }]