| ︙ | | | ︙ | |
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
(let* ((output (cmd-run->list cmd))
(res (car output))
(status (cadr output)))
(if (equal? status 0)
(let ((outres (string-intersperse
res
"\n")))
(debug:print 4 "INFO: shell result:\n" outres)
outres)
(begin
(with-output-to-port (current-error-port)
(print "ERROR: " cmd " returned bad exit code " status))
""))))
;; Lookup a value in runconfigs based on -reqtarg or -target
|
|
|
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
(let* ((output (cmd-run->list cmd))
(res (car output))
(status (cadr output)))
(if (equal? status 0)
(let ((outres (string-intersperse
res
"\n")))
(debug:print-info 4 "shell result:\n" outres)
outres)
(begin
(with-output-to-port (current-error-port)
(print "ERROR: " cmd " returned bad exit code " status))
""))))
;; Lookup a value in runconfigs based on -reqtarg or -target
|
| ︙ | | | ︙ | |
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
;; read a config file, returns hash table of alists
;; adds to ht if given (must be #f otherwise)
;; 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 4 "INFO: read-config " path " allow-system " allow-system " environ-patt " environ-patt " curr-section: " curr-section " sections: " sections)
(if (not (file-exists? path))
(begin
(debug:print 4 "INFO: 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)) ;; (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 8 "INFO: 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
|
|
|
|
|
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
;; read a config file, returns hash table of alists
;; adds to ht if given (must be #f otherwise)
;; 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 4 "read-config " path " allow-system " allow-system " environ-patt " environ-patt " curr-section: " curr-section " sections: " sections)
(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)) ;; (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
|
| ︙ | | | ︙ | |
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
#f #f))
(configf:key-sys-pr ( x key cmd ) (if allow-system
(let ((alist (hash-table-ref/default res curr-section-name '()))
(val-proc (lambda ()
(let* ((cmdres (cmd-run->list cmd))
(status (cadr cmdres))
(res (car cmdres)))
(debug:print 4 "INFO: " inl "\n => " (string-intersperse res "\n"))
(if (not (eq? status 0))
(begin
(debug:print 0 "ERROR: problem with " inl ", return code " status
" output: " cmdres)
(exit 1)))
(if (null? res)
""
|
|
|
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
#f #f))
(configf:key-sys-pr ( x key cmd ) (if allow-system
(let ((alist (hash-table-ref/default res curr-section-name '()))
(val-proc (lambda ()
(let* ((cmdres (cmd-run->list cmd))
(status (cadr cmdres))
(res (car cmdres)))
(debug:print-info 4 "" inl "\n => " (string-intersperse res "\n"))
(if (not (eq? status 0))
(begin
(debug:print 0 "ERROR: problem with " inl ", return code " status
" output: " cmdres)
(exit 1)))
(if (null? res)
""
|
| ︙ | | | ︙ | |
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
(loop (configf:read-line inp res) curr-section-name #f #f))
(loop (configf:read-line inp res) 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)))
(debug:print 6 "INFO: read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name)
(if envar
(begin
;; (debug:print 4 "INFO: read-config key=" key ", val=" val ", realval=" realval)
(setenv key realval)))
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist key realval))
(loop (configf:read-line inp res) 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
|
|
|
|
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
(loop (configf:read-line inp res) curr-section-name #f #f))
(loop (configf:read-line inp res) 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)))
(debug:print-info 6 "read-config env setting, envar: " envar " realval: " realval " val: " val " key: " key " curr-section-name: " curr-section-name)
(if envar
(begin
;; (debug:print-info 4 "read-config key=" key ", val=" val ", realval=" realval)
(setenv key realval)))
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist key realval))
(loop (configf:read-line inp res) 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
|
| ︙ | | | ︙ | |