Version 7 of Matthias Hoffmann - Tcl-Code-Snippets - Misc - Readprof

Updated 2007-06-28 11:29:48 by hoffi

The following needs translation and documentation ;-)

I use this module to read in program options which change not so often. The general mechanism is: The configuration file, called profile, consists of one or more lines in the format keyword value. Which profile to use and which keywords are valid and how the defaults are, is specified at runtime when calling readprof::readprof1. keywords are implemented as commands/procs in a safe-slave-interpreter. All other commands are not available for security reasons. By default, values can contain strings linke %this%. %this% references an environment var named this and is replaced with it's content. To suppress these, readprof1 must be called with 0 as the last arg.


 ###################################################################################
 # Modul    : readprof1.3.tcl                                                      #
 # Stand    : 27.06.2007                                                           #
 # Zweck    : Einlesen einer Konfigurationsdatei über einen sicheren Slave-Inter-  #
 #            preter (SandBox); Rückgabe der Schlüssel/Werte als Liste             #
 # Autor    : M.Hoffmann                                                           #
 # Weiteres : Für diverse Pakete erforderlich (FehlerDB, SW-Lib, ToDo, MsgPop32).  #
 # Historie :                                                                      #
 # 18.10.03 v1.0: erste Version                                                    #
 # 12.10.04 v1.1: wahlweise Variablenersetzung (Vorsicht: standardmässig AN);      #
 # 13.10.04        neue Prozeduren ::repenv und ::envvar; Bugfixes.                #
 # 12.11.05 v1.2: Bugfix: _errorMsg war ungleich "", obwohl alles ok               #
 # 27.06.07 v1.3: Angabe MEHRERER PROFILE möglich; Abarbeitung in Reihenfolge      #
 ###################################################################################

 package provide readprof 1.3
 namespace eval readprof {}

 #----------------------------------------------------------------------------------
 # prof - Dateiname für 'auszuführende' Konfigdatei
 # cmds - In der Konfigdatei erlaubte 'Kommandos' als Liste aus je {cmdName defVal}
 # Rück - cmdName Value cmdName Value [...] _errorMsg <rc> (wenn <rc> leer, ok)
 #
 proc readprof::readprof1 {prof cmds {substEnv 1}} {
      catch {
         set id [interp create -safe]; # Safe-Interpreter anlegen und absichern!
         interp eval $id {
                foreach cmd [info commands] {
                        if {$cmd != {rename} && $cmd != {if}} {
                           rename $cmd {}
                        }
                }
                rename if {}; rename rename {}
         }
         # Defaults im Array ablegen (Fehler bei 'falschen' cmds=ArrayKeys denkbar!)
         array set temp $cmds
         # indirektes Setzen über Proc, da SET nicht mehrere args verträgt
         proc set$id {key args} {
              upvar 1 temp     myArr
              upvar 1 substEnv sEnv
              set myArr($key) [join $args]
              if {$sEnv} {
                 # v1.1: auf Wunsch %EnvVar%s auflösen
                 set myArr($key) [readprof::repenv $myArr($key)]
              }
         }
         # Aliasnamen im Slave einrichten und auf setproc mappen
         foreach {cmd default} $cmds {
                 interp alias $id $cmd {} readprof::set$id $cmd; # arg [...]
         }
         # `Ausführen` der Konfigdatei(en)
         # Einzeln CATCHen, damit nicht eine kaputte Datei das Parsen aller verhindert
         foreach prf $prof {
                 catch {$id invokehidden source $prf}
         }
         set rc ""; # v1.2
      } rc
      catch {
         # Bugfix v1.1: IMMER aufräumen, auch nach Abbruch! D.h. extra CATCHen:
         interp delete $id
         rename set$id {}
      }
      # durch folgende Anweisung ist `temp` in jedem Falle definiert!
      set temp(_errorMsg) $rc; # Profname,-Datum,-Grösse;_errorRc usw. denkbar!
      return [array get temp]
 }

 #----------------------------------------------------------------------------------
 # Holt eine EINZELNE VARIABLE aus der Umgebung (wird INTERN benutzt). Gibt es die
 # Variable nicht, wird gemaess DOS/Windows-Verhalten ein LEERSTRING zurückgegeben.
 # envvar - Umgebungsvariablen-Name.
 # Rück   - Wert.
 #
 proc readprof::envvar {var} {
      set var [string trim $var %]; # eigentlich nur ein % vorn und hinten!
      if {[info exists ::env($var)]} {
         return $::env($var)
      } else {
         return ""
      }
 }

 #----------------------------------------------------------------------------------
 # Ersetzt in einer Zeichenkette %Vars% durch Werte (wird ggf. von readprof benutzt,
 # kann aber auch unabhängig von jedem externen Programm genutzt werden)
 # args - Zeichenkette, die %Variablen%-Referenzen enthalten kann
 # Rück - Zeichenkette mit aufgelösten Variablen-Referenzen; existiert eine %Var%
 #         nicht, wird sie durch Leerstring ersetzt (entspricht OS-.BATch-Logik)
 # ACHTUNG: Wegen subst-Erfordernis (regsub ersetzt nur eine Ebene) prinzipiell
 #  unsicher, daher über safe-Slave!
 #
 proc readprof::repenv {args} {
      set id [interp create -safe]; # Safe-Interpreter anlegen und absichern!
      interp eval $id {
             foreach cmd [info commands] {
                     if {$cmd != {rename} && $cmd != {if} && $cmd != {subst}} {
                        rename $cmd {}
                     }
             }
             rename if {}; rename rename {}
      }
      interp hide  $id subst; # auch subst selbst von aussen verstecken!
      interp alias $id __env {} readprof::envvar; # Umweg zum Lesen von env, denn
      # subSpec {$::env([string trim "&" %])} geht nicht, da im Slave kein env()!
      # Achtung: exp berücksichtigt nicht den denkbaren Sonderfall env(%name%)!
      regsub -nocase -all {%[^ %]{1}[^%]*%} $args {[__env &]} tmp
      # catch {$id invokehidden [list subst $tmp]} tmp; # neu: CATCH!
      catch {$id invokehidden subst -nobackslashes -novariables $tmp} tmp; # neu: CATCH!
      interp delete $id
      return $tmp
 }

 #==================================================================================

Testroutine

 lappend auto_path .
 package require readprof



 array set settings [readprof::readprof1 $argv {
     test1 default1
     test2 default2
     test3 default3
 }]

 # [Kommandos] werden schon VOR dem Aufruf ausgewertet!
 set env(%fies%) "varname mit Prozenten"
 puts [readprof::repenv Dies ist Appdata: '%appdata%']
 puts [readprof::repenv Dies ist Appdata: '%appdata%' und das fiese: '%%fies%%']
 # Test: Einschmuggeln eines Kommandos (das einzig erlaubte):
 puts [readprof::repenv {Dies ist Appdata: '%appdata%' oder so: '[__env appdata]'}]
 # Test: Einschmuggeln eines Kommandos (ein andres):
 puts [readprof::repenv {Dies ist Appdata: '%appdata%' oder so: '[subst abcde]'}]
 # puts [readprof::repenv {Dies ist Appdata: '%appdata%' oder so: '[info commands]'}]
 puts ***********
 parray settings

Test .RC-File

 test1 Dies ist der Pfad: '%path%'
 test3 Dies '%appdata%' ist falsch: '%falsch%'
 test2 Ist dies möglich?: '*[info globals]*' Nein!

Example:

 package require readprof
 # preparing the available profile commands and defaults of a hypothetical profile
 array set info {
           tempDir      d:/temp
           runIntervall 5000
           notify       [email protected]
 }
 # reading the profile
 array set info [readprof::readprof1 profile.rc [array get info]]
 parray info; # will now return:

 tempDir -> c:/temp
 runIntervall -> 2000
 notify [email protected]

simple profile-file profile.rc

 tempDir c:/temp
 runIntervall 2000

Category File