passepartout: v0.4.3 Shell Sandboxing & Safety Classification
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
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:
@@ -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)))
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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 <names> :severity <tier>)~
|
||||
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 <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))
|
||||
(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:")))
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user