| ︙ | | | ︙ | |
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Config file handling
;;======================================================================
(use regex regex-case) ;; directory-utils)
(declare (unit configf))
;; (declare (uses process))
|
|
|
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
|
;;======================================================================
;; Config file handling
;;======================================================================
(use regex regex-case) ;; directory-utils)
(declare (unit configf))
(declare (uses process))
(include "common_records.scm")
;; return list (path fullpath configname)
(define (find-config configname #!key (toppath #f))
(if toppath
(let ((cfname (conc toppath "/" configname)))
|
| ︙ | | | ︙ | |
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
(define (config:eval-string-in-environment str)
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: problem evaluating \"" str "\" in the shell environment")
#f)
(let ((cmdres (cmd-run->list (conc "echo " str))))
(if (null? cmdres) ""
(caar cmdres)))))
;;======================================================================
;; Make the regexp's needed globally available
;;======================================================================
|
|
|
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
(define (config:eval-string-in-environment str)
(handle-exceptions
exn
(begin
(debug:print 0 "ERROR: problem evaluating \"" str "\" in the shell environment")
#f)
(let ((cmdres (process:cmd-run->list (conc "echo " str))))
(if (null? cmdres) ""
(caar cmdres)))))
;;======================================================================
;; Make the regexp's needed globally available
;;======================================================================
|
| ︙ | | | ︙ | |
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
(debug:print-info 9 "for line \"" l "\"\n command: " cmd " took " delta " seconds to run with output:\n " result)))))
(loop (conc prestr result poststr)))
res))
res)))
;; Run a shell command and return the output as a string
(define (shell cmd)
(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)
|
|
|
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
(debug:print-info 9 "for line \"" l "\"\n command: " cmd " took " delta " seconds to run with output:\n " result)))))
(loop (conc prestr result poststr)))
res))
res)))
;; Run a shell command and return the output as a string
(define (shell cmd)
(let* ((output (process: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)
|
| ︙ | | | ︙ | |
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
|
(member section-name sections))
section-name "") ;; stick everything into ""
#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* ((start-time (current-seconds))
(cmdres (cmd-run->list cmd))
(delta (- (current-seconds) start-time))
(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
|
|
|
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
|
(member section-name sections))
section-name "") ;; stick everything into ""
#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* ((start-time (current-seconds))
(cmdres (process:cmd-run->list cmd))
(delta (- (current-seconds) start-time))
(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
|
| ︙ | | | ︙ | |