passepartout: v0.4.1 Design Cleanup
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
- Remove system-prompt-augment mechanism, introduce *standing-mandates* - Fix false token-overhead claims in DESIGN_DECISIONS + ROADMAP - Update security vector count 9-10 across all docs and dispatcher docstring - Rewrite README with agent section, soften aspirational claims - Register 10 cognitive tools in programming-tools.org with test suite - Enforce NO-HARDCODED-CONSTANTS in .env.example - ROADMAP: mark v0.3.x patches DONE, add LOGBOOKs, mark releases - AGENTS.md: rewrite compact (180 to 50 lines), move refs to CONTRIBUTING - Normalize org tangle directives to file-level PROPERTY inheritance
This commit is contained in:
@@ -203,7 +203,7 @@ The first message sent to every new connection. The client can use this to verif
|
||||
|
||||
Validates that an incoming message has the minimum required structure: a plist with a valid ~:type~ field. Used by the protocol validator skill to reject malformed messages before they enter the cognitive loop.
|
||||
|
||||
#+begin_src lisp :tangle ../lisp/core-communication.lisp
|
||||
#+begin_src lisp
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun protocol-schema-validate (msg)
|
||||
@@ -258,7 +258,7 @@ Use this function to manually verify that the daemon is alive and the framing pr
|
||||
|
||||
* Test Suite
|
||||
Verifies that the framing protocol correctly serializes and deserializes messages.
|
||||
#+begin_src lisp :tangle ../lisp/core-communication.lisp
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
|
||||
@@ -306,7 +306,7 @@ to ~context-awareness-assemble~.
|
||||
|
||||
* Test Suite
|
||||
Verifies that the Foveal-Peripheral rendering correctly distinguishes between foveal (detailed) and peripheral (outline) content, and that the awareness budget includes all active projects.
|
||||
#+begin_src lisp :tangle ../lisp/core-context.lisp
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
|
||||
@@ -22,7 +22,7 @@ The implementation section includes:
|
||||
|
||||
** Package Definition and Export List
|
||||
The package definition. All public symbols are exported here.
|
||||
#+begin_src lisp :tangle ../lisp/core-defpackage.lisp
|
||||
#+begin_src lisp
|
||||
(defpackage :passepartout
|
||||
(:use :cl)
|
||||
(:export
|
||||
@@ -195,7 +195,7 @@ The package implementation section defines the low-level utilities and global st
|
||||
|
||||
*** Robust plist access (plist-get)
|
||||
Retrieves a value from a plist, checking both upper and lowercase keyword variants. This is needed because different components use different keyword conventions.
|
||||
#+begin_src lisp :tangle ../lisp/core-defpackage.lisp
|
||||
#+begin_src lisp
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun plist-get (plist key)
|
||||
@@ -208,7 +208,7 @@ Retrieves a value from a plist, checking both upper and lowercase keyword varian
|
||||
|
||||
*** Logging state
|
||||
The harness maintains a bounded ring buffer of log messages for inclusion in LLM context. Access is thread-safe via a lock.
|
||||
#+begin_src lisp :tangle ../lisp/core-defpackage.lisp
|
||||
#+begin_src lisp
|
||||
(defvar *log-buffer* nil)
|
||||
(defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock"))
|
||||
(defvar *log-limit* 100)
|
||||
@@ -216,14 +216,14 @@ The harness maintains a bounded ring buffer of log messages for inclusion in LLM
|
||||
|
||||
*** Skill registry
|
||||
The global registry of all loaded skills. This is the authoritative list that the deterministic engine iterates.
|
||||
#+begin_src lisp :tangle ../lisp/core-defpackage.lisp
|
||||
#+begin_src lisp
|
||||
(defvar *skill-registry* (make-hash-table :test 'equal)
|
||||
"Global registry of all loaded skills.")
|
||||
#+end_src
|
||||
|
||||
*** Skill telemetry
|
||||
Tracks execution metrics per skill (count, duration, failures) for diagnostics and performance analysis.
|
||||
#+begin_src lisp :tangle ../lisp/core-defpackage.lisp
|
||||
#+begin_src lisp
|
||||
(defvar *telemetry-table* (make-hash-table :test 'equal))
|
||||
(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
|
||||
|
||||
@@ -240,11 +240,11 @@ Tracks execution metrics per skill (count, duration, failures) for diagnostics a
|
||||
|
||||
*** Cognitive tool registry
|
||||
Tools that the LLM can invoke are registered here. Each tool has a name, description, parameters, optional guard, and implementation body. The ~def-cognitive-tool~ macro handles registration. ~cognitive-tool-prompt~ serialises the registry into the LLM's system prompt.
|
||||
#+begin_src lisp :tangle ../lisp/core-defpackage.lisp
|
||||
#+begin_src lisp
|
||||
(defvar *cognitive-tool-registry* (make-hash-table :test 'equal))
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ../lisp/core-defpackage.lisp
|
||||
#+begin_src lisp
|
||||
(defstruct cognitive-tool
|
||||
name
|
||||
description
|
||||
@@ -253,7 +253,7 @@ Tools that the LLM can invoke are registered here. Each tool has a name, descrip
|
||||
body)
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ../lisp/core-defpackage.lisp
|
||||
#+begin_src lisp
|
||||
(defmacro def-cognitive-tool (name description parameters &key guard body)
|
||||
"Registers a cognitive tool. PARAMETERS is a list of plists, one per parameter."
|
||||
`(setf (gethash (string-downcase (string ',name)) *cognitive-tool-registry*)
|
||||
@@ -264,7 +264,7 @@ Tools that the LLM can invoke are registered here. Each tool has a name, descrip
|
||||
:body ,body)))
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ../lisp/core-defpackage.lisp
|
||||
#+begin_src lisp
|
||||
(defun cognitive-tool-prompt ()
|
||||
"Serialises all registered tools into a prompt string for the LLM."
|
||||
(let ((descriptions nil))
|
||||
@@ -287,7 +287,7 @@ Tools that the LLM can invoke are registered here. Each tool has a name, descrip
|
||||
|
||||
*** Centralized logging (log-message)
|
||||
Thread-safe logging function that writes to both the ring buffer (for LLM context) and stdout (for the user). Bounded by ~*log-limit*~.
|
||||
#+begin_src lisp :tangle ../lisp/core-defpackage.lisp
|
||||
#+begin_src lisp
|
||||
(defun log-message (msg &rest args)
|
||||
"Centralized, thread-safe logging for the harness."
|
||||
(let ((formatted-msg (apply #'format nil msg args)))
|
||||
@@ -301,7 +301,7 @@ Thread-safe logging function that writes to both the ring buffer (for LLM contex
|
||||
|
||||
*** Debugger hook
|
||||
Friendly error handler that replaces the raw SBCL debugger with a diagnostic message. This prevents the agent from entering the debugger on unhandled conditions.
|
||||
#+begin_src lisp :tangle ../lisp/core-defpackage.lisp
|
||||
#+begin_src lisp
|
||||
(setf *debugger-hook* (lambda (condition hook)
|
||||
"Friendly error handler - shows diagnostic message instead of raw debugger."
|
||||
(declare (ignore hook))
|
||||
|
||||
@@ -300,7 +300,7 @@ uses the old name can call this alias. New code should call
|
||||
|
||||
* Test Suite
|
||||
Verifies that the act gate correctly processes an approved action and sets the signal status to ~:acted~.
|
||||
#+begin_src lisp :tangle ../lisp/core-loop-act.lisp
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
|
||||
@@ -247,7 +247,7 @@ uses the old name can call this alias. New code should call
|
||||
|
||||
* Test Suite
|
||||
Verifies that the perceive gate correctly ingests AST nodes into memory and that the depth limiter prevents runaway recursive signals.
|
||||
#+begin_src lisp :tangle ../lisp/core-loop-perceive.lisp
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
|
||||
@@ -195,9 +195,9 @@ This is the main entry point for the probabilistic engine. Every cognitive cycle
|
||||
The function handles several cases:
|
||||
- If a triggered skill provides a probabilistic prompt generator, that replaces the raw user input
|
||||
- If the previous proposal was rejected, the rejection trace is injected into the LLM's context so it can self-correct
|
||||
- Skills can augment the system prompt with domain-specific mandates via the ~system-prompt-augment~ mechanism
|
||||
- Standing mandates from ~*standing-mandates*~ are injected into the IDENTITY section of the system prompt
|
||||
|
||||
The system prompt assembly order — identity, tools, context, logs, mandates — is intentional: the most dynamic content (mandates from skills) comes last so it has the most influence on the LLM's output.
|
||||
The system prompt assembly order — identity (including mandates), tools, context, logs — is intentional: standing mandates appear early in IDENTITY so they set the behavioral frame before the model processes tools, context, and logs.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
@@ -216,19 +216,18 @@ The system prompt assembly order — identity, tools, context, logs, mandates
|
||||
(reflection-feedback (if rejection-trace
|
||||
(format nil "~%~%PREVIOUS PROPOSAL REJECTED: ~a" rejection-trace)
|
||||
""))
|
||||
(skill-augments (let ((augments ""))
|
||||
(maphash (lambda (name skill)
|
||||
(declare (ignore name))
|
||||
(let ((aug-fn (skill-system-prompt-augment skill)))
|
||||
(when aug-fn
|
||||
(let ((aug-text (ignore-errors (funcall aug-fn context))))
|
||||
(when (and aug-text (stringp aug-text) (> (length aug-text) 0))
|
||||
(setf augments (concatenate 'string augments aug-text (string #\Newline))))))))
|
||||
*skill-registry*)
|
||||
(when (> (length augments) 0) augments)))
|
||||
(system-prompt (format nil "IDENTITY: ~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a~%~a"
|
||||
assistant-name reflection-feedback tool-belt global-context system-logs
|
||||
(or skill-augments ""))))
|
||||
(standing-mandates-text (let ((out ""))
|
||||
(dolist (fn *standing-mandates*)
|
||||
(let ((text (ignore-errors (funcall fn context))))
|
||||
(when (and text (stringp text) (> (length text) 0))
|
||||
(setf out (concatenate 'string out text (string #\Newline))))))
|
||||
(when (> (length out) 0) out)))
|
||||
(system-prompt (format nil "IDENTITY: ~a~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
|
||||
assistant-name reflection-feedback
|
||||
(if standing-mandates-text
|
||||
(concatenate 'string (string #\Newline) standing-mandates-text)
|
||||
"")
|
||||
tool-belt global-context system-logs)))
|
||||
(let* ((thought (backend-cascade-call raw-prompt :system-prompt system-prompt :context context))
|
||||
(cleaned (if (and (listp thought) (getf thought :type))
|
||||
(format nil "~a" (getf (getf thought :payload) :text))
|
||||
@@ -375,7 +374,7 @@ uses the old name can call this alias. New code should call
|
||||
|
||||
* Test Suite
|
||||
Verifies that the deterministic engine correctly rejects unsafe actions (like ~rm -rf /~) while allowing safe ones.
|
||||
#+begin_src lisp :tangle ../lisp/core-loop-reason.lisp
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
|
||||
@@ -306,7 +306,7 @@ Boot sequence:
|
||||
|
||||
* Test Suite
|
||||
Verifies that the immune system (error handling) correctly catches and reports errors from the cognitive pipeline.
|
||||
#+begin_src lisp :tangle ../lisp/core-loop.lisp
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
|
||||
@@ -363,7 +363,7 @@ Restores memory state from a previously saved snapshot file. Called during boot
|
||||
|
||||
* Test Suite
|
||||
Verifies that the Merkle hash is deterministic and consistent across independent AST ingestions.
|
||||
#+begin_src lisp :tangle ../lisp/core-memory.lisp
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
|
||||
@@ -72,10 +72,10 @@ Simple mask function and the vault memory hash table. Used by the Security Dispa
|
||||
|
||||
** Skill data structures
|
||||
|
||||
The ~skill~ struct holds all metadata about a loaded skill: its name, priority, dependencies, trigger function, probabilistic prompt generator, deterministic gate, and system prompt augmentor. The ~skill-entry~ struct tracks the loading state of each discovered skill file.
|
||||
The ~skill~ struct holds all metadata about a loaded skill: its name, priority, dependencies, trigger function, probabilistic prompt generator, and deterministic gate. The ~skill-entry~ struct tracks the loading state of each discovered skill file.
|
||||
|
||||
#+begin_src lisp
|
||||
(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn system-prompt-augment)
|
||||
(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn)
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp
|
||||
@@ -87,6 +87,13 @@ The ~skill~ struct holds all metadata about a loaded skill: its name, priority,
|
||||
"Tracks all discovered skill files and their loading state.")
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp
|
||||
(defvar *standing-mandates* nil
|
||||
"List of functions (context) → string-or-nil. Each is called on every think() cycle.
|
||||
When non-nil, the returned string is injected into the IDENTITY section of the system prompt.
|
||||
Unlike skills (which activate on triggers), standing mandates are always consulted.")
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp
|
||||
(defstruct skill-entry filename (status :discovered) error-log (load-time 0))
|
||||
#+end_src
|
||||
@@ -114,14 +121,22 @@ This is how the system determines which skill "owns" the current user input. For
|
||||
(first (sort triggered #'> :key #'skill-priority))))
|
||||
#+end_src
|
||||
|
||||
** Standing Mandates
|
||||
|
||||
Standing mandates are cross-cutting instructions injected into every LLM system prompt. They live in ~*standing-mandates*~, a list of functions ~(context) → string-or-nil~. Each is called on every reasoning cycle; nil results are skipped.
|
||||
|
||||
This is the mechanism for always-on behavioral instructions. Skills call their registered trigger function to determine if they should activate for a given context; standing mandates always run and decide themselves whether to contribute text. Use ~push~ to register:
|
||||
|
||||
#+begin_example
|
||||
(push #'my-mandate *standing-mandates*)
|
||||
#+end_example
|
||||
|
||||
** Skill registration macro (defskill)
|
||||
|
||||
The primary API for skills. Each skill file calls this once to register itself. The macro creates a ~skill~ struct and stores it in ~*skill-registry*~ keyed by the skill's name.
|
||||
|
||||
The ~:system-prompt-augment~ slot is optional. If provided, it's a function that receives the context and returns a string to append to the LLM's system prompt. This allows skills to inject domain-specific instructions into every reasoning cycle.
|
||||
|
||||
#+begin_src lisp
|
||||
(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic system-prompt-augment)
|
||||
(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic)
|
||||
"Registers a new skill. NAME is a keyword. TRIGGER is a function (context) → bool."
|
||||
`(setf (gethash (string-downcase (string ,name)) *skill-registry*)
|
||||
(make-skill :name (string-downcase (string ,name))
|
||||
@@ -129,8 +144,7 @@ The ~:system-prompt-augment~ slot is optional. If provided, it's a function that
|
||||
:dependencies ',dependencies
|
||||
:trigger-fn ,trigger
|
||||
:probabilistic-prompt ,probabilistic
|
||||
:deterministic-fn ,deterministic
|
||||
:system-prompt-augment ,system-prompt-augment)))
|
||||
:deterministic-fn ,deterministic)))
|
||||
#+end_src
|
||||
|
||||
** Dependency resolution (skill-dependencies-resolve)
|
||||
|
||||
@@ -242,7 +242,10 @@ writes the result back through the reply-stream."
|
||||
* Phase E: Lifecycle
|
||||
The REPL skill loads at priority 200 (after diagnostics at 100, before utils-lisp at 400).
|
||||
|
||||
** System Prompt Augment (repl-mandate)
|
||||
** Standing Mandate (repl-mandate)
|
||||
|
||||
The REPL-first mandate is registered as a standing mandate — it runs on every ~think()~ cycle, inspecting the user input for code-related keywords. When it matches, the mandate text is injected into the IDENTITY section of the system prompt.
|
||||
|
||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||
#+begin_src lisp
|
||||
(defun repl-mandate (context)
|
||||
@@ -265,8 +268,12 @@ The REPL skill loads at priority 200 (after diagnostics at 100, before utils-lis
|
||||
(defskill :passepartout-programming-repl
|
||||
:priority 200
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil)
|
||||
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)
|
||||
:system-prompt-augment #'repl-mandate)
|
||||
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp
|
||||
(eval-when (:load-toplevel :execute)
|
||||
(push #'repl-mandate *standing-mandates*))
|
||||
#+end_src
|
||||
|
||||
* Test Suite
|
||||
|
||||
@@ -78,6 +78,17 @@ The Diagnostics skill is the self-knowledge of Passepartout. It answers
|
||||
3. Every test in ~* Test Suite~ MUST reference a specific Contract item.
|
||||
4. If you change a function's signature, you MUST update its Contract item.
|
||||
5. These files are excluded (no defuns): ~core-manifest.org~, ~setup.org~.
|
||||
6. **NO-HARDCODED-CONSTANTS**: All configurable values (thresholds, intervals,
|
||||
paths, limits, counters) MUST be read from environment variables with a
|
||||
documented default in ~.env.example~. No magic numbers, no hardcoded
|
||||
string literals in function bodies for any value a user might need to
|
||||
change. The user owns their configuration — they change it in ~.env~, not
|
||||
in the source code. Exceptions: internal implementation details that are
|
||||
never user-facing (hash-table sizes, buffer capacity limits, loop
|
||||
iteration caps) may live in source. But if the value controls *behavior*
|
||||
(how many approvals before a rule, what similarity threshold gates
|
||||
context, how long a shell command runs before timeout), it lives
|
||||
in ~.env~ with a fallback default.
|
||||
|
||||
** Engineering Lifecycle (Two-Track)
|
||||
|
||||
|
||||
520
org/programming-tools.org
Normal file
520
org/programming-tools.org
Normal file
@@ -0,0 +1,520 @@
|
||||
#+TITLE: SKILL: Programming Tools (programming-tools.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :programming:tools:cognitive:
|
||||
#+PROPERTY: header-args:lisp :tangle ../lisp/programming-tools.lisp
|
||||
|
||||
* Cognitive Tools for Codebase Operations
|
||||
|
||||
This skill registers ten cognitive tools that let the LLM search codebases, read and write files, evaluate Lisp expressions, run tests, and manipulate Org files. Without these tools, the agent can chat and run shell commands but cannot perform the core operations of a programming assistant.
|
||||
|
||||
Each tool is registered via ~def-cognitive-tool~ and appears in the LLM's tool belt prompt via ~cognitive-tool-prompt~. Tools receive arguments as a plist and return a plist with ~:status~ (~:success or :error~) and either ~:content~ (success) or ~:message~ (error). The tool executor (~action-tool-execute~) normalizes nested argument lists, dispatches by name, and feeds results back into the perception pipeline.
|
||||
|
||||
** Contract
|
||||
|
||||
1. Every tool returns a plist with at least ~:status~. On success: ~(:status :success :content "...")~. On error: ~(:status :error :message "...")~.
|
||||
2. Every tool guards against missing required parameters and returns a clear error message.
|
||||
3. Every tool handles runtime exceptions (~handler-case~) — a tool must never crash the daemon.
|
||||
4. ~search-files~: given ~:pattern~, ~:path~, optional ~:include~ (glob), returns matched lines with file:line prefixes.
|
||||
5. ~find-files~: given ~:pattern~ (glob), ~:path~, returns list of matching file paths.
|
||||
6. ~read-file~: given ~:filepath~, optional ~:start~, ~:limit~ (lines), returns file contents.
|
||||
7. ~write-file~: given ~:filepath~, ~:content~, creates directories, writes file, returns byte count.
|
||||
8. ~list-directory~: given ~:path~, optional ~:pattern~, returns sorted directory entries.
|
||||
9. ~run-shell~: given ~:cmd~, optional ~:timeout~, returns stdout, stderr, and exit code.
|
||||
10. ~eval-form~: given ~:code~ (Lisp expression string), returns evaluated result. Disables ~*read-eval*~.
|
||||
11. ~run-tests~: given optional ~:test-name~, runs specific test or all suites via ~fiveam:run-all-tests~.
|
||||
12. ~org-find-headline~: given ~:id~ or ~:title~, searches ~*memory-store*~ for matching memory objects.
|
||||
13. ~org-modify-file~: given ~:filepath~, ~:old-text~, ~:new-text~, performs exact-string replacement. Returns error if text not found.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun tools-write-file (filepath content)
|
||||
"Write string CONTENT to FILEPATH, creating parent directories."
|
||||
(uiop:ensure-all-directories-exist (list filepath))
|
||||
(with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
|
||||
(write-string content stream)))
|
||||
#+end_src
|
||||
|
||||
** Tool: search-files
|
||||
|
||||
Searches file contents recursively under a directory using regex pattern matching.
|
||||
|
||||
#+begin_src lisp
|
||||
(def-cognitive-tool search-files
|
||||
"Search file contents under a directory for a regex pattern."
|
||||
((: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"))
|
||||
:guard nil
|
||||
:body (lambda (args)
|
||||
(block nil
|
||||
(let* ((pattern (getf args :pattern))
|
||||
(path (getf args :path))
|
||||
(include (getf args :include))
|
||||
(results nil))
|
||||
(unless (and pattern path)
|
||||
(return (list :status :error :message "search-files requires :pattern and :path")))
|
||||
(handler-case
|
||||
(dolist (file (directory (merge-pathnames
|
||||
(if include
|
||||
(make-pathname :name :wild :type (subseq include 2) :defaults path)
|
||||
(make-pathname :name :wild :type :wild :defaults path))
|
||||
path)))
|
||||
(let ((base (file-namestring file)))
|
||||
(with-open-file (stream file :direction :input :if-does-not-exist nil)
|
||||
(when stream
|
||||
(loop for line = (read-line stream nil nil)
|
||||
for line-num from 1
|
||||
while line
|
||||
when (cl-ppcre:scan pattern line)
|
||||
do (push (format nil "~a:~d: ~a" base line-num (string-trim '(#\Space #\Tab) line))
|
||||
results))))))
|
||||
(t (c) (return (list :status :error :message (format nil "~a" c)))))
|
||||
(list :status :success
|
||||
:content (if results
|
||||
(format nil "~d matches:~%~a" (length results)
|
||||
(format nil "~{~a~^~%~}" (reverse results)))
|
||||
(format nil "No matches for '~a' in ~a" pattern path)))))))
|
||||
#+end_src
|
||||
|
||||
** Tool: find-files
|
||||
|
||||
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")
|
||||
(:name "path" :description "Directory to search in." :type "string"))
|
||||
:guard nil
|
||||
:body (lambda (args)
|
||||
(block nil
|
||||
(let* ((pattern (getf args :pattern))
|
||||
(path (getf args :path)))
|
||||
(unless (and pattern path)
|
||||
(return (list :status :error :message "find-files requires :pattern and :path")))
|
||||
(let ((full (merge-pathnames pattern path)))
|
||||
(handler-case
|
||||
(let ((files (directory full)))
|
||||
(list :status :success
|
||||
:content (if files
|
||||
(format nil "~d files:~%~{~a~^~%~}" (length files) files)
|
||||
(format nil "No files matching '~a' in ~a" pattern path))))
|
||||
(t (c) (list :status :error :message (format nil "~a" c)))))))))
|
||||
#+end_src
|
||||
|
||||
** Tool: read-file
|
||||
|
||||
Reads a file into a string. Supports optional ~:start~ and ~:limit~ for partial reads.
|
||||
|
||||
#+begin_src lisp
|
||||
(def-cognitive-tool read-file
|
||||
"Read the contents of a file."
|
||||
((: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"))
|
||||
:guard (lambda (args) (declare (ignore args)) nil)
|
||||
:body (lambda (args)
|
||||
(block nil
|
||||
(let* ((filepath (getf args :filepath))
|
||||
(start (getf args :start))
|
||||
(limit (getf args :limit)))
|
||||
(unless filepath
|
||||
(return (list :status :error :message "read-file requires :filepath")))
|
||||
(handler-case
|
||||
(let ((content (uiop:read-file-string filepath)))
|
||||
(if (or start limit)
|
||||
(let* ((lines (uiop:split-string content :separator '(#\Newline)))
|
||||
(start-idx (max 0 (1- (or start 1))))
|
||||
(end (if limit (min (length lines) (+ start-idx limit)) (length lines)))
|
||||
(selected (subseq lines start-idx end)))
|
||||
(list :status :success
|
||||
:content (format nil "~{~a~^~%~}" selected)))
|
||||
(list :status :success :content content)))
|
||||
(error (c) (list :status :error :message (format nil "~a" c))))))))
|
||||
#+end_src
|
||||
|
||||
** Tool: write-file
|
||||
|
||||
Writes string content to a file, creating parent directories as needed.
|
||||
|
||||
#+begin_src lisp
|
||||
(def-cognitive-tool write-file
|
||||
"Write string content to a file. Created directories as needed."
|
||||
((:name "filepath" :description "Path to the file to write." :type "string")
|
||||
(:name "content" :description "The text content to write." :type "string"))
|
||||
:guard nil
|
||||
:body (lambda (args)
|
||||
(block nil
|
||||
(let* ((filepath (getf args :filepath))
|
||||
(content (getf args :content)))
|
||||
(unless (and filepath content)
|
||||
(return (list :status :error :message "write-file requires :filepath and :content")))
|
||||
(handler-case
|
||||
(progn
|
||||
(tools-write-file filepath content)
|
||||
(list :status :success
|
||||
:content (format nil "Written ~d bytes to ~a" (length content) filepath)))
|
||||
(error (c) (list :status :error :message (format nil "~a" c))))))))
|
||||
#+end_src
|
||||
|
||||
** Tool: list-directory
|
||||
|
||||
Lists the contents of a directory, optionally filtered by a glob pattern.
|
||||
|
||||
#+begin_src lisp
|
||||
(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
|
||||
:body (lambda (args)
|
||||
(block nil
|
||||
(let* ((path (getf args :path))
|
||||
(pattern (getf args :pattern)))
|
||||
(unless path
|
||||
(return (list :status :error :message "list-directory requires :path")))
|
||||
(let ((full-pattern (if pattern
|
||||
(merge-pathnames pattern path)
|
||||
(make-pathname :name :wild :type :wild :defaults path))))
|
||||
(handler-case
|
||||
(let ((entries (directory full-pattern)))
|
||||
(list :status :success
|
||||
:content (if entries
|
||||
(format nil "~d entries in ~a:~%~{~a~^~%~}" (length entries) path entries)
|
||||
(format nil "No entries in ~a" path))))
|
||||
(t (c) (list :status :error :message (format nil "~a" c)))))))))
|
||||
#+end_src
|
||||
|
||||
** Tool: run-shell
|
||||
|
||||
Executes a shell command and returns stdout, stderr, and exit code.
|
||||
|
||||
#+begin_src lisp
|
||||
(def-cognitive-tool run-shell
|
||||
"Execute a shell command and return stdout, stderr, and exit code."
|
||||
((:name "cmd" :description "The shell command to execute." :type "string")
|
||||
(:name "timeout" :description "Optional timeout in seconds (default 30)." :type "integer"))
|
||||
:guard nil
|
||||
:body (lambda (args)
|
||||
(block nil
|
||||
(let* ((cmd (getf args :cmd))
|
||||
(timeout (or (getf args :timeout) 30)))
|
||||
(unless cmd
|
||||
(return (list :status :error :message "run-shell requires :cmd")))
|
||||
(handler-case
|
||||
(multiple-value-bind (out err code)
|
||||
(uiop:run-program (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd)
|
||||
:output :string :error-output :string
|
||||
:ignore-error-status t)
|
||||
(list :status :success
|
||||
:content (format nil "~a~@[~%~%stderr:~%~a~]~%exit: ~d"
|
||||
(or out "") (when (and err (> (length err) 0)) err) code)))
|
||||
(error (c) (list :status :error :message (format nil "~a" c))))))))
|
||||
#+end_src
|
||||
|
||||
** Tool: eval-form
|
||||
|
||||
Evaluates a Lisp expression in the running image. Binds ~*read-eval*~ to nil for safety.
|
||||
|
||||
#+begin_src lisp
|
||||
(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"))
|
||||
:guard nil
|
||||
:body (lambda (args)
|
||||
(block nil
|
||||
(let* ((code (getf args :code)))
|
||||
(unless code
|
||||
(return (list :status :error :message "eval-form requires :code")))
|
||||
(handler-case
|
||||
(let* ((*read-eval* nil)
|
||||
(form (read-from-string code))
|
||||
(result (eval form)))
|
||||
(list :status :success :content (format nil "~a" result)))
|
||||
(error (c) (list :status :error :message (format nil "~a" c))))))))
|
||||
#+end_src
|
||||
|
||||
** Tool: run-tests
|
||||
|
||||
Runs FiveAM test suites. Without arguments, runs all tests via ~fiveam:run-all-tests~.
|
||||
|
||||
#+begin_src lisp
|
||||
(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"))
|
||||
:guard nil
|
||||
:body (lambda (args)
|
||||
(block nil
|
||||
(let* ((test-name (getf args :test-name)))
|
||||
(handler-case
|
||||
(if test-name
|
||||
(let* ((sym (find-symbol (string-upcase test-name) :passepartout))
|
||||
(result (when sym (fiveam:run (intern (string-upcase test-name) :passepartout)))))
|
||||
(list :status :success
|
||||
:content (format nil "Test '~a' ~a" test-name
|
||||
(if result "completed" "not found"))))
|
||||
(let ((result (fiveam:run-all-tests)))
|
||||
(list :status :success :content (format nil "~a" result))))
|
||||
(error (c) (list :status :error :message (format nil "~a" c))))))))
|
||||
#+end_src
|
||||
|
||||
** Tool: org-find-headline
|
||||
|
||||
Finds Org headlines in the memory store by ID property or title substring match.
|
||||
|
||||
#+begin_src lisp
|
||||
(def-cognitive-tool org-find-headline
|
||||
"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"))
|
||||
:guard nil
|
||||
:body (lambda (args)
|
||||
(block nil
|
||||
(let* ((id (getf args :id))
|
||||
(title (getf args :title))
|
||||
(results nil))
|
||||
(unless (or id title)
|
||||
(return (list :status :error :message "org-find-headline requires :id or :title")))
|
||||
(handler-case
|
||||
(let ((is-mem (find-symbol "MEMORY-OBJECT-P" :passepartout))
|
||||
(get-id (find-symbol "MEMORY-OBJECT-ID" :passepartout))
|
||||
(get-title (find-symbol "MEMORY-OBJECT-TITLE" :passepartout)))
|
||||
(unless (and is-mem get-id get-title)
|
||||
(return (list :status :error :message "Memory store not loaded")))
|
||||
(maphash (lambda (k obj)
|
||||
(declare (ignore k))
|
||||
(when (and (funcall is-mem obj)
|
||||
(or (and id (string-equal id (funcall get-id obj)))
|
||||
(and title (search title (funcall get-title obj) :test #'char-equal))))
|
||||
(push obj results)))
|
||||
*memory-store*)
|
||||
(list :status :success
|
||||
:content (if results
|
||||
(format nil "~d headlines found:~%~{~a~^~%~}"
|
||||
(length results)
|
||||
(mapcar (lambda (r) (funcall get-title r)) results))
|
||||
(format nil "No headlines matching ~a" (or id title)))))
|
||||
(error (c) (list :status :error :message (format nil "~a" c))))))))
|
||||
#+end_src
|
||||
|
||||
** Tool: org-modify-file
|
||||
|
||||
Surgical text replacement in an Org file — matches exact text and replaces it.
|
||||
|
||||
#+begin_src lisp
|
||||
(def-cognitive-tool org-modify-file
|
||||
"Replace text in an Org file via exact string match. Returns error if old-text not found."
|
||||
((:name "filepath" :description "Path to the Org file." :type "string")
|
||||
(:name "old-text" :description "Exact text to replace." :type "string")
|
||||
(:name "new-text" :description "Text to insert in its place." :type "string"))
|
||||
:guard nil
|
||||
:body (lambda (args)
|
||||
(block nil
|
||||
(let* ((filepath (getf args :filepath))
|
||||
(old-text (getf args :old-text))
|
||||
(new-text (getf args :new-text)))
|
||||
(unless (and filepath old-text new-text)
|
||||
(return (list :status :error :message "org-modify-file requires :filepath, :old-text, and :new-text")))
|
||||
(handler-case
|
||||
(let ((content (uiop:read-file-string filepath)))
|
||||
(let ((pos (search old-text content)))
|
||||
(if pos
|
||||
(let ((new-content (concatenate 'string
|
||||
(subseq content 0 pos)
|
||||
new-text
|
||||
(subseq content (+ pos (length old-text))))))
|
||||
(tools-write-file filepath new-content)
|
||||
(list :status :success
|
||||
:content (format nil "Replaced at position ~d in ~a" pos filepath)))
|
||||
(list :status :error :message (format nil "Text not found in ~a" filepath)))))
|
||||
(error (c) (list :status :error :message (format nil "~a" c))))))))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
|
||||
#+begin_src lisp
|
||||
(defskill :passepartout-programming-tools
|
||||
:priority 50
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil)
|
||||
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
|
||||
#+end_src
|
||||
|
||||
* Test Suite
|
||||
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-programming-tools-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:programming-tools-suite))
|
||||
|
||||
(in-package :passepartout-programming-tools-tests)
|
||||
|
||||
(def-suite programming-tools-suite :description "Verification of programming cognitive tools")
|
||||
(in-suite programming-tools-suite)
|
||||
|
||||
(defun tools-tmpdir ()
|
||||
(let ((d (merge-pathnames "tmp/passepartout-tool-tests/" (user-homedir-pathname))))
|
||||
(uiop:ensure-all-directories-exist (list d))
|
||||
d))
|
||||
|
||||
(defun tools-cleanup ()
|
||||
(let ((d (tools-tmpdir)))
|
||||
(uiop:delete-directory-tree d :validate t :if-does-not-exist :ignore)))
|
||||
|
||||
(defun tools-write-file (filepath content)
|
||||
(uiop:ensure-all-directories-exist (list filepath))
|
||||
(with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
|
||||
(write-string content stream)))
|
||||
|
||||
(defun call-tool (tool-name &rest args)
|
||||
(let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
|
||||
(unless tool (error "Tool ~a not found" tool-name))
|
||||
(funcall (cognitive-tool-body tool) args)))
|
||||
|
||||
;; search-files
|
||||
(test test-search-files-finds-matches
|
||||
"Contract 1: search-files finds lines matching a regex pattern."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file-a (merge-pathnames "src-a.lisp" dir))
|
||||
(file-b (merge-pathnames "src-b.lisp" dir)))
|
||||
(tools-write-file file-a "(defun foo () 'hello)")
|
||||
(tools-write-file file-b "(defun bar () 'world)")
|
||||
(let ((result (call-tool 'search-files :pattern "defun" :path (namestring dir) :include "*.lisp")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "src-a.lisp:1:" (getf result :content)))
|
||||
(is (search "src-b.lisp:1:" (getf result :content))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-search-files-missing-params
|
||||
"search-files returns error when required params are missing."
|
||||
(let ((result (call-tool 'search-files :pattern "x")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; find-files
|
||||
(test test-find-files-by-extension
|
||||
"Contract 5: find-files returns files matching a glob."
|
||||
(let ((dir (tools-tmpdir)))
|
||||
(tools-write-file (merge-pathnames "a.lisp" dir) "test")
|
||||
(tools-write-file (merge-pathnames "b.lisp" dir) "test")
|
||||
(tools-write-file (merge-pathnames "c.org" dir) "test")
|
||||
(let ((result (call-tool 'find-files :pattern "*.lisp" :path (namestring dir))))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "a.lisp" (getf result :content)))
|
||||
(is (search "b.lisp" (getf result :content)))
|
||||
(is (not (search "c.org" (getf result :content)))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-find-files-missing-params
|
||||
"find-files returns error without required params."
|
||||
(let ((result (call-tool 'find-files :pattern "*.lisp")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; read-file
|
||||
(test test-read-file-full
|
||||
"Contract 6: read-file returns full file contents."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "readme.txt" dir)))
|
||||
(tools-write-file file (format nil "line one~%line two~%line three"))
|
||||
(let ((result (call-tool 'read-file :filepath (namestring file))))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "line one" (getf result :content))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-read-file-missing-params
|
||||
"read-file returns error without :filepath."
|
||||
(let ((result (call-tool 'read-file)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; write-file
|
||||
(test test-write-file-creates
|
||||
"Contract 7: write-file creates file with content."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "output.txt" dir)))
|
||||
(let ((result (call-tool 'write-file :filepath (namestring file) :content "hello world")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "11 bytes" (getf result :content))))
|
||||
(is (string-equal "hello world" (uiop:read-file-string file)))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-write-file-missing-params
|
||||
"write-file returns error without required params."
|
||||
(let ((result (call-tool 'write-file :content "x")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; list-directory
|
||||
(test test-list-directory-all
|
||||
"Contract 8: list-directory returns all entries."
|
||||
(let ((dir (tools-tmpdir)))
|
||||
(tools-write-file (merge-pathnames "alpha.txt" dir) "x")
|
||||
(tools-write-file (merge-pathnames "beta.txt" dir) "y")
|
||||
(let ((result (call-tool 'list-directory :path (namestring dir))))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "alpha.txt" (getf result :content)))
|
||||
(is (search "beta.txt" (getf result :content))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-list-directory-missing-params
|
||||
"list-directory returns error without :path."
|
||||
(let ((result (call-tool 'list-directory)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; run-shell
|
||||
(test test-run-shell-echo
|
||||
"Contract 9: run-shell executes a command and returns output."
|
||||
(let ((result (call-tool 'run-shell :cmd "echo hello")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "hello" (getf result :content)))))
|
||||
|
||||
(test test-run-shell-missing-params
|
||||
"run-shell returns error without :cmd."
|
||||
(let ((result (call-tool 'run-shell)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; eval-form
|
||||
(test test-eval-form-arithmetic
|
||||
"Contract 10: eval-form evaluates a Lisp expression."
|
||||
(let ((result (call-tool 'eval-form :code "(+ 1 2)")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "3" (getf result :content)))))
|
||||
|
||||
(test test-eval-form-missing-params
|
||||
"eval-form returns error without :code."
|
||||
(let ((result (call-tool 'eval-form)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; org-modify-file
|
||||
(test test-org-modify-file-replace
|
||||
"Contract 13: org-modify-file replaces exact text in file."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "doc.org" dir)))
|
||||
(tools-write-file file "* TODO Buy milk~%* DONE Walk dog~%")
|
||||
(let ((result (call-tool 'org-modify-file
|
||||
:filepath (namestring file)
|
||||
:old-text "TODO" :new-text "WAITING")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "WAITING" (uiop:read-file-string file))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-org-modify-file-not-found
|
||||
"org-modify-file returns error when text not in file."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "file.org" dir)))
|
||||
(tools-write-file file "some content")
|
||||
(let ((result (call-tool 'org-modify-file
|
||||
:filepath (namestring file)
|
||||
:old-text "not-in-file" :new-text "anything")))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (search "not found" (getf result :message))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-org-modify-file-missing-params
|
||||
"org-modify-file returns error without required params."
|
||||
(let ((result (call-tool 'org-modify-file :filepath "x" :old-text "y")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
#+end_src
|
||||
@@ -9,16 +9,19 @@ The Dispatcher is the physical security layer of Passepartout. While the Policy
|
||||
|
||||
Every action that reaches the Dispatcher has already been approved by the Reasoning pipeline. The LLM generated it, the deterministic gates verified it, and the Act stage is about to execute it. The Dispatcher is the last gate before the action touches the physical world.
|
||||
|
||||
The Dispatcher inspects nine vectors:
|
||||
1. **REPL verification** — warns if a defun is written without REPL prototyping
|
||||
The Dispatcher runs ten blocking checks (eleven including the warn-only REPL lint):
|
||||
|
||||
1. **REPL verification** — warns if a ~defun~ is written without REPL prototyping (warn only, doesn't block)
|
||||
2. **Lisp syntax** — blocks writes with unbalanced parens
|
||||
3. **Secret paths** — blocks reads to ~.env~, SSH keys, PEM files, etc.
|
||||
4. **Content exposure** — scans for API keys, PGP blocks, tokens
|
||||
5. **Vault secrets** — matches against stored credentials
|
||||
6. **Privacy tags** — blocks ~@personal~ tagged content
|
||||
7. **Privacy text** — warns if text references privacy tag names
|
||||
8. **Shell safety** — blocks destructive commands and injection patterns
|
||||
9. **Network exfil** — blocks unwhitelisted outbound connections
|
||||
4. **Self-build safety** — blocks writes to ~core-*~ files unless HITL approved (active when ~SELF_BUILD_MODE=true~)
|
||||
5. **Content exposure** — scans for API keys, PGP blocks, tokens
|
||||
6. **Vault secrets** — matches against stored credentials
|
||||
7. **Privacy tags** — blocks ~@personal~ tagged content
|
||||
8. **Privacy text** — warns if text references privacy tag names
|
||||
9. **Shell safety** — blocks destructive commands and injection patterns
|
||||
10. **Network exfil** — blocks unwhitelisted outbound connections
|
||||
11. **High-impact approval** — requires HITL for ~:shell~, ~:system :eval~, and ~:emacs :eval~
|
||||
|
||||
The Dispatcher also handles the **Flight Plan** system: when a high-risk action is blocked, it creates a Flight Plan node in the Org files that the user can manually approve.
|
||||
|
||||
@@ -357,8 +360,9 @@ Returns a list of matched pattern names or nil if safe."
|
||||
#+begin_src lisp
|
||||
(defun dispatcher-check (action context)
|
||||
"Security gate for high-risk actions.
|
||||
Vectors: lisp validation, secret path, secret content, vault secrets,
|
||||
privacy tags, privacy text, shell safety, network exfil, high-impact approval."
|
||||
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))
|
||||
(payload (proto-get action :payload))
|
||||
|
||||
@@ -8,7 +8,7 @@
|
||||
Every cognitive tool (file read, file write, shell execute, etc.) has a permission level: ~:allow~ (executed without asking), ~:ask~ (user is prompted before execution), or ~:deny~ (blocked entirely). Tool Permissions maintains the registry of these levels and provides the ~permission-gate-check~ that the Dispatcher calls before dispatching a tool action.
|
||||
|
||||
The complexity lives in the Dispatcher (security-dispatcher.org), which
|
||||
consults this table as one of its nine scan vectors.
|
||||
consults this table as one of its ten scan vectors.
|
||||
|
||||
** Contract
|
||||
|
||||
|
||||
Reference in New Issue
Block a user