passepartout: v0.4.3 Shell Sandboxing & Safety Classification
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s

- 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 <names> :severity <tier>)
- Version: 0.4.2 -> 0.4.3 across handshake, ASDF, README badge
This commit is contained in:
2026-05-07 17:52:32 -04:00
parent 791a0f9c3b
commit eeb1234086
10 changed files with 313 additions and 64 deletions

View File

@@ -3,7 +3,7 @@
#+FILETAGS: :passepartout:ai:assistant: #+FILETAGS: :passepartout:ai:assistant:
#+HTML: <div style="display: flex; gap: 8px; flex-wrap: wrap; margin-bottom: 1em;"> #+HTML: <div style="display: flex; gap: 8px; flex-wrap: wrap; margin-bottom: 1em;">
#+HTML: <img src="https://img.shields.io/badge/version-v0.4.2-blue?style=flat-square"> #+HTML: <img src="https://img.shields.io/badge/version-v0.4.3-blue?style=flat-square">
#+HTML: <img src="https://img.shields.io/badge/license-AGPLv3-green?style=flat-square"> #+HTML: <img src="https://img.shields.io/badge/license-AGPLv3-green?style=flat-square">
#+HTML: <img src="https://img.shields.io/badge/Lisp-Common%20Lisp-forestgreen?style=flat-square"> #+HTML: <img src="https://img.shields.io/badge/Lisp-Common%20Lisp-forestgreen?style=flat-square">
#+HTML: <img src="https://img.shields.io/badge/docs-Org--mode-darkgreen?style=flat-square"> #+HTML: <img src="https://img.shields.io/badge/docs-Org--mode-darkgreen?style=flat-square">
@@ -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 | | 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) | | 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 | | 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 | | 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 | | 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 | | MVCC memory concurrency | Planned | v0.6.1 | Concurrent reads/writes on Merkle tree |

View File

@@ -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. 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: :PROPERTIES:
:ID: id-v043-bwrap-sandbox :ID: id-v043-bwrap-sandbox
:CREATED: [2026-05-07 Thu] :CREATED: [2026-05-07 Thu]
:END: :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. 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. - 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. - 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: :PROPERTIES:
:ID: id-v043-severity-classification :ID: id-v043-severity-classification
:CREATED: [2026-05-07 Thu] :CREATED: [2026-05-07 Thu]
:END: :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. 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.

View File

@@ -62,7 +62,7 @@
(let ((stream (usocket:socket-stream socket))) (let ((stream (usocket:socket-stream socket)))
(handler-case (handler-case
(progn (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) (finish-output stream)
(loop (loop
(let ((msg (read-framed-message stream))) (let ((msg (read-framed-message stream)))

View File

@@ -46,15 +46,16 @@ dispatcher-check-core-path for self-build safety.")
"Maximum characters of shell output to capture.") "Maximum characters of shell output to capture.")
(defvar *dispatcher-shell-blocked* (defvar *dispatcher-shell-blocked*
'((:destructive-rm "\\brm\\s+-rf\\s+/") '((:destructive-rm "\\brm\\s+-rf\\s+/" :severity :catastrophic)
(:destructive-dd "\\bdd\\s+if=") (:destructive-dd "\\bdd\\s+if=" :severity :catastrophic)
(:destructive-mkfs "\\bmkfs\\.") (:destructive-mkfs "\\bmkfs\\." :severity :catastrophic)
(:destructive-format "\\bmformat\\b") (:disk-wipe "\\bshred\\s+/dev/" :severity :catastrophic)
(:disk-wipe "\\bshred\\s+/dev/") (:disk-wipe-b "\\bwipefs\\s+/dev/" :severity :catastrophic)
(:disk-wipe-b "\\bwipefs\\s+/dev/") (:injection-backtick "`[^`]+`" :severity :dangerous)
(:injection-backtick "`[^`]+`") (:injection-subshell "\\$\\([^)]+\\)" :severity :dangerous))
(:injection-subshell "\\$\\([^)]+\\)")) "Destructive and injection patterns blocked in shell commands.
"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) (defun wildcard-match (pattern path)
"Matches PATH against PATTERN where * matches any characters." "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) (defun dispatcher-check-shell-safety (cmd)
"Checks a shell command for destructive patterns and injection vectors. "Checks a shell command for destructive patterns and injection vectors.
Returns a list of matched pattern names or nil if safe." Returns (:matched <names> :severity <tier>) 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)) (when (and cmd (stringp cmd) (> (length cmd) 0))
(let ((matches nil)) (let ((matches nil)
(severity :harmless))
(dolist (entry *dispatcher-shell-blocked*) (dolist (entry *dispatcher-shell-blocked*)
(let ((name (first entry)) (let ((name (first entry))
(regex (second entry))) (regex (second entry))
(tier (getf entry :severity)))
(when (cl-ppcre:scan regex cmd) (when (cl-ppcre:scan regex cmd)
(push name matches)))) (push name matches)
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) (defun dispatcher-check-network-exfil (cmd)
"Detects if CMD attempts to contact an unwhitelisted external host." "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 "echo hello world")))
(is (not (dispatcher-check-shell-safety "ls -la /tmp")))) (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 (test test-check-privacy-tags
"Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content." "Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
(is (dispatcher-check-privacy-tags '("@personal" ":project:"))) (is (dispatcher-check-privacy-tags '("@personal" ":project:")))

View File

@@ -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) (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)) (declare (ignore context))
(let* ((payload (getf action :payload)) (let* ((payload (getf action :payload))
(cmd (getf payload :cmd)) (cmd (getf payload :cmd))
(timeout-sym (find-symbol "*DISPATCHER-SHELL-TIMEOUT*" :passepartout)) (timeout-sym (find-symbol "*DISPATCHER-SHELL-TIMEOUT*" :passepartout))
(timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30))) (timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30)))
(max-sym (find-symbol "*DISPATCHER-SHELL-MAX-OUTPUT*" :passepartout)) (max-sym (find-symbol "*DISPATCHER-SHELL-MAX-OUTPUT*" :passepartout))
(max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))) (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))
(log-message "ACT [Shell]: ~a (timeout: ~as)" cmd timeout) (memex-dir (or (uiop:getenv "MEMEX_DIR") (namestring (merge-pathnames "memex/" (user-homedir-pathname))))))
(multiple-value-bind (out err code) (log-message "ACT [Shell]: ~a (timeout: ~as)~@[ bwrap: enabled~]" cmd timeout (and *bwrap-available* " (bwrap)"))
(uiop:run-program (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd) (let ((cmdline (if *bwrap-available*
:output :string :error-output :string (bwrap-wrap-command cmd timeout memex-dir)
:ignore-error-status t) (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd))))
(cond (multiple-value-bind (out err code)
((= code 124) (format nil "ERROR: Command timed out after ~a seconds" timeout)) (uiop:run-program cmdline
((> (length out) max-output) :output :string :error-output :string
(format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output)) :ignore-error-status t)
((= code 0) out) (cond
(t (format nil "ERROR [~a]: ~a" code err)))))) ((= 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) (register-actuator :shell #'actuator-shell-execute)
(defskill :passepartout-system-actuator-shell (defskill :passepartout-system-actuator-shell
:priority 50 :priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :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))))

View File

@@ -151,7 +151,7 @@ The daemon sends a handshake message on connection, then enters a read loop, inj
(let ((stream (usocket:socket-stream socket))) (let ((stream (usocket:socket-stream socket)))
(handler-case (handler-case
(progn (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) (finish-output stream)
(loop (loop
(let ((msg (read-framed-message stream))) (let ((msg (read-framed-message stream)))

View File

@@ -22,7 +22,7 @@ Components are loaded in sequence (~:serial t~): package first (defines the publ
(defsystem :passepartout (defsystem :passepartout
:name "Passepartout" :name "Passepartout"
:author "Amr Gharbeia" :author "Amr Gharbeia"
:version "0.4.2" :version "0.4.3"
:license "AGPLv3" :license "AGPLv3"
:description "The Probabilistic-Deterministic Lisp Machine" :description "The Probabilistic-Deterministic Lisp Machine"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid) :depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)

View File

@@ -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 2. (dispatcher-check-secret-path filepath): returns the matching
protected pattern if ~filepath~ matches any entry in protected pattern if ~filepath~ matches any entry in
~*dispatcher-protected-paths*~, nil otherwise. ~*dispatcher-protected-paths*~, nil otherwise.
3. (dispatcher-check-shell-safety cmd): returns a list of matched 3. (dispatcher-check-shell-safety cmd): returns ~(:matched <names> :severity <tier>)~
dangerous-pattern names if ~cmd~ triggers any entry in if ~cmd~ triggers any entry in ~*dispatcher-shell-blocked*~, nil if safe.
~*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 4. (dispatcher-check-privacy-tags tags-list): returns T if any tag in
~tags-list~ matches a privacy filter tag, nil otherwise. ~tags-list~ matches a privacy filter tag, nil otherwise.
5. (dispatcher-check-network-exfil cmd): returns T (unsafe) if ~cmd~ 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 ;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp #+begin_src lisp
(defvar *dispatcher-shell-blocked* (defvar *dispatcher-shell-blocked*
'((:destructive-rm "\\brm\\s+-rf\\s+/") '((:destructive-rm "\\brm\\s+-rf\\s+/" :severity :catastrophic)
(:destructive-dd "\\bdd\\s+if=") (:destructive-dd "\\bdd\\s+if=" :severity :catastrophic)
(:destructive-mkfs "\\bmkfs\\.") (:destructive-mkfs "\\bmkfs\\." :severity :catastrophic)
(:destructive-format "\\bmformat\\b") (:disk-wipe "\\bshred\\s+/dev/" :severity :catastrophic)
(:disk-wipe "\\bshred\\s+/dev/") (:disk-wipe-b "\\bwipefs\\s+/dev/" :severity :catastrophic)
(:disk-wipe-b "\\bwipefs\\s+/dev/") (:injection-backtick "`[^`]+`" :severity :dangerous)
(:injection-backtick "`[^`]+`") (:injection-subshell "\\$\\([^)]+\\)" :severity :dangerous))
(:injection-subshell "\\$\\([^)]+\\)")) "Destructive and injection patterns blocked in shell commands.
"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 #+end_src
** Secret Path Check (dispatcher-check-secret-path) ** Secret Path Check (dispatcher-check-secret-path)
@@ -329,15 +330,35 @@ Returns the validation result plist or nil if not applicable."
#+begin_src lisp #+begin_src lisp
(defun dispatcher-check-shell-safety (cmd) (defun dispatcher-check-shell-safety (cmd)
"Checks a shell command for destructive patterns and injection vectors. "Checks a shell command for destructive patterns and injection vectors.
Returns a list of matched pattern names or nil if safe." Returns (:matched <names> :severity <tier>) 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)) (when (and cmd (stringp cmd) (> (length cmd) 0))
(let ((matches nil)) (let ((matches nil)
(severity :harmless))
(dolist (entry *dispatcher-shell-blocked*) (dolist (entry *dispatcher-shell-blocked*)
(let ((name (first entry)) (let ((name (first entry))
(regex (second entry))) (regex (second entry))
(tier (getf entry :severity)))
(when (cl-ppcre:scan regex cmd) (when (cl-ppcre:scan regex cmd)
(push name matches)))) (push name matches)
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 #+end_src
** Network Check (dispatcher-check-network-exfil) ** 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 "echo hello world")))
(is (not (dispatcher-check-shell-safety "ls -la /tmp")))) (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 (test test-check-privacy-tags
"Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content." "Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
(is (dispatcher-check-privacy-tags '("@personal" ":project:"))) (is (dispatcher-check-privacy-tags '("@personal" ":project:")))

View File

@@ -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 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 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 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 * Implementation
** Shell Execution (actuator-shell-execute) ** Shell Execution (actuator-shell-execute)
;; REPL-VERIFIED: 2026-05-03T13:00:00 ;; REPL-VERIFIED: 2026-05-03T13:00:00
#+begin_src lisp #+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) (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)) (declare (ignore context))
(let* ((payload (getf action :payload)) (let* ((payload (getf action :payload))
(cmd (getf payload :cmd)) (cmd (getf payload :cmd))
(timeout-sym (find-symbol "*DISPATCHER-SHELL-TIMEOUT*" :passepartout)) (timeout-sym (find-symbol "*DISPATCHER-SHELL-TIMEOUT*" :passepartout))
(timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30))) (timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30)))
(max-sym (find-symbol "*DISPATCHER-SHELL-MAX-OUTPUT*" :passepartout)) (max-sym (find-symbol "*DISPATCHER-SHELL-MAX-OUTPUT*" :passepartout))
(max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))) (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))
(log-message "ACT [Shell]: ~a (timeout: ~as)" cmd timeout) (memex-dir (or (uiop:getenv "MEMEX_DIR") (namestring (merge-pathnames "memex/" (user-homedir-pathname))))))
(multiple-value-bind (out err code) (log-message "ACT [Shell]: ~a (timeout: ~as)~@[ bwrap: enabled~]" cmd timeout (and *bwrap-available* " (bwrap)"))
(uiop:run-program (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd) (let ((cmdline (if *bwrap-available*
:output :string :error-output :string (bwrap-wrap-command cmd timeout memex-dir)
:ignore-error-status t) (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd))))
(cond (multiple-value-bind (out err code)
((= code 124) (format nil "ERROR: Command timed out after ~a seconds" timeout)) (uiop:run-program cmdline
((> (length out) max-output) :output :string :error-output :string
(format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output)) :ignore-error-status t)
((= code 0) out) (cond
(t (format nil "ERROR [~a]: ~a" code err)))))) ((= 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 #+end_src
** Skill Registration ** Skill Registration
@@ -49,3 +98,38 @@ Because shell execution is the highest-risk operation in the system, the Shell A
:priority 50 :priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src #+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

View File

@@ -1,7 +1,7 @@
(defsystem :passepartout (defsystem :passepartout
:name "Passepartout" :name "Passepartout"
:author "Amr Gharbeia" :author "Amr Gharbeia"
:version "0.4.2" :version "0.4.3"
:license "AGPLv3" :license "AGPLv3"
:description "The Probabilistic-Deterministic Lisp Machine" :description "The Probabilistic-Deterministic Lisp Machine"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid) :depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)