- ;; No new descriptor is needed.
- (values -1 nil))
- ((eq object nil)
- ;; Use /dev/null.
- (multiple-value-bind
- (fd errno)
- (sb-unix:unix-open #.(coerce "/dev/null" 'base-string)
- (case direction
- (:input sb-unix:o_rdonly)
- (:output sb-unix:o_wronly)
- (t sb-unix:o_rdwr))
- #o666)
- (unless fd
- (error "~@<couldn't open \"/dev/null\": ~2I~_~A~:>"
- (strerror errno)))
- (push fd *close-in-parent*)
- (values fd nil)))
- ((eq object :stream)
- (multiple-value-bind (read-fd write-fd) (sb-unix:unix-pipe)
- (unless read-fd
- (error "couldn't create pipe: ~A" (strerror write-fd)))
- (case direction
- (:input
- (push read-fd *close-in-parent*)
- (push write-fd *close-on-error*)
- (let ((stream (sb-sys:make-fd-stream write-fd :output t)))
- (values read-fd stream)))
- (:output
- (push read-fd *close-on-error*)
- (push write-fd *close-in-parent*)
- (let ((stream (sb-sys:make-fd-stream read-fd :input t)))
- (values write-fd stream)))
- (t
- (sb-unix:unix-close read-fd)
- (sb-unix:unix-close write-fd)
- (error "Direction must be either :INPUT or :OUTPUT, not ~S."
- direction)))))
- ((or (pathnamep object) (stringp object))
- (with-open-stream (file (apply #'open object keys))
- (multiple-value-bind
- (fd errno)
- (sb-unix:unix-dup (sb-sys:fd-stream-fd file))
- (cond (fd
- (push fd *close-in-parent*)
- (values fd nil))
- (t
- (error "couldn't duplicate file descriptor: ~A"
- (strerror errno)))))))
- ((sb-sys:fd-stream-p object)
- (values (sb-sys:fd-stream-fd object) nil))
- ((streamp object)
- (ecase direction
- (:input
- ;; FIXME: We could use a better way of setting up
- ;; temporary files, both here and in LOAD-FOREIGN.
- (dotimes (count
- 256
- (error "could not open a temporary file in /tmp"))
- (let* ((name (coerce (format nil "/tmp/.run-program-~D" count) 'base-string))
- (fd (sb-unix:unix-open name
- (logior sb-unix:o_rdwr
- sb-unix:o_creat
- sb-unix:o_excl)
- #o666)))
- (sb-unix:unix-unlink name)
- (when fd
- (let ((newline (string #\Newline)))
- (loop
- (multiple-value-bind
- (line no-cr)
- (read-line object nil nil)
- (unless line
- (return))
- (sb-unix:unix-write fd line 0 (length line))
- (if no-cr
- (return)
- (sb-unix:unix-write fd newline 0 1)))))
- (sb-unix:unix-lseek fd 0 sb-unix:l_set)
- (push fd *close-in-parent*)
- (return (values fd nil))))))
- (:output
- (multiple-value-bind (read-fd write-fd)
- (sb-unix:unix-pipe)
- (unless read-fd
- (error "couldn't create pipe: ~S" (strerror write-fd)))
- (copy-descriptor-to-stream read-fd object cookie)
- (push read-fd *close-on-error*)
- (push write-fd *close-in-parent*)
- (values write-fd nil)))))
- (t
- (error "invalid option to RUN-PROGRAM: ~S" object))))
+ ;; No new descriptor is needed.
+ (values -1 nil))
+ ((eq object nil)
+ ;; Use /dev/null.
+ (multiple-value-bind
+ (fd errno)
+ (sb-unix:unix-open #.(coerce "/dev/null" 'base-string)
+ (case direction
+ (:input sb-unix:o_rdonly)
+ (:output sb-unix:o_wronly)
+ (t sb-unix:o_rdwr))
+ #o666)
+ (unless fd
+ (error "~@<couldn't open \"/dev/null\": ~2I~_~A~:>"
+ (strerror errno)))
+ (push fd *close-in-parent*)
+ (values fd nil)))
+ ((eq object :stream)
+ (multiple-value-bind (read-fd write-fd) (sb-unix:unix-pipe)
+ (unless read-fd
+ (error "couldn't create pipe: ~A" (strerror write-fd)))
+ (case direction
+ (:input
+ (push read-fd *close-in-parent*)
+ (push write-fd *close-on-error*)
+ (let ((stream (sb-sys:make-fd-stream write-fd :output t)))
+ (values read-fd stream)))
+ (:output
+ (push read-fd *close-on-error*)
+ (push write-fd *close-in-parent*)
+ (let ((stream (sb-sys:make-fd-stream read-fd :input t)))
+ (values write-fd stream)))
+ (t
+ (sb-unix:unix-close read-fd)
+ (sb-unix:unix-close write-fd)
+ (error "Direction must be either :INPUT or :OUTPUT, not ~S."
+ direction)))))
+ ((or (pathnamep object) (stringp object))
+ (with-open-stream (file (apply #'open object keys))
+ (multiple-value-bind
+ (fd errno)
+ (sb-unix:unix-dup (sb-sys:fd-stream-fd file))
+ (cond (fd
+ (push fd *close-in-parent*)
+ (values fd nil))
+ (t
+ (error "couldn't duplicate file descriptor: ~A"
+ (strerror errno)))))))
+ ((sb-sys:fd-stream-p object)
+ (values (sb-sys:fd-stream-fd object) nil))
+ ((streamp object)
+ (ecase direction
+ (:input
+ ;; FIXME: We could use a better way of setting up
+ ;; temporary files, both here and in LOAD-FOREIGN.
+ (dotimes (count
+ 256
+ (error "could not open a temporary file in /tmp"))
+ (let* ((name (coerce (format nil "/tmp/.run-program-~D" count) 'base-string))
+ (fd (sb-unix:unix-open name
+ (logior sb-unix:o_rdwr
+ sb-unix:o_creat
+ sb-unix:o_excl)
+ #o666)))
+ (sb-unix:unix-unlink name)
+ (when fd
+ (let ((newline (string #\Newline)))
+ (loop
+ (multiple-value-bind
+ (line no-cr)
+ (read-line object nil nil)
+ (unless line
+ (return))
+ (sb-unix:unix-write
+ fd
+ ;; FIXME: this really should be
+ ;; (STRING-TO-OCTETS :EXTERNAL-FORMAT ...).
+ ;; RUN-PROGRAM should take an
+ ;; external-format argument, which should
+ ;; be passed down to here. Something
+ ;; similar should happen on :OUTPUT, too.
+ (map '(vector (unsigned-byte 8)) #'char-code line)
+ 0 (length line))
+ (if no-cr
+ (return)
+ (sb-unix:unix-write fd newline 0 1)))))
+ (sb-unix:unix-lseek fd 0 sb-unix:l_set)
+ (push fd *close-in-parent*)
+ (return (values fd nil))))))
+ (:output
+ (multiple-value-bind (read-fd write-fd)
+ (sb-unix:unix-pipe)
+ (unless read-fd
+ (error "couldn't create pipe: ~S" (strerror write-fd)))
+ (copy-descriptor-to-stream read-fd object cookie)
+ (push read-fd *close-on-error*)
+ (push write-fd *close-in-parent*)
+ (values write-fd nil)))))
+ (t
+ (error "invalid option to RUN-PROGRAM: ~S" object))))