9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
;; PURPOSE.
;;======================================================================
;;======================================================================
;; Config file handling
;;======================================================================
(use regex regex-case)
(declare (unit configf))
(declare (uses common))
(declare (uses process))
(include "common_records.scm")
;; return list (path fullpath configname)
|
|
|
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
;; PURPOSE.
;;======================================================================
;;======================================================================
;; Config file handling
;;======================================================================
(use regex regex-case directory-utils)
(declare (unit configf))
(declare (uses common))
(declare (uses process))
(include "common_records.scm")
;; return list (path fullpath configname)
|
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
;; envion-patt is a regex spec that identifies sections that will be eval'd
;; in the environment on the fly
;; sections: #f => get all, else list of sections to gather
(define (read-config path ht allow-system #!key (environ-patt #f)(curr-section #f)(sections #f))
(debug:print-info 5 "read-config " path " allow-system " allow-system " environ-patt " environ-patt " curr-section: " curr-section " sections: " sections " pwd: " (current-directory))
(if (not (file-exists? path))
(begin
(debug:print-info 4 "read-config - file not found " path " current path: " (current-directory))
(if (not ht)(make-hash-table) ht))
(let ((inp (open-input-file path))
(res (if (not ht)(make-hash-table) ht)))
(let loop ((inl (configf:read-line inp res allow-system)) ;; (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)
(begin
(close-input-port inp)
(hash-table-delete! res "") ;; we are using "" as a dumping ground and must remove it before returning the ht
res)
(regex-case
inl
(configf:comment-rx _ (loop (configf:read-line inp res allow-system) curr-section-name #f #f))
(configf:blank-l-rx _ (loop (configf:read-line inp res allow-system) curr-section-name #f #f))
(configf:include-rx ( x include-file ) (let ((curr-dir (current-directory))
(conf-dir (pathname-directory path)))
(if conf-dir (change-directory conf-dir))
(read-config include-file res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections)
(change-directory curr-dir)
(loop (configf:read-line inp res allow-system) curr-section-name #f #f)))
(configf:section-rx ( x section-name ) (loop (configf:read-line inp res allow-system)
;; 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
|
|
|
>
>
>
>
|
>
>
>
>
|
|
|
|
>
>
>
>
|
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
;; envion-patt is a regex spec that identifies sections that will be eval'd
;; in the environment on the fly
;; sections: #f => get all, else list of sections to gather
(define (read-config path ht allow-system #!key (environ-patt #f)(curr-section #f)(sections #f))
(debug:print-info 5 "read-config " path " allow-system " allow-system " environ-patt " environ-patt " curr-section: " curr-section " sections: " sections " pwd: " (current-directory))
(if (not (file-exists? path))
(begin
(debug:print-info 1 "read-config - file not found " path " current path: " (current-directory))
(if (not ht)(make-hash-table) ht))
(let ((inp (open-input-file path))
(res (if (not ht)(make-hash-table) ht)))
(let loop ((inl (configf:read-line inp res allow-system)) ;; (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)
(begin
(close-input-port inp)
(hash-table-delete! res "") ;; we are using "" as a dumping ground and must remove it before returning the ht
res)
(regex-case
inl
(configf:comment-rx _ (loop (configf:read-line inp res allow-system) curr-section-name #f #f))
(configf:blank-l-rx _ (loop (configf:read-line inp res allow-system) 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
curr-conf-dir
".")
"/" include-file)))))
(if (file-exists? full-conf)
(begin
;; (push-directory conf-dir)
(read-config full-conf res allow-system environ-patt: environ-patt curr-section: curr-section-name sections: sections)
;; (pop-directory)
(loop (configf:read-line inp res allow-system) curr-section-name #f #f))
(begin
(debug:print 2 "INFO: include file " include-file " not found (called from " path ")")
(debug:print 2 " " full-conf)
(loop (configf:read-line inp res allow-system) curr-section-name #f #f)))))
(configf:section-rx ( x section-name ) (loop (configf:read-line inp res allow-system)
;; 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
|