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

@@ -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:")))