/
process.cljc
634 lines (578 loc) · 23.2 KB
/
process.cljc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
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
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
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
(ns babashka.process
"Shell out in Clojure with simplicity and ease.
If you are not yet familiar with the API, start reading the
docstrings for `process` and `shell`."
(:require [babashka.fs :as fs]
[clojure.java.io :as io]
[clojure.string :as str])
(:import [java.lang ProcessBuilder$Redirect]))
(ns-unmap *ns* 'Process)
(ns-unmap *ns* 'ProcessBuilder)
(set! *warn-on-reflection* true)
(defn tokenize
"Tokenize string to list of individual space separated arguments.
If argument contains space you can wrap it with `'` or `\"`."
[s]
(loop [s (java.io.StringReader. s)
in-double-quotes? false
in-single-quotes? false
buf (java.io.StringWriter.)
parsed []]
(let [c (.read s)]
(cond
(= -1 c) (if (pos? (count (str buf)))
(conj parsed (str buf))
parsed)
(= 39 c) ;; single-quotes
(if in-double-quotes?
(recur s in-double-quotes? false (doto buf
(.write c)) parsed)
(if in-single-quotes?
(recur s in-double-quotes? false (java.io.StringWriter.) (conj parsed (str buf)))
(recur s in-double-quotes? true buf parsed)))
(= 92 c) ;; the \\ escape character
(let [escaped (.read s)
buf (if (and in-double-quotes?
(= 34 escaped)) ;; double quote
(doto buf (.write escaped))
(doto buf
(.write c)
(.write escaped)))]
(recur s in-double-quotes? in-single-quotes? buf parsed))
(and (not in-single-quotes?) (= 34 c)) ;; double quote
(if in-double-quotes?
;; exit double-quoted string
(recur s false in-single-quotes? buf parsed)
;; enter double-quoted string
(recur s true in-single-quotes? buf parsed))
(and (not in-double-quotes?)
(not in-single-quotes?)
(Character/isWhitespace c))
(recur s in-double-quotes? in-single-quotes? (java.io.StringWriter.)
(let [bs (str buf)]
(cond-> parsed
(not (str/blank? bs)) (conj bs))))
:else (do
(.write buf c)
(recur s in-double-quotes? in-single-quotes? buf parsed))))))
(defn- as-string-map
"Helper to coerce a Clojure map with keyword keys into something coerceable to Map<String,String>
Stringifies keyword keys, but otherwise doesn't try to do anything clever with values"
[m]
(if (map? m)
(into {} (map (fn [[k v]] [(str (if (keyword? k) (name k) k)) (str v)])) m)
m))
(defn- set-env
"Sets environment for a ProcessBuilder instance.
Returns instance to participate in the thread-first macro."
^java.lang.ProcessBuilder [^java.lang.ProcessBuilder pb env]
(doto (.environment pb)
(.clear)
(.putAll (as-string-map env)))
pb)
(defn- add-env
"Adds environment for a ProcessBuilder instance.
Returns instance to participate in the thread-first macro."
^java.lang.ProcessBuilder [^java.lang.ProcessBuilder pb env]
(doto (.environment pb)
(.putAll (as-string-map env)))
pb)
#_{:clj-kondo/ignore [:unused-private-var]}
(defn- debug [& strs]
(binding [*out* *err*]
(println (str/join " " strs))))
(defn check
"Takes a process, waits until is finished and throws if exit code is non-zero."
[proc]
(let [proc @proc
exit-code (:exit proc)
err (:err proc)]
(if (not (zero? exit-code))
(let [err (cond
(string? err)
err
(instance? java.io.InputStream err)
(slurp err)
:else
nil)]
(throw (ex-info (if (string? err)
err
"failed")
(assoc proc :type ::error))))
proc)))
(defrecord Process [^java.lang.Process proc exit in out err prev cmd]
clojure.lang.IDeref
(deref [this]
(let [exit-code (.waitFor proc)
out (if (future? out) @out out)
err (if (future? err) @err err)]
(assoc this
:exit exit-code
:out out
:err err)))
#?@(:bb []
:clj [clojure.lang.IBlockingDeref
(deref [this timeout-ms timeout-value]
(if (.waitFor proc timeout-ms java.util.concurrent.TimeUnit/MILLISECONDS)
@this
timeout-value))]))
(defmethod print-method Process [proc ^java.io.Writer w]
(.write w (pr-str (into {} proc))))
#_{:clj-kondo/ignore [:unused-private-var]}
(defn- proc->Process [^java.lang.Process proc cmd prev]
(let [stdin (.getOutputStream proc)
stdout (.getInputStream proc)
stderr (.getErrorStream proc)]
(->Process proc
nil
stdin
stdout
stderr
prev
cmd)))
(defmacro ^:private if-before-jdk8 [pre-9 post-8]
(if (identical? ::ex (try (import 'java.lang.ProcessHandle)
(catch Exception _ ::ex)))
pre-9
post-8))
(defn destroy
"Destroys the process and returns the input arg. Takes process or map
with :proc (`java.lang.ProcessBuilder`). "
[proc]
(.destroy ^java.lang.Process (:proc proc))
proc)
(if-before-jdk8
(def destroy-tree destroy)
(defn destroy-tree
"Same as `destroy` but also destroys all descendants. JDK9+
only. Falls back to `destroy` on older JVM versions."
[proc]
(let [handle (.toHandle ^java.lang.Process (:proc proc))]
(run! (fn [^java.lang.ProcessHandle handle]
(.destroy handle))
(cons handle (iterator-seq (.iterator (.descendants handle))))))
proc))
(def ^:private windows?
(-> (System/getProperty "os.name")
(str/lower-case)
(str/includes? "windows")))
(defn- -program-resolver [program]
;; this should make life easier and not cause any bugs that weren't there previously
;; on exception we just return the program as is
(try
(if (fs/relative? program)
(if-let [f (fs/which program)]
(str f)
program)
program)
(catch Throwable _ program)))
(defn ^:no-doc default-program-resolver
[program]
(if windows?
(-program-resolver program)
program))
(def ^:private default-escape
(if windows? #(str/replace % "\"" "\\\"") identity))
(def ^:dynamic *defaults*
"Dynamic var containing overridable default options. Use
`alter-var-root` to change permanently or `binding` to change temporarily."
{:shutdown nil
:escape default-escape
:program-resolver default-program-resolver})
(defn- normalize-opts [{:keys [:out :err :in :inherit] :as opts}]
(cond-> opts
(and inherit (not out))
(-> (assoc :out :inherit))
(and inherit (not err))
(-> (assoc :err :inherit))
(and inherit (not in))
(-> (assoc :in :inherit))
(or (instance? java.io.File out)
(string? out))
(-> (assoc :out-file (io/file out))
(assoc :out :write))
(or (instance? java.io.File err)
(string? err))
(-> (assoc :err-file (io/file err))
(assoc :err :write))))
(defn- build
(^java.lang.ProcessBuilder [cmd] (build cmd nil))
(^java.lang.ProcessBuilder [^java.util.List cmd opts]
(let [;; we assume here that opts are already normalized and merged with
;; defaults
{:keys [:in
:out
:out-file
:err
:err-file
:dir
:env
:extra-env
:escape]} opts
str-fn (comp escape str)
cmd (mapv str-fn cmd)
cmd (if-let [program-resolver (:program-resolver opts)]
(let [[program & args] cmd]
(into [(program-resolver program)] args))
cmd)
pb (cond-> (java.lang.ProcessBuilder. ^java.util.List cmd)
dir (.directory (io/file dir))
env (set-env env)
extra-env (add-env extra-env))]
(case out
:inherit (.redirectOutput pb ProcessBuilder$Redirect/INHERIT)
:write (.redirectOutput pb (ProcessBuilder$Redirect/to (io/file out-file)))
:append (.redirectOutput pb (ProcessBuilder$Redirect/appendTo (io/file out-file)))
nil)
(case err
:inherit (.redirectError pb ProcessBuilder$Redirect/INHERIT)
:write (.redirectError pb (ProcessBuilder$Redirect/to (io/file err-file)))
:append (.redirectError pb (ProcessBuilder$Redirect/appendTo (io/file err-file)))
nil)
(case in
:inherit (.redirectInput pb ProcessBuilder$Redirect/INHERIT)
nil)
pb)))
(defrecord ProcessBuilder [pb opts prev])
(defn parse-args
"Parses arguments to `process` to map with:
* `:prev`: a (previous) process whose input is piped into the current process
* `:cmd`: a vector of command line argument strings
* `:opts`: options map
"
[args]
(let [arg-count (count args)
maybe-prev (first args)
args (rest args)
[prev args] (if (or (instance? Process maybe-prev)
(instance? ProcessBuilder maybe-prev)
(and (nil? maybe-prev)
(sequential? (first args))))
[maybe-prev args]
[nil (cons maybe-prev args)])
;; we've parsed the input process, now assume the first argument is either an opts map, or a sequential
maybe-opts (first args)
args (rest args)
[opts args] (cond (or (nil? maybe-opts) (map? maybe-opts))
[maybe-opts args args]
(sequential? maybe-opts)
;; flatten command structure
[nil (into (vec maybe-opts) args)]
(string? maybe-opts)
[nil (cons maybe-opts args)]
:else [nil (cons maybe-opts args)])
[args opts] (cond opts
[args opts]
(and (= (+ 2 (if prev 1 0)) arg-count)
(map? (last args)))
[(butlast args) (last args)]
;; no options found
:else [args opts])
args (let [args (map str args)
fst (first args)
rst (rest args)]
(vec (into (if (fs/exists? fst)
[fst]
(if fst
(tokenize fst)
fst)) rst)))]
{:prev prev
:cmd args
:opts opts}))
(defn pb
"Returns a process builder (as record)."
[& args]
(let [{:keys [cmd opts prev]} (parse-args args)]
(let [opts (merge *defaults* (normalize-opts opts))]
(->ProcessBuilder (build cmd opts)
opts
prev))))
(defn- copy [in out encoding]
(let [[out post-fn] (if (keyword? out)
(case out
:string [(java.io.StringWriter.) str])
[out identity])]
(io/copy in out :encoding encoding)
(post-fn out)))
(defn process*
"Same as with `process` but called with parsed arguments (the result from `parse-args`)"
[{:keys [prev cmd opts]}]
(let [opts (merge *defaults* (normalize-opts opts))
prev-in (:out prev)
opt-in (:in opts)
opts (assoc opts :in
(cond (not opt-in) prev-in
(= :inherit opt-in) (or prev-in opt-in)
:else opt-in))
{:keys [in in-enc
out out-enc
err err-enc
shutdown
pre-start-fn
exit-fn]} opts
cmd (if (and (string? cmd)
(not (.exists (io/file cmd))))
(tokenize cmd)
cmd)
^java.lang.ProcessBuilder pb
(if (instance? java.lang.ProcessBuilder cmd)
cmd
(build cmd opts))
cmd (vec (.command pb))
_ (when pre-start-fn
(let [interceptor-map {:cmd cmd}]
(pre-start-fn interceptor-map)))
proc (.start pb)
stdin (.getOutputStream proc)
stdout (.getInputStream proc)
stderr (.getErrorStream proc)
out (if (and out (or (identical? :string out)
(not (keyword? out))))
(future (copy stdout out out-enc))
stdout)
err (if (and err (or (identical? :string err)
(not (keyword? err))))
(future (copy stderr err err-enc))
stderr)]
;; wrap in futures, see https://github.com/clojure/clojure/commit/7def88afe28221ad78f8d045ddbd87b5230cb03e
(when (and in (not (identical? :inherit in)))
(future (with-open [stdin stdin] ;; needed to close stdin after writing
(io/copy in stdin :encoding in-enc))))
(let [;; bb doesn't support map->Process at the moment
res (->Process proc
nil
stdin
out
err
prev
cmd)]
(when shutdown
(-> (Runtime/getRuntime)
(.addShutdownHook (Thread. (fn [] (shutdown res))))))
(when exit-fn
(if-before-jdk8
(throw (ex-info "The `:exit-fn` option is not support on JDK 8 and lower." res))
(-> (.onExit proc)
(.thenRun (fn []
(exit-fn @res))))))
res)))
(defn process
"Creates a child process. Takes a command (vector of strings or
objects that will be turned into strings) and optionally a map of
options.
Returns: a record with:
- `:proc`: an instance of `java.lang.Process`
- `:in`, `:err`, `:out`: the process's streams. To obtain a string from
`:out` or `:err` you will typically use `slurp` or use the `:string`
option (see below). Slurping those streams will block the current thread
until the process is finished.
- `:cmd`: the command that was passed to create the process.
- `:prev`: previous process record in case of a pipeline.
The returned record can be passed to `deref`. Doing so will cause the current
thread to block until the process is finished and will populate `:exit` with
the exit code.
Supported options:
- `:in`, `:out`, `:err`: objects compatible with `clojure.java.io/copy` that
will be copied to or from the process's corresponding stream. May be set
to `:inherit` for redirecting to the parent process's corresponding
stream. Optional `:in-enc`, `:out-enc` and `:err-enc` values will
be passed along to `clojure.java.io/copy`.
For redirecting to Clojure's `*in*`, `*out*` or `*err*` stream, set
the corresponding option accordingly.
The `:out` and `:err` options support `:string` for writing to a string
output. You will need to `deref` the process before accessing the string
via the process's `:out`.
For writing output to a file, you can set `:out` and `:err` to a `java.io.File` object, or a keyword:
- `:write` + an additional `:out-file`/`:err-file` + file to write to the file.
- `:append` + an additional `:out-file`/`:err-file` + file to append to the file.
- `:inherit`: if true, sets `:in`, `:out` and `:err` to `:inherit`.
- `:dir`: working directory.
- `:env`, `:extra-env`: a map of environment variables. See [Add environment](/README.md#add-environment).
- `:escape`: function that will applied to each stringified argument. On
Windows this defaults to prepending a backslash before a double quote. On
other operating systems it defaults to `identity`.
- `:pre-start-fn`: a one-argument function that, if present, gets called with a
map of process info just before the process is started. Can be useful for debugging
or reporting. Any return value from the function is discarded. Map contents:
- `:cmd` - a vector of the tokens of the command to be executed (e.g. `[\"ls\" \"foo\"]`)
- `:shutdown`: shutdown hook, defaults to `nil`. Takes process
map. Typically used with `destroy` or `destroy-tree` to ensure long
running processes are cleaned up on shutdown.
- `:exit-fn`: a function which is executed upon exit. Receives process map as argument. Only supported in JDK11+."
{:arglists '([opts? & args])}
[& args]
(process* (parse-args args)))
(if-before-jdk8
(defn pipeline
"Returns the processes for one pipe created with -> or creates
pipeline from multiple process builders.
- When passing a process, returns a vector of processes of a pipeline created with `->` or `pipeline`.
- When passing two or more process builders created with `pb`: creates a
pipeline as a vector of processes (JDK9+ only).
Also see [Pipelines](/README.md#pipelines).
"
([proc]
(if-let [prev (:prev proc)]
(conj (pipeline prev) proc)
[proc])))
(defn pipeline
"Returns the processes for one pipe created with -> or creates
pipeline from multiple process builders.
- When passing a process, returns a vector of processes of a pipeline created with `->` or `pipeline`.
- When passing two or more process builders created with `pb`: creates a
pipeline as a vector of processes (JDK9+ only).
Also see [Pipelines](/README.md#pipelines).
"
([proc]
(if-let [prev (:prev proc)]
(conj (pipeline prev) proc)
[proc]))
([pb & pbs]
(let [pbs (cons pb pbs)
opts (map :opts pbs)
pbs (map :pb pbs)
procs (java.lang.ProcessBuilder/startPipeline pbs)
pbs+opts+procs (map vector pbs opts procs)]
(-> (reduce (fn [{:keys [:prev :procs]}
[pb opts proc]]
(let [shutdown (:shutdown opts)
cmd (.command ^java.lang.ProcessBuilder pb)
new-proc (proc->Process proc cmd prev)
new-procs (conj procs new-proc)]
(when shutdown
(-> (Runtime/getRuntime)
(.addShutdownHook (Thread.
(fn []
(shutdown new-proc))))))
{:prev new-proc :procs new-procs}))
{:prev nil :procs []}
pbs+opts+procs)
:procs)))))
(defn start
"Takes a process builder, calls start and returns a process (as record)."
[pb]
(let [pipe (pipeline pb)]
(if (= 1 (count pipe))
(process* {:cmd (:pb pb) :opts (:opts pb)})
(last (apply pipeline pipe)))))
(defn- process-unquote [arg]
(let [f (first arg)]
(if (and (symbol? f) (= "unquote" (name f)))
(second arg)
arg)))
(defn- format-arg [arg]
(cond
(seq? arg) (process-unquote arg)
:else (list 'quote arg)))
(defmacro $
"Convenience macro around `process`. Takes command as varargs. Options can
be passed via metadata on the form or as a first map arg. Supports
interpolation via `~`"
{:arglists '([opts? & args])}
[& args]
(let [opts (meta &form)
farg (first args)
args (if (and (= 1 (count args))
(and (string? farg)
(not (.exists (io/file farg)))))
(tokenize farg)
args)
farg (first args)
marg? (map? farg)
cmd (if marg?
(vec (cons farg (mapv format-arg (rest args))))
(mapv format-arg args))]
`(let [cmd# ~cmd
opts# ~opts
fcmd# (first cmd#)
[prev# cmd#]
(if (:proc fcmd#)
[fcmd# (rest cmd#)]
[nil cmd#])
fcmd# (first cmd#)
[opts# cmd#]
(if (map? fcmd#)
[(merge opts# fcmd#) (rest cmd#)]
[opts# cmd#])]
(process* {:prev prev# :cmd cmd# :opts opts#}))))
(defn sh
"Convenience function similar to `clojure.java.shell/sh` that sets
`:out` and `:err` to `:string` by default and blocks. Similar to
`cjs/sh` it does not check the exit code (this can be done with
`check`)."
{:arglists '([opts? & args])}
[& args]
(let [{:keys [opts cmd prev]} (parse-args args)
opts (merge {:out :string
:err :string} opts)]
@(process* {:cmd cmd :opts opts :prev prev})))
(def ^:private has-exec?
(boolean (try (.getMethod ^Class
(resolve 'org.graalvm.nativeimage.ProcessProperties) "exec"
(into-array [java.nio.file.Path (Class/forName "[Ljava.lang.String;") java.util.Map]))
(catch Exception _ false))))
(defmacro ^:no-doc
if-has-exec [then else]
(if has-exec?
then else))
(defn exec
"Replaces the current process image with the process image specified
by the given path invoked with the given args. Works only in GraalVM
native images. Override the first argument using `:arg0`."
{:arglists '([opts? & args])}
[& args]
(let [{:keys [cmd opts]} (parse-args args)]
(let [{:keys [escape env extra-env]
:or {escape default-escape}
:as opts} opts
cmd (if (and (string? cmd)
(not (.exists (io/file cmd))))
(tokenize cmd)
cmd)
str-fn (comp escape str)
cmd (mapv str-fn cmd)
arg0 (or (:arg0 opts)
(first cmd))
cmd (let [program-resolver (:program-resolver opts -program-resolver)
[program & args] cmd]
(into [(program-resolver program)] args))
[program & args] cmd
args (cons arg0 args)
^java.util.Map env (into (or env (into {} (System/getenv))) extra-env)]
(if-has-exec
(org.graalvm.nativeimage.ProcessProperties/exec (fs/path program)
(into-array String args)
env)
(throw (ex-info "exec is not supported in non-GraalVM environments" {:cmd cmd}))))))
(def ^:private default-shell-opts
{:in :inherit
:out :inherit
:err :inherit
:shutdown destroy-tree})
(defn shell
"Convenience function around `process` that was originally in `babashka.tasks`.
Defaults to inheriting I/O: input is read and output is printed
while the process runs. Throws on non-zero exit codes. Kills all
subprocesses on shutdown. Optional options map can be passed as the
first argument, followed by multiple command line arguments. The
first command line argument is automatically tokenized.
Examples:
- `(shell \"ls -la\")`
- `(shell {:out \"/tmp/log.txt\"} \"git commit -m\" \"WIP\")`
Also see the `shell` entry in the babashka book [here](https://book.babashka.org/#_shell)."
{:arglists '([opts? & args])}
[& args]
(let [{:keys [opts] :as args} (parse-args args)]
(let [proc (process* (assoc args :opts (merge default-shell-opts opts)))
proc (deref proc)]
(if (:continue opts)
proc
(check proc )))))
(defn alive?
"Returns `true` if the process is still running and false otherwise."
[p]
(.isAlive ^java.lang.Process (:proc p)))
#?(:bb nil
:clj
(when (contains? (loaded-libs) 'clojure.pprint) ;; pprint was already loaded, e.g. by nREPL
(require '[babashka.process.pprint])))