run-program.lisp 29.6 KB
Newer Older
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
13
14
15
   #:subprocess-error-code #:subprocess-error-command #:subprocess-error-process)
  (:import-from :uiop/launch-program
   #:%handle-if-does-not-exist #:%handle-if-exists #:%interactivep
   #: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
22
23
24
    "Given FUN (typically SLURP-INPUT-STREAM or VOMIT-OUTPUT-STREAM,
a PROCESSOR specification which is either an atom or a list specifying
a processor an keyword arguments, call the specified processor with
the given STREAM as input"
25
26
27
28
    (if (consp processor)
        (apply fun (first processor) stream (rest processor))
        (funcall fun processor stream)))

29
  (defgeneric slurp-input-stream (processor input-stream &key)
30
31
32
33
34
35
36
37
    (:documentation
     "SLURP-INPUT-STREAM is a generic function with two positional arguments
PROCESSOR and INPUT-STREAM and additional keyword arguments, that consumes (slurps)
the contents of the INPUT-STREAM and processes them according to a method
specified by PROCESSOR.

Built-in methods include the following:
* 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
40
  INPUT-STREAM and the rest of the list.  That is (x . y) will be treated as
    \(APPLY x <stream> y\)
41
* if PROCESSOR is an output-stream, the contents of INPUT-STREAM is copied to the output-stream,
42
43
44
45
46
47
48
  per copy-stream-to-stream, with appropriate keyword arguments.
* if PROCESSOR is the symbol CL:STRING or the keyword :STRING, then the contents of INPUT-STREAM
  are returned as a string, as per SLURP-STREAM-STRING.
* if PROCESSOR is the keyword :LINES then the INPUT-STREAM will be handled by SLURP-STREAM-LINES.
* if PROCESSOR is the keyword :LINE then the INPUT-STREAM will be handled by SLURP-STREAM-LINE.
* if PROCESSOR is the keyword :FORMS then the INPUT-STREAM will be handled by SLURP-STREAM-FORMS.
* 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
56
    (funcall function input-stream))

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
64
65
66
    (copy-stream-to-stream
     input-stream output-stream
     :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))

67
68
  (defmethod slurp-input-stream ((x (eql 'string)) stream &key stripped)
    (slurp-stream-string stream :stripped stripped))
69

70
71
  (defmethod slurp-input-stream ((x (eql :string)) stream &key stripped)
    (slurp-stream-string stream :stripped stripped))
72

73
  (defmethod slurp-input-stream ((x (eql :lines)) stream &key count)
74
75
    (slurp-stream-lines stream :count count))

76
  (defmethod slurp-input-stream ((x (eql :line)) stream &key (at 0))
77
78
    (slurp-stream-line stream :at at))

79
  (defmethod slurp-input-stream ((x (eql :forms)) stream &key count)
80
81
    (slurp-stream-forms stream :count count))

82
  (defmethod slurp-input-stream ((x (eql :form)) stream &key (at 0))
83
84
    (slurp-stream-form stream :at at))

85
86
87
  (defmethod slurp-input-stream ((x (eql t)) stream &rest keys &key &allow-other-keys)
    (apply 'slurp-input-stream *standard-output* stream keys))

Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
88
  (defmethod slurp-input-stream ((x null) (stream t) &key)
89
90
    nil)

91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
  (defmethod slurp-input-stream ((pathname pathname) input
                                 &key
                                   (element-type *default-stream-element-type*)
                                   (external-format *utf-8-external-format*)
                                   (if-exists :rename-and-delete)
                                   (if-does-not-exist :create)
                                   buffer-size
                                   linewise)
    (with-output-file (output pathname
                              :element-type element-type
                              :external-format external-format
                              :if-exists if-exists
                              :if-does-not-exist if-does-not-exist)
      (copy-stream-to-stream
       input output
       :element-type element-type :buffer-size buffer-size :linewise linewise)))

108
  (defmethod slurp-input-stream (x stream
109
                                 &key linewise prefix (element-type 'character) buffer-size)
110
111
    (declare (ignorable stream linewise prefix element-type buffer-size))
    (cond
112
      #+genera
113
      ((functionp x) (funcall x stream))
114
      #+genera
115
116
      ((output-stream-p x)
       (copy-stream-to-stream
117
        stream x
118
119
        :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
      (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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
    (:documentation
     "VOMIT-OUTPUT-STREAM is a generic function with two positional arguments
PROCESSOR and OUTPUT-STREAM and additional keyword arguments, that produces (vomits)
some content onto the OUTPUT-STREAM, according to a method specified by PROCESSOR.

Built-in methods include the following:
* if PROCESSOR is a function, it is called with the OUTPUT-STREAM as its argument
* if PROCESSOR is a list, its first element should be a function.
  It will be applied to a cons of the OUTPUT-STREAM and the rest of the list.
  That is (x . y) will be treated as \(APPLY x <stream> y\)
* if PROCESSOR is an input-stream, its contents will be copied the OUTPUT-STREAM,
  per copy-stream-to-stream, with appropriate keyword arguments.
* if PROCESSOR is a string, its contents will be printed to the OUTPUT-STREAM.
* if PROCESSOR is T, it is treated the same as *standard-input*. If it is NIL, nothing is done.

Programmers are encouraged to define their own methods for this generic function."))

142
  #-genera
143
  (defmethod vomit-output-stream ((function function) output-stream &key)
144
145
    (funcall function output-stream))

146
  (defmethod vomit-output-stream ((list cons) output-stream &key)
147
148
    (apply (first list) output-stream (rest list)))

149
  #-genera
150
  (defmethod vomit-output-stream ((input-stream stream) output-stream
151
                                 &key linewise prefix (element-type 'character) buffer-size)
152
153
154
155
    (copy-stream-to-stream
     input-stream output-stream
     :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))

156
  (defmethod vomit-output-stream ((x string) stream &key fresh-line terpri)
157
158
159
160
161
162
163
164
    (princ x stream)
    (when fresh-line (fresh-line stream))
    (when terpri (terpri stream))
    (values))

  (defmethod vomit-output-stream ((x (eql t)) stream &rest keys &key &allow-other-keys)
    (apply 'vomit-output-stream *standard-input* stream keys))

165
  (defmethod vomit-output-stream ((x null) (stream t) &key)
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
    (values))

  (defmethod vomit-output-stream ((pathname pathname) input
                                 &key
                                   (element-type *default-stream-element-type*)
                                   (external-format *utf-8-external-format*)
                                   (if-exists :rename-and-delete)
                                   (if-does-not-exist :create)
                                   buffer-size
                                   linewise)
    (with-output-file (output pathname
                              :element-type element-type
                              :external-format external-format
                              :if-exists if-exists
                              :if-does-not-exist if-does-not-exist)
      (copy-stream-to-stream
       input output
       :element-type element-type :buffer-size buffer-size :linewise linewise)))

  (defmethod vomit-output-stream (x stream
186
                                 &key linewise prefix (element-type 'character) buffer-size)
187
188
    (declare (ignorable stream linewise prefix element-type buffer-size))
    (cond
189
      #+genera
190
      ((functionp x) (funcall x stream))
191
      #+genera
192
193
194
195
196
      ((input-stream-p x)
       (copy-stream-to-stream
        x stream
        :linewise linewise :prefix prefix :element-type element-type :buffer-size buffer-size))
      (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
202
203
204
205
206
(with-upgradability ()
  (define-condition subprocess-error (error)
    ((code :initform nil :initarg :code :reader subprocess-error-code)
     (command :initform nil :initarg :command :reader subprocess-error-command)
     (process :initform nil :initarg :process :reader subprocess-error-process))
    (:report (lambda (condition stream)
207
               (format stream "Subprocess ~@[~S~% ~]~@[with command ~S~% ~]exited with error~@[ code ~D~]"
208
209
210
211
                       (subprocess-error-process condition)
                       (subprocess-error-command condition)
                       (subprocess-error-code condition)))))

212
213
214
215
216
217
  (defun %check-result (exit-code &key command process ignore-error-status)
    (unless ignore-error-status
      (unless (eql exit-code 0)
        (cerror "IGNORE-ERROR-STATUS"
                'subprocess-error :command command :code exit-code :process process)))
    exit-code)
218
219

  (defun %active-io-specifier-p (specifier)
220
221
222
    "Determines whether a run-program I/O specifier requires Lisp-side processing
via SLURP-INPUT-STREAM or VOMIT-OUTPUT-STREAM (return T),
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))
Elias Pipping's avatar
Elias Pipping committed
225
                            #+lispworks file-stream))))
226

227
228
229
230
  (defun %run-program (command &rest keys &key &allow-other-keys)
    "DEPRECATED. Use LAUNCH-PROGRAM instead."
    (apply 'launch-program command keys))

231
  (defun %call-with-program-io (gf tval stream-easy-p fun direction spec activep returner
232
233
234
                                &key
                                  (element-type #-clozure *default-stream-element-type* #+clozure 'character)
                                  (external-format *utf-8-external-format*) &allow-other-keys)
235
236
237
238
239
240
    ;; handle redirection for run-program and system
    ;; SPEC is the specification for the subprocess's input or output or error-output
    ;; TVAL is the value used if the spec is T
    ;; GF is the generic function to call to handle arbitrary values of SPEC
    ;; STREAM-EASY-P is T if we're going to use a RUN-PROGRAM that copies streams in the background
    ;; (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
243
244
245
246
247
248
    ;; FUN is a function of the new reduced spec and an activity function to call with a stream
    ;; when the subprocess is active and communicating through that stream.
    ;; ACTIVEP is a boolean true if we will get to run code while the process is running
    ;; ELEMENT-TYPE and EXTERNAL-FORMAT control what kind of temporary file we may open.
    ;; RETURNER is a function called with the value of the activity.
    ;; --- TODO (fare@tunes.org): handle if-output-exists and such when doing it the hard way.
    (declare (ignorable stream-easy-p))
249
250
251
252
    (let* ((actual-spec (if (eq spec t) tval spec))
           (activity-spec (if (eq actual-spec :output)
                              (ecase direction
                                ((:input :output)
253
254
                                 (parameter-error "~S does not allow ~S as a ~S spec"
                                                  'run-program :output direction))
255
256
257
258
259
260
261
262
263
264
                                ((:error-output)
                                 nil))
                              actual-spec)))
      (labels ((activity (stream)
                 (call-function returner (call-stream-processor gf activity-spec stream)))
               (easy-case ()
                 (funcall fun actual-spec nil))
               (hard-case ()
                 (if activep
                     (funcall fun :stream #'activity)
265
                     (with-temporary-file (:pathname tmp)
266
267
                       (ecase direction
                         (:input
268
269
270
271
                          (with-output-file (s tmp :if-exists :overwrite
                                               :external-format external-format
                                               :element-type element-type)
                            (activity s))
272
273
                          (funcall fun tmp nil))
                         ((:output :error-output)
274
275
276
277
278
                          (multiple-value-prog1 (funcall fun tmp nil)
                            (with-input-file (s tmp
                                               :external-format external-format
                                               :element-type element-type)
                              (activity s)))))))))
279
280
281
        (typecase activity-spec
          ((or null string pathname (eql :interactive))
           (easy-case))
282
          #+(or cmucl (and sbcl os-unix) scl) ;; streams are only easy on implementations that try very hard
283
284
285
286
          (stream
           (if stream-easy-p (easy-case) (hard-case)))
          (t
           (hard-case))))))
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

  (defmacro place-setter (place)
    (when place
      (let ((value (gensym)))
        `#'(lambda (,value) (setf ,place ,value)))))

  (defmacro with-program-input (((reduced-input-var
                                  &optional (input-activity-var (gensym) iavp))
                                 input-form &key setf stream-easy-p active keys) &body body)
    `(apply '%call-with-program-io 'vomit-output-stream *standard-input* ,stream-easy-p
            #'(lambda (,reduced-input-var ,input-activity-var)
                ,@(unless iavp `((declare (ignore ,input-activity-var))))
                ,@body)
            :input ,input-form ,active (place-setter ,setf) ,keys))

  (defmacro with-program-output (((reduced-output-var
                                  &optional (output-activity-var (gensym) oavp))
                                  output-form &key setf stream-easy-p active keys) &body body)
    `(apply '%call-with-program-io 'slurp-input-stream *standard-output* ,stream-easy-p
            #'(lambda (,reduced-output-var ,output-activity-var)
                ,@(unless oavp `((declare (ignore ,output-activity-var))))
                ,@body)
            :output ,output-form ,active (place-setter ,setf) ,keys))

  (defmacro with-program-error-output (((reduced-error-output-var
                                         &optional (error-output-activity-var (gensym) eoavp))
                                        error-output-form &key setf stream-easy-p active keys)
                                       &body body)
    `(apply '%call-with-program-io 'slurp-input-stream *error-output* ,stream-easy-p
            #'(lambda (,reduced-error-output-var ,error-output-activity-var)
                ,@(unless eoavp `((declare (ignore ,error-output-activity-var))))
                ,@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
Elias Pipping's avatar
Elias Pipping committed
324
    #+(or cormanlisp gcl (and lispworks os-windows) mcl xcl)
325
326
    (progn
      command keys input output error-output ignore-error-status ;; ignore
327
      (not-implemented-error '%use-launch-program))
328
329
330
    (when (member :stream (list input output error-output))
      (parameter-error "~S: ~S is not allowed as synchronous I/O redirection argument"
                       'run-program :stream))
331
332
    (let* ((active-input-p (%active-io-specifier-p input))
           (active-output-p (%active-io-specifier-p output))
333
           (active-error-output-p (%active-io-specifier-p error-output))
334
335
336
337
338
339
           (activity
             (cond
               (active-output-p :output)
               (active-input-p :input)
               (active-error-output-p :error-output)
               (t nil)))
340
           output-result error-output-result exit-code process-info)
341
342
343
344
      (with-program-output ((reduced-output output-activity)
                            output :keys keys :setf output-result
                            :stream-easy-p t :active (eq activity :output))
        (with-program-error-output ((reduced-error-output error-output-activity)
345
                                    error-output :keys keys :setf error-output-result
346
347
348
349
                                    :stream-easy-p t :active (eq activity :error-output))
          (with-program-input ((reduced-input input-activity)
                               input :keys keys
                               :stream-easy-p t :active (eq activity :input))
350
            (setf process-info
351
                  (apply 'launch-program command
352
                         :input reduced-input :output reduced-output
Elias Pipping's avatar
Elias Pipping committed
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
                         :error-output (if (eq error-output :output) :output reduced-error-output)
                         keys))
            (labels ((get-stream (stream-name &optional fallbackp)
                       (or (slot-value process-info stream-name)
                           (when fallbackp
                             (slot-value process-info 'bidir-stream))))
                     (run-activity (activity stream-name &optional fallbackp)
                       (if-let (stream (get-stream stream-name fallbackp))
                         (funcall activity stream)
                         (error 'subprocess-error
                                :code `(:missing ,stream-name)
                                :command command :process process-info))))
              (unwind-protect
                   (ecase activity
                     ((nil))
                     (:input (run-activity input-activity 'input-stream t))
                     (:output (run-activity output-activity 'output-stream t))
                     (:error-output (run-activity error-output-activity 'error-output-stream)))
Elias Pipping's avatar
Elias Pipping committed
371
                (close-streams process-info)
372
                (setf exit-code (wait-process process-info)))))))
373
374
375
      (%check-result exit-code
                     :command command :process process-info
                     :ignore-error-status ignore-error-status)
376
377
      (values output-result error-output-result exit-code)))

378
  (defun %normalize-system-command (command) ;; helper for %USE-SYSTEM
379
    (etypecase command
380
      (string command)
381
      (list (escape-shell-command
382
383
384
             (os-cond
              ((os-unix-p) (cons "exec" command))
              (t command))))))
385

386
  (defun %redirected-system-command (command in out err directory) ;; helper for %USE-SYSTEM
387
388
389
390
    (flet ((redirect (spec operator)
             (let ((pathname
                     (typecase spec
                       (null (null-device-pathname))
391
                       (string (parse-native-namestring spec))
392
393
                       (pathname spec)
                       ((eql :output)
394
                        (unless (equal operator " 2>>")
395
396
                          (parameter-error "~S: only the ~S argument can be ~S"
                                           'run-program :error-output :output))
397
398
                        (return-from redirect '(" 2>&1"))))))
               (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
405
406
407
408
             (chdir (when directory
                      (let ((dir-arg (escape-shell-token (native-namestring directory))))
                        (os-cond
                         ((os-unix-p) `("cd " ,dir-arg " ; "))
                         ((os-windows-p) `("cd /d " ,dir-arg " & ")))))))
409
        (reduce/strcat
410
411
         (os-cond
          ((os-unix-p) `(,@(when redirections `("exec " ,@redirections " ; ")) ,@chdir ,normalized))
412
          ((os-windows-p) `(,@chdir ,@redirections " " ,normalized)))))))
413

414
  (defun %system (command &rest keys &key directory
415
416
417
                                       input (if-input-does-not-exist :error)
                                       output (if-output-exists :supersede)
                                       error-output (if-error-output-exists :supersede)
418
                                       &allow-other-keys)
419
    "A portable abstraction of a low-level call to libc's system()."
Elias Pipping's avatar
Elias Pipping committed
420
421
    (declare (ignorable keys directory input if-input-does-not-exist output
                        if-output-exists error-output if-error-output-exists))
422
    #+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl)
423
424
425
426
427
428
    (let (#+(or abcl ecl mkcl)
            (version (parse-version
                      #-abcl
                      (lisp-implementation-version)
                      #+abcl
                      (second (split-string (implementation-identifier) :separator '(#\-))))))
429
      (nest
430
       #+abcl (unless (lexicographic< '< version '(1 4 0)))
431
       #+ecl (unless (lexicographic<= '< version '(16 0 0)))
432
       #+mkcl (unless (lexicographic<= '< version '(1 1 9)))
433
434
435
       (return-from %system
         (wait-process
          (apply 'launch-program (%normalize-system-command command) keys)))))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
436
    #+(or abcl clasp clisp cormanlisp ecl gcl genera (and lispworks os-windows) mkcl xcl)
437
    (let ((%command (%redirected-system-command command input output error-output directory)))
Elias Pipping's avatar
Elias Pipping committed
438
439
440
441
      ;; see comments for these functions
      (%handle-if-does-not-exist input if-input-does-not-exist)
      (%handle-if-exists output if-output-exists)
      (%handle-if-exists error-output if-error-output-exists)
442
443
444
445
446
      #+abcl (ext:run-shell-command %command)
      #+(or clasp ecl) (let ((*standard-input* *stdin*)
                             (*standard-output* *stdout*)
                             (*error-output* *stderr*))
                         (ext:system %command))
447
      #+clisp
448
449
450
451
452
453
454
455
456
      (let ((raw-exit-code
             (or
              #.`(#+os-windows ,@'(ext:run-shell-command %command)
                  #+os-unix ,@'(ext:run-program "/bin/sh" :arguments `("-c" ,%command))
                  :wait t :input :terminal :output :terminal)
              0)))
        (if (minusp raw-exit-code)
            (- 128 raw-exit-code)
            raw-exit-code))
457
458
459
      #+cormanlisp (win32:system %command)
      #+gcl (system:system %command)
      #+genera (not-implemented-error '%system)
460
461
      #+(and lispworks os-windows)
      (system:call-system %command :current-directory directory :wait t)
462
463
464
      #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
      #+mkcl (mkcl:system %command)
      #+xcl (system:%run-shell-command %command)))
465
466
467

  (defun %use-system (command &rest keys
                      &key input output error-output ignore-error-status &allow-other-keys)
468
    ;; helper for RUN-PROGRAM when using %system
469
470
471
472
473
474
    (let (output-result error-output-result exit-code)
      (with-program-output ((reduced-output)
                            output :keys keys :setf output-result)
        (with-program-error-output ((reduced-error-output)
                                    error-output :keys keys :setf error-output-result)
          (with-program-input ((reduced-input) input :keys keys)
475
476
477
478
479
480
            (setf exit-code (apply '%system command
                                   :input reduced-input :output reduced-output
                                   :error-output reduced-error-output keys)))))
      (%check-result exit-code
                     :command command
                     :ignore-error-status ignore-error-status)
481
482
483
      (values output-result error-output-result exit-code)))

  (defun run-program (command &rest keys
484
                       &key ignore-error-status (force-shell nil force-shell-suppliedp)
485
                         input (if-input-does-not-exist :error)
486
                         output (if-output-exists :supersede)
487
                         error-output (if-error-output-exists :supersede)
488
489
                         (element-type #-clozure *default-stream-element-type* #+clozure 'character)
                         (external-format *utf-8-external-format*)
490
                       &allow-other-keys)
491
    "Run program specified by COMMAND,
492
either a list of strings specifying a program and list of arguments,
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
493
494
495
or a string specifying a shell command (/bin/sh on Unix, CMD.EXE on Windows);
_synchronously_ process its output as specified and return the processing results
when the program and its output processing are complete.
496

497
Always call a shell (rather than directly execute the command when possible)
498
499
if FORCE-SHELL is specified.  Similarly, never call a shell if FORCE-SHELL is
specified to be NIL.
500

501
Signal a continuable SUBPROCESS-ERROR if the process wasn't successful (exit-code 0),
502
503
unless IGNORE-ERROR-STATUS is specified.

504
505
If OUTPUT is a pathname, a string designating a pathname, or NIL (the default)
designating the null device, the file at that path is used as output.
506
507
508
509
If it's :INTERACTIVE, output is inherited from the current process;
beware that this may be different from your *STANDARD-OUTPUT*,
and under SLIME will be on your *inferior-lisp* buffer.
If it's T, output goes to your current *STANDARD-OUTPUT* stream.
510
Otherwise, OUTPUT should be a value that is a suitable first argument to
511
SLURP-INPUT-STREAM (qv.), or a list of such a value and keyword arguments.
512
513
In this case, RUN-PROGRAM will create a temporary stream for the program output;
the program output, in that stream, will be processed by a call to SLURP-INPUT-STREAM,
514
515
516
517
using OUTPUT as the first argument (or the first element of OUTPUT, and the rest as keywords).
The primary value resulting from that call (or NIL if no call was needed)
will be the first value returned by RUN-PROGRAM.
E.g., using :OUTPUT :STRING will have it return the entire output stream as a string.
518
519
And using :OUTPUT '(:STRING :STRIPPED T) will have it return the same string
stripped of any ending newline.
520

521
522
523
524
525
526
IF-OUTPUT-EXISTS, which is only meaningful if OUTPUT is a string or a
pathname, can take the values :ERROR, :APPEND, and :SUPERSEDE (the
default). The meaning of these values and their effect on the case
where OUTPUT does not exist, is analogous to the IF-EXISTS parameter
to OPEN with :DIRECTION :OUTPUT.

527
528
ERROR-OUTPUT is similar to OUTPUT, except that the resulting value is returned
as the second value of RUN-PROGRAM. T designates the *ERROR-OUTPUT*.
529
530
Also :OUTPUT means redirecting the error output to the output stream,
in which case NIL is returned.
531

532
533
534
IF-ERROR-OUTPUT-EXISTS is similar to IF-OUTPUT-EXIST, except that it
affects ERROR-OUTPUT rather than OUTPUT.

535
536
537
INPUT is similar to OUTPUT, except that VOMIT-OUTPUT-STREAM is used,
no value is returned, and T designates the *STANDARD-INPUT*.

538
539
540
541
542
IF-INPUT-DOES-NOT-EXIST, which is only meaningful if INPUT is a string
or a pathname, can take the values :CREATE and :ERROR (the
default). The meaning of these values is analogous to the
IF-DOES-NOT-EXIST parameter to OPEN with :DIRECTION :INPUT.

Elias Pipping's avatar
Elias Pipping committed
543
ELEMENT-TYPE and EXTERNAL-FORMAT are passed on
544
to your Lisp implementation, when applicable, for creation of the output stream.
545
546

One and only one of the stream slurping or vomiting may or may not happen
547
548
549
550
551
in parallel in parallel with the subprocess,
depending on options and implementation,
and with priority being given to output processing.
Other streams are completely produced or consumed
before or after the subprocess is spawned, using temporary files.
552
553
554
555
556
557

RUN-PROGRAM returns 3 values:
0- the result of the OUTPUT slurping if any, or NIL
1- the result of the ERROR-OUTPUT slurping if any, or NIL
2- either 0 if the subprocess exited with success status,
or an indication of failure via the EXIT-CODE of the process"
558
559
    (declare (ignorable input output error-output if-input-does-not-exist if-output-exists
                        if-error-output-exists element-type external-format ignore-error-status))
560
    #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl lispworks mcl mkcl sbcl scl xcl)
Elias Pipping's avatar
Elias Pipping committed
561
    (not-implemented-error 'run-program)
562
    (apply (if (or force-shell
563
564
565
566
567
568
                   ;; Per doc string, set FORCE-SHELL to T if we get command as a string.
                   ;; But don't override user's specified preference. [2015/06/29:rpg]
                   (and (stringp command)
                        (or (not force-shell-suppliedp)
                            #-(or allegro clisp clozure sbcl) (os-cond ((os-windows-p) t))))
                   #+(or clasp clisp cormanlisp gcl (and lispworks os-windows) mcl xcl) t
569
570
                   ;; A race condition in ECL <= 16.0.0 prevents using ext:run-program
                   #+ecl #.(if-let (ver (parse-version (lisp-implementation-version)))
571
                                   (lexicographic<= '< ver '(16 0 0)))
572
                   #+(and lispworks os-unix) (%interactivep input output error-output))
573
               '%use-system '%use-launch-program)
574
           command keys)))
575