From 1b8318df3bafcdfe9927e21b0083c2b04015e734 Mon Sep 17 00:00:00 2001 From: takeokunn Date: Mon, 12 Oct 2026 00:32:41 +0900 Subject: [PATCH 1/6] fix: restore explicit assistant execution and provider lifecycle --- .../assistant/src/domain/redaction.lisp | 120 +++-- .../feature/assistant/src/domain/safety.lisp | 139 +++--- .../src/infrastructure/audit-log.lisp | 1 + src/application/execute-pipeline-stage.lisp | 3 +- .../assistant-sidecar-stream.lisp | 199 ++++---- src/presentation/repl-export.lisp | 24 +- src/presentation/repl-output-handlers.lisp | 30 +- src/presentation/repl.lisp | 4 + t/unit/test-agent-mode.lisp | 35 ++ t/unit/test-assistant-context.lisp | 104 ++++ t/unit/test-assistant-model-boundary.lisp | 467 ++++++++++++++++-- t/unit/test-assistant-redaction.lisp | 77 +++ t/unit/test-assistant-safety.lisp | 32 ++ t/unit/test-repl-ask.lisp | 51 ++ 14 files changed, 1019 insertions(+), 267 deletions(-) diff --git a/packages/feature/assistant/src/domain/redaction.lisp b/packages/feature/assistant/src/domain/redaction.lisp index b71d0214..db08409d 100644 --- a/packages/feature/assistant/src/domain/redaction.lisp +++ b/packages/feature/assistant/src/domain/redaction.lisp @@ -178,44 +178,43 @@ (match 0 0))) (defun %assistant-command-token-separator-p (token) - (member token '("|" "||" ";" "&&" "$(" ")") :test #'string=)) + (keywordp token)) (defun %assistant-split-command-tokens (line) (let ((tokens nil) - (start nil) - (length (length line))) - (labels ((flush-token (position) - (when start - (push (subseq line start position) tokens) - (setf start nil))) - (push-token (token) - (push token tokens))) - (loop for position from 0 below length - for character = (char line position) - do (cond - ((%assistant-whitespace-p character) - (flush-token position)) - ((char= character #\$) - (if (and (< (1+ position) length) - (char= (char line (1+ position)) #\()) - (progn - (flush-token position) - (push-token "$(") - (incf position)) - (unless start (setf start position)))) - ((member character '(#\| #\; #\) #\&) :test #'char=) - (flush-token position) - (if (and (member character '(#\| #\&) :test #'char=) - (< (1+ position) length) - (char= (char line (1+ position)) character)) - (progn - (push-token (if (char= character #\|) "||" "&&")) - (incf position)) - (push-token (string character)))) - (t - (unless start (setf start position)))) - finally (flush-token length)) - (nreverse tokens)))) + (substitutions nil) + (word-end nil)) + (dolist (token (nshell.domain.parsing:tokenization-result-tokens + (nshell.domain.parsing:tokenize line))) + (let ((type (nshell.domain.parsing:token-type token)) + (value (nshell.domain.parsing:token-value token))) + (cond + ((eq type :word) + ;; The parser joins adjacent quoted and unquoted word fragments. + (if (eql word-end (nshell.domain.parsing:token-start token)) + (setf (first tokens) (concatenate 'string (first tokens) value)) + (push value tokens)) + (setf word-end (nshell.domain.parsing:token-end token)) + (unless (eq (nshell.domain.parsing:token-quote-style token) :single) + (dolist (marker '("$(" "<(" ">(" "(")) + (dolist (text (nshell.domain.parsing:parenthesized-substitution-texts + value marker)) + ;; Partial command lines still need their denylisted bodies removed. + (let ((body (if (eq text :incomplete) + (subseq value (+ (search marker value) + (length marker))) + text))) + (push (cons :substitution + (%assistant-split-command-tokens body)) + substitutions)))))) + ((member type '(:pipe :and :or :semicolon :newline :ampersand + :lparen :rparen)) + (push type tokens) + (setf word-end nil)) + (t (setf word-end nil))))) + (append (nreverse tokens) + (loop for substitution in (nreverse substitutions) + append (append substitution (list :substitution)))))) (defun %assistant-command-token-name (token) (let ((slash (position #\/ token :from-end t))) @@ -227,17 +226,24 @@ :test #'string=)) (defun %assistant-wrapper-option-takes-argument-p (wrapper option) - (and (member wrapper '("sudo" "env" "nice" "stdbuf") :test #'string=) - (or (member option - '("-u" "--user" "-g" "--group" "-h" "--host" - "-p" "--prompt" "-C" "--close-from" "-D" "--chdir" - "-R" "--chroot" "-r" "--role" "-t" "--type" - "-n" "--adjustment" "-i" "--input" "-o" "--output" - "-e" "--error" "--unset") - :test #'string=) - (and (> (length option) 2) - (member (subseq option 0 2) '("-u" "-g" "-p" "-C" "-D" "-R" "-r" "-t" "-n") - :test #'string=))))) + (multiple-value-bind (short-options long-options) + (cond + ((string= wrapper "sudo") + (values "ughpCDRrt" '("--user" "--group" "--host" "--prompt" + "--close-from" "--chdir" "--chroot" "--role" "--type"))) + ((string= wrapper "env") + (values "uCS" '("--unset" "--chdir" "--split-string"))) + ((string= wrapper "nice") (values "n" '("--adjustment"))) + ((string= wrapper "stdbuf") (values "ioe" '("--input" "--output" "--error")))) + (or (member option long-options :test #'string=) + ;; An attached short-option value does not consume the following command. + (and short-options (> (length option) 1) + (char= (char option 0) #\-) + (not (char= (char option 1) #\-)) + (let ((position (position-if (lambda (character) + (find character short-options)) + option :start 1))) + (and position (= position (1- (length option))))))))) (defun %assistant-command-index-after-wrappers (tokens start) (loop with position = start @@ -246,6 +252,8 @@ do (cond ((%assistant-command-token-separator-p token) (return nil)) + ((nshell.domain.parsing:shell-assignment-word-p token) + (incf position)) ((not (%assistant-wrapper-name-p token)) (return position)) (t @@ -253,23 +261,29 @@ (incf position) (loop while (< position (length tokens)) for option = (nth position tokens) - while (or (and (string= wrapper "env") - (search "=" option)) - (and (plusp (length option)) - (char= (char option 0) #\-))) + while (and (stringp option) + (or (and (string= wrapper "env") + (nshell.domain.parsing:shell-assignment-word-p option)) + (and (plusp (length option)) + (char= (char option 0) #\-)))) do (incf position) + (when (string= option "--") (return)) (when (%assistant-wrapper-option-takes-argument-p wrapper option) - (incf position)))))))) + (if (and (< position (length tokens)) + (stringp (nth position tokens))) + (incf position) + (return-from %assistant-command-index-after-wrappers nil))))))))) (defun %assistant-command-pattern-match-p (pattern tokens position) (let ((pattern-tokens (%assistant-split-command-tokens pattern))) (and (plusp (length pattern-tokens)) + (stringp (first pattern-tokens)) (<= (+ position (length pattern-tokens)) (length tokens)) (string= (%assistant-command-token-name (first pattern-tokens)) (%assistant-command-token-name (nth position tokens))) (loop for offset from 1 below (length pattern-tokens) - always (string= (nth offset pattern-tokens) - (nth (+ position offset) tokens)))))) + always (equal (nth offset pattern-tokens) + (nth (+ position offset) tokens)))))) (defun %assistant-denylisted-command-p (tokens denylist-commands) (loop for position = 0 then (1+ separator) diff --git a/packages/feature/assistant/src/domain/safety.lisp b/packages/feature/assistant/src/domain/safety.lisp index 65d83ebd..df155427 100644 --- a/packages/feature/assistant/src/domain/safety.lisp +++ b/packages/feature/assistant/src/domain/safety.lisp @@ -30,7 +30,7 @@ (:arg-equals "~") (:arg-equals "$HOME") (:arg-equals ".")) - (:any (:arg-prefix "-r") (:arg-equals "--recursive"))) + (:any (:short-option-any "rR") (:option-equals "--recursive"))) :reason "recursive deletion of the filesystem root is blocked") (make-assistant-safety-rule :name :destructive-delete @@ -79,10 +79,23 @@ (some (lambda (part) (%assistant-condition-p part args)) (rest condition))) ((and (consp condition) (eq (first condition) :arg-equals)) (member (second condition) args :test #'string=)) + ((and (consp condition) (eq (first condition) :option-equals)) + (loop for arg in args + until (string= arg "--") + thereis (string= (second condition) arg))) ((and (consp condition) (eq (first condition) :arg-prefix)) (some (lambda (arg) (%assistant-string-prefix-p (second condition) arg)) args)) + ((and (consp condition) (eq (first condition) :short-option-any)) + (loop for arg in args + until (string= arg "--") + thereis (and (> (length arg) 1) + (char= (char arg 0) #\-) + (not (char= (char arg 1) #\-)) + (find-if (lambda (character) + (find character (second condition))) + (subseq arg 1))))) ((and (consp condition) (eq (first condition) :subcommand-equals)) (and (first args) (string= (second condition) (first args)))) (t nil))) @@ -268,69 +281,67 @@ (let* ((command (nshell.domain.parsing:command-node-command node)) (args (nshell.domain.parsing:command-node-arg-values node)) (rule (%assistant-rule-for command args)) - (substitution-result (%assistant-command-substitution-result command args))) - (cond - ((and substitution-result - (eq :block - (assistant-safety-result-classification substitution-result))) - substitution-result) - ((and substitution-result - (eq :confirm - (assistant-safety-result-classification substitution-result))) - substitution-result) - ((%assistant-unsafe-argument-p command args) - (make-assistant-safety-result - :classification :confirm - :command command - :reason (%assistant-unsafe-argument-reason command args))) - ((and (string= command "git") - (not (%assistant-safe-git-command-p args))) - (make-assistant-safety-result - :classification :confirm - :command command - :reason "writing, external command execution, or configuration injection requires confirmation")) - ((or (member command +assistant-safe-command-names+ :test #'string=) - (and (string= command "git") - (%assistant-safe-git-command-p args))) - (make-assistant-safety-result - :classification :safe - :command command - :rule-name :safe-allowlist - :reason "command is on the built-in read-only allowlist")) - ((multiple-value-bind (index kind) - (%assistant-wrapper-index-and-kind command args) - (declare (ignore kind)) - (when index - (%assistant-parse-and-classify-text - (format nil "~{~a~^ ~}" (nthcdr (1+ index) (cons command args))))))) - ((string= command "source") - ;; The arguments name a file; classifying them cannot vet its contents. - (make-assistant-safety-result - :classification :confirm - :command command - :reason "sourcing a file can execute commands and requires confirmation")) - ((string= command "eval") - (%assistant-parse-and-classify-text (format nil "~{~a~^ ~}" args))) - ((member command '("sh" "bash" "zsh" "fish") :test #'string=) - (let ((index (position "-c" args :test #'string=))) - (if (and index (nth (1+ index) args)) - (%assistant-parse-and-classify-text (nth (1+ index) args)) - (%assistant-unknown-command-result command)))) - ((and rule - (eq (assistant-safety-rule-classification rule) :block)) - (make-assistant-safety-result - :classification :block - :command command - :rule-name (assistant-safety-rule-name rule) - :reason (assistant-safety-rule-reason rule))) - (rule - (make-assistant-safety-result - :classification (assistant-safety-rule-classification rule) - :command command - :rule-name (assistant-safety-rule-name rule) - :reason (assistant-safety-rule-reason rule))) - (t (or (%assistant-unknown-wrapper-result command args) - (%assistant-unknown-command-result command))))) + (substitution-result (%assistant-command-substitution-result command args)) + (unsafe-reason (%assistant-unsafe-argument-reason command args))) + ;; Redirects and substitutions add restrictions; they cannot relax a block. + (%assistant-most-restrictive-result + (remove nil + (list + (cond + ((and (string= command "git") + (not (%assistant-safe-git-command-p args))) + (make-assistant-safety-result + :classification :confirm + :command command + :reason "writing, external command execution, or configuration injection requires confirmation")) + ((or (member command +assistant-safe-command-names+ :test #'string=) + (and (string= command "git") + (%assistant-safe-git-command-p args))) + (make-assistant-safety-result + :classification :safe + :command command + :rule-name :safe-allowlist + :reason "command is on the built-in read-only allowlist")) + ((multiple-value-bind (index kind) + (%assistant-wrapper-index-and-kind command args) + (declare (ignore kind)) + (when index + (%assistant-parse-and-classify-text + (format nil "~{~a~^ ~}" (nthcdr (1+ index) (cons command args))))))) + ((string= command "source") + ;; The arguments name a file; classifying them cannot vet its contents. + (make-assistant-safety-result + :classification :confirm + :command command + :reason "sourcing a file can execute commands and requires confirmation")) + ((string= command "eval") + (%assistant-parse-and-classify-text (format nil "~{~a~^ ~}" args))) + ((member command '("sh" "bash" "zsh" "fish") :test #'string=) + (let ((index (position "-c" args :test #'string=))) + (if (and index (nth (1+ index) args)) + (%assistant-parse-and-classify-text (nth (1+ index) args)) + (%assistant-unknown-command-result command)))) + ((and rule + (eq (assistant-safety-rule-classification rule) :block)) + (make-assistant-safety-result + :classification :block + :command command + :rule-name (assistant-safety-rule-name rule) + :reason (assistant-safety-rule-reason rule))) + (rule + (make-assistant-safety-result + :classification (assistant-safety-rule-classification rule) + :command command + :rule-name (assistant-safety-rule-name rule) + :reason (assistant-safety-rule-reason rule))) + (t (or (%assistant-unknown-wrapper-result command args) + (%assistant-unknown-command-result command)))) + substitution-result + (when unsafe-reason + (make-assistant-safety-result + :classification :confirm + :command command + :reason unsafe-reason)))))) (make-assistant-safety-result :classification :block :reason "the value is not a command AST node"))) diff --git a/packages/feature/assistant/src/infrastructure/audit-log.lisp b/packages/feature/assistant/src/infrastructure/audit-log.lisp index b86f32d1..07bcf4e6 100644 --- a/packages/feature/assistant/src/infrastructure/audit-log.lisp +++ b/packages/feature/assistant/src/infrastructure/audit-log.lisp @@ -42,6 +42,7 @@ (defun %assistant-json-value (value) (cond + ((null value) json-kit:+json-null+) ((stringp value) value) ((%assistant-plist-p value) (json-kit:alist->json-object diff --git a/src/application/execute-pipeline-stage.lisp b/src/application/execute-pipeline-stage.lisp index f4761a87..35e48081 100644 --- a/src/application/execute-pipeline-stage.lisp +++ b/src/application/execute-pipeline-stage.lisp @@ -3,7 +3,8 @@ (declaim (notinline nshell.infrastructure.acl:process-substitution-resource-path nshell.infrastructure.acl:process-substitution-resource-fd)) -(declaim (special nshell.infrastructure.acl:*external-command-timeout*)) +(declaim (special nshell.infrastructure.acl:*external-command-timeout* + *execution-gate-parent-kind*)) ;;; Pipeline stage execution and command expansion. ;;; execute-ast-in-context (defined in execute-pipeline-control.lisp) is diff --git a/src/infrastructure/assistant-sidecar-stream.lisp b/src/infrastructure/assistant-sidecar-stream.lisp index 4a6723ea..2818a458 100644 --- a/src/infrastructure/assistant-sidecar-stream.lisp +++ b/src/infrastructure/assistant-sidecar-stream.lisp @@ -8,6 +8,8 @@ ((equal type "assistant") :assistant) ((equal type "rate_limit_event") :rate-limit-event) ((equal type "result") :result) + ((equal type "control_response") :control-response) + ((equal type "user") :user) (t :unknown)))) (defun %assistant-read-json-value (stream) @@ -97,29 +99,28 @@ (:value (when pending (let ((kind (%assistant-event-kind object))) - (if (eq kind :unknown) + (cond + ((and (member kind '(:control-response :user)) + (not (%assistant-sidecar-starting-p state))) nil) + ((eq kind :unknown) (progn (%assistant-sidecar-publish pending (%assistant-sidecar-error-event pending-generation "assistant sidecar returned an unknown event")) - (%assistant-sidecar-complete pending)) - (let ((event (make-assistant-model-event + (%assistant-sidecar-complete pending))) + (t (let ((event (make-assistant-model-event pending-generation kind object))) (%assistant-sidecar-publish pending event) - (when (eq kind :result) - (%assistant-sidecar-complete pending))))))) + (when (and (eq kind :result) + (not (%assistant-sidecar-starting-p state))) + (%assistant-sidecar-complete pending)))))))) (:eof - ;; EOF means the sidecar has closed its protocol stream. Reap the - ;; exited child before respawn cleanup can inspect its stale handle. - (ignore-errors - (sb-ext:process-wait - (nshell.infrastructure.acl:sidecar-handle-process handle))) - ;; A request can arrive while PROCESS-WAIT reaps the child. Settle - ;; the cell captured by the identity-validated stop transition. + ;; Closing stdout does not imply process exit. Use bounded stop + ;; cleanup and settle the cell captured by its identity check. (multiple-value-bind (stopped-p stopped-pending) (%assistant-sidecar-stop-state state :preserve-pending-p t @@ -203,18 +204,6 @@ (when channel (ignore-errors (cl-concurrent-kit:close-channel channel)))) -(defun %assistant-sidecar-discard-pending (state pending) - (when (%assistant-sidecar-clear-pending state pending) - (loop - (multiple-value-bind (event present-p closed-p) - (cl-concurrent-kit:try-recv - (assistant-pending-cell-events pending)) - (declare (ignore event closed-p)) - (unless present-p - (return)))) - (%assistant-sidecar-close-channel - (assistant-pending-cell-events pending)))) - (defun %assistant-sidecar-drain-pending-events (pending) (loop (multiple-value-bind (event present-p closed-p) @@ -226,7 +215,8 @@ (defun %assistant-sidecar-retire-pending (state pending) (sb-thread:with-mutex ((assistant-sidecar-state-lock state)) - (push pending (assistant-sidecar-state-retired-pending state)))) + ;; Only the most recently stopped turn can still be polled by the caller. + (setf (assistant-sidecar-state-retired-pending state) (list pending)))) (defun %assistant-sidecar-terminate-pending (state pending reason) (when (and pending (%assistant-sidecar-clear-pending state pending)) @@ -345,8 +335,60 @@ :name "nshell assistant sidecar error reader")) t))) +(defun %assistant-sidecar-init-handshake (state pending) + ;; Claude emits its isolation manifest only after receiving user input. + ;; Bootstrap with no user context, interrupt that turn, and consume its + ;; terminal response before allowing the queued request onto the stream. + (%assistant-sidecar-write-item + state (%make-assistant-write-item + (assistant-pending-cell-generation pending) + "{\"type\":\"user\",\"message\":{\"role\":\"user\",\"content\":\"\"}}")) + (let ((deadline (+ (get-internal-real-time) + (round (* +assistant-sidecar-handshake-timeout-seconds+ + internal-time-units-per-second)))) + (safe-p nil) + (interrupted-p nil) + (finished-p nil)) + (loop + (unless (%assistant-sidecar-starting-p state) + (return nil)) + (multiple-value-bind (event present-p closed-p) + (cl-concurrent-kit:try-recv (assistant-pending-cell-events pending)) + (declare (ignore closed-p)) + (when (and present-p (assistant-model-event-p event)) + (case (assistant-model-event-kind event) + (:system-init + (unless (and (not safe-p) + (assistant-system-init-safe-p + (assistant-model-event-payload event))) + (return nil)) + (setf safe-p t) + (%assistant-sidecar-write-item + state (%make-assistant-write-item + (assistant-pending-cell-generation pending) + "{\"type\":\"control_request\",\"request_id\":\"nshell-bootstrap-interrupt\",\"request\":{\"subtype\":\"interrupt\"}}"))) + (:control-response + (let ((response (%assistant-object-field + (assistant-model-event-payload event) "response"))) + (unless (and safe-p + (equal (%assistant-object-field response "request_id") + "nshell-bootstrap-interrupt") + (equal (%assistant-object-field response "subtype") + "success")) + (return nil)) + (setf interrupted-p t))) + (:result + (unless safe-p (return nil)) + (setf finished-p t)) + ((:stream-error :stream-ended) (return nil)))) + (when (and safe-p interrupted-p finished-p) + (return t)) + (when (>= (get-internal-real-time) deadline) + (return nil)) + (unless present-p (sleep 0.01)))))) + (defun %assistant-sidecar-start-worker (state pending startup-generation) - (let ((startup-events nil)) + (progn (multiple-value-bind (version version-status) (let ((cached-version (sb-thread:with-mutex ((assistant-sidecar-state-lock state)) @@ -397,40 +439,11 @@ (%assistant-sidecar-close-channel write-channel) (return-from %assistant-sidecar-start-worker (nshell.infrastructure.acl:stop-sidecar handle))) - (let ((deadline (+ (get-internal-real-time) - (round (* +assistant-sidecar-handshake-timeout-seconds+ - internal-time-units-per-second))))) - (loop - (multiple-value-bind (event present-p closed-p) - (cl-concurrent-kit:try-recv - (assistant-pending-cell-events pending)) - (declare (ignore closed-p)) - (when (or (not (%assistant-sidecar-starting-p state)) - present-p) - (when (and present-p - (assistant-model-event-p event) - (eq :system-init - (assistant-model-event-kind event)) - (assistant-system-init-safe-p - (assistant-model-event-payload event))) - (sb-thread:with-mutex ((assistant-sidecar-state-lock state)) - (setf (assistant-sidecar-state-init-p state) t))) - (when (and present-p (assistant-model-event-p event)) - (let ((kind (assistant-model-event-kind event))) - (cond - ((member kind '(:stream-error :stream-ended)) - (return)) - ((eq kind :system-init) - (return)) - ((not (eq kind :system-init)) - (push event startup-events))))) - (when (or (%assistant-sidecar-init-p state) - (not (%assistant-sidecar-starting-p state))) - (return))) - (when (and (not present-p) - (>= (get-internal-real-time) deadline)) - (return)) - (sleep 0.01))) + (when (%assistant-sidecar-init-handshake state pending) + (sb-thread:with-mutex ((assistant-sidecar-state-lock state)) + (when (eql startup-generation + (assistant-sidecar-state-startup-generation state)) + (setf (assistant-sidecar-state-init-p state) t)))) (unless (%assistant-sidecar-generation-current-p state startup-generation) (return-from %assistant-sidecar-start-worker nil)) @@ -449,8 +462,6 @@ (make-assistant-model-event (assistant-pending-cell-generation pending) :system-init nil)) - (dolist (event (nreverse startup-events)) - (%assistant-sidecar-publish pending event)) (when payload (%assistant-sidecar-write-item state @@ -467,13 +478,18 @@ "assistant sidecar init handshake failed")) (%assistant-sidecar-complete pending) (%assistant-sidecar-stop-state state - :preserve-pending-p t)))))))))))) + :preserve-pending-p t))))))))))) (defun %assistant-sidecar-start (state) (let ((startup-generation (sb-thread:with-mutex ((assistant-sidecar-state-lock state)) (cond ((assistant-sidecar-state-starting-p state) :already-starting) + ((and (assistant-sidecar-state-init-p state) + (not (assistant-sidecar-state-dead-p state)) + (assistant-sidecar-state-handle state) + (nshell.infrastructure.acl:sidecar-alive-p + (assistant-sidecar-state-handle state))) :already-starting) ((null (assistant-sidecar-state-command state)) (setf (assistant-sidecar-state-disabled-reason state) :disabled-by-environment) @@ -541,7 +557,7 @@ (let ((pending (%assistant-sidecar-current-pending state))) (when (and pending (%assistant-sidecar-starting-p state)) (handler-case - (let ((line (json-kit:stringify (json-kit:alist->json-object payload)))) + (let ((line (json-kit:stringify (%assistant-json-value payload)))) (unless (json-kit:parse line :object-type :alist) (return-from %assistant-sidecar-request nil)) (let ((send-now-p nil)) @@ -562,7 +578,7 @@ (%assistant-sidecar-init-p state) (zerop (assistant-pending-cell-generation pending))) (handler-case - (let ((line (json-kit:stringify (json-kit:alist->json-object payload)))) + (let ((line (json-kit:stringify (%assistant-json-value payload)))) (unless (json-kit:parse line :object-type :alist) (return-from %assistant-sidecar-request nil)) (let ((send-now-p nil)) @@ -581,7 +597,7 @@ (not (%assistant-sidecar-dead-p state)) (null pending)) (handler-case - (let* ((object (json-kit:alist->json-object payload)) + (let* ((object (%assistant-json-value payload)) (line (json-kit:stringify object))) (unless (json-kit:parse line :object-type :alist) (return-from %assistant-sidecar-request nil)) @@ -608,7 +624,8 @@ nil)))) (defun %assistant-sidecar-poll (state generation) - (let ((pending (%assistant-sidecar-current-pending state))) + (let* ((current (%assistant-sidecar-current-pending state)) + (pending current)) (when (and pending (eql generation (assistant-pending-cell-generation pending)) (%assistant-sidecar-starting-p state)) @@ -627,25 +644,41 @@ (cl-concurrent-kit:try-recv (assistant-pending-cell-events pending)) (declare (ignore closed-p)) - (when (and present-p - (assistant-model-event-p event) - (member (assistant-model-event-kind event) - '(:result :stream-ended :stream-error - :rate-limit-event))) - (if (eq pending (%assistant-sidecar-current-pending state)) - (%assistant-sidecar-clear-pending state pending) - (sb-thread:with-mutex ((assistant-sidecar-state-lock state)) - (setf (assistant-sidecar-state-retired-pending state) - (delete pending - (assistant-sidecar-state-retired-pending state) - :test #'eq)))) - (%assistant-sidecar-close-channel - (assistant-pending-cell-events pending))) + (when (and present-p (assistant-model-event-p event)) + (let ((rejected-p + (and (eq (assistant-model-event-kind event) :rate-limit-event) + (equal "rejected" + (%assistant-object-field + (%assistant-object-field + (assistant-model-event-payload event) "rate_limit_info") + "status"))))) + (when (or rejected-p + (member (assistant-model-event-kind event) + '(:result :stream-ended :stream-error))) + (if (eq pending (%assistant-sidecar-current-pending state)) + (progn + ;; A rejected turn can still emit a result. Retire its + ;; process before allowing another request to use it. + (when rejected-p + (%assistant-sidecar-stop-state state :preserve-pending-p t)) + (%assistant-sidecar-clear-pending state pending)) + (sb-thread:with-mutex ((assistant-sidecar-state-lock state)) + (setf (assistant-sidecar-state-retired-pending state) + (delete pending + (assistant-sidecar-state-retired-pending state) + :test #'eq)))) + (when rejected-p + (%assistant-sidecar-complete pending)) + (%assistant-sidecar-close-channel + (assistant-pending-cell-events pending))))) (values event present-p)) (progn - (when (and pending + (when (and current + (> generation (assistant-pending-cell-generation current)) (not (%assistant-sidecar-starting-p state))) - (%assistant-sidecar-discard-pending state pending)) + ;; A stopped turn must lose its process, not just its event queue: + ;; otherwise its late response could be assigned to the next turn. + (%assistant-sidecar-stop-state state)) (values nil nil))))) (defun %assistant-sidecar-stop (state) diff --git a/src/presentation/repl-export.lisp b/src/presentation/repl-export.lisp index 0feeb0bd..d3bb5fc7 100644 --- a/src/presentation/repl-export.lisp +++ b/src/presentation/repl-export.lisp @@ -1,10 +1,32 @@ (in-package #:nshell.presentation) +(defun %assistant-environment-denylist-values (bindings) + ;; Only known, typed non-credential bindings may be omitted. Unknown short + ;; values remain protected, even when they duplicate a normal setting. + (loop for binding in bindings + for name = (nshell.domain.environment:env-binding-name binding) + for value = (nshell.domain.environment:env-binding-value binding) + for number = (and (member name '("NSHELL_AI_MAX_STEPS" "?" "status") + :test #'string=) + (plusp (length value)) + (every (lambda (character) + (char<= #\0 character #\9)) + value) + (parse-integer value)) + unless (and number + (or (and (string= name "NSHELL_AI_MAX_STEPS") + (plusp number)) + (and (member name '("?" "status") :test #'string=) + (not (nshell.domain.environment:env-binding-exported-p + binding)) + (<= 0 number 255)))) + collect value)) + (defun %assistant-export-environment-data () (let ((bindings (nshell.domain.environment:env-bindings (ensure-environment)))) (values (mapcar #'nshell.domain.environment:env-binding-name bindings) - (mapcar #'nshell.domain.environment:env-binding-value bindings)))) + (%assistant-environment-denylist-values bindings)))) (defun %export-prompt-state () (when (and *interactive-terminal-installed-p* *assistant-session-id*) diff --git a/src/presentation/repl-output-handlers.lisp b/src/presentation/repl-output-handlers.lisp index 94c7e15c..c6fe8dee 100644 --- a/src/presentation/repl-output-handlers.lisp +++ b/src/presentation/repl-output-handlers.lisp @@ -105,7 +105,7 @@ wrapped line's other rows on screen as stale duplicates." :denylist-commands nshell.feature.assistant:+assistant-default-denylist-commands+ :denylist-values - (mapcar #'nshell.domain.environment:env-binding-value bindings)))) + (%assistant-environment-denylist-values bindings)))) (defun %assistant-payload-field (payload key) (when (listp payload) @@ -363,9 +363,15 @@ wrapped line's other rows on screen as stale duplicates." (refresh-current-input-state-suggestion)) (defun %ask-model-terminal-event-p (event) - (member (nshell.feature.assistant:assistant-model-event-kind event) - '(:result :stream-ended :stream-error :rate-limit-event) - :test #'eq)) + (let ((kind (nshell.feature.assistant:assistant-model-event-kind event))) + (or (member kind '(:result :stream-ended :stream-error) :test #'eq) + (and (eq kind :rate-limit-event) + (equal "rejected" + (%assistant-payload-field + (%assistant-payload-field + (nshell.feature.assistant:assistant-model-event-payload event) + "rate_limit_info") + "status")))))) (defun %handle-ask-model-event (event) (let ((kind (nshell.feature.assistant:assistant-model-event-kind event)) @@ -375,6 +381,9 @@ wrapped line's other rows on screen as stale duplicates." (nshell.feature.assistant:record-assistant-result-usage payload)) (:rate-limit-event (nshell.feature.assistant:record-assistant-rate-limit payload))) + (when (and (eq kind :rate-limit-event) + (not (%ask-model-terminal-event-p event))) + (return-from %handle-ask-model-event nil)) (cond ((eq *assistant-request-kind* :agent) (%handle-agent-model-event event)) @@ -455,9 +464,9 @@ wrapped line's other rows on screen as stale duplicates." :denylist-commands nshell.feature.assistant:+assistant-default-denylist-commands+ :denylist-values - (mapcar #'nshell.domain.environment:env-binding-value - (nshell.domain.environment:env-bindings - (ensure-environment))))) + (%assistant-environment-denylist-values + (nshell.domain.environment:env-bindings + (ensure-environment))))) (start-result (nshell.feature.assistant:assistant-model-start))) (setf *assistant-last-cancel-at* nil) (setf *assistant-explain-candidates* nil @@ -471,8 +480,8 @@ wrapped line's other rows on screen as stale duplicates." (nshell.feature.assistant:append-assistant-audit-entry payload nil :denylist-values - (mapcar #'nshell.domain.environment:env-binding-value - (nshell.domain.environment:env-bindings (ensure-environment)))) + (%assistant-environment-denylist-values + (nshell.domain.environment:env-bindings (ensure-environment)))) (let ((request-result (nshell.feature.assistant:assistant-model-request generation payload))) @@ -661,8 +670,7 @@ wrapped line's other rows on screen as stale duplicates." :denylist-commands nshell.feature.assistant:+assistant-default-denylist-commands+ :denylist-values - (mapcar - #'nshell.domain.environment:env-binding-value + (%assistant-environment-denylist-values (nshell.domain.environment:env-bindings (ensure-environment))))) (setf *command-not-found-command* nil)))) diff --git a/src/presentation/repl.lisp b/src/presentation/repl.lisp index c40f5940..1a889151 100644 --- a/src/presentation/repl.lisp +++ b/src/presentation/repl.lisp @@ -105,6 +105,10 @@ (return-from %process-input-event (%render-prompt-after-terminal-resize))) (multiple-value-bind (new-state output-event) (reduce-input-state *input-state* event) + (when (and (eq *assistant-command-origin* :proposal) + (not (string= (input-state-buffer *input-state*) + (input-state-buffer new-state)))) + (setf *assistant-command-confirmed-p* nil)) (when (and (not (eq output-event :rerun-last-command)) (or *rerun-confirmation-pending-p* *rerun-command-assessment*)) (setf *rerun-confirmation-pending-p* nil diff --git a/t/unit/test-agent-mode.lisp b/t/unit/test-agent-mode.lisp index 743415a7..33cf088c 100644 --- a/t/unit/test-agent-mode.lisp +++ b/t/unit/test-agent-mode.lisp @@ -151,6 +151,41 @@ (nshell.application:agent-step-status step)) (expect nil :to-be nshell.presentation::*agent-session*)))))) + (it "carries-enter-approval-through-command-expansion-and-dispatch" + (dolist (command '("ls" "touch approved-fixture")) + (with-repl-test-state + (let ((session (nshell.application:make-agent-session "run one step" + :max-steps 1)) + (dispatches 0)) + (nshell.application:agent-session-propose-step session command) + (let ((step (nshell.application:agent-session-current-step session))) + (setf nshell.presentation::*agent-session* session + nshell.presentation::*history-persistence-enabled-p* nil) + (with-repl-input-state (:mode :insert :buffer command + :cursor-pos (length command)) + (with-temporary-functions + (('nshell.application::%run-external-command-in-context + (lambda (context name args) + (declare (ignore context)) + (incf dispatches) + (expect (if (string= command "ls") "ls" "touch") + :to-equal name) + (expect (if (string= command "ls") nil '("approved-fixture")) + :to-equal args) + (values "fixture-output" 0))) + ('nshell.presentation::render-prompt-cont (lambda () nil)) + ('nshell.presentation::render-transient-panel + (lambda (content &rest arguments) + (declare (ignore content arguments)) + nil))) + (capture-standard-output + (nshell.presentation::%process-agent-panel-event + (input-key-event :enter)))) + (expect 1 :to-equal dispatches) + (expect 0 :to-equal nshell.presentation::*last-exit-code*) + (expect :executed :to-equal + (nshell.application:agent-step-status step)))))))) + (it "enters-editing-mode-with-e" (with-repl-test-state (let ((session (nshell.application:make-agent-session "list files" diff --git a/t/unit/test-assistant-context.lisp b/t/unit/test-assistant-context.lisp index a0370f39..09fbd1a0 100644 --- a/t/unit/test-assistant-context.lisp +++ b/t/unit/test-assistant-context.lisp @@ -1,5 +1,109 @@ (in-package #:nshell/test) +(describe "assistant-environment-request-contracts" + (it "preserves ordinary settings in the actual request and audit payload" + (cl-weave:expect-assertions 14) + (with-repl-test-state + (repl-test-set-env "NSHELL_AI_MAX_STEPS" "1" t) + (repl-test-set-env "?" "0") + (repl-test-set-env "status" "0") + (repl-test-set-env "UNKNOWN_SECRET" "Q" t) + (add-history-record nshell.presentation::*history* + "echo live-approved-65341" + :exit-code 0 :duration-ms 1) + (setf nshell.presentation::*last-command-output* "result 0 step 1 secret Q") + (with-repl-input-state (:mode :ask-waiting + :buffer "live-approved-65341 Q" + :cursor-pos 21) + (host-kit:with-temporary-directory (audit-directory) + (let* ((audit-path (merge-pathnames "ai-audit.jsonl" audit-directory)) + (start-count 0) + (request-count 0) + (request-generation nil) + (request-payload nil) + (boundary + (nshell.feature.assistant:make-assistant-model-boundary + :start-fn (lambda () (incf start-count) t) + :request-fn (lambda (generation payload) + (incf request-count) + (setf request-generation generation + request-payload payload) + t) + :poll-fn (lambda (generation) + (declare (ignore generation)) + (values nil nil)) + :stop-fn (lambda () t)))) + (setf nshell.feature.assistant:*assistant-boundaries* + (nshell.feature.assistant:make-assistant-boundary-context boundary)) + (let ((nshell.feature.assistant:*assistant-audit-file-path-override* + audit-path)) + (with-temporary-functions + (('nshell.infrastructure.acl:get-git-status + (lambda (directory) + (declare (ignore directory)) + (values "main" nil))) + ('nshell.presentation::render-prompt-cont (lambda () nil)) + ('nshell.presentation::render-assistant-progress-panel + (lambda (started-at) (declare (ignore started-at)) nil))) + (expect (functionp + (nshell.presentation::process-output-event :ask-submit)) + :to-be-truthy) + (expect 1 :to-be start-count) + (expect 1 :to-be request-count) + (expect 1 :to-be request-generation) + (let* ((message (cdr (assoc "message" request-payload :test #'string=))) + (context (cdr (assoc "context" request-payload :test #'string=))) + (names (cdr (assoc "environment-names" context :test #'string=))) + (audit (host-kit:read-file-string audit-path))) + (expect "live-approved-65341 [REDACTED]" :to-equal + (cdr (assoc "content" message :test #'string=))) + (expect "echo live-approved-65341" :to-equal + (cdr (assoc "command" context :test #'string=))) + (expect "result 0 step 1 secret [REDACTED]" :to-equal + (cdr (assoc "last-output" context :test #'string=))) + (dolist (name '("NSHELL_AI_MAX_STEPS" "?" "status" "UNKNOWN_SECRET")) + (expect (member name names :test #'string=) :to-be-truthy)) + (expect (plusp (length audit)) :to-be-truthy) + (expect (search "live-approved-65341" audit) :to-be-truthy) + (expect nil :to-be (search "secret Q" audit)))))))))) + + (it "keeps one-character unknown secrets redacted on the actual send path" + (cl-weave:expect-assertions 3) + (with-repl-test-state + (repl-test-set-env "NSHELL_AI_MAX_STEPS" "1" t) + (repl-test-set-env "UNKNOWN_VALUE" "1" t) + (with-repl-input-state (:mode :ask-waiting + :buffer "live-approved-65341" :cursor-pos 19) + (host-kit:with-temporary-directory (audit-directory) + (let ((request-count 0) + (request-payload nil) + (nshell.feature.assistant:*assistant-audit-file-path-override* + (merge-pathnames "ai-audit.jsonl" audit-directory))) + (setf nshell.feature.assistant:*assistant-boundaries* + (nshell.feature.assistant:make-assistant-boundary-context + (nshell.feature.assistant:make-assistant-model-boundary + :start-fn (lambda () t) + :request-fn (lambda (generation payload) + (declare (ignore generation)) + (incf request-count) + (setf request-payload payload) + t)))) + (with-temporary-functions + (('nshell.infrastructure.acl:get-git-status + (lambda (directory) + (declare (ignore directory)) (values nil nil))) + ('nshell.presentation::render-prompt-cont (lambda () nil)) + ('nshell.presentation::render-assistant-progress-panel + (lambda (started-at) (declare (ignore started-at)) nil))) + (expect (functionp + (nshell.presentation::process-output-event :ask-submit)) + :to-be-truthy) + (expect 1 :to-be request-count) + (expect "live-approved-6534[REDACTED]" :to-equal + (cdr (assoc "content" + (cdr (assoc "message" request-payload :test #'string=)) + :test #'string=)))))))))) + (describe "assistant-context-contracts" (it "assembles only redacted, bounded context values" (let* ((context diff --git a/t/unit/test-assistant-model-boundary.lisp b/t/unit/test-assistant-model-boundary.lisp index f66e3e99..acb0b626 100644 --- a/t/unit/test-assistant-model-boundary.lisp +++ b/t/unit/test-assistant-model-boundary.lisp @@ -1,5 +1,99 @@ (in-package #:nshell/test) +(describe "assistant-sidecar-payload-regressions" + (dolist (phase '(:starting :initialized :ready)) + (let ((phase phase)) + (it (format nil "serializes-the-real-user-payload-in-~A" phase) + (let* ((state (nshell.feature.assistant::%make-assistant-sidecar-state nil nil)) + (channel (cl-concurrent-kit:make-channel :buffer-size 8)) + (pending (unless (eq phase :ready) + (nshell.feature.assistant::%make-assistant-pending-cell + 0 (cl-concurrent-kit:make-channel :buffer-size 8) + (cl-concurrent-kit:make-promise)))) + (payload (nshell.feature.assistant:make-assistant-user-payload + "Propose pwd." + :context (nshell.feature.assistant:make-assistant-context + :command "pwd" :exit 0 :cwd "/fixture" + :environment-names '("PATH")))) + (line nil)) + (setf (nshell.feature.assistant::assistant-sidecar-state-pending state) pending + (nshell.feature.assistant::assistant-sidecar-state-starting-p state) + (eq phase :starting) + (nshell.feature.assistant::assistant-sidecar-state-init-p state) + (not (eq phase :starting)) + (nshell.feature.assistant::assistant-sidecar-state-handle state) :fixture + (nshell.feature.assistant::assistant-sidecar-state-write-channel state) channel) + (with-temporary-functions + (('nshell.feature.assistant::%assistant-sidecar-dead-p + (lambda (current) (declare (ignore current)) nil)) + ('nshell.feature.assistant::%assistant-sidecar-start + (lambda (current) (declare (ignore current)) t)) + ('nshell.feature.assistant::%assistant-sidecar-write-item + (lambda (current item) + (declare (ignore current)) + (setf line (nshell.feature.assistant::assistant-write-item-line item))))) + (expect t :to-be + (nshell.feature.assistant::%assistant-sidecar-request state 41 payload))) + (cond ((eq phase :starting) + (expect nil :to-be line) + (setf line (nshell.feature.assistant::assistant-pending-cell-request-payload + pending))) + ((eq phase :ready) + (multiple-value-bind (item present-p) (cl-concurrent-kit:try-recv channel) + (expect t :to-be present-p) + (setf line (nshell.feature.assistant::assistant-write-item-line item))))) + (let* ((object (json-kit:parse line :object-type :alist :array-type :list)) + (message (cdr (assoc "message" object :test #'string=))) + (context (cdr (assoc "context" object :test #'string=)))) + (expect "user" :to-equal (cdr (assoc "role" message :test #'string=))) + (expect "Propose pwd." :to-equal (cdr (assoc "content" message :test #'string=))) + (expect "/fixture" :to-equal (cdr (assoc "cwd" context :test #'string=))) + (expect '("PATH") :to-equal + (cdr (assoc "environment-names" context :test #'string=))))))))) + +(describe "assistant-sidecar-cancel-regressions" + (it "stops-a-stale-active-request-before-accepting-another" + (let* ((state (nshell.feature.assistant::%make-assistant-sidecar-state nil nil)) + (pending (nshell.feature.assistant::%make-assistant-pending-cell + 1 (cl-concurrent-kit:make-channel :buffer-size 8) + (cl-concurrent-kit:make-promise))) + (stopped nil)) + (setf (nshell.feature.assistant::assistant-sidecar-state-pending state) pending) + (with-temporary-function + ('nshell.feature.assistant::%assistant-sidecar-stop-state + (lambda (current &rest options) + (declare (ignore options)) + (setf stopped t) + (nshell.feature.assistant::%assistant-sidecar-clear-pending current pending))) + (multiple-value-bind (event present-p) + (nshell.feature.assistant::%assistant-sidecar-poll state 2) + (expect nil :to-be event) + (expect nil :to-be present-p))) + (expect t :to-be stopped) + (expect nil :to-be + (nshell.feature.assistant::%assistant-sidecar-current-pending state)))) + (it "does-not-cancel-a-new-request-while-polling-a-retired-request" + (let* ((state (nshell.feature.assistant::%make-assistant-sidecar-state nil nil)) + (current (nshell.feature.assistant::%make-assistant-pending-cell + 2 (cl-concurrent-kit:make-channel :buffer-size 8) + (cl-concurrent-kit:make-promise))) + (retired (nshell.feature.assistant::%make-assistant-pending-cell + 1 (cl-concurrent-kit:make-channel :buffer-size 8) + (cl-concurrent-kit:make-promise)))) + (setf (nshell.feature.assistant::assistant-sidecar-state-pending state) current + (nshell.feature.assistant::assistant-sidecar-state-retired-pending state) + (list retired)) + (cl-concurrent-kit:send + (nshell.feature.assistant::assistant-pending-cell-events retired) + (nshell.feature.assistant:make-assistant-model-error-event 1 "cancelled")) + (multiple-value-bind (event present-p) + (nshell.feature.assistant::%assistant-sidecar-poll state 1) + (expect t :to-be present-p) + (expect :stream-error :to-be + (nshell.feature.assistant:assistant-model-event-kind event))) + (expect current :to-be + (nshell.feature.assistant::%assistant-sidecar-current-pending state))))) + (defun %assistant-stop-sidecar (handle) (funcall (symbol-function 'nshell.infrastructure.acl:stop-sidecar) handle)) @@ -9,20 +103,7 @@ (get-internal-real-time)) (uiop:temporary-directory)))) (with-open-file (stream path :direction :output :if-exists :supersede) - (dolist (line - '("#!/bin/sh" - "if [ \"$1\" = \"--version\" ]; then" - " printf '%s\\n' 'test-version'" - " exit 0" - "fi")) - (write-line line stream)) - (when unsafe-init - (write-line (format nil "printf '%s\\n' '~a'" unsafe-init) stream)) - (dolist (line - '("printf '%s\\n' '{\"type\":\"system\",\"subtype\":\"init\",\"tools\":[\"StructuredOutput\"],\"mcp_servers\":[]}'" - "while IFS= read -r line" - "do")) - (write-line line stream)) + (%assistant-test-write-bootstrap-fixture stream unsafe-init) (when received-path (write-line (format nil " printf '%s\\n' \"$line\" >> '~a'" @@ -38,6 +119,47 @@ (sb-posix:chmod (namestring path) #o700) path)) +(defun %assistant-test-write-bootstrap-fixture (stream &optional unsafe-init) + (dolist (line + '("#!/bin/sh" + "if [ \"$1\" = \"--version\" ]; then" + " printf '%s\\n' 'test-version'" + " exit 0" + "fi" + "request_count=0" + "while IFS= read -r line" + "do" + " case \"$line\" in" + " *'\"request_id\":\"nshell-bootstrap-interrupt\"'*)" + " printf '%s\\n' '{\"type\":\"control_response\",\"response\":{\"subtype\":\"success\",\"request_id\":\"nshell-bootstrap-interrupt\",\"response\":{\"still_queued\":[]}}}'" + " printf '%s\\n' '{\"type\":\"user\",\"message\":{\"role\":\"user\",\"content\":[]}}'" + " printf '%s\\n' '{\"type\":\"result\",\"subtype\":\"error_during_execution\",\"is_error\":true}'" + " continue ;;" + " *'\"content\":\"\"'*)")) + (write-line line stream)) + (when unsafe-init + (write-line (format nil " printf '%s\\n' '~a'" unsafe-init) stream)) + (dolist (line + '(" printf '%s\\n' '{\"type\":\"system\",\"subtype\":\"init\",\"tools\":[\"StructuredOutput\"],\"mcp_servers\":[]}'" + " continue ;;" + " esac")) + (write-line line stream))) + +(defun %assistant-test-rate-sidecar-script () + (let ((path (merge-pathnames + (format nil "nshell-assistant-rate-~D.sh" (get-internal-real-time)) + (uiop:temporary-directory)))) + (with-open-file (stream path :direction :output :if-exists :supersede) + (%assistant-test-write-bootstrap-fixture stream) + (dolist (line + '(" request_count=$((request_count + 1))" + " printf '%s\\n' '{\"type\":\"rate_limit_event\",\"rate_limit_info\":{\"status\":\"allowed\"}}'" + " printf '%s\\n' \"{\\\"type\\\":\\\"result\\\",\\\"subtype\\\":\\\"success\\\",\\\"structured_output\\\":{\\\"command\\\":\\\"pwd\\\",\\\"reason\\\":\\\"request-$request_count\\\",\\\"risk\\\":\\\"low\\\"}}\"" + "done")) + (write-line line stream))) + (sb-posix:chmod (namestring path) #o700) + path)) + (defun %assistant-test-rejecting-sidecar-script () (let ((path (merge-pathnames (format nil "nshell-assistant-rejecting-sidecar-~D.sh" @@ -65,16 +187,9 @@ (get-universal-time)) (uiop:temporary-directory)))) (with-open-file (stream path :direction :output :if-exists :supersede) + (%assistant-test-write-bootstrap-fixture stream) (dolist (line - '("#!/bin/sh" - "if [ \"$1\" = \"--version\" ]; then" - " printf '%s\\n' 'test-version'" - " exit 0" - "fi" - "printf '%s\\n' '{\"type\":\"system\",\"subtype\":\"init\",\"tools\":[\"StructuredOutput\"],\"mcp_servers\":[]}'" - "while IFS= read -r line" - "do" - " while :; do sleep 1; done" + '(" while :; do sleep 1; done" "done")) (write-line line stream))) (sb-posix:chmod (namestring path) #o700) @@ -180,13 +295,18 @@ (nshell.feature.assistant::assistant-sidecar-state-pending state) pending) (expect t :to-be (nshell.feature.assistant::%assistant-sidecar-request - state 41 '(("message" . "init-sequence")))) + state 41 + (nshell.feature.assistant:make-assistant-user-payload "init-sequence"))) ;; Run the gate synchronously, but keep the real process and IO threads. (with-temporary-function ('nshell.feature.assistant::%assistant-sidecar-write-item (lambda (current item) - (push (nshell.feature.assistant::assistant-write-item-line item) - forwarded) + (let* ((line (nshell.feature.assistant::assistant-write-item-line item)) + (object (json-kit:parse line :object-type :alist)) + (message (cdr (assoc "message" object :test #'string=))) + (content (cdr (assoc "content" message :test #'string=)))) + (when (and (stringp content) (plusp (length content))) + (push line forwarded))) (funcall write-item current item))) (with-temporary-function ('nshell.feature.assistant::%assistant-sidecar-install-threads @@ -212,8 +332,10 @@ (nshell.feature.assistant::assistant-sidecar-state-init-p state)) (expect 1 :to-be (length forwarded)) (expect "init-sequence" :to-equal - (cdr (assoc "message" - (json-kit:parse (first forwarded) :object-type :alist) + (cdr (assoc "content" + (cdr (assoc "message" + (json-kit:parse (first forwarded) :object-type :alist) + :test #'string=)) :test #'string=))))) (let ((terminal nil)) (loop repeat 8 @@ -305,7 +427,12 @@ (setf pending (nshell.feature.assistant::%assistant-sidecar-current-pending state)) (expect t :to-be (nshell.feature.assistant::%assistant-sidecar-request - state 41 '(("message" . "async-init-sequence")))) + state 41 + (nshell.feature.assistant:make-assistant-user-payload + "async-init-sequence" + :context (nshell.feature.assistant:make-assistant-context + :command "pwd" :exit 0 :cwd "/fixture" + :environment-names '("PATH"))))) (expect 41 :to-be (nshell.feature.assistant::assistant-pending-cell-generation pending)) (multiple-value-bind (event present-p) @@ -326,10 +453,18 @@ (let ((received (uiop:read-file-lines received-path))) (expect (if unsafe-init 0 1) :to-be (length received)) (unless unsafe-init - (expect "async-init-sequence" :to-equal - (cdr (assoc "message" - (json-kit:parse (first received) :object-type :alist) - :test #'string=))))) + (let* ((object (json-kit:parse (first received) + :object-type :alist :array-type :list)) + (message (cdr (assoc "message" object :test #'string=))) + (context (cdr (assoc "context" object :test #'string=)))) + (expect "user" :to-equal + (cdr (assoc "role" message :test #'string=))) + (expect "async-init-sequence" :to-equal + (cdr (assoc "content" message :test #'string=))) + (expect "/fixture" :to-equal + (cdr (assoc "cwd" context :test #'string=))) + (expect '("PATH") :to-equal + (cdr (assoc "environment-names" context :test #'string=)))))) (let ((terminal nil)) (loop repeat 8 until terminal @@ -642,7 +777,7 @@ (expect pending :to-be (nshell.feature.assistant::assistant-sidecar-state-pending state)) (expect nil :to-be (nshell.feature.assistant::assistant-sidecar-state-dead-p state))))) - (it "rechecks-reader-identity-after-eof-process-wait" + (it "rechecks-reader-identity-after-eof-read" (dolist (changed-part '(:handle :generation)) (let* ((state (nshell.feature.assistant::%make-assistant-sidecar-state nil nil)) (handle (nshell.infrastructure.acl::%make-sidecar-handle @@ -657,15 +792,15 @@ (cl-concurrent-kit:make-promise)))) (setf (nshell.feature.assistant::assistant-sidecar-state-handle state) handle (nshell.feature.assistant::assistant-sidecar-state-pending state) pending) - (sb-ext:without-package-locks - (with-temporary-function - ('sb-ext:process-wait - (lambda (process) - (declare (ignore process)) - (setf (nshell.feature.assistant::assistant-sidecar-state-handle state) active - (nshell.feature.assistant::assistant-sidecar-state-startup-generation state) - generation))) - (nshell.feature.assistant::%assistant-sidecar-reader-loop state handle 0))) + (with-temporary-function + ('nshell.feature.assistant::%assistant-read-json-value + (lambda (stream) + (declare (ignore stream)) + (setf (nshell.feature.assistant::assistant-sidecar-state-handle state) active + (nshell.feature.assistant::assistant-sidecar-state-startup-generation state) + generation) + (values nil :eof nil))) + (nshell.feature.assistant::%assistant-sidecar-reader-loop state handle 0)) (expect active :to-be (nshell.feature.assistant::assistant-sidecar-state-handle state)) (expect generation :to-be (nshell.feature.assistant::assistant-sidecar-state-startup-generation state)) @@ -677,7 +812,7 @@ (cl-concurrent-kit:close-channel (nshell.feature.assistant::assistant-pending-cell-events pending))))) - (it "settles-request-accepted-while-reader-waits-for-eof" + (it "settles-request-accepted-while-reader-reads-eof" (let* ((state (nshell.feature.assistant::%make-assistant-sidecar-state nil nil)) (handle (nshell.infrastructure.acl::%make-sidecar-handle nil nil nil (make-string-input-stream "") nil :stopped)) @@ -685,19 +820,18 @@ (pending nil) (accepted-p nil) (queued-generation nil) - (wait-calls 0)) + (read-calls 0)) (setf (nshell.feature.assistant::assistant-sidecar-state-handle state) handle (nshell.feature.assistant::assistant-sidecar-state-init-p state) t (nshell.feature.assistant::assistant-sidecar-state-write-channel state) writes) (expect nil :to-be (nshell.feature.assistant::assistant-sidecar-state-pending state)) (unwind-protect (progn - (sb-ext:without-package-locks - (with-temporary-function - ('sb-ext:process-wait - (lambda (process) - (declare (ignore process)) - (incf wait-calls) + (with-temporary-function + ('nshell.feature.assistant::%assistant-read-json-value + (lambda (stream) + (declare (ignore stream)) + (incf read-calls) (setf accepted-p (with-temporary-function ('nshell.infrastructure.acl:sidecar-alive-p @@ -711,9 +845,10 @@ (cl-concurrent-kit:try-recv writes) (when present-p (setf queued-generation - (nshell.feature.assistant::assistant-write-item-generation item)))))) - (nshell.feature.assistant::%assistant-sidecar-reader-loop state handle 0))) - (expect 1 :to-be wait-calls) + (nshell.feature.assistant::assistant-write-item-generation item)))) + (values nil :eof nil))) + (nshell.feature.assistant::%assistant-sidecar-reader-loop state handle 0)) + (expect 1 :to-be read-calls) (expect t :to-be accepted-p) (expect 17 :to-be queued-generation) (expect t :to-be @@ -1094,6 +1229,230 @@ (when (probe-file script) (delete-file script)))))) +(defun %assistant-test-await-sidecar-ready (state) + (loop repeat 200 + until (and (nshell.feature.assistant::assistant-sidecar-state-init-p state) + (not (nshell.feature.assistant::assistant-sidecar-state-starting-p state))) + do (sleep 0.01)) + (expect t :to-be (nshell.feature.assistant::assistant-sidecar-state-init-p state)) + (expect nil :to-be (nshell.feature.assistant::assistant-sidecar-state-starting-p state)) + (let ((init-event nil)) + (loop repeat 200 + until init-event + do (multiple-value-bind (event present-p) + (nshell.feature.assistant::%assistant-sidecar-poll state 0) + (when present-p (setf init-event event)) + (unless init-event (sleep 0.01)))) + (expect :system-init :to-be + (nshell.feature.assistant:assistant-model-event-kind init-event)) + (expect 0 :to-be + (nshell.feature.assistant:assistant-model-event-generation init-event)))) + +(defun %assistant-test-await-sidecar-result (state generation &key allowed-rate-p) + (let ((pending (nshell.feature.assistant::%assistant-sidecar-current-pending state)) + (rate-count 0) + (result nil)) + (loop repeat 200 + until result + do (multiple-value-bind (event present-p) + (nshell.feature.assistant::%assistant-sidecar-poll state generation) + (when present-p + (expect generation :to-be + (nshell.feature.assistant:assistant-model-event-generation event)) + (case (nshell.feature.assistant:assistant-model-event-kind event) + (:rate-limit-event + (incf rate-count) + (expect "allowed" :to-equal + (cdr (assoc "status" + (cdr (assoc "rate_limit_info" + (nshell.feature.assistant:assistant-model-event-payload event) + :test #'string=)) + :test #'string=))) + (expect pending :to-be + (nshell.feature.assistant::%assistant-sidecar-current-pending state))) + (:result (setf result event)) + ((:stream-error :stream-ended) + (expect :result :to-be + (nshell.feature.assistant:assistant-model-event-kind event))))) + (unless result (sleep 0.01)))) + (expect (if allowed-rate-p 1 0) :to-be rate-count) + (expect :result :to-be (nshell.feature.assistant:assistant-model-event-kind result)) + (expect "success" :to-equal + (cdr (assoc "subtype" + (nshell.feature.assistant:assistant-model-event-payload result) + :test #'string=))) + (expect nil :to-be (nshell.feature.assistant::%assistant-sidecar-current-pending state)) + result)) + +(describe "assistant-sidecar-lifecycle-regressions" + (it "stops-rejected-turn-before-releasing-pending-and-isolates-late-results" + (let* ((state (nshell.feature.assistant::%make-assistant-sidecar-state nil nil)) + (handle (nshell.infrastructure.acl:spawn-sidecar + "/bin/sleep" '("30") :input :stream :output :stream :error :stream)) + (pending (nshell.feature.assistant::%make-assistant-pending-cell + 91 (cl-concurrent-kit:make-channel :buffer-size 4) + (cl-concurrent-kit:make-promise))) + (rejected (nshell.feature.assistant::make-assistant-model-event + 91 :rate-limit-event + '(("rate_limit_info" . (("status" . "rejected")))))) + (late (nshell.feature.assistant::make-assistant-model-event 91 :result nil)) + (writes (cl-concurrent-kit:make-channel :buffer-size 2))) + (unwind-protect + (progn + (expect t :to-be (nshell.infrastructure.acl:sidecar-alive-p handle)) + (setf (nshell.feature.assistant::assistant-sidecar-state-handle state) handle + (nshell.feature.assistant::assistant-sidecar-state-init-p state) t + (nshell.feature.assistant::assistant-sidecar-state-pending state) pending) + (nshell.feature.assistant::%assistant-sidecar-publish pending rejected) + (nshell.feature.assistant::%assistant-sidecar-publish pending late) + (multiple-value-bind (event present-p) + (nshell.feature.assistant::%assistant-sidecar-poll state 91) + (expect t :to-be present-p) + (expect rejected :to-be event)) + (expect nil :to-be (nshell.infrastructure.acl:sidecar-alive-p handle)) + (expect :stopped :to-be (nshell.infrastructure.acl:sidecar-handle-cleanup-state handle)) + (expect nil :to-be (nshell.feature.assistant::assistant-sidecar-state-handle state)) + (expect nil :to-be (nshell.feature.assistant::assistant-sidecar-state-init-p state)) + (expect nil :to-be (nshell.feature.assistant::assistant-sidecar-state-pending state)) + (expect t :to-be (cl-concurrent-kit:promise-settled-p + (nshell.feature.assistant::assistant-pending-cell-completion pending))) + ;; Install a ready successor without a provider or shell restart. + (setf (nshell.feature.assistant::assistant-sidecar-state-handle state) :successor + (nshell.feature.assistant::assistant-sidecar-state-init-p state) t + (nshell.feature.assistant::assistant-sidecar-state-write-channel state) writes) + (with-temporary-function + ('nshell.infrastructure.acl:sidecar-alive-p + (lambda (candidate) (eq candidate :successor))) + (expect t :to-be (nshell.feature.assistant::%assistant-sidecar-request + state 92 '(("type" . "user") ("message" . "next"))))) + (nshell.feature.assistant::%assistant-sidecar-publish pending late) + (multiple-value-bind (event present-p) + (nshell.feature.assistant::%assistant-sidecar-poll state 92) + (expect nil :to-be event) + (expect nil :to-be present-p)) + (expect 92 :to-be (nshell.feature.assistant::assistant-pending-cell-generation + (nshell.feature.assistant::assistant-sidecar-state-pending state))) + (expect nil :to-be (cl-concurrent-kit:promise-settled-p + (nshell.feature.assistant::assistant-pending-cell-completion + (nshell.feature.assistant::assistant-sidecar-state-pending state))))) + (nshell.infrastructure.acl:stop-sidecar handle) + (setf (nshell.feature.assistant::assistant-sidecar-state-handle state) nil) + (nshell.feature.assistant::%assistant-sidecar-stop-state state) + (cl-concurrent-kit:close-channel writes) + (cl-concurrent-kit:close-channel + (nshell.feature.assistant::assistant-pending-cell-events pending))))) + + (it "keeps-allowed-and-warning-rate-events-pending" + (dolist (status '("allowed" "allowed_warning")) + (let* ((state (nshell.feature.assistant::%make-assistant-sidecar-state nil nil)) + (pending (nshell.feature.assistant::%make-assistant-pending-cell + 91 (cl-concurrent-kit:make-channel :buffer-size 2) + (cl-concurrent-kit:make-promise))) + (event (nshell.feature.assistant::make-assistant-model-event + 91 :rate-limit-event `(("rate_limit_info" . (("status" . ,status))))))) + (unwind-protect + (progn + (setf (nshell.feature.assistant::assistant-sidecar-state-pending state) pending) + (nshell.feature.assistant::%assistant-sidecar-publish pending event) + (multiple-value-bind (polled present-p) + (nshell.feature.assistant::%assistant-sidecar-poll state 91) + (expect t :to-be present-p) + (expect event :to-be polled)) + (expect pending :to-be (nshell.feature.assistant::assistant-sidecar-state-pending state)) + (expect nil :to-be (cl-concurrent-kit:promise-settled-p + (nshell.feature.assistant::assistant-pending-cell-completion pending)))) + (nshell.feature.assistant::%assistant-sidecar-stop-state state))))) + + (it "bounds-eof-cleanup-when-child-closes-stdout-but-keeps-running" + (let* ((state (nshell.feature.assistant::%make-assistant-sidecar-state nil nil)) + (handle (nshell.infrastructure.acl:spawn-sidecar + "/bin/sh" '("-c" "exec 1>&-; exec sleep 30") + :input :stream :output :stream :error :stream)) + (pending (nshell.feature.assistant::%make-assistant-pending-cell + 93 (cl-concurrent-kit:make-channel :buffer-size 2) + (cl-concurrent-kit:make-promise))) + (reader nil)) + (unwind-protect + (progn + (expect t :to-be (nshell.infrastructure.acl:sidecar-alive-p handle)) + (setf (nshell.feature.assistant::assistant-sidecar-state-handle state) handle + (nshell.feature.assistant::assistant-sidecar-state-init-p state) t + (nshell.feature.assistant::assistant-sidecar-state-pending state) pending + reader (sb-thread:make-thread + (lambda () + (nshell.feature.assistant::%assistant-sidecar-reader-loop state handle 0)))) + (sb-thread:join-thread reader :timeout 2 :default :timed-out) + (expect nil :to-be (sb-thread:thread-alive-p reader)) + (expect nil :to-be (nshell.infrastructure.acl:sidecar-alive-p handle)) + (expect t :to-be (nshell.feature.assistant::assistant-sidecar-state-dead-p state)) + (expect :reader-eof :to-be (nshell.feature.assistant::assistant-sidecar-state-dead-reason state)) + (expect nil :to-be (nshell.feature.assistant::assistant-sidecar-state-init-p state)) + (expect nil :to-be (nshell.feature.assistant::assistant-sidecar-state-handle state)) + (expect t :to-be (cl-concurrent-kit:promise-settled-p + (nshell.feature.assistant::assistant-pending-cell-completion pending))) + (multiple-value-bind (event present-p) + (nshell.feature.assistant::%assistant-sidecar-poll state 93) + (expect t :to-be present-p) + (expect :stream-error :to-be (nshell.feature.assistant:assistant-model-event-kind event))) + (expect nil :to-be (nshell.feature.assistant::assistant-sidecar-state-pending state))) + (nshell.infrastructure.acl:stop-sidecar handle) + (when reader + (sb-thread:join-thread reader :timeout 2 :default nil)) + (nshell.feature.assistant::%assistant-sidecar-stop-state state) + (cl-concurrent-kit:close-channel + (nshell.feature.assistant::assistant-pending-cell-events pending))))) + + (it "keeps-the-ready-reader-generation-when-start-is-repeated" + (let* ((script (%assistant-test-sidecar-script)) + (state (nshell.feature.assistant::%make-assistant-sidecar-state + (namestring script) nil))) + (unwind-protect + (progn + (expect t :to-be (nshell.feature.assistant::%assistant-sidecar-start state)) + (%assistant-test-await-sidecar-ready state) + (let ((generation (nshell.feature.assistant::assistant-sidecar-state-startup-generation state)) + (handle (nshell.feature.assistant::assistant-sidecar-state-handle state)) + (reader (nshell.feature.assistant::assistant-sidecar-state-reader-thread state))) + (expect t :to-be (nshell.feature.assistant::%assistant-sidecar-start state)) + (expect generation :to-be + (nshell.feature.assistant::assistant-sidecar-state-startup-generation state)) + (expect handle :to-be (nshell.feature.assistant::assistant-sidecar-state-handle state)) + (expect reader :to-be + (nshell.feature.assistant::assistant-sidecar-state-reader-thread state)) + (expect t :to-be (sb-thread:thread-alive-p reader)) + (expect t :to-be + (nshell.feature.assistant::%assistant-sidecar-request + state 71 (nshell.feature.assistant:make-assistant-user-payload "ready-restart"))) + (%assistant-test-await-sidecar-result state 71))) + (nshell.feature.assistant::%assistant-sidecar-stop-state state) + (when (probe-file script) (delete-file script))))) + + (it "keeps-allowed-rate-events-nonterminal-across-two-requests" + (let* ((script (%assistant-test-rate-sidecar-script)) + (state (nshell.feature.assistant::%make-assistant-sidecar-state + (namestring script) nil))) + (unwind-protect + (progn + (expect t :to-be (nshell.feature.assistant::%assistant-sidecar-start state)) + (%assistant-test-await-sidecar-ready state) + (loop for generation in '(81 82) + for request-number from 1 + do (expect t :to-be + (nshell.feature.assistant::%assistant-sidecar-request + state generation + (nshell.feature.assistant:make-assistant-user-payload + (format nil "request-~D" request-number)))) + (let ((result (%assistant-test-await-sidecar-result + state generation :allowed-rate-p t))) + (expect (format nil "request-~D" request-number) :to-equal + (cdr (assoc "reason" + (cdr (assoc "structured_output" + (nshell.feature.assistant:assistant-model-event-payload result) + :test #'string=)) + :test #'string=)))))) + (nshell.feature.assistant::%assistant-sidecar-stop-state state) + (when (probe-file script) (delete-file script)))))) + (it "does-not-let-poll-consume-the-startup-handshake" (let ((script (%assistant-test-sidecar-script)) (context nil)) diff --git a/t/unit/test-assistant-redaction.lisp b/t/unit/test-assistant-redaction.lisp index 9f628504..3e719561 100644 --- a/t/unit/test-assistant-redaction.lisp +++ b/t/unit/test-assistant-redaction.lisp @@ -1,6 +1,83 @@ (in-package #:nshell/test) +(describe "assistant-environment-denylist-contracts" + (it "excludes only typed settings and unexported internal status" + (cl-weave:expect-assertions 6) + (with-repl-test-state + (repl-test-set-env "NSHELL_AI_MAX_STEPS" "1" t) + (repl-test-set-env "?" "0") + (repl-test-set-env "status" "2") + (multiple-value-bind (names values) + (nshell.presentation::%assistant-export-environment-data) + (dolist (name '("NSHELL_AI_MAX_STEPS" "?" "status")) + (expect (member name names :test #'string=) :to-be-truthy)) + (dolist (value '("1" "0" "2")) + (expect nil :to-be (member value values :test #'string=)))))) + + (it "retains invalid settings and exported status values" + (let ((cases '(("NSHELL_AI_MAX_STEPS" "0" t) + ("NSHELL_AI_MAX_STEPS" "-1" t) + ("NSHELL_AI_MAX_STEPS" "private-value" t) + ("?" "private-value" nil) + ("status" "256" nil) + ("status" "0" t)))) + (cl-weave:expect-assertions (length cases)) + (dolist (case cases) + (with-repl-test-state + (apply #'repl-test-set-env case) + (expect (member (second case) + (nth-value 1 + (nshell.presentation::%assistant-export-environment-data)) + :test #'string=) + :to-be-truthy))))) + + (it "protects unknown one-character secrets including duplicate setting values" + (cl-weave:expect-assertions 6) + (dolist (value '("1" "7" "Q")) + (with-repl-test-state + (repl-test-set-env "NSHELL_AI_MAX_STEPS" "1" t) + (repl-test-set-env "UNKNOWN_VALUE" value t) + (let ((values (nth-value 1 + (nshell.presentation::%assistant-export-environment-data)))) + (expect (member value values :test #'string=) :to-be-truthy) + (expect "prefix:[REDACTED]:suffix" :to-equal + (nshell.feature.assistant:redact-text + (format nil "prefix:~A:suffix" value) + :denylist-values values))))))) + (describe "assistant-redaction-contracts" + (it "P1 denies quoted assigned and option-wrapped command names" + (let ((cases '("\"pass\" show" "'pass' show" "p'a'ss show" "p\\ass show" + "DUMMY=1 pass show" "ONE=1 TWO=2 /usr/bin/pass show" + "sudo -uroot pass show" "sudo -n pass show" + "sudo -Eu root pass show" "sudo --user=root pass show" + "sudo -u root -- pass show" "env -u DUMMY pass show" + "env -uDUMMY pass show" "env DUMMY=1 pass show" + "nice -n 10 pass show" "nice -n10 pass show" + "stdbuf -oL pass show" "command -- 'pass' show" + "echo ok & pass show" "echo ok |& pass show" + "echo $(sudo -n pass show)" "echo $(DUMMY=1 pass show)" + "echo \"$(pass show)\"" "echo <(pass show)" + "echo >(pass show)" "echo $(pass show"))) + (cl-weave:expect-assertions (length cases)) + (dolist (line cases) + (expect "" :to-equal + (nshell.feature.assistant:redact-lines + line :denylist-paths nil :denylist-commands '("pass")))))) + + (it "P1 retains ordinary arguments and wrapper option values" + (let ((cases '("echo pass" "echo 'pass'" "echo 'x | pass show'" + "echo 'x ; pass show'" "DUMMY=1 echo pass" + "sudo -u pass echo ok" "sudo --user=pass echo ok" + "env -u pass echo ok" "env -upass echo ok" + "nice -n 10 echo pass" "stdbuf -oL echo pass" + "DUMMY=pass" "echo '$(pass show)'"))) + (cl-weave:expect-assertions (length cases)) + (dolist (line cases) + (expect line :to-equal + (nshell.feature.assistant:redact-lines + line :denylist-paths nil :denylist-commands '("pass")))))) + (it "removes known token shapes and PEM material" (let* ((pem (format nil "-----BEGIN TEST PRIVATE KEY-----~%secret-key-material~%-----END TEST PRIVATE KEY-----")) (raw (format nil "sk-abcdefghijklmnopqrstuvwxyz ghp_12345678901234567890 Bearer abcdefghijklmnopqrstuvwxyz ~a" diff --git a/t/unit/test-assistant-safety.lisp b/t/unit/test-assistant-safety.lisp index 7d78c405..4081c3f6 100644 --- a/t/unit/test-assistant-safety.lisp +++ b/t/unit/test-assistant-safety.lisp @@ -1,6 +1,38 @@ (in-package #:nshell/test) (describe "assistant-safety-classifier-contracts" + (it "P1 preserves block across redirects wrappers and recursive short options" + (let ((cases '("rm -rf / > out" "rm -fr /" "rm -R /" "rm -fR /" + "rm -ifr /" "rm --recursive /" "rm -fr ." "rm -R ~" + "rm -fr /*" "rm -R $HOME" "\"rm\" -fr /" + "sudo -u root rm -fr / > out" "command rm -R / > out" + "env DUMMY=1 rm -fr / > out" "DUMMY=1 rm -fr / > out" + "sh -c 'rm -fr /' > out" "eval 'rm -fr /' > out" + "rm -rf / $(git push)" "ls > out $(rm -fr /)" + "ls | rm -fr / > out"))) + (cl-weave:expect-assertions (* 2 (length cases))) + (dolist (line cases) + (let ((parsed (nshell.domain.parsing:parse-command-line line))) + (expect (nshell.domain.parsing:parse-complete-p parsed) :to-be-truthy) + (expect :block :to-be + (nshell.feature.assistant:assistant-safety-result-classification + (nshell.feature.assistant:classify-ast + (nshell.domain.parsing:parse-result-ast parsed)))))))) + + (it "P1 keeps safe and confirm controls without treating operands as options" + (let ((cases '(("ls" :safe) ("ls > out" :confirm) ("rm -f /" :confirm) + ("rm -- -rf /" :confirm) ("rm -- --recursive /" :confirm) + ("rm -fr file" :confirm) + ("command ls > out" :confirm) ("echo $(ls)" :safe)))) + (cl-weave:expect-assertions (* 2 (length cases))) + (dolist (case cases) + (let ((parsed (nshell.domain.parsing:parse-command-line (first case)))) + (expect (nshell.domain.parsing:parse-complete-p parsed) :to-be-truthy) + (expect (second case) :to-be + (nshell.feature.assistant:assistant-safety-result-classification + (nshell.feature.assistant:classify-ast + (nshell.domain.parsing:parse-result-ast parsed)))))))) + (it "classifies the required command AST cases" (flet ((command (name &rest args) (nshell.domain.parsing:make-command-node name args)) diff --git a/t/unit/test-repl-ask.lisp b/t/unit/test-repl-ask.lisp index 4b0330aa..4d5c822c 100644 --- a/t/unit/test-repl-ask.lisp +++ b/t/unit/test-repl-ask.lisp @@ -1,5 +1,56 @@ (in-package #:nshell/test) +(describe "repl-proposal-edit-regressions" + (it "invalidates-approval-when-the-command-buffer-changes" + (with-repl-test-state + (with-repl-input-state (:mode :insert :buffer "rm file" :cursor-pos 7) + (let ((nshell.presentation::*assistant-command-origin* :proposal) + (nshell.presentation::*assistant-command-confirmed-p* t)) + (with-temporary-function + ('nshell.presentation::process-output-event + (lambda (event) (declare (ignore event)) nil)) + (nshell.presentation::%process-input-event (input-key-event :char #\x))) + (expect "rm filex" :to-equal + (nshell.presentation:input-state-buffer nshell.presentation::*input-state*)) + (expect nil :to-be nshell.presentation::*assistant-command-confirmed-p*))))) + (it "preserves-approval-when-only-the-cursor-moves" + (with-repl-test-state + (with-repl-input-state (:mode :insert :buffer "rm file" :cursor-pos 7) + (let ((nshell.presentation::*assistant-command-origin* :proposal) + (nshell.presentation::*assistant-command-confirmed-p* t)) + (with-temporary-function + ('nshell.presentation::process-output-event + (lambda (event) (declare (ignore event)) nil)) + (nshell.presentation::%process-input-event (input-key-event :left))) + (expect 6 :to-be + (nshell.presentation:input-state-cursor-pos nshell.presentation::*input-state*)) + (expect t :to-be nshell.presentation::*assistant-command-confirmed-p*)))))) + +(describe "repl-rate-limit-regressions" + (dolist (request-kind '(:ask :explain :agent)) + (dolist (status '("allowed" "allowed_warning")) + (it (format nil "keeps-~A-waiting-after-~A" request-kind status) + (with-repl-test-state + (with-repl-input-state (:mode :ask-waiting :buffer "question" :cursor-pos 8) + (let* ((nshell.presentation::*assistant-request-kind* request-kind) + (handler #'nshell.presentation::%handle-ask-model-event) + (event (nshell.feature.assistant::make-assistant-model-event + 1 :rate-limit-event + `(("rate_limit_info" . (("status" . ,status))))))) + (setf nshell.presentation::*assistant-model-event-handler* handler) + (expect nil :to-be (nshell.presentation::%ask-model-terminal-event-p event)) + (funcall handler event) + (expect :ask-waiting :to-be + (nshell.presentation:input-state-mode nshell.presentation::*input-state*)) + (expect handler :to-be nshell.presentation::*assistant-model-event-handler*) + (expect request-kind :to-be nshell.presentation::*assistant-request-kind*))))))) + (it "treats-rejected-rate-limits-as-terminal" + (expect (nshell.presentation::%ask-model-terminal-event-p + (nshell.feature.assistant::make-assistant-model-event + 1 :rate-limit-event + '(("rate_limit_info" . (("status" . "rejected")))))) + :to-be-truthy))) + (describe "repl-ask-request-tests" (it "starts-the-model-and-sends-the-natural-language-payload" (with-repl-test-state From 9fb365c4f6fd9aaba3ad44ec29e2c5575eeea0df Mon Sep 17 00:00:00 2001 From: takeokunn Date: Mon, 12 Oct 2026 00:50:18 +0900 Subject: [PATCH 2/6] test: enforce nonvacuous dependency and native spawn gates --- .github/workflows/ci.yml | 3 + .github/workflows/release.yml | 3 + scripts/test-dependencies.lisp | 114 +++++++++++++++++--- scripts/test-dependencies.sh | 23 +++- scripts/test-native-spawn.sh | 48 +++++++++ t/scripts/test-dependencies.pl | 66 ++++++++++++ t/scripts/test-dependency-assertions.lisp | 109 +++++++++++++++++++ t/scripts/test-native-spawn.pl | 123 ++++++++++++++++++++++ 8 files changed, 470 insertions(+), 19 deletions(-) create mode 100644 scripts/test-native-spawn.sh create mode 100644 t/scripts/test-dependencies.pl create mode 100644 t/scripts/test-dependency-assertions.lisp create mode 100644 t/scripts/test-native-spawn.pl diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 5b4d9085..b9cc5697 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -95,6 +95,9 @@ jobs: NSHELL_TEST_PTY: "1" run: | nix develop -c bash scripts/test-dependencies.sh + nix develop -c perl t/scripts/test-dependencies.pl + nix develop -c perl t/scripts/test-native-spawn.pl + nix develop -c sbcl --script t/scripts/test-dependency-assertions.lisp nix develop -c sbcl --script scripts/test-history-storage.lisp coverage: diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml index df86380e..be08cee6 100644 --- a/.github/workflows/release.yml +++ b/.github/workflows/release.yml @@ -115,6 +115,9 @@ jobs: NSHELL_TEST_PTY: "1" run: | nix develop -c bash scripts/test-dependencies.sh + nix develop -c perl t/scripts/test-dependencies.pl + nix develop -c perl t/scripts/test-native-spawn.pl + nix develop -c sbcl --script t/scripts/test-dependency-assertions.lisp nix develop -c sbcl --script scripts/test-history-storage.lisp release: diff --git a/scripts/test-dependencies.lisp b/scripts/test-dependencies.lisp index 0df8cb15..212abd1c 100644 --- a/scripts/test-dependencies.lisp +++ b/scripts/test-dependencies.lisp @@ -53,6 +53,77 @@ items) #'string<)) +(defparameter *dependency-history-assertion-paths* + '(("navigation invariants" "one step back then one step forward restores the typed input") + ("navigation invariants" "with WRAP true, walking backward past the oldest match keeps cycling instead of ever returning NIL") + ("navigation invariants" "with WRAP true, alternating HISTORY-PREVIOUS and HISTORY-NEXT keeps cycling in both directions instead of ever returning NIL"))) + +(defun dependency-call-with-history-assertions (system root run) + (unless (string= system "cl-history-kit/test") + (return-from dependency-call-with-history-assertions (funcall run))) + (let ((matches (make-hash-table :test #'equal)) + (counter (find-symbol "*ASSERTION-COUNT*" "CL-WEAVE")) + (setter (find-symbol "TEST-CASE-FUNCTION" "CL-WEAVE")) + (records nil)) + (unless (and counter setter (fboundp (list 'setf setter))) + (error "Required cl-weave assertion instrumentation is unavailable")) + (labels ((visit (node path) + (cond ((dependency-weave "SUITE-P" node) + (dolist (child (dependency-weave "SUITE-CHILDREN" node)) + (visit child (if (eq node root) path + (append path (list (dependency-weave "SUITE-NAME" node))))))) + ((dependency-weave "TEST-CASE-P" node) + (let ((full-path (append path (list (dependency-weave "TEST-CASE-NAME" node))))) + (when (member full-path *dependency-history-assertion-paths* :test #'equal) + (push node (gethash full-path matches))))) + (t (error "Unknown cl-weave registry node: ~S" node))))) + (visit root nil)) + (dolist (path *dependency-history-assertion-paths*) + (let ((tests (gethash path matches))) + (unless (= 1 (length tests)) + (error "Expected exactly one history property at ~S; found ~D" path (length tests))) + (push (list path (first tests) + (dependency-weave "TEST-CASE-FUNCTION" (first tests)) 0 0) + records))) + (setf records (nreverse records)) + (unwind-protect + (progn + (dolist (record records) + (let ((original (third record))) + (funcall (fdefinition (list 'setf setter)) + (lambda () + ;; Count only the property body, not before/after hooks. + ;; A nonmatching trial is valid; the whole property must assert. + (let ((before (symbol-value counter))) + (unless (integerp before) + (error "cl-weave did not bind its assertion counter")) + (incf (fourth record)) + (unwind-protect (funcall original) + (incf (fifth record) (- (symbol-value counter) before))))) + (second record)))) + (multiple-value-prog1 (funcall run) + (dolist (record records) + (format t "~&dependency-assertions system=~S path=~{~S~^ > ~} executed=~D assertions=~D~%" + system (first record) (fourth record) (fifth record))) + (unless (every (lambda (record) + (and (= 1 (fourth record)) (plusp (fifth record)))) + records) + (error "History property body was unexecuted, repeated, or assertion-free")))) + (dolist (record records) + (funcall (fdefinition (list 'setf setter)) (third record) (second record)))))) + +(defun dependency-native-spawn-source () + (dependency-configure-registry) + (let* ((system (asdf:find-system "cl-process-kit")) + (source (asdf:system-source-file system)) + (script (merge-pathnames "t/native-spawn-test.sh" source))) + (unless (and (dependency-store-path-p source) + (string= "3.2.0" (asdf:component-version system)) + (probe-file script) + (dependency-store-path-p (truename script))) + (error "Pinned cl-process-kit 3.2.0 native test source is unavailable")) + (write-line (namestring (truename script))))) + (defun dependency-test-main (system) (let ((entry (assoc system *dependency-test-systems* :test #'string=)) (discovered :unknown) (selected :unknown) (executed 0) (passed 0) @@ -82,22 +153,26 @@ plan)) (error "Empty or incomplete/focused dependency test selection")) ;; Unlike ASDF test-op and run-all, RUN returns actual events. - (let ((events (dependency-weave - "NORMALIZE-RUN-RESULTS" - (dependency-weave "RUN" root :reporter :spec - :name-filter nil :bail nil :retry 0 - :timeout-ms (second entry) - :max-workers 1)))) - (setf executed (length events) - passed (count :pass events - :key (lambda (event) - (dependency-weave "TEST-EVENT-STATUS" event))) - nonpass (- executed passed)) - (unless (and (= discovered selected executed passed) - (equal (dependency-paths plan "TEST-PLAN-ENTRY-PATH") - (dependency-paths events "TEST-EVENT-PATH"))) - (error "Incomplete execution or non-pass events (skip/todo also fail)")) - (setf success t)))) + (dependency-call-with-history-assertions + system root + (lambda () + (let ((events (dependency-weave + "NORMALIZE-RUN-RESULTS" + (dependency-weave "RUN" root :reporter :spec + :name-filter nil :bail nil :retry 0 + :timeout-ms (second entry) + :max-workers 1)))) + (setf executed (length events) + passed (count :pass events + :key (lambda (event) + (dependency-weave "TEST-EVENT-STATUS" event))) + nonpass (- executed passed)) + (unless (and (= discovered selected executed passed) + (equal (dependency-paths plan "TEST-PLAN-ENTRY-PATH") + (dependency-paths events "TEST-EVENT-PATH"))) + (error "Incomplete execution or non-pass events (skip/todo also fail)")) + events))) + (setf success t))) (error (condition) (format *error-output* "~&dependency-error system=~S: ~A~%" system condition))) (format t "~&dependency-result system=~S discovered=~A selected=~A executed=~D pass=~D nonpass=~D status=~A~%" @@ -108,8 +183,13 @@ (let ((arguments (uiop:command-line-arguments))) (cond ((equal arguments '("--list")) (dolist (entry *dependency-test-systems*) (write-line (first entry)))) + ((equal arguments '("--native-spawn-source")) + (handler-case (dependency-native-spawn-source) + (error (condition) + (format *error-output* "Native test source error: ~A~%" condition) + (uiop:quit 1)))) ((= (length arguments) 1) (uiop:quit (dependency-test-main (first arguments)))) (t - (format *error-output* "Usage: sbcl --script scripts/test-dependencies.lisp SYSTEM | --list~%") + (format *error-output* "Usage: sbcl --script scripts/test-dependencies.lisp SYSTEM | --list | --native-spawn-source~%") (uiop:quit 2)))) diff --git a/scripts/test-dependencies.sh b/scripts/test-dependencies.sh index 1b1d5094..81b01d65 100644 --- a/scripts/test-dependencies.sh +++ b/scripts/test-dependencies.sh @@ -7,7 +7,9 @@ dependency_script_dir=$(cd -- "$(dirname -- "${BASH_SOURCE[0]}")" && pwd) dependency_sbcl=${SBCL:-sbcl} if [[ ${1:-} == --list ]]; then - exec "$dependency_sbcl" --noinform --script "$dependency_script_dir/test-dependencies.lisp" "$@" + "$dependency_sbcl" --noinform --script "$dependency_script_dir/test-dependencies.lisp" "$@" + printf '%s\n' cl-process-kit/native-spawn-test + exit 0 fi if (( $# == 0 )); then @@ -19,6 +21,18 @@ if (( $# == 0 )); then fi (( $# > 0 )) || { echo 'No dependency suites selected' >&2; exit 1; } +dependency_needs_native=0 +dependency_has_native=0 +for dependency_system in "$@"; do + case $dependency_system in + cl-process-kit/test|cl-process-kit/pty-test) dependency_needs_native=1 ;; + cl-process-kit/native-spawn-test) dependency_has_native=1 ;; + esac +done +if (( dependency_needs_native && ! dependency_has_native )); then + set -- "$@" cl-process-kit/native-spawn-test +fi + # A private cache avoids both read-only store writes and other sessions' caches. dependency_cache=$(mktemp -d "${TMPDIR:-/tmp}/nshell-dependency-tests.XXXXXXXX") export NSHELL_ASDF_OUTPUT_DIR="$dependency_cache/asdf/" @@ -26,7 +40,12 @@ export NSHELL_ASDF_OUTPUT_DIR="$dependency_cache/asdf/" dependency_failed=0 dependency_passed=0 for dependency_system in "$@"; do - if "$dependency_sbcl" --noinform --script "$dependency_script_dir/test-dependencies.lisp" "$dependency_system"; then + if [[ $dependency_system == cl-process-kit/native-spawn-test ]]; then + dependency_command=("$BASH" "$dependency_script_dir/test-native-spawn.sh") + else + dependency_command=("$dependency_sbcl" --noinform --script "$dependency_script_dir/test-dependencies.lisp" "$dependency_system") + fi + if "${dependency_command[@]}"; then dependency_passed=$((dependency_passed + 1)) else dependency_exit=$? diff --git a/scripts/test-native-spawn.sh b/scripts/test-native-spawn.sh new file mode 100644 index 00000000..0cfca2dd --- /dev/null +++ b/scripts/test-native-spawn.sh @@ -0,0 +1,48 @@ +#!/usr/bin/env bash +set -euo pipefail + +native_script_dir=$(cd -- "$(dirname -- "${BASH_SOURCE[0]}")" && pwd) +native_sbcl=${SBCL:-sbcl} +if [[ ${CL_PROCESS_KIT_SPAWN:-} != /* || ! -f ${CL_PROCESS_KIT_SPAWN:-} || ! -x ${CL_PROCESS_KIT_SPAWN:-} ]]; then + echo 'native-spawn environment error: CL_PROCESS_KIT_SPAWN must name an absolute executable file' >&2 + exit 2 +fi +for native_tool in "$native_sbcl" timeout sha256sum sh touch cat ps perl uname stat wc mkdir mktemp rm; do + if ! command -v "$native_tool" >/dev/null 2>&1; then + printf 'native-spawn environment error: required tool %s is unavailable\n' "$native_tool" >&2 + exit 2 + fi +done +native_source=$("$native_sbcl" --noinform --script "$native_script_dir/test-dependencies.lisp" --native-spawn-source) +if [[ $native_source != /nix/store/*/t/native-spawn-test.sh || ! -f $native_source || ! -s $native_source ]]; then + echo 'native-spawn source error: expected a nonempty pinned Nix store script' >&2 + exit 2 +fi +# cl-process-kit 3.2.0, revision 44fc4281e5f7e97d662180aa15e23349b7ed7a5d. +# Refuse a substituted or empty upstream test rather than accepting its exit alone. +native_digest=$(sha256sum -- "$native_source") +if [[ ${native_digest%% *} != 1cada2f6fbbc6dec58db8ef0e099cfb39c20d1e230d1c27b0d0091cefe112d8a ]]; then + echo 'native-spawn source error: pinned upstream test digest differs' >&2 + exit 2 +fi +native_tmp_parent=${TMPDIR:-/tmp} +if [[ $native_tmp_parent != /* || ! -d $native_tmp_parent ]]; then + echo 'native-spawn environment error: TMPDIR must name an absolute existing directory' >&2 + exit 2 +fi +native_tmp=$(mktemp -d "$native_tmp_parent/nshell-native-spawn.XXXXXXXX") +trap 'rm -rf -- "$native_tmp"' EXIT +trap 'exit 129' HUP +trap 'exit 130' INT +trap 'exit 143' TERM +# Upstream uses a PID-named child directory. Its parent and cwd are exclusive here. +export TMPDIR="$native_tmp" +cd -- "$native_tmp" +printf 'native-spawn-discovery discovered=1 selected=1 upstream-sha256=%s\n' "${native_digest%% *}" +if timeout 30 sh "$native_source" "$CL_PROCESS_KIT_SPAWN"; then + printf 'native-spawn-result executed=1 pass=1 status=PASS\n' +else + native_exit=$? + printf 'native-spawn-result executed=1 pass=0 status=FAIL exit=%s\n' "$native_exit" >&2 + exit "$native_exit" +fi diff --git a/t/scripts/test-dependencies.pl b/t/scripts/test-dependencies.pl new file mode 100644 index 00000000..43d2520f --- /dev/null +++ b/t/scripts/test-dependencies.pl @@ -0,0 +1,66 @@ +use strict; +use warnings; +use Test::More; +use Cwd qw(abs_path); +use File::Temp qw(tempdir); +use FindBin qw($Bin); + +my $repository = abs_path("$Bin/../.."); +my $root = tempdir('nshell-dependency-fixture-XXXXXX', TMPDIR => 1, CLEANUP => 1); +my $sbcl = "$root/sbcl"; +open my $fixture, '>', $sbcl or die $!; +print {$fixture} <<'SH'; +#!/bin/sh +case "$*" in + *--list) printf '%s\n' cl-process-kit/test cl-history-kit/test ;; + *--native-spawn-source) echo 'unexpected resolver call' >&2; exit 99 ;; + *cl-history-kit/signal-fixture-test) + printf '%s\n' 'dependency signal fixture reached' + kill -TERM "$NSHELL_DEPENDENCY_FIXTURE_GATE_PID" ;; +esac +SH +close $fixture or die $!; +chmod 0700, $sbcl or die $!; + +sub run { + my ($script, @arguments) = @_; + my $log = "$root/output"; + my $pid = fork(); + die $! unless defined $pid; + if (!$pid) { + $ENV{SBCL} = $sbcl; + $ENV{TMPDIR} = $root; + $ENV{NSHELL_DEPENDENCY_FIXTURE_GATE_PID} = $$; + delete $ENV{CL_PROCESS_KIT_SPAWN}; + open STDOUT, '>', $log or die $!; + open STDERR, '>&', STDOUT or die $!; + exec '/bin/bash', "$repository/scripts/$script", @arguments; + die $!; + } + waitpid($pid, 0); + my $status = $?; + open my $output, '<', $log or die $!; + local $/; + return (($status & 127) ? 128 + ($status & 127) : $status >> 8, <$output>); +} + +my ($exit, $output) = run('test-dependencies.sh', '--list'); +is($exit, 0, 'list succeeds'); +like($output, qr/^cl-process-kit\/native-spawn-test$/m, 'ordinary list includes upstream shell test'); +($exit, $output) = run('test-dependencies.sh'); +is($exit, 1, 'default gate rejects missing native environment'); +like($output, qr/dependency-suites selected=3 pass=2 failed=1/, 'native contributes to aggregate result'); +like($output, qr/CL_PROCESS_KIT_SPAWN/, 'missing helper is explicit'); +($exit, $output) = run('test-dependencies.sh', 'cl-process-kit/test'); +is($exit, 1, 'explicit process suite also includes native test'); +like($output, qr/dependency-suites selected=2 pass=1 failed=1/, 'explicit process gate cannot omit native'); +($exit, $output) = run('test-dependencies.sh', 'cl-history-kit/test'); +is($exit, 0, 'unrelated narrow suite does not require native environment'); +like($output, qr/dependency-suites selected=1 pass=1 failed=0/, 'narrow selection remains nonempty'); +($exit, $output) = run('test-dependencies.sh', 'cl-history-kit/signal-fixture-test'); +like($output, qr/^dependency signal fixture reached$/m, 'signal fixture executed inside dependency gate'); +is($exit, 143, 'signal-terminated dependency gate cannot pass'); +($exit, $output) = run('test-native-spawn.sh'); +is($exit, 2, 'standalone native gate reports environment error'); +like($output, qr/CL_PROCESS_KIT_SPAWN/, 'standalone missing environment is explicit'); +done_testing(); diff --git a/t/scripts/test-dependency-assertions.lisp b/t/scripts/test-dependency-assertions.lisp new file mode 100644 index 00000000..a89fb9c5 --- /dev/null +++ b/t/scripts/test-dependency-assertions.lisp @@ -0,0 +1,109 @@ +(require :asdf) +(let ((sb-ext:*posix-argv* '("sbcl" "--list")) + (*standard-output* (make-broadcast-stream))) + (load (merge-pathnames "../../scripts/test-dependencies.lisp" *load-truename*))) +(nshell-configure-writable-asdf-output) +(dependency-configure-registry) +(asdf:load-system "cl-weave") + +(defvar *checks* 0) +(defun check (value description) + (incf *checks*) + (unless value (error "Check failed: ~A" description))) + +(defparameter *paths* + '(("navigation invariants" "one step back then one step forward restores the typed input") + ("navigation invariants" "with WRAP true, walking backward past the oldest match keeps cycling instead of ever returning NIL") + ("navigation invariants" "with WRAP true, alternating HISTORY-PREVIOUS and HISTORY-NEXT keeps cycling in both directions instead of ever returning NIL"))) + +(defun fixture (body) + (let* ((tests (mapcar (lambda (path) + (dependency-weave "MAKE-TEST-CASE" :name (second path) :function body)) + *paths*)) + (suite (dependency-weave "MAKE-SUITE" :name "navigation invariants" :children tests)) + (root (dependency-weave "MAKE-SUITE" :name "root" :children (list suite)))) + (funcall (fdefinition (list 'setf (find-symbol "SUITE-PARENT" "CL-WEAVE"))) root suite) + (values root tests))) + +(defun run-fixture (root) + (dependency-weave "NORMALIZE-RUN-RESULTS" + (dependency-weave "RUN" root :reporter :spec :retry 0 :max-workers 1))) + +(defun rejects (thunk message) + (handler-case (progn (funcall thunk) nil) + (error (condition) (not (null (search message (princ-to-string condition))))))) + +(multiple-value-bind (root tests) (fixture (lambda () nil)) + (let ((originals (mapcar (lambda (test) (dependency-weave "TEST-CASE-FUNCTION" test)) tests))) + (check (= 3 (count :pass (run-fixture root) + :key (lambda (event) (dependency-weave "TEST-EVENT-STATUS" event)))) + "baseline accepts three assertion-free cases") + (check (rejects (lambda () + (dependency-call-with-history-assertions + "cl-history-kit/test" root (lambda () (run-fixture root)))) + "History property body") + "limited gate rejects assertion-free properties") + (check (every #'eq originals + (mapcar (lambda (test) (dependency-weave "TEST-CASE-FUNCTION" test)) tests)) + "body functions are restored after rejection"))) + +(multiple-value-bind (root tests) + (fixture (lambda () + ;; Nonmatching trials may legitimately do nothing; aggregate counts must be positive. + (dotimes (trial 100) + (when (zerop trial) (eval '(cl-weave:expect t :to-be-truthy)))))) + (declare (ignore tests)) + (check (= 3 (length (dependency-call-with-history-assertions + "cl-history-kit/test" root (lambda () (run-fixture root))))) + "one assertion and 99 empty trials per property are accepted")) + +(multiple-value-bind (root tests) (fixture (lambda () nil)) + (declare (ignore tests)) + (check (= 3 (length (dependency-call-with-history-assertions + "cl-process-kit/test" root (lambda () (run-fixture root))))) + "other systems remain outside the limited gate") + (check (rejects (lambda () + (dependency-call-with-history-assertions + "cl-history-kit/test" (dependency-weave "MAKE-SUITE" :name "root") + (lambda () nil))) + "Expected exactly one history property") + "missing intended property paths are rejected")) + +(multiple-value-bind (root tests) (fixture (lambda () nil)) + (declare (ignore tests)) + (let ((suite (first (dependency-weave "SUITE-CHILDREN" root)))) + (dolist (accessor '("SUITE-BEFORE-EACH" "SUITE-AFTER-EACH")) + (funcall (fdefinition (list 'setf (find-symbol accessor "CL-WEAVE"))) + (list (lambda () (eval '(cl-weave:expect t :to-be-truthy)))) suite))) + (check (= 3 (count :pass (run-fixture root) + :key (lambda (event) (dependency-weave "TEST-EVENT-STATUS" event)))) + "hooks execute assertions successfully in the baseline") + (check (rejects (lambda () + (dependency-call-with-history-assertions + "cl-history-kit/test" root (lambda () (run-fixture root)))) + "History property body") + "hook assertions cannot conceal an assertion-free property body")) + +(multiple-value-bind (root tests) + (fixture (lambda () (eval '(cl-weave:expect t :to-be-truthy)))) + (declare (ignore tests)) + (check (rejects (lambda () + (dependency-call-with-history-assertions + "cl-history-kit/test" root (lambda () nil))) + "History property body") + "selected but unexecuted properties are rejected") + (check (rejects (lambda () + (dependency-call-with-history-assertions + "cl-history-kit/test" root + (lambda () (run-fixture root) (run-fixture root)))) + "History property body") + "repeated execution does not satisfy the exactly-once gate")) + +(multiple-value-bind (root tests) + (fixture (lambda () (eval '(cl-weave:expect nil :to-be-truthy)))) + (declare (ignore tests)) + (check (= 3 (count :fail (dependency-call-with-history-assertions + "cl-history-kit/test" root (lambda () (run-fixture root))) + :key (lambda (event) (dependency-weave "TEST-EVENT-STATUS" event)))) + "counting failing assertions preserves their failed events")) +(format t "~&dependency-assertion-checks=~D status=PASS~%" *checks*) diff --git a/t/scripts/test-native-spawn.pl b/t/scripts/test-native-spawn.pl new file mode 100644 index 00000000..6f0926f2 --- /dev/null +++ b/t/scripts/test-native-spawn.pl @@ -0,0 +1,123 @@ +use strict; +use warnings; +use Test::More; +use Cwd qw(abs_path); +use Config; +use File::Temp qw(tempdir); +use FindBin qw($Bin); + +my $repository = abs_path("$Bin/../.."); +my $helper = $ENV{CL_PROCESS_KIT_SPAWN} // ''; +die "CL_PROCESS_KIT_SPAWN must name the real absolute executable helper\n" + unless $helper =~ m{^/} && -f $helper && -x $helper; +my $root = abs_path(tempdir('nshell-native-fixture-XXXXXX', TMPDIR => 1, CLEANUP => 1)); +my $observations = "$root/observations"; +my $instrumented = "$root/helper"; +my $perl = abs_path($Config{perlpath}); +die "Perl must provide an absolute executable interpreter path\n" + unless defined $perl && $perl =~ m{^/} && -f $perl && -x $perl; +open my $fixture, '>', $instrumented or die $!; +# $^X can be a bare name after PATH-based invocation, which is not a valid shebang. +print {$fixture} '#!', $perl, "\n", <<'PL'; +use strict; +use warnings; +use Cwd qw(getcwd); +use Fcntl qw(:flock); +open my $log, '>>', $ENV{NATIVE_OBSERVATIONS} or die $!; +flock $log, LOCK_EX or die $!; +print {$log} join("\t", $ENV{TMPDIR}, getcwd()), "\n"; +close $log or die $!; +exec $ENV{NATIVE_REAL_HELPER}, @ARGV; +die $!; +PL +close $fixture or die $!; +chmod 0700, $instrumented or die $!; +open my $sentinel, '>', "$root/sentinel" or die $!; +print {$sentinel} "preserve\n"; +close $sentinel or die $!; + +sub start { + my ($name, $spawn, $tmpdir, $environment) = @_; + my $log = "$root/$name.log"; + my $pid = fork(); + die $! unless defined $pid; + if (!$pid) { + $ENV{CL_PROCESS_KIT_SPAWN} = $spawn; + $ENV{TMPDIR} = $tmpdir; + $ENV{NATIVE_REAL_HELPER} = $helper; + $ENV{NATIVE_OBSERVATIONS} = $observations; + @ENV{keys %$environment} = values %$environment if $environment; + open STDOUT, '>', $log or die $!; + open STDERR, '>&', STDOUT or die $!; + exec '/bin/bash', "$repository/scripts/test-native-spawn.sh"; + die $!; + } + return [$pid, $log]; +} + +sub finish { + my ($job) = @_; + waitpid($job->[0], 0); + my $status = $?; + open my $log, '<', $job->[1] or die $!; + local $/; + return (($status & 127) ? 128 + ($status & 127) : $status >> 8, <$log>); +} + +my @jobs = (start('first', $instrumented, $root), start('second', $instrumented, $root)); +for my $job (@jobs) { + my ($exit, $output) = finish($job); + is($exit, 0, 'real pinned upstream test succeeds concurrently'); + like($output, qr/native-spawn-discovery discovered=1 selected=1 upstream-sha256=[a-f0-9]{64}/, + 'one nonempty locked upstream script selected'); + like($output, qr/native-spawn-result executed=1 pass=1 status=PASS/, + 'actual upstream execution passes'); +} +open my $log, '<', $observations or die $!; +my %calls; +my $isolated = 1; +while (my $line = <$log>) { + chomp $line; + my ($tmpdir, $cwd) = split /\t/, $line; + $isolated &&= $tmpdir eq $cwd && index($tmpdir, "$root/nshell-native-spawn.") == 0; + $calls{$tmpdir}++; +} +close $log or die $!; +is(scalar keys %calls, 2, 'concurrent invocations use distinct private tmp parents'); +ok($isolated, 'upstream helper uses the exclusive parent as both TMPDIR and cwd'); +is_deeply([sort values %calls], [9, 9], 'each real upstream test executes all nine helper scenarios'); +ok(!(grep { -e $_ } keys %calls), 'both private parents are removed after success'); +ok(-f "$root/sentinel", 'unrelated parent content is preserved'); + +my $failing = "$root/failing-helper"; +open $fixture, '>', $failing or die $!; +print {$fixture} "#!/bin/sh\nexit 7\n"; +close $fixture or die $!; +chmod 0700, $failing or die $!; +my ($exit, $output) = finish(start('failure', $failing, $root)); +is($exit, 7, 'upstream failure status propagates without conversion to success'); +like($output, qr/native-spawn-result executed=1 pass=0 status=FAIL exit=7/, + 'failed upstream execution is explicit'); +my @remaining = glob "$root/nshell-native-spawn.*"; +is(scalar @remaining, 0, 'private parent is also removed after failure'); +($exit, $output) = finish(start('relative-tmp', $instrumented, '.')); +is($exit, 2, 'relative TMPDIR is rejected before unsafe isolation'); +like($output, qr/TMPDIR must name an absolute existing directory/, 'invalid tmp environment is explicit'); + +my $empty = "$root/empty-helper"; +open $fixture, '>', $empty or die $!; +print {$fixture} "#!/bin/sh\nexit 0\n"; +close $fixture or die $!; +chmod 0700, $empty or die $!; +($exit, $output) = finish(start('empty-helper', $empty, $root)); +is($exit, 1, 'an executable no-op helper cannot pass the upstream assertions'); +like($output, qr/native-spawn-result executed=1 pass=0 status=FAIL exit=1/, + 'empty helper produces a failed result rather than a vacuous pass'); + +mkdir "$root/bin" or die $!; +symlink '/usr/bin/dirname', "$root/bin/dirname" or die $!; +($exit, $output) = finish(start('missing-timeout', $instrumented, $root, + {SBCL => '/usr/bin/true', PATH => "$root/bin"})); +is($exit, 2, 'missing timeout fails the preflight'); +like($output, qr/required tool timeout is unavailable/, 'missing timeout is explicitly identified'); +done_testing(); From ed65ed9f0e29547865e4159bfdb36d926d268d9d Mon Sep 17 00:00:00 2001 From: takeokunn Date: Mon, 12 Oct 2026 00:50:30 +0900 Subject: [PATCH 3/6] docs: document verified assistant behavior for v0.6.5 --- README.md | 4 +- docs/src/guide/concepts.md | 43 ++++++++------------- docs/src/guide/customization.md | 15 +++---- docs/src/index.md | 58 +++++++++++++--------------- docs/src/project/contributing.md | 29 +++++++++----- docs/src/project/public-readiness.md | 45 +++++++++++++++++---- docs/src/project/roadmap.md | 19 ++++----- docs/src/reference/builtins.md | 2 +- man/nshell.1 | 2 +- nshell.asd | 8 ++-- 10 files changed, 128 insertions(+), 97 deletions(-) diff --git a/README.md b/README.md index d17c1f70..5bba2a41 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.4 +nix run github:nerima-lisp/nshell/v0.6.5 ``` 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.4 +nix profile install github:nerima-lisp/nshell/v0.6.5 ``` Pin a release tag rather than following the default branch. diff --git a/docs/src/guide/concepts.md b/docs/src/guide/concepts.md index ada1de43..529dd09a 100644 --- a/docs/src/guide/concepts.md +++ b/docs/src/guide/concepts.md @@ -2,30 +2,24 @@ ## The input state is a value -Every keystroke runs a pure reducer over an immutable `input-state` value, and -what appears on screen is derived from that value. Nothing about the current -line lives in a terminal buffer or a mutable global. +The reducer returns a new `input-state` value. The REPL stores the current +value in `*input-state*` and derives rendering from it. -This is the single decision most of nshell's interactive behaviour follows -from. Because a keystroke is a function from state to state, the line editor -can be tested exhaustively without a terminal: a test feeds a key sequence and -asserts on the resulting buffer, cursor, kill ring, or undo stack. Multi-level -undo is a stack of prior values rather than a replay log, and rendering can be -recomputed from scratch whenever it is cheaper than diffing. +Reducer tests feed key sequences and assert on the resulting buffer, cursor, +kill ring, or undo stack without a terminal. PTY tests check terminal +integration separately. Multi-level undo stores prior values rather than a +replay log, and rendering can be recomputed from the current state. -The REPL that drives the reducer is a continuation-passing trampoline loop, -which keeps the interactive core deterministic and unit-testable. +The REPL drives the reducer through a continuation-passing trampoline loop. ## Color is a theme, not a pile of escape codes -Every colored thing nshell draws (the prompt, the command line as you type, the -completion menu) reads its style from one theme: a mapping from a named role to -a fish-style style spec such as `5fafff --bold` or `gray --italics`. Nothing in -the rendering code carries a hardcoded escape sequence, so switching the whole -shell to another palette is one `theme use` away, and a role you dislike is one -`theme set` away. Colors are written once in truecolor and downsampled at the -terminal boundary, so the same theme renders on a 256-color or 16-color -terminal and disappears entirely under `NO_COLOR`. See +The prompt, command line, and completion menu read styles from a shared theme: +a mapping from a named role to a fish-style spec such as `5fafff --bold` or +`gray --italics`. `theme use` selects a palette; `theme set` changes a role. +Theme roles control colors and text styles. Cursor movement and other terminal +controls use separate escape sequences. Colors are downsampled for 256-color +or 16-color terminals; a nonempty `NO_COLOR` disables color output. See [Customization](customization.md). ## Highlighting answers a question before you press Enter @@ -72,10 +66,9 @@ remain literal. ## Abbreviations expand in place -An abbreviation registered with `abbr` expands inline as you type, so what ends -up in history is the expanded command. This differs from an alias, which stays -unexpanded and hides what actually ran. Abbreviations keep muscle memory short -while leaving history honest and greppable. +An abbreviation registered with `abbr` expands inline as you type, so history +records the expanded command. An alias is resolved during execution; history +retains the entered alias name. ## External editing preserves the prompt state @@ -124,6 +117,4 @@ instead. `set -l` forces a new local variable even when an outer one of the same name exists; `set -g` always reaches past every local scope to the outermost one. Reading a name walks the scope chain from innermost outward, so a local variable shadows a global of the same name for the rest of that -call. This is fish's scoping model, and nshell's environment stores it as an -ordered list of scopes rather than a single table, so shadowing and cleanup -fall out of list structure instead of a bookkeeping pass. +call. The environment stores scopes as an ordered list. diff --git a/docs/src/guide/customization.md b/docs/src/guide/customization.md index c7281ad6..5c719f29 100644 --- a/docs/src/guide/customization.md +++ b/docs/src/guide/customization.md @@ -3,9 +3,9 @@ nshell colors the prompt, syntax highlighting, and completion menu from a single **theme**: a mapping from named roles (`command`, `prompt-path`, `completion-file`, and so on) to a style. The `theme` builtin lets you switch -between built-in presets or override individual roles, and `~/.nshellrc` runs -plain nshell commands at startup, so a `theme` line there applies on every -launch. +between built-in presets or override individual roles. `~/.nshellrc` runs +plain nshell commands at interactive startup. `--no-config` skips the file, +and `--config PATH` selects another file. Batch and script runs do not load it. ## East Asian ambiguous character width @@ -138,7 +138,7 @@ run of spaces is dropped too, so `{path} {git} {status}` never leaves a double space outside a repository. nshell has two prompts: the left one, and a right prompt that floats at the -far edge of the terminal. They default to exactly today's layout: +far edge of the terminal. The default formats are: ``` {path} {git} {status} @@ -212,7 +212,7 @@ An unknown key name or action name exits with status 2 and lists the valid names; `bind` with anything else prints a usage line and exits 1. A key name is spelled the way it is typed, in lowercase and hyphen-separated (`ctrl-r`, `alt-e`, `right`, `shift-tab`). Put `bind` lines in `~/.nshellrc` to apply -custom bindings on every launch, the same way `theme` lines do. +custom bindings at interactive startup, the same way `theme` lines do. ### Capturing the previous command's output @@ -239,8 +239,9 @@ when vi mode is off or the terminal is not interactive. ## In `~/.nshellrc` `.nshellrc` is not a separate configuration format: it is a file of plain -nshell commands, sourced once at startup before the first prompt. Put a -`theme` command there to start every session with your preset: +nshell commands, sourced once at interactive startup before the first prompt +unless `--no-config` or `--config PATH` changes this behavior. Put a `theme` +command there to select your preset: ```sh theme use tokyo-night diff --git a/docs/src/index.md b/docs/src/index.md index 50d19014..ab880b67 100644 --- a/docs/src/index.md +++ b/docs/src/index.md @@ -1,64 +1,60 @@ # nshell -A modern, fish-inspired interactive shell written in Common Lisp. +A fish-inspired interactive shell written in Common Lisp. -nshell is an interactive shell that puts the *interactive* experience first: -real-time syntax highlighting, history-aware autosuggestions, fish-style -abbreviations, and a fast, context-aware completion engine — all built on a -clean, test-driven Common Lisp core and a reproducible Nix build. +nshell provides real-time syntax highlighting, history-aware autosuggestions, +fish-style abbreviations, and context-aware completion. It is built with Nix. !!! note "Status: development preview (0.6.x)" - The interactive editor and core pipeline execution are solid and heavily - tested. The shell *language* is a growing subset of POSIX/fish semantics — - see the [roadmap](project/roadmap.md) for what is and isn't supported yet. - nshell is usable as a daily interactive shell for common workflows; it is - not a script-compatible `/bin/sh` replacement. + The shell implements a tested subset of shell syntax, not full POSIX/fish + compatibility. For supported features and known limits, + see the [roadmap](project/roadmap.md). + It is not a script-compatible `/bin/sh` replacement. ## Highlights -- **Syntax highlighting** as you type — a command that would fail with +- **Syntax highlighting** as you type: a command that would fail with `command not found` is red before you run it, existing paths are underlined, and strings, variables, keywords, and operators each get their own color. - **Autosuggestions** from your history, fish-style, accepted with `→` / `Ctrl-F`. -- **Abbreviations** (`abbr`) that expand inline as you type — keep your muscle - memory, type less. -- **Context-aware completion** — a knowledge base of commands and flags plus +- **Abbreviations** (`abbr`) expand inline as you type. +- **Context-aware completion**: a knowledge base of commands and flags plus filesystem completion, git branches, environment variables, and directory-only completion for `cd`, in a colored candidate menu with common-prefix `Tab` extension. -- **Rich line editing** — Emacs keybindings, kill-ring and yank, multi-level +- **Line editing**: Emacs keybindings, kill-ring and yank, multi-level undo/redo, multiline editing, and a `Ctrl-R` history picker that lists matches under the prompt. -- **Vi key bindings** (optional, `NSHELL_VI_MODE=1`) — normal-mode motions, +- **Vi key bindings** (optional, `NSHELL_VI_MODE=1`): normal-mode motions, counts, operators (`dd`, `cw`, …), visual selection, and insert/append. -- **Themes** — one named palette drives the prompt, the highlighter, and the +- **Themes**: one named palette drives the prompt, the highlighter, and the completion menu; ten presets ship with the shell, `theme use` switches live, and colors downsample to 256- or 16-color terminals. -- **A prompt that reports** — working directory, git branch and dirty marker, +- **Prompt status**: working directory, git branch and dirty marker, a prompt character that turns red after a failure, and, on the right, the failing exit code plus the duration of anything slower than a second. -- **Job control** — background jobs (`&`), `jobs`, `fg`, `bg`, `disown`. -- **Pipelines and redirection** — `|`, `>`, `>>`, `<`, `<<`, `<<<`, logical +- **Job control**: background jobs (`&`), `jobs`, `fg`, `bg`, `disown`. +- **Pipelines and redirection**: `|`, `>`, `>>`, `<`, `<<`, `<<<`, logical `&&` / `||`, and command sequencing. -- **Control flow and functions** — `if`, `for`, `while`, `switch`, +- **Control flow and functions**: `if`, `for`, `while`, `switch`, `begin`/`end`, and user-defined `function`s. -- **History expansion** — `!!`, `!$`, `!-N`, `!?text?`, and `!prefix`, with - quoted and backslash-escaped exclamation marks kept literal. -- **External editing** — `Alt-E` opens the current line with the configured +- **History expansion**: `!!`, `!$`, `!-N`, `!?text?`, and `!prefix`, with + single-quoted and backslash-escaped exclamation marks kept literal. +- **External editing**: `Alt-E` opens the current line with the configured editor and returns the edited buffer to the prompt. -- **Reproducible build** — a dumped SBCL image and its process-launch helper via Nix; - `nix run` and you're in. +- **Nix build**: a dumped SBCL image and its process-launch helper; + start the shell with `nix run`. ## Where to go next -- [Getting started](getting-started.md) — install nshell and run your first +- [Getting started](getting-started.md): install nshell and run your first command. -- [Core concepts](guide/concepts.md) — how the interactive layer is put +- [Core concepts](guide/concepts.md): how the interactive layer is put together. -- [Recipes](guide/recipes.md) — scripting, pipeline diagrams, and the test +- [Recipes](guide/recipes.md): scripting, pipeline diagrams, and the test workflow. -- [Built-in commands](reference/builtins.md) — the shell's own command set. -- [Architecture](reference/architecture.md) — the layered design and the +- [Built-in commands](reference/builtins.md): the shell's own command set. +- [Architecture](reference/architecture.md): the layered design and the toolkit family it builds on. diff --git a/docs/src/project/contributing.md b/docs/src/project/contributing.md index ac3ec91d..d1c996e9 100644 --- a/docs/src/project/contributing.md +++ b/docs/src/project/contributing.md @@ -1,7 +1,7 @@ # Contributing to nshell -The process — branching, pull requests, commit conventions, and the org-wide -rules a review checks — lives in the +Branching, pull requests, commit conventions, and org-wide review rules are +documented in the [nerima-lisp contributing guide](https://github.com/nerima-lisp/.github/blob/main/CONTRIBUTING.md). This page covers only what is specific to nshell. @@ -14,10 +14,11 @@ review will actually push back on: - **`domain/` performs no I/O.** Whether it lives under `src/` or a feature package, new parsing, expansion, completion, or history logic belongs here and must be unit-testable without a terminal. -- **`infrastructure/` isolates all OS- and SBCL-specific code** — syscalls, PTY, - signals, terminal handling, persistence. Guard implementation-specific code - with `#+sbcl` where relevant. -- **`application/` holds use cases** — builtins, pipeline execution, job +- **`infrastructure/` holds OS adapters**: syscalls, PTYs, signals, terminal + handling, and persistence. The runtime targets SBCL; application and + presentation code also use SBCL facilities. Guard implementation-specific + code with `#+sbcl` where relevant. +- **`application/` holds use cases**: builtins, pipeline execution, job management. - **`presentation/` is the REPL, line editor, and rendering.** @@ -43,12 +44,22 @@ Iterate with the smallest relevant suite, then run the full gate before review. | Change | Run | |---|---| -| Anything | `perl -e '$SIG{ALRM}=sub { exit 124 }; alarm 1800; exec @ARGV' nix flake check --print-build-logs` before review; the full gate runs on `x86_64-linux` CI | +| Anything | `perl -e '$SIG{ALRM}=sub { exit 124 }; alarm 1800; exec @ARGV' nix flake check --print-build-logs` before review; CI runs on `x86_64-linux` | | Domain logic, builtins, parser, expansion | `perl -e '$SIG{ALRM}=sub { exit 124 }; alarm 300; exec @ARGV' nix run .#test` | | Completion engine or cl-prolog-kit knowledge base | `perl -e '$SIG{ALRM}=sub { exit 124 }; alarm 300; exec @ARGV' sbcl --script scripts/weave.lisp` | | PTY, subprocess, terminal, signal, job control | the non-sandboxed run below | | Coverage-oriented validation | `perl -e '$SIG{ALRM}=sub { exit 124 }; alarm 900; exec @ARGV' nix develop -c sbcl --script scripts/coverage.lisp` | +The full CI gate also runs these checks separately from `nix flake check`: + +```sh +nix develop -c bash scripts/test-dependencies.sh +nix develop -c perl t/scripts/test-dependencies.pl +nix develop -c perl t/scripts/test-native-spawn.pl +nix develop -c sbcl --script t/scripts/test-dependency-assertions.lisp +nix develop -c sbcl --script scripts/test-history-storage.lisp +``` + The non-sandboxed integration run, for changes the Nix sandbox cannot exercise: ```sh @@ -56,8 +67,8 @@ perl -e '$SIG{ALRM}=sub { exit 124 }; alarm 300; exec @ARGV' nix develop -c sbcl ``` Tests live in `t/` and must be hermetic: no dependence on the ambient working -directory, terminal size, or environment. Use the provided fixtures — for -example `with-stable-repl-prompt` and `with-fixed-terminal-size` — for +directory, terminal size, or environment. Use the provided fixtures, such as +`with-stable-repl-prompt` and `with-fixed-terminal-size`, for rendering tests. For parser, expansion, execution, or builtin changes, include focused unit diff --git a/docs/src/project/public-readiness.md b/docs/src/project/public-readiness.md index df8e59c8..73fbc7a7 100644 --- a/docs/src/project/public-readiness.md +++ b/docs/src/project/public-readiness.md @@ -2,13 +2,38 @@ ## Positioning -nshell targets daily interactive use first. v0.6.2 is a development preview, +nshell targets interactive use. The 0.6 series is a development preview, not a POSIX/fish-compatible script interpreter. -## Capability Matrix +## Current release evidence -The evidence and statuses below describe the published `v0.6.2` tree, not -unreleased changes on the default branch. +The published [v0.6.4 release](https://github.com/nerima-lisp/nshell/releases/tag/v0.6.4) +contains the `x86_64-linux` bundle and SHA-256 checksum. The +[main CI run](https://github.com/nerima-lisp/nshell/actions/runs/38136077742) +and [v0.6.4 release run](https://github.com/nerima-lisp/nshell/actions/runs/38136113875) +completed with success for commit `5969f455312025356905a0f8e2e104da317a0d6a`. +These workflow results do not establish production readiness, complete +dependency assertion coverage, or successful live AI provider requests. + +## Local verification for v0.6.5 + +The macOS arm64 source-loaded suite passed with PTY cases enabled and no +skipped cases. The pinned dependency suites and private history storage +regressions also passed. The dependency gate rejects zero-assertion runs of +three selected history properties and tests the pinned process library's +native spawn helper separately from its Lisp suite. + +A locally built executable was tested in a real PTY with Claude Code 2.1.295. +The probe checked that a proposed `touch` command did not run before approval, +Enter executed it once, cancellation left no file, a subsequent request could +execute a fresh proposal, and exit reaped the provider processes. These are +bounded checks with one provider on one platform, not an exhaustive provider +or terminal compatibility claim. They are not part of the linked CI runs. + +## Historical capability matrix (v0.6.2) + +The evidence and statuses below describe the published `v0.6.2` tree. They are +historical evidence, not results from the v0.6.4 workflows above. | Area | Capability or policy | Published evidence | Status | | --- | --- | --- | --- | @@ -29,7 +54,7 @@ sandbox. ## Release Gates These are the existing nshell gates, not a production-readiness verdict. -The linked v0.6.2 release run includes dependency-suite and extracted-artifact +The historical v0.6.2 release run includes dependency-suite and extracted-artifact checks, including the extracted executable's real-PTY gate. Before a public release can claim the capabilities listed here: @@ -40,7 +65,8 @@ Before a public release can claim the capabilities listed here: signal, and job-control coverage on the sole CI matrix target, `x86_64-linux`, without skipping those cases. 3. The pinned dependency suites execute directly, with nonempty discovery, - matching selected/executed counts, and no skipped cases. The private history + matching selected/executed counts, and no skipped cases. Suite-level pass + counts alone do not establish assertion coverage. The private history storage regressions pass. 4. An `x86_64-linux` release archive passes checksum verification before extraction. The extracted bundle passes required-file, dependency-closure, @@ -61,7 +87,7 @@ A maintainer reviews the assets and release notes before publishing the draft. Run these checks from the checkout being verified. To reproduce the historical release evidence above, use the `v0.6.2` tag. The flake declares only `x86_64-linux`. On another host, the Nix -checks require an `x86_64-linux` builder. Running the dev shell or PTY suite +checks require an `x86_64-linux` builder. Running these Nix-based commands also requires an `x86_64-linux` execution environment; a remote builder alone does not supply that runtime coverage. @@ -102,6 +128,11 @@ does not supply that runtime coverage. ## Known Limits and Future Work +- Live AI provider requests are not verified by the linked CI runs. The local + v0.6.5 probe above covers explicit approval, cancellation, and subsequent + requests with one provider; other providers and failure modes remain unverified. +- Do not infer complete dependency assertion coverage from suite-level pass + counts; the audit gates require separate assertion-level evidence. - Broader help-text-driven command discovery remains future work, especially for subcommand coverage and non-curated external tools. - Mouse selection and clipboard behavior depend on the terminal. No exhaustive diff --git a/docs/src/project/roadmap.md b/docs/src/project/roadmap.md index dc39ef15..ac24489e 100644 --- a/docs/src/project/roadmap.md +++ b/docs/src/project/roadmap.md @@ -22,17 +22,18 @@ help-text enrichment to additional commands and subcommands. See the **Distribution:** evaluate nixpkgs and Homebrew packaging. Neither channel is published; a packaging target has not been selected. A prebuilt `x86_64-linux` bundle is available in the -[v0.6.2 release](https://github.com/nerima-lisp/nshell/releases/tag/v0.6.2). +[v0.6.4 release](https://github.com/nerima-lisp/nshell/releases/tag/v0.6.4). See the [installation instructions](../getting-started.md#prebuilt-linux-bundle) for the current distribution. ## Release evidence -The [v0.6.2 Linux CI run](https://github.com/nerima-lisp/nshell/actions/runs/38120933504) -and [release workflow](https://github.com/nerima-lisp/nshell/actions/runs/38120952046) -validate the tagged tree. The published -[v0.6.2 release](https://github.com/nerima-lisp/nshell/releases/tag/v0.6.2) -contains the x86_64-linux bundle and SHA-256 checksum. The non-sandboxed -integration suite covers foreground external commands and pipelines with -`Ctrl-Z` suspension, `bg` resumption, `fg` terminal handoff, and `Ctrl-C` -interruption. +The [main Linux CI run](https://github.com/nerima-lisp/nshell/actions/runs/38136077742) +and [v0.6.4 release run](https://github.com/nerima-lisp/nshell/actions/runs/38136113875) +completed with success for commit `5969f455312025356905a0f8e2e104da317a0d6a`. +The published [v0.6.4 release](https://github.com/nerima-lisp/nshell/releases/tag/v0.6.4) +contains the `x86_64-linux` bundle and SHA-256 checksum. Workflow success does +not establish complete dependency assertion coverage, live AI provider +behavior, or production readiness. The historical +[v0.6.2 capability matrix](public-readiness.md#historical-capability-matrix-v062) +is separate from these current workflow results. diff --git a/docs/src/reference/builtins.md b/docs/src/reference/builtins.md index 6e864a98..d36a0679 100644 --- a/docs/src/reference/builtins.md +++ b/docs/src/reference/builtins.md @@ -26,7 +26,7 @@ proposed commands require confirmation before execution. **`pipeline-graph`** renders a typed pipeline as a Graphviz DOT graph, or a Mermaid flowchart with `--mermaid`, without executing it. Quote the pipeline so -the shell passes it as one argument — see +the shell passes it as one argument; see [Recipes](../guide/recipes.md#draw-a-pipeline-without-running-it). **`bind`** lists, sets, erases, or resets key bindings: `bind` alone lists diff --git a/man/nshell.1 b/man/nshell.1 index 448459c2..5792c9e3 100644 --- a/man/nshell.1 +++ b/man/nshell.1 @@ -1,4 +1,4 @@ -.TH NSHELL 1 "2026-09-30" "nshell 0.6.4" "User Commands" +.TH NSHELL 1 "2026-09-30" "nshell 0.6.5" "User Commands" .SH NAME nshell \- a fish-inspired interactive shell written in Common Lisp .SH SYNOPSIS diff --git a/nshell.asd b/nshell.asd index da68fe95..5740ef4d 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.4" + :version "0.6.5" :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.4" + :version "0.6.5" :author "takeokunn " :maintainer "takeokunn " :license "MIT" @@ -590,7 +590,7 @@ (error "cl-weave tests failed")))) (asdf:defsystem "nshell/weave" - :version "0.6.4" + :version "0.6.5" :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.4" + :version "0.6.5" :author "takeokunn " :maintainer "takeokunn " :license "MIT" From 218e1c4d58efcc9f34a7bfdf2aff465b69740902 Mon Sep 17 00:00:00 2001 From: takeokunn Date: Mon, 12 Oct 2026 01:07:10 +0900 Subject: [PATCH 4/6] test: resolve the sidecar fixture through the sandbox PATH --- t/unit/test-assistant-model-boundary.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/unit/test-assistant-model-boundary.lisp b/t/unit/test-assistant-model-boundary.lisp index acb0b626..ac5b16e2 100644 --- a/t/unit/test-assistant-model-boundary.lisp +++ b/t/unit/test-assistant-model-boundary.lisp @@ -1288,7 +1288,7 @@ (it "stops-rejected-turn-before-releasing-pending-and-isolates-late-results" (let* ((state (nshell.feature.assistant::%make-assistant-sidecar-state nil nil)) (handle (nshell.infrastructure.acl:spawn-sidecar - "/bin/sleep" '("30") :input :stream :output :stream :error :stream)) + "sleep" '("30") :input :stream :output :stream :error :stream)) (pending (nshell.feature.assistant::%make-assistant-pending-cell 91 (cl-concurrent-kit:make-channel :buffer-size 4) (cl-concurrent-kit:make-promise))) From 53a2484563fa8a097b2cc46f9479ccaa559ada2e Mon Sep 17 00:00:00 2001 From: takeokunn Date: Mon, 12 Oct 2026 02:09:26 +0900 Subject: [PATCH 5/6] fix: invalidate cached process stops after foreground resume --- src/application/manage-job.lisp | 2 +- src/infrastructure/acl/syscall-process.lisp | 11 ++- t/unit/test-manage-job.lisp | 83 +++++++++++++++++++++ 3 files changed, 94 insertions(+), 2 deletions(-) diff --git a/src/application/manage-job.lisp b/src/application/manage-job.lisp index 9af5fddb..bd78853c 100644 --- a/src/application/manage-job.lisp +++ b/src/application/manage-job.lisp @@ -72,7 +72,7 @@ (%set-acl-foreground-pgid pgid) (%with-terminal-foreground-pgroup pgid (dolist (process processes) - (sb-ext:process-kill process sb-unix:sigcont :pid)) + (nshell.infrastructure.acl:process-continue process)) (if (eq :stopped (%wait-terminal-processes processes)) (let* ((monitor (shell-context-job-monitor context)) (id (nshell.domain.job-control:monitor-add-background-job diff --git a/src/infrastructure/acl/syscall-process.lisp b/src/infrastructure/acl/syscall-process.lisp index bf2d201e..ce2f51a8 100644 --- a/src/infrastructure/acl/syscall-process.lisp +++ b/src/infrastructure/acl/syscall-process.lisp @@ -27,7 +27,16 @@ (defun process-continue (process) (if (pty-process-p process) (pty-process-continue process) - (sb-ext:process-kill process sb-unix:sigcont :pid))) + ;; SBCL 2.6 does not invalidate a cached stop when sending SIGCONT. + ;; Use its waitpid lock so a later stop or exit cannot be overwritten. + (sb-sys:without-interrupts + (sb-thread:with-mutex (sb-impl::*active-processes-lock*) + (multiple-value-bind (sent errno) + (sb-ext:process-kill process sb-unix:sigcont :pid) + (when (and sent (eq :stopped (sb-impl::process-%status process))) + (setf (sb-impl::process-%status process) :running + (sb-impl::process-%exit-code process) nil)) + (values sent errno)))))) (defun process-alive-p (process) (if (pty-process-p process) diff --git a/t/unit/test-manage-job.lisp b/t/unit/test-manage-job.lisp index 0f431de9..3b45d81e 100644 --- a/t/unit/test-manage-job.lisp +++ b/t/unit/test-manage-job.lisp @@ -1,6 +1,89 @@ (in-package #:nshell/test) +(defmacro with-stopped-resume-process ((process &optional (script "kill -STOP $$; exit 7")) &body body) + `(let ((,process (sb-ext:run-program "/bin/sh" + (list "-c" ,script) + :wait nil :output nil :error nil))) + (unwind-protect + (progn + (sb-ext:process-wait ,process t) + (expect :stopped :to-be (sb-ext:process-status ,process)) + (sb-ext:without-package-locks ,@body)) + (when (member (sb-ext:process-status ,process) '(:running :stopped)) + (sb-ext:process-kill ,process sb-unix:sigkill :pid)) + (sb-ext:process-wait ,process) + (sb-ext:process-close ,process)))) + (describe "manage-job-service-tests" + (it "process-resume-does-not-treat-cached-stop-as-a-new-stop" + (with-stopped-resume-process (process) + (with-temporary-function + ('sb-ext:process-kill + (lambda (observed signal &optional target) + (expect process :to-be observed) + (expect sb-unix:sigcont :to-equal signal) + (expect :pid :to-be target) + t)) + (expect (nshell.infrastructure.acl:process-continue process) :to-be-truthy) + (expect :running :to-be (nshell.infrastructure.acl:process-status process)) + (expect (sb-ext:process-exit-code process) :to-be-null)))) + + (it "process-resume-observes-a-new-stop-and-preserves-the-status-hook" + (with-stopped-resume-process (process "kill -STOP $$; kill -STOP $$; exit 7") + (let* ((notifications 0) + (previous-hook (lambda (observed) + (expect process :to-be observed) + (incf notifications)))) + (setf (sb-ext:process-status-hook process) previous-hook) + (expect (nshell.infrastructure.acl:process-continue process) :to-be-truthy) + (sb-ext:process-wait process t) + (expect :stopped :to-be (nshell.infrastructure.acl:process-status process)) + (expect previous-hook :to-be (sb-ext:process-status-hook process)) + (expect (plusp notifications) :to-be-truthy) + (expect (nshell.infrastructure.acl:process-continue process) :to-be-truthy) + (sb-ext:process-wait process) + (expect :exited :to-be (nshell.infrastructure.acl:process-status process)) + (expect 7 :to-equal (nshell.infrastructure.acl:process-exit-status-code process))))) + + (it "process-resume-preserves-running-and-terminal-states" + (dolist (next-state '(:running :exited :signaled)) + (with-stopped-resume-process (process) + (let ((notifications 0)) + (let ((previous-hook (lambda (observed) + (expect process :to-be observed) + (incf notifications)))) + (setf (sb-ext:process-status-hook process) previous-hook) + (sb-sys:without-interrupts + (sb-thread:with-mutex (sb-impl::*active-processes-lock*) + (setf (sb-impl::process-%status process) next-state))) + (with-temporary-function + ('sb-ext:process-kill + (lambda (&rest args) (declare (ignore args)) t)) + (expect (nshell.infrastructure.acl:process-continue process) :to-be-truthy) + (expect next-state :to-be (nshell.infrastructure.acl:process-status process)) + (expect previous-hook :to-be (sb-ext:process-status-hook process)) + (expect 0 :to-equal notifications)) + (sb-sys:without-interrupts + (sb-thread:with-mutex (sb-impl::*active-processes-lock*) + (setf (sb-impl::process-%status process) :stopped)))))))) + + (it "process-resume-preserves-failed-signal-status-and-hook" + (with-stopped-resume-process (process) + (let ((previous-hook (lambda (observed) + (expect process :to-be observed)))) + (setf (sb-ext:process-status-hook process) previous-hook) + (with-temporary-function + ('sb-ext:process-kill + (lambda (&rest args) + (declare (ignore args)) + (values nil sb-posix:esrch))) + (multiple-value-bind (sent errno) + (nshell.infrastructure.acl:process-continue process) + (expect sent :to-be-falsy) + (expect sb-posix:esrch :to-equal errno)) + (expect :stopped :to-be (nshell.infrastructure.acl:process-status process)) + (expect previous-hook :to-be (sb-ext:process-status-hook process)))))) + (it "registered-foreground-job-keeps-processes-across-stop-and-resume" (let* ((registry (make-hash-table)) (monitor (nshell.domain.job-control:make-job-monitor)) From 2cac7cd8e348d4867c9ce1196635c0b355dc97e6 Mon Sep 17 00:00:00 2001 From: takeokunn Date: Mon, 12 Oct 2026 02:23:59 +0900 Subject: [PATCH 6/6] fix: avoid SBCL wake-pipe races during process waits --- .../execute-pipeline-stage-external-wait.lisp | 2 +- .../acl/syscall-pipeline-wait.lisp | 4 +- src/infrastructure/acl/syscall-pipeline.lisp | 4 +- .../acl/syscall-process-execution.lisp | 2 +- src/infrastructure/acl/syscall-process.lisp | 17 +++- t/unit/test-execute-pipeline.lisp | 2 +- t/unit/test-manage-job.lisp | 98 +++++++++++++++++-- 7 files changed, 111 insertions(+), 18 deletions(-) diff --git a/src/application/execute-pipeline-stage-external-wait.lisp b/src/application/execute-pipeline-stage-external-wait.lisp index 77a7672a..72d58b80 100644 --- a/src/application/execute-pipeline-stage-external-wait.lisp +++ b/src/application/execute-pipeline-stage-external-wait.lisp @@ -37,4 +37,4 @@ (when (and process (sb-ext:process-alive-p process) (not (eq (sb-ext:process-status process) :stopped))) - (ignore-errors (sb-ext:process-wait process))))))) + (ignore-errors (nshell.infrastructure.acl:process-wait process))))))) diff --git a/src/infrastructure/acl/syscall-pipeline-wait.lisp b/src/infrastructure/acl/syscall-pipeline-wait.lisp index 32d4482e..09fa6c8c 100644 --- a/src/infrastructure/acl/syscall-pipeline-wait.lisp +++ b/src/infrastructure/acl/syscall-pipeline-wait.lisp @@ -9,7 +9,7 @@ (defun %wait-pipeline-processes (procs &optional (pipefail-p nil)) (let ((statuses nil)) (dolist (proc procs) - (sb-ext:process-wait proc) + (%wait-sbcl-process proc) (push (process-exit-status-code proc) statuses)) (values (%pipeline-exit-status statuses pipefail-p) statuses))) @@ -37,7 +37,7 @@ (%wait-pipeline-exit-with-timeout procs 0.5) (terminate sb-unix:sigkill) (dolist (proc procs) - (ignore-errors (sb-ext:process-wait proc))))))) + (ignore-errors (%wait-sbcl-process proc))))))) (defun %wait-pipeline-exit-with-timeout (procs timeout-seconds) (let ((deadline (+ (get-internal-real-time) diff --git a/src/infrastructure/acl/syscall-pipeline.lisp b/src/infrastructure/acl/syscall-pipeline.lisp index d625a50b..0b16aa78 100644 --- a/src/infrastructure/acl/syscall-pipeline.lisp +++ b/src/infrastructure/acl/syscall-pipeline.lisp @@ -59,7 +59,7 @@ (when (read-byte error-stream nil nil) (error "Pipeline helper failed before exec")) ;; The leader must stay alive until every stage has joined it. - (sb-ext:process-wait proc t) + (%wait-sbcl-process proc t) (unless (and (eq :stopped (sb-ext:process-status proc)) (= (or pgid (sb-ext:process-pid proc)) (sb-posix:getpgid (sb-ext:process-pid proc)))) @@ -69,7 +69,7 @@ (unless complete (when proc (ignore-errors (sb-ext:process-kill proc sb-unix:sigkill)) - (ignore-errors (sb-ext:process-wait proc)) + (ignore-errors (%wait-sbcl-process proc)) (ignore-errors (sb-ext:process-close proc)))) (when error-stream (close error-stream)) (when read-fd (sb-posix:close read-fd)) diff --git a/src/infrastructure/acl/syscall-process-execution.lisp b/src/infrastructure/acl/syscall-process-execution.lisp index 0185fb4e..d04cc29a 100644 --- a/src/infrastructure/acl/syscall-process-execution.lisp +++ b/src/infrastructure/acl/syscall-process-execution.lisp @@ -43,7 +43,7 @@ normal foreground timeout policy." (if (or (null timeout) (%wait-process-exit-with-timeout proc timeout)) (progn - (sb-ext:process-wait proc) + (%wait-sbcl-process proc) (process-exit-status-code proc)) (progn (%terminate-process proc) diff --git a/src/infrastructure/acl/syscall-process.lisp b/src/infrastructure/acl/syscall-process.lisp index ce2f51a8..91ea4e31 100644 --- a/src/infrastructure/acl/syscall-process.lisp +++ b/src/infrastructure/acl/syscall-process.lisp @@ -19,10 +19,21 @@ (pty-process-status process) (sb-ext:process-status process))) +(defun %wait-sbcl-process (process &optional check-for-stopped) + ;; SBCL's wake pipe can close an already closed FD on successive CONT/STOP + ;; notifications. Serve stream copiers without installing that wake pipe. + (loop for state = (sb-ext:process-status process) + while (or (eq state :running) + (and (eq state :stopped) (not check-for-stopped))) + do (sb-sys:serve-all-events 0.01) + finally (return (if (eq state :stopped) + process + (sb-ext:process-wait process))))) + (defun process-wait (process) (if (pty-process-p process) (pty-process-wait process) - (sb-ext:process-wait process))) + (%wait-sbcl-process process))) (defun process-continue (process) (if (pty-process-p process) @@ -111,13 +122,13 @@ (%with-process-output-copiers (copiers) (if (or (null timeout-seconds) (%wait-process-exit-with-timeout proc timeout-seconds)) - (progn (sb-ext:process-wait proc) success-fn) + (progn (%wait-sbcl-process proc) success-fn) (progn (%terminate-process proc) timeout-fn))))) (defun %wait-process-with-copiers-or-stop (proc copiers success-fn stop-fn) "Wait for PROC while allowing a stopped process to be continued." (loop - (sb-ext:process-wait proc t) + (%wait-sbcl-process proc t) (if (eq (sb-ext:process-status proc) :stopped) (let ((decision (funcall stop-fn))) (unless (eq decision :continue-wait) (return decision)) diff --git a/t/unit/test-execute-pipeline.lisp b/t/unit/test-execute-pipeline.lisp index 1e0946ac..d482730c 100644 --- a/t/unit/test-execute-pipeline.lisp +++ b/t/unit/test-execute-pipeline.lisp @@ -36,7 +36,7 @@ (terminated nil)) (sb-ext:without-package-locks (with-temporary-functions - (('sb-ext:process-wait + (('nshell.infrastructure.acl::%wait-sbcl-process (lambda (&rest arguments) (declare (ignore arguments)) (incf waits))) diff --git a/t/unit/test-manage-job.lisp b/t/unit/test-manage-job.lisp index 3b45d81e..299e44d7 100644 --- a/t/unit/test-manage-job.lisp +++ b/t/unit/test-manage-job.lisp @@ -1,20 +1,99 @@ (in-package #:nshell/test) -(defmacro with-stopped-resume-process ((process &optional (script "kill -STOP $$; exit 7")) &body body) +(defmacro with-stopped-resume-process ((process &optional (script "kill -STOP $$; exit 7") output) &body body) `(let ((,process (sb-ext:run-program "/bin/sh" (list "-c" ,script) - :wait nil :output nil :error nil))) + :wait nil :output ,output :error nil))) (unwind-protect (progn - (sb-ext:process-wait ,process t) + (nshell.infrastructure.acl::%wait-sbcl-process ,process t) (expect :stopped :to-be (sb-ext:process-status ,process)) (sb-ext:without-package-locks ,@body)) (when (member (sb-ext:process-status ,process) '(:running :stopped)) (sb-ext:process-kill ,process sb-unix:sigkill :pid)) - (sb-ext:process-wait ,process) + (nshell.infrastructure.acl:process-wait ,process) (sb-ext:process-close ,process)))) (describe "manage-job-service-tests" + (it "process-resume-wait-serves-events-before-terminal-output-drain" + (let ((states '(:running :stopped :running :exited)) + (served 0) + (drained 0)) + (sb-ext:without-package-locks + (with-temporary-functions + (('sb-ext:process-status + (lambda (process) + (expect :process :to-be process) + (first states))) + ('sb-sys:serve-all-events + (lambda (timeout) + (expect 0.01 :to-equal timeout) + (pop states) + (incf served))) + ('sb-ext:process-wait + (lambda (process &optional stopped-p) + (expect :process :to-be process) + (expect stopped-p :to-be-falsy) + (expect :exited :to-be (first states)) + (incf drained) + process))) + (expect :process :to-be (nshell.infrastructure.acl:process-wait :process)) + (expect 3 :to-equal served) + (expect 1 :to-equal drained))))) + + (it "process-resume-wait-returns-a-new-stop-without-terminal-drain" + (let ((state :running) + (served 0)) + (sb-ext:without-package-locks + (with-temporary-functions + (('sb-ext:process-status + (lambda (process) + (expect :process :to-be process) + state)) + ('sb-sys:serve-all-events + (lambda (timeout) + (expect 0.01 :to-equal timeout) + (expect 0 :to-equal served) + (incf served) + (setf state :stopped))) + ('sb-ext:process-wait + (lambda (&rest arguments) + (declare (ignore arguments)) + (error "A stopped process must not install a wake pipe")))) + (expect :process :to-be + (nshell.infrastructure.acl::%wait-sbcl-process :process t)) + (expect 1 :to-equal served))))) + + (it "process-resume-external-pipeline-cleanup-uses-safe-wait" + (let ((waits 0) + (failure (make-condition 'simple-error))) + (sb-ext:without-package-locks + (with-temporary-functions + (('nshell.application::%start-external-process-copiers + (lambda (&rest arguments) (declare (ignore arguments)) nil)) + ('nshell.infrastructure.acl::%foreground-external-command-timeout + (lambda () nil)) + ('nshell.infrastructure.acl::%wait-process-with-copiers-or-stop + (lambda (&rest arguments) + (declare (ignore arguments)) + (error failure))) + ('sb-ext:process-alive-p + (lambda (process) (expect :process :to-be process) t)) + ('sb-ext:process-status + (lambda (process) (expect :process :to-be process) :running)) + ('nshell.infrastructure.acl:process-wait + (lambda (process) (expect :process :to-be process) (incf waits))) + ('sb-ext:process-wait + (lambda (&rest arguments) + (declare (ignore arguments)) + (error "Unsafe wait during pipeline cleanup")))) + (expect failure :to-be + (handler-case + (nshell.application::%finish-external-pipeline-process + :process nil nil nil "command" nil) + (simple-error (condition) condition))) + (expect 1 :to-equal waits))))) + (it "process-resume-does-not-treat-cached-stop-as-a-new-stop" (with-stopped-resume-process (process) (with-temporary-function @@ -29,21 +108,24 @@ (expect (sb-ext:process-exit-code process) :to-be-null)))) (it "process-resume-observes-a-new-stop-and-preserves-the-status-hook" - (with-stopped-resume-process (process "kill -STOP $$; kill -STOP $$; exit 7") + (let ((output (make-string-output-stream))) + (with-stopped-resume-process + (process "printf before; kill -STOP $$; printf middle; kill -STOP $$; printf after; exit 7" output) (let* ((notifications 0) (previous-hook (lambda (observed) (expect process :to-be observed) (incf notifications)))) (setf (sb-ext:process-status-hook process) previous-hook) (expect (nshell.infrastructure.acl:process-continue process) :to-be-truthy) - (sb-ext:process-wait process t) + (nshell.infrastructure.acl::%wait-sbcl-process process t) (expect :stopped :to-be (nshell.infrastructure.acl:process-status process)) (expect previous-hook :to-be (sb-ext:process-status-hook process)) (expect (plusp notifications) :to-be-truthy) (expect (nshell.infrastructure.acl:process-continue process) :to-be-truthy) - (sb-ext:process-wait process) + (nshell.infrastructure.acl:process-wait process) (expect :exited :to-be (nshell.infrastructure.acl:process-status process)) - (expect 7 :to-equal (nshell.infrastructure.acl:process-exit-status-code process))))) + (expect 7 :to-equal (nshell.infrastructure.acl:process-exit-status-code process)) + (expect "beforemiddleafter" :to-equal (get-output-stream-string output)))))) (it "process-resume-preserves-running-and-terminal-states" (dolist (next-state '(:running :exited :signaled))