- (cond ((eq object t)
- ;; No new descriptor is needed.
- (values -1 nil))
- ((or (eq object nil)
- (and (typep object 'broadcast-stream)
- (not (broadcast-stream-streams object))))
- ;; Use /dev/null.
- (multiple-value-bind
- (fd errno)
- (sb-unix:unix-open #-win32 #.(coerce "/dev/null" 'base-string)
- #+win32 #.(coerce "nul" 'base-string)
- (case direction
- (:input sb-unix:o_rdonly)
- (:output sb-unix:o_wronly)
- (t sb-unix:o_rdwr))
- #o666)
- (unless fd
- (error #-win32 "~@<couldn't open \"/dev/null\": ~2I~_~A~:>"
- #+win32 "~@<couldn't open \"nul\" device: ~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
- :element-type :default
- :external-format
- external-format)))
- (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
- :element-type :default
- :external-format
- external-format)))
- (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))
- ;; GET-DESCRIPTOR-FOR uses &allow-other-keys, so rather
- ;; than munge the &rest list for OPEN, just disable keyword
- ;; validation there.
- (with-open-stream (file (apply #'open object :allow-other-keys t
- keys))
- (when file
- (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))))))))
+ (let ((dev-null #.(coerce #-win32 "/dev/null" #+win32 "nul" 'base-string)))
+ (cond ((eq object t)
+ ;; No new descriptor is needed.
+ (values -1 nil))
+ ((or (eq object nil)
+ (and (typep object 'broadcast-stream)
+ (not (broadcast-stream-streams object))))
+ ;; Use /dev/null.
+ (multiple-value-bind
+ (fd errno)
+ (sb-unix:unix-open dev-null
+ (case direction
+ (:input sb-unix:o_rdonly)
+ (:output sb-unix:o_wronly)
+ (t sb-unix:o_rdwr))
+ #o666)
+ (unless fd
+ (error "~@<couldn't open ~S: ~2I~_~A~:>"
+ dev-null (strerror errno)))
+ #+win32
+ (setf (sb-win32::inheritable-handle-p fd) t)
+ (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)))
+ #+win32
+ (setf (sb-win32::inheritable-handle-p read-fd)
+ (eq direction :input)
+ (sb-win32::inheritable-handle-p write-fd)
+ (eq direction :output))
+ (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
+ :element-type :default
+ :external-format
+ external-format)))
+ (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
+ :element-type :default
+ :external-format
+ external-format)))
+ (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))
+ ;; GET-DESCRIPTOR-FOR uses &allow-other-keys, so rather
+ ;; than munge the &rest list for OPEN, just disable keyword
+ ;; validation there.
+ (with-open-stream (file (apply #'open object :allow-other-keys t
+ keys))
+ (when file
+ (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))))))))