diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index 192487a..92c0328 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -217,13 +217,16 @@ (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") @@ -318,16 +321,16 @@ (add-msg :system "No snapshots available")))) ;; /audit verify — memory integrity ((string-equal text "/audit verify") - (let ((count 0) (hashed 0)) - (maphash (lambda (k v) (declare (ignore k)) - (when v - (incf count) - (when (passepartout::memory-object-hash v) - (incf hashed)))) - passepartout::*memory-store*) - (add-msg :system (format nil "Audit: ~d objects, ~d hashed, ~d snapshots" - count hashed - (length passepartout::*memory-snapshots*))))) + (if (fboundp 'passepartout::audit-verify-hash) + (let* ((result (funcall 'passepartout::audit-verify-hash)) + (total (car result)) + (missing (cdr result))) + (add-msg :system (format nil "Audit: ~d objects, ~d missing hashes, ~d snapshots~@[ — VERIFY PASS~]~@[ — ~d MISSING HASHES~]" + total missing + (length passepartout::*memory-snapshots*) + (zerop missing) + (unless (zerop missing) missing)))) + (add-msg :system "Memory audit not available"))) ;; /resume — resume from snapshot ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/resume ")) (let* ((n-str (string-trim '(#\Space) (subseq text 8))) diff --git a/lisp/core-memory.lisp b/lisp/core-memory.lisp index 2833e4e..a496944 100644 --- a/lisp/core-memory.lisp +++ b/lisp/core-memory.lisp @@ -204,6 +204,20 @@ :hash (or (memory-object-hash obj) "(none)") :scope (memory-object-scope obj))))) +(defun audit-verify-hash () + "Count memory objects and report any with missing/empty hashes. +Returns (total . missing-hashes)." + (let ((total 0) (missing 0)) + (maphash (lambda (id obj) + (declare (ignore id)) + (when obj + (incf total) + (let ((h (memory-object-hash obj))) + (when (or (null h) (string= h "")) + (incf missing))))) + *memory-store*) + (cons total missing))) + (eval-when (:compile-toplevel :load-toplevel :execute) (ql:quickload :fiveam :silent t)) @@ -326,3 +340,12 @@ (test test-audit-node-not-found "Contract v0.7.2: audit-node returns nil for nonexistent id." (is (null (passepartout::audit-node "nonexistent-xxxx")))) + +(test test-audit-verify-hash + "Contract v0.7.2: audit-verify-hash returns (total . missing)." + (clrhash passepartout::*memory-store*) + (setf (gethash "a" passepartout::*memory-store*) + (passepartout::make-memory-object :id "a" :type :HEADLINE :hash "abc")) + (let ((result (passepartout::audit-verify-hash))) + (is (= 1 (car result))) + (is (= 0 (cdr result))))) diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index 9424023..a456c98 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -355,16 +355,16 @@ Event handlers + daemon I/O + main loop. (add-msg :system "No snapshots available")))) ;; /audit verify — memory integrity ((string-equal text "/audit verify") - (let ((count 0) (hashed 0)) - (maphash (lambda (k v) (declare (ignore k)) - (when v - (incf count) - (when (passepartout::memory-object-hash v) - (incf hashed)))) - passepartout::*memory-store*) - (add-msg :system (format nil "Audit: ~d objects, ~d hashed, ~d snapshots" - count hashed - (length passepartout::*memory-snapshots*))))) + (if (fboundp 'passepartout::audit-verify-hash) + (let* ((result (funcall 'passepartout::audit-verify-hash)) + (total (car result)) + (missing (cdr result))) + (add-msg :system (format nil "Audit: ~d objects, ~d missing hashes, ~d snapshots~@[ — VERIFY PASS~]~@[ — ~d MISSING HASHES~]" + total missing + (length passepartout::*memory-snapshots*) + (zerop missing) + (unless (zerop missing) missing)))) + (add-msg :system "Memory audit not available"))) ;; /resume — resume from snapshot ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/resume ")) (let* ((n-str (string-trim '(#\Space) (subseq text 8))) diff --git a/org/core-memory.org b/org/core-memory.org index 4728009..04c36da 100644 --- a/org/core-memory.org +++ b/org/core-memory.org @@ -415,6 +415,20 @@ Restores memory state from a previously saved snapshot file. Called during boot :version (memory-object-version obj) :hash (or (memory-object-hash obj) "(none)") :scope (memory-object-scope obj))))) + +(defun audit-verify-hash () + "Count memory objects and report any with missing/empty hashes. +Returns (total . missing-hashes)." + (let ((total 0) (missing 0)) + (maphash (lambda (id obj) + (declare (ignore id)) + (when obj + (incf total) + (let ((h (memory-object-hash obj))) + (when (or (null h) (string= h "")) + (incf missing))))) + *memory-store*) + (cons total missing))) #+end_src * Test Suite @@ -542,4 +556,13 @@ Verifies that the Merkle hash is deterministic and consistent across independent (test test-audit-node-not-found "Contract v0.7.2: audit-node returns nil for nonexistent id." (is (null (passepartout::audit-node "nonexistent-xxxx")))) + +(test test-audit-verify-hash + "Contract v0.7.2: audit-verify-hash returns (total . missing)." + (clrhash passepartout::*memory-store*) + (setf (gethash "a" passepartout::*memory-store*) + (passepartout::make-memory-object :id "a" :type :HEADLINE :hash "abc")) + (let ((result (passepartout::audit-verify-hash))) + (is (= 1 (car result))) + (is (= 0 (cdr result))))) #+end_src \ No newline at end of file