diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 5e482004..5b4d9085 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -85,6 +85,18 @@ jobs: NSHELL_TEST_PTY: "1" run: nix develop -c sbcl --script run-tests.lisp + - name: Verify dependency suites and private history storage + env: + HOME: ${{ runner.temp }}/nshell-dependency-home + XDG_CACHE_HOME: ${{ runner.temp }}/nshell-dependency-cache + XDG_CONFIG_HOME: ${{ runner.temp }}/nshell-dependency-config + XDG_STATE_HOME: ${{ runner.temp }}/nshell-dependency-state + NSHELL_AI_COMMAND: /nonexistent + NSHELL_TEST_PTY: "1" + run: | + nix develop -c bash scripts/test-dependencies.sh + nix develop -c sbcl --script scripts/test-history-storage.lisp + coverage: # Keep coverage separate from the integration gate: the report instrumented # run is slower and writes generated files, while integration remains the @@ -155,5 +167,18 @@ jobs: - name: Build release bundle run: nix build .#releaseBundle --print-build-logs + - name: Verify release PTY harness regressions + run: perl t/scripts/test-release-pty.pl + - name: Verify release bundle run: perl scripts/verify-release-bundle.pl result + + - name: Verify extracted release bundle with a real PTY + run: | + set -euo pipefail + archive="$RUNNER_TEMP/nshell-ci.tar.gz" + tar -czf "$archive" -C result . + extracted="$(mktemp -d "$RUNNER_TEMP/nshell-ci.XXXXXX")" + tar -xzf "$archive" -C "$extracted" + perl scripts/verify-release-bundle.pl "$extracted" + perl scripts/test-release-pty.pl "$extracted" diff --git a/.github/workflows/release.yml b/.github/workflows/release.yml index 2be6720c..df86380e 100644 --- a/.github/workflows/release.yml +++ b/.github/workflows/release.yml @@ -105,6 +105,18 @@ jobs: NSHELL_TEST_PTY: "1" run: nix develop -c sbcl --script run-tests.lisp + - name: Verify dependency suites and private history storage + env: + HOME: ${{ runner.temp }}/nshell-dependency-home + XDG_CACHE_HOME: ${{ runner.temp }}/nshell-dependency-cache + XDG_CONFIG_HOME: ${{ runner.temp }}/nshell-dependency-config + XDG_STATE_HOME: ${{ runner.temp }}/nshell-dependency-state + NSHELL_AI_COMMAND: /nonexistent + NSHELL_TEST_PTY: "1" + run: | + nix develop -c bash scripts/test-dependencies.sh + nix develop -c sbcl --script scripts/test-history-storage.lisp + release: name: build and publish x86_64-linux needs: [verify, integration] @@ -155,6 +167,16 @@ jobs: rm "dist/${name}.repro.tar.gz" ( cd dist && shasum -a 256 "${name}.tar.gz" > "${name}.tar.gz.sha256" ) + - name: Verify the packaged archive + run: | + set -euo pipefail + name="nshell-${RELEASE_REF}-x86_64-linux" + ( cd dist && shasum -a 256 -c "${name}.tar.gz.sha256" ) + extracted="$(mktemp -d "$RUNNER_TEMP/nshell-release.XXXXXX")" + tar -xzf "dist/${name}.tar.gz" -C "$extracted" + perl scripts/verify-release-bundle.pl "$extracted/$name" + perl scripts/test-release-pty.pl "$extracted/$name" + # Publish only after the maintainer supplies user-facing release notes. - name: Create draft release uses: softprops/action-gh-release@3bb12739c298aeb8a4eeaf626c5b8d85266b0e65 # v2.6.2 diff --git a/README.md b/README.md index 323cdd7d..848117f0 100644 --- a/README.md +++ b/README.md @@ -20,10 +20,10 @@ 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.1 +nix run github:nerima-lisp/nshell/v0.6.2 ``` -Then type as you would in any shell. Commands and paths colorize live, and a +At the prompt, enter `string upper hello`. Commands and paths colorize live, and a dimmed completion of the most recent matching history entry trails the cursor; press `→` or `Ctrl-F` to accept it: @@ -43,20 +43,28 @@ Interactive history expansion supports `!!`, `!$`, `!-N`, `!?text?`, and `!prefix`; exclamation marks inside single quotes or preceded by a backslash remain literal. Press `Alt-E` to edit the current command in the editor named by `NSHELL_EDITOR`, `VISUAL`, or `EDITOR` (falling back to `vi`), then return -the edited line to nshell. +the edited line to nshell. Save and quit the editor, then press Enter in nshell +to execute it. See [History expansion](docs/src/guide/concepts.md#history-expansion-is-explicit) +for the expansion forms. + +History is stored in `~/.nshell_history` with owner-only permissions. Symlinks, +hard links, and files owned by another user are rejected. A malformed tail is +reported without discarding existing bytes; further appends are refused until +the file is moved aside. `--no-history` disables persistence. ## Install ```sh -nix profile install github:nerima-lisp/nshell/v0.6.1 +nix profile install github:nerima-lisp/nshell/v0.6.2 ``` Pin a release tag rather than following the default branch. -The `x86_64-linux` release bundle removes Nix store references, carries its +To install without Nix, use the `x86_64-linux` release bundle. It removes Nix store references, carries its ELF runtime library closure, and is checked for required files and dependency -metadata. CI also runs `--help`, `--version`, and an `echo` smoke test on the -bundle. See [Getting +metadata. CI checks an extracted archive and exercises its executable with a +real PTY, including editing, signals, job control, history restart, and terminal +restoration. See [Getting started](https://nerima-lisp.github.io/nshell/getting-started/) for the bundle verification and installation procedure. @@ -71,19 +79,27 @@ verification and installation procedure. ```sh nix develop # SBCL with CL_SOURCE_REGISTRY already set (x86_64-linux) -perl -e '$SIG{ALRM}=sub { exit 124 }; alarm 300; exec @ARGV' nix build .#checks.$(nix eval --raw --impure --expr 'builtins.currentSystem').default --no-link # run the test suite -perl -e '$SIG{ALRM}=sub { exit 124 }; alarm 300; exec @ARGV' nix flake check # full hermetic gate on x86_64-linux CI +perl -e 'alarm 300; exec @ARGV' nix build .#checks.$(nix eval --raw --impure --expr 'builtins.currentSystem').default --no-link # run the test suite +perl -e 'alarm 300; exec @ARGV' nix flake check # time-limited local hermetic check nix fmt # format Nix sources (treefmt) nix build # produces ./result/bin/nshell nix build .#releaseBundle perl scripts/verify-release-bundle.pl result +perl scripts/test-release-pty.pl result ``` -The Perl wrappers limit each local check to five minutes and return exit code -124 if that limit expires. +The Perl wrappers send `SIGALRM` to each local check after five minutes. +This is not the full CI gate's time limit; see +[Recipes](docs/src/guide/recipes.md#run-the-test-suite) for that command. +The bundle checks run on Linux and require Perl, Python 3, `readelf`, and +standard POSIX tools. + +Run source-loaded integration, dependency, and history checks with the +[isolated HOME and XDG procedure](docs/src/project/public-readiness.md#verification-outside-ci) +to avoid reading or modifying personal history and configuration. To measure executable-source coverage, keep the report outside the checkout -and run the same hermetic test loader used by CI: +and use the isolated HOME and XDG procedure above with this command: ```sh NSHELL_COVERAGE_DIR="$(mktemp -d)" \ @@ -97,7 +113,7 @@ is 85% (`NSHELL_COVERAGE_MIN`); the target is 100% (`NSHELL_COVERAGE_TARGET`). Tests live in `t/` and run under -[cl-weave](https://github.com/nerima-lisp/cl-weave), the org's test framework. +[cl-weave](https://github.com/nerima-lisp/cl-weave). Cases needing a real PTY, `stty`, or external binaries cannot run in the Nix sandbox and are covered by CI's separate `integration` job; run them locally with the command in @@ -116,7 +132,3 @@ guide and the [package standard](https://github.com/nerima-lisp/.github/blob/mai See [SUPPORT](https://github.com/nerima-lisp/.github/blob/main/SUPPORT.md). Report vulnerabilities privately per this repository's [security policy](SECURITY.md) rather than a public issue. - -## License - -MIT. See [LICENSE](LICENSE). diff --git a/docs/notes/nerima-lisp-package-audit.md b/docs/notes/nerima-lisp-package-audit.md index 9d5f0672..1680f469 100644 --- a/docs/notes/nerima-lisp-package-audit.md +++ b/docs/notes/nerima-lisp-package-audit.md @@ -50,18 +50,26 @@ nshell. Neither they nor `cl-log-kit` is a direct dependency in `nshell.asd`. `nshell/test` uses `cl-weave`. `nshell/weave` additionally depends on `cl-prolog-kit/weave` for completion-query tests. Loading a library or its test helpers is not the same as running that library's own suite. The sibling -derivations do not enable `doCheck`, and the CI jobs run nshell's suites, -not the dependencies' own suites. In particular, `checks.weave` runs -`nshell/weave`, not `cl-weave/test`. Dependency suite results remain unverified. +derivations do not enable `doCheck`. In particular, `checks.weave` runs +`nshell/weave`, not `cl-weave/test`. + +The current CI and release integration jobs additionally run +[`scripts/test-dependencies.sh`](../../scripts/test-dependencies.sh). +It starts a separate Lisp image for each pinned dependency suite. Its +[`runner`](../../scripts/test-dependencies.lisp) requires nonempty discovery, +matching discovered, selected, executed, and passed counts, and matching test +paths. Skipped, pending, focused, or failed tests do not clear that gate. +The jobs also run the private-history storage regressions. These gates do not +retroactively verify dependencies in the published v0.6.1 tree; their results +must be checked for the commit being released. `cl-nix-forge` supplies the Nix build helpers. `paredit-cli` is a development tool, not an executable runtime dependency. Release refs are declared in `flake.nix`; resolved revisions and hashes are recorded in [`flake.lock`](../../flake.lock). This audit makes no claim that those refs are the newest upstream tags. An upgrade must update the declaration and lock file, -review the local [`cl-process-kit` patch](../../nix/patches/cl-process-kit-no-duplicate-monotonic-seconds.patch), -and rerun the release gates. The dependency's own suite also needs a separate -run. +review the local patches under [`nix/patches/`](../../nix/patches/), and rerun +the release gates, including the dependencies' own suites. ## Reproduce the source checks diff --git a/docs/src/getting-started.md b/docs/src/getting-started.md index 1b6a52f8..bea2f854 100644 --- a/docs/src/getting-started.md +++ b/docs/src/getting-started.md @@ -5,49 +5,60 @@ outside the tested support boundary. ## Run without installing -With [Nix](https://nixos.org/download) (flakes enabled): +Install [Nix](https://nixos.org/download) and enable its `nix-command` and +`flakes` experimental features before running: ```sh -nix run github:nerima-lisp/nshell/v0.6.1 +nix run github:nerima-lisp/nshell/v0.6.2 ``` ## Install ```sh -nix profile install github:nerima-lisp/nshell/v0.6.1 -nshell +nix profile install github:nerima-lisp/nshell/v0.6.2 man nshell # the manual page is installed alongside the binary +nshell ``` -Pin a release tag rather than following the default branch. +Pin a release tag rather than following the default branch. Type `exit` to +leave the interactive shell. ### Prebuilt Linux bundle Without Nix, download both assets from the -[v0.6.1 release](https://github.com/nerima-lisp/nshell/releases/tag/v0.6.1), +[v0.6.2 release](https://github.com/nerima-lisp/nshell/releases/tag/v0.6.2), verify the checksum, and extract the bundle. On `x86_64-linux`, with `curl`, `sha256sum`, and `tar` available, run these commands in an empty directory: ```sh -curl --fail --location --remote-name https://github.com/nerima-lisp/nshell/releases/download/v0.6.1/nshell-v0.6.1-x86_64-linux.tar.gz -curl --fail --location --remote-name https://github.com/nerima-lisp/nshell/releases/download/v0.6.1/nshell-v0.6.1-x86_64-linux.tar.gz.sha256 -sha256sum --check nshell-v0.6.1-x86_64-linux.tar.gz.sha256 +curl --fail --location --remote-name https://github.com/nerima-lisp/nshell/releases/download/v0.6.2/nshell-v0.6.2-x86_64-linux.tar.gz +curl --fail --location --remote-name https://github.com/nerima-lisp/nshell/releases/download/v0.6.2/nshell-v0.6.2-x86_64-linux.tar.gz.sha256 +sha256sum --check nshell-v0.6.2-x86_64-linux.tar.gz.sha256 ``` -Proceed only if the checksum command succeeds: +Proceed only if the checksum command exits successfully and prints +`nshell-v0.6.2-x86_64-linux.tar.gz: OK`: ```sh -tar -xzf nshell-v0.6.1-x86_64-linux.tar.gz -./nshell-v0.6.1-x86_64-linux/bin/nshell --version -./nshell-v0.6.1-x86_64-linux/bin/nshell -man ./nshell-v0.6.1-x86_64-linux/share/man/man1/nshell.1 +tar -xzf nshell-v0.6.2-x86_64-linux.tar.gz +./nshell-v0.6.2-x86_64-linux/bin/nshell --version +man ./nshell-v0.6.2-x86_64-linux/share/man/man1/nshell.1 +./nshell-v0.6.2-x86_64-linux/bin/nshell ``` Keep the extracted directory intact: the launcher resolves libraries and -helpers relative to itself. To invoke `nshell` by name, add its `bin` -directory to your existing shell's `PATH`. +helpers relative to itself. The version output must identify `v0.6.2`. +Type `exit` to return to your existing shell. To use `nshell` by name in +the examples below, add the extracted `bin` directory to that shell's +`PATH`. For Bash or Zsh, from the download directory: + +```sh +export PATH="$PWD/nshell-v0.6.2-x86_64-linux/bin:$PATH" +``` + +This changes only the current terminal session. Alternatively, replace +`nshell` in the examples with the full path to the extracted launcher. -The release workflow publishes an `x86_64-linux` tarball and SHA-256 checksum. The release bundle removes Nix store references, carries its ELF runtime library closure, and is checked for required files and dependency metadata. CI also runs `--help`, `--version`, and an `echo` smoke test on the bundle. The @@ -56,21 +67,24 @@ attestation. ## First commands -Start nshell and type as you would in any shell. The prompt shows the +Start nshell with `nshell`. The prompt shows the working directory, the git branch (with `*` when the tree is dirty), and a -`❯` that turns red after a failing command; the last exit code and any -command that took a second or more appear on the right. The distinguishing +`❯` that turns red after a failing command. The right prompt shows a failing +exit code, the duration of commands that took at least one second, and the +current time when the prompt is rendered. The distinguishing behaviour shows up while typing: commands colorize live (an unknown command turns red before you run it), existing paths are underlined, and a dimmed completion of the most recent matching history entry trails the cursor. Press `→` or `Ctrl-F` to accept it. A mistyped command gets a `did you mean` -suggestion, `FOO=bar cmd` exports `FOO` for that one command, and `theme list` +suggestion, `FOO=bar printenv FOO` prints `bar` without keeping `FOO` in the +shell environment, and `theme list` shows the color presets. The prompt layout, the colors, and the key bindings are all configurable; see [Customization](guide/customization.md). Set `NSHELL_GREETING` to replace the startup banner with your own line, or to -the empty string to start silently. It is read after `~/.nshellrc` runs, so -`set -x NSHELL_GREETING ""` in that file works. +the empty string to start silently. If you want to make this persistent, +create the optional `~/.nshellrc` startup file and add +`set -x NSHELL_GREETING ""`. ### One-off command @@ -81,13 +95,14 @@ nshell -c 'string upper hello' ### Run a script ```sh -nshell examples/greet.nsh World +curl --fail --location --output greet.nsh https://raw.githubusercontent.com/nerima-lisp/nshell/v0.6.2/examples/greet.nsh +nshell greet.nsh World ``` Script files support multiline blocks (functions, `if`/`for`/`while`/`switch`), comments, and a `#!` shebang; arguments after the script name are available as `$argv`. See -[`examples/`](https://github.com/nerima-lisp/nshell/tree/main/examples) for a +[`examples/`](https://github.com/nerima-lisp/nshell/tree/v0.6.2/examples) for a runnable sample. ### Command line @@ -112,26 +127,15 @@ Options: ## Build from source -nshell builds with [SBCL](http://www.sbcl.org/) and ASDF. The supported and -tested path is Nix: +The Nix build supplies [SBCL](http://www.sbcl.org/), ASDF, and the dependencies. +On `x86_64-linux`, with Git and flake-enabled Nix installed: ```sh -git clone https://github.com/nerima-lisp/nshell +git clone --branch v0.6.2 https://github.com/nerima-lisp/nshell cd nshell -nix build # produces ./result/bin/nshell -nix flake check # full hermetic gate on x86_64-linux CI -nix develop # dev shell with SBCL + cl-weave +nix build +./result/bin/nshell ``` -`flake.nix` declares `x86_64-linux` only. The full hermetic flake gate, the -release-binary gate, and the non-sandboxed integration suite run in CI on that -target. A remote `x86_64-linux` builder can build the artifacts from another -host, but running the dev shell or the non-sandboxed PTY suite requires an -`x86_64-linux` execution environment. - -Inside `nix develop`, load the system into a REPL: - -```lisp -(asdf:load-system "nshell") -(nshell:main) -``` +For the development shell and test commands, see +[Recipes](guide/recipes.md#run-the-test-suite). diff --git a/docs/src/guide/concepts.md b/docs/src/guide/concepts.md index 47c9684b..ada1de43 100644 --- a/docs/src/guide/concepts.md +++ b/docs/src/guide/concepts.md @@ -45,19 +45,16 @@ Completion candidates come from a logic knowledge base compiled into a predicates such as `completes`, `describes`, `has-flag`, `command-is`, `suggests-dir`, and `suggests-file`. -Expressing completion as facts and rules rather than a lookup table means new -command metadata is data, and the ranking and filtering logic stays in one -place. Filesystem completion composes with the same query path, so a candidate -menu can mix a flag, a subcommand, and a path without special-casing any of -them. +Command metadata is expressed as facts and rules. Filesystem completion joins +the candidate query path, so a menu can mix flags, subcommands, and paths. +Candidate sources still use command-specific rules and routing priorities. ## Autosuggestions come from history As you type, nshell searches command history for the most recent entry with the current line as a prefix and shows the remainder dimmed after the cursor. -Accepting it with `→` or `Ctrl-F` inserts the rest. This is the fish-style -behaviour: it costs nothing when you ignore it, and it is faster than reverse -search when the command is recent. +Accepting it with `→` or `Ctrl-F` inserts the rest. You can continue typing +without accepting the suggestion. `Ctrl-R` opens incremental reverse search for the cases where a prefix is not what you remember. It draws the matching history entries under the prompt with @@ -94,17 +91,15 @@ terminal is narrow) and the git branch with a `*` when the tree is dirty. The prompt character is green after a success and red after a failure, so the last result is visible without reading anything. The right prompt adds the failing exit code, the wall-clock duration of any command that took a second or more, -and the time it finished. Everything on the right is omitted when it has -nothing to say, which keeps a fast, successful command on a quiet line. +and the current time when the prompt is rendered. The default clock remains +visible after fast, successful commands too. ## Layers, and what is allowed to do I/O -nshell follows a domain-driven, layered design where each layer depends only on -the layers beneath it. The rule that matters day to day is that `domain/` -performs no I/O: parsing, expansion, completion, history, prompting, and -job-control logic are pure functions over values. Everything that touches the -operating system — syscalls, PTY, signals, terminal I/O, persistence — is -isolated in `infrastructure/`, behind explicit boundaries that tests can swap. +The domain layer models parsing, expansion, completion, history, prompting, +and job-control policy as values. Infrastructure adapters provide syscalls, +PTYs, signals, terminal I/O, and persistence. The runtime targets SBCL and +also uses its facilities outside infrastructure. That separation is why the prompt and command timing are deterministic under test: hostname, working directory, and the clock are injected boundaries rather diff --git a/docs/src/guide/customization.md b/docs/src/guide/customization.md index 459c97e7..c7281ad6 100644 --- a/docs/src/guide/customization.md +++ b/docs/src/guide/customization.md @@ -96,7 +96,7 @@ nshell detects the terminal's color depth (truecolor, 256-color, or the 16-color ANSI palette) and downsamples every hex color automatically: to the nearest 256-color entry, or on a 16-color terminal to the palette slot with the same hue (low-saturation colors become the grays). A preset written for -truecolor still renders sensibly over a plain ANSI connection. Setting `NO_COLOR` to any value +truecolor still renders sensibly over a plain ANSI connection. Setting `NO_COLOR` to a nonempty value disables color output entirely, regardless of the active theme. ### Presets @@ -157,7 +157,9 @@ $ prompt left '{user}@{host} {path}{git} $ ' `prompt preview FORMAT` renders `FORMAT` once against the current state, without installing it, so you can check a format before committing to it. -`prompt reset` restores both defaults. An invalid format exits with status 2 +`prompt reset` removes both session overrides. The corresponding environment +variables then apply, or the built-in defaults if those variables are empty or +unset. An invalid format exits with status 2 and names the unknown segment; `prompt` with anything else prints a usage line and exits 1. @@ -217,8 +219,11 @@ custom bindings on every launch, the same way `theme` lines do. After a command has finished, press `Ctrl-X` to request a captured rerun. nshell shows the complete command and its existing AI safety classification; press `Ctrl-X` again only when that displayed command and classification are -acceptable. Any other key cancels the pending confirmation. Commands classified -as blocked, and terminal-dependent commands such as `vim`, `less`, and `ssh`, +acceptable. Reassigned bindings are shown in the confirmation instead. Long +lines wrap without omitting text. If the complete confirmation cannot fit in +the terminal, or contains non-displayable control characters, nshell refuses +the rerun. Any other key or a terminal resize cancels the pending confirmation. +Commands classified as blocked, and terminal-dependent commands such as `vim`, `less`, and `ssh`, are rejected because the capture path does not provide a live terminal. This is useful when the previous command's output was not retained for `?` diff --git a/docs/src/guide/recipes.md b/docs/src/guide/recipes.md index 8583d5d9..5c66fa9b 100644 --- a/docs/src/guide/recipes.md +++ b/docs/src/guide/recipes.md @@ -39,8 +39,10 @@ Start an interactive assistant task from a terminal: agent "inspect the current job state" ``` -The `agent` builtin is interactive-only. Proposed shell commands are shown for -review and require pressing Enter again before execution. +The `agent` builtin is interactive-only. Commands classified as safe execute +automatically. Commands requiring confirmation are shown for review and execute +only after Enter; blocked commands are not executed. Review this policy before +starting a task, especially in a directory containing sensitive data. Inspect assistant state and configure the session with `ai`: @@ -68,6 +70,10 @@ perl -e '$SIG{ALRM}=sub { exit 124 }; alarm 1800; exec @ARGV' nix flake check -- Just the primary suite, through the same entry point CI uses: +For source-loaded checks, first isolate HOME and XDG directories using the +[validation procedure](../project/public-readiness.md#verification-outside-ci) to keep +personal history and configuration out of the test run. + ```sh perl -e '$SIG{ALRM}=sub { exit 124 }; alarm 300; exec @ARGV' nix run .#test # or, inside `nix develop`: @@ -84,12 +90,10 @@ perl -e '$SIG{ALRM}=sub { exit 124 }; alarm 300; exec @ARGV' sbcl --script scrip Some cases need a real PTY, `stty`, and external binaries, which the Nix sandbox does not provide; they are skipped inside `nix flake check` and run -instead in CI's `integration` job. Run them locally when changing PTY, -subprocess, terminal, or job-control behaviour: - -```sh -perl -e '$SIG{ALRM}=sub { exit 124 }; alarm 300; exec @ARGV' nix develop -c sbcl --script run-tests.lisp -``` +instead in CI's `integration` job. When changing PTY, subprocess, terminal, +or job-control behaviour, run the [isolated integration, dependency, and history +suites](../project/public-readiness.md#verification-outside-ci) with `NSHELL_TEST_PTY=1`, +as shown there. This covers the real-PTY interactive smoke tests, `Ctrl-C` recovery, and the job-control lifecycle checks. diff --git a/docs/src/project/public-readiness.md b/docs/src/project/public-readiness.md index b19c91a5..e42703d4 100644 --- a/docs/src/project/public-readiness.md +++ b/docs/src/project/public-readiness.md @@ -1,8 +1,5 @@ # Public Readiness -This document records the release gates, evidence, and known limits for -nshell's interactive features. - ## Positioning nshell targets daily interactive use first. v0.6.1 is a development preview, @@ -10,28 +7,30 @@ not a POSIX/fish-compatible script interpreter. ## Capability Matrix -| Area | Release bar | Current evidence | Status | +The evidence and statuses below describe the published `v0.6.1` tree, not +unreleased changes on the default branch. + +| Area | Release bar | Published evidence | Status | | --- | --- | --- | --- | | Interactive editor | Live syntax feedback, Emacs bindings, optional vi mode, multiline editing, undo/yank, predictable rendering | input-state, rendering, and PTY integration tests | CI-verified on `x86_64-linux` | | History and suggestions | Persistent history, reverse search, prefix autosuggestions, handling of multiline entries | history, autosuggest, and E2E editing tests | CI-verified on `x86_64-linux` | | Completion | Context-aware command/path/flag completion, candidate menu, deterministic cycling and cancellation | completion domain and REPL rendering tests, hierarchical command resolution, curated external command metadata and selective help-text enrichment | Broader command discovery/cache policy and subcommand coverage remain future work | | Shell language | Functions, control flow, command substitution, expansions, heredocs, here-strings, redirection, pipelines | parser, expansion, source, pipeline, process-substitution, descriptor-duplication, tab-stripping-heredoc, and smoke tests | Tested subset; full POSIX/fish parity is not claimed | -| Process control | Foreground/background jobs, `jobs`/`fg`/`bg`/`disown`, Ctrl-C recovery, terminal restoration; external commands attached to the interactive terminal have no default timeout, while redirected execution and command substitution remain bounded | job-control and non-sandboxed PTY integration tests | CI-verified on `x86_64-linux` | -| Distribution | Reproducible Nix build, installed man page, release binary smoke, checksummed artifacts | flake build, man page, CI/release workflows, [v0.6.1 release assets](https://github.com/nerima-lisp/nshell/releases/tag/v0.6.1) | Prebuilt `x86_64-linux` binary and SHA-256 checksum published; nixpkgs/Homebrew remain future work | +| Process control | Foreground/background jobs, `jobs`/`fg`/`bg`/`disown`, Ctrl-C recovery, terminal restoration; terminal-attached commands have no default timeout, while redirected execution defaults to 3600 seconds and command substitution to 300 seconds | job-control and non-sandboxed PTY integration tests | CI-verified on `x86_64-linux` | +| Distribution | Nix-pinned build, installed man page, release binary smoke, checksummed artifacts | flake build, man page, CI/release workflows, [v0.6.1 release assets](https://github.com/nerima-lisp/nshell/releases/tag/v0.6.1) | Prebuilt `x86_64-linux` binary and SHA-256 checksum published; nixpkgs/Homebrew remain future work | | Security and operations | Private vulnerability reporting, explicit security scope, validation of secret handling in history/completion/diagnostics | [repository security policy](https://github.com/nerima-lisp/nshell/blob/v0.6.1/SECURITY.md) and [contribution guidelines](contributing.md) | Reporting policy exists; it does not establish a security audit of runtime behavior | The [v0.6.1 CI run](https://github.com/nerima-lisp/nshell/actions/runs/38050042888) and [release workflow](https://github.com/nerima-lisp/nshell/actions/runs/38052885425) -validate the tagged tree. The published -[v0.6.1 release](https://github.com/nerima-lisp/nshell/releases/tag/v0.6.1) -contains the x86_64-linux bundle and SHA-256 checksum. The non-sandboxed +validate the tagged tree. The non-sandboxed integration job runs the PTY and external-process cases skipped by the Nix sandbox. ## Release Gates These are the existing nshell gates, not a production-readiness verdict. -They do not close the dependency-suite and license-packaging gaps below. +The workflow also requires dependency-suite and extracted-artifact checks; +the older published runs linked above do not establish these newer gates. Before a public release can claim the capabilities listed here: @@ -40,15 +39,22 @@ Before a public release can claim the capabilities listed here: 2. The non-sandboxed integration suite passes for PTY, subprocess, terminal, signal, and job-control coverage on the sole CI matrix target, `x86_64-linux`, without skipping those cases. -3. A release binary is built on `x86_64-linux`, starts, and ships - with `README.md`, `LICENSE`, and the `nshell(1)` man page. -4. User-visible behavior changes are represented in README, man page, the +3. The pinned dependency suites execute directly, with nonempty discovery, + matching selected/executed counts, and no skipped cases. 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, + license-file, and runtime smoke checks. Its executable passes the real-PTY gate for editing, + signals, job control, history restart, and terminal restoration, and ships + with `README.md`, `LICENSE`, dependency licenses, and `nshell(1)`. +5. User-visible behavior changes are represented in README, man page, the GitHub Release notes, and completion metadata when applicable. -5. Open roadmap gaps remain explicit instead of being implied as complete. +6. Open roadmap gaps remain explicit instead of being implied as complete. -The [release workflow](https://github.com/nerima-lisp/nshell/blob/v0.6.1/.github/workflows/release.yml) +The [release workflow](https://github.com/nerima-lisp/nshell/blob/main/.github/workflows/release.yml) runs hermetic checks and a non-sandboxed integration job against the same -resolved tagged commit, and only then builds the published release assets. +resolved tagged commit, and only then builds the release assets in a draft. +A maintainer reviews the assets and release notes before publishing the draft. ## Verification outside CI @@ -58,38 +64,51 @@ also requires an `x86_64-linux` execution environment; a remote builder alone does not supply that runtime coverage. - Run `nix flake check --print-build-logs` on an `x86_64-linux` builder. -- Run `NSHELL_TEST_PTY=1 nix develop -c sbcl --script run-tests.lisp` on the - same target for the non-sandboxed PTY and external-process suite. +- Run the non-sandboxed suites on the same target with a temporary home and + XDG directories, as the integration jobs do. Tests can access history and + configuration through the normal runtime APIs; do not use personal data. + Run this block from the repository root: + + ```sh + ( + verification_dir=$(mktemp -d) + mkdir -p "$verification_dir/home" "$verification_dir/cache" \ + "$verification_dir/config" "$verification_dir/state" + export HOME="$verification_dir/home" + export XDG_CACHE_HOME="$verification_dir/cache" + export XDG_CONFIG_HOME="$verification_dir/config" + export XDG_STATE_HOME="$verification_dir/state" + export NSHELL_AI_COMMAND=/nonexistent NSHELL_TEST_PTY=1 + nix develop -c sbcl --script run-tests.lisp && + nix develop -c bash scripts/test-dependencies.sh && + nix develop -c sbcl --script scripts/test-history-storage.lisp + ) + ``` + Confirm nonempty test discovery and no skipped PTY or external-process cases in the test report; an exit status of zero alone does not establish coverage. - The integrated suite covers OSC 52 clipboard output, tab-stripping `<<-` heredocs, process substitution, ordered descriptor duplication, path-like argument completion, hierarchical command completion, and SGR mouse selection. +- The dependency runner executes the pinned libraries' own suites; the history + script checks private persistence. A successful library load is not a test + result. +- Verify the release archive against its SHA-256 checksum before extraction. + Extract it and run + `perl scripts/verify-release-bundle.pl ` followed by + `perl scripts/test-release-pty.pl ` on `x86_64-linux`. ## Known Limits and Future Work - Broader help-text-driven command discovery remains future work, especially for subcommand coverage and non-curated external tools. -- Full POSIX/fish expansion compatibility is outside the documented scripting - subset; scripts for those shells must not be assumed compatible. - Mouse selection and clipboard behavior depend on the terminal. No exhaustive terminal matrix is claimed; the editor maps SGR coordinates through captured prompt geometry and falls back to OSC 52 when host clipboard integration is unavailable. -- The x86_64-linux release bundle is checked for Nix store references, its ELF - runtime closure, required files listed in - [`scripts/verify-release-bundle.pl`](https://github.com/nerima-lisp/nshell/blob/v0.6.1/scripts/verify-release-bundle.pl), - and `--help`, `--version`, and `echo` smoke behavior in CI via - `perl scripts/verify-release-bundle.pl result`. This checks the Nix build - output, not an extracted tarball. It does not run the full integration suite - against the bundled executable. -- The bundle verifier checks the Nix output directory, not a re-extracted - tarball. Tar extraction, checksum verification, and execution of the - extracted bundle remain release-consumer checks; the bundled executable is - smoke-tested in the Nix output during CI. -- CI runs nshell's test suites, not the dependency libraries' own suites. - Loading those libraries or their test helpers does not establish that their - suites pass. +- The extracted executable's PTY scenarios are a separate bounded gate, not + the entire source-loaded integration suite. Passing them does not establish + every integration case against the portable executable. - Release assets include a SHA-256 checksum. GitHub artifact attestations are not configured; the checksum alone is not a provenance attestation. - Validate the process-isolated benchmark scenarios in CI and collect equivalent diff --git a/docs/src/project/releasing.md b/docs/src/project/releasing.md index 032cb0b1..4ab0d2bc 100644 --- a/docs/src/project/releasing.md +++ b/docs/src/project/releasing.md @@ -1,8 +1,7 @@ # Releasing -nshell ships a binary as well as a source release, so its release checklist is -longer than the org default: a green test suite does not prove that the dumped -SBCL image starts on a user's machine. +nshell ships a binary as well as a source release. A green source test suite +does not prove that the dumped SBCL image starts on a user's machine. The default Nix package and portable bundle use an uncompressed saved image. This deliberately trades artifact size for lower warm-filesystem CLI startup @@ -13,8 +12,8 @@ latency; compressed images are not a supported release variant. The top-level `:version` form in `nshell.asd` is the release version source of truth. Secondary systems repeat that version as ASDF metadata. `flake.nix` reads it, and `release.yml` refuses to publish unless every `:version` form in -the file agrees with the tag. Bump every version in the `.asd` and nothing -else. +the file agrees with the tag. Bump every version in the `.asd` and update the +man page's version label. No separate version file is needed. ## What CI enforces on a tag push @@ -23,10 +22,13 @@ Pushing a `v*.*.*` tag runs `release.yml`, which: 1. Verifies the tag matches `nshell.asd`'s `:version`, and stops before building anything if it does not. 2. Runs `nix flake check --print-build-logs` against the tagged tree. -3. Builds the binary for the `x86_64-linux` release target, confirms it - starts, and packages a tarball plus a SHA-256 checksum. No other platform is - declared or published by the current flake. -4. Creates the GitHub Release as an empty **draft** with those files attached. +3. Runs the non-sandboxed integration suite, dependency suites, and history + storage regressions against the same resolved tagged commit. +4. Builds the binary for `x86_64-linux` and packages a tarball plus a SHA-256 + checksum. It checks the checksum, re-extracts the archive, verifies its + manifest and runtime closure, and exercises the extracted executable with + a real PTY. No other platform is declared or published by the current flake. +5. Creates the GitHub Release as an empty **draft** with those files attached. It writes no release body: the GitHub Release description is the canonical history and there is no `CHANGELOG.md`. @@ -34,14 +36,15 @@ Pushing a `v*.*.*` tag runs `release.yml`, which: Verify the public artefacts from a clean checkout: +The bundle checks require Perl, Python 3, `readelf`, and the standard POSIX +tools on the Linux verification host. + - `nix flake check --print-build-logs` passes on `x86_64-linux`. Other hosts require an `x86_64-linux` builder for the release gate. - The non-sandboxed integration suite passes for PTY, subprocess, terminal, - signal, and job-control coverage: - - ```sh - nix develop -c sbcl --script run-tests.lisp - ``` + signal, and job-control coverage. Run the integration, dependency, and + history suites with the [isolated HOME and XDG procedure](public-readiness.md#verification-outside-ci), + not personal history or configuration directories. - `nix build .#releaseBundle --print-build-logs` produces the executable, man page, README, and dependency license texts in `./result`. @@ -51,36 +54,60 @@ Verify the public artefacts from a clean checkout: - `./result/bin/nshell --version` reports the intended version. - `./result/bin/nshell --help` and `man ./man/nshell.1` match the documentation and shipped behaviour. -- Release tarballs contain `nshell`, `README.md`, `LICENSE`, the man page, and - the `LICENSES/` directory produced by `releaseBundle`; each checksum - verifies with `shasum -a 256 -c`. -- Release notes are drafted. Read `git log ..HEAD` and select - entries by "does a user of nshell have to change anything". After the +- Package the built bundle using GNU tar and gzip, as the release workflow + does. Replace `vX.Y.Z` with the intended tag: + + ```sh + name="nshell-vX.Y.Z-x86_64-linux" + mkdir -p "dist/$name" + cp -R result/. "dist/$name/" + nix shell --inputs-from . nixpkgs#gnutar nixpkgs#gzip --command \ + bash -euo pipefail -c 'tar --sort=name --mtime="@0" --owner=0 --group=0 \ + --numeric-owner -cf - -C dist "$1" | gzip -n > "dist/$1.tar.gz"' bash "$name" + (cd dist && shasum -a 256 "$name.tar.gz" > "$name.tar.gz.sha256") + (cd dist && shasum -a 256 -c "$name.tar.gz.sha256") + ``` + + The archive includes `bin/nshell`, `README.md`, `LICENSE`, the man page, + and the dependency texts in `LICENSES/`. +- Extract the checked archive into a private temporary directory and verify + the extracted bundle, using the same `name` as above: + + ```sh + extracted="$(mktemp -d)" + tar -xzf "dist/$name.tar.gz" -C "$extracted" + perl scripts/verify-release-bundle.pl "$extracted/$name" + perl scripts/test-release-pty.pl "$extracted/$name" + ``` + + The PTY check exercises editing, Ctrl-C, Ctrl-Z/`bg`/`fg`, history across + restart, and terminal restoration. A source-loaded suite is not a substitute. +- Release notes are drafted. Review changes since the previous tag and describe + user-visible features, fixes, and any required migration. After the workflow goes green, paste them in and publish the draft: ```sh gh release edit vX.Y.Z --notes-file --draft=false ``` - A draft appears neither under "Latest release" nor in the default output of - `gh release list`, so a release whose notes were forgotten never reaches - downstream. + A draft is not a public release. `gh release list` can show drafts to an + authenticated maintainer; that listing does not establish publication. ## Updating locked dependencies The scheduled `flake.lock` workflow updates the flake inputs and opens or -refreshes a pull request. For a manual refresh or review: +refreshes a pull request. To review that update: 1. Inspect `git diff -- flake.lock` and confirm that only the intended dependency graph changed. -2. Run `nix flake check --print-build-logs` on Linux. On macOS, run the checks - available for the pinned dependency set. +2. Run `nix flake check --print-build-logs` and the non-sandboxed commands above + on `x86_64-linux`. A macOS host alone cannot execute the release target. 3. Keep the lock-file refresh separate from behaviour or release-version changes. Merge a lock-file refresh only after reviewing the generated diff and the check results, because the lock file is part of the release input. -When triggering the workflow manually rather than by tag push, pass the tag as +When triggering `release.yml` manually rather than by tag push, pass the tag as the `tag` input so checkout, artefact naming, and the GitHub Release target all use it consistently. Do not build a branch ref while publishing a tag release. diff --git a/docs/src/reference/architecture.md b/docs/src/reference/architecture.md index ca6f24f7..135111f3 100644 --- a/docs/src/reference/architecture.md +++ b/docs/src/reference/architecture.md @@ -1,51 +1,53 @@ # Architecture -nshell follows a domain-driven, layered design. Each layer depends only on the -layers beneath it: +nshell groups shell policy, use cases, operating-system adapters, and the +interactive interface into four layers: ``` src/ ├── domain/ Pure shell logic: parsing, expansion, completion, -│ history, prompting, job-control — no I/O. +│ history, prompting, job-control (no I/O). ├── application/ Use cases: builtins, pipeline execution, job management. -├── infrastructure/ ACLs over the OS: syscalls, PTY, signals, terminal I/O, -│ persistence. SBCL-specific code is isolated here. +├── infrastructure/ OS adapters: syscalls, PTY, signals, terminal I/O, +│ persistence. └── presentation/ The REPL, line editor (input-state reducer), rendering, highlighting, autosuggestions, completion UI. ``` -`src/` is the composition route for the existing shell runtime. New -capabilities are vertical features under `packages/`, with the same DDD layer -names kept together inside each feature: +`src/` contains the shell runtime. Features under `packages/` keep their +layers together; `` below means `domain`, `application`, +`infrastructure`, or `presentation`: ``` packages/ -├── core//src// Shared domain and architecture primitives. -└── feature//src// A feature's domain, use cases, adapters, and UI. +├── core//src// Shared domain and architecture primitives. +└── feature//src// A feature's domain, use cases, adapters, and UI. ``` -The command-line feature is the first slice in this layout. Its pure option +The command-line feature's pure option policy, application contract, and help presentation live in -`packages/feature/command-line/src/`. `src/main.lisp` remains a small -composition root and consumes `cl-cli` directly, so the feature boundary does -not contain a compatibility adapter. Its established internal entry points -delegate to the feature boundary, so startup and test callers do not need to -know where the slice is stored. ASDF loads the package modules before the -shared `src/` components, preserving the dependency direction while -making the vertical boundary explicit. +`packages/feature/command-line/src/`. `src/main.lisp` constructs and parses +the CLI with `cl-cli`, delegates option policy and help to the feature, and +dispatches interactive, command, script, or stdin execution. `nshell.asd` +declares the runtime and feature modules and their load order. ## Assistant feature The assistant is a vertical feature under -`packages/feature/assistant/src//`. Its application layer assembles +`packages/feature/assistant/src//`. Its application layer assembles context and tracks settings and usage, while the infrastructure layer isolates -the model-sidecar boundary and audit state. Domain checks classify proposed +the model-sidecar boundary and audit state. The sidecar is an external +assistant process; `src/infrastructure/assistant-sidecar-stream.lisp` +manages its startup, requests, events, and shutdown. Domain checks classify proposed commands and redact sensitive payloads before the REPL approval gate allows a proposal to execute. -Tests follow the same observable boundaries: `t/unit/` checks feature policy -and contracts, `t/integration/` checks the source topology, and `t/e2e/` -checks that the `src/main` route exposes the feature's user-facing behavior. +`t/unit/` checks feature policy and contracts. +`t/integration/test-package-topology.lisp` checks that the layer directories +exist, not that dependencies obey the layer boundaries. `t/e2e/` checks +user-facing CLI behavior. + +## Shell runtime The REPL is structured as a **continuation-passing / trampoline loop**: each keystroke runs a pure reducer over an immutable `input-state`, and rendering is @@ -54,51 +56,51 @@ unit-testable without a terminal. See [Core concepts](../guide/concepts.md#the-input-state-is-a-value) for what that buys in practice. -Confining SBCL-specific code to `infrastructure/` is what makes the layers -above it portable in principle and testable in practice: a test replaces a -boundary with a value instead of arranging for the operating system to produce -one. +The runtime targets SBCL. OS adapters live primarily in `infrastructure/`, +but application and presentation code also use SBCL facilities, including +timeouts and process status. Pipeline orchestration keeps process waiting and termination policy in `infrastructure/acl/syscall-pipeline-wait.lisp`, separate from pipe topology -and stage spawning. This makes timeout escalation, process-group ownership, -and pipefail status calculation independently reviewable while the public -pipeline entry points remain unchanged. +and stage spawning. That file implements timeout escalation, process-group +ownership, and pipefail status calculation. ## Toolkit foundation -nshell builds on the `nerima-lisp` Common Lisp toolkit family, each wired at the -layer where it fits the domain-driven design: +nshell uses these `nerima-lisp` Common Lisp toolkits: -- **[cl-parser-kit](https://github.com/nerima-lisp/cl-parser-kit)** — its +- **[cl-parser-kit](https://github.com/nerima-lisp/cl-parser-kit)**: its rule-based tokenizer and Pratt (operator-precedence) parser drive `$((...))` arithmetic, which parses to an AST and then evaluates, adding `**`, bitwise `& | ^ ~`, shifts `<< >>`, and the ternary `?:`. -- **[cl-dataflow-kit](https://github.com/nerima-lisp/cl-dataflow-kit)** — renders +- **[cl-dataflow-kit](https://github.com/nerima-lisp/cl-dataflow-kit)**: renders pipelines as validated computation graphs (`pipeline-graph`) and models the job lifecycle as an analyzable state machine. -- **[cl-boundary-kit](https://github.com/nerima-lisp/cl-boundary-kit)** — makes +- **[cl-boundary-kit](https://github.com/nerima-lisp/cl-boundary-kit)**: makes the REPL edge's OS effects (hostname, working directory, clock) explicit, swappable boundaries, so the prompt and command timing are deterministic under test. -- **[cl-cli](https://github.com/nerima-lisp/cl-cli)** — declaratively describes +- **[cl-cli](https://github.com/nerima-lisp/cl-cli)**: declaratively describes the `nshell` command line (`--help`/`--version`/`-c`/script dispatch). -- **[cl-tty-kit](https://github.com/nerima-lisp/cl-tty-kit)** — provides +- **[cl-tty-kit](https://github.com/nerima-lisp/cl-tty-kit)**: provides Unicode-correct display-width, truncation, and padding; the ANSI/SGR escape vocabulary used by rendering, prompt, and completion; and the `ioctl(TIOCGWINSZ)` window-size query behind `nshell.infrastructure.acl:get-terminal-size`. Raw mode is deliberately *not* taken from the kit: `cl-tty-kit:enable-raw-mode` is a full cfmakeraw-style - mode that also clears `ISIG` and `OPOST`, while nshell holds raw mode for the - whole session — including while a foreground child runs — and needs the - terminal driver to keep turning `^C`/`^Z` into signals for that child and to - keep mapping LF to CR-LF. See the commentary in + mode that also clears `ISIG` and `OPOST`. nshell's editor preserves these + flags so the terminal driver still generates signals and maps LF to CR-LF. + Before running a foreground command, nshell restores the saved terminal + settings; after the command returns, it re-enables editor mode. + nshell snapshots the complete native terminal settings (Linux `termios2` + or Darwin `termios`) to preserve speeds and control fields across raw-mode + changes. See the commentary in `src/infrastructure/terminal/raw-mode.lisp`. -- **[cl-process-kit](https://github.com/nerima-lisp/cl-process-kit)** — backs +- **[cl-process-kit](https://github.com/nerima-lisp/cl-process-kit)**: backs timeout-guarded process launch, escalating SIGTERM to SIGKILL across a child's whole process group so a timed-out command substitution leaves no orphaned descendants. -- **[cl-prolog-kit](https://github.com/nerima-lisp/cl-prolog-kit)** — the logic engine +- **[cl-prolog-kit](https://github.com/nerima-lisp/cl-prolog-kit)**: the logic engine behind the completion knowledge base. ## Test suites @@ -106,8 +108,8 @@ layer where it fits the domain-driven design: Two suites run under [cl-weave](https://github.com/nerima-lisp/cl-weave), both exposed as Nix checks: -- **`nshell/test`** — the primary regression suite, in `t/`. -- **`nshell/weave`** — a focused suite exercising the completion engine's +- **`nshell/test`**: the primary regression suite, in `t/`. +- **`nshell/weave`**: a focused suite exercising the completion engine's cl-prolog-kit knowledge base with property-based tests, fixtures, benchmarks, and direct Prolog queries (`findall`, negation-as-failure, foreign predicates) plus the `cl-prolog-kit/weave` query bridge. diff --git a/flake.nix b/flake.nix index abea1dc7..108776ec 100644 --- a/flake.nix +++ b/flake.nix @@ -239,10 +239,12 @@ clParserKit = sibling { name = "cl-parser-kit"; source = cl-parser-kit; + patches = [ ./nix/patches/cl-parser-kit-prolog-kit-name.patch ]; }; clDataflow = sibling { name = "cl-dataflow-kit"; source = cl-dataflow-kit; + patches = [ ./nix/patches/cl-dataflow-kit-writable-snapshot-fixture.patch ]; dependencies = [ clProlog clConcurrentKit @@ -263,11 +265,13 @@ clBoundaryKit = sibling { name = "cl-boundary-kit"; source = cl-boundary-kit; + patches = [ ./nix/patches/cl-boundary-kit-prolog-kit-name.patch ]; dependencies = [ clHostKit ]; }; clConcurrentKit = sibling { name = "cl-concurrent-kit"; source = cl-concurrent-kit; + patches = [ ./nix/patches/cl-concurrent-kit-cancelled-barrier.patch ]; dependencies = [ clBoundaryKit clDateKit @@ -289,11 +293,16 @@ clCli = sibling { name = "cl-cli"; source = cl-cli; + patches = [ + ./nix/patches/cl-cli-prolog-kit-name.patch + ./nix/patches/cl-cli-zsh-render-cache.patch + ]; dependencies = [ clHostKit ]; }; clTtyKit = sibling { name = "cl-tty-kit"; source = cl-tty-kit; + patches = [ ./nix/patches/cl-tty-kit-prolog-kit-name.patch ]; dependencies = [ clCodecKit clConcurrentKit @@ -307,10 +316,13 @@ clLogKit clCodecKit ]; - # v3.2.0 defines %monotonic-seconds in both parameters.lisp and - # fd-readiness.lisp. Upstream main is still identical; remove this - # patch when a release containing the upstream fix is available. - patches = [ ./nix/patches/cl-process-kit-no-duplicate-monotonic-seconds.patch ]; + # Share process reaping with the cancellation watcher and execute + # the complete dependency suite on Linux as well as Darwin. + patches = [ + ./nix/patches/cl-process-kit-no-duplicate-monotonic-seconds.patch + ./nix/patches/cl-process-kit-enable-linux-tests.patch + ./nix/patches/cl-process-kit-wait-for-timeout-group.patch + ]; }; clRegexKit = sibling { name = "cl-regex-kit"; @@ -357,6 +369,24 @@ ''; }; + ptyHelperFor = + ctx: + ctx.pkgs.stdenv.mkDerivation { + pname = "cl-process-kit-pty"; + version = ctx.cl.fromAsdSystem "${cl-process-kit}/cl-process-kit.asd"; + dontUnpack = true; + buildPhase = '' + runHook preBuild + $CC -O2 -fPIC -shared ${cl-process-kit}/native/pty.c -o libcl_process_kit_pty${ctx.pkgs.stdenv.hostPlatform.extensions.sharedLibrary} + runHook postBuild + ''; + installPhase = '' + runHook preInstall + install -Dm755 libcl_process_kit_pty${ctx.pkgs.stdenv.hostPlatform.extensions.sharedLibrary} "$out/lib/libcl_process_kit_pty${ctx.pkgs.stdenv.hostPlatform.extensions.sharedLibrary}" + runHook postInstall + ''; + }; + # The delivered binary plus its human-readable release metadata. # `overrideAttrs` on the delivery, # not a second derivation wrapping it: `mkExecutable` returns a @@ -680,11 +710,27 @@ # The cl-weave CLI, which the suites' reporters are documented against. # Interactive only: the registry the shell exports already carries every # system, check dependencies included. - devShellPackages = ctx: [ - (spawnHelperFor ctx) - cl-weave.packages.${ctx.system}.default - paredit-cli.packages.${ctx.system}.default - ]; + devShellPackages = + ctx: + [ + (spawnHelperFor ctx) + cl-weave.packages.${ctx.system}.default + paredit-cli.packages.${ctx.system}.default + ] + # The dependency gate rejects skipped real-shell verification tests. + ++ lib.optionals ctx.pkgs.stdenv.hostPlatform.isLinux ( + with ctx.pkgs; + [ + bash + zsh + fish + ghq + mandoc + nushell + powershell + elvish + ] + ); overrideOutputs = ctx: @@ -721,6 +767,9 @@ # derivation's own resolved registry, including check dependencies) # is kept. devShells.default = ctx.generated.devShells.default.overrideAttrs (previous: { + TZDIR = "${ctx.pkgs.tzdata}/share/zoneinfo"; + CL_PROCESS_KIT_SPAWN = "${spawnHelperFor ctx}/bin/cl-process-kit-spawn"; + CL_PROCESS_KIT_PTY_LIBRARY = "${ptyHelperFor ctx}/lib/libcl_process_kit_pty${ctx.pkgs.stdenv.hostPlatform.extensions.sharedLibrary}"; shellHook = previous.shellHook + '' export NSHELL_ROOT=$PWD alias test='cd "$NSHELL_ROOT" && sbcl --script "$NSHELL_ROOT/run-tests.lisp"' diff --git a/man/nshell.1 b/man/nshell.1 index e51d5d6e..f5152cdc 100644 --- a/man/nshell.1 +++ b/man/nshell.1 @@ -1,6 +1,6 @@ -.TH NSHELL 1 "2026-09-30" "nshell 0.5.0" "User Commands" +.TH NSHELL 1 "2026-09-30" "nshell 0.6.2" "User Commands" .SH NAME -nshell \- a modern, fish-inspired interactive shell written in Common Lisp +nshell \- a fish-inspired interactive shell written in Common Lisp .SH SYNOPSIS .B nshell .RB [ \-\-help ] @@ -17,9 +17,8 @@ nshell \- a modern, fish-inspired interactive shell written in Common Lisp .RI [ ARGS .\|.\|.]] .SH DESCRIPTION .B nshell -is an interactive command-line shell that emphasizes the interactive -experience: real-time syntax highlighting, history-aware autosuggestions, -fish-style abbreviations, and a fast, context-aware completion engine. +provides real-time syntax highlighting, history-aware autosuggestions, +fish-style abbreviations, and context-aware completion. .PP When started with standard input connected to a terminal, .B nshell @@ -38,6 +37,7 @@ file argument, it runs the script (with multiline blocks); any following .I ARGS are exposed to the script as .BR $argv . +Indexing is 1-based: \fB$argv[1]\fR selects the first argument. .SH OPTIONS .TP .BR \-h ", " \-\-help @@ -68,12 +68,20 @@ instead of .BR ~/.nshellrc . .TP .B \-\-no\-history -Do not read or write interactive history. +Do not load or save the history file, or record commands in in-session history. .SH KEY BINDINGS -By default the line editor uses Emacs-style key bindings, including cursor -motion (\fBC\-a\fR, \fBC\-e\fR, \fBM\-f\fR, \fBM\-b\fR), editing (\fBC\-k\fR, -\fBC\-u\fR, \fBC\-w\fR, \fBC\-y\fR), undo (\fBC\-_\fR), incremental history -search (\fBC\-r\fR), and autosuggestion acceptance (\fBRight\fR, \fBC\-f\fR). +The default Emacs-style bindings use \fBC\-\fR for Ctrl +and \fBM\-\fR for Alt (Meta). +\fBC\-a\fR moves to the start of the line; \fBC\-e\fR moves to the end, +or accepts the autosuggestion when already at the end. +\fBM\-b\fR moves back one word; \fBM\-f\fR moves forward one word, +or accepts the next suggested word at the end of the line. +\fBRight\fR and \fBC\-f\fR move forward one character, +or accept the entire autosuggestion at the end of the line. +.PP +\fBC\-k\fR cuts to the end of the line; \fBC\-u\fR cuts to the start; +\fBC\-w\fR cuts the preceding word; \fBC\-y\fR reinserts the last cut text. +\fBC\-_\fR undoes the last edit. .PP \fBC\-r\fR lists the matching history entries under the prompt. \fBC\-r\fR/\fBC\-s\fR and the arrow keys move the selection, @@ -84,7 +92,8 @@ restores the line that was being typed. .PP Setting the environment variable .B NSHELL_VI_MODE -to a non-empty value (other than 0/false/no) enables vi key bindings: press +to a non-empty value other than 0, false, or no (case-insensitive) +enables vi key bindings: press .B ESC to enter normal mode, which supports motions (\fBh l 0 ^ $ w b e\fR), insert entries (\fBi a I A\fR), edits (\fBx D C s\fR), counts, operators @@ -95,6 +104,14 @@ Press \fBM\-e\fR (\fBAlt\-E\fR) to open the current line in the external editor selected by \fBNSHELL_EDITOR\fR, \fBVISUAL\fR, or \fBEDITOR\fR, falling back to \fBvi\fR; the edited line is returned to the prompt without being executed. .PP +Press \fBC\-x\fR to request a captured rerun of the previous command. +Review the complete command and safety classification, then press the displayed +confirmation binding again to execute it. Long commands wrap without truncation. +The rerun is refused if the confirmation cannot fit, contains control +characters, or the command is blocked or requires a live terminal. +Any other key or a terminal resize cancels the confirmation. This executes +the command again; it does not replay saved output. +.PP The .B bind builtin lists, sets, erases, and resets these bindings; run @@ -108,10 +125,19 @@ expansion (\fB~\fR), arithmetic expansion (\fB$((expr))\fR), variable and parameter expansion, command substitution (\fB$(cmd)\fR and fish-style \fB(cmd)\fR), and globbing (\fB* ? [\&.\&.\&.]\fR). .PP -Parameter expansion supports \fB${VAR}\fR, defaults \fB${VAR:-word}\fR and -relatives (\fB:= :+ :?\fR), substring slicing \fB${VAR:offset[:length]}\fR, -length \fB${#VAR}\fR, prefix/suffix stripping (\fB${VAR#pat} ## % %%\fR), and -substitution (\fB${VAR/pat/rep} //\fR). +\fB${VAR}\fR expands to the variable's value; \fB${#VAR}\fR gives its length. +\fB${VAR:-word}\fR uses \fBword\fR when VAR is unset or empty; +\fB${VAR:=word}\fR also assigns that value to VAR. +\fB${VAR:+word}\fR uses \fBword\fR only when VAR is set and non-empty; +\fB${VAR:?message}\fR reports an error when VAR is unset or empty. +.PP +\fB${VAR:offset}\fR takes a substring from the zero-based offset to the end; +\fB${VAR:offset:length}\fR specifies a length. +\fB${VAR#pat}\fR and \fB${VAR##pat}\fR remove the shortest and longest +glob-matching prefixes; \fB${VAR%pat}\fR and \fB${VAR%%pat}\fR do the same +for suffixes. +\fB${VAR/pat/rep}\fR replaces the first literal occurrence of \fBpat\fR +with \fBrep\fR; \fB${VAR//pat/rep}\fR replaces all occurrences. .PP Double quotes suppress globbing and word-splitting but allow variable, arithmetic, and command-substitution expansion; single quotes are fully @@ -149,8 +175,12 @@ is rejected, since nshell has no universal-variable store. .SH BUILTINS .B nshell provides the following builtins: +.BR . , +.BR [ , .BR alias , .BR abbr , +.BR agent , +.BR ai , .BR and , .BR bg , .BR bind , @@ -203,10 +233,23 @@ provides the following builtins: Run .B help inside the shell for details. +.SH HISTORY FILE +.I ~/.nshell_history +is created with owner-only permissions. Symlinks, hard links, nonregular files, +and files owned by another user are rejected. +.PP +A malformed or truncated record is reported. Earlier complete records remain +readable, but new records are not appended until the file is moved aside. +Existing bytes are not discarded automatically. +.PP +Use +.B \-\-no\-history +to disable history persistence. .SH ENVIRONMENT .TP .B NSHELL_VI_MODE -When set to a non-empty value, enables vi key bindings (see KEY BINDINGS). +When set to a non-empty value other than 0, false, or no (case-insensitive), +enables vi key bindings. .TP .B NSHELL_GREETING Printed at interactive startup in place of the version banner. An empty value @@ -215,9 +258,9 @@ starts the session silently. Read after the startup file runs, so can set it. .TP .B NSHELL_PROMPT -Sets the left prompt's format string at session start (see -.B prompt -under BUILTINS). A +Sets the left prompt's format string at session start. See +. +A .B prompt left line in .B ~/.nshellrc @@ -229,7 +272,7 @@ As for the right prompt. .TP .B NO_COLOR -When set to any value, disables colored output. +When set to a nonempty value, disables colored output. .TP .B COLORTERM Set to @@ -244,7 +287,7 @@ Used for tilde expansion. .B PATH Searched for external commands. .SH EXAMPLES -Run a one-off pipeline: +Run a one-off command: .RS .EX nshell \-c 'string upper hello' @@ -267,5 +310,3 @@ interactive exit. .BR zsh (1) .SH BUGS Report issues at . -.SH AUTHORS -The nshell authors. diff --git a/nix/patches/cl-boundary-kit-prolog-kit-name.patch b/nix/patches/cl-boundary-kit-prolog-kit-name.patch new file mode 100644 index 00000000..28616080 --- /dev/null +++ b/nix/patches/cl-boundary-kit-prolog-kit-name.patch @@ -0,0 +1,427 @@ +diff --git a/cl-boundary-kit.asd b/cl-boundary-kit.asd +--- a/cl-boundary-kit.asd ++++ b/cl-boundary-kit.asd +@@ -167,7 +167,7 @@ + (:file "examples-runtime-test"))) + (asdf:defsystem "cl-boundary-kit/test-prolog" + :description "Prolog-backed test suite for cl-boundary-kit" +- :depends-on (:cl-boundary-kit/test-base :cl-prolog :cl-prolog/weave) ++ :depends-on (:cl-boundary-kit/test-base :cl-prolog-kit :cl-prolog-kit/weave) + :pathname "t" + :serial t + :components ((:file "prolog-boundary-invariants-test") +diff --git a/t/package.lisp b/t/package.lisp +--- a/t/package.lisp ++++ b/t/package.lisp +@@ -61,7 +61,7 @@ + ,@body))) + + (defun prolog-special-symbol (name) +- (multiple-value-bind (symbol status) (find-symbol name '#:cl-prolog) ++ (multiple-value-bind (symbol status) (find-symbol name '#:cl-prolog-kit) + (when (and status (boundp symbol)) + symbol))) + +@@ -90,7 +90,7 @@ + ()) + + (defun prolog-parser-resource-error-symbol () +- (multiple-value-bind (symbol status) (find-symbol "PROLOG-PARSER-RESOURCE-ERROR" '#:cl-prolog) ++ (multiple-value-bind (symbol status) (find-symbol "PROLOG-PARSER-RESOURCE-ERROR" '#:cl-prolog-kit) + (when status + symbol))) + +@@ -104,7 +104,7 @@ + condition) + + (defun prolog-parser-resource-error-accessor-value (name condition) +- (multiple-value-bind (symbol status) (find-symbol name '#:cl-prolog) ++ (multiple-value-bind (symbol status) (find-symbol name '#:cl-prolog-kit) + (when (and status (fboundp symbol)) + (funcall (symbol-function symbol) condition)))) + +@@ -129,7 +129,7 @@ + ,@body))) + + (defun prolog-condition-symbol (name) +- (multiple-value-bind (symbol status) (find-symbol name '#:cl-prolog) ++ (multiple-value-bind (symbol status) (find-symbol name '#:cl-prolog-kit) + (when status + symbol))) + +diff --git a/t/property-invariants-test.lisp b/t/property-invariants-test.lisp +--- a/t/property-invariants-test.lisp ++++ b/t/property-invariants-test.lisp +@@ -156,7 +156,7 @@ + ("*MAX-PROLOG-SOURCE-CHARACTERS*" 256)) + (handler-case + ;; Parsed within limits: a well-formed term is returned. +- (expect (cl-prolog:read-prolog-term source) :to-be-truthy) ++ (expect (cl-prolog-kit:read-prolog-term source) :to-be-truthy) + (error (condition) + ;; Rejected: the failure is bounded and carries a positive limit. + (assert-prolog-parser-resource-error condition) +diff --git a/t/prolog-advanced-test.lisp b/t/prolog-advanced-test.lisp +--- a/t/prolog-advanced-test.lisp ++++ b/t/prolog-advanced-test.lisp +@@ -1,6 +1,6 @@ + ;;;; t/prolog-advanced-test.lisp + ;;;; +-;;;; Advanced cl-prolog usage: bounded parsing of untrusted policy source, ++;;;; Advanced cl-prolog-kit usage: bounded parsing of untrusted policy source, + ;;;; ISO-conformant rejection of malformed goals, and terminating transitive + ;;;; reasoning over a boundary delegation graph. Split from + ;;;; prolog-boundary-invariants-test.lisp, which holds the trusted-Lisp-data policy +@@ -24,31 +24,31 @@ + ;;; a host can tighten it around any consult of untrusted input. + + (it "untrusted-policy-source-parses-and-answers-queries" +- (let ((policy (cl-prolog:consult-prolog *boundary-policy-source*))) ++ (let ((policy (cl-prolog-kit:consult-prolog *boundary-policy-source*))) +- (expect (cl-prolog:prolog-succeeds-p ++ (expect (cl-prolog-kit:prolog-succeeds-p +- policy (cl-prolog:read-prolog-term "permitted(filesystem, read)")) ++ policy (cl-prolog-kit:read-prolog-term "permitted(filesystem, read)")) + :to-be-truthy) +- (expect (cl-prolog:prolog-succeeds-p ++ (expect (cl-prolog-kit:prolog-succeeds-p +- policy (cl-prolog:read-prolog-term "permitted(filesystem, mutate)")) ++ policy (cl-prolog-kit:read-prolog-term "permitted(filesystem, mutate)")) + :to-be-null))) + + (it "oversized-policy-token-stream-is-rejected-with-a-bounded-error" + (with-optional-first-prolog-special (("*MAX-PROLOG-TOKENS*" 8) + ("*MAX-PROLOG-SOURCE-CHARACTERS*" 8)) + (with-prolog-parser-resource-error (condition) +- (cl-prolog:consult-prolog *boundary-policy-source*) ++ (cl-prolog-kit:consult-prolog *boundary-policy-source*) + condition))) + + (it "deeply-nested-policy-terms-are-rejected-before-stack-exhaustion" + (with-optional-prolog-special ("*MAX-PROLOG-PARSER-DEPTH*" 4) + (with-prolog-parser-resource-error (condition) +- (cl-prolog:read-prolog-term "effect(a(b(c(d(e(f))))))") ++ (cl-prolog-kit:read-prolog-term "effect(a(b(c(d(e(f))))))") + condition))) + + (it "the-parser-resource-error-carries-actionable-diagnostics" + (with-optional-prolog-special ("*MAX-PROLOG-SOURCE-CHARACTERS*" 5) + (with-prolog-parser-resource-error (condition) +- (cl-prolog:read-prolog-term "boundary(filesystem)") ++ (cl-prolog-kit:read-prolog-term "boundary(filesystem)") + (let ((resource (prolog-parser-resource-error-resource-value condition)) + (limit (prolog-parser-resource-error-limit-value condition))) + (when resource +@@ -65,7 +65,7 @@ + (it "prolog-query-boundary-rejects-unbound-goals-with-a-catchable-error" + (handler-case + (progn +- (cl-prolog:query-prolog *boundary-policy* '?goal) ++ (cl-prolog-kit:query-prolog *boundary-policy* '?goal) + (error "Expected unbound Prolog goal to fail")) + (error (condition) + (expect (or (prolog-condition-p condition "PROLOG-INSTANTIATION-ERROR") +@@ -75,7 +75,7 @@ + (it "prolog-query-boundary-rejects-non-callable-goals-before-dispatch" + (handler-case + (progn +- (cl-prolog:query-prolog *boundary-policy* 42) ++ (cl-prolog-kit:query-prolog *boundary-policy* 42) + (error "Expected non-callable Prolog goal to fail")) + (error (condition) + (expect (prolog-condition-p condition "INVALID-GOAL-ERROR") :to-be-truthy)))) +@@ -86,7 +86,7 @@ + ;;; and terminates, where a naive resolution order would diverge. + + (defparameter *boundary-delegation* +- (cl-prolog:prolog ++ (cl-prolog-kit:prolog + ((delegates recording-filesystem buffered-filesystem)) + ((delegates buffered-filesystem native-filesystem)) + ((delegates recording-process native-process)) +@@ -96,7 +96,7 @@ + ((reaches ?a ?b) (delegates ?a ?b))) + "Which concrete boundaries a recording boundary ultimately delegates to.") + +-(cl-prolog/weave:deftest-queries boundary-delegation-reachability-terminates ++(cl-prolog-kit/weave:deftest-queries boundary-delegation-reachability-terminates + (*boundary-delegation*) + ("left-recursive reachability yields the full delegation closure" + (reaches recording-filesystem ?target) :set +@@ -112,7 +112,7 @@ + + (it "tabled-reachability-over-a-cyclic-graph-terminates-and-deduplicates" + (handler-case +- (let ((graph (cl-prolog:consult-prolog ++ (let ((graph (cl-prolog-kit:consult-prolog + " + :- table(reaches/2). + delegates(a, b). +@@ -122,8 +122,8 @@ + reaches(X, Y) :- delegates(X, Z), reaches(Z, Y)."))) + ;; Over the cycle a -> b -> c -> a every node reaches all three nodes, + ;; each exactly once thanks to tabled answer deduplication. +- (expect (= 3 (length (cl-prolog:query-prolog ++ (expect (= 3 (length (cl-prolog-kit:query-prolog +- graph (cl-prolog:read-prolog-term "reaches(a, Y)")))) ++ graph (cl-prolog-kit:read-prolog-term "reaches(a, Y)")))) + :to-be-truthy)) + (error (condition) + (if (prolog-error-message-contains-p condition "Unknown Prolog directive") +@@ -134,23 +134,23 @@ + ;;; non-empty stream of recognized boundary effects. The grammar validates + ;;; the stream declaratively; unknown effects or an empty grant are rejected. + ;;; (Grammar operators like TERMINAL are matched by symbol name, so they stay +-;;; unqualified; DEF-DCG-RULE/MAKE-RULEBASE/PHRASE-ALL are cl-prolog entry ++;;; unqualified; DEF-DCG-RULE/MAKE-RULEBASE/PHRASE-ALL are cl-prolog-kit entry + ;;; points.) + + (defparameter *capability-grammar* +- (cl-prolog:make-rulebase ++ (cl-prolog-kit:make-rulebase +- :clauses (list (cl-prolog:def-dcg-rule effect (terminal :read)) ++ :clauses (list (cl-prolog-kit:def-dcg-rule effect (terminal :read)) +- (cl-prolog:def-dcg-rule effect (terminal :write)) ++ (cl-prolog-kit:def-dcg-rule effect (terminal :write)) +- (cl-prolog:def-dcg-rule effect (terminal :request)) ++ (cl-prolog-kit:def-dcg-rule effect (terminal :request)) +- (cl-prolog:def-dcg-rule effect (terminal :observe)) ++ (cl-prolog-kit:def-dcg-rule effect (terminal :observe)) +- (cl-prolog:def-dcg-rule capability effect) ++ (cl-prolog-kit:def-dcg-rule capability effect) +- (cl-prolog:def-dcg-rule capability effect capability))) ++ (cl-prolog-kit:def-dcg-rule capability effect capability))) + "A DCG whose CAPABILITY rule accepts a non-empty stream of boundary effects.") + + (defun %capability-grant-p (tokens) + "True when TOKENS is fully consumed by the CAPABILITY grammar, i.e. the whole + stream is a well-formed boundary capability grant." +- (and (member nil (cl-prolog:phrase-all *capability-grammar* 'capability tokens) ++ (and (member nil (cl-prolog-kit:phrase-all *capability-grammar* 'capability tokens) + :test #'eq) + t)) + +@@ -171,9 +171,9 @@ + + (it "finite-domain-constraints-enumerate-admissible-boundary-orderings" + (let ((orderings +- (cl-prolog:query-prolog ++ (cl-prolog-kit:query-prolog +- (cl-prolog:make-rulebase) ++ (cl-prolog-kit:make-rulebase) +- (cl-prolog:read-prolog-term ++ (cl-prolog-kit:read-prolog-term + "Fs in [1,2,3], Net in [1,2,3], Proc in [1,2,3], all_different([Fs,Net,Proc]), Fs #< Net, labeling([], [Fs,Net,Proc])")))) + ;; Over distinct priorities in 1..3 with Fs < Net there are exactly three + ;; admissible orderings. +diff --git a/t/prolog-boundary-invariants-test.lisp b/t/prolog-boundary-invariants-test.lisp +--- a/t/prolog-boundary-invariants-test.lisp ++++ b/t/prolog-boundary-invariants-test.lisp +@@ -4,7 +4,7 @@ + (defun %prolog-binding (variable solution) + (cdr (assoc variable solution))) + +-(defparameter *boundary-policy* (cl-prolog:prolog ++(defparameter *boundary-policy* (cl-prolog-kit:prolog + ((boundary filesystem)) + ((boundary environment)) + ((boundary process)) +@@ -29,7 +29,7 @@ + (recordable ?boundary))) + "Facts and rules describing the effect surface of boundary objects.") + +-(cl-prolog/weave:deftest-queries ++(cl-prolog-kit/weave:deftest-queries + prolog-boundary-policy-has-declarative-invariants + (*boundary-policy*) + ("filesystem boundaries permit the expected operations" +@@ -60,7 +60,7 @@ + ;;;; added with a full native/test/recording triad, so they extend the fact + ;;;; base and the expected solution set below rather than introducing new + ;;;; asymmetries. +-(defparameter *boundary-api-completeness* (cl-prolog:prolog ++(defparameter *boundary-api-completeness* (cl-prolog-kit:prolog + ((provides-native filesystem)) + ((provides-native environment)) + ((provides-native process)) +@@ -147,7 +147,7 @@ + "Which native/test/recording constructors each boundary kind actually + exports.") + +-(cl-prolog/weave:deftest-queries ++(cl-prolog-kit/weave:deftest-queries + boundary-api-triads-match-the-documented-asymmetry + (*boundary-api-completeness*) + ("every boundary except clock completes the native/test/recording triad" +@@ -204,56 +204,56 @@ + immediately RETRACT-ing a throwaway fact registers the predicate as dynamic + with an empty extension, so BODY can query it before anything real is + registered without tripping that error." +- (cl-prolog:query-prolog ++ (cl-prolog-kit:query-prolog + policy +- '(cl-prolog:assertz (registered-boundary %seed%))) ++ '(cl-prolog-kit:assertz (registered-boundary %seed%))) +- (cl-prolog:query-prolog ++ (cl-prolog-kit:query-prolog + policy +- '(cl-prolog:assertz (registered-effect %seed% %seed%))) ++ '(cl-prolog-kit:assertz (registered-effect %seed% %seed%))) +- (cl-prolog:query-prolog ++ (cl-prolog-kit:query-prolog + policy +- '(cl-prolog:retract (registered-boundary %seed%))) ++ '(cl-prolog-kit:retract (registered-boundary %seed%))) +- (cl-prolog:query-prolog ++ (cl-prolog-kit:query-prolog + policy +- '(cl-prolog:retract (registered-effect %seed% %seed%))) ++ '(cl-prolog-kit:retract (registered-effect %seed% %seed%))) + (funcall body)) + + (it "runtime-plugin-registration-via-assertz-and-retract-updates-permitted-facts" +- (let ((policy (cl-prolog:extend-rulebase *boundary-policy* ++ (let ((policy (cl-prolog-kit:extend-rulebase *boundary-policy* + ((permitted ?boundary ?operation) + (registered-boundary ?boundary) + (registered-effect ?boundary ?operation))))) + (%call-with-empty-dynamic-registration policy + (lambda () +- (expect (cl-prolog:prolog-succeeds-p policy '(permitted plugin invoke)) ++ (expect (cl-prolog-kit:prolog-succeeds-p policy '(permitted plugin invoke)) + :to-be-null) +- (cl-prolog:query-prolog policy '(cl-prolog:assertz (registered-boundary plugin))) ++ (cl-prolog-kit:query-prolog policy '(cl-prolog-kit:assertz (registered-boundary plugin))) +- (cl-prolog:query-prolog policy '(cl-prolog:assertz (registered-effect plugin invoke))) ++ (cl-prolog-kit:query-prolog policy '(cl-prolog-kit:assertz (registered-effect plugin invoke))) +- (expect (cl-prolog:prolog-succeeds-p policy '(permitted plugin invoke)) ++ (expect (cl-prolog-kit:prolog-succeeds-p policy '(permitted plugin invoke)) + :to-be-truthy) +- (cl-prolog:query-prolog policy '(cl-prolog:retract (registered-effect plugin invoke))) ++ (cl-prolog-kit:query-prolog policy '(cl-prolog-kit:retract (registered-effect plugin invoke))) +- (expect (cl-prolog:prolog-succeeds-p policy '(permitted plugin invoke)) ++ (expect (cl-prolog-kit:prolog-succeeds-p policy '(permitted plugin invoke)) + :to-be-null) + ;; The original shared policy is untouched by mutating its extended copy. +- (expect (cl-prolog:prolog-succeeds-p *boundary-policy* '(boundary plugin)) ++ (expect (cl-prolog-kit:prolog-succeeds-p *boundary-policy* '(boundary plugin)) + :to-be-null))))) + + ;;; Negation as failure: "clock mutation is not permitted" stated as a rule + ;;; (using NOT rather than the :FAILS query kind above) so the restriction is + ;;; itself a declarative fact a query can depend on, not only an assertion a + ;;; test makes about the absence of solutions. +-(defparameter *boundary-policy-with-negation* (cl-prolog:extend-rulebase ++(defparameter *boundary-policy-with-negation* (cl-prolog-kit:extend-rulebase + *boundary-policy* + ((clock-mutation-forbidden) (not (permitted clock mutate))))) + + (it "negation-as-failure-declares-clock-mutation-forbidden" +- (expect (cl-prolog:prolog-succeeds-p ++ (expect (cl-prolog-kit:prolog-succeeds-p + *boundary-policy-with-negation* '(clock-mutation-forbidden)) + :to-be-truthy) + ;; A permitted operation is NOT forbidden -- the negated rule tracks the + ;; underlying PERMITTED facts rather than always succeeding. +- (expect (cl-prolog:prolog-succeeds-p ++ (expect (cl-prolog-kit:prolog-succeeds-p +- (cl-prolog:extend-rulebase *boundary-policy-with-negation* ++ (cl-prolog-kit:extend-rulebase *boundary-policy-with-negation* + ((clock-observation-forbidden) (not (permitted clock observe)))) + '(clock-observation-forbidden)) + :to-be-null)) +@@ -261,25 +261,25 @@ + (it + "prolog-rulebase-extension-is-transactional" + (let ((extended +- (cl-prolog:extend-rulebase ++ (cl-prolog-kit:extend-rulebase + *boundary-policy* + ((effect clock advance)) + ((recordable clock))))) +- (cl-prolog/weave:assert-query ++ (cl-prolog-kit/weave:assert-query + *boundary-policy* + (permitted clock advance) + :fails) +- (cl-prolog/weave:assert-query ++ (cl-prolog-kit/weave:assert-query + *boundary-policy* + (permitted clock ?operation) + :set + (((?operation . observe)))) +- (cl-prolog/weave:assert-query ++ (cl-prolog-kit/weave:assert-query + extended + (permitted clock ?operation) + :set + (((?operation . advance)) ((?operation . observe)))) +- (cl-prolog/weave:assert-query ++ (cl-prolog-kit/weave:assert-query + extended + (observable-effect clock ?operation) + :set +@@ -288,7 +288,7 @@ + (it + "prolog-solutions-stream-through-cps-query-boundary" + (let ((seen '())) +- (cl-prolog:map-prolog-solutions ++ (cl-prolog-kit:map-prolog-solutions + (lambda (solution) + (push (%prolog-binding '?boundary solution) seen)) + *boundary-policy* +@@ -305,7 +305,7 @@ + + (it + "prolog-occurs-check-rejects-cyclic-boundary-facts" +- (expect (null (cl-prolog:unify '?boundary '(wrapped ?boundary))) :to-be-truthy)) ++ (expect (null (cl-prolog-kit:unify '?boundary '(wrapped ?boundary))) :to-be-truthy)) + + ;;; FINDALL: aggregate every declared BOUNDARY/1 fact into one list and + ;;; assert its length, rather than enumerating solutions one at a time the +@@ -318,7 +318,7 @@ + (it + "findall-aggregates-every-declared-boundary-fact-into-one-count" + (let ((policy +- (cl-prolog:consult-prolog ++ (cl-prolog-kit:consult-prolog + "boundary(filesystem). + boundary(environment). + boundary(process). +@@ -328,8 +328,8 @@ + (= + 1 + (length +- (cl-prolog:query-prolog ++ (cl-prolog-kit:query-prolog + policy +- (cl-prolog:read-prolog-term ++ (cl-prolog-kit:read-prolog-term + "findall(B, boundary(B), [filesystem,environment,process,network,clock])")))) + :to-be-truthy))) +diff --git a/docs/src/reference/stability-policy.md b/docs/src/reference/stability-policy.md +--- a/docs/src/reference/stability-policy.md ++++ b/docs/src/reference/stability-policy.md +@@ -1,7 +1,7 @@ + # Documentation Scope + + The public contract is intentionally narrow. The current supported release +-series is `2.2.x`: ++series is `2.3.x`: + + - The exported symbols listed across the [Guide](../guide/composition.md) pages define + the current library surface. +diff --git a/docs/src/project/security.md b/docs/src/project/security.md +--- a/docs/src/project/security.md ++++ b/docs/src/project/security.md +@@ -9,8 +9,8 @@ + + | Version | Supported | + | --- | --- | +-| `2.2.x` | Yes | +-| `< 2.2.0` | No | ++| `2.3.x` | Yes | ++| `< 2.3.0` | No | + + ## Supported Scope + diff --git a/nix/patches/cl-cli-prolog-kit-name.patch b/nix/patches/cl-cli-prolog-kit-name.patch new file mode 100644 index 00000000..f9ded12a --- /dev/null +++ b/nix/patches/cl-cli-prolog-kit-name.patch @@ -0,0 +1,83 @@ +diff --git a/cl-cli.asd b/cl-cli.asd +--- a/cl-cli.asd ++++ b/cl-cli.asd +@@ -137,7 +137,7 @@ + ;; `cl-cli/demo` belongs to the PORTABLE half: it depends on nothing but + ;; `cl-cli`, so t/demo-test.lisp runs under the ECL gate too -- which is the + ;; only thing that would notice the demo growing an SBCL-only form. +- :depends-on ("cl-cli" "cl-cli/demo" "cl-weave" "cl-prolog/weave" "cl-json-kit") ++ :depends-on ("cl-cli" "cl-cli/demo" "cl-weave" "cl-prolog-kit/weave" "cl-json-kit") + :serial t + :components ((:file "t/package") + (:file "t/helpers-fixtures") +diff --git a/t/package.lisp b/t/package.lisp +--- a/t/package.lisp ++++ b/t/package.lisp +@@ -1,10 +1,10 @@ + (defpackage #:cl-cli/test + (:use #:cl #:cl-cli) +- (:import-from #:cl-prolog ++ (:import-from #:cl-prolog-kit + #:assertz + #:make-rulebase + #:query-prolog) +- (:import-from #:cl-prolog/weave ++ (:import-from #:cl-prolog-kit/weave + #:deftest-queries) + (:import-from #:cl-weave + #:assert-mutation-score +diff --git a/t/helpers-support.lisp b/t/helpers-support.lisp +--- a/t/helpers-support.lisp ++++ b/t/helpers-support.lisp +@@ -252,7 +252,7 @@ + (defparameter *prolog-atom-package* (find-package :cl-cli/test) + "Fixed package for interning Prolog atoms. + +-Predicate and atom identity in cl-prolog is symbol identity, so facts must be ++Predicate and atom identity in cl-prolog-kit is symbol identity, so facts must be + interned into the same package the query literals in the test files are read + into (CL-CLI/TESTS). Interning into the volatile *PACKAGE* makes rulebases + non-reproducible: under the CL-USER runtime the suite uses, derived predicates +@@ -266,7 +266,7 @@ + (integer value))) + + (defun prolog-fact (&rest term) +- (cl-prolog:make-clause term)) ++ (cl-prolog-kit:make-clause term)) + + (defun option-atom (option) + (prolog-atom (option-key option))) +@@ -401,12 +401,12 @@ + "The full (predicate . arity) vocabulary the consumer-migration contracts query. + + Kept as an explicit list so the contract surface is documented in one place and +-so absent facts fail cleanly instead of raising cl-prolog's existence_error.") ++so absent facts fail cleanly instead of raising cl-prolog-kit's existence_error.") + + (defun consumer-migration-schema-clauses () + "Declare every contract predicate with a never-succeeding guard clause. + +-cl-prolog raises the ISO existence_error(procedure, Name/Arity) for a query ++cl-prolog-kit raises the ISO existence_error(procedure, Name/Arity) for a query + whose predicate has no clauses at all. A :fails contract such as + \"nshell script stays optional\" (app-positional-required has zero facts when no + positional is required) would therefore error instead of failing. Seeding a +@@ -414,15 +414,15 @@ + mirrors how src/option-relations.lisp declares :requires/:conflicts. The guard + adds no solutions, so :succeeds and :set contracts are unaffected." + (loop for (name arity) in *consumer-migration-contract-predicates* +- collect (cl-prolog:make-clause ++ collect (cl-prolog-kit:make-clause + (cons (prolog-atom (symbol-name name)) + (loop for index below arity + collect (intern (format nil "?G~D" index) + *prolog-atom-package*))) +- (list (list 'cl-prolog:fail))))) ++ (list (list 'cl-prolog-kit:fail))))) + + (defun consumer-migration-rulebase () +- (cl-prolog:make-rulebase ++ (cl-prolog-kit:make-rulebase + :clauses + (append (consumer-migration-schema-clauses) + (mapcan #'app->prolog-clauses diff --git a/nix/patches/cl-cli-zsh-render-cache.patch b/nix/patches/cl-cli-zsh-render-cache.patch new file mode 100644 index 00000000..add9e9bd --- /dev/null +++ b/nix/patches/cl-cli-zsh-render-cache.patch @@ -0,0 +1,238 @@ +--- a/src/completion-renderer-helpers.lisp ++++ b/src/completion-renderer-helpers.lisp +@@ -129,5 +129,14 @@ +-(defun %completion-zsh-option-specs-for-options (options) +- (%completion-option-items-for-options +- options +- #'%completion-recognized-option-names +- #'%completion-zsh-option-spec)) ++(defun %completion-zsh-option-specs-for-options (options &optional cache) ++ (collecting ++ (dolist (option options) ++ (unless (option-hidden-p option) ++ (let ((specs ++ (if cache ++ (or (gethash option cache) ++ (setf (gethash option cache) ++ (%completion-zsh-option-specs-for-specs ++ (list option)))) ++ (%completion-zsh-option-specs-for-specs (list option))))) ++ ;; Do not splice the cached list into a mutable output accumulator. ++ (dolist (spec specs) ++ (collect spec))))))) +@@ -144,5 +153,5 @@ +-(defun %completion-zsh-write-option-specs (stream options variable-name &key app) ++(defun %completion-zsh-write-option-specs (stream options variable-name &key app cache) + (%completion-zsh-write-assignment + stream variable-name +- (append (%completion-zsh-option-specs-for-options options) ++ (append (%completion-zsh-option-specs-for-options options cache) + (when app +--- a/src/completion-renderers-zsh.lisp ++++ b/src/completion-renderers-zsh.lisp +@@ -33,7 +33,8 @@ + stream "subcommand_specs" + (%completion-zsh-command-specs subcommands))) + +-(defun %completion-zsh-write-command-node (stream app command scope-options depth) ++(defun %completion-zsh-write-command-node (stream app command scope-options depth ++ &optional option-cache) + "Write the `NAME) ... ;;' case clause for COMMAND at word index DEPTH directly to STREAM. + + SCOPE-OPTIONS accumulates globals plus every ancestor command's options; a +@@ -50,12 +51,14 @@ + (format stream " ") + (%completion-zsh-write-command-labels stream command) + (format stream ")~%") +- (%completion-zsh-write-option-specs stream options "command_option_specs" :app app) ++ (%completion-zsh-write-option-specs stream options "command_option_specs" ++ :app app :cache option-cache) + (%completion-zsh-render-value-cases options stream) + (when subcommands + (format stream " case \"${words[~A]}\" in~%" child-depth) + (dolist (subcommand subcommands) +- (%completion-zsh-write-command-node stream app subcommand options child-depth)) ++ (%completion-zsh-write-command-node stream app subcommand options child-depth ++ option-cache)) + (format stream " esac~%")) + (format stream " if [[ \"$current_word\" == -* ]]; then~%") + (format stream " _describe 'options' command_option_specs~%") +@@ -80,8 +83,9 @@ + (format stream " return 0~%") + (format stream " ;;~%"))) + +-(defun %completion-zsh-write-command-case-source (stream app command) +- (%completion-zsh-write-command-node stream app command (app-global-options app) 2)) ++(defun %completion-zsh-write-command-case-source (stream app command &optional option-cache) ++ (%completion-zsh-write-command-node stream app command (app-global-options app) 2 ++ option-cache)) + + (defun %completion-zsh-write-positional-fallback (app stream indent) + "Write INDENT-prefixed compadd/_files fallback lines for APP's own +@@ -105,8 +109,9 @@ + With no STREAM, return the completion script as a string. With a STREAM, + write the script to it and return no values." + (ensure-output-stream stream render-zsh-completion app) + (let ((function-name (%completion-function-name app)) +- (app-name (%completion-control-safe-string (app-name app)))) ++ (app-name (%completion-control-safe-string (app-name app))) ++ (option-cache (make-hash-table :test #'eq))) + (format stream "#compdef ~A~%" app-name) + (format stream "~A() {~%" function-name) + (format stream " local current_word previous_word command_word~%") +@@ -124,14 +129,15 @@ + (format stream " command_word=~%") + (format stream " fi~%") + (%completion-zsh-write-command-specs stream app) +- (%completion-zsh-write-option-specs stream (app-global-options app) "option_specs" :app app) ++ (%completion-zsh-write-option-specs stream (app-global-options app) "option_specs" ++ :app app :cache option-cache) + (%completion-zsh-render-value-cases (app-global-options app) stream) + (if (%completion-visible-commands app) + (progn + (format stream " case \"$command_word\" in~%") + (dolist (command (%completion-visible-commands app)) +- (%completion-zsh-write-command-case-source stream app command)) ++ (%completion-zsh-write-command-case-source stream app command option-cache)) + (format stream " *)~%") + (format stream " if [[ \"$current_word\" == -* ]]; then~%") + (format stream " _describe 'options' option_specs~%") + (format stream " return 0~%") +--- a/t/completion-commands-test.lisp ++++ b/t/completion-commands-test.lisp +@@ -193,6 +193,56 @@ + (assert-searches nushell "\"bad value\"" "first seconddone") + (assert-searches elvish "'bad value'"))) + ++ (it "reuses zsh option descriptors only within a render cache" ++ (let* ((option (make-option :name "verbose" :short #\v :kind :flag ++ :description "first:[value]")) ++ (hidden (make-option :name "secret" :kind :flag :hidden-p t)) ++ (options (list option hidden)) ++ (cache (make-hash-table :test #'eq)) ++ (first (cl-cli::%completion-zsh-option-specs-for-options options cache)) ++ (again (cl-cli::%completion-zsh-option-specs-for-options options cache))) ++ (expect (equal first ++ (cl-cli::%completion-option-items-for-options ++ options #'cl-cli::%completion-recognized-option-names ++ #'cl-cli::%completion-zsh-option-spec))) ++ (expect (= 1 (hash-table-count cache))) ++ (expect (= 2 (length first))) ++ (expect (equal first again)) ++ (expect (every #'eq first again)) ++ (expect (equal first (gethash option cache))) ++ (setf (car first) "poison") ++ (expect (not (equal first again))) ++ (expect (equal again (gethash option cache))) ++ (setf (option-description option) "second") ++ (expect (not (equal again ++ (cl-cli::%completion-zsh-option-specs-for-options ++ options (make-hash-table :test #'eq))))))) ++ ++ (it "refreshes zsh descriptors between renders and shares them with child commands" ++ (let* ((option (make-option :name "verbose" :kind :flag :description "before")) ++ (child-option (make-option :name "leaf" :kind :flag)) ++ (parent (make-command :name "parent" ++ :subcommands (list (make-command :name "child" ++ :options (list child-option))))) ++ (app (demo-app :global-options (list option) :commands (list parent))) ++ (cache (make-hash-table :test #'eq)) ++ (before (render-zsh-completion app))) ++ (expect (string= ++ (with-output-to-string (s) ++ (cl-cli::%completion-zsh-write-command-case-source s app parent cache)) ++ (with-output-to-string (s) ++ (cl-cli::%completion-zsh-write-command-case-source s app parent)))) ++ (expect (= 2 (hash-table-count cache))) ++ (expect (gethash child-option cache)) ++ (setf (option-description option) "after") ++ (let ((after (render-zsh-completion app))) ++ (expect (not (string= before after))) ++ (expect (search "--verbose[after]" after)) ++ (expect (not (search "--verbose[before]" after))) ++ (expect (string= after (with-output-to-string (s) ++ (expect (null (multiple-value-list ++ (render-zsh-completion app s)))))))))) ++ + (it "renderers return the script as a string when no stream is given" + (let ((app (demo-app + :global-options (list (make-option :name "verbose" :kind :flag)) +--- a/src/option-relations.lisp ++++ b/src/option-relations.lisp +@@ -92,10 +92,13 @@ + two options that conflict with each other." + (some (lambda (root) +- (let ((reachable (cons root (transitive-required-option-keys graph root)))) ++ (let ((reachable (cons root (transitive-required-option-keys graph root))) ++ (reachable-table (make-hash-table :test #'eql))) ++ (dolist (key reachable) ++ (setf (gethash key reachable-table) t)) + (some (lambda (left) +- (some (lambda (right) +- (member right (gethash left (option-relation-graph-conflicts graph)))) +- reachable)) ++ (some (lambda (conflict) ++ (gethash conflict reachable-table)) ++ (gethash left (option-relation-graph-conflicts graph)))) + reachable))) + keys)) + +--- a/t/option-relations-test.lisp ++++ b/t/option-relations-test.lisp +@@ -330,6 +330,56 @@ + :conflicts-with '(:c)) + (make-option :name "c" :kind :flag))))) + ++ (it "matches pairwise closure validation across fixed-order three-option DAGs and conflict graphs" ++ (let ((keys '(:a :b :c)) ++ (edges '((:a :b) (:a :c) (:b :c))) ++ (checked 0)) ++ (labels ((pairwise-conflict-p (graph roots) ++ (some (lambda (root) ++ (let ((reachable ++ (cons root (cl-cli::transitive-required-option-keys ++ graph root)))) ++ (some (lambda (left) ++ (some (lambda (right) ++ (member right ++ (gethash left ++ (cl-cli::option-relation-graph-conflicts ++ graph)))) ++ reachable)) ++ reachable))) ++ roots))) ++ (dotimes (requires-mask 8) ++ (dotimes (conflicts-mask 8) ++ (let ((graph (cl-cli::%make-option-relation-graph))) ++ (loop for (left right) in edges ++ for bit from 0 ++ do (when (logbitp bit requires-mask) ++ (push right (gethash left ++ (cl-cli::option-relation-graph-requires graph)))) ++ (when (logbitp bit conflicts-mask) ++ (push right (gethash left (cl-cli::option-relation-graph-conflicts graph))) ++ (push left (gethash right (cl-cli::option-relation-graph-conflicts graph))))) ++ (dolist (key keys) ++ (setf (gethash key (cl-cli::option-relation-graph-transitive-requires graph)) ++ (cl-cli::%relation-graph-transitive-requires graph key))) ++ (dolist (roots (cons keys (mapcar #'list keys))) ++ (expect (eql (not (null (pairwise-conflict-p graph roots))) ++ (not (null (cl-cli::%relation-graph-conflicting-closure-p ++ graph roots)))))) ++ (incf checked))))) ++ (expect (= 64 checked)))) ++ ++ (it "preserves eql conflict matching for numeric option keys" ++ (let* ((graph (cl-cli::%make-option-relation-graph)) ++ (reachable-key (parse-integer "1000000000000000000000000000000")) ++ (conflict-key (parse-integer "1000000000000000000000000000000"))) ++ (setf (gethash :a (cl-cli::option-relation-graph-transitive-requires graph)) ++ (list reachable-key) ++ (gethash :a (cl-cli::option-relation-graph-conflicts graph)) ++ (list conflict-key)) ++ (expect (eql reachable-key conflict-key)) ++ (expect (cl-cli::%relation-graph-conflicting-closure-p graph '(:a))))) ++ + (it "keeps each app's cached relation rulebase independent when a command is reused across apps" + ;; COMMAND-SPEC is documented as a reusable, composable object -- the same + ;; instance can be spliced into :COMMANDS for more than one MAKE-APP call. diff --git a/nix/patches/cl-concurrent-kit-cancelled-barrier.patch b/nix/patches/cl-concurrent-kit-cancelled-barrier.patch new file mode 100644 index 00000000..30b2ae92 --- /dev/null +++ b/nix/patches/cl-concurrent-kit-cancelled-barrier.patch @@ -0,0 +1,29 @@ +--- a/src/latch.lisp ++++ b/src/latch.lisp +@@ -133,6 +133,7 @@ + (handler-case + (with-lock-held + ((%barrier-lock barrier)) ++ (when scope (check-cancelled scope)) + (when (%barrier-broken-p barrier) + (error 'barrier-broken :barrier barrier)) + (let ((generation (%barrier-generation barrier)) +--- a/t/latch-test.lisp ++++ b/t/latch-test.lisp +@@ -115,6 +115,16 @@ + (expect cancelled-p :to-be-truthy) + (expect (barrier-broken-p barrier) :to-be-truthy))) + ++ (it "signals TASK-CANCELLED when its SCOPE was cancelled before arrival" ++ (let ((barrier (make-barrier 2)) ++ (scope (cl-concurrent-kit::%make-task-scope))) ++ (cl-concurrent-kit::%scope-cancel scope) ++ (signals task-cancelled (await-barrier barrier :timeout +test-timeout+ :scope scope)) ++ (expect (barrier-broken-p barrier) :to-be-truthy) ++ (expect (barrier-number-waiting barrier) :to-be 0) ++ (signals barrier-broken (await-barrier barrier :timeout +test-timeout+)) ++ (expect (barrier-number-waiting barrier) :to-be 0))) ++ + (it "permits a fresh generation again after RESET-BARRIER" + (let ((barrier (make-barrier 2))) + (signals operation-timed-out (await-barrier barrier :timeout +test-timeout-brief+)) diff --git a/nix/patches/cl-dataflow-kit-writable-snapshot-fixture.patch b/nix/patches/cl-dataflow-kit-writable-snapshot-fixture.patch new file mode 100644 index 00000000..668e33dd --- /dev/null +++ b/nix/patches/cl-dataflow-kit-writable-snapshot-fixture.patch @@ -0,0 +1,47 @@ +--- a/t/graph-export-test.lisp ++++ b/t/graph-export-test.lisp +@@ -14,21 +14,30 @@ + (search "\"a\" -> \"c\"" dot)))))) + + (deftest graph->dot-and-mermaid-match-recorded-snapshots +- ;; Snapshot tests (cl-weave :to-match-snapshot) complement the fragment +- ;; checks above: they catch any unintended change anywhere in the full +- ;; rendered text, not just the substrings asserted elsewhere. Regenerate +- ;; with CL_WEAVE_UPDATE_SNAPSHOTS=1 after an intentional rendering change. +- ;; *SNAPSHOT-DIRECTORY* is bound to an absolute path explicitly: cl-weave +- ;; resolves its default relative location against *DEFAULT-PATHNAME-DEFAULTS*, +- ;; which some invocations of this suite (e.g. a saved executable image) +- ;; leave unbound. ++ ;; Compare the complete rendering with the recorded baseline, never update it. ++ ;; Weave locks beside its snapshot file, so copy it out of read-only sources. ++ (when (cl-weave::snapshot-update-enabled-p) ++ (error "Graph export snapshots are comparison-only.")) + (let ((*snapshot-directory* +- (merge-pathnames #P"__snapshots__/" (asdf:system-source-directory "cl-dataflow-kit/test")))) +- (with-graph-fixture (graph +- ((a "a") (b "b") (c "c")) +- :edges ((a b) (a c))) +- (expect (graph->dot graph :name "flow") :to-match-snapshot "graph-export/dot-basic") +- (expect (graph->mermaid graph :direction "LR") :to-match-snapshot "graph-export/mermaid-basic")))) ++ (uiop:ensure-directory-pathname ++ (uiop:run-program ++ (list "mktemp" "-d" ++ (namestring (merge-pathnames "cl-dataflow-snapshots.XXXXXX" ++ (uiop:temporary-directory)))) ++ :output '(:string :stripped t))))) ++ (unwind-protect ++ (progn ++ (uiop:copy-file ++ (merge-pathnames #P"__snapshots__/snapshots.sexp" ++ (asdf:system-source-directory "cl-dataflow-kit/test")) ++ (merge-pathnames #P"snapshots.sexp" *snapshot-directory*)) ++ (with-graph-fixture (graph ++ ((a "a") (b "b") (c "c")) ++ :edges ((a b) (a c))) ++ (expect (graph->dot graph :name "flow") :to-match-snapshot "graph-export/dot-basic") ++ (expect (graph->mermaid graph :direction "LR") :to-match-snapshot "graph-export/mermaid-basic"))) ++ (uiop:delete-directory-tree *snapshot-directory* ++ :validate t :if-does-not-exist :ignore)))) + + (deftest graph->dot-escapes-quotes-in-names + (with-graph-fixture (graph ((weird "a\"b"))) diff --git a/nix/patches/cl-parser-kit-prolog-kit-name.patch b/nix/patches/cl-parser-kit-prolog-kit-name.patch new file mode 100644 index 00000000..af4138a3 --- /dev/null +++ b/nix/patches/cl-parser-kit-prolog-kit-name.patch @@ -0,0 +1,79 @@ +# Backport the Prolog package-name migration from upstream. +# https://github.com/nerima-lisp/cl-parser-kit/commit/7f9bef4e08df1c0ef15b25c45eb801e5164a6575 +--- a/cl-parser-kit.asd ++++ b/cl-parser-kit.asd +@@ -16,7 +16,7 @@ + :source-control (:git "https://github.com/nerima-lisp/cl-parser-kit.git") + ;; DEPENDENCY_POLICY.md places this package at L1 (general-purpose + ;; utility): the runtime system depends on nothing outside the standard. +- ;; cl-weave and cl-prolog are test-only and belong to cl-parser-kit/test. ++ ;; cl-weave and cl-prolog-kit are test-only and belong to cl-parser-kit/test. + :depends-on () + :pathname "src" + :serial t +@@ -67,7 +67,7 @@ + :homepage "https://github.com/nerima-lisp/cl-parser-kit" + :bug-tracker "https://github.com/nerima-lisp/cl-parser-kit/issues" + :source-control (:git "https://github.com/nerima-lisp/cl-parser-kit.git") +- :depends-on ("cl-parser-kit" "cl-weave" "cl-prolog/weave") ++ :depends-on ("cl-parser-kit" "cl-weave" "cl-prolog-kit/weave") + :pathname "t" + :serial t + :components +--- a/t/prolog-contract-test.lisp ++++ b/t/prolog-contract-test.lisp +@@ -18,21 +18,21 @@ + (ecase fixity + (:prefix + (let ((entry (gethash key (pratt-table-prefixes table)))) +- (cl-prolog:make-clause ++ (cl-prolog-kit:make-clause + `(operator ,key :prefix + ,(cl-parser-kit::pratt-prefix-entry-binding-power entry) + ,(cl-parser-kit::pratt-prefix-entry-binding-power entry)) + nil))) + (:infix + (let ((entry (gethash key (pratt-table-infixes table)))) +- (cl-prolog:make-clause ++ (cl-prolog-kit:make-clause + `(operator ,key :infix + ,(cl-parser-kit::pratt-infix-entry-left-binding-power entry) + ,(cl-parser-kit::pratt-infix-entry-right-binding-power entry)) + nil))) + (:postfix + (let ((entry (gethash key (pratt-table-postfixes table)))) +- (cl-prolog:make-clause ++ (cl-prolog-kit:make-clause + `(operator ,key :postfix + ,(cl-parser-kit::pratt-postfix-entry-binding-power entry) + ,(cl-parser-kit::pratt-postfix-entry-binding-power entry)) +@@ -47,12 +47,12 @@ + (%pratt-operator-clause table :bang :postfix))) + (contract-clauses + (list +- (cl-prolog:make-clause '(associativity :plus :left) nil) ++ (cl-prolog-kit:make-clause '(associativity :plus :left) nil) +- (cl-prolog:make-clause '(associativity :star :left) nil) ++ (cl-prolog-kit:make-clause '(associativity :star :left) nil) +- (cl-prolog:make-clause '(precedence-edge :bang :star) nil) ++ (cl-prolog-kit:make-clause '(precedence-edge :bang :star) nil) +- (cl-prolog:make-clause '(precedence-edge :star :plus) nil)))) ++ (cl-prolog-kit:make-clause '(precedence-edge :star :plus) nil)))) + (let ((rulebase +- (cl-prolog:prolog ++ (cl-prolog-kit:prolog + ((higher-priority ?higher ?lower) + (precedence-edge ?higher ?lower)) + ((higher-priority ?higher ?lower) +@@ -62,9 +62,9 @@ + (operator ?operator :infix ?left-binding ?right-binding) + (associativity ?operator :left))))) + (dolist (clause (append operator-clauses contract-clauses) rulebase) +- (cl-prolog:rulebase-insert-clause! rulebase clause))))) ++ (cl-prolog-kit:rulebase-insert-clause! rulebase clause))))) + +-(cl-prolog/weave:deftest-queries pratt-relational-contracts ++(cl-prolog-kit/weave:deftest-queries pratt-relational-contracts + ((%make-pratt-contract-rulebase)) + ("projects the registered Pratt table as relational data" + (operator ?operator ?fixity ?left ?right) diff --git a/nix/patches/cl-process-kit-enable-linux-tests.patch b/nix/patches/cl-process-kit-enable-linux-tests.patch new file mode 100644 index 00000000..6f230e87 --- /dev/null +++ b/nix/patches/cl-process-kit-enable-linux-tests.patch @@ -0,0 +1,81 @@ +--- a/t/spawn-test.lisp ++++ b/t/spawn-test.lisp +@@ -73,6 +73,1 @@ +- #+linux +- (cl-weave:it-skip +- "rejects a concurrent communicate while capture is in progress" +- "flaky under CI contention: asserts group death within a 0.1s grace period (see release notes)") +- #-linux + (it "rejects a concurrent communicate while capture is in progress" +@@ -157,6 +152,1 @@ +- #+linux +- (cl-weave:it-skip +- "kills descendants after the process-group leader exits on TERM" +- "flaky under CI contention: asserts group death within a 0.1s grace period (see release notes)") +- #-linux + (it "kills descendants after the process-group leader exits on TERM" +@@ -181,6 +171,1 @@ +- #+linux +- (cl-weave:it-skip +- "does not publicly signal a group after its leader is terminal" +- "flaky under CI contention: asserts group death within a 0.1s grace period (see release notes)") +- #-linux + (it "does not publicly signal a group after its leader is terminal" +@@ -196,6 +181,1 @@ +- #+linux +- (cl-weave:it-skip +- "provides distinct leader and group signal operations" +- "flaky under CI contention: asserts group death within a 0.1s grace period (see release notes)") +- #-linux + (it "provides distinct leader and group signal operations" +@@ -217,6 +197,1 @@ +- #+linux +- (cl-weave:it-skip +- "close-process cleans descendants more than five seconds after their leader exits" +- "flaky under CI contention: asserts group death within a 0.1s grace period (see release notes)") +- #-linux + (it "close-process cleans descendants more than five seconds after their leader exits" +--- a/t/async-task-test.lisp ++++ b/t/async-task-test.lisp +@@ -8,6 +8,1 @@ +- #+linux +- (cl-weave:it-skip +- "communicate-async reports overflow without losing the terminal event" +- "flaky under CI contention: asserts group death within a 0.1s grace period (see release notes)") +- #-linux + (it "communicate-async reports overflow without losing the terminal event" +@@ -56,6 +51,1 @@ +- #+linux +- (cl-weave:it-skip +- "cancels blocked asynchronous output without failing the task" +- "flaky under CI contention: asserts group death within a 0.1s grace period (see release notes)") +- #-linux + (it "cancels blocked asynchronous output without failing the task" +--- a/t/package.lisp ++++ b/t/package.lisp +@@ -20,23 +20,10 @@ + + (in-package #:cl-process-kit/test) + + (defparameter +suite-complete-p+ +- (not #+linux t #-linux nil) +- "True when every test in the suite actually runs on this platform. +- +-False on Linux, where seven process-group/cancellation cases are `it-skip`ped +-under `#+linux`: each asserts that a process group is gone within a 0.1s grace +-period, which a contended shared CI runner cannot reliably deliver. They are +-skipped rather than given more headroom because a timing assertion loose +-enough to survive arbitrary contention no longer asserts the timing. +- +-`run-tests.lisp` consults this before enforcing its coverage ratchet. A floor +-set from a complete run is not a meaningful bound on a run that skipped part +-of the suite -- comparing the two is a category error, and it is what failed +-CI on every Linux build before 1.0.0: the floor tracked the macOS figure +-while CI measured the reduced Linux one and reported a \"regression\" that was +-only ever the missing tests.") ++ t ++ "The pinned suite executes every test on both supported platforms.") + + (defun run-tests () + (unless (run-all :reporter :spec) + (error "cl-process-kit test suite failed")) diff --git a/nix/patches/cl-process-kit-no-duplicate-monotonic-seconds.patch b/nix/patches/cl-process-kit-no-duplicate-monotonic-seconds.patch index c7b48f48..c47d625e 100644 --- a/nix/patches/cl-process-kit-no-duplicate-monotonic-seconds.patch +++ b/nix/patches/cl-process-kit-no-duplicate-monotonic-seconds.patch @@ -8,3 +8,13 @@ - (/ (get-internal-real-time) internal-time-units-per-second)) - (defun %timeval-parts (seconds) +--- a/src/communicate.lisp ++++ b/src/communicate.lisp +@@ -154,5 +154,5 @@ +- (unless (process-handle-reaped-p process) +- (sb-ext:process-wait (%handle-raw-process process))) ++ ;; Share the state lock with the cancellation watcher's reaper. ++ (process-wait process :poll-interval poll-interval) + (when (and (boundp '*current-cancellation-token*) + (symbol-value '*current-cancellation-token*) + (cancellation-requested-p (symbol-value '*current-cancellation-token*))) diff --git a/nix/patches/cl-process-kit-wait-for-timeout-group.patch b/nix/patches/cl-process-kit-wait-for-timeout-group.patch new file mode 100644 index 00000000..3295f8ca --- /dev/null +++ b/nix/patches/cl-process-kit-wait-for-timeout-group.patch @@ -0,0 +1,190 @@ +--- a/src/communicate.lisp ++++ b/src/communicate.lisp +@@ -153,6 +153,16 @@ + (ignore-errors (%close-stream-for-copier stdin-stream stdin-feeder))) + ;; Share the state lock with the cancellation watcher's reaper. + (process-wait process :poll-interval poll-interval) ++ ;; Reaping the leader does not wait for SIGKILL delivery to its ++ ;; descendants. Cleanup uses real time even with an injected clock. ++ (when (and timed-out-p ++ (not (%wait-until-process-group-gone process grace-period))) ++ (let ((condition ++ (make-condition 'process-io-error :stream :cleanup ++ :cause "Owned process group remained alive after timeout cleanup."))) ++ (with-locked-process-state (state process) ++ (setf (%process-state-communication-cleanup-error state) condition)) ++ (error condition))) + (when (and (boundp '*current-cancellation-token*) + (symbol-value '*current-cancellation-token*) + (cancellation-requested-p (symbol-value '*current-cancellation-token*))) +--- a/src/process-handle.lisp ++++ b/src/process-handle.lisp +@@ -17,6 +17,7 @@ + result + communication-result + communication-contract ++ communication-cleanup-error + communication-reservation-owner + (communication-status :idle) + (status :running) +--- a/src/communication-state.lisp ++++ b/src/communication-state.lisp +@@ -69,20 +69,25 @@ + :expected-options ,expected :actual-options ,actual))) + + (defun %reserve-communication (process contract owner) +- (with-locked-process-state (state process) +- (let ((expected (%process-state-communication-contract state))) +- (case (%process-state-communication-status state) +- (:communicated +- (%check-contract-match process expected contract) +- :cached) +- (:idle +- (setf (%process-state-communication-contract state) contract +- (%process-state-communication-reservation-owner state) owner +- (%process-state-communication-status state) :reserved) +- :reserved) +- (otherwise +- (%check-contract-match process expected contract) +- (error "COMMUNICATE is already in progress for this process.")))))) ++ (multiple-value-bind (result cleanup-error) ++ (with-locked-process-state (state process) ++ (if (%process-state-communication-cleanup-error state) ++ (values nil (%process-state-communication-cleanup-error state)) ++ (let ((expected (%process-state-communication-contract state))) ++ (case (%process-state-communication-status state) ++ (:communicated ++ (%check-contract-match process expected contract) ++ :cached) ++ (:idle ++ (setf (%process-state-communication-contract state) contract ++ (%process-state-communication-reservation-owner state) owner ++ (%process-state-communication-status state) :reserved) ++ :reserved) ++ (otherwise ++ (%check-contract-match process expected contract) ++ (error "COMMUNICATE is already in progress for this process.")))))) ++ (when cleanup-error (error cleanup-error)) ++ result)) + + (defun %release-communication-reservation (process owner) + (with-locked-process-state (state process) +@@ -104,27 +109,32 @@ + input timeout grace-period timeout-signal kill-signal on-timeout + max-output-characters drain-timeout-seconds result-type external-format + decoding-error-policy clock sleeper poll-interval))) +- (with-locked-process-state (state process) +- (let ((expected-contract (%process-state-communication-contract state))) +- (case (%process-state-communication-status state) +- (:communicated +- (%check-contract-match process expected-contract actual-contract) +- (%process-state-communication-result state)) +- (:reserved +- (%check-contract-match process expected-contract actual-contract) +- (unless (eq (%process-state-communication-reservation-owner state) +- *communication-reservation-owner*) +- (error "COMMUNICATE is already reserved for this process.")) +- (setf (%process-state-communication-status state) :communicating +- (%process-state-communication-reservation-owner state) nil) +- nil) +- (:communicating +- (%check-contract-match process expected-contract actual-contract) +- (error "COMMUNICATE is already in progress for this process.")) +- (otherwise +- (setf (%process-state-communication-contract state) actual-contract +- (%process-state-communication-status state) :communicating) +- nil)))))) ++ (multiple-value-bind (result cleanup-error) ++ (with-locked-process-state (state process) ++ (if (%process-state-communication-cleanup-error state) ++ (values nil (%process-state-communication-cleanup-error state)) ++ (let ((expected-contract (%process-state-communication-contract state))) ++ (case (%process-state-communication-status state) ++ (:communicated ++ (%check-contract-match process expected-contract actual-contract) ++ (%process-state-communication-result state)) ++ (:reserved ++ (%check-contract-match process expected-contract actual-contract) ++ (unless (eq (%process-state-communication-reservation-owner state) ++ *communication-reservation-owner*) ++ (error "COMMUNICATE is already reserved for this process.")) ++ (setf (%process-state-communication-status state) :communicating ++ (%process-state-communication-reservation-owner state) nil) ++ nil) ++ (:communicating ++ (%check-contract-match process expected-contract actual-contract) ++ (error "COMMUNICATE is already in progress for this process.")) ++ (otherwise ++ (setf (%process-state-communication-contract state) actual-contract ++ (%process-state-communication-status state) :communicating) ++ nil))))) ++ (when cleanup-error (error cleanup-error)) ++ result))) + + (defun %abort-communication (process) + (with-locked-process-state (state process) +--- a/t/run-timeout-test.lisp ++++ b/t/run-timeout-test.lisp +@@ -27,6 +27,62 @@ + :sleep-fn (lambda (seconds) (declare (ignore seconds)) (incf (car counter)) nil))) + + (describe "run timeout and signal escalation" ++ (it "confirms group termination after reaping a timed-out leader" ++ (let ((waits nil)) ++ (with-process (process (spawn "/bin/sh" (list "-c" "sleep 5") ++ :output :stream :error :stream)) ++ (with-mocked-functions ++ (((symbol-function 'process-kit::%wait-until-process-group-gone) ++ (lambda (owned-process timeout) ++ (push (list owned-process timeout) waits) ++ t))) ++ (expect (communicate process :timeout 0.05 :grace-period 0.05 ++ :on-timeout :return) ++ :to-have-timed-out)) ++ (expect (length waits) :to-be 1) ++ (expect (caar waits) :to-be process) ++ (expect (cadar waits) :to-be 0.05)))) ++ ++ (it "reports incomplete group cleanup instead of caching a timeout result" ++ (let ((waits 0) ++ (failure nil)) ++ (with-process (process (spawn "/bin/sh" (list "-c" "sleep 5") ++ :output :stream :error :stream)) ++ (with-mocked-functions ++ (((symbol-function 'process-kit::%wait-until-process-group-gone) ++ (lambda (owned-process timeout) ++ (declare (ignore owned-process timeout)) ++ (incf waits) ++ nil))) ++ (handler-case ++ (communicate process :timeout 0.05 :grace-period 0.05 :on-timeout :return) ++ (process-io-error (condition) (setf failure condition)))) ++ (expect waits :to-be 1) ++ (expect (typep failure 'process-io-error) :to-be-truthy) ++ (expect (process-io-error-stream failure) :to-be :cleanup) ++ (process-kit::with-locked-process-state (state process) ++ (expect (process-kit::%process-state-communication-result state) :to-be nil)) ++ (dolist (retry (list (lambda () ++ (communicate process :timeout 0.05 :grace-period 0.05 ++ :on-timeout :return)) ++ (lambda () ++ (process-kit::%reserve-communication process nil :retry)))) ++ (let ((observed nil)) ++ (expect (handler-case ++ (handler-bind ++ ((process-io-error ++ (lambda (condition) ++ (process-kit::with-locked-process-state (state process) ++ (expect (process-kit::%process-state-communication-result state) ++ :to-be nil)) ++ (setf observed condition)))) ++ (funcall retry)) ++ (process-io-error (condition) condition)) ++ :to-be failure) ++ (expect observed :to-be failure))) ++ (process-kit::with-locked-process-state (state process) ++ (expect (process-kit::%process-state-communication-result state) :to-be nil))))) ++ + (it "run with on-timeout :return sets timed-out-p on a real timeout" + (let ((result (run "/bin/sh" (list "-c" "sleep 5") + :timeout 0.2 :grace-period 0.1 :on-timeout :return))) diff --git a/nix/patches/cl-tty-kit-prolog-kit-name.patch b/nix/patches/cl-tty-kit-prolog-kit-name.patch new file mode 100644 index 00000000..0064b4c6 --- /dev/null +++ b/nix/patches/cl-tty-kit-prolog-kit-name.patch @@ -0,0 +1,328 @@ +# Backport the Prolog package-name migration from upstream. +# https://github.com/nerima-lisp/cl-tty-kit/commit/2ee564efbc32c629b2597094fe2d790b40e96da0 +--- a/cl-tty-kit.asd ++++ b/cl-tty-kit.asd +@@ -6,9 +6,9 @@ + ;;; See PACKAGE_STANDARD.md "asd の書き方". + (in-package #:asdf-user) + +-;; nerima-lisp/cl-prolog and nerima-lisp/cl-weave (see docs/src/guide/logic-engine.md ++;; nerima-lisp/cl-prolog-kit and nerima-lisp/cl-weave (see docs/src/guide/logic-engine.md + ;; and t/sgr-prolog-oracle-test.lisp) are both used only by :CL-TTY-KIT/TEST below -- +-;; cl-prolog as a differential-testing oracle cross-checking the hand-written ++;; cl-prolog-kit as a differential-testing oracle cross-checking the hand-written + ;; SGR/CSI decoders, cl-weave as the test framework -- never by :CL-TTY-KIT + ;; itself; those two stay test-only regardless of what :CL-TTY-KIT's own + ;; :DEPENDS-ON grows to (see the note on its :DEPENDS-ON below). Neither is +@@ -150,7 +150,7 @@ + :bug-tracker "https://github.com/nerima-lisp/cl-tty-kit/issues" + :source-control (:git "https://github.com/nerima-lisp/cl-tty-kit.git") + :serial t +- :depends-on (#:cl-tty-kit #:cl-prolog #:cl-weave) ++ :depends-on (#:cl-tty-kit #:cl-prolog-kit #:cl-weave) + :components ((:file "t/package") + (:file "t/helpers-package-data") + (:file "t/suite") +--- a/t/helpers-prolog-cases.lisp ++++ b/t/helpers-prolog-cases.lisp +@@ -4,11 +4,11 @@ + ;;; actual test files small and lets the suite enumerate behaviors one by one. + ;;; + ;;; AND/OR/NOT/= are ordinary Common Lisp symbols inherited from #:CL, so they +-;;; dispatch to nerima-lisp/cl-prolog's builtins from any package without ++;;; dispatch to nerima-lisp/cl-prolog-kit's builtins from any package without +-;;; qualification. CALL/FINDALL/TRUE/FAIL are cl-prolog-specific exports with no ++;;; qualification. CALL/FINDALL/TRUE/FAIL are cl-prolog-kit-specific exports with no + ;;; CL equivalent, so a bare (unqualified) symbol of that name read in this file +-;;; is a different symbol than CL-PROLOG:CALL and the engine reports the goal as ++;;; is a different symbol than CL-PROLOG-KIT:CALL and the engine reports the goal as +-;;; an undefined procedure -- these four are written CL-PROLOG:CALL etc. ++;;; an undefined procedure -- these four are written CL-PROLOG-KIT:CALL etc. + ;;; throughout. + + (defparameter +prolog-query-cases+ +@@ -26,7 +26,7 @@ + "an unprovable goal yields no solutions"))) + + (defparameter +prolog-primitive-cases+ +- '((cl-prolog:prolog-succeeds-p ++ '((cl-prolog-kit:prolog-succeeds-p + (ancestor abraham joseph) + t + "provable-p reports a reachable relation") +@@ -47,19 +47,19 @@ + (jacob joseph) + "disjunction enumerates the solutions of each branch in order") + (%solve-variable +- (cl-prolog:call (ancestor abraham ?x)) ++ (cl-prolog-kit:call (ancestor abraham ?x)) + (isaac jacob joseph) + "call/1 proves a goal term like an ordinary relation") + (%solve-result +- (cl-prolog:findall ?a (ancestor ?a joseph) ?result) ++ (cl-prolog-kit:findall ?a (ancestor ?a joseph) ?result) + ((jacob abraham isaac)) + "findall/3 aggregates every solution into a single list in proof order") + (%solve-result +- (cl-prolog:findall ?x (parent joseph ?x) ?result) ++ (cl-prolog-kit:findall ?x (parent joseph ?x) ?result) + (()) + "findall/3 yields the empty list when the goal has no proof") + (%not-provable-p +- (cl-prolog:fail) ++ (cl-prolog-kit:fail) + t + "fail/0 never succeeds") + (%not-provable-p +@@ -70,11 +70,11 @@ + (= abraham isaac) + t + "the = primitive fails when its arguments don't unify") +- (cl-prolog:prolog-succeeds-p ++ (cl-prolog-kit:prolog-succeeds-p +- (cl-prolog:true) ++ (cl-prolog-kit:true) + t + "true/0 always succeeds") + (%not-provable-p +- (cl-prolog:findall ?x (parent abraham ?x) (mismatch)) ++ (cl-prolog-kit:findall ?x (parent abraham ?x) (mismatch)) + t + "findall/3 fails when RESULT doesn't unify with the collected items"))) +--- a/t/helpers-prolog.lisp ++++ b/t/helpers-prolog.lisp +@@ -1,7 +1,7 @@ + (in-package #:cl-tty-kit/test) + + (defun %genealogy-db () +- (cl-prolog:prolog ++ (cl-prolog-kit:prolog + ((parent abraham isaac)) + ((parent isaac jacob)) + ((parent jacob joseph)) +@@ -9,15 +9,15 @@ + ((ancestor ?a ?b) (parent ?a ?c) (ancestor ?c ?b)))) + + (defun %many-solutions-db () +- (cl-prolog:prolog ++ (cl-prolog-kit:prolog + ((value one)) + ((value two)) + ((value three)))) + + (defun %project-variable (database goal variable) + "Return VARIABLE's binding from every solution of GOAL against DATABASE." +- (mapcar (lambda (solution) (cl-prolog:solution-binding variable solution)) ++ (mapcar (lambda (solution) (cl-prolog-kit:solution-binding variable solution)) +- (cl-prolog:query-prolog database goal))) ++ (cl-prolog-kit:query-prolog database goal))) + + (defun %normalize-solutions (solutions) + (sort (copy-list solutions) +@@ -33,7 +33,7 @@ + (expect actual :to-equal expected)))) + + (defun %not-provable-p (database goal) +- (not (cl-prolog:prolog-succeeds-p database goal))) ++ (not (cl-prolog-kit:prolog-succeeds-p database goal))) + + (defun %solve-variable (database goal) + (%project-variable database goal '?x)) +--- a/t/prolog-db-test.lisp ++++ b/t/prolog-db-test.lisp +@@ -1,6 +1,6 @@ + (in-package #:cl-tty-kit/test) + +-;;; cl-prolog's rulebase is an immutable value by default (see the Rule DSL ++;;; cl-prolog-kit's rulebase is an immutable value by default (see the Rule DSL + ;;; docs on EXTEND-RULEBASE) rather than the retired hand-rolled engine's + ;;; mutable clause-db, so the invariants worth checking here are different: + ;;; functional extension leaves the base untouched, and an undefined relation +@@ -8,25 +8,25 @@ + + (describe "extend-rulebase" + (it "leaves the base rulebase unaffected" +- (let* ((base (cl-prolog:prolog ((color apple red))))) ++ (let* ((base (cl-prolog-kit:prolog ((color apple red))))) +- (cl-prolog:extend-rulebase base ((color lime green))) ++ (cl-prolog-kit:extend-rulebase base ((color lime green))) +- (expect (mapcar (lambda (solution) (cl-prolog:solution-binding '?color solution)) ++ (expect (mapcar (lambda (solution) (cl-prolog-kit:solution-binding '?color solution)) +- (cl-prolog:query-prolog base '(color apple ?color))) ++ (cl-prolog-kit:query-prolog base '(color apple ?color))) + :to-equal '(red)))) + (it "sees its own additional clauses" +- (let* ((base (cl-prolog:prolog ((color apple red)))) ++ (let* ((base (cl-prolog-kit:prolog ((color apple red)))) +- (extended (cl-prolog:extend-rulebase base ((color lime green))))) ++ (extended (cl-prolog-kit:extend-rulebase base ((color lime green))))) +- (expect (mapcar (lambda (solution) (cl-prolog:solution-binding '?color solution)) ++ (expect (mapcar (lambda (solution) (cl-prolog-kit:solution-binding '?color solution)) +- (cl-prolog:query-prolog extended '(color lime ?color))) ++ (cl-prolog-kit:query-prolog extended '(color lime ?color))) + :to-equal '(green)))) + (it "also sees the base's clauses" +- (let* ((base (cl-prolog:prolog ((color apple red)))) ++ (let* ((base (cl-prolog-kit:prolog ((color apple red)))) +- (extended (cl-prolog:extend-rulebase base ((color lime green))))) ++ (extended (cl-prolog-kit:extend-rulebase base ((color lime green))))) +- (expect (mapcar (lambda (solution) (cl-prolog:solution-binding '?color solution)) ++ (expect (mapcar (lambda (solution) (cl-prolog-kit:solution-binding '?color solution)) +- (cl-prolog:query-prolog extended '(color apple ?color))) ++ (cl-prolog-kit:query-prolog extended '(color apple ?color))) + :to-equal '(red))))) + + (describe "an undefined relation" + (it "signals a catchable prolog-existence-error instead of failing silently" +- (expect (lambda () (cl-prolog:query-prolog (%genealogy-db) '(no-such-relation abraham))) ++ (expect (lambda () (cl-prolog-kit:query-prolog (%genealogy-db) '(no-such-relation abraham))) +- :to-throw 'cl-prolog:prolog-existence-error))) ++ :to-throw 'cl-prolog-kit:prolog-existence-error))) +--- a/t/prolog-primitives-test.lisp ++++ b/t/prolog-primitives-test.lisp +@@ -6,26 +6,26 @@ + (it description + (expect (funcall predicate (%genealogy-db) goal) :to-equal expected)))) + ;; Unlike the retired engine's hand-written primitives (which reported "expects +- ;; N arguments" for a wrong arity), cl-prolog's builtins are registered per ++ ;; N arguments" for a wrong arity), cl-prolog-kit's builtins are registered per + ;; exact predicate indicator: a name called at an arity it does not support + ;; denotes a different, undefined procedure and signals the catchable ISO + ;; PROLOG-EXISTENCE-ERROR, same as calling any other undefined relation. + (it "a wrong-arity findall call signals prolog-existence-error" + (let ((db (%genealogy-db))) +- (expect (lambda () (cl-prolog:query-prolog db (list 'cl-prolog:findall '?x '(parent ?x ?y)))) ++ (expect (lambda () (cl-prolog-kit:query-prolog db (list 'cl-prolog-kit:findall '?x '(parent ?x ?y)))) +- :to-throw 'cl-prolog:prolog-existence-error))) ++ :to-throw 'cl-prolog-kit:prolog-existence-error))) + (it "a wrong-arity = call signals prolog-existence-error" +- (expect (lambda () (cl-prolog:query-prolog (%genealogy-db) '(= ?x))) ++ (expect (lambda () (cl-prolog-kit:query-prolog (%genealogy-db) '(= ?x))) +- :to-throw 'cl-prolog:prolog-existence-error)) ++ :to-throw 'cl-prolog-kit:prolog-existence-error)) + (it "a wrong-arity true call signals prolog-existence-error" +- (expect (lambda () (cl-prolog:query-prolog (%genealogy-db) (list 'cl-prolog:true 'extra))) ++ (expect (lambda () (cl-prolog-kit:query-prolog (%genealogy-db) (list 'cl-prolog-kit:true 'extra))) +- :to-throw 'cl-prolog:prolog-existence-error)) ++ :to-throw 'cl-prolog-kit:prolog-existence-error)) + ;; CALL/N is ISO meta-call: extra arguments are appended to the inner goal + ;; rather than making CALL itself arity-mismatched, so (call G extra) proves + ;; G with one more argument -- here PARENT/3, which the rulebase never + ;; defines, so it still signals PROLOG-EXISTENCE-ERROR, just against PARENT. + (it "call/n appends its extra argument to the inner goal" + (expect (lambda () +- (cl-prolog:query-prolog (%genealogy-db) ++ (cl-prolog-kit:query-prolog (%genealogy-db) +- (list 'cl-prolog:call '(parent abraham isaac) 'extra))) ++ (list 'cl-prolog-kit:call '(parent abraham isaac) 'extra))) +- :to-throw 'cl-prolog:prolog-existence-error))) ++ :to-throw 'cl-prolog-kit:prolog-existence-error))) +--- a/t/prolog-queries-test.lisp ++++ b/t/prolog-queries-test.lisp +@@ -5,32 +5,32 @@ + (destructuring-bind (goal template expected description &key set-p) case + (it description + (%check-query (%genealogy-db) goal template expected :set-p set-p)))) +- ;; NOTE: unlike cl-tty-kit's retired hand-rolled engine, cl-prolog does not ++ ;; NOTE: unlike cl-tty-kit's retired hand-rolled engine, cl-prolog-kit does not + ;; proactively guard against a directly self-referential (circular) host + ;; goal term at the query level -- QUERY-PROLOG hangs rather than signaling, + ;; so that case is intentionally not exercised here. Only pass well-formed, + ;; finite goal terms to QUERY-PROLOG/PROLOG-SUCCEEDS-P. + (it "signals prolog-depth-limit-exceeded on an infinite goal past max-depth" +- (let ((db (cl-prolog:prolog ((loop ?x) (loop (s ?x)))))) ++ (let ((db (cl-prolog-kit:prolog ((loop ?x) (loop (s ?x)))))) +- (expect (lambda () (cl-prolog:query-prolog db '(loop ?x) :max-depth 5)) ++ (expect (lambda () (cl-prolog-kit:query-prolog db '(loop ?x) :max-depth 5)) +- :to-throw 'cl-prolog:prolog-depth-limit-exceeded))) ++ :to-throw 'cl-prolog-kit:prolog-depth-limit-exceeded))) + (it "signals invalid-max-depth-error with the offending value for a negative max-depth" + (expect (lambda () +- (cl-prolog:prolog-succeeds-p (%genealogy-db) '(parent abraham isaac) ++ (cl-prolog-kit:prolog-succeeds-p (%genealogy-db) '(parent abraham isaac) + :max-depth -1)) + :to-throw + (lambda (condition) +- (and (typep condition 'cl-prolog:invalid-max-depth-error) ++ (and (typep condition 'cl-prolog-kit:invalid-max-depth-error) +- (= -1 (cl-prolog:invalid-max-depth-error-value condition)))))) ++ (= -1 (cl-prolog-kit:invalid-max-depth-error-value condition)))))) +- ;; Unlike the retired engine's hard "result limit" budget, cl-prolog's :LIMIT ++ ;; Unlike the retired engine's hard "result limit" budget, cl-prolog-kit's :LIMIT + ;; is a benign cap: querying for more solutions than exist under a :LIMIT + ;; simply returns what was found, with no error. + (it ":limit truncates instead of erroring" +- (expect (mapcar (lambda (solution) (cl-prolog:solution-binding '?x solution)) ++ (expect (mapcar (lambda (solution) (cl-prolog-kit:solution-binding '?x solution)) +- (cl-prolog:query-prolog (%many-solutions-db) '(value ?x) :limit 2)) ++ (cl-prolog-kit:query-prolog (%many-solutions-db) '(value ?x) :limit 2)) + :to-equal '(one two))) + (it "signals type-error with the offending value for a negative limit" +- (expect (lambda () (cl-prolog:query-prolog (%many-solutions-db) '(value ?x) :limit -1)) ++ (expect (lambda () (cl-prolog-kit:query-prolog (%many-solutions-db) '(value ?x) :limit -1)) + :to-throw + (lambda (condition) + (and (typep condition 'type-error) +--- a/t/prolog-unification-test.lisp ++++ b/t/prolog-unification-test.lisp +@@ -3,24 +3,24 @@ + (describe "unify" + (it "unifies a shared free variable across two terms" + (flet ((unified (left right) +- (multiple-value-bind (env ok) (cl-prolog:unify left right) ++ (multiple-value-bind (env ok) (cl-prolog-kit:unify left right) +- (and ok (cl-prolog:logic-substitute left env))))) ++ (and ok (cl-prolog-kit:logic-substitute left env))))) + (expect (unified '(?x b) '(a ?y)) :to-equal '(a b)) + (expect (unified '(?x ?x) '(a a)) :to-equal '(a a)))) + (it "rejects binding one variable to two distinct constants" +- (multiple-value-bind (env ok) (cl-prolog:unify '(?x ?x) '(a b)) ++ (multiple-value-bind (env ok) (cl-prolog-kit:unify '(?x ?x) '(a b)) + (declare (ignore env)) + (expect (not ok)))) + (it "the occurs check rejects an infinite term" +- (multiple-value-bind (env ok) (cl-prolog:unify '?x '(f ?x)) ++ (multiple-value-bind (env ok) (cl-prolog-kit:unify '?x '(f ?x)) + (declare (ignore env)) + (expect (not ok)))) + (it "a circular host term fails unification instead of looping" + ;; A directly circular host cons -- built by hand, never through the reader + ;; or the engine's own construction -- unifies safely rather than looping or +- ;; erroring: cl-prolog compares cyclic structure coinductively. ++ ;; erroring: cl-prolog-kit compares cyclic structure coinductively. + (let ((term (list 'loop))) + (setf (rest term) term) +- (multiple-value-bind (env ok) (cl-prolog:unify term '(loop)) ++ (multiple-value-bind (env ok) (cl-prolog-kit:unify term '(loop)) + (declare (ignore env)) + (expect (not ok)))))) +--- a/t/sgr-prolog-oracle-test.lisp ++++ b/t/sgr-prolog-oracle-test.lisp +@@ -6,10 +6,10 @@ + ;;; The imperative SGR decoder in src/sgr-parse.lisp classifies the colour + ;;; parameters with a hand-written CASE. Here the same grammar is stated + ;;; declaratively -- one relational fact per parameter -- and resolved by +-;;; nerima-lisp/cl-prolog. Cross-checking the two catches a drift in either ++;;; nerima-lisp/cl-prolog-kit. Cross-checking the two catches a drift in either + ;;; direction: the decoder is the fast path, the relation is the independent + ;;; specification. This keeps the data (the grammar) apart from the logic (the +-;;; decoder) and exercises CL-PROLOG:QUERY-PROLOG / PROLOG-SUCCEEDS-P as ++;;; decoder) and exercises CL-PROLOG-KIT:QUERY-PROLOG / PROLOG-SUCCEEDS-P as + ;;; first-class code. + ;;; + ;;; (sgr-channel PARAM CHANNEL): PARAM touches CHANNEL. 38/48/58 set an extended +@@ -17,7 +17,7 @@ + ;;; -------------------------------------------------------------------------- + + (defun %sgr-channel-grammar () +- (cl-prolog:prolog ++ (cl-prolog-kit:prolog + ((sgr-channel 38 :fg)) + ((sgr-channel 39 :fg)) + ((sgr-channel 48 :bg)) +@@ -50,4 +50,4 @@ + :to-equal '(58 59))) + ;; A basic colour parameter is not part of the channel-selection grammar. + (it "a basic colour parameter is not part of the channel-selection grammar" +- (expect (not (cl-prolog:prolog-succeeds-p (%sgr-channel-grammar) '(sgr-channel 30 :fg)))))) ++ (expect (not (cl-prolog-kit:prolog-succeeds-p (%sgr-channel-grammar) '(sgr-channel 30 :fg)))))) diff --git a/nshell.asd b/nshell.asd index 14b33670..059a8f6f 100644 --- a/nshell.asd +++ b/nshell.asd @@ -19,10 +19,11 @@ :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.1" + :version "0.6.2" :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") + :defsystem-depends-on (#+linux "sb-grovel") :depends-on ("cl-prolog-kit" "cl-parser-kit" "cl-dataflow-kit" @@ -277,6 +278,10 @@ (:file "infrastructure/persistence/file-history") (:file "infrastructure/persistence/file-config") (:file "infrastructure/terminal/detection") + #+linux + (:module "infrastructure/terminal/linux-abi" + :components ((:sb-grovel-constants-file "termios2" + :package :nshell.infrastructure.terminal))) (:file "infrastructure/terminal/raw-mode") (:file "infrastructure/terminal/ansi") (:file "infrastructure/terminal/input-core") @@ -398,7 +403,7 @@ :in-order-to ((test-op (test-op "nshell/test")))) (asdf:defsystem "nshell/test" - :version "0.6.1" + :version "0.6.2" :author "takeokunn " :maintainer "takeokunn " :license "MIT" @@ -585,7 +590,7 @@ (error "cl-weave tests failed")))) (asdf:defsystem "nshell/weave" - :version "0.6.1" + :version "0.6.2" :author "takeokunn " :maintainer "takeokunn " :license "MIT" @@ -615,7 +620,7 @@ primary suite in nshell/test." :reporter :spec) (error "cl-weave suite failed")))) (asdf:defsystem "nshell/benchmark" - :version "0.6.1" + :version "0.6.2" :author "takeokunn " :maintainer "takeokunn " :license "MIT" diff --git a/packages/feature/assistant/src/domain/safety.lisp b/packages/feature/assistant/src/domain/safety.lisp index 71c5a3f2..65d83ebd 100644 --- a/packages/feature/assistant/src/domain/safety.lisp +++ b/packages/feature/assistant/src/domain/safety.lisp @@ -187,9 +187,26 @@ (return (values (%assistant-command-basename command) args)))))) (defun %assistant-safe-git-command-p (args) - (let ((subcommand (first args))) - (and (member subcommand '("log" "show" "branch" "remote") - :test #'string=) + (let ((subcommand (first args)) + (options (rest args))) + (cond + ((equal subcommand "branch") + ;; A bare name creates a branch; -l creates its reflog, not a listing. + (or (null options) + (and (equal (first options) "--list") + (loop with patterns-only = nil + for arg in (rest options) + always (cond + (patterns-only t) + ((string= arg "--") (setf patterns-only t)) + (t (not (%assistant-string-prefix-p "-" arg)))))))) + ((equal subcommand "remote") + ;; Only the no-subcommand listing grammar is automatically approved. + (every (lambda (arg) + (member arg '("-v" "--verbose") :test #'string=)) + options)) + (t + (and (member subcommand '("log" "show") :test #'string=) (every (lambda (arg) (or (not (%assistant-string-prefix-p "-" arg)) @@ -202,9 +219,7 @@ ((string= subcommand "show") '("--stat" "--patch" "-p" "--name-only" "--name-status" "--pretty" "--format" - "--no-patch" "--")) - ((string= subcommand "branch") '("--list" "-l" "--")) - ((string= subcommand "remote") '("-v" "--verbose" "--"))) + "--no-patch" "--"))) :test #'string=) (some (lambda (prefix) (%assistant-string-prefix-p prefix arg)) @@ -212,7 +227,7 @@ ((string= subcommand "log") '("--pretty=" "--format=")) ((string= subcommand "show") '("--pretty=" "--format=")) (t nil))))) - (rest args))))) + options)))))) (defun %assistant-parse-and-classify-text (text) (let ((parsed (nshell.domain.parsing:parse-command-line text))) @@ -288,7 +303,13 @@ (when index (%assistant-parse-and-classify-text (format nil "~{~a~^ ~}" (nthcdr (1+ index) (cons command args))))))) - ((member command '("eval" "source") :test #'string=) + ((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=))) diff --git a/scripts/dependency-registry.lisp b/scripts/dependency-registry.lisp new file mode 100644 index 00000000..ca1edf10 --- /dev/null +++ b/scripts/dependency-registry.lisp @@ -0,0 +1,46 @@ +;;;; Keep dependency discovery separate from the editable checkout. + +(require :asdf) +(require :sb-posix) + +(defparameter *dependency-checkout-root* + (truename (uiop:pathname-parent-directory-pathname + (uiop:pathname-directory-pathname *load-truename*)))) + +(defun dependency-store-path-p (path) + (and path (uiop:string-prefix-p "/nix/store/" (namestring (truename path))))) + +(defun dependency-registry-configuration (value) + (let* ((registry (and value (asdf/source-registry:parse-source-registry-string value))) + (entries (and registry (rest registry)))) + (unless (and value (plusp (length value)) (eq (first registry) :source-registry)) + (error "CL_SOURCE_REGISTRY must explicitly name pinned Nix store sources")) + (setf entries + (remove-if + (lambda (entry) + (or (member entry '(:inherit-configuration :ignore-inherited-configuration + (:inherit-configuration) (:ignore-inherited-configuration)) + :test #'equal) + ;; The forge dev shell prepends its checkout. Never use it + ;; when resolving the pinned libraries' own test systems. + (and (consp entry) (eq (first entry) :directory) (= (length entry) 2) + (equal *dependency-checkout-root* + (truename (uiop:ensure-directory-pathname (second entry))))))) + entries)) + (unless (and entries + (every (lambda (entry) + (and (consp entry) (member (first entry) '(:directory :tree)) + (= (length entry) 2) + (dependency-store-path-p (second entry)))) + entries)) + (error "Only explicit Nix store :directory/:tree registry entries are allowed")) + `(:source-registry ,@entries :ignore-inherited-configuration))) + +(defun dependency-configure-registry () + (let ((configuration (dependency-registry-configuration (uiop:getenv "CL_SOURCE_REGISTRY")))) + (setf asdf:*central-registry* nil) + (asdf:clear-source-registry) + (asdf:initialize-source-registry configuration) + ;; Dependency tests that launch child Lisp images inherit the same pins. + (sb-posix:setenv "CL_SOURCE_REGISTRY" (prin1-to-string configuration) 1) + configuration)) diff --git a/scripts/test-dependencies.lisp b/scripts/test-dependencies.lisp new file mode 100644 index 00000000..0df8cb15 --- /dev/null +++ b/scripts/test-dependencies.lisp @@ -0,0 +1,115 @@ +;;;; Run one pinned dependency suite per fresh SBCL process. + +(require :asdf) +(load (merge-pathnames "asdf-runtime.lisp" *load-truename*)) +(load (merge-pathnames "dependency-registry.lisp" *load-truename*)) + +(defparameter *dependency-test-systems* + '(("cl-prolog-kit/test" nil) + ("cl-parser-kit/test" nil) + ("cl-dataflow-kit/test" nil) + ("cl-boundary-kit/test" nil) + ("cl-cli/test" nil) + ("cl-cli/test/shell-verification" nil) + ("cl-tty-kit/test" nil) + ("cl-log-kit/test" nil) + ("cl-process-kit/test" nil) + ("cl-process-kit/pty-test" nil) + ("cl-regex-kit/test" 30000) + ("cl-vcs-kit/test" nil) + ("cl-tui-kit/test" nil) + ("cl-history-kit/test" 10000) + ("cl-host-kit/test" 10000) + ("cl-codec-kit/test" 20000) + ("cl-concurrent-kit/test" 20000) + ("cl-date-kit/test" 20000) + ("cl-json-kit/test" 10000))) + +(defun dependency-weave (name &rest arguments) + ;; Event accessors and registry nodes are internal in pinned cl-weave 1.3.0. + ;; A changed API must fail, not fall back to run-all's permissive boolean. + (let ((symbol (find-symbol name "CL-WEAVE"))) + (unless (and symbol (fboundp symbol)) + (error "Required cl-weave API is unavailable: ~A" name)) + (apply (symbol-function symbol) arguments))) + +(defun dependency-check-source (system) + (let ((source (asdf:system-source-file (asdf:find-system system)))) + (unless (dependency-store-path-p source) + (error "System ~A is not from a Nix store source" system)) + (format t "~&dependency-source system=~S source=~S~%" system (namestring source)))) + +(defun dependency-registered-count (node) + (cond ((dependency-weave "TEST-CASE-P" node) 1) + ((dependency-weave "SUITE-P" node) + (reduce #'+ (dependency-weave "SUITE-CHILDREN" node) + :key #'dependency-registered-count :initial-value 0)) + (t (error "Unknown cl-weave registry node: ~S" node)))) + +(defun dependency-paths (items accessor) + (sort (mapcar (lambda (item) + (with-standard-io-syntax + (prin1-to-string (dependency-weave accessor item)))) + items) + #'string<)) + +(defun dependency-test-main (system) + (let ((entry (assoc system *dependency-test-systems* :test #'string=)) + (discovered :unknown) (selected :unknown) (executed 0) (passed 0) + (nonpass 0) (success nil)) + (unwind-protect + (handler-case + (progn + (unless entry (error "Unknown dependency test system: ~A" system)) + (nshell-configure-writable-asdf-output) + (dependency-configure-registry) + (dependency-check-source system) + (dependency-check-source "cl-weave") + (unless (string= "1.3.0" (asdf:component-version (asdf:find-system "cl-weave"))) + (error "This runner requires pinned cl-weave 1.3.0")) + (asdf:load-system system) + (let* ((root (dependency-weave "ROOT-SUITE")) + (plan (dependency-weave "COLLECT-TEST-PLAN" root + :name-filter nil :retry 0 + :timeout-ms (second entry)))) + (setf discovered (dependency-registered-count root) + selected (length plan)) + (format t "~&dependency-discovery system=~S discovered=~D selected=~D~%" + system discovered selected) + (unless (and (plusp discovered) (= discovered selected) + (notany (lambda (test) + (dependency-weave "TEST-PLAN-ENTRY-FOCUSED" test)) + 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)))) + (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~%" + system discovered selected executed passed nonpass (if success "PASS" "FAIL")) + (finish-output)) + (if success 0 1))) + +(let ((arguments (uiop:command-line-arguments))) + (cond ((equal arguments '("--list")) + (dolist (entry *dependency-test-systems*) (write-line (first entry)))) + ((= (length arguments) 1) + (uiop:quit (dependency-test-main (first arguments)))) + (t + (format *error-output* "Usage: sbcl --script scripts/test-dependencies.lisp SYSTEM | --list~%") + (uiop:quit 2)))) diff --git a/scripts/test-dependencies.sh b/scripts/test-dependencies.sh new file mode 100644 index 00000000..1b1d5094 --- /dev/null +++ b/scripts/test-dependencies.sh @@ -0,0 +1,38 @@ +#!/usr/bin/env bash +# CL_SOURCE_REGISTRY is supplied by the pinned Nix check/dev environment. +# Run every suite in a separate image; never merge global cl-weave registries. +set -euo pipefail + +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" "$@" +fi + +if (( $# == 0 )); then + dependency_systems=$("$dependency_sbcl" --noinform --script "$dependency_script_dir/test-dependencies.lisp" --list) + while IFS= read -r dependency_system; do + [[ -n $dependency_system ]] || continue + set -- "$@" "$dependency_system" + done <<< "$dependency_systems" +fi +(( $# > 0 )) || { echo 'No dependency suites selected' >&2; exit 1; } + +# 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/" +"$dependency_sbcl" --noinform --script "$dependency_script_dir/test-dependency-registry.lisp" +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 + dependency_passed=$((dependency_passed + 1)) + else + dependency_exit=$? + printf 'dependency-process system=%s exit=%s\n' "$dependency_system" "$dependency_exit" >&2 + dependency_failed=$((dependency_failed + 1)) + fi +done +printf 'dependency-suites selected=%s pass=%s failed=%s cache=%s\n' "$#" "$dependency_passed" "$dependency_failed" "$dependency_cache" +(( dependency_failed == 0 )) diff --git a/scripts/test-dependency-registry.lisp b/scripts/test-dependency-registry.lisp new file mode 100644 index 00000000..20d289d9 --- /dev/null +++ b/scripts/test-dependency-registry.lisp @@ -0,0 +1,80 @@ +(load (merge-pathnames "dependency-registry.lisp" *load-truename*)) + +(let* ((original (uiop:getenv "CL_SOURCE_REGISTRY")) + (parsed (asdf/source-registry:parse-source-registry-string original)) + (stores (remove-if-not + (lambda (entry) + (and (consp entry) (member (first entry) '(:directory :tree)) + (= (length entry) 2) (dependency-store-path-p (second entry)))) + (rest parsed))) + (checkout (namestring *dependency-checkout-root*)) + (parent (namestring (uiop:pathname-parent-directory-pathname *dependency-checkout-root*))) + (child (namestring (merge-pathnames "scripts/" *dependency-checkout-root*))) + (passed 0)) + (unless stores (error "Registry regression tests require nonempty Nix store fixtures")) + (labels ((check (name result) + (unless result (error "Registry check failed: ~A" name)) + (incf passed) + (format t "registry-check ~A PASS~%" name)) + (configuration (&rest entries) + (dependency-registry-configuration + (prin1-to-string `(:source-registry ,@entries :ignore-inherited-configuration)))) + (rejects (value) + (handler-case (progn (dependency-registry-configuration value) nil) + (asdf/source-registry:invalid-source-registry () t) + (error () t)))) + (let ((expected `(:source-registry ,@stores :ignore-inherited-configuration))) + (check "store-order" (equal expected (apply #'configuration stores))) + (check "checkout-removed" + (equal expected (apply #'configuration `(:directory ,checkout) stores))) + (check "colon-devshell" + (equal `(:source-registry (:directory ,(second (first stores))) + :ignore-inherited-configuration) + (dependency-registry-configuration + (format nil "~A:~A" checkout (second (first stores)))))) + (check "store-tree" + (equal `(:source-registry (:tree ,(second (first stores))) + :ignore-inherited-configuration) + (configuration `(:tree ,(second (first stores)))))) + (check "inheritance-removed" + (equal expected (dependency-registry-configuration + (prin1-to-string + `(:source-registry ,@stores :inherit-configuration))))) + (uiop:with-current-directory (child) + (check "checkout-independent-of-cwd" + (equal expected (apply #'configuration `(:directory ,checkout) stores)))) + (dolist (entry `((:directory ,parent) (:directory ,child) (:tree ,checkout) + (:include ,checkout) (:directory ,checkout :extra))) + (check (format nil "reject-~S" (first entry)) + (rejects (prin1-to-string + `(:source-registry ,entry ,@stores :ignore-inherited-configuration))))) + (check "checkout-only-rejected" + (rejects (prin1-to-string `(:source-registry (:directory ,checkout) + :ignore-inherited-configuration)))) + (check "empty-rejected" (rejects "")) + (check "unset-rejected" (rejects nil)) + (sb-posix:setenv "CL_SOURCE_REGISTRY" original 1) + (check "configured-store-only" (equal expected (dependency-configure-registry))) + (check "exported-store-only" + (equal expected (read-from-string (uiop:getenv "CL_SOURCE_REGISTRY")))) + (check "child-inherits-store-only" + (equal expected + (read-from-string + (uiop:run-program + (list (namestring sb-ext:*runtime-pathname*) "--noinform" "--non-interactive" + "--eval" "(require :asdf)" + "--eval" "(write-string (uiop:getenv \"CL_SOURCE_REGISTRY\"))") + :output :string)))) + (uiop:with-temporary-file (:pathname shadow :type "asd" :prefix "nshell-registry-shadow-" + :stream stream) + (let ((name (pathname-name shadow))) + (format stream "(asdf:defsystem ~S)~%" name) + (finish-output stream) + (setf asdf:*central-registry* (list (uiop:pathname-directory-pathname shadow))) + (check "local-shadow-control" (asdf:find-system name nil)) + (asdf:clear-system name) + (dependency-configure-registry) + (check "central-registry-cleared" (null asdf:*central-registry*)) + (check "local-shadow-not-loaded" (null (asdf:find-system name nil)))))) + (format t "dependency-registry-checks selected=20 pass=~D~%" passed) + (unless (= passed 20) (error "Incomplete registry regression selection")))) diff --git a/scripts/test-history-storage.lisp b/scripts/test-history-storage.lisp new file mode 100644 index 00000000..d5eba244 --- /dev/null +++ b/scripts/test-history-storage.lisp @@ -0,0 +1,276 @@ +(require :asdf) +(require :sb-posix) +(load (merge-pathnames "asdf-runtime.lisp" *load-truename*)) +(nshell-configure-writable-asdf-output) +(asdf:load-system "cl-history-kit") +(defpackage #:nshell.infrastructure.persistence (:use #:cl)) +(load (merge-pathnames "../src/infrastructure/persistence/file-history.lisp" + *load-truename*)) + +(let ((arguments (uiop:command-line-arguments))) + (when (equal "--history-child-append" (first arguments)) + (write-line "HISTORY-CHILD-READY") + (finish-output) + (let ((text (read-line *standard-input* nil nil))) + (unless text (uiop:quit 2)) + (let ((nshell.infrastructure.persistence::*history-file-path-override* + (pathname (second arguments))) + (*error-output* (make-string-output-stream))) + (nshell.infrastructure.persistence::append-history-entry text) + (let ((errors (get-output-stream-string *error-output*))) + (write-string errors) + (uiop:quit (cond ((zerop (length errors)) 0) + ((search "SB-POSIX:LOCKF" errors) 3) + (t 4)))))))) + +(defun check-history-reader-lock (path check) + (let ((script (namestring *load-truename*)) + (children nil) + (all-children nil)) + (labels ((prepare-child () + (let* ((start (get-internal-real-time)) + (child (uiop:launch-program + (list (namestring sb-ext:*runtime-pathname*) "--script" script + "--history-child-append" (namestring path)) + :input :stream :output :stream :error-output :output))) + (push child all-children) + (sb-ext:with-timeout 30 + (let ((startup (make-string-output-stream))) + (loop for line = (read-line (uiop:process-info-output child) nil nil) + do (cond + ((null line) + (error "Child failed before ready: exit=~d ~a" + (uiop:wait-process child) + (get-output-stream-string startup))) + ((string= line "HISTORY-CHILD-READY") (return)) + (t (write-line line startup)))))) + (format t "CHILD ready before writer hold in ~,3fs~%" + (/ (- (get-internal-real-time) start) + internal-time-units-per-second)) + child)) + (child-append (label text) + (let* ((child (or (pop children) (error "No prepared child for ~a" label))) + (input (uiop:process-info-input child))) + (sb-ext:with-timeout 5 + (write-line text input) + (finish-output input) + (close input) + (let* ((output (uiop:slurp-stream-string (uiop:process-info-output child))) + (code (uiop:wait-process child))) + (format t "CHILD ~a exit=~d~%" label code) + (unless (member code '(0 3 4)) + (error "Unexpected child result: ~d ~a" code output)) + (when (= code 4) + (write-string output)) + code)))) + (wait-for-signal (semaphore label) + (unless (sb-thread:wait-on-semaphore semaphore :timeout 5) + (error "Timed out waiting for ~a" label))) + (reader-state (thread done) + (let ((deadline (+ (get-internal-real-time) + (* 5 internal-time-units-per-second)))) + (loop + (when (eq nshell.infrastructure.persistence::*history-file-lock* + (sb-thread::thread-waiting-for thread)) + (return :blocked)) + (when (sb-thread:try-semaphore done) + (return :completed)) + (when (> (get-internal-real-time) deadline) + (error "Reader neither completed nor waited for the history mutex")) + (sb-thread:thread-yield)))) + (run-ready-case (control-p) + (delete-file path) + (let ((nshell.infrastructure.persistence::*history-file-path-override* path)) + (nshell.infrastructure.persistence::append-history-entry "seed")) + (let* ((held (sb-thread:make-semaphore)) + (release (sb-thread:make-semaphore)) + (started (sb-thread:make-semaphore)) + (done (sb-thread:make-semaphore)) + (original (symbol-function + 'nshell.infrastructure.persistence::%append-history-record)) + (writer nil) + (reader nil) + (writer-result nil) + (reader-result nil)) + ;; This isolated runner pauses, but still calls, the real serializer. + (unwind-protect + (progn + (setf (symbol-function + 'nshell.infrastructure.persistence::%append-history-record) + (lambda (stream record) + (sb-thread:signal-semaphore held) + (wait-for-signal release "writer release") + (funcall original stream record))) + (setf writer + (sb-thread:make-thread + (lambda () + (let ((nshell.infrastructure.persistence::*history-file-path-override* path) + (*error-output* (make-string-output-stream))) + (nshell.infrastructure.persistence::append-history-entry + "holding-writer") + (get-output-stream-string *error-output*))) + :name "history holding writer")) + (wait-for-signal held "writer descriptor lock") + (funcall check + (if control-p "control writer initially excludes child" + "public writer initially excludes child") + (= 3 (child-append "before-reader" "intruder"))) + (setf reader + (sb-thread:make-thread + (lambda () + (let ((nshell.infrastructure.persistence::*history-file-path-override* path) + (*error-output* (make-string-output-stream))) + (sb-thread:signal-semaphore started) + (unwind-protect + (let ((records + (if control-p + ;; Reproduce the pre-mutex descriptor-close hazard. + (with-open-stream + (stream (nshell.infrastructure.persistence::%open-history-stream path)) + (nshell.infrastructure.persistence::%read-history-records stream)) + (nshell.infrastructure.persistence::load-history-file)))) + (list (get-output-stream-string *error-output*) + (mapcar #'nshell.infrastructure.persistence::history-record-text + records))) + (sb-thread:signal-semaphore done)))) + :name "history overlapping reader")) + (wait-for-signal started "reader start") + (let ((state (reader-state reader done))) + (format t "READER ~a ~a~%" (if control-p "control" "public") state) + (funcall check + (if control-p "control reader closes while writer is held" + "public reader waits on held writer mutex") + (eq state (if control-p :completed :blocked)))) + (funcall check + (if control-p "control reader close releases process file lock" + "public reader cannot release held writer file lock") + (= (if control-p 0 3) + (child-append "after-reader-start" "intruder")))) + (sb-thread:signal-semaphore release) + (unwind-protect + (progn + (when writer + (setf writer-result (sb-thread:join-thread writer :timeout 5))) + (when reader + (setf reader-result (sb-thread:join-thread reader :timeout 5)))) + (setf (symbol-function + 'nshell.infrastructure.persistence::%append-history-record) + original))) + (format t "WRITER ~a alive=~s stderr=~s~%" + (if control-p "control" "public") + (sb-thread:thread-alive-p writer) writer-result) + (format t "READER-RESULT ~a ~s~%" + (if control-p "control" "public") reader-result) + (funcall check + (if control-p "control writer and reader finish without errors" + "public writer and reader finish with committed records") + (and (string= "" writer-result) + (equal reader-result + (list "" (if control-p '("seed") + '("seed" "holding-writer"))))))) + (unless control-p + (funcall check "writer close permits child append" + (= 0 (child-append "after-writer-close" "after-release"))) + (let ((nshell.infrastructure.persistence::*history-file-path-override* path) + (*error-output* (make-string-output-stream))) + (let ((records (nshell.infrastructure.persistence::load-history-file))) + (funcall check "concurrent history retains exact records without corrupt tail" + (and (equal '("seed" "holding-writer" "after-release") + (mapcar #'nshell.infrastructure.persistence::history-record-text + records)) + (string= "" (get-output-stream-string *error-output*)))))))) + (run-case (control-p) + ;; Cold SBCL/ASDF startup must not consume the writer's five-second hold. + (let ((completed nil) + (cleanup-errors nil)) + (unwind-protect + (progn + (setf children (loop repeat (if control-p 2 3) + collect (prepare-child))) + (run-ready-case control-p) + (setf completed t)) + (dolist (child all-children) + (handler-case + (sb-ext:with-timeout 5 + (unwind-protect + (progn + (when (uiop:process-alive-p child) + (uiop:terminate-process child :urgent t)) + (uiop:wait-process child)) + (uiop:close-streams child))) + (serious-condition (condition) + (push condition cleanup-errors)))) + (setf children nil all-children nil) + (when cleanup-errors + (if completed + (error "Child cleanup failed: ~{~a~^; ~}" cleanup-errors) + (format *error-output* "Child cleanup also failed: ~{~a~^; ~}~%" + cleanup-errors))))))) + (run-case t) + (run-case nil)))) + +(let* ((directory (format nil "/tmp/nshell-history-storage-~d-~36r/" + (sb-posix:getpid) (random most-positive-fixnum))) + (path (merge-pathnames "history" directory)) + (target (merge-pathnames "target" directory)) + (old-mask (sb-posix:umask #o022)) + (checks 0) + (failures 0)) + (sb-posix:mkdir directory #o700) + (labels ((check (name result) + (incf checks) + (unless result (incf failures)) + (format t "~a ~a~%" (if result "PASS" "FAIL") name)) + (contents (file) + (uiop:read-file-string file)) + (append-command (command) + (let ((*error-output* (make-string-output-stream))) + (nshell.infrastructure.persistence::append-history-entry command) + (get-output-stream-string *error-output*)))) + (unwind-protect + (let ((nshell.infrastructure.persistence::*history-file-path-override* path)) + (append-command "first") + (check "new file is owner-only" + (= #o600 (logand #o777 (sb-posix:stat-mode (sb-posix:stat path))))) + (sb-posix:chmod path #o644) + (append-command "second") + (check "existing file is owner-only" + (= #o600 (logand #o777 (sb-posix:stat-mode (sb-posix:stat path))))) + (check "valid entries round-trip" + (equal '("first" "second") + (mapcar #'nshell.infrastructure.persistence::history-record-text + (nshell.infrastructure.persistence::load-history-file)))) + (rename-file path target) + (sb-posix:symlink (namestring target) (namestring path)) + (let ((before (contents target))) + (check "symlink append rejected with target unchanged" + (and (plusp (length (append-command "symlink"))) + (string= before (contents target))))) + (sb-posix:unlink (namestring path)) + (sb-posix:link (namestring target) (namestring path)) + (let ((before (contents target))) + (check "hardlink append rejected with target unchanged" + (and (plusp (length (append-command "hardlink"))) + (string= before (contents target))))) + (delete-file path) + (delete-file target) + (append-command "retained") + (with-open-file (stream path :direction :output :if-exists :append) + (write-string "# nshell-history-v3 100 +short" stream)) + (let ((before (contents path))) + (check "corrupt tail rejects append without discarding bytes" + (and (plusp (length (append-command "hidden"))) + (string= before (contents path))))) + (let ((*error-output* (make-string-output-stream))) + (check "valid prefix remains readable after corruption" + (equal '("retained") + (mapcar #'nshell.infrastructure.persistence::history-record-text + (nshell.infrastructure.persistence::load-history-file))))) + (check-history-reader-lock path #'check) + (format t "History storage: ~d checks, ~d failures~%" checks failures)) + (sb-posix:umask old-mask) + (when (probe-file path) (delete-file path)) + (when (probe-file target) (delete-file target)) + (sb-posix:rmdir directory))) + (uiop:quit (if (and (plusp checks) (zerop failures)) 0 1))) diff --git a/scripts/test-release-pty.pl b/scripts/test-release-pty.pl new file mode 100644 index 00000000..c75d70ad --- /dev/null +++ b/scripts/test-release-pty.pl @@ -0,0 +1,628 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Cwd qw(abs_path); +use File::Path qw(make_path); +use File::Temp qw(tempdir); +use POSIX qw(WNOHANG); +use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC sleep alarm); + +# Usage: perl scripts/test-release-pty.pl EXTRACTED_BUNDLE [--timeout SECONDS] +# Only the public executable is launched; no Lisp forms or source paths are supplied. +my $bundle = shift @ARGV; +my $timeout = 45; +if (@ARGV == 2 && $ARGV[0] eq '--timeout' && $ARGV[1] =~ /^\d+$/) { + $timeout = $ARGV[1]; + @ARGV = (); +} +die "usage: $0 EXTRACTED_BUNDLE [--timeout SECONDS (5..300)]\n" + if !defined($bundle) || @ARGV || $timeout < 5 || $timeout > 300; +$bundle = abs_path($bundle) // die "bundle does not exist\n"; +my $executable = "$bundle/bin/nshell"; +die "bundle/bin/nshell must be a nonempty executable file\n" + unless -f $executable && -s $executable && -x $executable; +die "PTY verification requires Linux or Darwin (no skip)\n" + unless $^O eq 'linux' || $^O eq 'darwin'; +if ($^O eq 'darwin') { + for my $object ($executable, "$bundle/libexec/nshell") { + next unless -f $object; + open my $fh, '<', $object or die "cannot inspect executable\n"; + read($fh, my $magic, 4) == 4 or die "cannot read executable header\n"; + close $fh or die "cannot close executable\n"; + die "Linux ELF bundle cannot be verified on Darwin (no skip)\n" + if $magic eq "\x7fELF"; + } +} +my $isolation = tempdir('nshell-release-pty-XXXXXX', TMPDIR => 1, CLEANUP => 1); +make_path(map { "$isolation/$_" } qw(home config cache data state tmp)); +my $origin = clock_gettime(CLOCK_MONOTONIC); +my $deadline = $origin + $timeout; +my $backend = <<'PYTHON'; +import copy +import errno +import fcntl +import os +import re +import select +import signal +import struct +import subprocess +import sys +import termios +import time + +executable, isolation, deadline_text = sys.argv[1:] +# Older Darwin Python uses a process-relative monotonic() epoch. +def monotonic(): + return time.clock_gettime(time.CLOCK_MONOTONIC) + +deadline = float(deadline_text) +# Reserve time for escalation/reaping inside the whole-run deadline. +work_deadline = deadline - 2 +stage = 'startup' +sessions = [] +jobs = {} +passed = [] +prompt = b'release-pty> ' +nonce = os.urandom(8).hex() +environment = { + 'HOME': isolation + '/home', 'XDG_CONFIG_HOME': isolation + '/config', + 'XDG_CACHE_HOME': isolation + '/cache', 'XDG_DATA_HOME': isolation + '/data', + 'XDG_STATE_HOME': isolation + '/state', 'TMPDIR': isolation + '/tmp', + 'PATH': '/usr/bin:/bin', 'TERM': 'xterm', 'LANG': 'C', 'LC_ALL': 'C', + 'NSHELL_PROMPT': prompt.decode(), +} + + +def interrupted(signum, frame): + raise RuntimeError('runner interrupted by signal %d' % signum) + + +signal.signal(signal.SIGTERM, interrupted) +signal.signal(signal.SIGINT, interrupted) +signal.signal(signal.SIGALRM, interrupted) +signal.setitimer(signal.ITIMER_REAL, max(0.001, deadline - monotonic())) + + +def remaining(limit=5): + value = min(limit, work_deadline - monotonic()) + if value <= 0: + raise RuntimeError('whole-run deadline exceeded') + return value + + +def process(pid): + result = subprocess.run(['ps', '-o', 'pgid=', '-o', 'stat=', '-o', 'ppid=', '-p', str(pid)], + stdout=subprocess.PIPE, stderr=subprocess.PIPE, + timeout=remaining(1), env=environment) + if result.returncode == 1 and not result.stdout.strip(): + return None + if result.returncode != 0: + raise RuntimeError('ps observation failed') + fields = result.stdout.split() + if len(fields) != 3: + raise RuntimeError('invalid ps observation') + return int(fields[0]), fields[1].decode('ascii'), int(fields[2]) + + +class Session: + def __init__(self, history=False): + self.master, self.slave = os.openpty() + self.status = None + self.output = b'' + attributes = termios.tcgetattr(self.slave) + attributes[3] |= termios.ICANON | termios.ECHO | termios.ISIG + termios.tcsetattr(self.slave, termios.TCSANOW, attributes) + # Darwin revokes the slave when its session leader exits; the retained + # master still exposes this same terminal's attributes after exit. + self.baseline = copy.deepcopy(termios.tcgetattr(self.master)) + fcntl.ioctl(self.slave, termios.TIOCSWINSZ, struct.pack('HHHH', 24, 100, 0, 0)) + self.pid = os.fork() + if self.pid == 0: + try: + os.close(self.master) + os.setsid() + fcntl.ioctl(self.slave, termios.TIOCSCTTY, 0) + for fd in (0, 1, 2): + os.dup2(self.slave, fd) + if self.slave > 2: + os.close(self.slave) + os.chdir(isolation) + arguments = [executable, '--no-config'] + if not history: + arguments.append('--no-history') + os.execve(executable, arguments, environment) + except BaseException: + os._exit(127) + sessions.append(self) + os.set_blocking(self.master, False) + + def poll(self): + if self.status is None: + pid, status = os.waitpid(self.pid, os.WNOHANG) + if pid: + self.status = status + return self.status + + def read(self, duration=0.02): + if select.select([self.master], [], [], duration)[0]: + try: + data = os.read(self.master, 8192) + except OSError as error: + if error.errno != errno.EIO: + raise + data = b'' + self.output += data + if len(self.output) > 1024 * 1024: + raise RuntimeError('PTY output limit exceeded') + + def send(self, data): + if self.poll() is not None: + raise RuntimeError('executable exited before input (status %d)' % self.status) + end = monotonic() + remaining() + view = memoryview(data) + while view: + if monotonic() >= end: + raise RuntimeError('PTY write deadline exceeded') + if select.select([], [self.master], [], 0.02)[1]: + view = view[os.write(self.master, view):] + + def expect(self, expected, start, stimulus=b''): + pattern = re.compile(expected) if isinstance(expected, bytes) else expected + if pattern.search(stimulus): + raise RuntimeError('assertion would match terminal input echo') + end = monotonic() + remaining() + while True: + match = pattern.search(self.output[start:]) + if match: + return match, start + match.end() + if self.poll() is not None: + raise RuntimeError('executable exited before expected output (status %d)' % self.status) + if monotonic() >= end: + raise RuntimeError('expected output deadline exceeded') + self.read() + + def marker(self, name, value): + label = name + '-' + nonce + command = ("printf 'rel-%s:<%s>\\n' '%s' '%s'\n" % ('%s', '%s', label, value)).encode() + expected = ('rel-%s:<%s>' % (label, value)).encode() + start = len(self.output) + self.send(command) + match, end = self.expect(re.escape(expected), start, command) + self.expect(re.escape(prompt), end) + return command + + def foreground(self): + return struct.unpack('i', fcntl.ioctl(self.master, termios.TIOCGPGRP, struct.pack('i', 0)))[0] + + def wait(self, predicate): + end = monotonic() + remaining() + while not predicate(): + if self.poll() is not None: + raise RuntimeError('executable exited during process-state assertion') + if monotonic() >= end: + raise RuntimeError('process-state deadline exceeded') + self.read() + + def finish(self): + self.send(b'\x04') + end = monotonic() + remaining() + while self.poll() is None: + if monotonic() >= end: + raise RuntimeError('interactive exit deadline exceeded') + self.read() + if not os.WIFEXITED(self.status) or os.WEXITSTATUS(self.status) != 0: + raise RuntimeError('interactive executable exit was not zero') + restored = termios.tcgetattr(self.master) + if restored != self.baseline: + fields = ('iflag', 'oflag', 'cflag', 'lflag', 'ispeed', 'ospeed', 'cc') + changes = ['%s: %r -> %r' % (name, before, after) + for name, before, after in zip(fields, self.baseline, restored) + if before != after] + raise RuntimeError('interactive termios was not restored (%s)' % '; '.join(changes)) + + +def check(name): + passed.append(name) + print('ok: ' + name, flush=True) + + +failure = None +cleanup_errors = [] +try: + if sys.platform.startswith('linux'): + # Reap adopted jobs even if a failing shell exits before reaping them. + import ctypes + libc = ctypes.CDLL(None, use_errno=True) + if libc.prctl(36, 1, 0, 0, 0) != 0: # PR_SET_CHILD_SUBREAPER + raise RuntimeError('cannot establish owned-job subreaper') + session = Session() + session.expect(re.escape(prompt), 0) + stage = 'interactive readiness' + label = 'tty-' + nonce + command = ("sh -c 'test -t 0 && test -t 1 && test -t 2 || exit 91; printf \"rel-%%s:<%%s>\\n\" %s yes'\n" % label).encode() + start = len(session.output) + session.send(command) + _, end = session.expect(re.escape(('rel-%s:' % label).encode()), start, command) + session.expect(re.escape(prompt), end) + stage = 'editing/backspace' + label = 'edit-' + nonce + command = ("printf 'rel-%%s:<%%s>\\n' %s okx" % label).encode() + b'\x08\n' + start = len(session.output) + session.send(command) + _, end = session.expect(re.escape(('rel-%s:' % label).encode()), start, command) + session.expect(re.escape(prompt), end) + check(stage) + + stage = 'Ctrl-C pending input' + start = len(session.output) + pending = b'exit 91' + session.send(pending) + # Require the entire rendered input, not 91 inside an ANSI color sequence. + ansi = rb'(?:\x1b\[[0-?]*[ -/]*[@-~])*' + session.expect(ansi.join(re.escape(bytes([byte])) for byte in pending), start) + start = len(session.output) + session.send(b'\x03') + session.expect(re.escape(prompt), start) + session.marker('pending-recovered', 'yes') + check(stage) + + stage = 'Ctrl-C foreground' + label = 'job-' + nonce + command = ("sh -c 'printf \"rel-%%s:<%%s>\\n\" %s \"$$\" > /dev/tty; exec sleep 30'\n" % label).encode() + + def launch_job(): + start = len(session.output) + session.send(command) + match, _ = session.expect(re.compile(re.escape(('rel-%s:<' % label).encode()) + rb'(\d+)>'), start, command) + pid = int(match.group(1)) + observed = process(pid) + ancestor = observed + seen = {pid} + while ancestor is not None and ancestor[2] != session.pid: + parent = ancestor[2] + if parent <= 1 or parent in seen: + raise RuntimeError('job PID is not an owned PTY descendant') + seen.add(parent) + ancestor = process(parent) + if ancestor is None: + raise RuntimeError('job PID is not an owned PTY descendant') + if observed is None or observed[0] != pid or pid == session.pid: + raise RuntimeError('foreground job lacks an independent real PGID') + jobs[pid] = observed[0] + session.wait(lambda: session.foreground() == pid and process(pid) is not None + and 'T' not in process(pid)[1]) + return pid + + def interrupt_job(pid): + start = len(session.output) + session.send(b'\x03') + session.wait(lambda: session.foreground() == session.pid) + session.expect(re.escape(prompt), start) + label = 'status-' + nonce + status_command = ("printf 'rel-%%s:<%%s>\\n' %s $status\n" % label).encode() + start = len(session.output) + session.send(status_command) + _, end = session.expect(re.escape(('rel-%s:<130>' % label).encode()), start, status_command) + session.expect(re.escape(prompt), end) + session.wait(lambda: process(pid) is None) + del jobs[pid] + + pid = launch_job() + interrupt_job(pid) + check(stage) + + stage = 'Ctrl-Z/bg/fg real PGID' + pid = launch_job() + start = len(session.output) + session.send(b'\x1a') + session.wait(lambda: session.foreground() == session.pid and process(pid) is not None + and 'T' in process(pid)[1]) + session.expect(re.escape(prompt), start) + start = len(session.output) + session.send(b'jobs\n') + _, end = session.expect(rb'\[1\][ +\-]*\s*Stopped\b', start, b'jobs\n') + session.expect(re.escape(prompt), end) + start = len(session.output) + session.send(b'bg 1\n') + session.wait(lambda: process(pid) is not None and 'T' not in process(pid)[1]) + session.expect(re.escape(prompt), start) + start = len(session.output) + session.send(b'jobs\n') + _, end = session.expect(rb'\[1\][ +\-]*\s*Running\b', start, b'jobs\n') + session.expect(re.escape(prompt), end) + session.send(b'fg 1\n') + session.wait(lambda: session.foreground() == pid) + interrupt_job(pid) + check(stage) + stage = 'interactive termios restoration' + session.finish() + check(stage) + + stage = 'history restart isolated HOME' + writer = Session(history=True) + writer.expect(re.escape(prompt), 0) + writer.marker('history-older', 'older') + writer.marker('history-newest', 'newest') + writer.finish() + reader = Session(history=True) + reader.expect(re.escape(prompt), 0) + if writer.pid == reader.pid: + raise RuntimeError('history restart did not start a different process') + start = len(reader.output) + reader.send(b'\x1b[A\n') + _, end = reader.expect(re.escape(('rel-history-newest-%s:' % nonce).encode()), start, b'\x1b[A\n') + reader.expect(re.escape(prompt), end) + reader.finish() + check(stage) +except BaseException as error: + failure = '%s: %s' % (stage, error) +finally: + # Cleanup runs even after deadline/signal failures and never turns one into success. + signal.signal(signal.SIGTERM, signal.SIG_IGN) + signal.signal(signal.SIGINT, signal.SIG_IGN) + signal.setitimer(signal.ITIMER_REAL, max(0.001, deadline - monotonic())) + + def cleanup_remaining(): + return max(0.001, deadline - monotonic()) + + active = {s.pid for s in sessions if s.status is None} + owned = {pid: 1 for pid in jobs} + frozen = set() + # Freeze owned parents before observing descendants, including jobs whose + # PID marker never arrived or whose PGID assertion failed before registration. + for pid in active: + try: + os.kill(pid, signal.SIGSTOP) + frozen.add(pid) + except ProcessLookupError: + pass + except BaseException as error: + cleanup_errors.append('freeze owned PID %d: %s' % (pid, error)) + try: + snapshot = subprocess.run(['ps', '-axo', 'pid=,ppid='], + stdout=subprocess.PIPE, stderr=subprocess.PIPE, + timeout=cleanup_remaining(), env=environment) + if snapshot.returncode != 0: + raise RuntimeError('descendant observation failed') + parents = {int(pid): int(parent) for pid, parent in + (row.split() for row in snapshot.stdout.splitlines())} + for pid in parents: + ancestor, depth, seen = pid, 0, set() + while ancestor in parents and ancestor not in active and ancestor not in seen: + seen.add(ancestor) + ancestor = parents[ancestor] + depth += 1 + if ancestor in active and pid not in active: + owned[pid] = depth + except BaseException as error: + cleanup_errors.append('owned descendants: %s' % error) + + for pid in sorted(owned, key=lambda pid: owned[pid], reverse=True): + for sig in (signal.SIGCONT, signal.SIGKILL): + try: + os.kill(pid, sig) + except ProcessLookupError: + pass + except BaseException as error: + cleanup_errors.append('owned child PID %d: %s' % (pid, error)) + for pid in frozen: + try: + os.kill(pid, signal.SIGCONT) + except ProcessLookupError: + pass + except BaseException as error: + cleanup_errors.append('resume owned parent PID %d: %s' % (pid, error)) + # Keep parents alive briefly so they can reap killed children before exit. + try: + end = min(deadline - 0.5, monotonic() + 0.5) + while owned and monotonic() < end: + probe = subprocess.run(['ps', '-o', 'pid=', '-p', ','.join(map(str, owned))], + stdout=subprocess.PIPE, stderr=subprocess.PIPE, + timeout=cleanup_remaining(), env=environment) + if probe.returncode == 1 and not probe.stdout.strip(): + break + if probe.returncode not in (0, 1): + raise RuntimeError('owned-child reaping observation failed') + time.sleep(0.02) + except BaseException as error: + cleanup_errors.append('child-before-parent reaping: %s' % error) + for session in sessions: + try: + if session.status is None: + # setsid may not have happened when startup failed. + try: + os.kill(session.pid, signal.SIGKILL) + except ProcessLookupError: + pass + except BaseException as error: + cleanup_errors.append('owned PID %d: %s' % (session.pid, error)) + for fd in (session.master, session.slave): + try: + os.close(fd) + except BaseException as error: + cleanup_errors.append('owned PTY fd %d: %s' % (fd, error)) + try: + pending = set(owned) | active + while pending: + # Linux subreaper also adopts children of failed/exited job parents. + while True: + try: + pid, status = os.waitpid(-1, os.WNOHANG) + except ChildProcessError: + break + if pid == 0: + break + for session in sessions: + if session.pid == pid: + session.status = status + for pid in tuple(pending): + probe = subprocess.run(['ps', '-o', 'stat=', '-p', str(pid)], + stdout=subprocess.PIPE, stderr=subprocess.PIPE, + timeout=cleanup_remaining(), env=environment) + if probe.returncode == 1 and not probe.stdout.strip(): + pending.remove(pid) + elif probe.returncode != 0: + raise RuntimeError('owned-process absence observation failed') + if pending and monotonic() >= deadline - 0.1: + raise RuntimeError('owned PIDs remain after cleanup: %s' % sorted(pending)) + if pending: + time.sleep(0.02) + except BaseException as error: + cleanup_errors.append('owned-process postcondition: %s' % error) + signal.setitimer(signal.ITIMER_REAL, 0) + +if not cleanup_errors: + print('CLEANUP: owned processes absent; PTYs closed', flush=True) +if failure or cleanup_errors: + print('FAIL: ' + (failure or 'cleanup failed'), file=sys.stderr) + for error in cleanup_errors: + print('cleanup: ' + error, file=sys.stderr) + sys.exit(1) +if len(passed) != 6 or len(sessions) != 3 or any(s.status != 0 for s in sessions): + print('FAIL: incomplete PTY execution', file=sys.stderr) + sys.exit(1) +print('PASS: 6 PTY checks; 3 executable sessions exited zero; owned processes cleaned', flush=True) +PYTHON + +my $pid = fork // die "cannot start PTY backend: $!\n"; +if (!$pid) { + exec 'python3', '-c', $backend, $executable, $isolation, sprintf('%.9f', $deadline); + die "python3 PTY backend unavailable: $!\n"; +} +my ($signal, $requested, $backend_reaped); +sub request_cleanup { + return if $backend_reaped; + # A stopped backend must be resumed to run its signal cleanup handler. + kill 'TERM', $pid; + kill 'CONT', $pid; + $requested = 1; +} +local $SIG{INT} = sub { $signal = 'INT'; request_cleanup() }; +local $SIG{TERM} = sub { $signal = 'TERM'; request_cleanup() }; +my $end = $deadline + 1; + +sub process_snapshot { + my ($until) = @_; + my ($observer, $fh, $text, $error); + eval { + local $SIG{ALRM} = sub { die "owned-process observation deadline\n" }; + my $left = $until - clock_gettime(CLOCK_MONOTONIC); + die "owned-process observation deadline\n" if $left <= 0; + alarm $left; + $observer = open($fh, '-|', 'ps', '-axo', 'pid=,ppid='); + die "cannot observe owned processes\n" unless $observer; + local $/; + $text = <$fh>; + my $closed = close($fh); + undef $observer; # close has reaped this observer, including on nonzero exit. + die "owned-process observation failed\n" unless $closed; + alarm 0; + 1; + } or $error = $@; + alarm 0; + if ($error) { + kill 'KILL', $observer if $observer; + waitpid($observer, 0) if $observer; + die $error; + } + die "empty owned-process observation\n" unless defined($text) && $text =~ /\S/; + my %parents; + for my $row (split /\n/, $text) { + die "invalid owned-process observation\n" unless $row =~ /^\s*(\d+)\s+(\d+)\s*$/; + $parents{$1} = $2; + } + return \%parents; +} + +sub watchdog_cleanup { + local $SIG{INT} = sub { $signal = 'INT' }; + local $SIG{TERM} = sub { $signal = 'TERM' }; + my %owned = ($pid => 0); + my (%frozen, $parents, $error); + eval { + # The unreaped fork child is the ownership root, never a name/PGID match. + # Freeze each newly discovered generation before the next observation. + while (1) { + for my $owner (keys %owned) { + kill 'STOP', $owner unless $frozen{$owner}++; + } + $parents = process_snapshot($end - 0.1); + die "owned backend missing from observation\n" unless exists $parents->{$pid}; + my $added = 0; + for my $child (keys %$parents) { + next if exists $owned{$child}; + my ($ancestor, $depth, %seen) = ($child, 0); + while (exists $parents->{$ancestor} && !exists $owned{$ancestor} && !$seen{$ancestor}++) { + $ancestor = $parents->{$ancestor}; + ++$depth; + } + if (exists $owned{$ancestor}) { + $owned{$child} = $owned{$ancestor} + $depth; + $added = 1; + } + } + last unless $added; + } + 1; + } or $error = $@; + for my $child (sort { $owned{$b} <=> $owned{$a} } grep { $_ != $pid } keys %owned) { + kill 'KILL', $child; + my $parent = $parents ? $parents->{$child} : undef; + # Keep the backend frozen until all descendants are killed. Only the + # child's still-owned parent gets a bounded opportunity to reap it. + if (defined($parent) && $parent != $pid && exists $owned{$parent}) { + kill 'CONT', $parent; + sleep 0.02 if clock_gettime(CLOCK_MONOTONIC) < $end - 0.2; + kill 'STOP', $parent; + } + } + request_cleanup(); + my $grace_end = clock_gettime(CLOCK_MONOTONIC) + 0.1; + $grace_end = $end - 0.2 if $grace_end > $end - 0.2; + while (clock_gettime(CLOCK_MONOTONIC) < $grace_end) { + if (waitpid($pid, WNOHANG) == $pid) { + $backend_reaped = 1; + last; + } + sleep 0.02; + } + if (!$backend_reaped) { + kill 'KILL', $pid; + waitpid($pid, 0); + $backend_reaped = 1; + } + die $error if $error; + while (1) { + my $remaining = process_snapshot($end); + my @left = grep { exists $remaining->{$_} } keys %owned; + last unless @left; + die "owned PIDs remain: @left\n" if clock_gettime(CLOCK_MONOTONIC) >= $end - 0.02; + sleep 0.01; + } + print "CLEANUP: owned processes absent; PTYs closed\n"; +} + +while (1) { + my $reaped = waitpid($pid, WNOHANG); + if ($reaped == $pid) { + my $status = $?; + $backend_reaped = 1; + die "PTY backend interrupted\n" if $signal; + exit(($status & 127) ? 1 : $status >> 8); + } + die "cannot reap PTY backend\n" if $reaped == -1; + my $now = clock_gettime(CLOCK_MONOTONIC); + request_cleanup() if !$requested && $now >= $deadline - 2; + if ($now >= $deadline) { + eval { watchdog_cleanup(); 1 } or warn "cleanup: watchdog: $@"; + # Even a failed observation must not leave the direct backend running. + if (!$backend_reaped) { + kill 'KILL', $pid; + waitpid($pid, 0); + $backend_reaped = 1; + } + die "PTY backend exceeded whole-run deadline\n"; + } + sleep 0.02; +} diff --git a/src/infrastructure/acl/syscall-process-substitution.lisp b/src/infrastructure/acl/syscall-process-substitution.lisp index 4d4665c4..39654e77 100644 --- a/src/infrastructure/acl/syscall-process-substitution.lisp +++ b/src/infrastructure/acl/syscall-process-substitution.lisp @@ -111,10 +111,13 @@ owns the parent-side fd and the child processes until it is closed." "Wait for RESOURCE's process substitution child processes." (let ((processes (process-substitution-resource-processes resource))) (unwind-protect - (if processes - (%wait-pipeline-processes processes) - 0) - (setf (process-substitution-resource-processes resource) nil)))) + (multiple-value-prog1 + (if processes + (%wait-pipeline-processes processes) + 0) + (setf (process-substitution-resource-processes resource) nil)) + (when (process-substitution-resource-processes resource) + (close-process-substitution resource))))) (defun close-process-substitution (resource) "Release RESOURCE's fd and terminate/wait any remaining child processes." diff --git a/src/infrastructure/acl/syscall-process.lisp b/src/infrastructure/acl/syscall-process.lisp index eddd3443..bf2d201e 100644 --- a/src/infrastructure/acl/syscall-process.lisp +++ b/src/infrastructure/acl/syscall-process.lisp @@ -6,8 +6,8 @@ (defun %spawn-terminal-command (command args) (multiple-value-bind (resolved environment) (%prepare-external-command command) (when resolved - (%spawn-in-own-process-group resolved args environment *standard-input* t - :error t)))) + ;; Hold user code until the caller hands this process group the terminal. + (%run-pipeline-command command args *standard-input* t t environment resolved)))) (defun process-pid (process) (if (pty-process-p process) diff --git a/src/infrastructure/assistant-sidecar-stream.lisp b/src/infrastructure/assistant-sidecar-stream.lisp index d26b6954..ca1efe8a 100644 --- a/src/infrastructure/assistant-sidecar-stream.lisp +++ b/src/infrastructure/assistant-sidecar-stream.lisp @@ -53,7 +53,8 @@ (eq handle (assistant-sidecar-state-handle state))) (let ((pending (assistant-sidecar-state-pending state))) (values pending - (and pending (assistant-pending-cell-generation pending))))))) + (and pending (assistant-pending-cell-generation pending)) + t))))) (defun %assistant-sidecar-set-pending (state pending) (sb-thread:with-mutex ((assistant-sidecar-state-lock state)) @@ -88,9 +89,9 @@ (multiple-value-bind (object status message) (%assistant-read-json-value (nshell.infrastructure.acl:sidecar-handle-output handle)) - (multiple-value-bind (pending pending-generation) + (multiple-value-bind (pending pending-generation current-p) (%assistant-sidecar-reader-pending state handle generation) - (unless pending + (unless current-p (return)) (case status (:value @@ -117,15 +118,20 @@ (ignore-errors (sb-ext:process-wait (nshell.infrastructure.acl:sidecar-handle-process handle))) - (%assistant-sidecar-mark-dead state :reader-eof) - (when pending - (%assistant-sidecar-publish - pending - (%assistant-sidecar-error-event - pending-generation - "assistant sidecar process exited before the pending request completed")) - (%assistant-sidecar-complete pending)) - (%assistant-sidecar-stop-state state :preserve-pending-p t) + ;; A request can arrive while PROCESS-WAIT reaps the child. Settle + ;; the cell captured by the identity-validated stop transition. + (multiple-value-bind (stopped-p stopped-pending) + (%assistant-sidecar-stop-state + state :preserve-pending-p t + :expected-handle handle :expected-generation generation + :dead-reason :reader-eof) + (when (and stopped-p stopped-pending) + (%assistant-sidecar-publish + stopped-pending + (%assistant-sidecar-error-event + (assistant-pending-cell-generation stopped-pending) + "assistant sidecar process exited before the pending request completed")) + (%assistant-sidecar-complete stopped-pending))) (return)) (otherwise (when (and (eq status :error) @@ -238,14 +244,25 @@ (%assistant-sidecar-close-channel (assistant-pending-cell-events pending)))) -(defun %assistant-sidecar-stop-state (state &key preserve-pending-p preserve-starting-p) - (let (pending write-channel handle startup reader writer error-thread) +(defun %assistant-sidecar-stop-state (state &key preserve-pending-p preserve-starting-p + (expected-handle nil expected-handle-p) + expected-generation dead-reason) + (let (pending write-channel handle startup reader writer error-thread stopping-generation) (sb-thread:with-mutex ((assistant-sidecar-state-lock state)) + (when (and expected-handle-p + (not (and (eq expected-handle (assistant-sidecar-state-handle state)) + (eql expected-generation + (assistant-sidecar-state-startup-generation state))))) + (return-from %assistant-sidecar-stop-state nil)) + (when dead-reason + (setf (assistant-sidecar-state-dead-p state) t + (assistant-sidecar-state-dead-reason state) dead-reason)) (unless preserve-starting-p (setf (assistant-sidecar-state-starting-p state) nil (assistant-sidecar-state-startup-generation state) (1+ (assistant-sidecar-state-startup-generation state)))) - (setf pending (assistant-sidecar-state-pending state) + (setf stopping-generation (assistant-sidecar-state-startup-generation state) + pending (assistant-sidecar-state-pending state) write-channel (assistant-sidecar-state-write-channel state) handle (assistant-sidecar-state-handle state) startup (assistant-sidecar-state-start-thread state) @@ -270,14 +287,17 @@ (%assistant-sidecar-join-thread writer) (%assistant-sidecar-join-thread error-thread) (sb-thread:with-mutex ((assistant-sidecar-state-lock state)) - (setf (assistant-sidecar-state-handle state) nil - (assistant-sidecar-state-init-p state) nil - (assistant-sidecar-state-reader-thread state) nil - (assistant-sidecar-state-writer-thread state) nil - (assistant-sidecar-state-error-thread state) nil - (assistant-sidecar-state-write-channel state) nil - (assistant-sidecar-state-start-thread state) nil)) - t)) + (when (and (eq handle (assistant-sidecar-state-handle state)) + (eql stopping-generation + (assistant-sidecar-state-startup-generation state))) + (setf (assistant-sidecar-state-handle state) nil + (assistant-sidecar-state-init-p state) nil + (assistant-sidecar-state-reader-thread state) nil + (assistant-sidecar-state-writer-thread state) nil + (assistant-sidecar-state-error-thread state) nil + (assistant-sidecar-state-write-channel state) nil + (assistant-sidecar-state-start-thread state) nil))) + (values t pending))) (defun %assistant-sidecar-start-thread (state) (sb-thread:with-mutex ((assistant-sidecar-state-lock state)) diff --git a/src/infrastructure/persistence/file-history.lisp b/src/infrastructure/persistence/file-history.lisp index dbd9c665..2cbb6b29 100644 --- a/src/infrastructure/persistence/file-history.lisp +++ b/src/infrastructure/persistence/file-history.lisp @@ -25,6 +25,7 @@ (defvar *history-record-tables* (make-hash-table :test #'eq)) (defvar *history-record-to-append* nil) +(defvar *history-file-lock* (sb-thread:make-mutex :name "nshell history file")) (defun %make-history-record-from-values (&key text timestamp cwd exit-code duration-ms origin) (check-type text string) @@ -114,7 +115,7 @@ (let ((payload (make-string length))) (if (= length (read-sequence payload stream)) (let ((separator (read-char stream nil nil))) - (if (or (null separator) (char= separator #\Newline)) + (if (eql separator #\Newline) (case version (:v2 (values (%make-history-record-from-values :text payload) @@ -151,6 +152,48 @@ (length payload) payload))) +(defun %open-history-stream (path &key append) + (let ((fd (handler-case + (if append + (handler-case + (sb-posix:open (namestring path) + (logior sb-posix:o-rdwr sb-posix:o-creat + sb-posix:o-excl sb-posix:o-nofollow + sb-posix:o-nonblock) + #o600) + (sb-posix:syscall-error (condition) + (if (= (sb-posix:syscall-errno condition) sb-posix:eexist) + (sb-posix:open (namestring path) + (logior sb-posix:o-rdwr sb-posix:o-nofollow + sb-posix:o-nonblock)) + (error condition)))) + (sb-posix:open (namestring path) + (logior sb-posix:o-rdonly sb-posix:o-nofollow + sb-posix:o-nonblock))) + (sb-posix:syscall-error (condition) + (if (and (not append) + (= (sb-posix:syscall-errno condition) sb-posix:enoent)) + nil + (error condition)))))) + (when fd + (handler-case + (let ((stat (sb-posix:fstat fd))) + (unless (and (sb-posix:s-isreg (sb-posix:stat-mode stat)) + (= (sb-posix:stat-uid stat) (sb-posix:getuid)) + (= (sb-posix:stat-nlink stat) 1)) + (error "History must be a regular, singly-linked file owned by this user.")) + (sb-posix:fchmod fd #o600) + ;; Never wait on another shell while handling interactive input. + ;; The descriptor starts at zero, so a zero-length lock covers the file. + (when append (sb-posix:lockf fd sb-posix:f-tlock 0)) + (sb-sys:make-fd-stream fd :input t :output append + :element-type 'character + :external-format :utf-8 :auto-close t + :pathname (pathname path))) + (error (condition) + (sb-posix:close fd) + (error condition)))))) + (defun %history-record-table (history) (or (gethash history *history-record-tables*) (setf (gethash history *history-record-tables*) @@ -229,22 +272,25 @@ (defun load-history-file () "Return v3 records oldest first, promoting v2 records with NIL metadata." (let ((path (history-file-path))) - (when (probe-file path) - (handler-case - (with-open-file (f path :direction :input :if-does-not-exist nil) - (multiple-value-bind (records status) (%read-history-records f) - (when status - (%report-history-error "read" path - (format nil "~a history record" status))) - records)) - (condition (condition) - (%report-history-error "read" path condition) - nil))))) + (handler-case + ;; Closing any descriptor releases this process's POSIX file locks. + (sb-thread:with-mutex (*history-file-lock*) + (let ((stream (%open-history-stream path))) + (when stream + (with-open-stream (f stream) + (multiple-value-bind (records status) (%read-history-records f) + (when status + (%report-history-error "read" path + (format nil "~a history record" status))) + records))))) + (condition (condition) + (%report-history-error "read" path condition) + nil)))) (defun append-history-entry (text &key timestamp cwd exit-code duration-ms origin) (let ((path (history-file-path))) (handler-case - (progn + (sb-thread:with-mutex (*history-file-lock*) (ensure-directories-exist path) (let ((record (or *history-record-to-append* (%make-history-record-from-values @@ -256,9 +302,14 @@ :origin origin)))) (unless (string= text (history-record-text record)) (error "History record text does not match the appended command.")) - (with-open-file (f path :direction :output - :if-exists :append :if-does-not-exist :create) - (%append-history-record f record)))) + (with-open-stream (f (%open-history-stream path :append t)) + (multiple-value-bind (records status) (%read-history-records f) + (declare (ignore records)) + (when status + (error "~a history record; existing bytes were preserved." status))) + (file-position f :end) + (%append-history-record f record) + (finish-output f)))) (condition (condition) (%report-history-error "append to" path condition) nil)))) diff --git a/src/infrastructure/terminal/input-core.lisp b/src/infrastructure/terminal/input-core.lisp index 33d1bb6c..914f7ba1 100644 --- a/src/infrastructure/terminal/input-core.lisp +++ b/src/infrastructure/terminal/input-core.lisp @@ -26,6 +26,7 @@ (20 . :ctrl-t) (21 . :ctrl-u) (23 . :ctrl-w) + (24 . :ctrl-x) (25 . :ctrl-y) (29 . :ctrl-right-bracket) (31 . :ctrl-underscore) diff --git a/src/infrastructure/terminal/linux-abi/termios2.lisp b/src/infrastructure/terminal/linux-abi/termios2.lisp new file mode 100644 index 00000000..5a526c27 --- /dev/null +++ b/src/infrastructure/terminal/linux-abi/termios2.lisp @@ -0,0 +1,17 @@ +("asm/termbits.h" "asm/ioctls.h") + +((:integer-no-check +kernel-tcgets2+ "(unsigned long) TCGETS2") + (:integer-no-check +kernel-tcsets2+ "(unsigned long) TCSETS2") + (:type kernel-cc-t "cc_t") + (:type kernel-speed-t "speed_t") + (:type kernel-flag-t "tcflag_t") + (:structure kernel-termios2 + ("struct termios2" + (kernel-flag-t input-flags "tcflag_t" "c_iflag") + (kernel-flag-t output-flags "tcflag_t" "c_oflag") + (kernel-flag-t control-flags "tcflag_t" "c_cflag") + (kernel-flag-t local-flags "tcflag_t" "c_lflag") + (kernel-cc-t discipline "cc_t" "c_line") + ((array kernel-cc-t) control-chars "cc_t" "c_cc") + (kernel-speed-t input-speed "speed_t" "c_ispeed") + (kernel-speed-t output-speed "speed_t" "c_ospeed")))) diff --git a/src/infrastructure/terminal/raw-mode.lisp b/src/infrastructure/terminal/raw-mode.lisp index 00411b4c..5d19b914 100644 --- a/src/infrastructure/terminal/raw-mode.lisp +++ b/src/infrastructure/terminal/raw-mode.lisp @@ -12,15 +12,9 @@ ;;; full cfmakeraw-style mode -- and two of the extra bits are load-bearing for ;;; a shell: ;;; -;;; ISIG nshell leaves it SET. enable-raw-mode is called once per session -;;; (repl-session.lisp) and stays in effect while a foreground child -;;; runs; manage-job.lisp hands the terminal to the child's process -;;; group but never returns the tty to cooked mode. ISIG is what makes -;;; the kernel turn ^C/^Z into SIGINT/SIGTSTP for that foreground -;;; group, which is how `sleep 100` gets interrupted and how the -;;; shell-sigtstp-handler / fg / bg job-control path is driven at all. -;;; Clearing it would deliver a bare #\Etx byte to the reader instead -;;; and leave foreground jobs uninterruptible. +;;; ISIG nshell leaves it SET so the kernel turns ^C/^Z into signals for +;;; the foreground process group. Foreground commands receive cooked +;;; settings; the editor must retain signal delivery when it resumes. ;;; OPOST nshell leaves it SET. Both nshell's own output (every `~%' in the ;;; presentation tier) and the inherited output of every child process ;;; rely on the driver mapping LF to CR-LF; clearing it makes all @@ -74,18 +68,79 @@ has put that fd into raw mode.") (defun %forget-termios (fd) (setf *saved-termios* (delete fd *saved-termios* :key #'car :test #'eql))) +;; SB-POSIX's Lisp conversion omits native fields, including Darwin's speeds. +;; Linux libc can also normalize CIBAUD during tcgetattr/tcsetattr. Use the +;; kernel's termios2 ABI there so restoring a snapshot preserves those bits. +(sb-alien:define-alien-type native-termios + #+linux kernel-termios2 + #-linux sb-posix::alien-termios) + +#+linux +(sb-alien:define-alien-routine ("ioctl" %termios-ioctl) sb-alien:int + (fd sb-alien:int) + (request sb-alien:unsigned-long) + (termios sb-sys:system-area-pointer)) + +#-linux +(sb-alien:define-alien-routine ("tcgetattr" %tcgetattr) sb-alien:int + (fd sb-alien:int) + (termios sb-sys:system-area-pointer)) + +#-linux +(sb-alien:define-alien-routine ("tcsetattr" %tcsetattr) sb-alien:int + (fd sb-alien:int) + (action sb-alien:int) + (termios sb-sys:system-area-pointer)) + +(defun %read-termios (fd) + (let ((termios (make-array (sb-alien:alien-size native-termios :bytes) + :element-type '(unsigned-byte 8) + :initial-element 0))) + (sb-sys:with-pinned-objects (termios) + (when (minusp + #+linux + (%termios-ioctl fd + (ldb (byte (sb-alien:alien-size sb-alien:unsigned-long) 0) + +kernel-tcgets2+) + (sb-sys:vector-sap termios)) + #-linux + (%tcgetattr fd (sb-sys:vector-sap termios))) + (let ((errno (sb-unix::get-errno))) + (error "Terminal query failed on fd ~d (errno=~d)" fd errno)))) + termios)) + +(defun %apply-termios (fd termios) + (sb-sys:with-pinned-objects (termios) + (when (minusp + #+linux + (%termios-ioctl fd + (ldb (byte (sb-alien:alien-size sb-alien:unsigned-long) 0) + +kernel-tcsets2+) + (sb-sys:vector-sap termios)) + #-linux + (%tcsetattr fd sb-posix:tcsanow (sb-sys:vector-sap termios))) + (let ((errno (sb-unix::get-errno))) + (error "Terminal update failed on fd ~d (errno=~d)" fd errno))))) + (defun %raw-termios (termios) "Clear the input and local flags nshell's line editor needs off TERMIOS. ICANON and ECHO give the editor character-at-a-time input and full control of what is displayed; IXON and IXOFF stop ^S/^Q from being eaten as flow control. Everything else -- notably ISIG and OPOST -- is left as the terminal had it; see the commentary at the top of this file." - (setf (sb-posix:termios-iflag termios) - (logand (sb-posix:termios-iflag termios) - (lognot (logior sb-posix:ixon sb-posix:ixoff)))) - (setf (sb-posix:termios-lflag termios) - (logand (sb-posix:termios-lflag termios) - (lognot (logior sb-posix:icanon sb-posix:echo)))) + (sb-sys:with-pinned-objects (termios) + (let ((native (sb-alien:sap-alien (sb-sys:vector-sap termios) + (* native-termios)))) + (setf (sb-alien:slot (sb-alien:deref native) + #+linux 'input-flags #-linux 'sb-posix::iflag) + (logand (sb-alien:slot (sb-alien:deref native) + #+linux 'input-flags #-linux 'sb-posix::iflag) + (lognot (logior sb-posix:ixon sb-posix:ixoff)))) + (setf (sb-alien:slot (sb-alien:deref native) + #+linux 'local-flags #-linux 'sb-posix::lflag) + (logand (sb-alien:slot (sb-alien:deref native) + #+linux 'local-flags #-linux 'sb-posix::lflag) + (lognot (logior sb-posix:icanon sb-posix:echo)))))) termios) (defun enable-raw-mode (&optional (fd 0)) @@ -95,7 +150,7 @@ back. Calling this again while FD is already raw re-applies the mode without disturbing the remembered settings. Signals TERMINAL-MODE-OPERATION-FAILED if the terminal cannot be queried or reconfigured." (handler-case - (let ((raw (%raw-termios (sb-posix:tcgetattr fd)))) + (let ((raw (%raw-termios (%read-termios fd)))) ;; The drain is deliberately OUTSIDE the guard below, and has to stay ;; there. It waits for the terminal's output queue to empty, which is ;; not a bounded wait: a terminal stopped by ^S (IXON is still set at @@ -135,8 +190,8 @@ the terminal cannot be queried or reconfigured." ;; saving raw settings as the way back. (sb-sys:without-interrupts (unless (%saved-termios fd) - (%save-termios fd (sb-posix:tcgetattr fd))) - (sb-posix:tcsetattr fd sb-posix:tcsanow raw) + (%save-termios fd (%read-termios fd))) + (%apply-termios fd raw) t)) (error (condition) (error 'terminal-mode-operation-failed @@ -164,7 +219,7 @@ the terminal in an unknown state silently." ;; this %FORGET-TERMIOS discards the cooked settings that were the ;; only way back. The terminal is stranded raw for good. (sb-sys:without-interrupts - (sb-posix:tcsetattr fd sb-posix:tcsanow saved) + (%apply-termios fd saved) (%forget-termios fd) t)) (error (condition) diff --git a/src/presentation/repl-output-handlers.lisp b/src/presentation/repl-output-handlers.lisp index 37d9313d..94c7e15c 100644 --- a/src/presentation/repl-output-handlers.lisp +++ b/src/presentation/repl-output-handlers.lisp @@ -878,7 +878,45 @@ wrapped line's other rows on screen as stale duplicates." (format nil "安全性: ~(~a~)（~a）" (getf assessment :classification) (getf assessment :reason)) - "確認するにはもう一度 Ctrl-X を押してください。その他のキーで取り消します。")) + (format nil "確認するにはもう一度 ~{~a~^ / ~} を押してください。その他のキーで取り消します。" + (loop for (key . action) in (input-dispatch-bindings-listing) + when (string= action "rerun-last-command") + collect key)))) + +(defun %rerun-confirmation-panel-lines (assessment) + (let ((width (- (terminal-width) 4)) + (lines nil)) + (unless (plusp width) + (return-from %rerun-confirmation-panel-lines nil)) + (dolist (line (%rerun-panel-lines assessment)) + (when (some (lambda (char) + (let ((code (char-code char))) + (or (< code 32) (<= 127 code 159)))) + line) + (return-from %rerun-confirmation-panel-lines nil)) + (let ((graphemes nil) + (line-width 0)) + (dolist (grapheme (cl-tty-kit:string-graphemes line)) + (let ((grapheme-width (%grapheme-visible-width grapheme))) + (when (> grapheme-width width) + (return-from %rerun-confirmation-panel-lines nil)) + (when (> (+ line-width grapheme-width) width) + (push (format nil "~{~a~}" (nreverse graphemes)) lines) + (setf graphemes nil line-width 0)) + (push grapheme graphemes) + (incf line-width grapheme-width))) + (push (format nil "~{~a~}" (nreverse graphemes)) lines))) + (when (<= (+ 2 (length lines)) + (max 0 (- (%transient-panel-terminal-rows) + *prompt-rendered-lines* 1))) + (nreverse lines)))) + +(defun %reject-incomplete-rerun-confirmation () + (setf *rerun-confirmation-pending-p* nil + *rerun-command-assessment* nil) + (render-transient-panel + '("確認内容を全て表示できないため、出力捕捉による再実行を拒否しました。" + "端末を広げ、表示できない制御文字を含まないコマンドを使用してください。"))) (defun %process-rerun-last-command-output-event () (cond @@ -896,9 +934,13 @@ wrapped line's other rows on screen as stale duplicates." (list (format nil "出力捕捉による再実行を拒否: ~a" (getf assessment :reason)) (format nil "コマンド: ~a" *last-command-text*))) - (progn - (setf *rerun-confirmation-pending-p* t) - (render-transient-panel (%rerun-panel-lines assessment))))))) + (let ((lines (%rerun-confirmation-panel-lines assessment))) + (if lines + (progn + (setf *rerun-confirmation-pending-p* t) + (render-transient-panel lines) + (setf *preserve-transient-panel-on-next-prompt-p* t)) + (%reject-incomplete-rerun-confirmation))))))) (t (let ((assessment *rerun-command-assessment*)) (setf *rerun-confirmation-pending-p* nil @@ -909,14 +951,21 @@ wrapped line's other rows on screen as stale duplicates." (with-cleared-rendered-completions-and-prompt-cont (render-transient-panel '("安全でない、または対話型のコマンドのため、出力捕捉による再実行を拒否しました。"))) - (progn - (clear-rendered-transient-panel) - (setf *input-state* - (make-repl-input-state - :buffer *last-command-text* - :cursor-pos (length *last-command-text*))) - (let ((*capture-command-output-p* t)) - (%process-execute-output-event)))))))) + (if (let ((lines (%rerun-confirmation-panel-lines assessment))) + (not (and lines + (equal lines *transient-panel-content*) + (= (+ 2 (length lines)) + *transient-panel-rendered-lines*)))) + (with-cleared-rendered-completions-and-prompt-cont + (%reject-incomplete-rerun-confirmation)) + (progn + (clear-rendered-transient-panel) + (setf *input-state* + (make-repl-input-state + :buffer *last-command-text* + :cursor-pos (length *last-command-text*))) + (let ((*capture-command-output-p* t)) + (%process-execute-output-event))))))))) (defun %execute-command-line (text) (if (%assistant-proposal-confirmation-required-p) diff --git a/src/presentation/repl.lisp b/src/presentation/repl.lisp index 3c9e7ee6..c40f5940 100644 --- a/src/presentation/repl.lisp +++ b/src/presentation/repl.lisp @@ -3,6 +3,10 @@ (in-package #:nshell.presentation) (defun %render-prompt-after-terminal-resize () + (when *rerun-confirmation-pending-p* + (setf *rerun-confirmation-pending-p* nil + *rerun-command-assessment* nil) + (clear-rendered-transient-panel)) (let ((*preserve-transient-panel-on-next-prompt-p* t)) (render-prompt-cont))) @@ -95,6 +99,21 @@ (setf *input-state* new-state) (process-output-event output-event)))))) +(defun %process-input-event (event) + (when (and *rerun-confirmation-pending-p* + (nshell.infrastructure.acl:consume-terminal-resize-p)) + (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 (not (eq output-event :rerun-last-command)) + (or *rerun-confirmation-pending-p* *rerun-command-assessment*)) + (setf *rerun-confirmation-pending-p* nil + *rerun-command-assessment* nil) + (clear-rendered-transient-panel)) + (setf *assistant-last-cancel-at* nil + *input-state* new-state) + (process-output-event output-event))) + (defun read-key-cont () (if (nshell.infrastructure.acl:consume-terminal-resize-p) (lambda () (%render-prompt-after-terminal-resize)) @@ -109,6 +128,9 @@ raw-event) (%map-rendered-mouse-event-to-buffer raw-event)))) (cond + ((and *rerun-confirmation-pending-p* + (nshell.infrastructure.acl:consume-terminal-resize-p)) + (lambda () (%render-prompt-after-terminal-resize))) ((nshell.feature.assistant:assistant-model-event-p raw-event) (lambda () (when (eql *assistant-turn-generation* @@ -118,6 +140,8 @@ (when (functionp *assistant-model-event-handler*) (funcall *assistant-model-event-handler* raw-event))) (read-key-cont))) + ((and event *rerun-confirmation-pending-p*) + (lambda () (%process-input-event event))) ((and event *command-not-found-fallback-text*) (lambda () (%process-command-not-found-fallback-event event))) ((and event (%transient-panel-expand-event-p event)) @@ -141,17 +165,7 @@ ((%assistant-repeat-cancel-event-p event) (lambda () (process-output-event :ask-cancel-turn))) (event - (lambda () - (when (or *rerun-confirmation-pending-p* - *rerun-command-assessment*) - (setf *rerun-confirmation-pending-p* nil) - (setf *rerun-command-assessment* nil) - (clear-rendered-transient-panel)) - (setf *assistant-last-cancel-at* nil) - (multiple-value-bind (new-state output-event) - (reduce-input-state *input-state* event) - (setf *input-state* new-state) - (process-output-event output-event)))) + (lambda () (%process-input-event event))) ((nshell.infrastructure.acl:consume-terminal-resize-p) (lambda () (%render-prompt-after-terminal-resize))) (t diff --git a/t/e2e/test-smoke.lisp b/t/e2e/test-smoke.lisp index dcdcc931..ba193cc0 100644 --- a/t/e2e/test-smoke.lisp +++ b/t/e2e/test-smoke.lisp @@ -525,8 +525,15 @@ The regular read timeout remains short for command-response assertions.") :cols 100)) (let ((fd (nshell.infrastructure.acl:pty-process-master-fd pty))) (%e2e-pty-await-ready fd) - (%e2e-pty-write-line fd "sh -c 'sleep 2; printf \"pty-%s\\n\" outlived-timeout' | cat") + ;; Enter accepts autosuggestions; this probe must execute exactly cat. + (%e2e-pty-write-line + fd + (format nil "~A~C" + "sh -c 'sleep 2; printf \"pty-%s\\n\" outlived-timeout' | cat" + (code-char 7))) (let ((output (%e2e-pty-read-until fd "pty-outlived-timeout" :attempts 220))) + (unless (search "pty-outlived-timeout" output) + (format *error-output* "~&Foreground pipeline PTY transcript: ~S~%" output)) (expect (search "pty-outlived-timeout" output) :to-be-truthy) (expect (search "timed out after" output) :to-be-falsy)) (%e2e-pty-write-line fd "exit") diff --git a/t/integration/test-file-history.lisp b/t/integration/test-file-history.lisp index e0279203..48d96b3d 100644 --- a/t/integration/test-file-history.lisp +++ b/t/integration/test-file-history.lisp @@ -21,6 +21,21 @@ (setf nshell.infrastructure.persistence:*history-file-path-override* nil) (when (probe-file test-path) (delete-file test-path))))) + (it "file-history-path-designators-round-trip" + (with-temporary-output-file (test-path :prefix "nshell-history-designators") + (dolist (designator (list (pathname test-path) test-path)) + (let ((nshell.infrastructure.persistence:*history-file-path-override* + designator)) + (nshell.infrastructure.persistence:append-history-entry "older") + (nshell.infrastructure.persistence:append-history-entry "newer") + (expect '("older" "newer") + :to-equal + (mapcar #'nshell.infrastructure.persistence:history-record-text + (nshell.infrastructure.persistence:load-history-file))) + (expect #o600 :to-equal + (logand #o777 (sb-posix:stat-mode (sb-posix:stat test-path)))) + (delete-file test-path))))) + (it "file-history-multiline-round-trip" "Multiline command history survives persistence." (let* ((test-path (format nil "/tmp/nshell-test-history-multiline-~d.lisp" diff --git a/t/integration/test-process.lisp b/t/integration/test-process.lisp index 73722ce7..c79694cd 100644 --- a/t/integration/test-process.lisp +++ b/t/integration/test-process.lisp @@ -13,6 +13,27 @@ form)) (describe "process-tests" + (it "spawn-terminal-command-stops-before-running-user-code" + (with-temporary-output-file (target :prefix "nshell-terminal-barrier") + (let ((process nil)) + (unwind-protect + (progn + (setf process + (nshell.infrastructure.acl:%spawn-terminal-command + "/bin/sh" + (list "-c" "printf started > \"$1\"" "nshell-test" target))) + (expect :stopped :to-equal (sb-ext:process-status process)) + (expect (sb-ext:process-pid process) :to-equal + (sb-posix:getpgid (sb-ext:process-pid process))) + (expect (probe-file target) :to-be-null) + (nshell.infrastructure.acl:process-continue process) + (sb-ext:process-wait process) + (expect 0 :to-equal + (nshell.infrastructure.acl:process-exit-status-code process)) + (expect "started" :to-equal (host-kit:read-file-string target))) + (nshell.infrastructure.acl::%terminate-process process) + (when process (sb-ext:process-close process)))))) + (it "spawn-pipeline-timeout-covers-orphaned-output-writer" (with-temporary-output-file (pid-file :prefix "nshell-pipeline-orphan") (let ((worker nil) (result nil) (failure nil) (joined nil)) diff --git a/t/integration/test-terminal-stream.lisp b/t/integration/test-terminal-stream.lisp index b3d5f631..67a566cf 100644 --- a/t/integration/test-terminal-stream.lisp +++ b/t/integration/test-terminal-stream.lisp @@ -25,6 +25,7 @@ (20 . :ctrl-t) (21 . :ctrl-u) (23 . :ctrl-w) + (24 . :ctrl-x) (25 . :ctrl-y) (31 . :ctrl-underscore))) (events (read-key-events-from-string diff --git a/t/integration/test-terminal.lisp b/t/integration/test-terminal.lisp index 361e0c36..8f85789f 100644 --- a/t/integration/test-terminal.lisp +++ b/t/integration/test-terminal.lisp @@ -59,16 +59,57 @@ under test. sb-posix does not name either constant, hence the literals." "FD's lflag with the driver's own status bits masked out." (logandc2 (%lflag fd) (%transient-lflag-bits))) +#+(or darwin linux) +(defun %native-baud-rates (fd) + ;; Use the grovelled native size only, bypassing Lisp termios conversion and + ;; observing both speeds through libc rather than SB-POSIX field accessors. + (sb-alien:with-alien ((storage sb-posix::alien-termios)) + (let ((pointer (sb-alien:cast (sb-alien:addr storage) (* t)))) + (unless (zerop + (sb-alien:alien-funcall + (sb-alien:extern-alien "tcgetattr" + (function sb-alien:int sb-alien:int (* t))) + fd pointer)) + (error "Native tcgetattr failed for fd ~D" fd)) + (list + (sb-alien:alien-funcall + (sb-alien:extern-alien "cfgetispeed" + (function #+darwin sb-alien:unsigned-long + #+linux sb-alien:unsigned-int (* t))) + pointer) + (sb-alien:alien-funcall + (sb-alien:extern-alien "cfgetospeed" + (function #+darwin sb-alien:unsigned-long + #+linux sb-alien:unsigned-int (* t))) + pointer))))) + +#+linux +(defun %kernel-preserved-terminal-state (fd) + ;; Read through an independent ioctl call, not nshell's snapshot helper. + (sb-alien:with-alien + ((storage nshell.infrastructure.terminal::kernel-termios2)) + (unless (zerop + (sb-alien:alien-funcall + (sb-alien:extern-alien "ioctl" + (function sb-alien:int sb-alien:int sb-alien:unsigned-long (* t))) + fd + (ldb (byte (sb-alien:alien-size sb-alien:unsigned-long) 0) + nshell.infrastructure.terminal::+kernel-tcgets2+) + (sb-alien:cast (sb-alien:addr storage) (* t)))) + (error "Kernel terminal query failed for fd ~D" fd)) + (list (sb-alien:slot storage 'nshell.infrastructure.terminal::control-flags) + (sb-alien:slot storage 'nshell.infrastructure.terminal::output-flags) + (sb-alien:slot storage 'nshell.infrastructure.terminal::discipline) + (sb-alien:slot storage 'nshell.infrastructure.terminal::input-speed) + (sb-alien:slot storage 'nshell.infrastructure.terminal::output-speed)))) + (describe "terminal-raw-mode-tests" (it "raw-mode-clears-only-the-line-editor-flags" "Raw mode turns off ICANON/ECHO/IXON/IXOFF and leaves ISIG and OPOST set. -This is a regression guard, not an implementation detail. nshell enables raw -mode once per session and keeps it while a foreground child runs, so ISIG is -what still turns ^C/^Z into SIGINT/SIGTSTP for that child, and OPOST is what -still maps LF to CR-LF for nshell's own output and the child's. A full -cfmakeraw-style mode -- cl-tty-kit:enable-raw-mode, for instance -- clears both -and would break foreground job interruption and multi-line rendering." +ISIG keeps editor interrupts available after a foreground command returns; +OPOST preserves multi-line rendering. Foreground commands receive cooked +settings rather than inheriting the editor's mode." #-(or darwin linux) (skip "PTY-backed terminal tests are only supported on Darwin and Linux") #+(or darwin linux) @@ -97,6 +138,53 @@ raw mode with no matching restore, which is exactly this case." (nshell.infrastructure.terminal:restore-terminal-mode fd) (expect original-lflag :to-equal (%settings-lflag fd))))) + (it "raw-mode-preserves-native-baud-rates-through-repeated-enable-and-restore" + #-(or darwin linux) + (skip "PTY-backed terminal tests are only supported on Darwin and Linux") + #+(or darwin linux) + (with-pty-slave (fd) + (let ((nshell.infrastructure.terminal::*saved-termios* nil) + (baseline (%native-baud-rates fd)) + first-enable second-enable restored) + (cl-weave:expect-assertions 5) + (unwind-protect + (progn + (nshell.infrastructure.terminal:enable-raw-mode fd) + (setf first-enable (%native-baud-rates fd)) + (nshell.infrastructure.terminal:enable-raw-mode fd) + (setf second-enable (%native-baud-rates fd)) + (nshell.infrastructure.terminal:restore-terminal-mode fd) + (setf restored (%native-baud-rates fd))) + (nshell.infrastructure.terminal:restore-terminal-mode fd)) + (expect (plusp (first baseline)) :to-be-truthy) + (expect (plusp (second baseline)) :to-be-truthy) + (expect first-enable :to-equal baseline) + (expect second-enable :to-equal baseline) + (expect restored :to-equal baseline)))) + + #+linux + (it "raw-mode-preserves-kernel-control-flags-and-speeds" + (with-pty-slave (fd) + (let ((nshell.infrastructure.terminal::*saved-termios* nil) + (baseline (%kernel-preserved-terminal-state fd)) + first-enable second-enable restored) + (cl-weave:expect-assertions 6) + (unwind-protect + (progn + (nshell.infrastructure.terminal:enable-raw-mode fd) + (setf first-enable (%kernel-preserved-terminal-state fd)) + (nshell.infrastructure.terminal:enable-raw-mode fd) + (setf second-enable (%kernel-preserved-terminal-state fd)) + (nshell.infrastructure.terminal:restore-terminal-mode fd) + (setf restored (%kernel-preserved-terminal-state fd))) + (nshell.infrastructure.terminal:restore-terminal-mode fd)) + (expect (plusp (first baseline)) :to-be-truthy) + (expect (plusp (fourth baseline)) :to-be-truthy) + (expect (plusp (fifth baseline)) :to-be-truthy) + (expect first-enable :to-equal baseline) + (expect second-enable :to-equal baseline) + (expect restored :to-equal baseline)))) + (it "raw-mode-keeps-saved-settings-per-fd" "Two fds in raw mode at once each restore their own settings." #-(or darwin linux) diff --git a/t/scripts/test-release-pty.pl b/t/scripts/test-release-pty.pl new file mode 100644 index 00000000..13fff35c --- /dev/null +++ b/t/scripts/test-release-pty.pl @@ -0,0 +1,244 @@ +use strict; +use warnings; +use Test::More; +use Cwd qw(abs_path); +use File::Path qw(make_path); +use File::Temp qw(tempdir); +use FindBin qw($Bin); +use POSIX qw(WNOHANG); +use Time::HiRes qw(time sleep); + +my $repository = abs_path("$Bin/../.."); +my $runner = "$repository/scripts/test-release-pty.pl"; +my $root = tempdir('nshell-pty-fixtures-XXXXXX', TMPDIR => 1, CLEANUP => 1); +my $bash = '/bin/bash'; +BAIL_OUT('independent real-PTY fixtures require /bin/bash') unless -x $bash; + +sub write_file { + my ($path, $contents, $mode) = @_; + open my $fh, '>', $path or die "$path: $!"; + print {$fh} $contents or die $!; + close $fh or die $!; + chmod $mode, $path or die $! if defined $mode; +} + +sub read_file { + my ($path) = @_; + open my $fh, '<', $path or die "$path: $!"; + local $/; + return <$fh>; +} + +sub perl_literal { + my ($text) = @_; + $text =~ s/([\\'])/\\$1/g; + return "'$text'"; +} + +sub fixture { + my ($name) = @_; + my $bundle = "$root/$name bundle"; # Exercise argv paths, not shell interpolation. + make_path("$bundle/bin", "$bundle/libexec"); + my $rc = "$bundle/fixture.bashrc"; + my $trace = "$bundle/trace"; + my $job_trace = "$bundle/jobs"; + my $settings = <<'BASH'; +PS1=$NSHELL_PROMPT +PROMPT_COMMAND='status=$?' +HISTCONTROL= +HISTIGNORE= +HISTFILE=$HOME/.nshell_history +HISTSIZE=100 +HISTFILESIZE=100 +if [ "$FIXTURE_HISTORY" = off ]; then unset HISTFILE; fi +BASH + $settings .= "bind '\"\\C-h\":forward-char'\n" if $name eq 'bad-edit'; + $settings .= "unset HISTFILE\n" if $name eq 'no-history'; + $settings .= "trap '' INT\n" if $name eq 'ignored-pending'; + if ($name eq 'ansi-pending') { + # Consume the real pending input without rendering it; only emit ANSI color 91. + $settings .= <<'BASH'; +ansi_pending() { + local discarded + IFS= read -r -s -n 6 discarded + printf '%s\n' "$discarded" > "$FIXTURE_PENDING_TRACE" + bind '"e":self-insert' + READLINE_LINE= + READLINE_POINT=0 + printf '\033[1;91m\033[0m' +} +fixture_prompts=0 +PROMPT_COMMAND='status=$?; fixture_prompts=$((fixture_prompts + 1)); if [ "$fixture_prompts" = 3 ]; then bind -x '\''"e":ansi_pending'\''; fi' +BASH + } + $settings .= "PROMPT_COMMAND='status=\$?; set +m'\n" if $name eq 'no-job-control'; + $settings .= "jobs() { printf 'broken job table\\n'; }\n" if $name eq 'bad-jobs'; + make_path("$bundle/tools"); + my $sleep_program = '#!' . $^X . "\nuse strict; use warnings;\n"; + $sleep_program .= 'open my $log, ">>", ' . perl_literal($job_trace) . " or die \$!;\n"; + $sleep_program .= 'print {$log} "$$\n"; close $log;' . "\n"; + $sleep_program .= "\$SIG{INT} = 'IGNORE';\n" if $name eq 'ignored-foreground'; + $sleep_program .= 'exec "/bin/sleep", @ARGV; die $!;' . "\n"; + write_file("$bundle/tools/sleep", $sleep_program, 0755); + if ($name eq 'watchdog') { + # Independent wedged backend: real descendants, no cooperative TERM handler. + my $wedged = '#!' . $^X . "\nuse strict; use warnings;\n"; + $wedged .= '$SIG{TERM} = "IGNORE";' . "\n"; + $wedged .= '$ENV{HOME} = "$ARGV[3]/home"; my $child = fork // die $!;' . "\n"; + $wedged .= 'if (!$child) { exec $ARGV[2], "--no-config", "--no-history"; die $!; }' . "\n"; + $wedged .= 'sleep 30; waitpid($child, 0); sleep 30; exit 0;' . "\n"; + write_file("$bundle/tools/python3", $wedged, 0755); + } + $settings .= 'PATH=' . perl_literal("$bundle/tools:/usr/bin:/bin") . "\n"; + if ($name eq 'missing-job-marker') { + my $sh_program = '#!' . $^X . "\nuse strict; use warnings;\n"; + $sh_program .= 's{> /dev/tty}{> /dev/null}g for @ARGV; exec "/bin/sh", @ARGV; die $!;' . "\n"; + write_file("$bundle/tools/sh", $sh_program, 0755); + } + write_file($rc, $settings, 0600); + my $program = '#!' . $^X . "\nuse strict; use warnings;\n"; + $program .= 'open my $log, ">>", ' . perl_literal($trace) . " or die \$!;\n"; + $program .= 'print {$log} "$$|$ENV{HOME}|" . join(" ", @ARGV) . "\n"; close $log;' . "\n"; + $program .= <<'PERL'; +die "unexpected public CLI arguments" unless @ARGV >= 1 && $ARGV[0] eq '--no-config'; +die "unexpected public CLI arguments" if @ARGV > 2 || (@ARGV == 2 && $ARGV[1] ne '--no-history'); +$ENV{FIXTURE_HISTORY} = @ARGV == 2 ? 'off' : 'on'; +PERL + $program .= '$ENV{FIXTURE_PENDING_TRACE} = ' . perl_literal("$bundle/pending") . ";\n" + if $name eq 'ansi-pending'; + if ($name eq 'watchdog' || $name eq 'signal') { + # Synchronize on a real descendant, then stop the backend, not the runner. + $program .= 'my $backend = getppid(); my $child = fork // die $!;' . "\n"; + $program .= 'if (!$child) { exec "/bin/sleep", "30"; die $!; }' . "\n"; + $program .= 'kill "STOP", $backend or die $!;' . "\n"; + $program .= 'open my $jobs, ">>", ' . perl_literal($job_trace) . ' or die $!;' . "\n"; + $program .= 'print {$jobs} "$child\n"; close $jobs; sleep 30; exit 0;' . "\n"; + } elsif ($name eq 'hang') { + $program .= "sleep 30; exit 0;\n"; + } elsif ($name eq 'echo-only') { + $program .= 'print $ENV{NSHELL_PROMPT}; $|=1; while () { print $_; print $ENV{NSHELL_PROMPT}; } exit 0;' . "\n"; + } elsif ($name eq 'exit-zero') { + $program .= "exit 0;\n"; + } else { + # This is an independent interactive shell, not a canned expected-output transcript. + $program .= "system('/bin/stty', '-onlcr') == 0 or die 'stty failed';\n" + if $name eq 'bad-termios'; + $program .= 'exec ' . perl_literal($bash) . ', "--noprofile", "--rcfile", ' + . perl_literal($rc) . ', "-i"; die $!;' . "\n"; + } + write_file("$bundle/bin/nshell", $program, 0755); + write_file("$bundle/libexec/nshell", "\x7fELFfixture\n", 0755) if $name eq 'linux-elf'; + return ($bundle, $trace, $job_trace); +} + +sub run_fixture { + my ($name, $timeout) = @_; + my ($bundle, $trace, $job_trace) = fixture($name); + my $output = "$bundle/output"; + my $start = time; + my $pid = fork // die $!; + if (!$pid) { + open STDOUT, '>', $output or die $!; + open STDERR, '>&', \*STDOUT or die $!; + $ENV{PATH} = "$bundle/tools:$ENV{PATH}" if $name eq 'watchdog'; + exec $^X, $runner, $bundle, '--timeout', $timeout; + die $!; + } + my $end = time + $timeout + 5; + my $signalled = 0; + while (waitpid($pid, WNOHANG) == 0) { + if ($name eq 'signal' && !$signalled && -s $job_trace) { + kill 'TERM', $pid or die "cannot signal owned runner: $!"; + $signalled = 1; + } + if (time >= $end) { + kill 'TERM', $pid; + sleep 0.2; + kill 'KILL', $pid; + waitpid($pid, 0); + BAIL_OUT("$name runner exceeded test deadline"); + } + sleep 0.02; + } + my $status = $?; + my $text = read_file($output); + my @trace = -f $trace ? split(/\n/, read_file($trace)) : (); + for my $record (@trace) { + my ($child, $home, $arguments) = split /\|/, $record, 3; + ok(!kill(0, $child), "$name owned executable PID cleaned"); + ok(!-d $home, "$name isolated HOME removed"); + like($arguments, qr/^--no-config(?: --no-history)?$/, "$name public CLI only"); + } + my @jobs = -f $job_trace ? split(/\n/, read_file($job_trace)) : (); + for my $job (@jobs) { + like($job, qr/^\d+$/, "$name independent job PID trace"); + ok(!kill(0, $job), "$name owned job PID absent after cleanup (including zombies)"); + } + return ($status, $text, \@trace, time - $start, \@jobs); +} + +# An inherited HOME and injection variables must never reach the executable. +make_path("$root/user-home"); +write_file("$root/user-home/.nshell_history", "untouched-user-history\n", 0600); +local $ENV{HOME} = "$root/user-home"; +local $ENV{NSHELL_PROMPT} = 'incorrect-inherited-prompt'; +local $ENV{SBCL_HOME} = '/must/not/load'; +local $ENV{BASH_ENV} = '/must/not/load'; + +my ($status, $text, $records, $elapsed, $jobs) = run_fixture('control', 20); +is($status, 0, 'independent Bash control passes real PTY checks'); +diag($text) if $status; +like($text, qr/^PASS: 6 PTY checks; 3 executable sessions exited zero; owned processes cleaned$/m, + 'nonzero assertion and session completion counts'); +like($text, qr/^CLEANUP: owned processes absent; PTYs closed$/m, + 'control positively confirms cleanup completion'); +is(scalar @$records, 3, 'three actual executable launches'); +is(scalar @$jobs, 2, 'two independently observed foreground jobs'); +my @homes = map { (split /\|/)[1] } @$records; +is(scalar(keys %{ { map { $_ => 1 } @homes } }), 1, 'history restarts reuse the same isolated HOME'); +isnt($homes[0], $ENV{HOME}, 'fixture cannot touch inherited HOME'); + +for my $case ( + ['bad-edit', qr/FAIL: editing\/backspace:/], + ['echo-only', qr/FAIL: interactive readiness:/], + ['exit-zero', qr/FAIL: startup:/], + ['ignored-pending', qr/FAIL: Ctrl-C pending input:/], + ['ansi-pending', qr/FAIL: Ctrl-C pending input: expected output deadline exceeded/], + ['ignored-foreground', qr/FAIL: Ctrl-C foreground:/], + ['missing-job-marker', qr/FAIL: Ctrl-C foreground:/], + ['no-job-control', qr/FAIL: Ctrl-C foreground: foreground job lacks an independent real PGID/], + ['bad-jobs', qr/FAIL: Ctrl-Z\/bg\/fg real PGID:/], + ['bad-termios', qr/FAIL: interactive termios restoration: interactive termios was not restored \(oflag: \d+ -> \d+\)/], + ['no-history', qr/FAIL: history restart isolated HOME:/], + ['hang', qr/FAIL: startup: .*deadline/], + ['watchdog', qr/PTY backend exceeded whole-run deadline/], + ['signal', qr/PTY backend interrupted/], +) { + my ($name, $diagnostic) = @$case; + my ($result, $output, $trace, $elapsed, $jobs) = run_fixture($name, 9); + diag(sprintf '%s runner exit=%d signal=%d elapsed=%.3f seconds', + $name, $result >> 8, $result & 127, $elapsed) if $name eq 'watchdog' || $name eq 'signal'; + isnt($result, 0, "$name rejects broken behavior (no skip success)"); + like($output, $diagnostic, "$name fails at the relevant assertion"); + diag($output) unless $output =~ $diagnostic; + cmp_ok($elapsed, '<', 11, "$name whole-run deadline bounded"); + cmp_ok(scalar @$trace, '>=', 1, "$name really executed the fixture"); + cmp_ok(scalar @$jobs, '>=', 1, "$name cleanup exercised a real child before failure") + if $name =~ /^(?:ignored-foreground|missing-job-marker|no-job-control|bad-jobs|watchdog|signal)$/; + unlike($output, qr/^cleanup:/m, "$name cleanup completed without suppressed errors"); + like($output, qr/^CLEANUP: owned processes absent; PTYs closed$/m, + "$name positively confirms cleanup completion after failure"); + is(read_file("$root/$name bundle/pending"), "xit 91\n", + 'ANSI-only control consumed the entire pending input independently') + if $name eq 'ansi-pending'; +} + +if ($^O eq 'darwin') { + my ($result, $output, $trace) = run_fixture('linux-elf', 9); + isnt($result, 0, 'Linux bundle rejected on macOS'); + like($output, qr/Linux ELF bundle cannot be verified on Darwin \(no skip\)/, + 'platform incompatibility is not a successful skip'); + is(scalar @$trace, 0, 'incompatible platform rejected before executable launch'); +} +is(read_file("$root/user-home/.nshell_history"), "untouched-user-history\n", 'inherited history unchanged'); +done_testing(); diff --git a/t/unit/test-agent-mode.lisp b/t/unit/test-agent-mode.lisp index 707b9d83..894c4828 100644 --- a/t/unit/test-agent-mode.lisp +++ b/t/unit/test-agent-mode.lisp @@ -282,8 +282,9 @@ (format nil "cat /tmp/private.env~%ghp_agent-secret-token")) (repl-test-set-env "AGENT_SECRET" "agent-environment-secret" t) (with-repl-input-state (:mode :ask-waiting :buffer "continue" :cursor-pos 8) - (with-temporary-output-file (audit-path) - (let ((boundary + (host-kit:with-temporary-directory (audit-directory) + (let ((audit-path (merge-pathnames "ai-audit.jsonl" audit-directory)) + (boundary (nshell.feature.assistant:make-assistant-model-boundary :start-fn (lambda () t) :request-fn (lambda (generation payload) diff --git a/t/unit/test-assistant-audit.lisp b/t/unit/test-assistant-audit.lisp index a343764f..24390ec7 100644 --- a/t/unit/test-assistant-audit.lisp +++ b/t/unit/test-assistant-audit.lisp @@ -85,47 +85,48 @@ (delete-file target)))))) (it "appends JSONL after applying the same redaction to payload and response" - (let ((path (merge-pathnames - (format nil "nshell-assistant-audit-~a.jsonl" (gensym)) - (uiop:temporary-directory)))) - (unwind-protect - (let ((nshell.feature.assistant:*assistant-audit-file-path-override* - path)) - (host-kit:write-file-string "" path) - (sb-posix:chmod (namestring path) #o644) - (expect path :to-equal - (nshell.feature.assistant:assistant-audit-file-path)) - (expect (nshell.feature.assistant:append-assistant-audit-entry - `(("environment" . ("API_TOKEN=secret-value")) - ("output" . - ,(format nil "ghp_12345678901234567890~%-----BEGIN PRIVATE KEY-----")) - ("path" . "/tmp/private.env")) - '(("summary" . "Bearer response-secret-value")) - :denylist-paths '("*/private.env") - :denylist-commands '("cat")) - :to-be-truthy) - (expect (nshell.feature.assistant:append-assistant-audit-entry - '(("environment" . ("HOME=/Users/example"))) - '(("summary" . "ok"))) - :to-be-truthy) - (let ((lines - (with-open-file (stream path) - (loop for line = (read-line stream nil nil) - while line collect line)))) - (expect 2 :to-be (length lines)) - (expect (every (lambda (line) (json-kit:parse line)) lines) + (host-kit:with-temporary-directory (directory) + (let ((path (merge-pathnames + (format nil "nshell-assistant-audit-~a.jsonl" (gensym)) + directory))) + (unwind-protect + (let ((nshell.feature.assistant:*assistant-audit-file-path-override* + path)) + (host-kit:write-file-string "" path) + (sb-posix:chmod (namestring path) #o644) + (expect path :to-equal + (nshell.feature.assistant:assistant-audit-file-path)) + (expect (nshell.feature.assistant:append-assistant-audit-entry + `(("environment" . ("API_TOKEN=secret-value")) + ("output" . + ,(format nil "ghp_12345678901234567890~%-----BEGIN PRIVATE KEY-----")) + ("path" . "/tmp/private.env")) + '(("summary" . "Bearer response-secret-value")) + :denylist-paths '("*/private.env") + :denylist-commands '("cat")) :to-be-truthy) - (let ((content (format nil "~{~a~^~%~}" lines))) - (expect (search "API_TOKEN" content) :to-be-truthy) - (expect nil :to-be (search "secret-value" content)) - (expect nil :to-be - (search "ghp_12345678901234567890" content)) - (expect nil :to-be (search "PRIVATE KEY" content)) - (expect nil :to-be (search "/tmp/private.env" content)) - (expect nil :to-be (search "response-secret-value" content)))) - (expect #o600 - :to-equal - (logand (sb-posix:stat-mode - (sb-posix:stat path)) #o777))) - (when (probe-file path) - (delete-file path)))))) + (expect (nshell.feature.assistant:append-assistant-audit-entry + '(("environment" . ("HOME=/Users/example"))) + '(("summary" . "ok"))) + :to-be-truthy) + (let ((lines + (with-open-file (stream path) + (loop for line = (read-line stream nil nil) + while line collect line)))) + (expect 2 :to-be (length lines)) + (expect (every (lambda (line) (json-kit:parse line)) lines) + :to-be-truthy) + (let ((content (format nil "~{~a~^~%~}" lines))) + (expect (search "API_TOKEN" content) :to-be-truthy) + (expect nil :to-be (search "secret-value" content)) + (expect nil :to-be + (search "ghp_12345678901234567890" content)) + (expect nil :to-be (search "PRIVATE KEY" content)) + (expect nil :to-be (search "/tmp/private.env" content)) + (expect nil :to-be (search "response-secret-value" content)))) + (expect #o600 + :to-equal + (logand (sb-posix:stat-mode + (sb-posix:stat path)) #o777))) + (when (probe-file path) + (delete-file path))))))) diff --git a/t/unit/test-assistant-model-boundary.lisp b/t/unit/test-assistant-model-boundary.lisp index ed2a8a22..5df608be 100644 --- a/t/unit/test-assistant-model-boundary.lisp +++ b/t/unit/test-assistant-model-boundary.lisp @@ -121,20 +121,21 @@ (sb-thread:thread-alive-p thread))) (sb-thread:list-all-threads))) -(defmacro %assistant-test-with-sidecar-cleanup (&body body) - `(unwind-protect - (progn ,@body) - (ignore-errors - (nshell.feature.assistant:assistant-model-stop)) - (let ((deadline (+ (get-internal-real-time) - (round (* 2 internal-time-units-per-second))))) - (dolist (name '("nshell assistant sidecar startup" - "nshell assistant sidecar reader" - "nshell assistant sidecar writer" - "nshell assistant sidecar error reader")) - (loop while (and (%assistant-test-live-thread-named-p name) - (< (get-internal-real-time) deadline)) - do (sleep 0.01)))))) +(defmacro %assistant-test-with-sidecar-cleanup (context &body body) + `(let ((nshell.feature.assistant:*assistant-boundaries* ,context)) + (unwind-protect + (progn ,@body) + (ignore-errors + (nshell.feature.assistant:assistant-model-stop)) + (let ((deadline (+ (get-internal-real-time) + (round (* 2 internal-time-units-per-second))))) + (dolist (name '("nshell assistant sidecar startup" + "nshell assistant sidecar reader" + "nshell assistant sidecar writer" + "nshell assistant sidecar error reader")) + (loop while (and (%assistant-test-live-thread-named-p name) + (< (get-internal-real-time) deadline)) + do (sleep 0.01))))))) (defun %assistant-test-await-state (state &optional (timeout-seconds 12)) (let ((deadline (+ (get-internal-real-time) @@ -334,6 +335,205 @@ (expect t :to-be (eq pending actual)) (expect 17 :to-be actual-generation)))) + (it "handles-reader-eof-after-poll-clears-pending" + (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)) + (pending (nshell.feature.assistant::%make-assistant-pending-cell + 17 (cl-concurrent-kit:make-channel :buffer-size 2) + (cl-concurrent-kit:make-promise)))) + (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 (nshell.feature.assistant::make-assistant-model-event 17 :result nil)) + (multiple-value-bind (event present-p) + (nshell.feature.assistant::%assistant-sidecar-poll state 17) + (expect t :to-be present-p) + (expect :result :to-be + (nshell.feature.assistant:assistant-model-event-kind event))) + (expect nil :to-be + (nshell.feature.assistant::assistant-sidecar-state-pending state)) + (nshell.feature.assistant::%assistant-sidecar-reader-loop state handle 0) + (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-handle state)))) + + (it "keeps-idle-reader-through-values-until-eof" + (let* ((state (nshell.feature.assistant::%make-assistant-sidecar-state nil nil)) + (stream (make-string-input-stream + (format nil "{\"type\":\"system\"}~%{\"type\":\"system\"}~%"))) + (handle (nshell.infrastructure.acl::%make-sidecar-handle + nil nil nil stream nil :stopped))) + (setf (nshell.feature.assistant::assistant-sidecar-state-handle state) handle) + (nshell.feature.assistant::%assistant-sidecar-reader-loop state handle 0) + (expect :eof :to-be (read-char stream nil :eof)) + (expect t :to-be (nshell.feature.assistant::assistant-sidecar-state-dead-p state)) + (expect nil :to-be (nshell.feature.assistant::assistant-sidecar-state-handle state)))) + + (it "ignores-reader-eof-from-stale-handle-or-generation" + (dolist (stale-part '(:handle :generation)) + (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)) + (active (if (eq stale-part :handle) (gensym "ACTIVE-") handle)) + (generation (if (eq stale-part :generation) 1 0)) + (pending (nshell.feature.assistant::%make-assistant-pending-cell 17 nil nil))) + (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-state-pending state) pending) + (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)) + (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" + (dolist (changed-part '(:handle :generation)) + (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)) + (active (if (eq changed-part :handle) + (nshell.infrastructure.acl::%make-sidecar-handle + nil nil nil (make-string-input-stream "") nil :stopped) + handle)) + (generation (if (eq changed-part :generation) 1 0)) + (pending (nshell.feature.assistant::%make-assistant-pending-cell + 17 (cl-concurrent-kit:make-channel :buffer-size 2) + (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))) + (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)) + (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)) + (expect nil :to-be + (cl-concurrent-kit:promise-settled-p + (nshell.feature.assistant::assistant-pending-cell-completion pending))) + (cl-concurrent-kit:close-channel + (nshell.feature.assistant::assistant-pending-cell-events pending))))) + + (it "settles-request-accepted-while-reader-waits-for-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)) + (writes (cl-concurrent-kit:make-channel :buffer-size 2)) + (pending nil) + (accepted-p nil) + (queued-generation nil) + (wait-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) + (setf accepted-p + (with-temporary-function + ('nshell.infrastructure.acl:sidecar-alive-p + (lambda (candidate) + (expect handle :to-be candidate) + t)) + (nshell.feature.assistant::%assistant-sidecar-request + state 17 '(("type" . "user") ("message" . "pwd")))) + pending (nshell.feature.assistant::assistant-sidecar-state-pending state)) + (multiple-value-bind (item present-p) + (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) + (expect t :to-be accepted-p) + (expect 17 :to-be queued-generation) + (expect t :to-be + (and pending + (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 17) + (expect t :to-be present-p) + (when present-p + (expect :stream-error :to-be + (nshell.feature.assistant::assistant-model-event-kind event)) + (expect 17 :to-be + (nshell.feature.assistant::assistant-model-event-generation event)))) + (expect t :to-be (nshell.feature.assistant::assistant-sidecar-state-dead-p state)) + (expect nil :to-be (nshell.feature.assistant::assistant-sidecar-state-handle state))) + (cl-concurrent-kit:close-channel writes) + (when pending + (cl-concurrent-kit:close-channel + (nshell.feature.assistant::assistant-pending-cell-events pending)))))) + + (it "preserves-new-reader-identity-during-eof-cleanup" + (dolist (changed-part '(:handle :generation)) + (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)) + (active (if (eq changed-part :handle) + (nshell.infrastructure.acl::%make-sidecar-handle + nil nil nil (make-string-input-stream "") nil :stopped) + handle)) + (generation (if (eq changed-part :generation) 2 1)) + (writes (cl-concurrent-kit:make-channel :buffer-size 2)) + (thread sb-thread:*current-thread*) + (pending (nshell.feature.assistant::%make-assistant-pending-cell + 17 (cl-concurrent-kit:make-channel :buffer-size 2) + (cl-concurrent-kit:make-promise)))) + (setf (nshell.feature.assistant::assistant-sidecar-state-handle state) handle + (nshell.feature.assistant::assistant-sidecar-state-pending state) pending) + (with-temporary-function + ('nshell.infrastructure.acl:stop-sidecar + (lambda (stopped) + (expect handle :to-be stopped) + (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-state-init-p state) t + (nshell.feature.assistant::assistant-sidecar-state-dead-p state) nil + (nshell.feature.assistant::assistant-sidecar-state-write-channel state) writes + (nshell.feature.assistant::assistant-sidecar-state-reader-thread state) thread + (nshell.feature.assistant::assistant-sidecar-state-writer-thread state) thread + (nshell.feature.assistant::assistant-sidecar-state-error-thread state) thread + (nshell.feature.assistant::assistant-sidecar-state-start-thread state) thread))) + (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)) + (expect t :to-be (nshell.feature.assistant::assistant-sidecar-state-init-p state)) + (expect nil :to-be (nshell.feature.assistant::assistant-sidecar-state-dead-p state)) + (expect writes :to-be + (nshell.feature.assistant::assistant-sidecar-state-write-channel state)) + (expect thread :to-be + (nshell.feature.assistant::assistant-sidecar-state-reader-thread state)) + (expect thread :to-be + (nshell.feature.assistant::assistant-sidecar-state-writer-thread state)) + (expect thread :to-be + (nshell.feature.assistant::assistant-sidecar-state-error-thread state)) + (expect thread :to-be + (nshell.feature.assistant::assistant-sidecar-state-start-thread state)) + (expect t :to-be (cl-concurrent-kit:try-send writes :replacement)) + (cl-concurrent-kit:close-channel writes) + (cl-concurrent-kit:close-channel + (nshell.feature.assistant::assistant-pending-cell-events pending))))) + (it "clears-starting-state-when-startup-handoff-fails" (let ((state (nshell.feature.assistant::%make-assistant-sidecar-state "/bin/false" nil)) @@ -383,12 +583,14 @@ (sb-posix:unsetenv "NSHELL_AI_DISABLE"))))) (it "times-out-a-sidecar-that-hangs-during-version-probe" - (let ((script (%assistant-test-hanging-version-sidecar-script))) + (let ((script (%assistant-test-hanging-version-sidecar-script)) + (context nil)) (unwind-protect (let* ((boundary (nshell.feature.assistant:make-assistant-sidecar-boundary :command (namestring script))) (nshell.feature.assistant:*assistant-boundaries* - (nshell.feature.assistant:make-assistant-boundary-context boundary)) + (setf context + (nshell.feature.assistant:make-assistant-boundary-context boundary))) (result (nshell.feature.assistant:assistant-model-start)) (status nil)) (expect :ok :to-be @@ -399,17 +601,19 @@ (expect nil :to-be (search (string #\Newline) (getf status :reason))) (nshell.feature.assistant:assistant-model-stop)) - (%assistant-test-with-sidecar-cleanup) + (%assistant-test-with-sidecar-cleanup context) (when (probe-file script) (delete-file script))))) (it "reports-version-probe-output-when-the-sidecar-exits-with-an-error" - (let ((script (%assistant-test-failing-version-sidecar-script))) + (let ((script (%assistant-test-failing-version-sidecar-script)) + (context nil)) (unwind-protect (let* ((boundary (nshell.feature.assistant:make-assistant-sidecar-boundary :command (namestring script))) (nshell.feature.assistant:*assistant-boundaries* - (nshell.feature.assistant:make-assistant-boundary-context boundary)) + (setf context + (nshell.feature.assistant:make-assistant-boundary-context boundary))) (result (nshell.feature.assistant:assistant-model-start)) (status nil) (reason nil)) @@ -423,7 +627,7 @@ (expect (search "17" reason) :to-be-truthy) (nshell.feature.assistant:assistant-model-stop)) - (%assistant-test-with-sidecar-cleanup) + (%assistant-test-with-sidecar-cleanup context) (when (probe-file script) (delete-file script))))) @@ -446,14 +650,16 @@ (%assistant-stop-sidecar handle)))))) (it "streams-sidecar-values-through-reader-and-writer-threads" - (let ((script (%assistant-test-sidecar-script))) + (let ((script (%assistant-test-sidecar-script)) + (context nil)) (unwind-protect (let* ((boundary (nshell.feature.assistant:make-assistant-sidecar-boundary :command (namestring script))) (nshell.feature.assistant:*assistant-boundaries* - (nshell.feature.assistant:make-assistant-boundary-context - boundary)) + (setf context + (nshell.feature.assistant:make-assistant-boundary-context + boundary))) (start (nshell.feature.assistant:assistant-model-start))) (expect :ok :to-be (nshell.feature.assistant:assistant-boundary-status start)) @@ -489,20 +695,22 @@ (expect :ok :to-be (nshell.feature.assistant:assistant-boundary-status (nshell.feature.assistant:assistant-model-stop)))) - (%assistant-test-with-sidecar-cleanup) + (%assistant-test-with-sidecar-cleanup context) (when (probe-file script) (delete-file script))))) (it "discards-a-stale-sidecar-pending-before-the-next-request" (with-temporary-output-file (received-path :prefix "nshell-assistant-received-") - (let ((script (%assistant-test-sidecar-script nil received-path))) + (let ((script (%assistant-test-sidecar-script nil received-path)) + (context nil)) (unwind-protect (let* ((boundary (nshell.feature.assistant:make-assistant-sidecar-boundary :command (namestring script))) (nshell.feature.assistant:*assistant-boundaries* - (nshell.feature.assistant:make-assistant-boundary-context - boundary))) + (setf context + (nshell.feature.assistant:make-assistant-boundary-context + boundary)))) (expect :ok :to-be (nshell.feature.assistant:assistant-boundary-status (nshell.feature.assistant:assistant-model-start))) @@ -532,7 +740,7 @@ (expect :ok :to-be (nshell.feature.assistant:assistant-boundary-status (nshell.feature.assistant:assistant-model-stop)))) - (%assistant-test-with-sidecar-cleanup) + (%assistant-test-with-sidecar-cleanup context) (when (probe-file script) (delete-file script)))))) @@ -559,14 +767,16 @@ (delete-file script))))) (it "respawns-sidecar-after-reader-detects-process-death" - (let ((script (%assistant-test-sidecar-script t))) + (let ((script (%assistant-test-sidecar-script t)) + (context nil)) (unwind-protect (let* ((boundary (nshell.feature.assistant:make-assistant-sidecar-boundary :command (namestring script))) (nshell.feature.assistant:*assistant-boundaries* - (nshell.feature.assistant:make-assistant-boundary-context - boundary)) + (setf context + (nshell.feature.assistant:make-assistant-boundary-context + boundary))) (start (nshell.feature.assistant:assistant-model-start))) (expect :ok :to-be (nshell.feature.assistant:assistant-boundary-status start)) @@ -628,19 +838,21 @@ (expect :ok :to-be (nshell.feature.assistant:assistant-boundary-status (nshell.feature.assistant:assistant-model-stop)))) - (%assistant-test-with-sidecar-cleanup) + (%assistant-test-with-sidecar-cleanup context) (when (probe-file script) (delete-file script)))))) (it "does-not-let-poll-consume-the-startup-handshake" - (let ((script (%assistant-test-sidecar-script))) + (let ((script (%assistant-test-sidecar-script)) + (context nil)) (unwind-protect (let* ((boundary (nshell.feature.assistant:make-assistant-sidecar-boundary :command (namestring script))) (nshell.feature.assistant:*assistant-boundaries* - (nshell.feature.assistant:make-assistant-boundary-context - boundary))) + (setf context + (nshell.feature.assistant:make-assistant-boundary-context + boundary)))) (expect :ok :to-be (nshell.feature.assistant:assistant-boundary-status (nshell.feature.assistant:assistant-model-start))) @@ -676,19 +888,21 @@ (expect :ok :to-be (nshell.feature.assistant:assistant-boundary-status (nshell.feature.assistant:assistant-model-stop)))) - (%assistant-test-with-sidecar-cleanup) + (%assistant-test-with-sidecar-cleanup context) (when (probe-file script) (delete-file script))))) (it "publishes-a-reasoned-terminal-event-before-stop-closes-pending" - (let ((script (%assistant-test-pending-sidecar-script))) + (let ((script (%assistant-test-pending-sidecar-script)) + (context nil)) (unwind-protect (let* ((boundary (nshell.feature.assistant:make-assistant-sidecar-boundary :command (namestring script))) (nshell.feature.assistant:*assistant-boundaries* - (nshell.feature.assistant:make-assistant-boundary-context - boundary))) + (setf context + (nshell.feature.assistant:make-assistant-boundary-context + boundary)))) (expect :ok :to-be (nshell.feature.assistant:assistant-boundary-status (nshell.feature.assistant:assistant-model-start))) @@ -716,19 +930,21 @@ (nshell.feature.assistant:assistant-model-event-payload event) :test #'string=))))) - (%assistant-test-with-sidecar-cleanup) + (%assistant-test-with-sidecar-cleanup context) (when (probe-file script) (delete-file script))))) (it "publishes-a-reasoned-terminal-event-before-respawn-replaces-pending" - (let ((script (%assistant-test-sidecar-script t))) + (let ((script (%assistant-test-sidecar-script t)) + (context nil)) (unwind-protect (let* ((boundary (nshell.feature.assistant:make-assistant-sidecar-boundary :command (namestring script))) (nshell.feature.assistant:*assistant-boundaries* - (nshell.feature.assistant:make-assistant-boundary-context - boundary))) + (setf context + (nshell.feature.assistant:make-assistant-boundary-context + boundary)))) (expect :ok :to-be (nshell.feature.assistant:assistant-boundary-status (nshell.feature.assistant:assistant-model-start))) @@ -763,20 +979,22 @@ (nshell.feature.assistant:assistant-model-event-kind error-event))) (nshell.feature.assistant:assistant-model-stop)) - (%assistant-test-with-sidecar-cleanup) + (%assistant-test-with-sidecar-cleanup context) (when (probe-file script) (delete-file script))))) (describe "assistant-sidecar-reader-stop-race" (it "stops-cleanly-when-init-gate-rejects-a-live-reader" - (let ((script (%assistant-test-rejecting-sidecar-script))) + (let ((script (%assistant-test-rejecting-sidecar-script)) + (context nil)) (unwind-protect (let* ((boundary (nshell.feature.assistant:make-assistant-sidecar-boundary :command (namestring script))) (nshell.feature.assistant:*assistant-boundaries* - (nshell.feature.assistant:make-assistant-boundary-context - boundary)) + (setf context + (nshell.feature.assistant:make-assistant-boundary-context + boundary))) (start (nshell.feature.assistant:assistant-model-start))) (expect :ok :to-be (nshell.feature.assistant:assistant-boundary-status start)) @@ -811,6 +1029,6 @@ (expect nil :to-be (%assistant-test-live-thread-named-p "nshell assistant sidecar reader"))) - (%assistant-test-with-sidecar-cleanup) + (%assistant-test-with-sidecar-cleanup context) (when (probe-file script) (delete-file script)))))) diff --git a/t/unit/test-assistant-safety.lisp b/t/unit/test-assistant-safety.lisp index 517168fa..7d78c405 100644 --- a/t/unit/test-assistant-safety.lisp +++ b/t/unit/test-assistant-safety.lisp @@ -106,6 +106,84 @@ (nshell.feature.assistant:assistant-safety-result-classification (nshell.feature.assistant:classify-ast ast)))))) + (it "limits git branch safety to an explicit listing grammar" + (let ((cases '(("git branch" :safe) + ("git branch --list" :safe) + ("git branch --list feature/*" :safe) + ("git branch --list -- -topic" :safe) + ("git branch new-name" :confirm) + ("git branch new-name HEAD" :confirm) + ("git branch -l new-name" :confirm) + ("git branch --" :confirm) + ("git branch -- new-name" :confirm) + ("git branch --list -d topic" :confirm) + ("git branch -m old new" :confirm) + ("git branch --set-upstream-to=origin/main topic" :confirm)))) + (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 "limits git remote safety to listing without a subcommand" + (let ((cases '(("git remote" :safe) + ("git remote -v" :safe) + ("git remote --verbose" :safe) + ("git remote remove origin" :confirm) + ("git remote rm origin" :confirm) + ("git remote add origin local-repo" :confirm) + ("git remote rename origin backup" :confirm) + ("git remote set-url origin local-repo" :confirm) + ("git remote -v remove origin" :confirm) + ("git remote update" :confirm) + ("git remote get-url origin" :confirm)))) + (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 "requires confirmation for source without treating filenames as commands" + (let ((cases '(("source echo" :confirm) + ("source ls" :confirm) + ("source git log" :confirm) + ("source" :confirm) + ("source script.sh" :confirm) + ("source rm -rf /" :confirm) + ("command source echo" :confirm) + ("builtin source echo" :confirm) + ("source $(echo echo)" :confirm) + ("source $(rm -rf /)" :block)))) + (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 "preserves the existing safe git log and show argument grammar" + (let ((cases '("git log" "git log --oneline -n 5" + "git log --format=%h HEAD -- file" + "git log --graph --all" + "git show" "git show --pretty=oneline HEAD" + "git show --format %h -- file"))) + (cl-weave:expect-assertions (* 2 (length cases))) + (dolist (text cases) + (let ((parsed (nshell.domain.parsing:parse-command-line text))) + (expect (nshell.domain.parsing:parse-complete-p parsed) :to-be-truthy) + (expect :safe :to-be + (nshell.feature.assistant:assistant-safety-result-classification + (nshell.feature.assistant:classify-ast + (nshell.domain.parsing:parse-result-ast parsed)))))))) + (it "blocks find output actions and command substitutions in command position" (dolist (text '("find . -fprint output" "find . -fprintf output %p" "find . -fls output" "find . -okdir rm {} \\;" diff --git a/t/unit/test-execute-pipeline-branches.lisp b/t/unit/test-execute-pipeline-branches.lisp index 3f45a266..dca9ad57 100644 --- a/t/unit/test-execute-pipeline-branches.lisp +++ b/t/unit/test-execute-pipeline-branches.lisp @@ -74,6 +74,46 @@ :to-equal (nshell.application::%process-substitution-resource-fds (list (list :fd 3) (list :fd 4)))))) + (it "wait-process-substitution-reaps-children-after-interruption" + (let* ((processes (list :child)) + (resource (nshell.infrastructure.acl::%make-process-substitution-resource + "/dev/fd/test" nil processes)) + (terminated nil)) + (with-temporary-functions + (('nshell.infrastructure.acl::%wait-pipeline-processes + (lambda (children) + (expect processes :to-be children) + (error "interrupted wait"))) + ('nshell.infrastructure.acl::%terminate-pipeline-processes + (lambda (children) (push children terminated)))) + (expect (lambda () + (nshell.infrastructure.acl:wait-process-substitution resource)) + :to-throw 'error) + (expect (list processes) :to-equal terminated) + (expect (nshell.infrastructure.acl::process-substitution-resource-processes + resource) + :to-be-null) + (nshell.infrastructure.acl:close-process-substitution resource) + (expect (list processes) :to-equal terminated)))) + (it "wait-process-substitution-preserves-normal-result-values" + (let* ((processes (list :child)) + (resource (nshell.infrastructure.acl::%make-process-substitution-resource + "/dev/fd/test" nil processes)) + (terminated nil)) + (with-temporary-functions + (('nshell.infrastructure.acl::%wait-pipeline-processes + (lambda (children) + (expect processes :to-be children) + (values 7 (list 7)))) + ('nshell.infrastructure.acl::%terminate-pipeline-processes + (lambda (children) (push children terminated)))) + (expect (list 7 (list 7)) :to-equal + (multiple-value-list + (nshell.infrastructure.acl:wait-process-substitution resource))) + (expect 0 :to-equal + (nshell.infrastructure.acl:wait-process-substitution resource)) + (nshell.infrastructure.acl:close-process-substitution resource) + (expect terminated :to-be-null)))) (it "source-pipeline-exit-status-honors-pipefail" (expect 2 :to-equal (nshell.application::%source-pipeline-exit-status (list 0 2) nil)) (expect 2 :to-equal (nshell.application::%source-pipeline-exit-status (list 0 2 0) t)) diff --git a/t/unit/test-prompt-rendering.lisp b/t/unit/test-prompt-rendering.lisp index bfb6fc09..2ea661be 100644 --- a/t/unit/test-prompt-rendering.lisp +++ b/t/unit/test-prompt-rendering.lisp @@ -113,9 +113,9 @@ (it "home-prefix-only-matches-path-boundaries" "Home-directory shortening should not trigger on plain string prefixes." - (expect (nshell.presentation::%home-prefix-p "/Users/take" "/Users/take") :to-be-truthy) - (expect (nshell.presentation::%home-prefix-p "/Users/take" "/Users/take/projects") :to-be-truthy) - (expect (nshell.presentation::%home-prefix-p "/Users/take" "/Users/takefoo") :to-be-falsy)) + (expect (nshell.presentation::%home-prefix-p "/Users/example" "/Users/example") :to-be-truthy) + (expect (nshell.presentation::%home-prefix-p "/Users/example" "/Users/example/projects") :to-be-truthy) + (expect (nshell.presentation::%home-prefix-p "/Users/example" "/Users/examplefoo") :to-be-falsy)) (it "strip-trailing-slash-keeps-a-lone-separator-or-tilde" "Root and home stay as a bare separator or tilde; every other path loses its trailing slash." diff --git a/t/unit/test-repl-ask.lisp b/t/unit/test-repl-ask.lisp index e8780ce6..4b0330aa 100644 --- a/t/unit/test-repl-ask.lisp +++ b/t/unit/test-repl-ask.lisp @@ -11,8 +11,9 @@ (with-repl-input-state (:mode :ask-waiting :buffer "show secret-value" :cursor-pos 17) - (with-temporary-output-file (audit-path) - (let* ((start-count 0) + (host-kit:with-temporary-directory (audit-directory) + (let* ((audit-path (merge-pathnames "ai-audit.jsonl" audit-directory)) + (start-count 0) (request-generation nil) (request-payload nil) (boundary @@ -510,8 +511,9 @@ :exit-code 7 :duration-ms 42) (with-repl-input-state (:mode :ask-waiting :buffer "" :cursor-pos 0) - (with-temporary-output-file (audit-path) - (let* ((request-payload nil) + (host-kit:with-temporary-directory (audit-directory) + (let* ((audit-path (merge-pathnames "ai-audit.jsonl" audit-directory)) + (request-payload nil) (boundary (nshell.feature.assistant:make-assistant-model-boundary :start-fn (lambda () t) diff --git a/t/unit/test-repl-execution.lisp b/t/unit/test-repl-execution.lisp index a6005f78..707a98e2 100644 --- a/t/unit/test-repl-execution.lisp +++ b/t/unit/test-repl-execution.lisp @@ -9,43 +9,213 @@ character) (describe "repl-tests" + (it "rerun-last-command-confirms-through-the-key-reader" + (dolist (key '(:ctrl-x :ctrl-p)) + (with-fresh-input-dispatch-bindings + (when (eq key :ctrl-p) + (expect :ok :to-equal + (nshell.presentation::input-dispatch-erase-binding "ctrl-x")) + (expect :ok :to-equal + (nshell.presentation::input-dispatch-set-binding + "ctrl-p" "rerun-last-command"))) + (dolist (command '("printf captured" "git push")) + (dolist (failure-explain-p '(nil t)) + (with-fixed-terminal-size (24 80) + (with-repl-test-state + (with-stable-repl-prompt () + (setf nshell.presentation::*last-command-text* command + nshell.presentation::*failure-explain-available-p* + failure-explain-p) + (with-repl-input-state (:buffer "") + (let ((calls 0) + (captured nil)) + (with-temporary-functions + (('nshell.infrastructure.acl:consume-terminal-resize-p + (lambda () nil)) + ('nshell.infrastructure.terminal:read-key-event + (lambda (&key interrupt-predicate) + (declare (ignore interrupt-predicate)) + (input-key-event key))) + ('nshell.presentation::%process-execute-output-event + (lambda () + (incf calls) + (setf captured + nshell.presentation::*capture-command-output-p*) + nil))) + (capture-standard-output + (funcall (funcall (nshell.presentation::read-key-cont)))) + (expect t :to-equal + nshell.presentation::*rerun-confirmation-pending-p*) + (expect (+ 2 (length nshell.presentation::*transient-panel-content*)) + :to-equal + nshell.presentation::*transient-panel-rendered-lines*) + (expect nshell.presentation::*transient-panel-content* + :to-be-truthy) + (expect 0 :to-equal calls) + (when (eq key :ctrl-p) + (expect (search "ctrl-p" + (princ-to-string + nshell.presentation::*transient-panel-content*)) + :to-be-truthy) + (expect (search "ctrl-x" + (princ-to-string + nshell.presentation::*transient-panel-content*)) + :to-be-null)) + (capture-standard-output + (funcall (nshell.presentation::read-key-cont))) + (expect 1 :to-equal calls) + (expect t :to-equal captured) + (expect command :to-equal + (nshell.presentation:input-state-buffer + nshell.presentation::*input-state*)) + (expect nil :to-equal + nshell.presentation::*rerun-confirmation-pending-p*)))))))))))) + (it "rerun-last-command-requires-confirmation-and-captures-output" - (with-repl-test-state - (setf nshell.presentation::*last-command-text* "printf captured") - (with-repl-input-state (:buffer "") - (let ((calls 0) - (captured nil)) + (with-fixed-terminal-size (24 80) + (with-repl-test-state + (setf nshell.presentation::*last-command-text* "printf captured") + (with-repl-input-state (:buffer "") + (let ((calls 0) + (captured nil)) + (with-temporary-function + ('nshell.presentation::%process-execute-output-event + (lambda () + (incf calls) + (setf captured nshell.presentation::*capture-command-output-p*) + nil)) + (capture-standard-output + (nshell.presentation::process-output-event :rerun-last-command)) + (expect t :to-equal + nshell.presentation::*rerun-confirmation-pending-p*) + (expect 0 :to-equal calls) + (capture-standard-output + (nshell.presentation::process-output-event :rerun-last-command)) + (expect 1 :to-equal calls) + (expect t :to-equal captured) + (expect nil :to-equal + nshell.presentation::*rerun-confirmation-pending-p*))))))) + + (it "rerun-last-command-wraps-the-complete-confirmation" + (with-repl-test-state + (with-fixed-terminal-size (40 32) + (setf nshell.presentation::*last-command-text* + "printf abcdefghijklmnopqrstuvwxyz0123456789") + (with-repl-input-state (:buffer "") + (capture-standard-output + (nshell.presentation::process-output-event :rerun-last-command)) + (expect t :to-equal + nshell.presentation::*rerun-confirmation-pending-p*) + (let* ((lines nshell.presentation::*transient-panel-content*) + (joined (format nil "~{~a~}" lines))) + (expect (search nshell.presentation::*last-command-text* joined) + :to-be-truthy) + (expect (every (lambda (line) + (<= (nshell.presentation::%string-visible-width line) 28)) + lines) + :to-be-truthy) + (expect (+ 2 (length lines)) :to-equal + nshell.presentation::*transient-panel-rendered-lines*)))))) + + (it "rerun-last-command-rejects-an-incomplete-confirmation" + (dolist (command (cons "printf captured" + (loop for code in '(9 10 13 27 127 133) + collect (format nil "printf 'hidden~ccommand'" + (code-char code))))) + (dolist (size '((4 80) (24 3) (24 80))) + (when (or (not (equal size '(24 80))) + (not (string= command "printf captured"))) + (with-repl-test-state + (with-fixed-terminal-size ((first size) (second size)) + (setf nshell.presentation::*last-command-text* command) + (with-repl-input-state (:buffer "") + (let ((calls 0)) + (with-temporary-function + ('nshell.presentation::%process-execute-output-event + (lambda () (incf calls))) + (dotimes (attempt 2) + (capture-standard-output + (nshell.presentation::process-output-event :rerun-last-command)))) + (expect 0 :to-equal calls) + (expect nil :to-equal + nshell.presentation::*rerun-confirmation-pending-p*))))))))) + + (it "rerun-last-command-resize-cancels-confirmation" + (with-repl-test-state + (with-fixed-terminal-size (24 80) + (setf nshell.presentation::*last-command-text* "printf captured") + (with-repl-input-state (:buffer "") + (capture-standard-output + (nshell.presentation::process-output-event :rerun-last-command)) + (expect t :to-equal + nshell.presentation::*rerun-confirmation-pending-p*) + (with-fixed-terminal-size (4 20) + (capture-standard-output + (nshell.presentation::%render-prompt-after-terminal-resize))) + (expect nil :to-equal + nshell.presentation::*rerun-confirmation-pending-p*) + (expect nil :to-equal nshell.presentation::*rerun-command-assessment*))))) + + (it "rerun-last-command-cancels-a-resize-during-key-read" + (dolist (timing '(:during-read :after-read)) + (with-repl-test-state + (with-fixed-terminal-size (24 80) + (with-repl-input-state (:buffer "") + (with-stable-repl-prompt () + (setf nshell.presentation::*last-command-text* "printf captured") + (capture-standard-output + (funcall (nshell.presentation::process-output-event :rerun-last-command))) + (expect t :to-equal nshell.presentation::*rerun-confirmation-pending-p*) + (let ((resize-p nil) + (calls 0)) + (with-temporary-functions + (('nshell.infrastructure.acl:consume-terminal-resize-p + (lambda () (prog1 resize-p (setf resize-p nil)))) + ('nshell.infrastructure.terminal:read-key-event + (lambda (&key interrupt-predicate) + (declare (ignore interrupt-predicate)) + (when (eq timing :during-read) (setf resize-p t)) + (input-key-event :ctrl-x))) + ('nshell.presentation::%process-execute-output-event + (lambda () (incf calls)))) + (let ((continuation (nshell.presentation::read-key-cont))) + (when (eq timing :after-read) (setf resize-p t)) + (capture-standard-output (funcall continuation))) + (expect 0 :to-equal calls) + (expect nil :to-equal nshell.presentation::*rerun-confirmation-pending-p*) + (expect nil :to-equal nshell.presentation::*rerun-command-assessment*))))))))) + + (it "rerun-last-command-rejects-a-confirmation-cleared-before-approval" + (with-repl-test-state + (with-fixed-terminal-size (24 80) + (setf nshell.presentation::*last-command-text* "printf captured") + (capture-standard-output + (nshell.presentation::process-output-event :rerun-last-command)) + (expect t :to-equal nshell.presentation::*rerun-confirmation-pending-p*) + (let ((calls 0)) (with-temporary-function ('nshell.presentation::%process-execute-output-event - (lambda () - (incf calls) - (setf captured nshell.presentation::*capture-command-output-p*) - nil)) - (capture-standard-output - (nshell.presentation::process-output-event :rerun-last-command)) - (expect t :to-equal - nshell.presentation::*rerun-confirmation-pending-p*) - (expect 0 :to-equal calls) + (lambda () (incf calls))) (capture-standard-output - (nshell.presentation::process-output-event :rerun-last-command)) - (expect 1 :to-equal calls) - (expect t :to-equal captured) - (expect nil :to-equal - nshell.presentation::*rerun-confirmation-pending-p*)))))) + (nshell.presentation::clear-rendered-transient-panel) + (nshell.presentation::process-output-event :rerun-last-command))) + (expect 0 :to-equal calls) + (expect nil :to-equal nshell.presentation::*rerun-confirmation-pending-p*))))) (it "rerun-last-command-shows-safety-and-command-before-confirming" - (with-repl-test-state - (setf nshell.presentation::*last-command-text* "git push") - (with-repl-input-state (:buffer "") - (capture-standard-output - (nshell.presentation::process-output-event :rerun-last-command)) - (expect t :to-equal - nshell.presentation::*rerun-confirmation-pending-p*) - (let ((panel - (nshell.presentation::%rerun-panel-lines - nshell.presentation::*rerun-command-assessment*))) - (expect (search "git push" (princ-to-string panel)) :to-be-truthy) - (expect (search "confirmation" (princ-to-string panel)) :to-be-truthy))))) + (with-fixed-terminal-size (24 80) + (with-repl-test-state + (setf nshell.presentation::*last-command-text* "git push") + (with-repl-input-state (:buffer "") + (capture-standard-output + (nshell.presentation::process-output-event :rerun-last-command)) + (expect t :to-equal + nshell.presentation::*rerun-confirmation-pending-p*) + (let ((panel + (nshell.presentation::%rerun-panel-lines + nshell.presentation::*rerun-command-assessment*))) + (expect (search "git push" (princ-to-string panel)) :to-be-truthy) + (expect (search "confirmation" (princ-to-string panel)) :to-be-truthy)))))) (it "rerun-last-command-rejects-interactive-commands" (with-repl-test-state @@ -127,29 +297,33 @@ :to-be-truthy)))) (it "rerun-last-command-cancel-clears-confirmation-on-other-input" - (with-repl-test-state - (setf nshell.presentation::*last-command-text* "git push") - (with-repl-input-state (:buffer "") - (capture-standard-output - (nshell.presentation::process-output-event :rerun-last-command)) - (with-temporary-functions - (('nshell.infrastructure.acl:consume-terminal-resize-p - (lambda () nil)) - ('nshell.infrastructure.acl:consume-sigint-received-p - (lambda () nil)) - ('nshell.infrastructure.terminal:read-key-event - (lambda (&key interrupt-predicate) - (declare (ignore interrupt-predicate)) - (input-key-event :char #\x))) - ('nshell.presentation::render-prompt-cont (lambda () nil))) - (let ((continuation (nshell.presentation::read-key-cont))) - (funcall continuation)) - (expect nil :to-equal - nshell.presentation::*rerun-confirmation-pending-p*) - (expect nil :to-equal nshell.presentation::*rerun-command-assessment*) - (expect "x" :to-equal - (nshell.presentation:input-state-buffer - nshell.presentation::*input-state*)))))) + (dolist (character '(#\x #\v)) + (with-fixed-terminal-size (24 80) + (with-repl-test-state + (setf nshell.presentation::*last-command-text* "git push") + (with-repl-input-state (:buffer "") + (capture-standard-output + (nshell.presentation::process-output-event :rerun-last-command)) + (expect t :to-equal + nshell.presentation::*rerun-confirmation-pending-p*) + (with-temporary-functions + (('nshell.infrastructure.acl:consume-terminal-resize-p + (lambda () nil)) + ('nshell.infrastructure.acl:consume-sigint-received-p + (lambda () nil)) + ('nshell.infrastructure.terminal:read-key-event + (lambda (&key interrupt-predicate) + (declare (ignore interrupt-predicate)) + (input-key-event :char character))) + ('nshell.presentation::render-prompt-cont (lambda () nil))) + (let ((continuation (nshell.presentation::read-key-cont))) + (funcall continuation)) + (expect nil :to-equal + nshell.presentation::*rerun-confirmation-pending-p*) + (expect nil :to-equal nshell.presentation::*rerun-command-assessment*) + (expect (string character) :to-equal + (nshell.presentation:input-state-buffer + nshell.presentation::*input-state*)))))))) (it "repl-installed-terminal-controls-actual-runner-lifecycle" (dolist (scenario '(:success :install-failure :execution-failure))