commit - /dev/null
commit + c78f50be073c1324df8ced7730ea3538e92580f4
blob - /dev/null
blob + 56149432a994999960a06ea4683bf3a81755118c (mode 644)
--- /dev/null
+++ .gitignore
+/build/
+/src/pisol/*.so
+/.ninja_log
blob - /dev/null
blob + 9d3d55da1c82b606c81201f981976630752bad97 (mode 644)
--- /dev/null
+++ LICENSE
+MIT License
+
+Copyright (c) 2026 mtmn
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
blob - /dev/null
blob + a49a799b818e2bc6cc27a688512f776ab95f4faa (mode 644)
--- /dev/null
+++ Makefile
+LIBDIR = src
+SCHEME ?= scheme
+
+.PHONY: build tui test copy-config clean run fmt install uninstall help
+
+default: help
+
+build: build/runtime/pisol.so
+
+build/runtime/pisol.so: bin/pisol.ss src/pisol/core.sls src/pisol/tui.sls tools/build.ss
+ @mkdir -p build/runtime/lib/pisol
+ $(SCHEME) --libdirs $(LIBDIR) --compile-imported-libraries --program tools/build.ss
+ cp src/pisol/core.so src/pisol/tui.so build/runtime/lib/pisol/
+
+tui: build
+ $(SCHEME) --libdirs $(LIBDIR) --program bin/pisol.ss
+
+test: build
+ shellcheck bin/pisol test/integration.sh tools/fmt.sh
+ $(SCHEME) --libdirs $(LIBDIR) --program test/test.ss
+ sh test/integration.sh
+
+copy-config:
+ @config_home="$${XDG_CONFIG_HOME:-$$HOME/.config}"; \
+ target="$$config_home/pisol/init"; \
+ s=; if [ -e "$$config_home" ] && [ ! -w "$$config_home" ]; then s=sudo; fi; \
+ if [ -f "$$target" ]; then \
+ printf 'pisol: %s already exists\n' "$$target" >&2; \
+ exit 1; \
+ fi; \
+ $$s install -d "$$config_home/pisol" && \
+ $$s install -m 644 config/pisol/init "$$target"
+
+clean:
+ rm -rf build src/pisol/core.so src/pisol/tui.so
+
+run: install
+ bash /usr/local/bin/pisol
+
+fmt:
+ sh tools/fmt.sh src/pisol/core.sls src/pisol/tui.sls bin/pisol.ss test/test.ss tools/build.ss
+
+install:
+ ninja install
+
+uninstall:
+ ninja uninstall
+
+help:
+ @printf '%s\n' \
+ 'make build Compile the Chez Scheme program' \
+ 'make tui Run the configuration TUI' \
+ 'make test Run specification, static, Chez, shell, and TUI tests' \
+ 'make run Install and run pisol' \
+ 'make fmt Format Scheme sources with emacs scheme-mode' \
+ 'make copy-config Copy the default global init to ~/.config/pisol/init' \
+ 'make clean Remove generated artifacts' \
+ 'make install Install pisol and its manual' \
+ 'make uninstall Remove installed pisol files' \
+ 'make help Show this help message' \
+ '' \
+ 'Variables: SCHEME=scheme'
blob - /dev/null
blob + 27240973130df2f0ca7d57de805a4629cab6811f (mode 644)
--- /dev/null
+++ README.md
+# pisol
+
+Working-directory Landrun isolation and configuration, with a terminal interface
+written in Chez Scheme.
+
+`pisol` combines command isolation with an editor for the local trusted
+`.isolate` shell fragment. Outbound TCP is denied by default. The editor manages
+extra writable/executable directories and the destination TCP ports commands
+may connect to.
+
+## Run
+
+You need Bash, [Landrun](https://github.com/Zouuup/landrun), Chez Scheme 10.4 or
+newer, and Ninja. Install `fzf` for fuzzy directory selection. Without it, the
+editor uses direct path entry. Install `emacs` to run `ninja fmt`.
+
+```sh
+ninja tui
+ninja test
+```
+
+After installation, open the editor in the working directory:
+
+```sh
+pisol
+```
+
+Run a command in that directory sandbox:
+
+```sh
+pisol -- your-command --with arguments
+```
+
+The command receives the caller environment, `PROMPT_ENV_INDICATOR=isolated`,
+and `ISOLATE_ENV` set to the canonical working directory. Calling `pisol -- ...`
+inside an existing pisol sandbox prints a warning and directly executes the
+command rather than creating a nested Landlock domain.
+
+## TUI commands
+
+```text
+a fuzzy-find or enter a writable directory path
+r choose and remove a writable directory
+p PORT allow outbound TCP connections to a destination port
+d enter and remove an outbound TCP port
+c show global and local configuration file contents
+s save
+sx save and exit immediately (xs also works)
+? help
+x exit (discards any unsaved changes)
+```
+
+After selecting `a`, enter a base path such as `/home/miro`, or press Enter to
+open the picker in your home directory. `fzf` then lists that path and its
+immediate child directories only. Press Enter to drill down into a directory,
+Alt+Enter or Ctrl-S to select it, or Escape to use the typed path directly.
+The baseline writable tree cannot be added redundantly.
+
+Set `NO_COLOR=1` to disable colour. `COLUMNS` and `LINES` are respected by the
+terminal environment. Set `ISOLATE_EXTRA_CONFIG` to use a config path other
+than `CURRENT_DIRECTORY/.isolate`.
+
+## Configuration and trust
+
+`.isolate` is sourced as trusted Bash by the launcher. A generated file looks
+like this:
+
+```bash
+args+=(
+ --rwx '/home/example/shared work'
+ --connect-tcp 443
+)
+```
+
+A global init file at `~/.config/pisol/init` is sourced before the local
+`.isolate` when it exists. Put shared grants there; the project-specific file
+builds on top of it. Override the path with `PISOL_INIT_CONFIG`.
+
+A permissive example init based on the legacy `isolate` script is included at
+`config/pisol/init`. Copy it to `~/.config/pisol/init` and edit to taste;
+remove `--unrestricted-network` to keep outbound TCP denied by default.
+
+The TUI also evaluates existing custom `.isolate` logic. It extracts the
+resulting `--rwx` and `--connect-tcp` entries and preserves other resulting
+Landrun arguments. Saving custom logic requires confirmation because the source
+is replaced by a canonical argument array; comments and dynamic logic are not
+retained. Default grants from the global init are shown but not edited in the
+TUI; add or remove project-specific entries instead.
+
+The minimal default policy grants the working tree read/write/execute access,
+temporary storage write access, read access to system configuration/data, and
+read/execute access to standard runtime and absolute `PATH` directories. It
+also grants the standard null, zero, random, and controlling-terminal devices,
+but does not grant unrestricted networking. A Wayland socket is added when
+`WAYLAND_DISPLAY` and `XDG_RUNTIME_DIR` are set.
+
+## Build and install
+
+```sh
+ninja build
+ninja test
+ninja fmt
+ninja install
+ninja copy-config
+```
+
+`ninja fmt` reindents the Scheme sources in place with `emacs` scheme-mode. Run
+it after editing Scheme files; it is a no-op on already-formatted files.
+
+`ninja install` defaults to `/usr/local` and asks for `sudo` only when needed.
+Set `PREFIX`, `DESTDIR`, `BINDIR`, `LIBEXECDIR`, `MANDIR`, or `SCHEME` to
+override the defaults. See `pisol(1)` after installation.
blob - /dev/null
blob + 0966c7b012fa721f124c9d3989f4a31de57a5038 (mode 755)
--- /dev/null
+++ bin/pisol
+#!/usr/bin/env bash
+set -euo pipefail
+
+pisol_usage() {
+ cat <<'EOF'
+Usage: pisol
+ pisol -- COMMAND [ARG...]
+
+With no arguments, edit the local .isolate configuration.
+With --, execute COMMAND in the current directory Landrun sandbox.
+EOF
+}
+
+pisol_bin_dir=$(CDPATH='' cd -- "$(dirname -- "$0")" && pwd)
+pisol_runtime_dir=${PISOL_RUNTIME_DIR:-$pisol_bin_dir/../libexec/pisol}
+
+case ${1:-} in
+-h|--help)
+ pisol_usage
+ exit 0
+ ;;
+--version)
+ printf '%s\n' 'pisol 0.1.0'
+ exit 0
+ ;;
+"")
+ pisol_project=$(pwd -P)
+ pisol_config=${ISOLATE_EXTRA_CONFIG:-$pisol_project/.isolate}
+ exec "${SCHEME:-scheme}" \
+ --libdirs "$pisol_runtime_dir/lib" \
+ --program "$pisol_runtime_dir/pisol.so" \
+ --project "$pisol_project" \
+ --config "$pisol_config"
+ ;;
+--)
+ shift
+ if [[ $# -eq 0 ]]; then
+ printf '%s\n' 'pisol: missing command after --' >&2
+ pisol_usage >&2
+ exit 2
+ fi
+ ;;
+*)
+ printf 'pisol: unknown option: %s\n' "$1" >&2
+ pisol_usage >&2
+ exit 2
+ ;;
+esac
+
+if [[ -n ${ISOLATE_ENV:-} ]]; then
+ printf '%s\n' 'pisol: warning: already isolated; executing command directly' >&2
+ exec "$@"
+fi
+
+if ! command -v landrun >/dev/null 2>&1; then
+ printf '%s\n' 'pisol: landrun is not installed or not on PATH' >&2
+ exit 127
+fi
+
+pisol_project=$(pwd -P)
+pisol_config=${ISOLATE_EXTRA_CONFIG:-$pisol_project/.isolate}
+
+env_args=()
+while IFS= read -r name; do
+ env_args+=(--env "$name")
+done < <(compgen -e)
+
+args=(
+ --best-effort
+ --ignore-missing
+ --unrestricted-scoped
+ --rw /tmp
+ --env PROMPT_ENV_INDICATOR=isolated
+ --env "ISOLATE_ENV=$pisol_project"
+ --rwx "$pisol_project"
+)
+
+declare -A pisol_seen=()
+pisol_add_path() {
+ local mode=$1 path=$2 key
+ [[ -e $path ]] || return 0
+ key=$mode:$path
+ [[ -z ${pisol_seen[$key]:-} ]] || return 0
+ pisol_seen[$key]=1
+ args+=("$mode" "$path")
+}
+
+for path in /bin /sbin /lib /lib64 /usr/bin /usr/sbin /usr/lib /usr/lib64 /nix /run/current-system/sw; do
+ pisol_add_path --rox "$path"
+done
+for path in /etc /usr/share; do
+ pisol_add_path --ro "$path"
+done
+for path in /dev/null /dev/zero /dev/random /dev/urandom /dev/tty; do
+ pisol_add_path --rw "$path"
+done
+
+IFS=: read -r -a pisol_path_entries <<<"${PATH:-}"
+for path in "${pisol_path_entries[@]}"; do
+ [[ $path = /* ]] && pisol_add_path --rox "$path"
+done
+
+if [[ ${TMPDIR:-} = /* && ${TMPDIR:-} != /tmp ]]; then
+ pisol_add_path --rw "$TMPDIR"
+fi
+
+if [[ -n ${WAYLAND_DISPLAY:-} && -n ${XDG_RUNTIME_DIR:-} ]]; then
+ args+=(--unix "${XDG_RUNTIME_DIR}/${WAYLAND_DISPLAY}")
+fi
+
+pisol_init=${PISOL_INIT_CONFIG:-${XDG_CONFIG_HOME:-$HOME/.config}/pisol/init}
+if [[ -f $pisol_init ]]; then
+ # shellcheck disable=SC1090
+ source "$pisol_init"
+fi
+
+if [[ -f $pisol_config ]]; then
+ # shellcheck disable=SC1090
+ source "$pisol_config"
+fi
+
+exec landrun \
+ "${env_args[@]}" \
+ "${args[@]}" \
+ -- \
+ "$@"
blob - /dev/null
blob + 2f97d60ac340181b0b19b09d563daabedaf13fda (mode 644)
--- /dev/null
+++ bin/pisol.ss
+#!/usr/bin/env scheme --program
+(import (chezscheme)
+ (pisol core)
+ (pisol tui))
+
+(define (usage port)
+ (display "Usage: pisol\n" port)
+ (display "Internal TUI options: --project PATH --config PATH\n" port))
+
+(define (parse arguments)
+ (let loop ([remaining arguments] [project #f] [config #f])
+ (cond
+ [(null? remaining) (values project config)]
+ [(and (pair? (cdr remaining)) (string=? (car remaining) "--project"))
+ (loop (cddr remaining) (cadr remaining) config)]
+ [(and (pair? (cdr remaining)) (string=? (car remaining) "--config"))
+ (loop (cddr remaining) project (cadr remaining))]
+ [else (error 'pisol "unknown or incomplete internal option" (car remaining))])))
+
+(guard (condition
+ (else
+ (display "pisol: " (current-error-port))
+ (display-condition condition (current-error-port))
+ (newline (current-error-port))
+ (exit 1)))
+ (let-values ([(project config) (parse (cdr (command-line)))])
+ (let* ([project (or (canonical-directory (or project (current-directory)))
+ (error 'pisol "project is not a directory" project))]
+ [config (or config
+ (getenv "ISOLATE_EXTRA_CONFIG")
+ (string-append project "/.isolate"))])
+ (run-tui (load-configuration project config)))))
+
blob - /dev/null
blob + 4d9c7939c5a158d67ec69b06eb25da179a2c1c45 (mode 644)
--- /dev/null
+++ build.ninja
+ninja_required_version = 1.5
+
+libdir = src
+
+rule compile
+ command = mkdir -p build/runtime/lib/pisol && $${SCHEME:-scheme} --libdirs $libdir --compile-imported-libraries --program tools/build.ss && cp src/pisol/core.so src/pisol/tui.so build/runtime/lib/pisol/
+ description = compiling pisol
+
+build build/runtime/pisol.so: compile bin/pisol.ss src/pisol/core.sls src/pisol/tui.sls tools/build.ss
+
+build build: phony build/runtime/pisol.so
+default build
+
+rule install
+ command = prefix=$${PREFIX:-/usr/local}; bindir=$${BINDIR:-$$prefix/bin}; libexecdir=$${LIBEXECDIR:-$$prefix/libexec/pisol}; mandir=$${MANDIR:-$$prefix/share/man}; destdir=$${DESTDIR:-}; can_create() { d="$$1"; while [ -n "$$d" ] && [ ! -e "$$d" ]; do d=$$(dirname "$$d"); done; [ -d "$$d" ] && [ -w "$$d" ]; }; s=; if ! can_create "$$destdir$$bindir"; then s=sudo; fi; $$s install -d "$$destdir$$bindir" "$$destdir$$libexecdir/lib/pisol" "$$destdir$$mandir/man1" && $$s install -m 755 bin/pisol "$$destdir$$bindir/pisol" && $$s install -m 755 build/runtime/pisol.so "$$destdir$$libexecdir/pisol.so" && $$s install -m 644 build/runtime/lib/pisol/core.so build/runtime/lib/pisol/tui.so "$$destdir$$libexecdir/lib/pisol/" && $$s install -m 644 doc/pisol.1 "$$destdir$$mandir/man1/pisol.1"
+ pool = console
+ description = installing pisol
+
+build install: install build/runtime/pisol.so
+
+rule uninstall
+ command = prefix=$${PREFIX:-/usr/local}; bindir=$${BINDIR:-$$prefix/bin}; libexecdir=$${LIBEXECDIR:-$$prefix/libexec/pisol}; mandir=$${MANDIR:-$$prefix/share/man}; destdir=$${DESTDIR:-}; can_create() { d="$$1"; while [ -n "$$d" ] && [ ! -e "$$d" ]; do d=$$(dirname "$$d"); done; [ -d "$$d" ] && [ -w "$$d" ]; }; s=; if ! can_create "$$destdir$$bindir"; then s=sudo; fi; $$s rm -f "$$destdir$$bindir/pisol" "$$destdir$$libexecdir/pisol.so" "$$destdir$$libexecdir/lib/pisol/core.so" "$$destdir$$libexecdir/lib/pisol/tui.so" "$$destdir$$mandir/man1/pisol.1"
+ pool = console
+ description = uninstalling pisol
+
+build uninstall: uninstall
+
+rule help
+ command = printf '%s\n' 'ninja install Install pisol and its manual (escalates to sudo if needed)' 'ninja uninstall Remove installed pisol files' '' 'Variables: PREFIX=/usr/local DESTDIR=' ' BINDIR=PREFIX/bin LIBEXECDIR=PREFIX/libexec/pisol MANDIR=PREFIX/share/man' ' NO_COLOR=1'
+ pool = console
+
+build help: help
blob - /dev/null
blob + 63da1b855da6d8a2b9be5d572dfced0d0cb68ee6 (mode 644)
--- /dev/null
+++ config/pisol/init
+#!/usr/bin/env bash
+# Default global init for pisol.
+# Sourced before the project-specific .isolate file. Put shared grants here
+# and keep per-project additions in $PWD/.isolate.
+
+# Remove --unrestricted-network below to deny outbound TCP by default,
+
+args+=(--unrestricted-network)
+
+for p in \
+ /bin \
+ /lib \
+ /lib64 \
+ /usr/bin \
+ /usr/lib \
+ /etc \
+ /nix \
+ "$HOME/bin" \
+ "$HOME/.zvm" \
+ "$HOME/.cargo" \
+ "$HOME/.config" \
+ "$HOME/.gitconfig" \
+ "$HOME/.local/bin" \
+ "$HOME/.cache/zig" \
+ "$HOME/.rustup" \
+ "$HOME/.nix-profile"; do
+ args+=(--rox "$p")
+done
+
+for p in \
+ "$HOME/.codex" \
+ "$HOME/.pi" \
+ "$HOME/.config/goose" \
+ "$HOME/.cache/opencode" \
+ "$HOME/.config/opencode" \
+ "$HOME/.local/share/opencode" \
+ "$HOME/.local/state/opencode" \
+ "$HOME/.local/share/goose" \
+ "$HOME/.local/state/goose"; do
+ args+=(--rwx "$p")
+done
blob - /dev/null
blob + 719bc22fcae4c29d6dcd4d5cc3af89279fa2ae73 (mode 644)
--- /dev/null
+++ doc/pisol.1
+.TH PISOL 1 "2026-08-27" "pisol" "User Commands"
+.SH NAME
+pisol \- configure and run working-directory Landrun isolation
+.SH SYNOPSIS
+.B pisol
+.br
+.B pisol --
+.I COMMAND
+.RI [ ARG ...]
+.SH DESCRIPTION
+.B pisol
+opens a Chez Scheme terminal editor for the current directory isolation
+configuration. With
+.BR -- ,
+it replaces itself with
+.BR landrun (1)
+and executes the command in a working-directory sandbox.
+.PP
+The canonical current directory defines the writable tree. The configuration
+path is
+.I CURRENT_DIRECTORY/.isolate
+unless
+.B ISOLATE_EXTRA_CONFIG
+is set.
+.SH ISOLATION POLICY
+The working tree is readable, writable, and executable. Temporary storage is
+writable. Standard runtime and absolute PATH directories are readable and
+executable, while system configuration and shared data are read-only. The
+standard null, zero, random, and controlling-terminal devices are writable.
+.PP
+Outbound TCP is denied by default. Only destination ports configured with
+.B --connect-tcp
+are granted. Scoped IPC restrictions are relaxed, and the current Wayland
+socket is granted when its environment variables are available.
+.PP
+The caller environment is forwarded. The command additionally receives
+.B PROMPT_ENV_INDICATOR=isolated
+and
+.B ISOLATE_ENV
+set to the canonical working directory. If
+.B ISOLATE_ENV
+is already non-empty, pisol warns and directly executes the command without
+starting a nested Landlock domain.
+.SH TUI COMMANDS
+.TP
+.B a
+Prompt for a base directory path and add it as an additional
+read/write/execute grant. With no input, the picker opens in the user's home
+directory. When
+.BR fzf (1)
+is available, the picker lists only the typed path and its immediate child
+directories. Press Enter to drill down into a directory, Alt+Enter or
+Ctrl-S to select it, or Escape to use the typed path directly.
+.TP
+.B r
+Prompt for the number of a writable directory and remove it.
+.TP
+.BI p " PORT"
+Allow outbound TCP connections to PORT. Valid ports are 1 through 65535.
+.TP
+.B d
+Prompt for a configured outbound TCP port and remove it.
+.TP
+.B c
+Show the resolved global init file and the local configuration file, including their raw contents. A missing file is labelled absent.
+.TP
+.B s
+Save atomically with mode 0600. The combined commands
+.B sx
+and
+.B xs
+save and then exit immediately.
+.TP
+.BR ? , " x"
+Show help or exit. Exit discards any unsaved changes.
+.SH CONFIGURATION
+.I .isolate
+is trusted Bash code sourced by the launcher. It modifies the Bash array
+.IR args ,
+normally with an
+.B args+=(...)
+fragment.
+.PP
+If
+.I ~/.config/pisol/init
+exists, it is sourced before the local
+.I .isolate .
+Put shared grants in the global init file; per-project configuration builds on
+top of it. The path can be overridden with
+.BR PISOL_INIT_CONFIG .
+.PP
+A permissive example global init based on the legacy
+.I isolate
+script is included in the source tree at
+.IR config/pisol/init .
+Copy it to
+.I ~/.config/pisol/init
+and edit to customize. Remove
+.B --unrestricted-network
+from the copy to deny outbound TCP by default.
+.PP
+The editor evaluates an existing file, manages resulting
+.B --rwx
+and
+.B --connect-tcp
+pairs, and preserves other resulting arguments. Saving custom shell logic
+requires confirmation and replaces it with a canonical static array; source
+comments and dynamic logic are not preserved. Default grants from the global
+init file are shown but not editable in the TUI.
+.SH ENVIRONMENT
+.TP
+.B ISOLATE_EXTRA_CONFIG
+Override the local configuration path.
+.TP
+.B PISOL_INIT_CONFIG
+Override the global init path. Defaults to
+.IR ~/.config/pisol/init .
+.TP
+.B ISOLATE_ENV
+Marks an existing pisol sandbox and prevents nesting.
+.TP
+.B NO_COLOR
+Disable TUI colour when set to any value.
+.TP
+.BR HOME , " PATH" , " TMPDIR"
+Supply runtime paths and grants.
+.TP
+.BR WAYLAND_DISPLAY , " XDG_RUNTIME_DIR"
+Identify an optional Wayland Unix socket grant.
+.SH EXIT STATUS
+The TUI returns zero on normal exit and non-zero on load or save errors. In
+command mode, pisol propagates the executed command status. Usage errors
+return 2 and a missing Landrun executable returns 127.
+.SH SEE ALSO
+.BR fzf (1)
blob - /dev/null
blob + 0a4d232664c0dfe294cc8d6e9f4dfa101340b9da (mode 644)
--- /dev/null
+++ src/pisol/core.sls
+(library
+ (pisol core)
+ (export make-empty-configuration
+ load-configuration
+ global-init-path
+ save-configuration!
+ configuration-project-path
+ configuration-config-path
+ configuration-writable-directories
+ configuration-outbound-ports
+ configuration-preserved-arguments
+ configuration-local-writable-directories
+ configuration-local-outbound-ports
+ configuration-baseline-arguments
+ configuration-source-style
+ configuration-dirty?
+ add-directory!
+ remove-directory!
+ add-port!
+ remove-port!
+ port-valid?
+ canonical-directory
+ path-within?
+ shell-quote
+ config->shell
+ string-prefix?
+ partition-arguments)
+ (import (chezscheme))
+
+ (define-record-type configuration
+ (fields project-path
+ config-path
+ (mutable baseline-arguments)
+ (mutable local-writable-directories)
+ (mutable local-outbound-ports)
+ (mutable local-preserved-arguments)
+ (mutable writable-directories)
+ (mutable outbound-ports)
+ (mutable preserved-arguments)
+ (mutable source-style)
+ (mutable dirty?)))
+
+ (define (make-empty-configuration project-path config-path)
+ (make-configuration project-path config-path '() '() '() '() '() '() '() 'absent #f))
+
+ (define (string-prefix? prefix text)
+ (and (<= (string-length prefix) (string-length text))
+ (string=? prefix (substring text 0 (string-length prefix)))))
+
+ (define (string-suffix? suffix text)
+ (and (<= (string-length suffix) (string-length text))
+ (string=? suffix
+ (substring text
+ (- (string-length text) (string-length suffix))
+ (string-length text)))))
+
+ (define (trim text)
+ (let left ([start 0])
+ (if (and (< start (string-length text))
+ (char-whitespace? (string-ref text start)))
+ (left (+ start 1))
+ (let right ([end (string-length text)])
+ (if (and (> end start)
+ (char-whitespace? (string-ref text (- end 1))))
+ (right (- end 1))
+ (substring text start end))))))
+
+ (define (canonical-directory path)
+ (guard (condition (else #f))
+ (and (string? path)
+ (> (string-length path) 0)
+ (file-directory? path)
+ (parameterize ([current-directory path]) (current-directory)))))
+
+ (define (path-within? path root)
+ (or (string=? path root)
+ (let ([prefix (if (string-suffix? "/" root) root (string-append root "/"))])
+ (string-prefix? prefix path))))
+
+ (define (port-valid? port)
+ (and (integer? port) (exact? port) (<= 1 port 65535)))
+
+ (define (append-unique items item)
+ (if (member item items) items (append items (list item))))
+
+ (define (remove-equal items item)
+ (filter (lambda (candidate) (not (equal? candidate item))) items))
+
+ (define (unique items)
+ (let loop ([remaining items] [seen '()])
+ (if (null? remaining)
+ (reverse seen)
+ (if (member (car remaining) seen)
+ (loop (cdr remaining) seen)
+ (loop (cdr remaining) (cons (car remaining) seen))))))
+
+ (define (recompute-effective! configuration)
+ (let-values ([(base-dirs base-ports base-preserved)
+ (partition-arguments (configuration-baseline-arguments configuration))])
+ (let ([local-dirs (configuration-local-writable-directories configuration)]
+ [local-ports (configuration-local-outbound-ports configuration)]
+ [local-preserved (configuration-local-preserved-arguments configuration)])
+ (configuration-writable-directories-set!
+ configuration
+ (unique (append base-dirs local-dirs)))
+ (configuration-outbound-ports-set!
+ configuration
+ (sort < (unique (append base-ports local-ports))))
+ (configuration-preserved-arguments-set!
+ configuration
+ (unique (append base-preserved local-preserved))))))
+
+ (define (add-directory! configuration path)
+ (let ([directory (canonical-directory path)]
+ [project (configuration-project-path configuration)])
+ (if (or (not directory)
+ (path-within? directory project)
+ (member directory (configuration-writable-directories configuration)))
+ #f
+ (begin
+ (configuration-local-writable-directories-set!
+ configuration
+ (append (configuration-local-writable-directories configuration) (list directory)))
+ (recompute-effective! configuration)
+ (configuration-dirty?-set! configuration #t)
+ #t))))
+
+ (define (remove-directory! configuration directory)
+ (if (not (member directory (configuration-local-writable-directories configuration)))
+ #f
+ (begin
+ (configuration-local-writable-directories-set!
+ configuration
+ (remove-equal (configuration-local-writable-directories configuration) directory))
+ (recompute-effective! configuration)
+ (configuration-dirty?-set! configuration #t)
+ #t)))
+
+ (define (add-port! configuration port)
+ (if (or (not (port-valid? port))
+ (member port (configuration-outbound-ports configuration)))
+ #f
+ (begin
+ (configuration-local-outbound-ports-set!
+ configuration
+ (sort < (append (configuration-local-outbound-ports configuration) (list port))))
+ (recompute-effective! configuration)
+ (configuration-dirty?-set! configuration #t)
+ #t)))
+
+ (define (remove-port! configuration port)
+ (if (not (member port (configuration-local-outbound-ports configuration)))
+ #f
+ (begin
+ (configuration-local-outbound-ports-set!
+ configuration
+ (remove-equal (configuration-local-outbound-ports configuration) port))
+ (recompute-effective! configuration)
+ (configuration-dirty?-set! configuration #t)
+ #t)))
+
+ (define (shell-quote text)
+ (let-values ([(port extract) (open-string-output-port)])
+ (display "'" port)
+ (for-each (lambda (character)
+ (if (char=? character #\')
+ (display "'\\''" port)
+ (write-char character port)))
+ (string->list text))
+ (display "'" port)
+ (extract)))
+
+ (define (read-text path)
+ (call-with-input-file path get-string-all))
+
+ (define (canonical-source? text)
+ (let ([text (trim text)])
+ (or (string-prefix? "# Generated by pisol\nargs+=(" text)
+ (string-prefix? "args+=(\n" text)
+ (string-prefix? "args=(\n" text))))
+
+ (define (temporary-path stem)
+ (format "~a.pisol.~a" stem (time-nanosecond (current-time))))
+
+ (define (bytevector->nul-strings bytes)
+ (let loop ([at 0] [current '()] [result '()])
+ (cond
+ [(= at (bytevector-length bytes))
+ (reverse (if (null? current)
+ result
+ (cons (utf8->string (u8-list->bytevector (reverse current))) result)))]
+ [(= (bytevector-u8-ref bytes at) 0)
+ (loop (+ at 1)
+ '()
+ (cons (utf8->string (u8-list->bytevector (reverse current))) result))]
+ [else
+ (loop (+ at 1) (cons (bytevector-u8-ref bytes at) current) result)])))
+
+ (define (evaluate-config path)
+ (let* ([tmpbase (format "~a/pisol-eval-~a"
+ (or (getenv "TMPDIR") "/tmp")
+ (time-nanosecond (current-time)))]
+ [output (string-append tmpbase ".args")]
+ [errors (string-append tmpbase ".errors")]
+ [script "args=(); source \"$1\"; if ((${#args[@]})); then printf '%s\\0' \"${args[@]}\"; fi"]
+ [command (string-append "bash -c " (shell-quote script)
+ " pisol-config " (shell-quote path)
+ ">" (shell-quote output)
+ " 2>" (shell-quote errors))])
+ (dynamic-wind
+ (lambda () #f)
+ (lambda ()
+ (let ([status (system command)])
+ (unless (zero? status)
+ (error 'load-configuration
+ (if (file-exists? errors)
+ (trim (read-text errors))
+ "configuration evaluation failed")
+ path))
+ (let ([port (open-file-input-port output)])
+ (let ([bytes (get-bytevector-all port)])
+ (close-port port)
+ (if (eof-object? bytes)
+ '()
+ (bytevector->nul-strings bytes))))))
+ (lambda ()
+ (when (file-exists? output) (delete-file output))
+ (when (file-exists? errors) (delete-file errors))))))
+
+ (define (digits? text)
+ (and (> (string-length text) 0)
+ (for-all char-numeric? (string->list text))))
+
+ (define (normalize-loaded-directory path)
+ (or (canonical-directory path) path))
+
+ (define (partition-arguments arguments)
+ (let loop ([remaining arguments] [directories '()] [ports '()] [preserved '()])
+ (cond
+ [(null? remaining)
+ (values directories (sort < ports) preserved)]
+ [(string=? (car remaining) "--rwx")
+ (when (null? (cdr remaining))
+ (error 'load-configuration "missing value for --rwx"))
+ (let ([directory (normalize-loaded-directory (cadr remaining))])
+ (loop (cddr remaining)
+ (append-unique directories directory)
+ ports
+ preserved))]
+ [(string=? (car remaining) "--connect-tcp")
+ (when (null? (cdr remaining))
+ (error 'load-configuration "missing value for --connect-tcp"))
+ (let* ([text (cadr remaining)]
+ [port (and (digits? text) (string->number text))])
+ (unless (port-valid? port)
+ (error 'load-configuration "invalid --connect-tcp port" text))
+ (loop (cddr remaining)
+ directories
+ (append-unique ports port)
+ preserved))]
+ [else
+ (loop (cdr remaining)
+ directories
+ ports
+ (append preserved (list (car remaining))))])))
+
+ (define (global-init-path)
+ (or (getenv "PISOL_INIT_CONFIG")
+ (let ([xdg (getenv "XDG_CONFIG_HOME")]
+ [home (getenv "HOME")])
+ (and (or xdg home)
+ (string-append (or xdg (string-append home "/.config"))
+ "/pisol/init")))))
+
+ (define (load-configuration project-path config-path)
+ (let ([project (or (canonical-directory project-path)
+ (error 'load-configuration "project is not a directory" project-path))])
+ (let* ([global-path (global-init-path)]
+ [baseline-args (if (and global-path (file-exists? global-path))
+ (evaluate-config global-path)
+ '())]
+ [local-exists? (file-exists? config-path)]
+ [source-style (if local-exists?
+ (if (canonical-source? (read-text config-path)) 'canonical 'custom)
+ 'absent)]
+ [local-args (if local-exists? (evaluate-config config-path) '())])
+ (let-values ([(base-dirs base-ports base-preserved) (partition-arguments baseline-args)]
+ [(local-dirs local-ports local-preserved) (partition-arguments local-args)])
+ (let ([config (make-configuration project
+ config-path
+ baseline-args
+ local-dirs
+ local-ports
+ local-preserved
+ '()
+ '()
+ '()
+ source-style
+ #f)])
+ (recompute-effective! config)
+ config)))))
+
+ (define (config->shell configuration)
+ (let-values ([(port extract) (open-string-output-port)])
+ (display "args+=(\n" port)
+ (for-each (lambda (argument)
+ (display " " port)
+ (display (shell-quote argument) port)
+ (newline port))
+ (configuration-local-preserved-arguments configuration))
+ (for-each (lambda (directory)
+ (display " --rwx " port)
+ (display (shell-quote directory) port)
+ (newline port))
+ (configuration-local-writable-directories configuration))
+ (for-each (lambda (tcp-port)
+ (format port " --connect-tcp ~a~%" tcp-port))
+ (configuration-local-outbound-ports configuration))
+ (display ")\n" port)
+ (extract)))
+
+ (define (save-configuration! configuration)
+ (let* ([path (configuration-config-path configuration)]
+ [temporary (temporary-path path)])
+ (guard (condition
+ (else
+ (when (file-exists? temporary) (delete-file temporary))
+ (raise condition)))
+ (call-with-output-file temporary
+ (lambda (port) (display (config->shell configuration) port))
+ 'replace)
+ (chmod temporary #o600)
+ (rename-file temporary path)
+ (configuration-source-style-set! configuration 'canonical)
+ (configuration-dirty?-set! configuration #f)
+ #t)))
+)
blob - /dev/null
blob + e0c2d19202e9d0d7e6b2e814e3a9bbf5a726ca3e (mode 644)
--- /dev/null
+++ src/pisol/tui.sls
+(library
+ (pisol tui)
+ (export run-tui)
+ (import (chezscheme)
+ (pisol core))
+
+ (define esc (string (integer->char 27)))
+ (define color? (not (getenv "NO_COLOR")))
+
+ (define (ansi code text)
+ (if color? (string-append esc "[" code "m" text esc "[0m") text))
+ (define (cyan text) (ansi "38;2;155;246;255" text))
+ (define (green text) (ansi "38;2;202;255;191" text))
+ (define (yellow text) (ansi "38;2;253;255;182" text))
+ (define (muted text) (ansi "38;2;108;117;125" text))
+ (define (intense text) (ansi "1;38;2;248;249;250" text))
+
+ (define (clear-screen)
+ (display esc)
+ (display "[2J")
+ (display esc)
+ (display "[H"))
+
+ (define (trim text)
+ (let left ([start 0])
+ (if (and (< start (string-length text))
+ (char-whitespace? (string-ref text start)))
+ (left (+ start 1))
+ (let right ([end (string-length text)])
+ (if (and (> end start)
+ (char-whitespace? (string-ref text (- end 1))))
+ (right (- end 1))
+ (substring text start end))))))
+
+ (define (split-command text)
+ (let ([text (trim text)])
+ (let loop ([at 0])
+ (cond
+ [(= at (string-length text)) (values text "")]
+ [(and (= at 1) (> (string-length text) 1) (not (char-whitespace? (string-ref text 1))))
+ (values (substring text 0 1) (substring text 1 (string-length text)))]
+ [(char-whitespace? (string-ref text at))
+ (values (substring text 0 at) (trim (substring text at (string-length text))))]
+ [else (loop (+ at 1))]))))
+
+ (define (read-input prompt)
+ (display prompt)
+ (flush-output-port (current-output-port))
+ (let ([line (get-line (current-input-port))])
+ (and (not (eof-object? line)) line)))
+
+ (define (command-available? command)
+ (zero? (system (string-append "command -v " command " >/dev/null 2>&1"))))
+
+ (define (terminal-input?)
+ (zero? (system "test -t 0")))
+
+ (define (temporary-path)
+ (string-append (or (getenv "TMPDIR") "/tmp")
+ "/pisol-fzf-"
+ (number->string (time-nanosecond (current-time)))))
+
+ (define (read-first-line path)
+ (and (file-exists? path)
+ (call-with-input-file path
+ (lambda (port)
+ (let ([line (get-line port)])
+ (and (not (eof-object? line)) line))))))
+
+ (define (read-output-lines path)
+ (and (file-exists? path)
+ (call-with-input-file path
+ (lambda (port)
+ (let ([first (get-line port)])
+ (if (eof-object? first)
+ #f
+ (let ([second (get-line port)])
+ (list first
+ (if (eof-object? second) #f second)))))))))
+ (define (read-text path)
+ (call-with-input-file path get-string-all))
+
+ (define (fuzzy-directory base)
+ (if (or (not (terminal-input?))
+ (not (command-available? "fzf"))
+ (not (file-directory? base)))
+ base
+ (let* ([output (temporary-path)]
+ [fd? (command-available? "fd")]
+ [child-list (lambda (dir)
+ (if fd?
+ (string-append "fd --absolute-path --type directory "
+ "--hidden --exclude .git --max-depth 1 . "
+ (shell-quote dir) " 2>/dev/null")
+ (string-append "find " (shell-quote dir)
+ " -maxdepth 1 -type d 2>/dev/null")))]
+ [initial (child-list base)]
+ [reload (child-list "{+1}")]
+ [command
+ (string-append
+ "{ " initial "; } "
+ "| fzf --scheme=path --layout=reverse --height=80% --border"
+ " --expect=esc"
+ " --prompt='Directory path: '"
+ " --header='Enter drills down. Alt+Enter or Ctrl-S selects. Esc uses the typed path.'"
+ " --bind 'enter:reload(" reload ")+clear-query'"
+ " --bind 'alt-enter:accept'"
+ " --bind 'ctrl-s:accept'"
+ " >" (shell-quote output))])
+ (dynamic-wind
+ (lambda () #f)
+ (lambda ()
+ (let ([status (system command)])
+ (cond
+ [(not (zero? status)) #f]
+ [else
+ (let ([lines (read-output-lines output)])
+ (cond
+ [(not lines) base]
+ [(string=? (car lines) "esc") base]
+ [else
+ (let ([selection (cadr lines)])
+ (if (and selection (not (string=? (trim selection) "")))
+ selection
+ base))]))])))
+ (lambda ()
+ (when (file-exists? output) (delete-file output)))))))
+
+ (define (choose-directory)
+ (let* ([home (getenv "HOME")]
+ [default (or home "")]
+ [prompt (if (string=? default "")
+ "Directory path: "
+ (string-append "Directory path [" default "]: "))]
+ [entry (read-input prompt)])
+ (and entry
+ (let ([base (trim entry)])
+ (if (string=? base "")
+ (and (not (string=? default ""))
+ (fuzzy-directory default))
+ (fuzzy-directory base))))))
+
+ (define (yes? prompt)
+ (let ([answer (read-input (string-append prompt " [y/N] "))])
+ (and answer
+ (member (string-downcase (trim answer)) '("y" "yes"))
+ #t)))
+
+ (define (integer-text text)
+ (and (> (string-length text) 0)
+ (for-all char-numeric? (string->list text))
+ (string->number text)))
+
+ (define (items-not-in items excluded)
+ (filter (lambda (item) (not (member item excluded))) items))
+
+ (define (show-config-files configuration)
+ (clear-screen)
+ (display (intense "pisol configuration files"))
+ (newline)
+ (newline)
+ (display (cyan "Global init"))
+ (newline)
+ (let ([global (global-init-path)])
+ (cond
+ [(not global)
+ (display (yellow "not configured"))
+ (newline)]
+ [else
+ (display (muted global))
+ (newline)
+ (if (file-exists? global)
+ (display (read-text global))
+ (display (yellow "absent")))
+ (newline)]))
+ (newline)
+ (display (cyan "Local config"))
+ (newline)
+ (let ([local (configuration-config-path configuration)])
+ (display (muted local))
+ (newline)
+ (if (file-exists? local)
+ (display (read-text local))
+ (display (yellow "absent")))
+ (newline))
+ (read-input "Press enter to return. "))
+
+ (define (render configuration status)
+ (clear-screen)
+ (display (intense "pisol ยท isolation"))
+ (newline)
+ (display (muted "config: "))
+ (display (configuration-config-path configuration))
+ (when (eq? (configuration-source-style configuration) 'custom)
+ (display (yellow " custom shell")))
+ (newline)
+ (newline)
+ (display (cyan "Writable directories"))
+ (newline)
+ (let ([local-dirs (configuration-local-writable-directories configuration)])
+ (if (null? local-dirs)
+ (begin (display (muted " none")) (newline))
+ (let loop ([items local-dirs] [index 1])
+ (unless (null? items)
+ (format #t "~3d ~a~%" index (car items))
+ (loop (cdr items) (+ index 1))))))
+ (newline)
+ (display (cyan "Outbound TCP ports"))
+ (newline)
+ (let ([local-ports (configuration-local-outbound-ports configuration)])
+ (if (null? local-ports)
+ (begin (display (muted " none")) (newline))
+ (begin
+ (display " ")
+ (for-each (lambda (port) (format #t "~a " port)) local-ports)
+ (newline))))
+ (newline)
+ (display "a add dir r remove dir p add port d remove port")
+ (newline)
+ (display "s save sx save exit c show config ? help x exit")
+ (newline)
+ (when (configuration-dirty? configuration)
+ (display (yellow "unsaved changes"))
+ (newline))
+ (when (and status (not (string=? status "")))
+ (display (if (string-prefix? "saved" status) (green status) (yellow status)))
+ (newline)))
+
+ (define (show-help)
+ (clear-screen)
+ (display (intense "pisol help"))
+ (newline)
+ (newline)
+ (display "Enter a base path; fuzzy selection lists it and its immediate children.")
+ (newline)
+ (display "Cancel the picker to use the typed path directly.")
+ (newline)
+ (display "The baseline writable tree cannot be added again. TCP is denied unless listed.")
+ (newline)
+ (newline)
+ (display "Existing custom .isolate shell is trusted and evaluated. Saving it replaces")
+ (newline)
+ (display "the source with the canonical evaluated Landrun argument list.")
+ (newline)
+ (display "c shows the raw global and local configuration files.")
+ (newline)
+ (read-input "Press enter to return. "))
+
+ (define (run-tui configuration)
+ (let loop ([status ""])
+ (render configuration status)
+ (let ([input (read-input "> ")])
+ (if (not input)
+ #t
+ (let-values ([(command argument) (split-command input)])
+ (cond
+ [(string=? command "a")
+ (let ([path (choose-directory)])
+ (cond
+ [(not path) #t]
+ [(string=? (trim path) "") (loop "directory path is required")]
+ [(add-directory! configuration (trim path))
+ (loop (string-append "added " (trim path)))]
+ [else
+ (loop "directory is missing, duplicated, or already writable")]))]
+ [(string=? command "r")
+ (let ([directories (configuration-local-writable-directories configuration)])
+ (if (null? directories)
+ (loop "no writable directory to remove")
+ (let ([index (let ([given (or (and (> (string-length argument) 0) (integer-text argument))
+ (let ([text (read-input "Directory number: ")])
+ (and text (integer-text (trim text)))))])
+ (and given (integer? given) given))])
+ (if (and index (<= 1 index (length directories)))
+ (begin
+ (remove-directory! configuration
+ (list-ref directories (- index 1)))
+ (loop "directory removed"))
+ (loop "enter a number from the writable directory list")))))]
+ [(string=? command "p")
+ (let ([port (integer-text argument)])
+ (if (and port (add-port! configuration port))
+ (loop (format "added outbound TCP port ~a" port))
+ (loop "port must be unique and between 1 and 65535")))]
+ [(string=? command "d")
+ (let ([ports (configuration-local-outbound-ports configuration)])
+ (if (null? ports)
+ (loop "no outbound TCP port to remove")
+ (let ([port (let ([given (or (and (> (string-length argument) 0) (integer-text argument))
+ (let ([text (read-input "Port: ")])
+ (and text (integer-text (trim text)))))])
+ (and given (integer? given) given))])
+ (if (and port (remove-port! configuration port))
+ (loop (format "removed outbound TCP port ~a" port))
+ (loop "configured port not found")))))]
+ [(or (string=? command "s") (string=? command "sx") (string=? command "xs"))
+ (cond
+ [(not (configuration-dirty? configuration))
+ (if (string=? command "s") (loop "nothing to save") #t)]
+ [(and (eq? (configuration-source-style configuration) 'custom)
+ (not (yes? "Replace custom shell with canonical evaluated arguments?")))
+ (if (string=? command "s") (loop "save cancelled") #t)]
+ [else
+ (guard (condition
+ (else (loop (format "save failed: ~a" condition))))
+ (save-configuration! configuration)
+ (if (or (string=? command "sx") (string=? command "xs")) #t (loop "saved .isolate")))])]
+ [(string=? command "?") (show-help) (loop "")]
+ [(string=? command "c") (show-config-files configuration) (loop "")]
+ [(string=? command "x") #t]
+ [(string=? command "") (loop status)]
+ [else (loop "unknown command; enter ? for help")]))))))
+)
blob - /dev/null
blob + 6b778faeb157579442fdc80a46aa8618606bdea4 (mode 755)
--- /dev/null
+++ test/integration.sh
+#!/bin/sh
+set -eu
+
+project_root=$(CDPATH='' cd -- "$(dirname -- "$0")/.." && pwd)
+test_root=${TMPDIR:-/tmp}/pisol-integration.$$
+fake_bin=$test_root/bin
+project=$test_root/project
+home=$test_root/home
+capture=$test_root/landrun.args
+trap 'rm -rf "$test_root"' 0 HUP INT TERM
+mkdir -p "$fake_bin" "$project" "$home" "$home/extra dir"
+
+cat >"$fake_bin/landrun" <<'EOF'
+#!/bin/sh
+set -eu
+: "${PISOL_TEST_CAPTURE:?}"
+printf '%s\0' "$@" >"$PISOL_TEST_CAPTURE"
+while [ "$#" -gt 0 ] && [ "$1" != -- ]; do shift; done
+[ "$#" -gt 0 ] && shift
+exec "$@"
+EOF
+chmod +x "$fake_bin/landrun"
+
+run_pisol() {
+ (
+ cd "$project"
+ PATH=$fake_bin:$PATH \
+ HOME=$home \
+ PISOL_RUNTIME_DIR=$project_root/build/runtime \
+ PISOL_TEST_CAPTURE=$capture \
+ NO_COLOR=1 \
+ "$project_root/bin/pisol" "$@"
+ )
+}
+
+if run_pisol -- sh -c 'exit 7'; then
+ echo "pisol integration: command status was not propagated" >&2
+ exit 1
+else
+ status=$?
+ [ "$status" -eq 7 ] || exit 1
+fi
+
+tr '\0' '\n' <"$capture" >"$test_root/args.txt"
+grep -Fx -- '--best-effort' "$test_root/args.txt" >/dev/null
+grep -Fx -- '--unrestricted-scoped' "$test_root/args.txt" >/dev/null
+grep -Fx -- "$project" "$test_root/args.txt" >/dev/null
+grep -Fx -- '/dev/null' "$test_root/args.txt" >/dev/null
+if grep -Fx -- '--unrestricted-network' "$test_root/args.txt" >/dev/null; then
+ echo "pisol integration: unrestricted network unexpectedly enabled" >&2
+ exit 1
+fi
+
+printf '%s\n' 'args+=(' ' --connect-tcp 443' " --rwx '$home/extra dir'" ')' >"$project/.isolate"
+run_pisol -- sh -c 'exit 0'
+tr '\0' '\n' <"$capture" >"$test_root/args.txt"
+grep -Fx -- '--connect-tcp' "$test_root/args.txt" >/dev/null
+grep -Fx -- '443' "$test_root/args.txt" >/dev/null
+grep -Fx -- "$home/extra dir" "$test_root/args.txt" >/dev/null
+
+before=$(cksum "$capture")
+if ISOLATE_ENV=already run_pisol -- sh -c 'exit 9'; then
+ exit 1
+else
+ status=$?
+ [ "$status" -eq 9 ] || exit 1
+fi
+[ "$before" = "$(cksum "$capture")" ]
+
+run_pisol --help | grep -F 'pisol -- COMMAND' >/dev/null
+
+rm -f "$project/.isolate"
+printf 'a\n%s\np 443\ns\nx\n' "$home/extra dir" | run_pisol >"$test_root/tui.out"
+grep -F -- "--rwx '$home/extra dir'" "$project/.isolate" >/dev/null
+grep -F -- '--connect-tcp 443' "$project/.isolate" >/dev/null
+grep -F 'saved' "$test_root/tui.out" >/dev/null
+grep -F 'r remove dir' "$test_root/tui.out" >/dev/null
+grep -F 'd remove port' "$test_root/tui.out" >/dev/null
+if grep -E 'r NUMBER remove dir|d PORT remove' "$test_root/tui.out" >/dev/null; then
+ echo "pisol integration: removal commands still require inline arguments" >&2
+ exit 1
+fi
+if grep -E 'project:|p project|h home|browse/add' "$test_root/tui.out" >/dev/null; then
+ echo "pisol integration: location labels unexpectedly exposed" >&2
+ exit 1
+fi
+
+printf 'r\n1\nd\n443\ns\nx\n' | run_pisol >"$test_root/remove.out"
+if grep -F -- '--rwx' "$project/.isolate" >/dev/null ||
+ grep -F -- '--connect-tcp' "$project/.isolate" >/dev/null; then
+ echo "pisol integration: prompted removal did not remove configuration" >&2
+ exit 1
+fi
+
+saved=$(cksum "$project/.isolate")
+printf 'p 8443\n' | run_pisol >/dev/null
+[ "$saved" = "$(cksum "$project/.isolate")" ]
+
+printf '%s\n' 'if true; then args+=(--ro /custom); fi' >"$project/.isolate"
+custom=$(cksum "$project/.isolate")
+printf 'p 80\ns\nn\nx\ny\n' | run_pisol >/dev/null
+[ "$custom" = "$(cksum "$project/.isolate")" ]
+
+# Global init defaults are sourced before the local .isolate.
+global_init=$home/.config/pisol/init
+mkdir -p "$(dirname "$global_init")"
+printf '%s\n' 'args+=(' " --rwx '$home/extra dir'" ')' >"$global_init"
+rm -f "$project/.isolate"
+run_pisol -- sh -c 'exit 0'
+tr '\0' '\n' <"$capture" >"$test_root/args.txt"
+grep -Fx -- "$home/extra dir" "$test_root/args.txt" >/dev/null
+
+# Local .isolate builds on top of the global init.
+printf '%s\n' 'args+=( --connect-tcp 443 )' >"$project/.isolate"
+run_pisol -- sh -c 'exit 0'
+tr '\0' '\n' <"$capture" >"$test_root/args.txt"
+grep -Fx -- "$home/extra dir" "$test_root/args.txt" >/dev/null
+grep -Fx -- '443' "$test_root/args.txt" >/dev/null
+
+# show-config command prints both global and local configuration files.
+printf 'c\n\nx\n' | run_pisol >"$test_root/showconfig.out"
+grep -F 'c show config' "$test_root/showconfig.out" >/dev/null
+grep -F -- "$global_init" "$test_root/showconfig.out" >/dev/null
+grep -F -- "$project/.isolate" "$test_root/showconfig.out" >/dev/null
+grep -F -- "$home/extra dir" "$test_root/showconfig.out" >/dev/null
+grep -F -- '--connect-tcp 443' "$test_root/showconfig.out" >/dev/null
+
+printf 'pisol: shell and TUI integration checks passed\n'
blob - /dev/null
blob + 85973c99742e293da98399d3d3720c476ffd4a8a (mode 644)
--- /dev/null
+++ test/test.ss
+#!/usr/bin/env scheme --program
+(import (chezscheme)
+ (pisol core))
+
+(define checks 0)
+(define (check value message)
+ (set! checks (+ checks 1))
+ (unless value (error 'pisol-test message)))
+
+(define (check-equal actual expected message)
+ (check (equal? actual expected)
+ (format "~a: expected ~s, got ~s" message expected actual)))
+
+(define (mkdir-p path)
+ (unless (file-exists? path) (mkdir path)))
+
+(define (write-text path text)
+ (call-with-output-file path
+ (lambda (port) (display text port))
+ 'replace))
+
+(define (read-text path)
+ (call-with-input-file path get-string-all))
+
+(define (string-contains? haystack needle)
+ (let ([n (string-length needle)]
+ [m (string-length haystack)])
+ (let loop ([i 0])
+ (cond
+ [(> i (- m n)) #f]
+ [(string=? (substring haystack i (+ i n)) needle) #t]
+ [else (loop (+ i 1))]))))
+
+(define (temporary-root)
+ (let ([path (format "/tmp/pisol-test-~a" (time-nanosecond (current-time)))])
+ (mkdir-p path)
+ path))
+
+;; Isolate tests from the developer's real HOME config.
+(define test-home (temporary-root))
+(putenv "HOME" test-home)
+
+(define (port-tests)
+ (check (port-valid? 1) "minimum port is valid")
+ (check (port-valid? 65535) "maximum port is valid")
+ (check (not (port-valid? 0)) "zero port is invalid")
+ (check (not (port-valid? 65536)) "port above maximum is invalid")
+ (check (not (port-valid? "443")) "non-integer port is invalid")
+ (let ([configuration (make-empty-configuration "/project" "/project/.isolate")])
+ (check (add-port! configuration 443) "add a valid port")
+ (check-equal (configuration-outbound-ports configuration) '(443) "port is exposed")
+ (check (not (add-port! configuration 443)) "duplicate port rejected")
+ (check (configuration-dirty? configuration) "adding marks configuration dirty")
+ (check (remove-port! configuration 443) "remove existing port")
+ (check (not (remove-port! configuration 443)) "missing port removal rejected")
+ (check-equal (configuration-outbound-ports configuration) '() "port removed")))
+
+(define (directory-tests)
+ (let* ([root (temporary-root)]
+ [project (string-append root "/project")]
+ [outside (string-append root "/outside")]
+ [inside (string-append project "/inside")]
+ [missing (string-append root "/missing")])
+ (mkdir-p project)
+ (mkdir-p outside)
+ (mkdir-p inside)
+ (let ([configuration (make-empty-configuration project (string-append project "/.isolate"))])
+ (check (add-directory! configuration outside) "add an existing outside directory")
+ (check (not (add-directory! configuration outside)) "duplicate directory rejected")
+ (check (not (add-directory! configuration project)) "project directory is redundant")
+ (check (not (add-directory! configuration inside)) "project child is redundant")
+ (check (not (add-directory! configuration missing)) "missing directory rejected")
+ (check-equal (configuration-writable-directories configuration)
+ (list outside)
+ "canonical writable directories exposed")
+ (check (remove-directory! configuration outside) "remove existing directory")
+ (check (not (remove-directory! configuration outside)) "missing directory removal rejected"))))
+
+(define (quote-tests)
+ (check-equal (shell-quote "plain") "'plain'" "simple shell quote")
+ (check-equal (shell-quote "a b") "'a b'" "space shell quote")
+ (check-equal (shell-quote "it's") "'it'\\''s'" "apostrophe shell quote"))
+
+(define (configuration-tests)
+ (let* ([root (temporary-root)]
+ [project (string-append root "/project")]
+ [outside (string-append root "/outside dir's")]
+ [path (string-append project "/.isolate")])
+ (mkdir-p project)
+ (mkdir-p outside)
+ (write-text path
+ (string-append "args+=(\n"
+ " --ro '/opt/data'\n"
+ " --rwx '" root "/outside dir'\\''s'\n"
+ " --connect-tcp 443\n"
+ ")\n"))
+ (let ([configuration (load-configuration project path)])
+ (check-equal (configuration-source-style configuration) 'canonical "canonical source detected")
+ (check-equal (configuration-preserved-arguments configuration)
+ '("--ro" "/opt/data")
+ "opaque arguments retained")
+ (check-equal (configuration-writable-directories configuration)
+ (list outside)
+ "writable path loaded")
+ (check-equal (configuration-outbound-ports configuration) '(443) "port loaded")
+ (check (not (configuration-dirty? configuration)) "loaded configuration is clean")
+ (check (add-port! configuration 8443) "loaded configuration can be edited")
+ (save-configuration! configuration)
+ (check (not (configuration-dirty? configuration)) "save clears dirty state")
+ (check-equal (configuration-source-style configuration) 'canonical "save canonicalizes source")
+ (let ([again (load-configuration project path)])
+ (check-equal (configuration-preserved-arguments again)
+ '("--ro" "/opt/data")
+ "opaque arguments survive save")
+ (check-equal (configuration-outbound-ports again) '(443 8443) "ports survive save")
+ (check (string-prefix? "args+=(\n" (read-text path))
+ "canonical header written")))
+ (write-text path "if [ -n \"${HOME:-}\" ]; then args+=(--ro \"$HOME\"); fi\n")
+ (let ([custom (load-configuration project path)])
+ (check-equal (configuration-source-style custom) 'custom "custom shell detected")
+ (check-equal (configuration-preserved-arguments custom)
+ (list "--ro" (getenv "HOME"))
+ "custom shell evaluated as trusted config"))
+ (write-text path "args=()\n")
+ (let ([empty (load-configuration project path)])
+ (check-equal (configuration-preserved-arguments empty) '() "empty argument array loads")
+ (check-equal (configuration-writable-directories empty) '() "empty config has no directories")
+ (check-equal (configuration-outbound-ports empty) '() "empty config has no ports"))
+ (write-text path "args+=(--connect-tcp 0)\n")
+ (check (guard (condition (else #t)) (load-configuration project path) #f)
+ "invalid recognized port rejects config")
+ (write-text path "args+=(--rwx)\n")
+ (check (guard (condition (else #t)) (load-configuration project path) #f)
+ "missing recognized operand rejects config")))
+
+(define (baseline-tests)
+ (let* ([root (temporary-root)]
+ [home (string-append root "/home")]
+ [global (string-append home "/.config/pisol/init")]
+ [project (string-append root "/project")]
+ [outside (string-append root "/outside")]
+ [path (string-append project "/.isolate")])
+ (mkdir-p home)
+ (putenv "HOME" home)
+ (mkdir-p (string-append home "/.config"))
+ (mkdir-p (string-append home "/.config/pisol"))
+ (mkdir-p project)
+ (mkdir-p outside)
+ (write-text global
+ (string-append "args+=(\n"
+ " --ro '/opt/global'\n"
+ " --rwx '" root "/outside'\n"
+ " --connect-tcp 80\n"
+ ")\n"))
+ (write-text path
+ (string-append "args+=(\n"
+ " --connect-tcp 443\n"
+ ")\n"))
+ (let ([configuration (load-configuration project path)])
+ (check-equal (configuration-source-style configuration) 'canonical
+ "canonical local source detected with baseline")
+ (check-equal (configuration-preserved-arguments configuration)
+ '("--ro" "/opt/global")
+ "global preserved arguments merged")
+ (check-equal (configuration-writable-directories configuration)
+ (list outside)
+ "global writable directory merged")
+ (check-equal (configuration-outbound-ports configuration)
+ '(80 443)
+ "global and local ports merged")
+ (check-equal (configuration-local-outbound-ports configuration)
+ '(443)
+ "local port stored separately")
+ (check (not (configuration-dirty? configuration)) "loaded baseline config is clean")
+ (check (not (add-directory! configuration outside)) "duplicate global directory rejected")
+ (check (not (remove-directory! configuration outside)) "global directory cannot be removed here")
+ (check (add-port! configuration 8080) "local port added on top of baseline")
+ (save-configuration! configuration)
+ (let ([saved (read-text path)])
+ (check (not (string-contains? saved "/opt/global"))
+ "save does not duplicate global arguments")
+ (check (string-contains? saved "--connect-tcp 443")
+ "local port survives save")
+ (check (string-contains? saved "--connect-tcp 8080")
+ "added local port saved")))
+ (let ([empty-local (load-configuration project (string-append project "/missing.isolate"))])
+ (check-equal (configuration-source-style empty-local) 'absent
+ "missing local config with baseline is absent")
+ (check-equal (configuration-writable-directories empty-local)
+ (list outside)
+ "baseline grants available without local file")
+ (check (not (configuration-dirty? empty-local)) "baseline-only config is clean"))
+ (putenv "HOME" test-home)))
+
+(port-tests)
+(directory-tests)
+(quote-tests)
+(configuration-tests)
+(baseline-tests)
+(format #t "pisol: ~a Chez checks passed~%" checks)
blob - /dev/null
blob + 67f19c99c35860f7184778309e55ad208e993212 (mode 644)
--- /dev/null
+++ tools/build.ss
+(import (chezscheme))
+(compile-program "bin/pisol.ss" "build/runtime/pisol.so")
+
blob - /dev/null
blob + e97283066235c2f176a19ce9bd6d6e278182618d (mode 755)
--- /dev/null
+++ tools/fmt.sh
+#!/bin/sh
+set -eu
+
+fmt_file() {
+ file=$1
+ emacs --batch \
+ --eval "(require 'scheme)" \
+ --eval "(setq-default indent-tabs-mode nil)" \
+ --eval "(setq lisp-body-indent 2)" \
+ --eval "(put 'library 'scheme-indent-function (lambda (&rest _) 1))" \
+ --eval "(put 'cond 'scheme-indent-function 0)" \
+ --eval "(put 'dynamic-wind 'scheme-indent-function 0)" \
+ --eval "(put 'lambda 'scheme-indent-function 'defun)" \
+ --eval "(find-file \"$file\")" \
+ --eval "(indent-region (point-min) (point-max) nil)" \
+ --eval "(save-buffer)" >/dev/null 2>&1
+ if head -n1 "$file" | grep -q '^(library'; then
+ sed -i -E '${/^[[:space:]]*\)+[[:space:]]*$/s/^[[:space:]]*//}' "$file"
+ fi
+}
+
+for file in "$@"; do
+ fmt_file "$file"
+done
