| ︙ | | |
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
|
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
-
+
-
+
+
|
(else
(configf:process-line inl ht allow-processing)))))
(if (and (string? res)
(not (equal? (hash-table-ref/default settings "trim-trailing-spaces" "no") "no")))
(string-substitute "\\s+$" "" res)
res))))))
(define (configf:cfgdat->env-alist section cfgdat-ht)
(define (configf:cfgdat->env-alist section cfgdat-ht allow-system)
(filter
(lambda (pair)
(let* ((var (car pair))
(val (cdr pair)))
(cons var
(cond
((procedure? val)
((and allow-system (procedure? val)) ;; if we decided to use something other than #t or #f for allow-system ('return-procs or 'return-string) , this may become problematic
(val))
((procedure? val) #f)
((string? val) val)
(else "#f")))))
(append
(hash-table-ref/default cfgdat-ht "default" '())
(if (equal? section "default") '() (hash-table-ref/default cfgdat-ht section '())))))
(define (calc-allow-system allow-system section sections)
|
| ︙ | | |
233
234
235
236
237
238
239
240
241
242
243
244
245
246
|
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
+
+
+
+
+
|
(hash-table-keys ht))))
ht)
;; read a config file, returns hash table of alists
;; read a config file, returns hash table of alists
;; adds to ht if given (must be #f otherwise)
;; allow-system:
;; #f - do not evaluate [system
;; #t - immediately evaluate [system and store result as string
;; 'return-procs -- return a proc taking ht as an argument that may be evaulated at some future time
;; 'return-string -- return a string representing a proc taking ht as an argument that may be evaulated at some future time
;; 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
;; post-section-procs alist of section-pattern => proc, where: (proc section-name next-section-name ht curr-path)
;; apply-wildcards: #t/#f - apply vars from targets with % wildcards to all matching sections
;;
(define (read-config path ht allow-system #!key (environ-patt #f) (curr-section #f)
|
| ︙ | | |
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
|
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
|
+
-
+
|
curr-section-name #f #f)))))
(configf:script-rx ( x include-script params);; handle-exceptions
;; exn
;; (begin
;; (debug:print '(0 2 9) #f "INFO: include from script " include-script " failed.")
;; (loop (configf:read-line inp res (calc-allow-system allow-system curr-section-name sections) settings) curr-section-name #f #f))
(if (and (common:file-exists? include-script)(file-execute-access? include-script))
(let* ((local-allow-system (calc-allow-system allow-system curr-section-name sections))
(let* ((env-delta (configf:cfgdat->env-alist curr-section-name res))
(env-delta (configf:cfgdat->env-alist curr-section-name res local-allow-system))
(new-inp-port
(common:with-env-vars
env-delta
(lambda ()
(open-input-pipe (conc include-script " " params))))))
(debug:print '(2 9) *default-log-port* "Including from script output: " include-script)
;; (print "We got here, calling read-config next. Port is: " new-inp-port)
|
| ︙ | | |
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
|
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
|
+
-
+
|
section-name
#f #f)))
(configf:key-sys-pr ( x key cmd )
(if (calc-allow-system allow-system curr-section-name sections)
(let ((alist (hash-table-ref/default res curr-section-name '()))
(val-proc (lambda ()
(let* ((start-time (current-seconds))
(local-allow-system (calc-allow-system allow-system curr-section-name sections))
(env-delta (configf:cfgdat->env-alist curr-section-name res))
(env-delta (configf:cfgdat->env-alist curr-section-name res local-allow-system))
(cmdres (process:cmd-run->list cmd delta-env-alist-or-hash-table: env-delta)) ;; BB: here is where [system is exec'd. needs to have env from other vars!
(delta (- (current-seconds) start-time))
(status (cadr cmdres))
(res (car cmdres)))
(debug:print-info 4 *default-log-port* "" inl "\n => " (string-intersperse res "\n"))
(if (not (eq? status 0))
(begin
|
| ︙ | | |