v0.7.2: Merkle audit — audit-verify-hash with hash integrity check — TDD
audit-verify-hash counts total objects and those with missing/empty hashes. /audit verify uses it to report VERIFY PASS or MISSING HASHES count. fboundp-guarded. - core-memory: audit-verify-hash fn, 1 test - channel-tui-main: updated /audit verify handler - Core: 90/90 TUI Main: 102/102
This commit is contained in:
@@ -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 <n> — resume from snapshot
|
||||
((and (>= (length text) 8) (string-equal (subseq text 0 8) "/resume "))
|
||||
(let* ((n-str (string-trim '(#\Space) (subseq text 8)))
|
||||
|
||||
@@ -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)))))
|
||||
|
||||
Reference in New Issue
Block a user