diff --git a/README.md b/README.md index 5bba2a4..1dcce82 100644 --- a/README.md +++ b/README.md @@ -20,7 +20,7 @@ The release and Nix flake support `x86_64-linux` only. With [Nix](https://nixos.org/download) and flakes enabled: ```sh -nix run github:nerima-lisp/nshell/v0.6.5 +nix run github:nerima-lisp/nshell/v0.6.6 ``` At the prompt, enter `string upper hello`. Commands and paths colorize live, and a @@ -62,7 +62,7 @@ and session settings. ## Install ```sh -nix profile install github:nerima-lisp/nshell/v0.6.5 +nix profile install github:nerima-lisp/nshell/v0.6.6 ``` Pin a release tag rather than following the default branch. diff --git a/nshell.asd b/nshell.asd index 5740ef4..687e309 100644 --- a/nshell.asd +++ b/nshell.asd @@ -19,7 +19,7 @@ :license "MIT" ;; Single source of truth for the version. flake.nix reads this form ;; line-by-line, and release.yml refuses a tag that disagrees with it. - :version "0.6.5" + :version "0.6.6" :homepage "https://github.com/nerima-lisp/nshell" :bug-tracker "https://github.com/nerima-lisp/nshell/issues" :source-control (:git "https://github.com/nerima-lisp/nshell.git") @@ -403,7 +403,7 @@ :in-order-to ((test-op (test-op "nshell/test")))) (asdf:defsystem "nshell/test" - :version "0.6.5" + :version "0.6.6" :author "takeokunn " :maintainer "takeokunn " :license "MIT" @@ -590,7 +590,7 @@ (error "cl-weave tests failed")))) (asdf:defsystem "nshell/weave" - :version "0.6.5" + :version "0.6.6" :author "takeokunn " :maintainer "takeokunn " :license "MIT" @@ -620,7 +620,7 @@ primary suite in nshell/test." :reporter :spec) (error "cl-weave suite failed")))) (asdf:defsystem "nshell/benchmark" - :version "0.6.5" + :version "0.6.6" :author "takeokunn " :maintainer "takeokunn " :license "MIT" diff --git a/src/infrastructure/acl/syscall-process-execution.lisp b/src/infrastructure/acl/syscall-process-execution.lisp index d04cc29..bd38c4d 100644 --- a/src/infrastructure/acl/syscall-process-execution.lisp +++ b/src/infrastructure/acl/syscall-process-execution.lisp @@ -23,8 +23,8 @@ file` typed at an interactive prompt too." (defun run-external-exec (cmd args) "Execute CMD with ARGS for the exec builtin. -Standard streams pass through directly and noninteractive execution uses the -normal foreground timeout policy." +FD-backed standard streams pass through directly; other output streams are +drained under the normal foreground timeout policy." (handler-case (multiple-value-bind (resolved-cmd environment) (%prepare-external-command cmd) @@ -33,23 +33,21 @@ normal foreground timeout policy." (return-from run-external-exec 127)) (let ((proc (%spawn-in-own-process-group resolved-cmd args environment - *standard-input* *standard-output* - :error *error-output*))) + *standard-input* (%external-output-target *standard-output*) + :error (%external-output-target *error-output*)))) (if proc (let* ((pid (sb-ext:process-pid proc)) (pgid (and (integerp pid) (plusp pid) pid)) (timeout (%foreground-external-command-timeout))) (%with-foreground-process-group-if (pgid) - (if (or (null timeout) - (%wait-process-exit-with-timeout proc timeout)) - (progn - (%wait-sbcl-process proc) - (process-exit-status-code proc)) - (progn - (%terminate-process proc) - (format *error-output* "~a" - (%external-command-timeout-message cmd timeout)) - 124)))) + (values + (%wait-process-with-output + proc *standard-output* timeout + (lambda () + (format *error-output* "~a" + (%external-command-timeout-message cmd timeout)) + 124) + *error-output*)))) 1))) (error (err) (format *error-output* "exec: ~a: ~a~%" cmd err) @@ -65,7 +63,10 @@ normal foreground timeout policy." (return-from run-external 127)) (let ((proc (%spawn-external-command resolved-cmd args environment :input *standard-input* - :output :stream))) + :output :stream + :error (if *redirected-stderr* + (%external-output-target *error-output*) + :output)))) (if proc (let* ((pid (sb-ext:process-pid proc)) (pgid (and (integerp pid) (plusp pid) pid)) @@ -78,7 +79,8 @@ normal foreground timeout policy." (lambda () (format *error-output* "~a" (%external-command-timeout-message cmd timeout)) - 124)))) + 124) + *error-output*))) 1))) (error (err) (format *error-output* "nshell: ~a: ~a~%" cmd err) diff --git a/src/infrastructure/acl/syscall-process-io.lisp b/src/infrastructure/acl/syscall-process-io.lisp index 2803c27..ddfdab2 100644 --- a/src/infrastructure/acl/syscall-process-io.lisp +++ b/src/infrastructure/acl/syscall-process-io.lisp @@ -1,5 +1,12 @@ (in-package #:nshell.infrastructure.acl) +(defun %external-output-target (output) + ;; SBCL's internal copier for non-FD streams has no drain deadline. + (if (and (streamp output) + (null (sb-impl::get-stream-fd-and-external-format output :output))) + :stream + output)) + (defun %process-result-shell-exit (result) "Map a cl-process-kit PROCESS-RESULT to a shell exit status." (let ((code (process-kit:process-result-exit-code result)) diff --git a/src/infrastructure/acl/syscall-process.lisp b/src/infrastructure/acl/syscall-process.lisp index 91ea4e3..8faca19 100644 --- a/src/infrastructure/acl/syscall-process.lisp +++ b/src/infrastructure/acl/syscall-process.lisp @@ -118,12 +118,31 @@ (%join-process-output-copiers ,copiers))) (defun %wait-process-with-copiers (proc copiers timeout-seconds success-fn timeout-fn) - (funcall - (%with-process-output-copiers (copiers) - (if (or (null timeout-seconds) - (%wait-process-exit-with-timeout proc timeout-seconds)) - (progn (%wait-sbcl-process proc) success-fn) - (progn (%terminate-process proc) timeout-fn))))) + (let ((copiers (remove nil copiers)) + (callback success-fn) + (timed-out-p nil) + (deadline (when timeout-seconds + (+ (get-internal-real-time) + (round (* timeout-seconds internal-time-units-per-second)))))) + (unwind-protect + (progn + (loop while (or (sb-ext:process-alive-p proc) + (some #'sb-thread:thread-alive-p copiers)) + do (when (and deadline (>= (get-internal-real-time) deadline)) + (when (sb-ext:process-alive-p proc) + (%terminate-process proc)) + (setf callback timeout-fn + timed-out-p t) + (return)) + (sb-sys:serve-all-events 0.01)) + (unless timed-out-p + (%wait-sbcl-process proc))) + ;; Descendants may keep output pipes open after the owned process exits. + (dolist (copier copiers) + (when (sb-thread:thread-alive-p copier) + (sb-thread:terminate-thread copier)) + (%join-stream-copier copier))) + (funcall callback))) (defun %wait-process-with-copiers-or-stop (proc copiers success-fn stop-fn) "Wait for PROC while allowing a stopped process to be continued." @@ -136,11 +155,26 @@ (return (funcall (%with-process-output-copiers (copiers) success-fn)))))) -(defun %wait-process-with-output (proc output timeout-seconds timeout-fn) - (let ((copier (%start-process-output-copier proc output))) - (%wait-process-with-copiers proc (list copier) timeout-seconds - (lambda () (values (process-exit-status-code proc) nil)) - (lambda () (values (funcall timeout-fn) t))))) +(defun %wait-process-with-output (proc output timeout-seconds timeout-fn + &optional error-output) + (let ((copiers nil)) + (unwind-protect + (progn + (push (%start-process-output-copier proc output) copiers) + (let ((error-stream (sb-ext:process-error proc))) + (when (and error-stream + (not (eq error-stream (sb-ext:process-output proc)))) + (push (%start-stream-copier error-stream error-output + "nshell process error copier") + copiers))) + (%wait-process-with-copiers proc copiers timeout-seconds + (lambda () (values (process-exit-status-code proc) nil)) + (lambda () (values (funcall timeout-fn) t)))) + (dolist (copier copiers) + (when (and copier (sb-thread:thread-alive-p copier)) + (sb-thread:terminate-thread copier)) + (%join-stream-copier copier)) + (sb-ext:process-close proc)))) (defun spawn-async (cmd args &key redirects) "Spawn CMD with ARGS asynchronously. Returns the process or NIL on error." diff --git a/t/integration/test-process.lisp b/t/integration/test-process.lisp index c79694c..e962f92 100644 --- a/t/integration/test-process.lisp +++ b/t/integration/test-process.lisp @@ -12,6 +12,59 @@ "--eval" form)) +(defun %check-orphaned-external-output-timeout (executor separate-stderr-p fd-output-p) + (with-temporary-output-file (pid-file :prefix "nshell-external-orphan") + (with-temporary-output-file (output-file :prefix "nshell-external-output") + (let ((worker nil) (result nil) (failure nil) (join-reason nil) + (cleanup-join-reason nil) (worker-alive-p nil) (child-alive-p nil) + (child-kill-result nil) (error-output nil)) + (unwind-protect + (progn + (setf worker + (sb-thread:make-thread + (lambda () + (handler-case + (with-open-file (file-output output-file :direction :output + :if-does-not-exist :create) + (let ((nshell.infrastructure.acl:*external-command-timeout* 0.2) + (nshell.infrastructure.acl::*redirected-stderr* + separate-stderr-p) + (*standard-output* + (if fd-output-p file-output + (make-string-output-stream)))) + (setf error-output + (with-output-to-string (*error-output*) + (setf result + (funcall executor "/bin/sh" + (list "-c" + "sleep 3 & printf '%s' \"$!\" > \"$1\"" + "nshell-test" pid-file))))))) + (error (condition) (setf failure condition)))))) + (multiple-value-bind (value reason) + (sb-thread:join-thread worker :timeout 1 :default nil) + (declare (ignore value)) + (setf join-reason reason + worker-alive-p (sb-thread:thread-alive-p worker)))) + (let ((pid (ignore-errors + (parse-integer (host-kit:read-file-string pid-file))))) + (when pid + (setf child-alive-p (ignore-errors (sb-posix:kill pid 0) t) + child-kill-result (ignore-errors (sb-posix:kill pid sb-unix:sigkill))))) + (when worker + (multiple-value-bind (value reason) + (sb-thread:join-thread worker :timeout 3 :default nil) + (declare (ignore value)) + (setf cleanup-join-reason reason)))) + (expect nil :to-equal failure) + (expect nil :to-equal join-reason) + (expect nil :to-equal worker-alive-p) + (expect nil :to-equal cleanup-join-reason) + (expect nil :to-equal (sb-thread:thread-alive-p worker)) + (expect t :to-equal child-alive-p) + (expect 0 :to-equal child-kill-result) + (expect 124 :to-equal result) + (expect (search "timed out after" error-output) :to-be-truthy))))) + (describe "process-tests" (it "spawn-terminal-command-stops-before-running-user-code" (with-temporary-output-file (target :prefix "nshell-terminal-barrier") @@ -375,6 +428,20 @@ when *STANDARD-OUTPUT* is not an interactive terminal." (when bad-index (fail "unexpected character at ~d: ~s" bad-index (char output bad-index)))))) + (it "run-external-merges-stderr-into-stdout-once" + (let ((exit nil) (output nil) + (nshell.infrastructure.acl::*redirected-stderr* nil)) + (let ((error-output + (with-output-to-string (*error-output*) + (setf output + (capture-standard-output + (setf exit + (nshell.infrastructure.acl:run-external + "/bin/sh" '("-c" "printf OUT; printf ERR >&2")))))))) + (expect 0 :to-equal exit) + (expect "OUTERR" :to-equal output) + (expect "" :to-equal error-output)))) + (it "run-external-capture-echo" "External command capture returns stdout and exit code." (multiple-value-bind (output exit) @@ -408,6 +475,63 @@ when *STANDARD-OUTPUT* is not an interactive terminal." (expect 124 :to-equal exit) (expect (search "timed out after" error-output) :to-be-truthy))) + (it "run-external-timeout-covers-orphaned-output-writer" + (%check-orphaned-external-output-timeout + #'nshell.infrastructure.acl:run-external nil nil)) + + (it "process-output-timeout-callback-runs-after-copier-cleanup" + (let* ((proc (sb-ext:run-program "/bin/sh" '("-c" "exit 0") + :input nil :output nil :error nil :wait nil)) + (semaphore (sb-thread:make-semaphore)) + (copier (sb-thread:make-thread + (lambda () (sb-thread:wait-on-semaphore semaphore :timeout 3)))) + (success-called-p nil) (timeout-calls 0) (callback-copier-alive-p t)) + (unwind-protect + (multiple-value-bind (status timed-out-p) + (nshell.infrastructure.acl:%wait-process-with-copiers + proc (list copier) 0.2 + (lambda () (setf success-called-p t) (values 0 nil)) + (lambda () + (incf timeout-calls) + (setf callback-copier-alive-p (sb-thread:thread-alive-p copier)) + (values 124 t))) + (expect 124 :to-equal status) + (expect t :to-equal timed-out-p) + (expect nil :to-equal success-called-p) + (expect 1 :to-equal timeout-calls) + (expect nil :to-equal callback-copier-alive-p) + (expect nil :to-equal (sb-thread:thread-alive-p copier))) + (sb-thread:signal-semaphore semaphore) + (ignore-errors (sb-thread:join-thread copier :timeout 3)) + (nshell.infrastructure.acl::%terminate-process proc) + (sb-ext:process-close proc)))) + + (it "run-external-timeout-covers-orphaned-non-fd-stderr" + (%check-orphaned-external-output-timeout + #'nshell.infrastructure.acl:run-external t nil)) + + (it "run-external-exec-timeout-covers-orphaned-non-fd-stderr" + (%check-orphaned-external-output-timeout + #'nshell.infrastructure.acl:run-external-exec t t)) + + (it "run-external-exec-large-stdout-and-stderr-are-drained" + (let* ((size 131072) + (exit nil) (output nil) + (error-output + (with-output-to-string (*error-output*) + (setf output + (capture-standard-output + (setf exit + (nshell.infrastructure.acl:run-external-exec + (current-sbcl-executable) + (%process-test-sbcl-argv + (format nil + "(progn (write-string (make-string ~d :initial-element #\\x)) (write-string (make-string ~d :initial-element #\\y) *error-output*))" + size size))))))))) + (expect 0 :to-equal exit) + (expect (make-string size :initial-element #\x) :to-equal output) + (expect (make-string size :initial-element #\y) :to-equal error-output))) + (it "run-external-timeout-terminates-descendant-processes" "Timeout cleanup should kill descendants that inherited stdout." #+unix diff --git a/t/unit/test-assistant-model-boundary.lisp b/t/unit/test-assistant-model-boundary.lisp index ac5b16e..87ba26a 100644 --- a/t/unit/test-assistant-model-boundary.lisp +++ b/t/unit/test-assistant-model-boundary.lisp @@ -446,9 +446,10 @@ :timeout (cl-date-kit:duration-of-seconds 2))) (dolist (thread threads) (expect t :to-be (not (null thread))) - (expect nil :to-be - (eq :timed-out - (sb-thread:join-thread thread :timeout 2 :default :timed-out))) + (multiple-value-bind (value problem) + (sb-thread:join-thread thread :timeout 2 :default nil) + (declare (ignore value)) + (expect nil :to-be (eq :timeout problem))) (expect nil :to-be (sb-thread:thread-alive-p thread))) (let ((received (uiop:read-file-lines received-path))) (expect (if unsafe-init 0 1) :to-be (length received)) diff --git a/t/unit/test-execute-pipeline.lisp b/t/unit/test-execute-pipeline.lisp index d482730..f957433 100644 --- a/t/unit/test-execute-pipeline.lisp +++ b/t/unit/test-execute-pipeline.lisp @@ -4,36 +4,47 @@ (dolist (phase '(:wait-error :callback-error)) (let ((phase phase)) (it (format nil "copier-order-~(~A~)" phase) - (let ((joins 0) + (let ((copier (sb-thread:make-thread (lambda () nil))) + (joins 0) + (callbacks 0) (failure (make-condition 'simple-error))) - (with-temporary-functions - (('nshell.infrastructure.acl::%wait-process-exit-with-timeout - (lambda (&rest arguments) - (declare (ignore arguments)) - (when (eq phase :wait-error) (error failure)) - nil)) - ('nshell.infrastructure.acl::%terminate-process - (lambda (process) (declare (ignore process)))) - ('nshell.infrastructure.acl::%join-process-output-copiers - (lambda (copiers) - (declare (ignore copiers)) - (incf joins)))) - (expect failure :to-equal - (handler-case - (nshell.infrastructure.acl::%wait-process-with-copiers - :process '(:copier) 1 - (lambda () (error "Unexpected success")) - (lambda () (error failure))) - (simple-error (condition) condition))) - (expect 1 :to-equal joins)))))) + (sb-thread:join-thread copier) + (sb-ext:without-package-locks + (with-temporary-functions + (('sb-ext:process-alive-p + (lambda (process) + (declare (ignore process)) + (when (eq phase :wait-error) (error failure)) + nil)) + ('nshell.infrastructure.acl::%wait-sbcl-process + (lambda (process) (declare (ignore process)))) + ('nshell.infrastructure.acl::%join-stream-copier + (lambda (thread) + (expect copier :to-equal thread) + (expect nil :to-equal (sb-thread:thread-alive-p thread)) + (incf joins)))) + (expect failure :to-equal + (handler-case + (nshell.infrastructure.acl::%wait-process-with-copiers + :process (list copier) 1 + (lambda () + (incf callbacks) + (expect 1 :to-equal joins) + (error failure)) + (lambda () (error "Unexpected timeout"))) + (simple-error (condition) condition))) + (expect 1 :to-equal joins) + (expect (if (eq phase :wait-error) 0 1) :to-equal callbacks))))))) (dolist (mode '(:success :timeout :resumed-stop)) (let ((mode mode)) (it (format nil "copier-order-~(~A~)" mode) (let ((buffer (make-string-output-stream)) + (copier (sb-thread:make-thread (lambda () nil))) (joins 0) (waits 0) (terminated nil)) + (sb-thread:join-thread copier) (sb-ext:without-package-locks (with-temporary-functions (('nshell.infrastructure.acl::%wait-sbcl-process @@ -44,17 +55,18 @@ (lambda (process) (declare (ignore process)) (if (= waits 1) :stopped :exited))) - ('nshell.infrastructure.acl::%wait-process-exit-with-timeout - (lambda (&rest arguments) - (declare (ignore arguments)) - nil)) + ('sb-ext:process-alive-p + (lambda (process) + (declare (ignore process)) + (eq mode :timeout))) ('nshell.infrastructure.acl::%terminate-process (lambda (process) (declare (ignore process)) (setf terminated t))) - ('nshell.infrastructure.acl::%join-process-output-copiers - (lambda (copiers) - (expect '(:copier) :to-equal copiers) + ('nshell.infrastructure.acl::%join-stream-copier + (lambda (thread) + (expect copier :to-equal thread) + (expect nil :to-equal (sb-thread:thread-alive-p thread)) (incf joins) (write-string "complete" buffer)))) (flet ((collect-output () @@ -62,16 +74,18 @@ (multiple-value-bind (output code) (if (eq mode :resumed-stop) (nshell.infrastructure.acl::%wait-process-with-copiers-or-stop - :process '(:copier) #'collect-output + :process (list copier) #'collect-output (lambda () (expect 0 :to-equal joins) :continue-wait)) (nshell.infrastructure.acl::%wait-process-with-copiers - :process '(:copier) (when (eq mode :timeout) 1) + :process (list copier) (when (eq mode :timeout) 0) #'collect-output #'collect-output)) (expect "complete" :to-equal output) (expect 7 :to-equal code) (expect 1 :to-equal joins) + (expect (case mode (:timeout 0) (:success 1) (:resumed-stop 2)) + :to-equal waits) (expect (eq mode :timeout) :to-equal terminated))))))))) (it "command-substitution-keeps-capture-under-terminal-runner"