+
+#-win32
+(defun run-program (program args
+ &key
+ (env nil env-p)
+ (environment (if env-p
+ (unix-environment-sbcl-from-cmucl env)
+ (posix-environ))
+ environment-p)
+ (wait t)
+ search
+ pty
+ input
+ if-input-does-not-exist
+ output
+ (if-output-exists :error)
+ (error :output)
+ (if-error-exists :error)
+ status-hook)
+ #+sb-doc
+ "RUN-PROGRAM creates a new Unix process running the Unix program
+found in the file specified by the PROGRAM argument. ARGS are the
+standard arguments that can be passed to a Unix 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.
+
+ Notes about Unix environments (as in the :ENVIRONMENT and :ENV args):
+
+ - The SBCL implementation of RUN-PROGRAM, like Perl and many other
+ programs, but unlike the original CMU CL implementation, copies
+ the Unix environment by default.
+
+ - Running Unix programs from a setuid process, or in any other
+ situation where the Unix environment is under the control of someone
+ else, is a mother lode of security problems. If you are contemplating
+ doing this, read about it first. (The Perl community has a lot of good
+ documentation about this and other security issues in script-like
+ programs.)
+
+ The &KEY arguments have the following meanings:
+
+ :ENVIRONMENT
+ a list of SIMPLE-BASE-STRINGs describing the new Unix environment
+ (as in \"man environ\"). The default is to copy the environment of
+ the current process.
+ :ENV
+ an alternative lossy representation of the new Unix environment,
+ for compatibility with CMU CL
+ :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.
+ :PTY
+ Either T, NIL, or a stream. Unless NIL, the subprocess is established
+ under a PTY. If :pty is a stream, all output to this pty is sent to
+ this stream, otherwise the PROCESS-PTY slot is filled in with a stream
+ connected to pty that can read output and write input.
+ :INPUT
+ Either T, NIL, a pathname, a stream, or :STREAM. If T, the standard
+ input for the current process is inherited. If NIL, /dev/null
+ 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, /dev/null
+ 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."
+ (when (and env-p environment-p)
+ (error "can't specify :ENV and :ENVIRONMENT simultaneously"))
+ ;; Make sure that the interrupt handler is installed.
+ (sb-sys:enable-interrupt sb-unix:sigchld #'sigchld-handler)
+ ;; 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*
+ *handlers-installed*
+ ;; 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 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 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))
+ (multiple-value-bind (pty-name pty-stream)
+ (open-pty pty cookie)
+ ;; Make sure we are not notified about the child
+ ;; death before we have installed the PROCESS
+ ;; structure in *ACTIVE-PROCESSES*.
+ (with-active-processes-lock ()
+ (with-c-strvec (args-vec simple-args)
+ (with-c-strvec (environment-vec environment)
+ (let ((child-pid
+ (without-gcing
+ (spawn pfile args-vec environment-vec pty-name
+ stdin stdout stderr))))
+ (when (< child-pid 0)
+ (error "couldn't fork child process: ~A"
+ (strerror)))
+ (setf proc (make-process :pid child-pid
+ :%status :running
+ :pty pty-stream
+ :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))
+ (dolist (handler *handlers-installed*)
+ (sb-sys:remove-fd-handler handler))))
+ (when (and wait proc)
+ (process-wait proc))
+ proc))
+
+#+win32