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 <names> :severity <tier>)
- Version: 0.4.2 -> 0.4.3 across handshake, ASDF, README badge

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 <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)))))
+
+(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:")))