X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Frun-program.lisp;h=7db3ff5427609972940aff81f27aaa6e5525a12e;hb=b8f63d9b4e978bec3bfc1f4fc471e5ed946781fd;hp=d704435e7d8f2716974be2ef8eb96022ee40493a;hpb=8fc5fda05f92d69c95b47e4ad7561d91dab18c3e;p=sbcl.git diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index d704435..7db3ff5 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -11,9 +11,6 @@ ;;;; files for more information. (in-package "SB-EXT") - -(file-comment - "$Header$") ;;;; Import wait3(2) from Unix. @@ -22,10 +19,9 @@ (options sb-c-call:int) (rusage sb-c-call:int)) -(eval-when (load eval compile) - (defconstant wait-wnohang #-svr4 1 #+svr4 #o100) - (defconstant wait-wuntraced #-svr4 2 #+svr4 4) - (defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced)) +(defconstant wait-wnohang #-svr4 1 #+svr4 #o100) +(defconstant wait-wuntraced #-svr4 2 #+svr4 4) +(defconstant wait-wstopped #-svr4 #o177 #+svr4 wait-wuntraced) (defun wait3 (&optional do-not-hang check-for-stopped) "Return any available status information on child process. " @@ -123,10 +119,10 @@ (process-pid proc)) (defun process-kill (proc signal &optional (whom :pid)) - "Hand SIGNAL to PROC. If whom is :pid, use the kill Unix system call. If - whom is :process-group, use the killpg Unix system call. If whom is - :pty-process-group deliver the signal to whichever process group is currently - in the foreground." + "Hand SIGNAL to PROC. If WHOM is :PID, use the kill Unix system call. If + WHOM is :PROCESS-GROUP, use the killpg Unix system call. If WHOM is + :PTY-PROCESS-GROUP deliver the signal to whichever process group is + currently in the foreground." (let ((pid (ecase whom ((:pid :process-group) (process-pid proc)) @@ -213,13 +209,18 @@ #+FreeBSD (def-alien-type nil - (struct sgttyb - (sg-ispeed sb-c-call:char) ; input speed - (sg-ospeed sb-c-call:char) ; output speed - (sg-erase sb-c-call:char) ; erase character - (sg-kill sb-c-call:char) ; kill character - (sg-flags sb-c-call:short) ; mode flags - )) + (struct sgttyb + (sg-ispeed sb-c-call:char) ; input speed + (sg-ospeed sb-c-call:char) ; output speed + (sg-erase sb-c-call:char) ; erase character + (sg-kill sb-c-call:char) ; kill character + (sg-flags sb-c-call:short))) ; mode flags +#+OpenBSD +(def-alien-type nil + (struct sgttyb + (sg-four sb-c-call:int) + (sg-chars (array sb-c-call:char 4)) + (sg-flags sb-c-call:int))) ;;; Find a pty that is not in use. Return three values: the file ;;; descriptor for the master side of the pty, the file descriptor for @@ -238,17 +239,32 @@ sb-unix:o_rdwr #o666))) (when slave-fd - ; Maybe put a vhangup here? - #-linux + ;; comment from classic CMU CL: + ;; Maybe put a vhangup here? + ;; + ;; FIXME: It seems as though this logic should be in + ;; OPEN-PTY, not FIND-A-PTY (both from the comments + ;; documenting DEFUN FIND-A-PTY, and from the + ;; connotations of the function names). + ;; + ;; FIXME: It would be nice to have a note, and/or a pointer + ;; to some reference material somewhere, explaining + ;; why we need this on *BSD and not on Linux. + #+bsd (sb-alien:with-alien ((stuff (sb-alien:struct sgttyb))) (let ((sap (sb-alien:alien-sap stuff))) (sb-unix:unix-ioctl slave-fd sb-unix:TIOCGETP sap) (setf (sb-alien:slot stuff 'sg-flags) - #o300) ; EVENP|ODDP + ;; This is EVENP|ODDP, the same numeric code + ;; both on FreeBSD and on OpenBSD. -- WHN 20000929 + #o300) ; EVENP|ODDP (sb-unix:unix-ioctl slave-fd sb-unix:TIOCSETP sap) (sb-unix:unix-ioctl master-fd sb-unix:TIOCGETP sap) (setf (sb-alien:slot stuff 'sg-flags) (logand (sb-alien:slot stuff 'sg-flags) + ;; This is ~ECHO, the same numeric + ;; code both on FreeBSD and on OpenBSD. + ;; -- WHN 20000929 (lognot 8))) ; ~ECHO (sb-unix:unix-ioctl master-fd sb-unix:TIOCSETP sap))) (return-from find-a-pty @@ -333,11 +349,11 @@ (stdout sb-c-call:int) (stderr sb-c-call:int)) -;;; RUN-PROGRAM uses fork and execve to run a different program. -;;; Strange stuff happens to keep the unix state of the world +;;; RUN-PROGRAM uses fork() and execve() to run a different program. +;;; Strange stuff happens to keep the Unix state of the world ;;; coherent. ;;; -;;; The child process needs to get it's input from somewhere, and send +;;; The child process needs to get its input from somewhere, and send ;;; its output (both standard and error) to somewhere. We have to do ;;; different things depending on where these somewheres really are. ;;; @@ -348,8 +364,8 @@ ;;; this stream after the child is up and running to free any ;;; storage used in the parent. ;;; -- NIL: Same as "file", but use "/dev/null" as the file. -;;; -- :STREAM: Use unix-pipe to create two descriptors. Use -;;; sb-sys:make-fd-stream to create the output stream on the +;;; -- :STREAM: Use Unix pipe() to create two descriptors. Use +;;; SB-SYS:MAKE-FD-STREAM to create the output stream on the ;;; writeable descriptor, and pass the readable descriptor to ;;; the child. The parent must close the readable descriptor for ;;; EOF to be passed up correctly. @@ -383,56 +399,56 @@ Common Lisp Users Manual for details about the PROCESS structure. The keyword arguments have the following meanings: - :env - + :ENV An A-LIST mapping keyword environment variables to simple-string values. - :wait - + :WAIT If non-NIL (default), wait until the created process finishes. If NIL, continue running Lisp until the program finishes. - :pty - + :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 - + :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) - + :IF-INPUT-DOES-NOT-EXIST (when :INPUT is the name of a file) can be one of: - :error - generate an error. - :create - create an empty file. - nil (default) - return nil from run-program. - :output - + :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 :input is the name of a file) - + :IF-OUTPUT-EXISTS (when :OUTPUT is the name of a file) can be one of: - :error (default) - generates an error if the file already exists. - :supersede - output from the program supersedes the file. - :append - output from the program is appended to the file. - nil - run-program returns nil 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 + :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 - + :STATUS-HOOK This is a function the system calls whenever the status of the process changes. The function takes the process as an argument." - ;; Make sure the interrupt handler is installed. + ;; Make sure that the interrupt handler is installed. (sb-sys:enable-interrupt sb-unix:sigchld #'sigchld-handler) - ;; Make sure all the args are okay. + ;; Make sure that all the args are okay. (unless (every #'simple-string-p args) (error "All arguments to program must be simple strings: ~S" args)) - ;; Pre-pend the program to the argument list. + ;; Prepend the program to the argument list. (push (namestring program) args) ;; Clear various specials used by GET-DESCRIPTOR-FOR to communicate ;; cleanup info. Also, establish proc at this level so we can @@ -499,11 +515,9 @@ (process-wait proc)) proc)) -;;; COPY-DESCRIPTOR-TO-STREAM -- internal -;;; -;;; Installs a handler for any input that shows up on the file descriptor. -;;; The handler reads the data and writes it to the stream. -;;; +;;; Install a handler for any input that shows up on the file +;;; descriptor. The handler reads the data and writes it to the +;;; stream. (defun copy-descriptor-to-stream (descriptor stream cookie) (incf (car cookie)) (let ((string (make-string 256))