amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

v0.7.2: tag stack — trigger counts + PRIVACY_FILTER_TAGS fallback — TDD

Browse Source 
*tag-trigger-count* hash table tracks per-session tag triggers.
tag-trigger-record increments count, called from
dispatcher-privacy-severity on each matched tag. /tags shows
trigger count per tag.

tag-categories-load now falls back to PRIVACY_FILTER_TAGS env var
when TAG_CATEGORIES is not set (backward compat). All entries
default to :block severity.

- security-dispatcher: *tag-trigger-count*, tag-trigger-record,
  updated tag-categories-load, wired dispatcher-privacy-severity
  +2 tests (trigger record, privacy fallback)
- channel-tui-main: /tags shows trigger counts
- Core: 88/88  TUI Main: 102/102
This commit is contained in:
Amr Gharbeia
2026-05-08 21:20:06 -04:00
parent 4e756aeaa1
commit 8aed017ccd
3 changed files with 89 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

44
lisp/security-dispatcher.lisp
View File

@@ -114,9 +114,17 @@ Returns a list of matched category keywords."
"Alist of (tag . severity) from TAG_CATEGORIES env var.
Severity: :block (filter), :warn (log+include), :log (silent record).")
(defvar *tag-trigger-count* (make-hash-table :test 'equal)
"Per-session count of how many times each tag was triggered.")
(defun tag-trigger-record (tag)
"Increment the trigger count for TAG."
(incf (gethash (string-downcase tag) *tag-trigger-count* 0)))
(defun tag-categories-load ()
"Parse TAG_CATEGORIES env var into *tag-categories* alist."
(let ((raw (uiop:getenv "TAG_CATEGORIES")))
"Parse TAG_CATEGORIES or PRIVACY_FILTER_TAGS env var into *tag-categories* alist."
(let* ((raw (or (uiop:getenv "TAG_CATEGORIES")
(uiop:getenv "PRIVACY_FILTER_TAGS"))))
(setf *tag-categories*
(when raw
(mapcar (lambda (entry)
@@ -131,11 +139,14 @@ Severity: :block (filter), :warn (log+include), :log (silent record).")
(cdr (assoc tag *tag-categories* :test #'string-equal)))
(defun dispatcher-privacy-severity (tags-list)
"Return the highest-severity tag match: :block > :warn > :log, or nil."
"Return the highest-severity tag match: :block > :warn > :log, or nil.
Records trigger counts for matched tags."
(when (and tags-list (listp tags-list))
(let ((highest nil))
(dolist (tag tags-list)
(let ((sev (tag-category-severity tag)))
(when sev
(tag-trigger-record tag))
(when (or (eq sev :block)
(and (eq sev :warn) (not (eq highest :block)))
(and (eq sev :log) (null highest)))
@@ -604,6 +615,33 @@ Recognized formats:
(setf passepartout::*tag-categories* nil)
(is (null (passepartout::dispatcher-privacy-severity '("public")))))
(test test-tag-trigger-record
"v0.7.2: tag-trigger-record increments per-tag count."
(clrhash passepartout::*tag-trigger-count*)
(passepartout::tag-trigger-record "@personal")
(passepartout::tag-trigger-record "@personal")
(passepartout::tag-trigger-record "@draft")
(is (= 2 (gethash "@personal" passepartout::*tag-trigger-count* 0)))
(is (= 1 (gethash "@draft" passepartout::*tag-trigger-count* 0)))
(clrhash passepartout::*tag-trigger-count*))
(test test-tag-categories-privacy-fallback
"v0.7.2: TAG_CATEGORIES falls back to PRIVACY_FILTER_TAGS when not set."
(let ((orig-tag (uiop:getenv "TAG_CATEGORIES"))
(orig-privacy (uiop:getenv "PRIVACY_FILTER_TAGS"))
(saved-tag (uiop:getenv "TAG_CATEGORIES"))
(saved-privacy (uiop:getenv "PRIVACY_FILTER_TAGS")))
;; Set PRIVACY_FILTER_TAGS, clear TAG_CATEGORIES
(sb-posix:setenv "PRIVACY_FILTER_TAGS" "@personal,@draft" 1)
(sb-posix:unsetenv "TAG_CATEGORIES")
(passepartout::tag-categories-load)
(is (eq :block (passepartout::tag-category-severity "@personal")))
(is (eq :block (passepartout::tag-category-severity "@draft")))
;; Restore
(when saved-tag (sb-posix:setenv "TAG_CATEGORIES" saved-tag 1))
(when saved-privacy (sb-posix:setenv "PRIVACY_FILTER_TAGS" saved-privacy 1))
(passepartout::tag-categories-load)))
(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*)