From eeb12340867c2877ac00d82419e748d8212df15c Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Thu, 7 May 2026 17:52:32 -0400 Subject: [PATCH] passepartout: v0.4.3 Shell Sandboxing & Safety Classification - bwrap sandbox: detect bwrap binary, wrap shell commands through Linux namespace isolation with --unshare-net --unshare-ipc when available, fall back to timeout bash -c otherwise - Severity classification: extend shell-blocked patterns with :catastrophic/:dangerous/:moderate/:harmless severity tiers, dispatcher-severity-max for tier comparison - dispatcher-check-shell-safety: returns (:matched :severity ) - Version: 0.4.2 -> 0.4.3 across handshake, ASDF, README badge --- README.org | 4 +- docs/ROADMAP.org | 10 ++- lisp/core-communication.lisp | 2 +- lisp/security-dispatcher.lisp | 70 ++++++++++++++++---- lisp/system-actuator-shell.lisp | 95 +++++++++++++++++++++++---- org/core-communication.org | 2 +- org/core-manifest.org | 2 +- org/security-dispatcher.org | 80 ++++++++++++++++++----- org/system-actuator-shell.org | 110 ++++++++++++++++++++++++++++---- passepartout.asd | 2 +- 10 files changed, 313 insertions(+), 64 deletions(-) diff --git a/README.org b/README.org index 8526cbc..a037990 100644 --- a/README.org +++ b/README.org @@ -3,7 +3,7 @@ #+FILETAGS: :passepartout:ai:assistant: #+HTML:
-#+HTML: +#+HTML: #+HTML: #+HTML: #+HTML: @@ -113,6 +113,8 @@ Features marked =Stable= ship in the current release. Features marked =Planned= | Discord + Slack gateways | Stable | v0.4.0 | 4 platforms: Telegram, Signal, Discord, Slack | | Native embedding inference | Beta | v0.4.x | CFFI llama.cpp binding, nomic-embed-text (768-dim) | | Structured output (function-calling) | Stable | v0.4.2 | LLM tool use via native function-calling API, JSON→plist boundary | +| Shell sandbox (bwrap) | Stable | v0.4.3 | Bubblewrap namespace isolation, network/IPC lockdown | +| Shell severity classification | Stable | v0.4.3 | catastrophic→dangerous→moderate→harmless tier system | | Token economics + cost tracking | Planned | v0.5.0 | Per-session cost counter, prompt caching, budget enforcement | | Priority-queue signal processing | Planned | v0.6.0 | Preempts background for user interactions | | MVCC memory concurrency | Planned | v0.6.1 | Concurrent reads/writes on Merkle tree | diff --git a/docs/ROADMAP.org b/docs/ROADMAP.org index b99e3e4..a373a2d 100644 --- a/docs/ROADMAP.org +++ b/docs/ROADMAP.org @@ -694,11 +694,14 @@ Rationale: Once the provider layer returns structured ~tool-calls~, the ~think() The current shell safety is regex-based pattern matching — a fast pre-filter that catches obvious attacks but cannot contain sophisticated or encoded payloads. This version adds actual sandbox isolation (bubblewrap Linux namespaces) as the enforcement layer, and introduces severity classification so the rule learning system in v0.5.0 can apply different thresholds to catastrophic vs harmless operations. -*** TODO Add ~bwrap~ sandbox to shell actuator +*** DONE Add ~bwrap~ sandbox to shell actuator :PROPERTIES: :ID: id-v043-bwrap-sandbox :CREATED: [2026-05-07 Thu] :END: +:LOGBOOK: +- State "DONE" from "TODO" [2026-05-07 Thu 17:37] +:END: Rationale: Regex-based shell safety catches obvious patterns (~rm -rf /~, ~dd if=~, ~mkfs.~) but is fundamentally bypassable with encoding (~base64 -d | bash~), indirection (~find / -exec rm {} \;~), or interpreter-based execution (~python3 -c "import os; os.system(...)"~). Bubblewrap (~bwrap~) is a 200KB unprivileged sandbox binary available on all modern Linux distributions. It creates transient Linux namespaces without root, without Docker, without daemon processes. Combined with the regex pre-filter, it provides defense-in-depth: the regex catches obvious attacks fast (no sandbox spawn), the sandbox contains sophisticated ones. @@ -710,11 +713,14 @@ Rationale: Regex-based shell safety catches obvious patterns (~rm -rf /~, ~dd if - The regex checks remain as a fast pre-filter — they run before spawning the sandbox. - FiveAM test: command that reads ~/etc/shadow~ inside sandbox fails with permission error; same command in unsandboxed fallback is at least caught by path protection. -*** TODO Shell safety severity classification system +*** DONE Shell safety severity classification system :PROPERTIES: :ID: id-v043-severity-classification :CREATED: [2026-05-07 Thu] :END: +:LOGBOOK: +- State "DONE" from "TODO" [2026-05-07 Thu 17:37] +:END: Rationale: The current shell safety check treats all dangerous patterns equally — ~rm -rf /~ gets the same treatment as a backtick injection in ~echo~. But not all shell operations carry the same risk. A severity classification system enables the rule learning engine (v0.5.0) to apply different thresholds: catastrophic operations are always HITL regardless of approval count, moderate operations graduate to allowed after N approvals, harmless operations are allowed by default. diff --git a/lisp/core-communication.lisp b/lisp/core-communication.lisp index fc39b5d..a27f102 100644 --- a/lisp/core-communication.lisp +++ b/lisp/core-communication.lisp @@ -62,7 +62,7 @@ (let ((stream (usocket:socket-stream socket))) (handler-case (progn - (format stream "~a" (frame-message (make-hello-message "0.4.2"))) + (format stream "~a" (frame-message (make-hello-message "0.4.3"))) (finish-output stream) (loop (let ((msg (read-framed-message stream))) diff --git a/lisp/security-dispatcher.lisp b/lisp/security-dispatcher.lisp index 464a4f0..cd20568 100644 --- a/lisp/security-dispatcher.lisp +++ b/lisp/security-dispatcher.lisp @@ -46,15 +46,16 @@ dispatcher-check-core-path for self-build safety.") "Maximum characters of shell output to capture.") (defvar *dispatcher-shell-blocked* - '((:destructive-rm "\\brm\\s+-rf\\s+/") - (:destructive-dd "\\bdd\\s+if=") - (:destructive-mkfs "\\bmkfs\\.") - (:destructive-format "\\bmformat\\b") - (:disk-wipe "\\bshred\\s+/dev/") - (:disk-wipe-b "\\bwipefs\\s+/dev/") - (:injection-backtick "`[^`]+`") - (:injection-subshell "\\$\\([^)]+\\)")) - "Destructive and injection patterns blocked in shell commands.") + '((:destructive-rm "\\brm\\s+-rf\\s+/" :severity :catastrophic) + (:destructive-dd "\\bdd\\s+if=" :severity :catastrophic) + (:destructive-mkfs "\\bmkfs\\." :severity :catastrophic) + (:disk-wipe "\\bshred\\s+/dev/" :severity :catastrophic) + (:disk-wipe-b "\\bwipefs\\s+/dev/" :severity :catastrophic) + (:injection-backtick "`[^`]+`" :severity :dangerous) + (:injection-subshell "\\$\\([^)]+\\)" :severity :dangerous)) + "Destructive and injection patterns blocked in shell commands. +Each entry is (name regex :severity tier) where tier is one of: +:catastrophic, :dangerous, :moderate, :harmless.") (defun wildcard-match (pattern path) "Matches PATH against PATTERN where * matches any characters." @@ -170,15 +171,31 @@ Returns the validation result plist or nil if not applicable." (defun dispatcher-check-shell-safety (cmd) "Checks a shell command for destructive patterns and injection vectors. -Returns a list of matched pattern names or nil if safe." +Returns (:matched :severity ) when dangerous patterns found, +or nil if safe. Severity is the highest tier among matched patterns: +:catastrophic > :dangerous > :moderate > :harmless." (when (and cmd (stringp cmd) (> (length cmd) 0)) - (let ((matches nil)) + (let ((matches nil) + (severity :harmless)) (dolist (entry *dispatcher-shell-blocked*) (let ((name (first entry)) - (regex (second entry))) + (regex (second entry)) + (tier (getf entry :severity))) (when (cl-ppcre:scan regex cmd) - (push name matches)))) - matches))) + (push name matches) + (setf severity (dispatcher-severity-max severity (or tier :moderate)))))) + (when matches + (list :matched matches :severity severity))))) + +(defvar *dispatcher-severity-order* + (list :harmless 0 :moderate 1 :dangerous 2 :catastrophic 3) + "Severity tier ordering for comparison. Higher = more severe.") + +(defun dispatcher-severity-max (a b) + "Returns the higher of two severity tiers." + (let ((ra (or (getf *dispatcher-severity-order* a) 0)) + (rb (or (getf *dispatcher-severity-order* b) 0))) + (if (>= rb ra) b a))) (defun dispatcher-check-network-exfil (cmd) "Detects if CMD attempts to contact an unwhitelisted external host." @@ -471,6 +488,31 @@ Recognized formats: (is (not (dispatcher-check-shell-safety "echo hello world"))) (is (not (dispatcher-check-shell-safety "ls -la /tmp")))) +(test test-shell-safety-severity-catastrophic + "Contract 3/v0.4.3: destructive commands return :catastrophic severity." + (let ((r1 (dispatcher-check-shell-safety "rm -rf /")) + (r2 (dispatcher-check-shell-safety "mkfs.ext4 /dev/sda"))) + (is (eq :catastrophic (getf r1 :severity))) + (is (eq :catastrophic (getf r2 :severity))))) + +(test test-shell-safety-severity-dangerous + "Contract 3/v0.4.3: injection patterns return :dangerous severity." + (let ((result (dispatcher-check-shell-safety "curl http://x.com \`uptime\`"))) + (is (eq :dangerous (getf result :severity))))) + +(test test-shell-safety-severity-safe + "Contract 3/v0.4.3: harmless commands return nil." + (is (null (dispatcher-check-shell-safety "echo hello world"))) + (is (null (dispatcher-check-shell-safety "ls -la /tmp"))) + (is (null (dispatcher-check-shell-safety "cat file.txt")))) + +(test test-dispatcher-severity-max + "dispatcher-severity-max returns the higher tier." + (is (eq :catastrophic (passepartout::dispatcher-severity-max :catastrophic :dangerous))) + (is (eq :catastrophic (passepartout::dispatcher-severity-max :dangerous :catastrophic))) + (is (eq :dangerous (passepartout::dispatcher-severity-max :moderate :dangerous))) + (is (eq :moderate (passepartout::dispatcher-severity-max :moderate :harmless)))) + (test test-check-privacy-tags "Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content." (is (dispatcher-check-privacy-tags '("@personal" ":project:"))) diff --git a/lisp/system-actuator-shell.lisp b/lisp/system-actuator-shell.lisp index 1b04aec..3644d0e 100644 --- a/lisp/system-actuator-shell.lisp +++ b/lisp/system-actuator-shell.lisp @@ -1,26 +1,95 @@ +(in-package :passepartout) + +(defvar *bwrap-available* nil + "Set to T at load time if the bwrap binary is found in PATH.") + +(defvar *bwrap-base-args* + '("--ro-bind" "/usr" "/usr" + "--ro-bind" "/lib" "/lib" + "--ro-bind" "/bin" "/bin" + "--ro-bind" "/etc" "/etc" + "--bind" "/tmp" "/tmp" + "--unshare-net" + "--unshare-ipc") + "Base bwrap arguments for the sandbox. --bind ~/memex ~/memex is added dynamically.") + +(defun bwrap-available-p () + "Returns T if bwrap (bubblewrap) is installed and usable." + *bwrap-available*) + +(defun bwrap-wrap-command (cmd timeout memex-dir) + "Wrap CMD in a bwrap sandbox with network and IPC isolation. +Returns a list suitable for uiop:run-program." + `("bwrap" + ,@*bwrap-base-args* + "--bind" ,memex-dir ,memex-dir + "timeout" ,(format nil "~a" timeout) + "bash" "-c" ,cmd)) + +;; Initialize at load time +(setf *bwrap-available* + (= 0 (nth-value 2 (uiop:run-program '("which" "bwrap") :output nil :error-output nil :ignore-error-status t)))) + (defun actuator-shell-execute (action context) - "Executes a shell command via the OS timeout binary with output limit." + "Executes a shell command via the OS timeout binary with output limit. +When bwrap is available, wraps the command in a Linux namespace sandbox." (declare (ignore context)) (let* ((payload (getf action :payload)) (cmd (getf payload :cmd)) (timeout-sym (find-symbol "*DISPATCHER-SHELL-TIMEOUT*" :passepartout)) (timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30))) (max-sym (find-symbol "*DISPATCHER-SHELL-MAX-OUTPUT*" :passepartout)) - (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))) - (log-message "ACT [Shell]: ~a (timeout: ~as)" cmd timeout) - (multiple-value-bind (out err code) - (uiop:run-program (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd) - :output :string :error-output :string - :ignore-error-status t) - (cond - ((= code 124) (format nil "ERROR: Command timed out after ~a seconds" timeout)) - ((> (length out) max-output) - (format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output)) - ((= code 0) out) - (t (format nil "ERROR [~a]: ~a" code err)))))) + (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000))) + (memex-dir (or (uiop:getenv "MEMEX_DIR") (namestring (merge-pathnames "memex/" (user-homedir-pathname)))))) + (log-message "ACT [Shell]: ~a (timeout: ~as)~@[ bwrap: enabled~]" cmd timeout (and *bwrap-available* " (bwrap)")) + (let ((cmdline (if *bwrap-available* + (bwrap-wrap-command cmd timeout memex-dir) + (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd)))) + (multiple-value-bind (out err code) + (uiop:run-program cmdline + :output :string :error-output :string + :ignore-error-status t) + (cond + ((= code 124) (format nil "ERROR: Command timed out after ~a seconds" timeout)) + ((> (length out) max-output) + (format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output)) + ((= code 0) out) + (t (format nil "ERROR [~a]: ~a" code err))))))) (register-actuator :shell #'actuator-shell-execute) (defskill :passepartout-system-actuator-shell :priority 50 :trigger (lambda (ctx) (declare (ignore ctx)) nil)) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (ql:quickload :fiveam :silent t)) + +(defpackage :passepartout-shell-actuator-tests + (:use :cl :fiveam :passepartout) + (:export #:shell-actuator-suite)) + +(in-package :passepartout-shell-actuator-tests) + +(def-suite shell-actuator-suite :description "Verification of the Shell Actuator") +(in-suite shell-actuator-suite) + +(test test-bwrap-wrap-command + "Contract 2: bwrap-wrap-command returns properly formatted command list." + (let ((cmdline (passepartout::bwrap-wrap-command "echo hello" 30 "/home/user/memex"))) + (is (member "bwrap" cmdline :test #'string=)) + (is (member "--unshare-net" cmdline :test #'string=)) + (is (member "--unshare-ipc" cmdline :test #'string=)) + (is (member "echo hello" cmdline :test #'string=)))) + +(test test-bwrap-available-p-returns-boolean + "Contract 1: bwrap-available-p returns T or NIL." + (let ((avail (passepartout::bwrap-available-p))) + (is (typep avail 'boolean)))) + +(test test-actuator-shell-execute-echo + "Contract 3: actuator-shell-execute runs echo and returns output." + (let* ((action '(:type :REQUEST :target :shell :payload (:cmd "echo hello"))) + (result (passepartout::actuator-shell-execute action nil))) + (is (stringp result)) + (is (search "hello" result :test #'char-equal)))) diff --git a/org/core-communication.org b/org/core-communication.org index 53dc902..cf52653 100644 --- a/org/core-communication.org +++ b/org/core-communication.org @@ -151,7 +151,7 @@ The daemon sends a handshake message on connection, then enters a read loop, inj (let ((stream (usocket:socket-stream socket))) (handler-case (progn - (format stream "~a" (frame-message (make-hello-message "0.4.2"))) + (format stream "~a" (frame-message (make-hello-message "0.4.3"))) (finish-output stream) (loop (let ((msg (read-framed-message stream))) diff --git a/org/core-manifest.org b/org/core-manifest.org index 0aa64d9..1ee7c77 100644 --- a/org/core-manifest.org +++ b/org/core-manifest.org @@ -22,7 +22,7 @@ Components are loaded in sequence (~:serial t~): package first (defines the publ (defsystem :passepartout :name "Passepartout" :author "Amr Gharbeia" - :version "0.4.2" + :version "0.4.3" :license "AGPLv3" :description "The Probabilistic-Deterministic Lisp Machine" :depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid) diff --git a/org/security-dispatcher.org b/org/security-dispatcher.org index 44e6356..194f166 100644 --- a/org/security-dispatcher.org +++ b/org/security-dispatcher.org @@ -32,9 +32,9 @@ The Dispatcher also handles the **Flight Plan** system: when a high-risk action 2. (dispatcher-check-secret-path filepath): returns the matching protected pattern if ~filepath~ matches any entry in ~*dispatcher-protected-paths*~, nil otherwise. -3. (dispatcher-check-shell-safety cmd): returns a list of matched - dangerous-pattern names if ~cmd~ triggers any entry in - ~*dispatcher-shell-blocked*~, nil if safe. +3. (dispatcher-check-shell-safety cmd): returns ~(:matched :severity )~ + if ~cmd~ triggers any entry in ~*dispatcher-shell-blocked*~, nil if safe. + Severity tiers: ~:catastrophic~ > ~:dangerous~ > ~:moderate~ > ~:harmless~. 4. (dispatcher-check-privacy-tags tags-list): returns T if any tag in ~tags-list~ matches a privacy filter tag, nil otherwise. 5. (dispatcher-check-network-exfil cmd): returns T (unsafe) if ~cmd~ @@ -141,15 +141,16 @@ Destructive and injection patterns that are blocked in shell commands. Covers ~r ;; REPL-VERIFIED: 2026-05-03T13:00:00 #+begin_src lisp (defvar *dispatcher-shell-blocked* - '((:destructive-rm "\\brm\\s+-rf\\s+/") - (:destructive-dd "\\bdd\\s+if=") - (:destructive-mkfs "\\bmkfs\\.") - (:destructive-format "\\bmformat\\b") - (:disk-wipe "\\bshred\\s+/dev/") - (:disk-wipe-b "\\bwipefs\\s+/dev/") - (:injection-backtick "`[^`]+`") - (:injection-subshell "\\$\\([^)]+\\)")) - "Destructive and injection patterns blocked in shell commands.") + '((:destructive-rm "\\brm\\s+-rf\\s+/" :severity :catastrophic) + (:destructive-dd "\\bdd\\s+if=" :severity :catastrophic) + (:destructive-mkfs "\\bmkfs\\." :severity :catastrophic) + (:disk-wipe "\\bshred\\s+/dev/" :severity :catastrophic) + (:disk-wipe-b "\\bwipefs\\s+/dev/" :severity :catastrophic) + (:injection-backtick "`[^`]+`" :severity :dangerous) + (:injection-subshell "\\$\\([^)]+\\)" :severity :dangerous)) + "Destructive and injection patterns blocked in shell commands. +Each entry is (name regex :severity tier) where tier is one of: +:catastrophic, :dangerous, :moderate, :harmless.") #+end_src ** Secret Path Check (dispatcher-check-secret-path) @@ -329,15 +330,35 @@ Returns the validation result plist or nil if not applicable." #+begin_src lisp (defun dispatcher-check-shell-safety (cmd) "Checks a shell command for destructive patterns and injection vectors. -Returns a list of matched pattern names or nil if safe." +Returns (:matched :severity ) when dangerous patterns found, +or nil if safe. Severity is the highest tier among matched patterns: +:catastrophic > :dangerous > :moderate > :harmless." (when (and cmd (stringp cmd) (> (length cmd) 0)) - (let ((matches nil)) + (let ((matches nil) + (severity :harmless)) (dolist (entry *dispatcher-shell-blocked*) (let ((name (first entry)) - (regex (second entry))) + (regex (second entry)) + (tier (getf entry :severity))) (when (cl-ppcre:scan regex cmd) - (push name matches)))) - matches))) + (push name matches) + (setf severity (dispatcher-severity-max severity (or tier :moderate)))))) + (when matches + (list :matched matches :severity severity))))) +#+end_src + +** Severity Comparison (dispatcher-severity-max) +;; REPL-VERIFIED: 2026-05-07T17:00:00 +#+begin_src lisp +(defvar *dispatcher-severity-order* + (list :harmless 0 :moderate 1 :dangerous 2 :catastrophic 3) + "Severity tier ordering for comparison. Higher = more severe.") + +(defun dispatcher-severity-max (a b) + "Returns the higher of two severity tiers." + (let ((ra (or (getf *dispatcher-severity-order* a) 0)) + (rb (or (getf *dispatcher-severity-order* b) 0))) + (if (>= rb ra) b a))) #+end_src ** Network Check (dispatcher-check-network-exfil) @@ -707,6 +728,31 @@ Recognized formats: (is (not (dispatcher-check-shell-safety "echo hello world"))) (is (not (dispatcher-check-shell-safety "ls -la /tmp")))) +(test test-shell-safety-severity-catastrophic + "Contract 3/v0.4.3: destructive commands return :catastrophic severity." + (let ((r1 (dispatcher-check-shell-safety "rm -rf /")) + (r2 (dispatcher-check-shell-safety "mkfs.ext4 /dev/sda"))) + (is (eq :catastrophic (getf r1 :severity))) + (is (eq :catastrophic (getf r2 :severity))))) + +(test test-shell-safety-severity-dangerous + "Contract 3/v0.4.3: injection patterns return :dangerous severity." + (let ((result (dispatcher-check-shell-safety "curl http://x.com \`uptime\`"))) + (is (eq :dangerous (getf result :severity))))) + +(test test-shell-safety-severity-safe + "Contract 3/v0.4.3: harmless commands return nil." + (is (null (dispatcher-check-shell-safety "echo hello world"))) + (is (null (dispatcher-check-shell-safety "ls -la /tmp"))) + (is (null (dispatcher-check-shell-safety "cat file.txt")))) + +(test test-dispatcher-severity-max + "dispatcher-severity-max returns the higher tier." + (is (eq :catastrophic (passepartout::dispatcher-severity-max :catastrophic :dangerous))) + (is (eq :catastrophic (passepartout::dispatcher-severity-max :dangerous :catastrophic))) + (is (eq :dangerous (passepartout::dispatcher-severity-max :moderate :dangerous))) + (is (eq :moderate (passepartout::dispatcher-severity-max :moderate :harmless)))) + (test test-check-privacy-tags "Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content." (is (dispatcher-check-privacy-tags '("@personal" ":project:"))) diff --git a/org/system-actuator-shell.org b/org/system-actuator-shell.org index d1aa22a..8c2bf09 100644 --- a/org/system-actuator-shell.org +++ b/org/system-actuator-shell.org @@ -13,32 +13,81 @@ Because shell execution is the highest-risk operation in the system, the Shell A 3. The Dispatcher's network exfil gate blocks connections to unwhitelisted hosts 4. The actuator enforces a timeout (default 30s) so hanging commands don't freeze the agent 5. The actuator caps output (default 100KB) so infinite output doesn't exhaust memory +6. (v0.4.3) When ~bwrap~ (Bubblewrap) is available, commands execute inside a Linux namespace sandbox with network and IPC isolation + +** Contract + +1. (bwrap-available-p): returns T if ~bwrap~ is installed and usable, NIL otherwise. + Cached at load time via ~which bwrap~. +2. (bwrap-wrap-command cmd timeout memex-dir): returns a command list suitable for + ~uiop:run-program~ — wraps ~cmd~ in a ~bwrap~ sandbox with ~--unshare-net~, + ~--unshare-ipc~, ~--ro-bind~ for system dirs, and ~--bind~ for the memex and /tmp. +3. (actuator-shell-execute action context): when ~bwrap~ is available, wraps the + command through the sandbox. When ~bwrap~ is unavailable, falls back to the + existing ~timeout bash -c~ behavior. * Implementation ** Shell Execution (actuator-shell-execute) ;; REPL-VERIFIED: 2026-05-03T13:00:00 #+begin_src lisp +(in-package :passepartout) + +(defvar *bwrap-available* nil + "Set to T at load time if the bwrap binary is found in PATH.") + +(defvar *bwrap-base-args* + '("--ro-bind" "/usr" "/usr" + "--ro-bind" "/lib" "/lib" + "--ro-bind" "/bin" "/bin" + "--ro-bind" "/etc" "/etc" + "--bind" "/tmp" "/tmp" + "--unshare-net" + "--unshare-ipc") + "Base bwrap arguments for the sandbox. --bind ~/memex ~/memex is added dynamically.") + +(defun bwrap-available-p () + "Returns T if bwrap (bubblewrap) is installed and usable." + *bwrap-available*) + +(defun bwrap-wrap-command (cmd timeout memex-dir) + "Wrap CMD in a bwrap sandbox with network and IPC isolation. +Returns a list suitable for uiop:run-program." + `("bwrap" + ,@*bwrap-base-args* + "--bind" ,memex-dir ,memex-dir + "timeout" ,(format nil "~a" timeout) + "bash" "-c" ,cmd)) + +;; Initialize at load time +(setf *bwrap-available* + (= 0 (nth-value 2 (uiop:run-program '("which" "bwrap") :output nil :error-output nil :ignore-error-status t)))) + (defun actuator-shell-execute (action context) - "Executes a shell command via the OS timeout binary with output limit." + "Executes a shell command via the OS timeout binary with output limit. +When bwrap is available, wraps the command in a Linux namespace sandbox." (declare (ignore context)) (let* ((payload (getf action :payload)) (cmd (getf payload :cmd)) (timeout-sym (find-symbol "*DISPATCHER-SHELL-TIMEOUT*" :passepartout)) (timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30))) (max-sym (find-symbol "*DISPATCHER-SHELL-MAX-OUTPUT*" :passepartout)) - (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))) - (log-message "ACT [Shell]: ~a (timeout: ~as)" cmd timeout) - (multiple-value-bind (out err code) - (uiop:run-program (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd) - :output :string :error-output :string - :ignore-error-status t) - (cond - ((= code 124) (format nil "ERROR: Command timed out after ~a seconds" timeout)) - ((> (length out) max-output) - (format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output)) - ((= code 0) out) - (t (format nil "ERROR [~a]: ~a" code err)))))) + (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000))) + (memex-dir (or (uiop:getenv "MEMEX_DIR") (namestring (merge-pathnames "memex/" (user-homedir-pathname)))))) + (log-message "ACT [Shell]: ~a (timeout: ~as)~@[ bwrap: enabled~]" cmd timeout (and *bwrap-available* " (bwrap)")) + (let ((cmdline (if *bwrap-available* + (bwrap-wrap-command cmd timeout memex-dir) + (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd)))) + (multiple-value-bind (out err code) + (uiop:run-program cmdline + :output :string :error-output :string + :ignore-error-status t) + (cond + ((= code 124) (format nil "ERROR: Command timed out after ~a seconds" timeout)) + ((> (length out) max-output) + (format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output)) + ((= code 0) out) + (t (format nil "ERROR [~a]: ~a" code err))))))) #+end_src ** Skill Registration @@ -49,3 +98,38 @@ Because shell execution is the highest-risk operation in the system, the Shell A :priority 50 :trigger (lambda (ctx) (declare (ignore ctx)) nil)) #+end_src + +* Test Suite +#+begin_src lisp +(eval-when (:compile-toplevel :load-toplevel :execute) + (ql:quickload :fiveam :silent t)) + +(defpackage :passepartout-shell-actuator-tests + (:use :cl :fiveam :passepartout) + (:export #:shell-actuator-suite)) + +(in-package :passepartout-shell-actuator-tests) + +(def-suite shell-actuator-suite :description "Verification of the Shell Actuator") +(in-suite shell-actuator-suite) + +(test test-bwrap-wrap-command + "Contract 2: bwrap-wrap-command returns properly formatted command list." + (let ((cmdline (passepartout::bwrap-wrap-command "echo hello" 30 "/home/user/memex"))) + (is (member "bwrap" cmdline :test #'string=)) + (is (member "--unshare-net" cmdline :test #'string=)) + (is (member "--unshare-ipc" cmdline :test #'string=)) + (is (member "echo hello" cmdline :test #'string=)))) + +(test test-bwrap-available-p-returns-boolean + "Contract 1: bwrap-available-p returns T or NIL." + (let ((avail (passepartout::bwrap-available-p))) + (is (typep avail 'boolean)))) + +(test test-actuator-shell-execute-echo + "Contract 3: actuator-shell-execute runs echo and returns output." + (let* ((action '(:type :REQUEST :target :shell :payload (:cmd "echo hello"))) + (result (passepartout::actuator-shell-execute action nil))) + (is (stringp result)) + (is (search "hello" result :test #'char-equal)))) +#+end_src diff --git a/passepartout.asd b/passepartout.asd index 8452555..bc3ddb4 100644 --- a/passepartout.asd +++ b/passepartout.asd @@ -1,7 +1,7 @@ (defsystem :passepartout :name "Passepartout" :author "Amr Gharbeia" - :version "0.4.2" + :version "0.4.3" :license "AGPLv3" :description "The Probabilistic-Deterministic Lisp Machine" :depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)