run-program.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) README
(DIR) LICENSE
---
run-program.lisp (30529B)
---
1 ;;;; -------------------------------------------------------------------------
2 ;;;; run-program initially from xcvb-driver.
3
4 (uiop/package:define-package :uiop/run-program
5 (:nicknames :asdf/run-program) ; OBSOLETE. Used by cl-sane, printv.
6 (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/version
7 :uiop/pathname :uiop/os :uiop/filesystem :uiop/stream :uiop/launch-program)
8 (:export
9 #:run-program
10 #:slurp-input-stream #:vomit-output-stream
11 #:subprocess-error
12 #:subprocess-error-code #:subprocess-error-command #:subprocess-error-process)
13 (:import-from :uiop/launch-program
14 #:%handle-if-does-not-exist #:%handle-if-exists #:%interactivep
15 #:input-stream #:output-stream #:error-output-stream))
16 (in-package :uiop/run-program)
17
18 ;;;; Slurping a stream, typically the output of another program
19 (with-upgradability ()
20 (defun call-stream-processor (fun processor stream)
21 "Given FUN (typically SLURP-INPUT-STREAM or VOMIT-OUTPUT-STREAM,
22 a PROCESSOR specification which is either an atom or a list specifying
23 a processor an keyword arguments, call the specified processor with
24 the given STREAM as input"
25 (if (consp processor)
26 (apply fun (first processor) stream (rest processor))
27 (funcall fun processor stream)))
28
29 (defgeneric slurp-input-stream (processor input-stream &key)
30 (:documentation
31 "SLURP-INPUT-STREAM is a generic function with two positional arguments
32 PROCESSOR and INPUT-STREAM and additional keyword arguments, that consumes (slurps)
33 the contents of the INPUT-STREAM and processes them according to a method
34 specified by PROCESSOR.
35
36 Built-in methods include the following:
37 * if PROCESSOR is a function, it is called with the INPUT-STREAM as its argument
38 * if PROCESSOR is a list, its first element should be a function. It will be applied to a cons of the
39 INPUT-STREAM and the rest of the list. That is (x . y) will be treated as
40 \(APPLY x <stream> y\)
41 * if PROCESSOR is an output-stream, the contents of INPUT-STREAM is copied to the output-stream,
42 per copy-stream-to-stream, with appropriate keyword arguments.
43 * if PROCESSOR is the symbol CL:STRING or the keyword :STRING, then the contents of INPUT-STREAM
44 are returned as a string, as per SLURP-STREAM-STRING.
45 * if PROCESSOR is the keyword :LINES then the INPUT-STREAM will be handled by SLURP-STREAM-LINES.
46 * if PROCESSOR is the keyword :LINE then the INPUT-STREAM will be handled by SLURP-STREAM-LINE.
47 * if PROCESSOR is the keyword :FORMS then the INPUT-STREAM will be handled by SLURP-STREAM-FORMS.
48 * if PROCESSOR is the keyword :FORM then the INPUT-STREAM will be handled by SLURP-STREAM-FORM.
49 * if PROCESSOR is T, it is treated the same as *standard-output*. If it is NIL, NIL is returned.
50
51 Programmers are encouraged to define their own methods for this generic function."))
52
53 #-genera
54 (defmethod slurp-input-stream ((function function) input-stream &key)
55 (funcall function input-stream))
56
57 (defmethod slurp-input-stream ((list cons) input-stream &key)
58 (apply (first list) input-stream (rest list)))
59
60 #-genera
61 (defmethod slurp-input-stream ((output-stream stream) input-stream
62 &key linewise prefix (element-type 'character) buffer-size)
63 (copy-stream-to-stream
64 input-stream output-stream
65 :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
66
67 (defmethod slurp-input-stream ((x (eql 'string)) stream &key stripped)
68 (slurp-stream-string stream :stripped stripped))
69
70 (defmethod slurp-input-stream ((x (eql :string)) stream &key stripped)
71 (slurp-stream-string stream :stripped stripped))
72
73 (defmethod slurp-input-stream ((x (eql :lines)) stream &key count)
74 (slurp-stream-lines stream :count count))
75
76 (defmethod slurp-input-stream ((x (eql :line)) stream &key (at 0))
77 (slurp-stream-line stream :at at))
78
79 (defmethod slurp-input-stream ((x (eql :forms)) stream &key count)
80 (slurp-stream-forms stream :count count))
81
82 (defmethod slurp-input-stream ((x (eql :form)) stream &key (at 0))
83 (slurp-stream-form stream :at at))
84
85 (defmethod slurp-input-stream ((x (eql t)) stream &rest keys &key &allow-other-keys)
86 (apply 'slurp-input-stream *standard-output* stream keys))
87
88 (defmethod slurp-input-stream ((x null) (stream t) &key)
89 nil)
90
91 (defmethod slurp-input-stream ((pathname pathname) input
92 &key
93 (element-type *default-stream-element-type*)
94 (external-format *utf-8-external-format*)
95 (if-exists :rename-and-delete)
96 (if-does-not-exist :create)
97 buffer-size
98 linewise)
99 (with-output-file (output pathname
100 :element-type element-type
101 :external-format external-format
102 :if-exists if-exists
103 :if-does-not-exist if-does-not-exist)
104 (copy-stream-to-stream
105 input output
106 :element-type element-type :buffer-size buffer-size :linewise linewise)))
107
108 (defmethod slurp-input-stream (x stream
109 &key linewise prefix (element-type 'character) buffer-size)
110 (declare (ignorable stream linewise prefix element-type buffer-size))
111 (cond
112 #+genera
113 ((functionp x) (funcall x stream))
114 #+genera
115 ((output-stream-p x)
116 (copy-stream-to-stream
117 stream x
118 :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
119 (t
120 (parameter-error "Invalid ~S destination ~S" 'slurp-input-stream x)))))
121
122 ;;;; Vomiting a stream, typically into the input of another program.
123 (with-upgradability ()
124 (defgeneric vomit-output-stream (processor output-stream &key)
125 (:documentation
126 "VOMIT-OUTPUT-STREAM is a generic function with two positional arguments
127 PROCESSOR and OUTPUT-STREAM and additional keyword arguments, that produces (vomits)
128 some content onto the OUTPUT-STREAM, according to a method specified by PROCESSOR.
129
130 Built-in methods include the following:
131 * if PROCESSOR is a function, it is called with the OUTPUT-STREAM as its argument
132 * if PROCESSOR is a list, its first element should be a function.
133 It will be applied to a cons of the OUTPUT-STREAM and the rest of the list.
134 That is (x . y) will be treated as \(APPLY x <stream> y\)
135 * if PROCESSOR is an input-stream, its contents will be copied the OUTPUT-STREAM,
136 per copy-stream-to-stream, with appropriate keyword arguments.
137 * if PROCESSOR is a string, its contents will be printed to the OUTPUT-STREAM.
138 * if PROCESSOR is T, it is treated the same as *standard-input*. If it is NIL, nothing is done.
139
140 Programmers are encouraged to define their own methods for this generic function."))
141
142 #-genera
143 (defmethod vomit-output-stream ((function function) output-stream &key)
144 (funcall function output-stream))
145
146 (defmethod vomit-output-stream ((list cons) output-stream &key)
147 (apply (first list) output-stream (rest list)))
148
149 #-genera
150 (defmethod vomit-output-stream ((input-stream stream) output-stream
151 &key linewise prefix (element-type 'character) buffer-size)
152 (copy-stream-to-stream
153 input-stream output-stream
154 :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
155
156 (defmethod vomit-output-stream ((x string) stream &key fresh-line terpri)
157 (princ x stream)
158 (when fresh-line (fresh-line stream))
159 (when terpri (terpri stream))
160 (values))
161
162 (defmethod vomit-output-stream ((x (eql t)) stream &rest keys &key &allow-other-keys)
163 (apply 'vomit-output-stream *standard-input* stream keys))
164
165 (defmethod vomit-output-stream ((x null) (stream t) &key)
166 (values))
167
168 (defmethod vomit-output-stream ((pathname pathname) input
169 &key
170 (element-type *default-stream-element-type*)
171 (external-format *utf-8-external-format*)
172 (if-exists :rename-and-delete)
173 (if-does-not-exist :create)
174 buffer-size
175 linewise)
176 (with-output-file (output pathname
177 :element-type element-type
178 :external-format external-format
179 :if-exists if-exists
180 :if-does-not-exist if-does-not-exist)
181 (copy-stream-to-stream
182 input output
183 :element-type element-type :buffer-size buffer-size :linewise linewise)))
184
185 (defmethod vomit-output-stream (x stream
186 &key linewise prefix (element-type 'character) buffer-size)
187 (declare (ignorable stream linewise prefix element-type buffer-size))
188 (cond
189 #+genera
190 ((functionp x) (funcall x stream))
191 #+genera
192 ((input-stream-p x)
193 (copy-stream-to-stream
194 x stream
195 :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
196 (t
197 (parameter-error "Invalid ~S source ~S" 'vomit-output-stream x)))))
198
199
200 ;;;; Run-program: synchronously run a program in a subprocess, handling input, output and error-output.
201 (with-upgradability ()
202 (define-condition subprocess-error (error)
203 ((code :initform nil :initarg :code :reader subprocess-error-code)
204 (command :initform nil :initarg :command :reader subprocess-error-command)
205 (process :initform nil :initarg :process :reader subprocess-error-process))
206 (:report (lambda (condition stream)
207 (format stream "Subprocess ~@[~S~% ~]~@[with command ~S~% ~]exited with error~@[ code ~D~]"
208 (subprocess-error-process condition)
209 (subprocess-error-command condition)
210 (subprocess-error-code condition)))))
211
212 (defun %check-result (exit-code &key command process ignore-error-status)
213 (unless ignore-error-status
214 (unless (eql exit-code 0)
215 (cerror "IGNORE-ERROR-STATUS"
216 'subprocess-error :command command :code exit-code :process process)))
217 exit-code)
218
219 (defun %active-io-specifier-p (specifier)
220 "Determines whether a run-program I/O specifier requires Lisp-side processing
221 via SLURP-INPUT-STREAM or VOMIT-OUTPUT-STREAM (return T),
222 or whether it's already taken care of by the implementation's underlying run-program."
223 (not (typep specifier '(or null string pathname (member :interactive :output)
224 #+(or cmucl (and sbcl os-unix) scl) (or stream (eql t))
225 #+lispworks file-stream))))
226
227 (defun %run-program (command &rest keys &key &allow-other-keys)
228 "DEPRECATED. Use LAUNCH-PROGRAM instead."
229 (apply 'launch-program command keys))
230
231 (defun %call-with-program-io (gf tval stream-easy-p fun direction spec activep returner
232 &key
233 (element-type #-clozure *default-stream-element-type* #+clozure 'character)
234 (external-format *utf-8-external-format*) &allow-other-keys)
235 ;; handle redirection for run-program and system
236 ;; SPEC is the specification for the subprocess's input or output or error-output
237 ;; TVAL is the value used if the spec is T
238 ;; GF is the generic function to call to handle arbitrary values of SPEC
239 ;; STREAM-EASY-P is T if we're going to use a RUN-PROGRAM that copies streams in the background
240 ;; (it's only meaningful on CMUCL, SBCL, SCL that actually do it)
241 ;; DIRECTION is :INPUT, :OUTPUT or :ERROR-OUTPUT for the direction of this io argument
242 ;; FUN is a function of the new reduced spec and an activity function to call with a stream
243 ;; when the subprocess is active and communicating through that stream.
244 ;; ACTIVEP is a boolean true if we will get to run code while the process is running
245 ;; ELEMENT-TYPE and EXTERNAL-FORMAT control what kind of temporary file we may open.
246 ;; RETURNER is a function called with the value of the activity.
247 ;; --- TODO (fare@tunes.org): handle if-output-exists and such when doing it the hard way.
248 (declare (ignorable stream-easy-p))
249 (let* ((actual-spec (if (eq spec t) tval spec))
250 (activity-spec (if (eq actual-spec :output)
251 (ecase direction
252 ((:input :output)
253 (parameter-error "~S does not allow ~S as a ~S spec"
254 'run-program :output direction))
255 ((:error-output)
256 nil))
257 actual-spec)))
258 (labels ((activity (stream)
259 (call-function returner (call-stream-processor gf activity-spec stream)))
260 (easy-case ()
261 (funcall fun actual-spec nil))
262 (hard-case ()
263 (if activep
264 (funcall fun :stream #'activity)
265 (with-temporary-file (:pathname tmp)
266 (ecase direction
267 (:input
268 (with-output-file (s tmp :if-exists :overwrite
269 :external-format external-format
270 :element-type element-type)
271 (activity s))
272 (funcall fun tmp nil))
273 ((:output :error-output)
274 (multiple-value-prog1 (funcall fun tmp nil)
275 (with-input-file (s tmp
276 :external-format external-format
277 :element-type element-type)
278 (activity s)))))))))
279 (typecase activity-spec
280 ((or null string pathname (eql :interactive))
281 (easy-case))
282 #+(or cmucl (and sbcl os-unix) scl) ;; streams are only easy on implementations that try very hard
283 (stream
284 (if stream-easy-p (easy-case) (hard-case)))
285 (t
286 (hard-case))))))
287
288 (defmacro place-setter (place)
289 (when place
290 (let ((value (gensym)))
291 `#'(lambda (,value) (setf ,place ,value)))))
292
293 (defmacro with-program-input (((reduced-input-var
294 &optional (input-activity-var (gensym) iavp))
295 input-form &key setf stream-easy-p active keys) &body body)
296 `(apply '%call-with-program-io 'vomit-output-stream *standard-input* ,stream-easy-p
297 #'(lambda (,reduced-input-var ,input-activity-var)
298 ,@(unless iavp `((declare (ignore ,input-activity-var))))
299 ,@body)
300 :input ,input-form ,active (place-setter ,setf) ,keys))
301
302 (defmacro with-program-output (((reduced-output-var
303 &optional (output-activity-var (gensym) oavp))
304 output-form &key setf stream-easy-p active keys) &body body)
305 `(apply '%call-with-program-io 'slurp-input-stream *standard-output* ,stream-easy-p
306 #'(lambda (,reduced-output-var ,output-activity-var)
307 ,@(unless oavp `((declare (ignore ,output-activity-var))))
308 ,@body)
309 :output ,output-form ,active (place-setter ,setf) ,keys))
310
311 (defmacro with-program-error-output (((reduced-error-output-var
312 &optional (error-output-activity-var (gensym) eoavp))
313 error-output-form &key setf stream-easy-p active keys)
314 &body body)
315 `(apply '%call-with-program-io 'slurp-input-stream *error-output* ,stream-easy-p
316 #'(lambda (,reduced-error-output-var ,error-output-activity-var)
317 ,@(unless eoavp `((declare (ignore ,error-output-activity-var))))
318 ,@body)
319 :error-output ,error-output-form ,active (place-setter ,setf) ,keys))
320
321 (defun %use-launch-program (command &rest keys
322 &key input output error-output ignore-error-status &allow-other-keys)
323 ;; helper for RUN-PROGRAM when using LAUNCH-PROGRAM
324 #+(or cormanlisp gcl (and lispworks os-windows) mcl xcl)
325 (progn
326 command keys input output error-output ignore-error-status ;; ignore
327 (not-implemented-error '%use-launch-program))
328 (when (member :stream (list input output error-output))
329 (parameter-error "~S: ~S is not allowed as synchronous I/O redirection argument"
330 'run-program :stream))
331 (let* ((active-input-p (%active-io-specifier-p input))
332 (active-output-p (%active-io-specifier-p output))
333 (active-error-output-p (%active-io-specifier-p error-output))
334 (activity
335 (cond
336 (active-output-p :output)
337 (active-input-p :input)
338 (active-error-output-p :error-output)
339 (t nil)))
340 output-result error-output-result exit-code process-info)
341 (with-program-output ((reduced-output output-activity)
342 output :keys keys :setf output-result
343 :stream-easy-p t :active (eq activity :output))
344 (with-program-error-output ((reduced-error-output error-output-activity)
345 error-output :keys keys :setf error-output-result
346 :stream-easy-p t :active (eq activity :error-output))
347 (with-program-input ((reduced-input input-activity)
348 input :keys keys
349 :stream-easy-p t :active (eq activity :input))
350 (setf process-info
351 (apply 'launch-program command
352 :input reduced-input :output reduced-output
353 :error-output (if (eq error-output :output) :output reduced-error-output)
354 keys))
355 (labels ((get-stream (stream-name &optional fallbackp)
356 (or (slot-value process-info stream-name)
357 (when fallbackp
358 (slot-value process-info 'bidir-stream))))
359 (run-activity (activity stream-name &optional fallbackp)
360 (if-let (stream (get-stream stream-name fallbackp))
361 (funcall activity stream)
362 (error 'subprocess-error
363 :code `(:missing ,stream-name)
364 :command command :process process-info))))
365 (unwind-protect
366 (ecase activity
367 ((nil))
368 (:input (run-activity input-activity 'input-stream t))
369 (:output (run-activity output-activity 'output-stream t))
370 (:error-output (run-activity error-output-activity 'error-output-stream)))
371 (close-streams process-info)
372 (setf exit-code (wait-process process-info)))))))
373 (%check-result exit-code
374 :command command :process process-info
375 :ignore-error-status ignore-error-status)
376 (values output-result error-output-result exit-code)))
377
378 (defun %normalize-system-command (command) ;; helper for %USE-SYSTEM
379 (etypecase command
380 (string command)
381 (list (escape-shell-command
382 (os-cond
383 ((os-unix-p) (cons "exec" command))
384 (t command))))))
385
386 (defun %redirected-system-command (command in out err directory) ;; helper for %USE-SYSTEM
387 (flet ((redirect (spec operator)
388 (let ((pathname
389 (typecase spec
390 (null (null-device-pathname))
391 (string (parse-native-namestring spec))
392 (pathname spec)
393 ((eql :output)
394 (unless (equal operator " 2>>")
395 (parameter-error "~S: only the ~S argument can be ~S"
396 'run-program :error-output :output))
397 (return-from redirect '(" 2>&1"))))))
398 (when pathname
399 (list operator " "
400 (escape-shell-token (native-namestring pathname)))))))
401 (let* ((redirections (append (redirect in " <") (redirect out " >>") (redirect err " 2>>")))
402 (normalized (%normalize-system-command command))
403 (directory (or directory #+(or abcl xcl) (getcwd)))
404 (chdir (when directory
405 (let ((dir-arg (escape-shell-token (native-namestring directory))))
406 (os-cond
407 ((os-unix-p) `("cd " ,dir-arg " ; "))
408 ((os-windows-p) `("cd /d " ,dir-arg " & ")))))))
409 (reduce/strcat
410 (os-cond
411 ((os-unix-p) `(,@(when redirections `("exec " ,@redirections " ; ")) ,@chdir ,normalized))
412 ((os-windows-p) `(,@redirections " (" ,@chdir ,normalized ")")))))))
413
414 (defun %system (command &rest keys &key directory
415 input (if-input-does-not-exist :error)
416 output (if-output-exists :supersede)
417 error-output (if-error-output-exists :supersede)
418 &allow-other-keys)
419 "A portable abstraction of a low-level call to libc's system()."
420 (declare (ignorable keys directory input if-input-does-not-exist output
421 if-output-exists error-output if-error-output-exists))
422 (when (member :stream (list input output error-output))
423 (parameter-error "~S: ~S is not allowed as synchronous I/O redirection argument"
424 'run-program :stream))
425 #+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl)
426 (let (#+(or abcl ecl mkcl)
427 (version (parse-version
428 #-abcl
429 (lisp-implementation-version)
430 #+abcl
431 (second (split-string (implementation-identifier) :separator '(#\-))))))
432 (nest
433 #+abcl (unless (lexicographic< '< version '(1 4 0)))
434 #+ecl (unless (lexicographic<= '< version '(16 0 0)))
435 #+mkcl (unless (lexicographic<= '< version '(1 1 9)))
436 (return-from %system
437 (wait-process
438 (apply 'launch-program (%normalize-system-command command) keys)))))
439 #+(or abcl clasp clisp cormanlisp ecl gcl genera (and lispworks os-windows) mkcl xcl)
440 (let ((%command (%redirected-system-command command input output error-output directory)))
441 ;; see comments for these functions
442 (%handle-if-does-not-exist input if-input-does-not-exist)
443 (%handle-if-exists output if-output-exists)
444 (%handle-if-exists error-output if-error-output-exists)
445 #+abcl (ext:run-shell-command %command)
446 #+(or clasp ecl) (let ((*standard-input* *stdin*)
447 (*standard-output* *stdout*)
448 (*error-output* *stderr*))
449 (ext:system %command))
450 #+clisp
451 (let ((raw-exit-code
452 (or
453 #.`(#+os-windows ,@'(ext:run-shell-command %command)
454 #+os-unix ,@'(ext:run-program "/bin/sh" :arguments `("-c" ,%command))
455 :wait t :input :terminal :output :terminal)
456 0)))
457 (if (minusp raw-exit-code)
458 (- 128 raw-exit-code)
459 raw-exit-code))
460 #+cormanlisp (win32:system %command)
461 #+gcl (system:system %command)
462 #+genera (not-implemented-error '%system)
463 #+(and lispworks os-windows)
464 (system:call-system %command :current-directory directory :wait t)
465 #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
466 #+mkcl (mkcl:system %command)
467 #+xcl (system:%run-shell-command %command)))
468
469 (defun %use-system (command &rest keys
470 &key input output error-output ignore-error-status &allow-other-keys)
471 ;; helper for RUN-PROGRAM when using %system
472 (let (output-result error-output-result exit-code)
473 (with-program-output ((reduced-output)
474 output :keys keys :setf output-result)
475 (with-program-error-output ((reduced-error-output)
476 error-output :keys keys :setf error-output-result)
477 (with-program-input ((reduced-input) input :keys keys)
478 (setf exit-code (apply '%system command
479 :input reduced-input :output reduced-output
480 :error-output reduced-error-output keys)))))
481 (%check-result exit-code
482 :command command
483 :ignore-error-status ignore-error-status)
484 (values output-result error-output-result exit-code)))
485
486 (defun run-program (command &rest keys
487 &key ignore-error-status (force-shell nil force-shell-suppliedp)
488 input (if-input-does-not-exist :error)
489 output (if-output-exists :supersede)
490 error-output (if-error-output-exists :supersede)
491 (element-type #-clozure *default-stream-element-type* #+clozure 'character)
492 (external-format *utf-8-external-format*)
493 &allow-other-keys)
494 "Run program specified by COMMAND,
495 either a list of strings specifying a program and list of arguments,
496 or a string specifying a shell command (/bin/sh on Unix, CMD.EXE on Windows);
497 _synchronously_ process its output as specified and return the processing results
498 when the program and its output processing are complete.
499
500 Always call a shell (rather than directly execute the command when possible)
501 if FORCE-SHELL is specified. Similarly, never call a shell if FORCE-SHELL is
502 specified to be NIL.
503
504 Signal a continuable SUBPROCESS-ERROR if the process wasn't successful (exit-code 0),
505 unless IGNORE-ERROR-STATUS is specified.
506
507 If OUTPUT is a pathname, a string designating a pathname, or NIL (the default)
508 designating the null device, the file at that path is used as output.
509 If it's :INTERACTIVE, output is inherited from the current process;
510 beware that this may be different from your *STANDARD-OUTPUT*,
511 and under SLIME will be on your *inferior-lisp* buffer.
512 If it's T, output goes to your current *STANDARD-OUTPUT* stream.
513 Otherwise, OUTPUT should be a value that is a suitable first argument to
514 SLURP-INPUT-STREAM (qv.), or a list of such a value and keyword arguments.
515 In this case, RUN-PROGRAM will create a temporary stream for the program output;
516 the program output, in that stream, will be processed by a call to SLURP-INPUT-STREAM,
517 using OUTPUT as the first argument (or the first element of OUTPUT, and the rest as keywords).
518 The primary value resulting from that call (or NIL if no call was needed)
519 will be the first value returned by RUN-PROGRAM.
520 E.g., using :OUTPUT :STRING will have it return the entire output stream as a string.
521 And using :OUTPUT '(:STRING :STRIPPED T) will have it return the same string
522 stripped of any ending newline.
523
524 IF-OUTPUT-EXISTS, which is only meaningful if OUTPUT is a string or a
525 pathname, can take the values :ERROR, :APPEND, and :SUPERSEDE (the
526 default). The meaning of these values and their effect on the case
527 where OUTPUT does not exist, is analogous to the IF-EXISTS parameter
528 to OPEN with :DIRECTION :OUTPUT.
529
530 ERROR-OUTPUT is similar to OUTPUT, except that the resulting value is returned
531 as the second value of RUN-PROGRAM. T designates the *ERROR-OUTPUT*.
532 Also :OUTPUT means redirecting the error output to the output stream,
533 in which case NIL is returned.
534
535 IF-ERROR-OUTPUT-EXISTS is similar to IF-OUTPUT-EXIST, except that it
536 affects ERROR-OUTPUT rather than OUTPUT.
537
538 INPUT is similar to OUTPUT, except that VOMIT-OUTPUT-STREAM is used,
539 no value is returned, and T designates the *STANDARD-INPUT*.
540
541 IF-INPUT-DOES-NOT-EXIST, which is only meaningful if INPUT is a string
542 or a pathname, can take the values :CREATE and :ERROR (the
543 default). The meaning of these values is analogous to the
544 IF-DOES-NOT-EXIST parameter to OPEN with :DIRECTION :INPUT.
545
546 ELEMENT-TYPE and EXTERNAL-FORMAT are passed on
547 to your Lisp implementation, when applicable, for creation of the output stream.
548
549 One and only one of the stream slurping or vomiting may or may not happen
550 in parallel in parallel with the subprocess,
551 depending on options and implementation,
552 and with priority being given to output processing.
553 Other streams are completely produced or consumed
554 before or after the subprocess is spawned, using temporary files.
555
556 RUN-PROGRAM returns 3 values:
557 0- the result of the OUTPUT slurping if any, or NIL
558 1- the result of the ERROR-OUTPUT slurping if any, or NIL
559 2- either 0 if the subprocess exited with success status,
560 or an indication of failure via the EXIT-CODE of the process"
561 (declare (ignorable input output error-output if-input-does-not-exist if-output-exists
562 if-error-output-exists element-type external-format ignore-error-status))
563 #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl lispworks mcl mkcl sbcl scl xcl)
564 (not-implemented-error 'run-program)
565 (apply (if (or force-shell
566 ;; Per doc string, set FORCE-SHELL to T if we get command as a string.
567 ;; But don't override user's specified preference. [2015/06/29:rpg]
568 (and (stringp command)
569 (or (not force-shell-suppliedp)
570 #-(or allegro clisp clozure sbcl) (os-cond ((os-windows-p) t))))
571 #+(or clasp clisp cormanlisp gcl (and lispworks os-windows) mcl xcl) t
572 ;; A race condition in ECL <= 16.0.0 prevents using ext:run-program
573 #+ecl #.(if-let (ver (parse-version (lisp-implementation-version)))
574 (lexicographic<= '< ver '(16 0 0)))
575 #+(and lispworks os-unix) (%interactivep input output error-output))
576 '%use-system '%use-launch-program)
577 command keys)))
578