feat(v0.2.0): finalize autonomous self-editing foundation
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
- Hardened actuators: Fixed path-traversal vulnerabilities in file I/O tools and blocked .org files from regex replacements to force AST usage. Enforced Merkle snapshots on AST edits. - Implemented Reflection Loops: Injected rejection traces from deterministic gates back into the LLM context to enable autonomous self-correction. - Finalized tool permission tiers (ask/allow/deny) with proper LLM prompt filtering.
This commit is contained in:
@@ -224,4 +224,57 @@ Centralized logging function. It simultaneously writes to standard output and th
|
|||||||
(setq *system-logs* (subseq *system-logs* 0 *max-log-history*))))
|
(setq *system-logs* (subseq *system-logs* 0 *max-log-history*))))
|
||||||
(format t "~a~%" formatted-msg)
|
(format t "~a~%" formatted-msg)
|
||||||
(finish-output)))
|
(finish-output)))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
* Global Test Runner
|
||||||
|
#+begin_src lisp :tangle (expand-file-name "tests/run-all-tests.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
|
||||||
|
(load "~/quicklisp/setup.lisp")
|
||||||
|
|
||||||
|
(push #p"./" asdf:*central-registry*)
|
||||||
|
|
||||||
|
(ql:quickload '(:usocket :bordeaux-threads :cl-postgres :split-sequence
|
||||||
|
:dexador :jonathan :cl-dotenv :hunchentoot
|
||||||
|
:trivial-garbage :s-sql :str :uuid :cl-json :uiop :fiveam))
|
||||||
|
|
||||||
|
(asdf:load-system :opencortex)
|
||||||
|
(asdf:load-system :opencortex/tests)
|
||||||
|
|
||||||
|
(format t "~%=== Running ALL Test Suites ===~%")
|
||||||
|
|
||||||
|
;; Engineering Standards tests
|
||||||
|
(when (find-package :OPENCORTEX-ENGINEERING-STANDARDS-TESTS)
|
||||||
|
(fiveam:run! 'OPENCORTEX-ENGINEERING-STANDARDS-TESTS::ENGINEERING-STANDARDS-SUITE))
|
||||||
|
|
||||||
|
;; Literate Programming tests
|
||||||
|
(when (find-package :OPENCORTEX-LITERATE-PROGRAMMING-TESTS)
|
||||||
|
(fiveam:run! 'OPENCORTEX-LITERATE-PROGRAMMING-TESTS::LITERATE-PROGRAMMING-SUITE))
|
||||||
|
|
||||||
|
;; Communication tests
|
||||||
|
(when (find-package :OPENCORTEX-TESTS)
|
||||||
|
(fiveam:run! 'OPENCORTEX-TESTS::COMMUNICATION-PROTOCOL-SUITE))
|
||||||
|
|
||||||
|
;; Pipeline tests
|
||||||
|
(when (find-package :OPENCORTEX-PIPELINE-TESTS)
|
||||||
|
(fiveam:run! 'OPENCORTEX-PIPELINE-TESTS::PIPELINE-SUITE))
|
||||||
|
|
||||||
|
;; Boot sequence tests
|
||||||
|
(when (find-package :OPENCORTEX-BOOT-TESTS)
|
||||||
|
(fiveam:run! 'OPENCORTEX-BOOT-TESTS::BOOT-SUITE))
|
||||||
|
|
||||||
|
;; Memory tests
|
||||||
|
(when (find-package :OPENCORTEX-MEMORY-TESTS)
|
||||||
|
(fiveam:run! 'OPENCORTEX-MEMORY-TESTS::MEMORY-SUITE))
|
||||||
|
|
||||||
|
;; Immune system tests
|
||||||
|
(when (find-package :OPENCORTEX-IMMUNE-SYSTEM-TESTS)
|
||||||
|
(fiveam:run! 'OPENCORTEX-IMMUNE-SYSTEM-TESTS::IMMUNE-SUITE))
|
||||||
|
|
||||||
|
;; Emacs edit tests
|
||||||
|
(when (find-package :OPENCORTEX-EMACS-EDIT-TESTS)
|
||||||
|
(fiveam:run! 'OPENCORTEX-EMACS-EDIT-TESTS::EMACS-EDIT-SUITE))
|
||||||
|
|
||||||
|
;; Lisp utils tests
|
||||||
|
(when (find-package :OPENCORTEX-LISP-UTILS-TESTS)
|
||||||
|
(fiveam:run! 'OPENCORTEX-LISP-UTILS-TESTS::LISP-UTILS-SUITE))
|
||||||
|
|
||||||
|
(format t "~%=== ALL TESTS COMPLETE ===~%")
|
||||||
|
#+end_src
|
||||||
|
|||||||
@@ -199,7 +199,8 @@ The `think` function is the heart of the probabilistic engine. It constructs a p
|
|||||||
(tool-belt (generate-tool-belt-prompt))
|
(tool-belt (generate-tool-belt-prompt))
|
||||||
(global-context (context-assemble-global-awareness))
|
(global-context (context-assemble-global-awareness))
|
||||||
(system-logs (context-get-system-logs))
|
(system-logs (context-get-system-logs))
|
||||||
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent")))
|
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent"))
|
||||||
|
(rejection-trace (proto-get (proto-get context :payload) :rejection-trace)))
|
||||||
|
|
||||||
;; Generate prompt from skill or raw text
|
;; Generate prompt from skill or raw text
|
||||||
(let* ((prompt-generator (when active-skill
|
(let* ((prompt-generator (when active-skill
|
||||||
@@ -211,8 +212,14 @@ The `think` function is the heart of the probabilistic engine. It constructs a p
|
|||||||
(if (and p (stringp p))
|
(if (and p (stringp p))
|
||||||
p
|
p
|
||||||
"Maintain metabolic stasis."))))
|
"Maintain metabolic stasis."))))
|
||||||
|
|
||||||
|
;; Inject Reflection Loop feedback if a previous proposal was rejected
|
||||||
|
(reflection-feedback (if rejection-trace
|
||||||
|
(format nil "~%~%PREVIOUS PROPOSAL REJECTED:~%Your previous proposal was rejected by the deterministic safety gates.~%Rejection Trace: ~a~%You MUST fix the syntax or logic error described above and try again." rejection-trace)
|
||||||
|
""))
|
||||||
|
|
||||||
(system-prompt (format nil
|
(system-prompt (format nil
|
||||||
"IDENTITY: ~a
|
"IDENTITY: ~a~a
|
||||||
|
|
||||||
You are a component of the OpenCortex neurosymbolic AI agent.
|
You are a component of the OpenCortex neurosymbolic AI agent.
|
||||||
Your task is to generate exactly ONE valid Lisp plist response.
|
Your task is to generate exactly ONE valid Lisp plist response.
|
||||||
@@ -243,6 +250,7 @@ GLOBAL CONTEXT:
|
|||||||
RECENT LOGS:
|
RECENT LOGS:
|
||||||
~a"
|
~a"
|
||||||
assistant-name
|
assistant-name
|
||||||
|
reflection-feedback
|
||||||
tool-belt
|
tool-belt
|
||||||
global-context
|
global-context
|
||||||
system-logs)))
|
system-logs)))
|
||||||
@@ -417,30 +425,45 @@ The deterministic engine runs all registered skills' verification functions. Thi
|
|||||||
(member sensor '(:user-input :chat-message)))
|
(member sensor '(:user-input :chat-message)))
|
||||||
(return-from reason-gate signal))
|
(return-from reason-gate signal))
|
||||||
|
|
||||||
;; Generate proposal via LLM
|
;; Reflection Loop: Retry up to 3 times if deterministic gates reject
|
||||||
(let ((candidate (think signal)))
|
(let ((retries 3)
|
||||||
|
(current-signal (copy-tree signal))
|
||||||
|
(last-rejection nil))
|
||||||
|
(loop
|
||||||
|
(when (<= retries 0)
|
||||||
|
(harness-log "REASON: Reflection loop exhausted. Final rejection.")
|
||||||
|
(setf (getf signal :approved-action) last-rejection)
|
||||||
|
(setf (getf signal :status) :reasoned)
|
||||||
|
(return signal))
|
||||||
|
|
||||||
(harness-log "REASON: candidate type = ~a" (type-of candidate))
|
(when last-rejection
|
||||||
|
(setf (getf (getf current-signal :payload) :rejection-trace) last-rejection))
|
||||||
|
|
||||||
;; Validate candidate is a proper plist (not an error string or symbol)
|
(let ((candidate (think current-signal)))
|
||||||
(if (and candidate
|
(harness-log "REASON: candidate type = ~a" (type-of candidate))
|
||||||
(listp candidate)
|
|
||||||
(or (keywordp (car candidate))
|
|
||||||
(eq (car candidate) 'TYPE)
|
|
||||||
(eq (car candidate) 'type)))
|
|
||||||
|
|
||||||
;; Valid proposal - run through deterministic verification
|
(if (and candidate
|
||||||
(setf (getf signal :approved-action)
|
(listp candidate)
|
||||||
(deterministic-verify candidate signal))
|
(or (keywordp (car candidate))
|
||||||
|
(eq (car candidate) 'TYPE)
|
||||||
|
(eq (car candidate) 'type)))
|
||||||
|
|
||||||
;; Invalid response - log and drop
|
(let ((verified (deterministic-verify candidate current-signal)))
|
||||||
(progn
|
(if (member (getf verified :type) '(:LOG :EVENT :log :event))
|
||||||
(harness-log "REASON: Invalid candidate type ~a, dropping"
|
(progn
|
||||||
(type-of candidate))
|
(harness-log "REASON: Proposal rejected by gate. Retrying (~a left)." (1- retries))
|
||||||
(setf (getf signal :approved-action) nil)))
|
(decf retries)
|
||||||
|
(setf last-rejection verified))
|
||||||
|
(progn
|
||||||
|
(setf (getf signal :approved-action) verified)
|
||||||
|
(setf (getf signal :status) :reasoned)
|
||||||
|
(return signal))))
|
||||||
|
|
||||||
(setf (getf signal :status) :reasoned)
|
(progn
|
||||||
signal)))
|
(harness-log "REASON: Invalid candidate type ~a, dropping" (type-of candidate))
|
||||||
|
(setf (getf signal :approved-action) nil)
|
||||||
|
(setf (getf signal :status) :reasoned)
|
||||||
|
(return signal))))))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Test Suite
|
* Test Suite
|
||||||
|
|||||||
@@ -363,11 +363,13 @@ EXAMPLES:
|
|||||||
---
|
---
|
||||||
" )))
|
" )))
|
||||||
(maphash (lambda (name tool)
|
(maphash (lambda (name tool)
|
||||||
(setf output (concatenate 'string output
|
(let ((perm (ignore-errors (uiop:symbol-call :opencortex.skills.org-skill-tool-permissions :get-tool-permission name))))
|
||||||
(format nil "- ~a: ~a~% Parameters: ~s~%~%"
|
(unless (eq perm :deny)
|
||||||
name
|
(setf output (concatenate 'string output
|
||||||
(cognitive-tool-description tool)
|
(format nil "- ~a: ~a~% Parameters: ~s~%~%"
|
||||||
(cognitive-tool-parameters tool)))))
|
name
|
||||||
|
(cognitive-tool-description tool)
|
||||||
|
(cognitive-tool-parameters tool)))))))
|
||||||
*cognitive-tools*)
|
*cognitive-tools*)
|
||||||
output))
|
output))
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -462,9 +464,9 @@ EXAMPLES:
|
|||||||
(declare (ignore context))
|
(declare (ignore context))
|
||||||
(let* ((file (getf args :file))
|
(let* ((file (getf args :file))
|
||||||
(memex-root (or (uiop:getenv "MEMEX_DIR") "/home/user/memex"))
|
(memex-root (or (uiop:getenv "MEMEX_DIR") "/home/user/memex"))
|
||||||
(truename (ignore-errors (namestring (truename file)))))
|
(abs-path (namestring (uiop:ensure-absolute-pathname file (uiop:getcwd)))))
|
||||||
(or (null truename)
|
(and (str:starts-with-p memex-root abs-path)
|
||||||
(str:starts-with-p memex-root truename))))
|
(not (search ".." abs-path)))))
|
||||||
:body (lambda (args)
|
:body (lambda (args)
|
||||||
(let ((file (getf args :file)))
|
(let ((file (getf args :file)))
|
||||||
(handler-case
|
(handler-case
|
||||||
@@ -483,9 +485,10 @@ EXAMPLES:
|
|||||||
(declare (ignore context))
|
(declare (ignore context))
|
||||||
(let* ((file (getf args :file))
|
(let* ((file (getf args :file))
|
||||||
(memex-root (or (uiop:getenv "MEMEX_DIR") "/home/user/memex"))
|
(memex-root (or (uiop:getenv "MEMEX_DIR") "/home/user/memex"))
|
||||||
(truename (ignore-errors (namestring (truename file)))))
|
(abs-path (namestring (uiop:ensure-absolute-pathname file (uiop:getcwd)))))
|
||||||
(or (null truename)
|
(and (str:starts-with-p memex-root abs-path)
|
||||||
(str:starts-with-p memex-root truename))))
|
(not (search ".." abs-path))
|
||||||
|
(not (str:ends-with-p ".org" abs-path))))) ;; Force AST tools for .org files
|
||||||
:body (lambda (args)
|
:body (lambda (args)
|
||||||
(let ((file (getf args :file))
|
(let ((file (getf args :file))
|
||||||
(content (getf args :content))
|
(content (getf args :content))
|
||||||
@@ -515,9 +518,10 @@ EXAMPLES:
|
|||||||
(declare (ignore context))
|
(declare (ignore context))
|
||||||
(let* ((file (getf args :file))
|
(let* ((file (getf args :file))
|
||||||
(memex-root (or (uiop:getenv "MEMEX_DIR") "/home/user/memex"))
|
(memex-root (or (uiop:getenv "MEMEX_DIR") "/home/user/memex"))
|
||||||
(truename (ignore-errors (namestring (truename file)))))
|
(abs-path (namestring (uiop:ensure-absolute-pathname file (uiop:getcwd)))))
|
||||||
(or (null truename)
|
(and (str:starts-with-p memex-root abs-path)
|
||||||
(str:starts-with-p memex-root truename))))
|
(not (search ".." abs-path))
|
||||||
|
(not (str:ends-with-p ".org" abs-path))))) ;; Force AST tools for .org files
|
||||||
:body (lambda (args)
|
:body (lambda (args)
|
||||||
(let ((file (getf args :file))
|
(let ((file (getf args :file))
|
||||||
(old (getf args :old))
|
(old (getf args :old))
|
||||||
|
|||||||
@@ -184,6 +184,7 @@ Write AST back to file preserving structure.
|
|||||||
(defun emacs-edit-write-file (file-path ast)
|
(defun emacs-edit-write-file (file-path ast)
|
||||||
"Writes AST back to FILE-PATH, preserving org structure.
|
"Writes AST back to FILE-PATH, preserving org structure.
|
||||||
Clears cache after write."
|
Clears cache after write."
|
||||||
|
(opencortex::snapshot-memory)
|
||||||
(let ((org-text (emacs-edit-ast-to-org ast)))
|
(let ((org-text (emacs-edit-ast-to-org ast)))
|
||||||
(with-open-file (out file-path :direction :output :if-exists :supersede)
|
(with-open-file (out file-path :direction :output :if-exists :supersede)
|
||||||
(write-string org-text out)))
|
(write-string org-text out)))
|
||||||
|
|||||||
@@ -47,7 +47,7 @@ Tool permissions and embedding generation via multiple providers.
|
|||||||
(case perm
|
(case perm
|
||||||
(:allow :allow)
|
(:allow :allow)
|
||||||
(:deny :deny)
|
(:deny :deny)
|
||||||
(:ask (list :ask tool-name context))
|
(:ask (list :ask tool-name))
|
||||||
(t :allow))))
|
(t :allow))))
|
||||||
|
|
||||||
(def-cognitive-tool :get-embedding
|
(def-cognitive-tool :get-embedding
|
||||||
@@ -111,10 +111,22 @@ Tool permissions and embedding generation via multiple providers.
|
|||||||
|
|
||||||
(defskill :skill-tool-permissions
|
(defskill :skill-tool-permissions
|
||||||
:priority 600
|
:priority 600
|
||||||
:trigger (lambda (c) (declare (ignore c)) nil)
|
;; Trigger whenever there's a tool call
|
||||||
|
:trigger (lambda (c)
|
||||||
|
(let* ((action (getf c :candidate))
|
||||||
|
(target (getf action :target)))
|
||||||
|
(or (eq target :TOOL) (eq target :tool))))
|
||||||
:deterministic (lambda (a c)
|
:deterministic (lambda (a c)
|
||||||
(let ((tool (getf (getf a :payload) :tool)))
|
(let ((tool (getf (getf a :payload) :tool)))
|
||||||
(when tool (check-tool-permission-gate tool c)))))
|
(if tool
|
||||||
|
(let ((perm (check-tool-permission-gate tool c)))
|
||||||
|
(cond
|
||||||
|
((eq perm :deny)
|
||||||
|
(list :type :LOG :payload (list :text (format nil "Tool '~a' execution denied by permission tiers." tool))))
|
||||||
|
((and (listp perm) (eq (car perm) :ask))
|
||||||
|
(list :type :EVENT :status :suspended :reason :ask-permission :payload (list :tool tool :action a)))
|
||||||
|
(t a)))
|
||||||
|
a))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Test Suite
|
* Test Suite
|
||||||
|
|||||||
Reference in New Issue
Block a user