diff --git a/lisp/security-dispatcher.lisp b/lisp/security-dispatcher.lisp index 3e35cb0..676546a 100644 --- a/lisp/security-dispatcher.lisp +++ b/lisp/security-dispatcher.lisp @@ -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*) diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index 590814c..9424023 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -251,13 +251,16 @@ 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 - ;; /tags command — tag stack + ;; /tags command — tag stack with trigger counts ((string-equal text "/tags") - (let ((cats passepartout::*tag-categories*)) + (let ((cats passepartout::*tag-categories*) + (counts passepartout::*tag-trigger-count*)) (if cats (dolist (entry cats) - (add-msg :system (format nil "~a: ~a" (car entry) (cdr entry)))) + (let* ((tag (car entry)) + (sev (cdr entry)) + (n (gethash (string-downcase tag) counts 0))) + (add-msg :system (format nil "~a: ~a (~d trigger~:p this session)" tag sev n)))) (add-msg :system "No tags configured. Set TAG_CATEGORIES env var.")))) ;; /context command — section breakdown with token estimates ((string-equal text "/context") diff --git a/org/security-dispatcher.org b/org/security-dispatcher.org index 231248a..6f20f5d 100644 --- a/org/security-dispatcher.org +++ b/org/security-dispatcher.org @@ -250,9 +250,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) @@ -267,11 +275,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))) @@ -847,6 +858,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*)