@@ -183,12 +183,18 @@ #f) ;; (if (not ht)(make-hash-table) ht)) (let ((inp (open-input-file path)) (res (if (not ht)(make-hash-table) ht)) (metapath (if (or (debug:debug-mode 9) keep-filenames) - path #f))) - (let loop ((inl (configf:read-line inp res allow-system settings)) ;; (read-line inp)) + path #f)) + (calc-allow-system (lambda (allow-system section sections) + (if sections + (and (or (equal? "default" section) + (member section sections)) + allow-system) ;; account for sections and return allow-system as it might be a symbol such as return-strings + allow-system)))) + (let loop ((inl (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings)) ;; (read-line inp)) (curr-section-name (if curr-section curr-section "default")) (var-flag #f);; turn on for key-var-pr and cont-ln-rx, turn off elsewhere (lead #f)) (debug:print-info 8 "curr-section-name: " curr-section-name " var-flag: " var-flag "\n inl: \"" inl "\"") (if (eof-object? inl) @@ -197,15 +203,15 @@ (hash-table-delete! res "") ;; we are using "" as a dumping ground and must remove it before returning the ht (debug:print 9 "END: " path) res) (regex-case inl - (configf:comment-rx _ (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f)) - (configf:blank-l-rx _ (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f)) + (configf:comment-rx _ (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f)) + (configf:blank-l-rx _ (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f)) (configf:settings ( x setting val ) (begin (hash-table-set! settings setting val) - (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f))) + (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f))) (configf:include-rx ( x include-file ) (let* ((curr-conf-dir (pathname-directory path)) (full-conf (if (absolute-pathname? include-file) include-file (nice-path (conc (if curr-conf-dir @@ -214,33 +220,33 @@ "/" include-file))))) (if (file-exists? full-conf) (begin ;; (push-directory conf-dir) (debug:print 9 "Including: " full-conf) - (read-config full-conf res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames) + (read-config full-conf res (calc-allow-system allow-system curr-section sections) environ-patt: environ-patt curr-section: curr-section-name sections: sections settings: settings keep-filenames: keep-filenames) ;; (pop-directory) - (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f)) + (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f)) (begin (debug:print '(2 9) "INFO: include file " include-file " not found (called from " path ")") (debug:print 2 " " full-conf) - (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f))))) + (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f))))) (configf:section-rx ( x section-name ) (begin ;; call post-section-procs (for-each (lambda (dat) (let ((patt (car dat)) (proc (cdr dat))) (if (string-match patt curr-section-name) (proc curr-section-name section-name res path)))) post-section-procs) - (loop (configf:read-line inp res allow-system settings) + (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) ;; if we have the sections list then force all settings into "" and delete it later? (if (or (not sections) (member section-name sections)) section-name "") ;; stick everything into "" #f #f))) - (configf:key-sys-pr ( x key cmd ) (if allow-system + (configf:key-sys-pr ( x key cmd ) (if (calc-allow-system allow-system curr-section sections) (let ((alist (hash-table-ref/default res curr-section-name '())) (val-proc (lambda () (let* ((start-time (current-seconds)) (cmdres (process:cmd-run->list cmd)) (delta (- (current-seconds) start-time)) @@ -258,17 +264,17 @@ "" (string-intersperse res " ")))))) (hash-table-set! res curr-section-name (config:assoc-safe-add alist key - (case allow-system + (case (calc-allow-system allow-system curr-section sections) ((return-procs) val-proc) ((return-string) cmd) (else (val-proc))) metadata: metapath)) - (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f)) - (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f))) + (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f)) + (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f))) (configf:key-val-pr ( x key unk1 val unk2 ) (let* ((alist (hash-table-ref/default res curr-section-name '())) (envar (and environ-patt (string-search (regexp environ-patt) curr-section-name))) (realval (if envar (config:eval-string-in-environment val) val))) @@ -275,16 +281,16 @@ (debug:print-info 6 "read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name) (if envar (safe-setenv key realval)) (debug:print 10 " setting: [" curr-section-name "] " key " = " val) (hash-table-set! res curr-section-name (config:assoc-safe-add alist key realval metadata: metapath)) - (loop (configf:read-line inp res allow-system settings) curr-section-name key #f))) + (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name key #f))) (configf:key-no-val ( x key val) (let* ((alist (hash-table-ref/default res curr-section-name '()))) (debug:print 10 " setting: [" curr-section-name "] " key " = #t") (hash-table-set! res curr-section-name (config:assoc-safe-add alist key #t metadata: metapath)) - (loop (configf:read-line inp res allow-system settings) curr-section-name key #f))) + (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name key #f))) ;; if a continued line (configf:cont-ln-rx ( x whsp val ) (let ((alist (hash-table-ref/default res curr-section-name '()))) (if var-flag ;; if set to a string then we have a continued var (let ((newval (conc (config-lookup res curr-section-name var-flag) "\n" @@ -294,15 +300,15 @@ "") val))) ;; (print "val: " val "\nnewval: \"" newval "\"\nvarflag: " var-flag) (hash-table-set! res curr-section-name (config:assoc-safe-add alist var-flag newval metadata: metapath)) - (loop (configf:read-line inp res allow-system settings) curr-section-name var-flag (if lead lead whsp))) - (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f)))) + (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name var-flag (if lead lead whsp))) + (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f)))) (else (debug:print 0 "ERROR: problem parsing " path ",\n \"" inl "\"") (set! var-flag #f) - (loop (configf:read-line inp res allow-system settings) curr-section-name #f #f)))))))) + (loop (configf:read-line inp res (calc-allow-system allow-system curr-section sections) settings) curr-section-name #f #f)))))))) ;; pathenvvar will set the named var to the path of the config (define (find-and-read-config fname #!key (environ-patt #f)(given-toppath #f)(pathenvvar #f)) (let* ((curr-dir (current-directory)) (configinfo (find-config fname toppath: given-toppath))