- (dolist (handler *handlers-installed*)
- (sb-sys:remove-fd-handler handler))))
- (when (and wait proc)
- (process-wait proc))
- proc))
-
-#+win32
-(defun run-program (program args
- &key
- (wait t)
- search
- input
- if-input-does-not-exist
- output
- (if-output-exists :error)
- (error :output)
- (if-error-exists :error)
- status-hook)
- "RUN-PROGRAM creates a new process specified by the PROGRAM
-argument. ARGS are the standard arguments that can be passed to a
-program. For no arguments, use NIL (which means that just the name of
-the program is passed as arg 0).
-
-RUN-PROGRAM will return a PROCESS structure. See the CMU
-Common Lisp Users Manual for details about the PROCESS structure.
-
- The &KEY arguments have the following meanings:
- :SEARCH
- Look for PROGRAM in each of the directories along the $PATH
- environment variable. Otherwise an absolute pathname is required.
- (See also FIND-EXECUTABLE-IN-SEARCH-PATH)
- :WAIT
- If non-NIL (default), wait until the created process finishes. If
- NIL, continue running Lisp until the program finishes.
- :INPUT
- Either T, NIL, a pathname, a stream, or :STREAM. If T, the standard
- input for the current process is inherited. If NIL, nul
- is used. If a pathname, the file so specified is used. If a stream,
- all the input is read from that stream and send to the subprocess. If
- :STREAM, the PROCESS-INPUT slot is filled in with a stream that sends
- its output to the process. Defaults to NIL.
- :IF-INPUT-DOES-NOT-EXIST (when :INPUT is the name of a file)
- can be one of:
- :ERROR to generate an error
- :CREATE to create an empty file
- NIL (the default) to return NIL from RUN-PROGRAM
- :OUTPUT
- Either T, NIL, a pathname, a stream, or :STREAM. If T, the standard
- output for the current process is inherited. If NIL, nul
- is used. If a pathname, the file so specified is used. If a stream,
- all the output from the process is written to this stream. If
- :STREAM, the PROCESS-OUTPUT slot is filled in with a stream that can
- be read to get the output. Defaults to NIL.
- :IF-OUTPUT-EXISTS (when :OUTPUT is the name of a file)
- can be one of:
- :ERROR (the default) to generate an error
- :SUPERSEDE to supersede the file with output from the program
- :APPEND to append output from the program to the file
- NIL to return NIL from RUN-PROGRAM, without doing anything
- :ERROR and :IF-ERROR-EXISTS
- Same as :OUTPUT and :IF-OUTPUT-EXISTS, except that :ERROR can also be
- specified as :OUTPUT in which case all error output is routed to the
- same place as normal output.
- :STATUS-HOOK
- This is a function the system calls whenever the status of the
- process changes. The function takes the process as an argument."
- ;; Prepend the program to the argument list.
- (push (namestring program) args)
- (let (;; Clear various specials used by GET-DESCRIPTOR-FOR to
- ;; communicate cleanup info.
- *close-on-error*
- *close-in-parent*
- ;; Establish PROC at this level so that we can return it.
- proc
- ;; It's friendly to allow the caller to pass any string
- ;; designator, but internally we'd like SIMPLE-STRINGs.
- (simple-args
- (mapcar
- (lambda (x)
- (coerce
- ;; Apparently any spaces or double quotes in the arguments
- ;; need to be escaped on win32.
- #+win32
- (if (position-if (lambda (c) (find c '(#\" #\Space))) x)
- (write-to-string x)
- x)
- #-win32
- x
- 'simple-string))
- args)))
- (unwind-protect
- (let ((pfile
- (if search
- (find-executable-in-search-path program)
- (unix-namestring program)))
- (cookie (list 0)))
- (unless pfile
- (error "No such program: ~S" program))
- (unless (unix-filename-is-executable-p pfile)
- (error "Not an executable: ~S" program))
- (multiple-value-bind (stdin input-stream)
- (get-descriptor-for input cookie
- :direction :input
- :if-does-not-exist if-input-does-not-exist)
- (multiple-value-bind (stdout output-stream)
- (get-descriptor-for output cookie
- :direction :output
- :if-exists if-output-exists)
- (multiple-value-bind (stderr error-stream)
- (if (eq error :output)
- (values stdout output-stream)
- (get-descriptor-for error cookie
- :direction :output
- :if-exists if-error-exists))
- (with-c-strvec (args-vec simple-args)
- (let ((handle (without-gcing
- (spawn pfile args-vec
- stdin stdout stderr
- (if wait 1 0)))))
- (when (< handle 0)
- (error "Couldn't spawn program: ~A" (strerror)))
- (setf proc
- (if wait
- (make-process :pid handle
- :%status :exited
- :input input-stream
- :output output-stream
- :error error-stream
- :status-hook status-hook
- :cookie cookie
- :exit-code handle)
- (make-process :pid handle
- :%status :running
- :input input-stream
- :output output-stream
- :error error-stream
- :status-hook status-hook
- :cookie cookie)))
- (push proc *active-processes*)))))))
- (dolist (fd *close-in-parent*)
- (sb-unix:unix-close fd)))
- (unless proc
- (dolist (fd *close-on-error*)
- (sb-unix:unix-close fd)))
-
- proc))