From b67c2d7522c0b73a18e316faa2b81d7c8b187706 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 10 May 2011 20:05:25 +0000 Subject: [PATCH] 1.0.48.7: add FD-STREAM-FD-TYPE, use it to decide when to poll the fd 1.0.42.43 introduced a regression that caused reads from non-regular files to potentially block in an uninterruptible state, as WAIT-UNTIL-FD-USABLE started being called only when there was a timeout or events to serve. This was a win for regular files, because filling the input buffer then required one syscall less. ...but since uninterruptible blocking reads aren't fun for anyone, let's make things a bit smarter: * When creating an FD-STREAM, use fstat() to get the type of the fd, and store a keyword describing it in the FD-STREAM. * REFILL-INPUT-BUFFER now calls SYSREAD-MAY-BLOCK-P always if the file anything but :REGULAR -- so pipes and sockets and whatnot get their select() calls, and a read from a stream to one can no longer cause SBCL to hang. --- NEWS | 3 +++ package-data-list.lisp-expr | 1 + src/code/fd-stream.lisp | 11 ++++++----- src/code/unix.lisp | 24 ++++++++++++++++++++++++ tests/run-program.impure.lisp | 34 ++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 6 files changed, 69 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index 6fb5ce4..39819ac 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,9 @@ changes relative to sbcl-1.0.48: * enhancement: ASDF has been updated to version 2.015.1. * enhancement: backtraces involving frames from the default evaluator are more readable. + * bug fix: blocking reads from FIFOs created by RUN-PROGRAM were + uninterruptible, as well as blocking reads from socket streams created + with for which :SERVE-EVENTS NIL. (regression from 1.0.42.43) changes in sbcl-1.0.48 relative to sbcl-1.0.47: * incompatible change: SB!KERNEL:INSTANCE-LAMBDA, deprecated for over five diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index cf4afc2..58090b2 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -2368,6 +2368,7 @@ no guarantees of interface stability." "USER-HOMEDIR" "WITH-RESTARTED-SYSCALL" "SB-MKSTEMP" + "FD-TYPE" ;; stuff with a one-to-one mapping to Unix constructs "D-INO" "D-NAME" "D-NAMLEN" "D-OFF" "D-RECLEN" "DEV-T" "DIRECT" diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 54c7c51..07dfaf1 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -157,6 +157,8 @@ (element-type 'base-char) ;; the Unix file descriptor (fd -1 :type fixnum) + ;; What do we know about the FD? + (fd-type :unknown :type keyword) ;; controls when the output buffer is flushed (buffering :full :type (member :full :line :none)) ;; controls whether the input buffer must be cleared before output @@ -970,11 +972,9 @@ (count 0)) (tagbody ;; Check for blocking input before touching the stream if we are to - ;; serve events: if the FD is blocking, we don't want to hang on the - ;; write if we are to serve events or notice timeouts. - (if (and (or (fd-stream-serve-events stream) - (fd-stream-timeout stream) - *deadline*) + ;; serve events: if the FD is blocking, we don't want to try an uninterruptible + ;; read(). Regular files should never block, so we can elide the check. + (if (and (neq :regular (fd-stream-fd-type stream)) (sysread-may-block-p stream)) (go :wait-for-input) (go :main)) @@ -2217,6 +2217,7 @@ ((not (or input output)) (error "File descriptor must be opened either for input or output."))) (let ((stream (%make-fd-stream :fd fd + :fd-type (sb!unix:fd-type fd) :name name :file file :original original diff --git a/src/code/unix.lisp b/src/code/unix.lisp index d5ac483..115277a 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -880,6 +880,30 @@ corresponds to NAME, or NIL if there is none." (syscall ("fstat_wrapper" int (* (struct wrapped_stat))) (%extract-stat-results (addr buf)) fd (addr buf)))) + +(defun fd-type (fd) + (declare (type unix-fd fd)) + (let ((fmt (logand + sb!unix:s-ifmt + (or (with-alien ((buf (struct wrapped_stat))) + (syscall ("fstat_wrapper" int (* (struct wrapped_stat))) + (slot buf 'st-mode) + fd (addr buf))) + 0)))) + (cond ((logtest sb!unix:s-ififo fmt) + :fifo) + ((logtest sb!unix:s-ifchr fmt) + :character) + ((logtest sb!unix:s-ifdir fmt) + :directory) + ((logtest sb!unix:s-ifblk fmt) + :block) + ((logtest sb!unix:s-ifreg fmt) + :regular) + ((logtest sb!unix:s-ifsock fmt) + :socket) + (t + :unknown)))) ;;;; time.h diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp index 46238b9..d27bb65 100644 --- a/tests/run-program.impure.lisp +++ b/tests/run-program.impure.lisp @@ -31,6 +31,40 @@ (assert (= (read-byte in) i))) (process-close process)))) +#+sb-thread +(with-test (:name :run-program-cat-2) + ;; Tests that reading from a FIFO is interruptible. + (let* ((process (sb-ext:run-program "/bin/cat" '() + :wait nil + :output :stream :input :stream)) + (in (process-input process)) + (out (process-output process)) + (sem (sb-thread:make-semaphore)) + (state :init) + (writer (sb-thread:make-thread (lambda () + (sb-thread:wait-on-semaphore sem) + (setf state :sleep) + (sleep 2) + (setf state :write) + (write-line "OK" in) + (finish-output in)))) + (timeout nil) + (got nil) + (unwind nil)) + (sb-thread:signal-semaphore sem) + (handler-case + (with-timeout 0.1 + (unwind-protect + (setf got (read-line out)) + (setf unwind state))) + (timeout () + (setf timeout t))) + (assert (not got)) + (assert timeout) + (assert (eq unwind :sleep)) + (sb-thread:join-thread writer) + (assert (equal "OK" (read-line out))))) + ;;; Test driving an external program (cat) through pipes wrapped in ;;; composite streams. diff --git a/version.lisp-expr b/version.lisp-expr index 2e2f4de..a6a714f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -20,4 +20,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.48.6" +"1.0.48.7" -- 1.7.10.4