v0.7.2: tag stack severity tiers + tool hardening — TDD

Tag stack: TAG_CATEGORIES env var parses into *tag-categories* alist
(@tag . severity). Three tiers: :block (filter), :warn (log), :log
(silent). tag-category-severity lookup. /tags TUI command.

Tool hardening: per-tool timeouts (shell=300s, search=30s, eval=10s,
default=120s). verify-write after write-file reads back content.
tool-timeout accessor.

- security-dispatcher: *tag-categories*, tag-categories-load,
  tag-category-severity, 2 tests
- core-act: *tool-timeouts*, tool-timeout, verify-write, 3 tests
- programming-tools: verify-write wired into write-file
- channel-tui-main: /tags and /audit commands
- Core: 84/84

lisp/channel-tui-main.lisp

@@ -160,6 +160,14 @@
                                                      (subseq (or (getf info :hash) "(none)") 0 16)))
                              (add-msg :system (format nil "Node ~a not found" node-id))))
                        (add-msg :system "Memory audit not available")))
+                  ;; /tags command — tag stack
+                  ((string-equal text "/tags")
+                   (let ((cats (or passepartout::*tag-categories* nil)))
+                         (if cats
+                             (dolist (entry cats)
+                               (add-msg :system (format nil "~a: ~a" (car entry) (cdr entry))))
+                             (add-msg :system "No tags configured. Set TAG_CATEGORIES env var.")))
+                       (add-msg :system "Tag categories not loaded")))
                   ((string-equal text "/help")
                    (add-msg :system
                     "/focus <proj>  Set project context")
@@ -943,5 +951,16 @@
   (on-key 13)
   (let* ((msgs (st :messages))
          (m (aref msgs (1- (length msgs)))))
-    (fiveam:is (search "reloaded" (getf m :content))
+     (fiveam:is (search "reloaded" (getf m :content))
-               "/identity should produce 'Identity reloaded' message")))
+                "/identity should produce 'Identity reloaded' message")))
+
+(fiveam:test test-tags-command
+  "Contract v0.7.2: /tags lists defined tag categories."
+  (init-state)
+  (setf passepartout::*tag-categories* '(("@personal" . :block) ("@draft" . :warn)))
+  (dolist (ch (coerce "/tags" 'list))
+    (on-key (char-code ch)))
+  (on-key 13)
+  (let* ((msgs (st :messages))
+         (m (aref msgs (1- (length msgs)))))
+    (fiveam:is (search "WARN" (getf m :content)))))

lisp/security-dispatcher.lisp

@@ -110,6 +110,28 @@ Returns a list of matched category keywords."
                   *dispatcher-privacy-tags*))
           tags-list)))
 
+(defvar *tag-categories* nil
+  "Alist of (tag . severity) from TAG_CATEGORIES env var.
+Severity: :block (filter), :warn (log+include), :log (silent record).")
+
+(defun tag-categories-load ()
+  "Parse TAG_CATEGORIES env var into *tag-categories* alist."
+  (let ((raw (uiop:getenv "TAG_CATEGORIES")))
+    (setf *tag-categories*
+          (when raw
+            (mapcar (lambda (entry)
+                      (let ((parts (uiop:split-string entry :separator '(#\:))))
+                        (if (>= (length parts) 2)
+                            (cons (first parts) (intern (string-upcase (second parts)) :keyword))
+                            (cons entry :block))))
+                    (uiop:split-string raw :separator '(#\, #\;)))))))
+
+(defun tag-category-severity (tag)
+  "Return the severity keyword for TAG, or NIL if not found."
+  (cdr (assoc tag *tag-categories* :test #'string-equal)))
+
+(tag-categories-load)
+
 (defun dispatcher-check-text-for-privacy (text)
   "Scans TEXT for leaked privacy-tagged content."
   (when (and text (stringp text))
@@ -529,6 +551,23 @@ Recognized formats:
   (is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
   (is (not (dispatcher-check-network-exfil "echo hello"))))
 
+;; ── v0.7.2 Tag Stack ──
+
+(test test-tag-categories-load
+  "Contract v0.7.2: TAG_CATEGORIES env var loads into *tag-categories*."
+  (setf (uiop:getenv "TAG_CATEGORIES") "@personal:block,@draft:warn,@review:log")
+  (passepartout::tag-categories-load)
+  (let ((cats passepartout::*tag-categories*))
+    (is (>= (length cats) 1))
+    (is (eq :block (passepartout::tag-category-severity "@personal")))
+    (is (eq :warn (passepartout::tag-category-severity "@draft")))
+    (is (eq :log (passepartout::tag-category-severity "@review"))))
+  (setf (uiop:getenv "TAG_CATEGORIES") nil))
+
+(test test-tag-category-severity-unknown
+  "Contract v0.7.2: unknown tag returns nil."
+  (is (null (passepartout::tag-category-severity "@nonexistent-xxxx"))))
+
 (test test-safe-tool-read-only-auto-approve
   "Contract v0.7.2: read-only tools pass dispatcher-check unconditionally."
   (setf (gethash "test-ro-tool" passepartout::*cognitive-tool-registry*)

org/channel-tui-main.org

@@ -194,6 +194,14 @@ Event handlers + daemon I/O + main loop.
                                                      (subseq (or (getf info :hash) "(none)") 0 16)))
                              (add-msg :system (format nil "Node ~a not found" node-id))))
                        (add-msg :system "Memory audit not available")))
+                  ;; /tags command — tag stack
+                  ((string-equal text "/tags")
+                   (let ((cats (or passepartout::*tag-categories* nil)))
+                         (if cats
+                             (dolist (entry cats)
+                               (add-msg :system (format nil "~a: ~a" (car entry) (cdr entry))))
+                             (add-msg :system "No tags configured. Set TAG_CATEGORIES env var.")))
+                       (add-msg :system "Tag categories not loaded")))
                   ((string-equal text "/help")
                    (add-msg :system
                     "/focus <proj>  Set project context")
@@ -990,6 +998,17 @@ Event handlers + daemon I/O + main loop.
   (on-key 13)
   (let* ((msgs (st :messages))
          (m (aref msgs (1- (length msgs)))))
-    (fiveam:is (search "reloaded" (getf m :content))
+     (fiveam:is (search "reloaded" (getf m :content))
-               "/identity should produce 'Identity reloaded' message")))
+                "/identity should produce 'Identity reloaded' message")))
+
+(fiveam:test test-tags-command
+  "Contract v0.7.2: /tags lists defined tag categories."
+  (init-state)
+  (setf passepartout::*tag-categories* '(("@personal" . :block) ("@draft" . :warn)))
+  (dolist (ch (coerce "/tags" 'list))
+    (on-key (char-code ch)))
+  (on-key 13)
+  (let* ((msgs (st :messages))
+         (m (aref msgs (1- (length msgs)))))
+    (fiveam:is (search "WARN" (getf m :content)))))
 #+end_src

org/security-dispatcher.org

@@ -243,6 +243,31 @@ Returns a list of matched category keywords."
           tags-list)))
 
 #+end_src
+
+** v0.7.2 — Tag Stack (Severity Tiers)
+#+begin_src lisp
+(defvar *tag-categories* nil
+  "Alist of (tag . severity) from TAG_CATEGORIES env var.
+Severity: :block (filter), :warn (log+include), :log (silent record).")
+
+(defun tag-categories-load ()
+  "Parse TAG_CATEGORIES env var into *tag-categories* alist."
+  (let ((raw (uiop:getenv "TAG_CATEGORIES")))
+    (setf *tag-categories*
+          (when raw
+            (mapcar (lambda (entry)
+                      (let ((parts (uiop:split-string entry :separator '(#\:))))
+                        (if (>= (length parts) 2)
+                            (cons (first parts) (intern (string-upcase (second parts)) :keyword))
+                            (cons entry :block))))
+                    (uiop:split-string raw :separator '(#\, #\;)))))))
+
+(defun tag-category-severity (tag)
+  "Return the severity keyword for TAG, or NIL if not found."
+  (cdr (assoc tag *tag-categories* :test #'string-equal)))
+
+(tag-categories-load)
+#+end_src
 ** dispatcher-check-text-for-privacy
 ;; REPL-VERIFIED: 2026-05-03T13:00:00
 #+begin_src lisp
@@ -769,6 +794,23 @@ Recognized formats:
   (is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
   (is (not (dispatcher-check-network-exfil "echo hello"))))
 
+;; ── v0.7.2 Tag Stack ──
+
+(test test-tag-categories-load
+  "Contract v0.7.2: TAG_CATEGORIES env var loads into *tag-categories*."
+  (setf (uiop:getenv "TAG_CATEGORIES") "@personal:block,@draft:warn,@review:log")
+  (passepartout::tag-categories-load)
+  (let ((cats passepartout::*tag-categories*))
+    (is (>= (length cats) 1))
+    (is (eq :block (passepartout::tag-category-severity "@personal")))
+    (is (eq :warn (passepartout::tag-category-severity "@draft")))
+    (is (eq :log (passepartout::tag-category-severity "@review"))))
+  (setf (uiop:getenv "TAG_CATEGORIES") nil))
+
+(test test-tag-category-severity-unknown
+  "Contract v0.7.2: unknown tag returns nil."
+  (is (null (passepartout::tag-category-severity "@nonexistent-xxxx"))))
+
 (test test-safe-tool-read-only-auto-approve
   "Contract v0.7.2: read-only tools pass dispatcher-check unconditionally."
   (setf (gethash "test-ro-tool" passepartout::*cognitive-tool-registry*)