feat(v0.2.0): finalize autonomous self-editing foundation
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:
2026-04-27 13:44:43 -04:00
parent c8d8f1412d
commit f1be82a00b
5 changed files with 132 additions and 39 deletions

View File

@@ -225,3 +225,56 @@ Centralized logging function. It simultaneously writes to standard output and th
(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

View File

@@ -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))
(when last-rejection
(setf (getf (getf current-signal :payload) :rejection-trace) last-rejection))
(let ((candidate (think current-signal)))
(harness-log "REASON: candidate type = ~a" (type-of candidate)) (harness-log "REASON: candidate type = ~a" (type-of candidate))
;; Validate candidate is a proper plist (not an error string or symbol)
(if (and candidate (if (and candidate
(listp candidate) (listp candidate)
(or (keywordp (car candidate)) (or (keywordp (car candidate))
(eq (car candidate) 'TYPE) (eq (car candidate) 'TYPE)
(eq (car candidate) 'type))) (eq (car candidate) 'type)))
;; Valid proposal - run through deterministic verification (let ((verified (deterministic-verify candidate current-signal)))
(setf (getf signal :approved-action) (if (member (getf verified :type) '(:LOG :EVENT :log :event))
(deterministic-verify candidate signal))
;; Invalid response - log and drop
(progn (progn
(harness-log "REASON: Invalid candidate type ~a, dropping" (harness-log "REASON: Proposal rejected by gate. Retrying (~a left)." (1- retries))
(type-of candidate)) (decf retries)
(setf (getf signal :approved-action) nil))) (setf last-rejection verified))
(progn
(setf (getf signal :approved-action) verified)
(setf (getf signal :status) :reasoned) (setf (getf signal :status) :reasoned)
signal))) (return signal))))
(progn
(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

View File

@@ -363,11 +363,13 @@ EXAMPLES:
--- ---
" ))) " )))
(maphash (lambda (name tool) (maphash (lambda (name tool)
(let ((perm (ignore-errors (uiop:symbol-call :opencortex.skills.org-skill-tool-permissions :get-tool-permission name))))
(unless (eq perm :deny)
(setf output (concatenate 'string output (setf output (concatenate 'string output
(format nil "- ~a: ~a~% Parameters: ~s~%~%" (format nil "- ~a: ~a~% Parameters: ~s~%~%"
name name
(cognitive-tool-description tool) (cognitive-tool-description tool)
(cognitive-tool-parameters 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))

View File

@@ -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)))

View File

@@ -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