From 1743eca200696d3e3615a0df2a47428fdb8848a6 Mon Sep 17 00:00:00 2001 From: takeokunn Date: Sun, 11 Oct 2026 01:01:54 +0900 Subject: [PATCH 01/11] fix: harden interactive history and verify pinned dependency suites --- .github/workflows/ci.yml | 25 + .github/workflows/release.yml | 22 + README.md | 25 +- docs/src/project/public-readiness.md | 60 +-- docs/src/project/releasing.md | 75 ++- flake.nix | 24 + man/nshell.1 | 77 ++- .../cl-boundary-kit-prolog-kit-name.patch | 401 ++++++++++++++ nix/patches/cl-cli-prolog-kit-name.patch | 83 +++ ...taflow-kit-writable-snapshot-fixture.patch | 47 ++ .../cl-parser-kit-prolog-kit-name.patch | 79 +++ nix/patches/cl-tty-kit-prolog-kit-name.patch | 328 ++++++++++++ nshell.asd | 8 +- .../feature/assistant/src/domain/safety.lisp | 37 +- scripts/test-dependencies.lisp | 145 +++++ scripts/test-dependencies.sh | 37 ++ scripts/test-history-storage.lisp | 214 ++++++++ scripts/test-release-pty.pl | 497 ++++++++++++++++++ .../persistence/file-history.lisp | 83 ++- t/scripts/test-release-pty.pl | 192 +++++++ t/unit/test-assistant-safety.lisp | 78 +++ 21 files changed, 2426 insertions(+), 111 deletions(-) create mode 100644 nix/patches/cl-boundary-kit-prolog-kit-name.patch create mode 100644 nix/patches/cl-cli-prolog-kit-name.patch create mode 100644 nix/patches/cl-dataflow-kit-writable-snapshot-fixture.patch create mode 100644 nix/patches/cl-parser-kit-prolog-kit-name.patch create mode 100644 nix/patches/cl-tty-kit-prolog-kit-name.patch create mode 100644 scripts/test-dependencies.lisp create mode 100644 scripts/test-dependencies.sh create mode 100644 scripts/test-history-storage.lisp create mode 100644 scripts/test-release-pty.pl create mode 100644 t/scripts/test-release-pty.pl 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..befc3dc4 100644 --- a/README.md +++ b/README.md @@ -45,6 +45,11 @@ 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. +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 @@ -55,8 +60,9 @@ Pin a release tag rather than following the default branch. The `x86_64-linux` 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. 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. @@ -72,15 +78,21 @@ 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 '$SIG{ALRM}=sub { exit 124 }; 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 +NSHELL_TEST_PTY=1 nix develop -c bash scripts/test-dependencies.sh +nix develop -c sbcl --script scripts/test-history-storage.lisp ``` The Perl wrappers limit each local check to five minutes and return exit code -124 if that limit expires. +124 if that limit expires. 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. To measure executable-source coverage, keep the report outside the checkout and run the same hermetic test loader used by CI: @@ -97,7 +109,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 @@ -117,6 +129,3 @@ 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/src/project/public-readiness.md b/docs/src/project/public-readiness.md index b19c91a5..ec22b56d 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,13 +39,18 @@ 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 and manifest verification + after extraction. 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. @@ -65,31 +69,25 @@ does not supply that runtime 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. +- Run `NSHELL_TEST_PTY=1 nix develop -c bash scripts/test-dependencies.sh` for + the pinned libraries' own suites, and + `nix develop -c sbcl --script scripts/test-history-storage.lisp` for private + history persistence. A successful library load is not a test result. +- Extract a release archive 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..a58384e5 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,13 +36,18 @@ 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 + NSHELL_TEST_PTY=1 nix develop -c sbcl --script run-tests.lisp + NSHELL_TEST_PTY=1 nix develop -c bash scripts/test-dependencies.sh + nix develop -c sbcl --script scripts/test-history-storage.lisp ``` - `nix build .#releaseBundle --print-build-logs` produces the executable, @@ -51,36 +58,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/flake.nix b/flake.nix index abea1dc7..75d51a8b 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,6 +265,7 @@ clBoundaryKit = sibling { name = "cl-boundary-kit"; source = cl-boundary-kit; + patches = [ ./nix/patches/cl-boundary-kit-prolog-kit-name.patch ]; dependencies = [ clHostKit ]; }; clConcurrentKit = sibling { @@ -289,11 +292,13 @@ clCli = sibling { name = "cl-cli"; source = cl-cli; + patches = [ ./nix/patches/cl-cli-prolog-kit-name.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 @@ -357,6 +362,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 @@ -721,6 +744,7 @@ # derivation's own resolved registry, including check dependencies) # is kept. devShells.default = ctx.generated.devShells.default.overrideAttrs (previous: { + 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..4058fa10 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; in-session history remains available. .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 @@ -108,10 +117,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 +167,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 +225,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 +250,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 @@ -244,7 +279,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 +302,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..8180c2cd --- /dev/null +++ b/nix/patches/cl-boundary-kit-prolog-kit-name.patch @@ -0,0 +1,401 @@ +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/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-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-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..6764bed4 100644 --- a/nshell.asd +++ b/nshell.asd @@ -19,7 +19,7 @@ :license "MIT" ;; Single source of truth for the version. flake.nix reads this form ;; line-by-line, and release.yml refuses a tag that disagrees with it. - :version "0.6.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") @@ -398,7 +398,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 +585,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 +615,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/test-dependencies.lisp b/scripts/test-dependencies.lisp new file mode 100644 index 00000000..be56c204 --- /dev/null +++ b/scripts/test-dependencies.lisp @@ -0,0 +1,145 @@ +;;;; Run one pinned dependency suite per fresh SBCL process. + +(require :asdf) +(load (merge-pathnames "asdf-runtime.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-store-path-p (path) + (and path (uiop:string-prefix-p "/nix/store/" (namestring (truename path))))) + +(defun dependency-configure-registry () + (let* ((value (uiop:getenv "CL_SOURCE_REGISTRY")) + (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) + (member entry '(:inherit-configuration + :ignore-inherited-configuration + (:inherit-configuration) + (:ignore-inherited-configuration)) + :test #'equal)) + 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")) + (let ((configuration `(:source-registry ,@entries :ignore-inherited-configuration))) + (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)))) + +(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..db56730e --- /dev/null +++ b/scripts/test-dependencies.sh @@ -0,0 +1,37 @@ +#!/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_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-history-storage.lisp b/scripts/test-history-storage.lisp new file mode 100644 index 00000000..364421f6 --- /dev/null +++ b/scripts/test-history-storage.lisp @@ -0,0 +1,214 @@ +(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)) + (let ((nshell.infrastructure.persistence::*history-file-path-override* + (pathname (second arguments))) + (*error-output* (make-string-output-stream))) + (nshell.infrastructure.persistence::append-history-entry (third arguments)) + (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*))) + (labels ((child-append (label text) + (multiple-value-bind (output errors code) + (uiop:run-program + (list (namestring sb-ext:*runtime-pathname*) "--script" script + "--history-child-append" (namestring path) text) + :output :string :error-output :string :ignore-error-status t) + (format t "CHILD ~a exit=~d~%" label code) + (unless (member code '(0 3 4)) + (error "Unexpected child result: ~d ~a ~a" code output errors)) + (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-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))) + (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 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..b6a90227 --- /dev/null +++ b/scripts/test-release-pty.pl @@ -0,0 +1,497 @@ +#!/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(time sleep); + +# 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 $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, seconds = sys.argv[1:] +deadline = time.monotonic() + int(seconds) +# 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, int(seconds)) + + +def remaining(limit=5): + value = min(limit, work_deadline - time.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 = time.monotonic() + remaining() + view = memoryview(data) + while view: + if time.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 = time.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 time.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 = time.monotonic() + remaining() + while not predicate(): + if self.poll() is not None: + raise RuntimeError('executable exited during process-state assertion') + if time.monotonic() >= end: + raise RuntimeError('process-state deadline exceeded') + self.read() + + def finish(self): + self.send(b'\x04') + end = time.monotonic() + remaining() + while self.poll() is None: + if time.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') + if termios.tcgetattr(self.master) != self.baseline: + raise RuntimeError('interactive termios was not restored') + + +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) + session.send(b'exit 91') + session.expect(b'91', start) # Ensure the pending bytes reached the editor first. + 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 - time.monotonic())) + + def cleanup_remaining(): + return max(0.001, deadline - time.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, time.monotonic() + 0.5) + while owned and time.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 time.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 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, $timeout; + die "python3 PTY backend unavailable: $!\n"; +} +my $signal; +local $SIG{INT} = sub { $signal = 'INT'; kill 'TERM', $pid }; +local $SIG{TERM} = sub { $signal = 'TERM'; kill 'TERM', $pid }; +my $end = time + $timeout + 1; +while (1) { + my $reaped = waitpid($pid, WNOHANG); + if ($reaped == $pid) { + my $status = $?; + die "PTY backend interrupted\n" if $signal; + exit(($status & 127) ? 1 : $status >> 8); + } + die "cannot reap PTY backend\n" if $reaped == -1; + if (time >= $end) { + kill 'TERM', $pid; + sleep 0.1; + kill 'KILL', $pid; + waitpid($pid, 0); + die "PTY backend exceeded whole-run deadline\n"; + } + sleep 0.02; +} diff --git a/src/infrastructure/persistence/file-history.lisp b/src/infrastructure/persistence/file-history.lisp index dbd9c665..b43ca16e 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 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/t/scripts/test-release-pty.pl b/t/scripts/test-release-pty.pl new file mode 100644 index 00000000..27b90837 --- /dev/null +++ b/t/scripts/test-release-pty.pl @@ -0,0 +1,192 @@ +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'; + $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); + $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 + if ($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 $!; + exec $^X, $runner, $bundle, '--timeout', $timeout; + die $!; + } + my $end = time + $timeout + 5; + while (waitpid($pid, WNOHANG) == 0) { + 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'); +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:/], + ['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/], + ['no-history', qr/FAIL: history restart isolated HOME:/], + ['hang', qr/FAIL: startup: .*deadline/], +) { + my ($name, $diagnostic) = @$case; + my ($result, $output, $trace, $elapsed, $jobs) = run_fixture($name, 9); + 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)$/; + unlike($output, qr/^cleanup:/m, "$name cleanup completed without suppressed errors"); +} + +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-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 {} \\;" From d64724ef7d03d9c0a82aab5816716edffa58f232 Mon Sep 17 00:00:00 2001 From: takeokunn Date: Sun, 11 Oct 2026 11:15:58 +0900 Subject: [PATCH 02/11] fix: preserve terminal state and close dependency verification gaps --- README.md | 7 +- docs/notes/nerima-lisp-package-audit.md | 20 +- docs/src/guide/recipes.md | 14 +- docs/src/project/public-readiness.md | 30 ++- docs/src/project/releasing.md | 10 +- docs/src/reference/architecture.md | 26 +- flake.nix | 36 ++- .../cl-boundary-kit-prolog-kit-name.patch | 26 ++ nix/patches/cl-cli-zsh-render-cache.patch | 238 ++++++++++++++++++ .../cl-concurrent-kit-cancelled-barrier.patch | 29 +++ ...s-kit-no-duplicate-monotonic-seconds.patch | 10 + scripts/test-history-storage.lisp | 110 ++++++-- scripts/test-release-pty.pl | 186 +++++++++++--- .../persistence/file-history.lisp | 2 +- src/infrastructure/terminal/raw-mode.lisp | 50 +++- t/integration/test-file-history.lisp | 15 ++ t/integration/test-terminal.lisp | 48 ++++ t/scripts/test-release-pty.pl | 56 ++++- t/unit/test-agent-mode.lisp | 5 +- t/unit/test-assistant-audit.lisp | 87 +++---- t/unit/test-prompt-rendering.lisp | 6 +- t/unit/test-repl-ask.lisp | 10 +- 22 files changed, 853 insertions(+), 168 deletions(-) create mode 100644 nix/patches/cl-cli-zsh-render-cache.patch create mode 100644 nix/patches/cl-concurrent-kit-cancelled-barrier.patch diff --git a/README.md b/README.md index befc3dc4..c500177b 100644 --- a/README.md +++ b/README.md @@ -84,8 +84,6 @@ nix build # produces ./result/bin/nshell nix build .#releaseBundle perl scripts/verify-release-bundle.pl result perl scripts/test-release-pty.pl result -NSHELL_TEST_PTY=1 nix develop -c bash scripts/test-dependencies.sh -nix develop -c sbcl --script scripts/test-history-storage.lisp ``` The Perl wrappers limit each local check to five minutes and return exit code @@ -94,6 +92,10 @@ The Perl wrappers limit each local check to five minutes and return exit code 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: @@ -128,4 +130,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. - 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/guide/recipes.md b/docs/src/guide/recipes.md index 8583d5d9..d5a87336 100644 --- a/docs/src/guide/recipes.md +++ b/docs/src/guide/recipes.md @@ -68,6 +68,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 +88,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 ec22b56d..ee3a0e2e 100644 --- a/docs/src/project/public-readiness.md +++ b/docs/src/project/public-readiness.md @@ -62,17 +62,35 @@ 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. -- Run `NSHELL_TEST_PTY=1 nix develop -c bash scripts/test-dependencies.sh` for - the pinned libraries' own suites, and - `nix develop -c sbcl --script scripts/test-history-storage.lisp` for private - history persistence. A successful library load is not a test result. +- The dependency runner executes the pinned libraries' own suites; the history + script checks private persistence. A successful library load is not a test + result. - Extract a release archive and run `perl scripts/verify-release-bundle.pl ` followed by `perl scripts/test-release-pty.pl ` on `x86_64-linux`. diff --git a/docs/src/project/releasing.md b/docs/src/project/releasing.md index a58384e5..4ab0d2bc 100644 --- a/docs/src/project/releasing.md +++ b/docs/src/project/releasing.md @@ -42,13 +42,9 @@ 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 - NSHELL_TEST_PTY=1 nix develop -c sbcl --script run-tests.lisp - NSHELL_TEST_PTY=1 nix develop -c bash scripts/test-dependencies.sh - nix develop -c sbcl --script scripts/test-history-storage.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`. diff --git a/docs/src/reference/architecture.md b/docs/src/reference/architecture.md index ca6f24f7..24a593cf 100644 --- a/docs/src/reference/architecture.md +++ b/docs/src/reference/architecture.md @@ -6,7 +6,7 @@ layers beneath it: ``` 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. @@ -70,35 +70,37 @@ pipeline entry points remain unchanged. nshell builds on the `nerima-lisp` Common Lisp toolkit family, each wired at the layer where it fits the domain-driven design: -- **[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 + 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 + keep mapping LF to CR-LF. nshell snapshots the complete native `termios` + structure to preserve terminal 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 75d51a8b..21218e44 100644 --- a/flake.nix +++ b/flake.nix @@ -271,6 +271,7 @@ clConcurrentKit = sibling { name = "cl-concurrent-kit"; source = cl-concurrent-kit; + patches = [ ./nix/patches/cl-concurrent-kit-cancelled-barrier.patch ]; dependencies = [ clBoundaryKit clDateKit @@ -292,7 +293,10 @@ clCli = sibling { name = "cl-cli"; source = cl-cli; - patches = [ ./nix/patches/cl-cli-prolog-kit-name.patch ]; + patches = [ + ./nix/patches/cl-cli-prolog-kit-name.patch + ./nix/patches/cl-cli-zsh-render-cache.patch + ]; dependencies = [ clHostKit ]; }; clTtyKit = sibling { @@ -312,9 +316,8 @@ 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. + # Remove the duplicate clock definition and serialize process + # reaping with the cancellation watcher. patches = [ ./nix/patches/cl-process-kit-no-duplicate-monotonic-seconds.patch ]; }; clRegexKit = sibling { @@ -703,11 +706,26 @@ # 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 + mandoc + nushell + powershell + elvish + ] + ); overrideOutputs = ctx: diff --git a/nix/patches/cl-boundary-kit-prolog-kit-name.patch b/nix/patches/cl-boundary-kit-prolog-kit-name.patch index 8180c2cd..28616080 100644 --- a/nix/patches/cl-boundary-kit-prolog-kit-name.patch +++ b/nix/patches/cl-boundary-kit-prolog-kit-name.patch @@ -399,3 +399,29 @@ diff --git a/t/prolog-boundary-invariants-test.lisp b/t/prolog-boundary-invarian + (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-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-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/scripts/test-history-storage.lisp b/scripts/test-history-storage.lisp index 364421f6..d5eba244 100644 --- a/scripts/test-history-storage.lisp +++ b/scripts/test-history-storage.lisp @@ -9,30 +9,60 @@ (let ((arguments (uiop:command-line-arguments))) (when (equal "--history-child-append" (first arguments)) - (let ((nshell.infrastructure.persistence::*history-file-path-override* - (pathname (second arguments))) - (*error-output* (make-string-output-stream))) - (nshell.infrastructure.persistence::append-history-entry (third arguments)) - (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))))))) + (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*))) - (labels ((child-append (label text) - (multiple-value-bind (output errors code) - (uiop:run-program - (list (namestring sb-ext:*runtime-pathname*) "--script" script - "--history-child-append" (namestring path) text) - :output :string :error-output :string :ignore-error-status t) - (format t "CHILD ~a exit=~d~%" label code) - (unless (member code '(0 3 4)) - (error "Unexpected child result: ~d ~a ~a" code output errors)) - (when (= code 4) - (write-string output)) - code)) + (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))) @@ -48,7 +78,7 @@ (when (> (get-internal-real-time) deadline) (error "Reader neither completed nor waited for the history mutex")) (sb-thread:thread-yield)))) - (run-case (control-p) + (run-ready-case (control-p) (delete-file path) (let ((nshell.infrastructure.persistence::*history-file-path-override* path)) (nshell.infrastructure.persistence::append-history-entry "seed")) @@ -126,6 +156,11 @@ (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") @@ -143,7 +178,34 @@ (and (equal '("seed" "holding-writer" "after-release") (mapcar #'nshell.infrastructure.persistence::history-record-text records)) - (string= "" (get-output-stream-string *error-output*))))))))) + (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)))) diff --git a/scripts/test-release-pty.pl b/scripts/test-release-pty.pl index b6a90227..d837d8e1 100644 --- a/scripts/test-release-pty.pl +++ b/scripts/test-release-pty.pl @@ -5,7 +5,7 @@ use File::Path qw(make_path); use File::Temp qw(tempdir); use POSIX qw(WNOHANG); -use Time::HiRes qw(time sleep); +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. @@ -35,6 +35,8 @@ } 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 @@ -49,8 +51,12 @@ import termios import time -executable, isolation, seconds = sys.argv[1:] -deadline = time.monotonic() + int(seconds) +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' @@ -75,11 +81,11 @@ signal.signal(signal.SIGTERM, interrupted) signal.signal(signal.SIGINT, interrupted) signal.signal(signal.SIGALRM, interrupted) -signal.setitimer(signal.ITIMER_REAL, int(seconds)) +signal.setitimer(signal.ITIMER_REAL, max(0.001, deadline - monotonic())) def remaining(limit=5): - value = min(limit, work_deadline - time.monotonic()) + value = min(limit, work_deadline - monotonic()) if value <= 0: raise RuntimeError('whole-run deadline exceeded') return value @@ -153,10 +159,10 @@ def send(self, data): if self.poll() is not None: raise RuntimeError('executable exited before input (status %d)' % self.status) - end = time.monotonic() + remaining() + end = monotonic() + remaining() view = memoryview(data) while view: - if time.monotonic() >= end: + if monotonic() >= end: raise RuntimeError('PTY write deadline exceeded') if select.select([], [self.master], [], 0.02)[1]: view = view[os.write(self.master, view):] @@ -165,14 +171,14 @@ pattern = re.compile(expected) if isinstance(expected, bytes) else expected if pattern.search(stimulus): raise RuntimeError('assertion would match terminal input echo') - end = time.monotonic() + remaining() + 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 time.monotonic() >= end: + if monotonic() >= end: raise RuntimeError('expected output deadline exceeded') self.read() @@ -190,19 +196,19 @@ return struct.unpack('i', fcntl.ioctl(self.master, termios.TIOCGPGRP, struct.pack('i', 0)))[0] def wait(self, predicate): - end = time.monotonic() + remaining() + end = monotonic() + remaining() while not predicate(): if self.poll() is not None: raise RuntimeError('executable exited during process-state assertion') - if time.monotonic() >= end: + if monotonic() >= end: raise RuntimeError('process-state deadline exceeded') self.read() def finish(self): self.send(b'\x04') - end = time.monotonic() + remaining() + end = monotonic() + remaining() while self.poll() is None: - if time.monotonic() >= end: + if monotonic() >= end: raise RuntimeError('interactive exit deadline exceeded') self.read() if not os.WIFEXITED(self.status) or os.WEXITSTATUS(self.status) != 0: @@ -245,8 +251,11 @@ stage = 'Ctrl-C pending input' start = len(session.output) - session.send(b'exit 91') - session.expect(b'91', start) # Ensure the pending bytes reached the editor first. + 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) @@ -347,10 +356,10 @@ # 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 - time.monotonic())) + signal.setitimer(signal.ITIMER_REAL, max(0.001, deadline - monotonic())) def cleanup_remaining(): - return max(0.001, deadline - time.monotonic()) + 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} @@ -401,8 +410,8 @@ 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, time.monotonic() + 0.5) - while owned and time.monotonic() < end: + 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) @@ -450,7 +459,7 @@ pending.remove(pid) elif probe.returncode != 0: raise RuntimeError('owned-process absence observation failed') - if pending and time.monotonic() >= deadline - 0.1: + if pending and monotonic() >= deadline - 0.1: raise RuntimeError('owned PIDs remain after cleanup: %s' % sorted(pending)) if pending: time.sleep(0.02) @@ -458,6 +467,8 @@ 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: @@ -471,26 +482,141 @@ my $pid = fork // die "cannot start PTY backend: $!\n"; if (!$pid) { - exec 'python3', '-c', $backend, $executable, $isolation, $timeout; + exec 'python3', '-c', $backend, $executable, $isolation, sprintf('%.9f', $deadline); die "python3 PTY backend unavailable: $!\n"; } -my $signal; -local $SIG{INT} = sub { $signal = 'INT'; kill 'TERM', $pid }; -local $SIG{TERM} = sub { $signal = 'TERM'; kill 'TERM', $pid }; -my $end = time + $timeout + 1; +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; - if (time >= $end) { - kill 'TERM', $pid; - sleep 0.1; - kill 'KILL', $pid; - waitpid($pid, 0); + 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/persistence/file-history.lisp b/src/infrastructure/persistence/file-history.lisp index b43ca16e..2cbb6b29 100644 --- a/src/infrastructure/persistence/file-history.lisp +++ b/src/infrastructure/persistence/file-history.lisp @@ -189,7 +189,7 @@ (sb-sys:make-fd-stream fd :input t :output append :element-type 'character :external-format :utf-8 :auto-close t - :pathname path)) + :pathname (pathname path))) (error (condition) (sb-posix:close fd) (error condition)))))) diff --git a/src/infrastructure/terminal/raw-mode.lisp b/src/infrastructure/terminal/raw-mode.lisp index 00411b4c..4075e097 100644 --- a/src/infrastructure/terminal/raw-mode.lisp +++ b/src/infrastructure/terminal/raw-mode.lisp @@ -74,18 +74,48 @@ 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 termios conversion omits native fields, including Darwin's +;; baud rates. Keep the complete structure using its platform-grovelled size. +(sb-alien:define-alien-routine ("tcgetattr" %tcgetattr) sb-alien:int + (fd sb-alien:int) + (termios sb-sys:system-area-pointer)) + +(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 sb-posix::alien-termios :bytes) + :element-type '(unsigned-byte 8) + :initial-element 0))) + (sb-sys:with-pinned-objects (termios) + (when (minusp (%tcgetattr fd (sb-sys:vector-sap termios))) + (let ((errno (sb-unix::get-errno))) + (error "tcgetattr failed on fd ~d (errno=~d)" fd errno)))) + termios)) + +(defun %apply-termios (fd action termios) + (sb-sys:with-pinned-objects (termios) + (when (minusp (%tcsetattr fd action (sb-sys:vector-sap termios))) + (let ((errno (sb-unix::get-errno))) + (error "tcsetattr 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) + (* sb-posix::alien-termios)))) + (setf (sb-alien:slot (sb-alien:deref native) 'sb-posix::iflag) + (logand (sb-alien:slot (sb-alien:deref native) 'sb-posix::iflag) + (lognot (logior sb-posix:ixon sb-posix:ixoff)))) + (setf (sb-alien:slot (sb-alien:deref native) 'sb-posix::lflag) + (logand (sb-alien:slot (sb-alien:deref native) 'sb-posix::lflag) + (lognot (logior sb-posix:icanon sb-posix:echo)))))) termios) (defun enable-raw-mode (&optional (fd 0)) @@ -95,7 +125,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 +165,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 sb-posix:tcsanow raw) t)) (error (condition) (error 'terminal-mode-operation-failed @@ -164,7 +194,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 sb-posix:tcsanow saved) (%forget-termios fd) t)) (error (condition) 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-terminal.lisp b/t/integration/test-terminal.lisp index 361e0c36..5e9b69f5 100644 --- a/t/integration/test-terminal.lisp +++ b/t/integration/test-terminal.lisp @@ -59,6 +59,30 @@ 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))))) + (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. @@ -97,6 +121,30 @@ 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)))) + (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 index 27b90837..bd6a785d 100644 --- a/t/scripts/test-release-pty.pl +++ b/t/scripts/test-release-pty.pl @@ -55,6 +55,22 @@ sub fixture { $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"); @@ -64,6 +80,15 @@ sub fixture { $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"; @@ -79,7 +104,16 @@ sub fixture { die "unexpected public CLI arguments" if @ARGV > 2 || (@ARGV == 2 && $ARGV[1] ne '--no-history'); $ENV{FIXTURE_HISTORY} = @ARGV == 2 ? 'off' : 'on'; PERL - if ($name eq 'hang') { + $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"; @@ -106,11 +140,17 @@ sub run_fixture { 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; @@ -150,6 +190,8 @@ sub run_fixture { 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; @@ -161,6 +203,7 @@ sub run_fixture { ['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/], @@ -168,17 +211,26 @@ sub run_fixture { ['bad-termios', qr/FAIL: interactive termios restoration: interactive termios was not restored/], ['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)$/; + 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') { 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-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) From ea67de885753870f4de2a856ca6de2d83a86dc6d Mon Sep 17 00:00:00 2001 From: takeokunn Date: Sun, 11 Oct 2026 11:32:32 +0900 Subject: [PATCH 03/11] test: report exact terminal restoration differences in release checks --- scripts/test-release-pty.pl | 9 +++++++-- t/scripts/test-release-pty.pl | 2 +- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/scripts/test-release-pty.pl b/scripts/test-release-pty.pl index d837d8e1..c75d70ad 100644 --- a/scripts/test-release-pty.pl +++ b/scripts/test-release-pty.pl @@ -213,8 +213,13 @@ self.read() if not os.WIFEXITED(self.status) or os.WEXITSTATUS(self.status) != 0: raise RuntimeError('interactive executable exit was not zero') - if termios.tcgetattr(self.master) != self.baseline: - raise RuntimeError('interactive termios was not restored') + 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): diff --git a/t/scripts/test-release-pty.pl b/t/scripts/test-release-pty.pl index bd6a785d..13fff35c 100644 --- a/t/scripts/test-release-pty.pl +++ b/t/scripts/test-release-pty.pl @@ -208,7 +208,7 @@ sub run_fixture { ['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/], + ['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/], From 28882ea4c2d0ab50f89eeab73c470ae4580b11ce Mon Sep 17 00:00:00 2001 From: takeokunn Date: Sun, 11 Oct 2026 12:07:54 +0900 Subject: [PATCH 04/11] fix: preserve Linux kernel terminal settings --- nshell.asd | 5 ++ .../terminal/linux-abi/termios2.lisp | 17 +++++ src/infrastructure/terminal/raw-mode.lisp | 73 +++++++++++++------ t/integration/test-terminal.lisp | 52 +++++++++++-- 4 files changed, 117 insertions(+), 30 deletions(-) create mode 100644 src/infrastructure/terminal/linux-abi/termios2.lisp diff --git a/nshell.asd b/nshell.asd index 6764bed4..059a8f6f 100644 --- a/nshell.asd +++ b/nshell.asd @@ -23,6 +23,7 @@ :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") 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 4075e097..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,32 +68,59 @@ 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 termios conversion omits native fields, including Darwin's -;; baud rates. Keep the complete structure using its platform-grovelled size. +;; 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 sb-posix::alien-termios :bytes) + (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 (%tcgetattr fd (sb-sys:vector-sap 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 "tcgetattr failed on fd ~d (errno=~d)" fd errno)))) + (error "Terminal query failed on fd ~d (errno=~d)" fd errno)))) termios)) -(defun %apply-termios (fd action termios) +(defun %apply-termios (fd termios) (sb-sys:with-pinned-objects (termios) - (when (minusp (%tcsetattr fd action (sb-sys:vector-sap 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 "tcsetattr failed on fd ~d (errno=~d)" fd 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. @@ -109,12 +130,16 @@ Everything else -- notably ISIG and OPOST -- is left as the terminal had it; see the commentary at the top of this file." (sb-sys:with-pinned-objects (termios) (let ((native (sb-alien:sap-alien (sb-sys:vector-sap termios) - (* sb-posix::alien-termios)))) - (setf (sb-alien:slot (sb-alien:deref native) 'sb-posix::iflag) - (logand (sb-alien:slot (sb-alien:deref native) 'sb-posix::iflag) + (* 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) 'sb-posix::lflag) - (logand (sb-alien:slot (sb-alien:deref native) 'sb-posix::lflag) + (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) @@ -166,7 +191,7 @@ the terminal cannot be queried or reconfigured." (sb-sys:without-interrupts (unless (%saved-termios fd) (%save-termios fd (%read-termios fd))) - (%apply-termios fd sb-posix:tcsanow raw) + (%apply-termios fd raw) t)) (error (condition) (error 'terminal-mode-operation-failed @@ -194,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 - (%apply-termios fd sb-posix:tcsanow saved) + (%apply-termios fd saved) (%forget-termios fd) t)) (error (condition) diff --git a/t/integration/test-terminal.lisp b/t/integration/test-terminal.lisp index 5e9b69f5..8f85789f 100644 --- a/t/integration/test-terminal.lisp +++ b/t/integration/test-terminal.lisp @@ -83,16 +83,33 @@ under test. sb-posix does not name either constant, hence the literals." #+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) @@ -145,6 +162,29 @@ raw mode with no matching restore, which is exactly this case." (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) From fa63437b806eb407f20d863cd879521450fe5999 Mon Sep 17 00:00:00 2001 From: takeokunn Date: Sun, 11 Oct 2026 12:39:11 +0900 Subject: [PATCH 05/11] test: capture foreground pipeline failures and clarify release docs --- README.md | 22 ++++---- docs/src/getting-started.md | 90 ++++++++++++++++-------------- docs/src/guide/concepts.md | 27 ++++----- docs/src/reference/architecture.md | 72 ++++++++++++------------ t/e2e/test-smoke.lisp | 2 + 5 files changed, 108 insertions(+), 105 deletions(-) diff --git a/README.md b/README.md index c500177b..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,7 +43,9 @@ 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 @@ -53,12 +55,12 @@ 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 checks an extracted archive and exercises its executable with a real PTY, including editing, signals, job control, history restart, and terminal @@ -77,8 +79,8 @@ 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 # time-limited local hermetic check +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 @@ -86,8 +88,8 @@ 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. This is not the full CI gate's time limit; see +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. @@ -97,7 +99,7 @@ Run source-loaded integration, dependency, and history checks with the 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)" \ 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/reference/architecture.md b/docs/src/reference/architecture.md index 24a593cf..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). ├── 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,21 +56,18 @@ 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 rule-based tokenizer and Pratt (operator-precedence) parser drive `$((...))` @@ -89,11 +88,12 @@ layer where it fits the domain-driven design: `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. nshell snapshots the complete native `termios` - structure to preserve terminal speeds and control fields across raw-mode + 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 diff --git a/t/e2e/test-smoke.lisp b/t/e2e/test-smoke.lisp index dcdcc931..57345027 100644 --- a/t/e2e/test-smoke.lisp +++ b/t/e2e/test-smoke.lisp @@ -527,6 +527,8 @@ The regular read timeout remains short for command-response assertions.") (%e2e-pty-await-ready fd) (%e2e-pty-write-line fd "sh -c 'sleep 2; printf \"pty-%s\\n\" outlived-timeout' | cat") (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") From 0383d22305ae91e38cd8e68e6502bc456467dae4 Mon Sep 17 00:00:00 2001 From: takeokunn Date: Sun, 11 Oct 2026 13:41:54 +0900 Subject: [PATCH 06/11] fix: enforce visible rerun confirmation and settle sidecar EOF races --- docs/src/guide/customization.md | 13 +- docs/src/guide/recipes.md | 6 +- man/nshell.1 | 12 +- .../acl/syscall-process-substitution.lisp | 11 +- .../assistant-sidecar-stream.lisp | 66 ++-- src/infrastructure/terminal/input-core.lisp | 1 + src/presentation/repl-output-handlers.lisp | 73 +++- src/presentation/repl.lisp | 36 +- t/e2e/test-smoke.lisp | 7 +- t/integration/test-terminal-stream.lisp | 1 + t/unit/test-assistant-model-boundary.lisp | 314 +++++++++++++++--- t/unit/test-execute-pipeline-branches.lisp | 40 +++ t/unit/test-repl-execution.lisp | 282 +++++++++++++--- 13 files changed, 701 insertions(+), 161 deletions(-) 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 d5a87336..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`: diff --git a/man/nshell.1 b/man/nshell.1 index 4058fa10..f5152cdc 100644 --- a/man/nshell.1 +++ b/man/nshell.1 @@ -68,7 +68,7 @@ instead of .BR ~/.nshellrc . .TP .B \-\-no\-history -Do not load or save the history file; in-session history remains available. +Do not load or save the history file, or record commands in in-session history. .SH KEY BINDINGS The default Emacs-style bindings use \fBC\-\fR for Ctrl and \fBM\-\fR for Alt (Meta). @@ -104,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 @@ -264,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 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/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/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/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 57345027..ba193cc0 100644 --- a/t/e2e/test-smoke.lisp +++ b/t/e2e/test-smoke.lisp @@ -525,7 +525,12 @@ 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)) 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/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-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-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)) From 1bbcbdaa81a4346b8db3816c18cde2d8d1e1ae15 Mon Sep 17 00:00:00 2001 From: takeokunn Date: Sun, 11 Oct 2026 14:23:23 +0900 Subject: [PATCH 07/11] fix: hold foreground children until terminal ownership transfers --- src/infrastructure/acl/syscall-process.lisp | 4 ++-- t/integration/test-process.lisp | 21 +++++++++++++++++++++ 2 files changed, 23 insertions(+), 2 deletions(-) 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/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)) From 948d07a0bb3a34f4c650ef0fb202ab751153d61f Mon Sep 17 00:00:00 2001 From: takeokunn Date: Sun, 11 Oct 2026 14:25:30 +0900 Subject: [PATCH 08/11] docs: distinguish draft assets from published releases --- docs/src/project/public-readiness.md | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/docs/src/project/public-readiness.md b/docs/src/project/public-readiness.md index ee3a0e2e..e42703d4 100644 --- a/docs/src/project/public-readiness.md +++ b/docs/src/project/public-readiness.md @@ -42,8 +42,9 @@ Before a public release can claim the capabilities listed here: 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 and manifest verification - after extraction. Its executable passes the real-PTY gate for editing, +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 @@ -52,7 +53,8 @@ Before a public release can claim the capabilities listed here: 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 @@ -91,7 +93,8 @@ does not supply that runtime coverage. - The dependency runner executes the pinned libraries' own suites; the history script checks private persistence. A successful library load is not a test result. -- Extract a release archive and run +- 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`. From 30cf533d3c821b232ea82f411863a9e54eef10ad Mon Sep 17 00:00:00 2001 From: takeokunn Date: Sun, 11 Oct 2026 14:25:30 +0900 Subject: [PATCH 09/11] fix: exclude the forge checkout from pinned dependency discovery --- scripts/dependency-registry.lisp | 46 +++++++++++++++ scripts/test-dependencies.lisp | 32 +---------- scripts/test-dependencies.sh | 1 + scripts/test-dependency-registry.lisp | 80 +++++++++++++++++++++++++++ 4 files changed, 128 insertions(+), 31 deletions(-) create mode 100644 scripts/dependency-registry.lisp create mode 100644 scripts/test-dependency-registry.lisp 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 index be56c204..0df8cb15 100644 --- a/scripts/test-dependencies.lisp +++ b/scripts/test-dependencies.lisp @@ -2,6 +2,7 @@ (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) @@ -32,37 +33,6 @@ (error "Required cl-weave API is unavailable: ~A" name)) (apply (symbol-function symbol) arguments))) -(defun dependency-store-path-p (path) - (and path (uiop:string-prefix-p "/nix/store/" (namestring (truename path))))) - -(defun dependency-configure-registry () - (let* ((value (uiop:getenv "CL_SOURCE_REGISTRY")) - (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) - (member entry '(:inherit-configuration - :ignore-inherited-configuration - (:inherit-configuration) - (:ignore-inherited-configuration)) - :test #'equal)) - 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")) - (let ((configuration `(:source-registry ,@entries :ignore-inherited-configuration))) - (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)))) - (defun dependency-check-source (system) (let ((source (asdf:system-source-file (asdf:find-system system)))) (unless (dependency-store-path-p source) diff --git a/scripts/test-dependencies.sh b/scripts/test-dependencies.sh index db56730e..1b1d5094 100644 --- a/scripts/test-dependencies.sh +++ b/scripts/test-dependencies.sh @@ -22,6 +22,7 @@ fi # A private cache avoids both read-only store writes and other sessions' caches. dependency_cache=$(mktemp -d "${TMPDIR:-/tmp}/nshell-dependency-tests.XXXXXXXX") export NSHELL_ASDF_OUTPUT_DIR="$dependency_cache/asdf/" +"$dependency_sbcl" --noinform --script "$dependency_script_dir/test-dependency-registry.lisp" dependency_failed=0 dependency_passed=0 for dependency_system in "$@"; do 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")))) From f0df77504dd5bd32471e289086ca8dad00055928 Mon Sep 17 00:00:00 2001 From: takeokunn Date: Sun, 11 Oct 2026 15:06:14 +0900 Subject: [PATCH 10/11] fix: execute every dependency test in the Linux verification environment --- flake.nix | 12 ++- .../cl-process-kit-enable-linux-tests.patch | 81 +++++++++++++++++++ 2 files changed, 90 insertions(+), 3 deletions(-) create mode 100644 nix/patches/cl-process-kit-enable-linux-tests.patch diff --git a/flake.nix b/flake.nix index 21218e44..821a405c 100644 --- a/flake.nix +++ b/flake.nix @@ -316,9 +316,12 @@ clLogKit clCodecKit ]; - # Remove the duplicate clock definition and serialize process - # reaping with the cancellation watcher. - 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 + ]; }; clRegexKit = sibling { name = "cl-regex-kit"; @@ -720,6 +723,7 @@ bash zsh fish + ghq mandoc nushell powershell @@ -762,6 +766,8 @@ # 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 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")) From 30de937bd62e1a79023555cf132b67b3594cc61c Mon Sep 17 00:00:00 2001 From: takeokunn Date: Sun, 11 Oct 2026 15:51:57 +0900 Subject: [PATCH 11/11] fix: wait for timed-out process groups and preserve cleanup failures --- flake.nix | 1 + ...l-process-kit-wait-for-timeout-group.patch | 190 ++++++++++++++++++ 2 files changed, 191 insertions(+) create mode 100644 nix/patches/cl-process-kit-wait-for-timeout-group.patch diff --git a/flake.nix b/flake.nix index 821a405c..108776ec 100644 --- a/flake.nix +++ b/flake.nix @@ -321,6 +321,7 @@ 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 { 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)))