18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
-
+
|
;;======================================================================
;;======================================================================
;; Process convience utils
;;======================================================================
(use regex)
(use regex directory-utils)
(declare (unit process))
(define (process:conservative-read port)
(let loop ((res ""))
(if (not (eof-object? (peek-char port)))
(loop (conc res (read-char port)))
res)))
|
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
|
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
178
|
-
+
+
-
+
+
+
+
+
+
+
+
-
+
|
(loop (let ((l (read-line fh)))
(if (eof-object? l) l (proc l)))
(append result (list curr)))
result))))
;; here is an example line where the shell is sh or bash
;; "find / -print 2&>1 > findall.log"
(define (run-n-wait cmdline #!key (params #f)(print-cmd #f))
(define (run-n-wait cmdline #!key (params #f)(print-cmd #f)(run-dir #f))
(if print-cmd
(debug:print 0 *default-log-port*
(if (string? print-cmd)
print-cmd
"")
(if run-dir (conc "Run in " run-dir ";") "")
cmdline
(if params
(string-intersperse params " ")
(conc " " (string-intersperse params " "))
"")))
(if (and run-dir
(directory-exists? run-dir))
(push-directory run-dir))
(let ((pid (if params
(process-run cmdline params)
(process-run cmdline))))
(let loop ((i 0))
(let-values (((pid-val exit-status exit-code) (process-wait pid #t)))
(if (eq? pid-val 0)
(begin
(thread-sleep! 2)
(loop (+ i 1)))
(begin
(if (and run-dir
(directory-exists? run-dir))
(pop-directory))
(values pid-val exit-status exit-code))))))
(values pid-val exit-status exit-code)))))))
;;======================================================================
;; MISC PROCESS RELATED STUFF
;;======================================================================
(define (process:children proc)
(with-input-from-pipe
|