amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

fix(chaos): finalized absolute tangle paths via concat and INSTALL_DIR

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-28 18:22:49 -04:00
parent a2d6c5ae38
commit 357efbdb59
35 changed files with 641 additions and 641 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
harness/act.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "harness/act.lisp" (expand-file-name "harness/")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/act.lisp")" )
#+TITLE: Stage 3: Act (act.lisp) #+TITLE: Stage 3: Act (act.lisp)
#+AUTHOR: Amr #+AUTHOR: Amr
#+FILETAGS: :harness:act: #+FILETAGS: :harness:act:
@@ -47,11 +47,11 @@ Example feedback chain:
#+begin_src lisp #+begin_src lisp
(defvar *default-actuator* :cli (defvar *default-actuator* :cli
"The actuator used when no explicit target is specified. "The actuator used when no explicit target is specified.
Override with DEFAULT_ACTUATOR environment variable.") Override with DEFAULT_ACTUATOR environment variable.
(defvar *silent-actuators* '(:cli :system-message :emacs) (defvar *silent-actuators* '(:cli :system-message :emacs)
"List of actuators that don't generate tool-output feedback. "List of actuators that don't generate tool-output feedback.
These typically have their own feedback mechanisms (CLI prints directly, etc.)") These typically have their own feedback mechanisms (CLI prints directly, etc.)
#+end_src #+end_src
** initialize-actuators: System Bootstrap ** initialize-actuators: System Bootstrap
@@ -70,20 +70,20 @@ Example feedback chain:
3. :tui - Terminal UI output via reply stream" 3. :tui - Terminal UI output via reply stream"
;; Load environment configuration ;; Load environment configuration
(let ((def (getenv "DEFAULT_ACTUATOR")) (let ((def (getenv "DEFAULT_ACTUATOR)
(silent (getenv "SILENT_ACTUATORS"))) (silent (getenv "SILENT_ACTUATORS))
;; Set default actuator ;; Set default actuator
(when def (when def
(setf *default-actuator* (setf *default-actuator*
(intern (string-upcase def) "KEYWORD"))) (intern (string-upcase def) "KEYWORD))
;; Parse silent actuators list ;; Parse silent actuators list
(when silent (when silent
(setf *silent-actuators* (setf *silent-actuators*
(mapcar (lambda (s) (mapcar (lambda (s)
(intern (string-upcase (string-trim '(#\Space) s)) (intern (string-upcase (string-trim '(#\Space) s))
"KEYWORD")) "KEYWORD)
(str:split "," silent))))) (str:split "," silent)))))
;; Register core harness actuators ;; Register core harness actuators
@@ -179,7 +179,7 @@ Example feedback chain:
(:create-skill (:create-skill
(let* ((filename (getf payload :filename)) (let* ((filename (getf payload :filename))
(content (getf payload :content)) (content (getf payload :content))
(skills-dir (merge-pathnames "skills/" (skills-dir (merge-pathnames ""
(asdf:system-source-directory :opencortex))) (asdf:system-source-directory :opencortex)))
(full-path (merge-pathnames filename skills-dir))) (full-path (merge-pathnames filename skills-dir)))
(with-open-file (out full-path (with-open-file (out full-path
@@ -273,7 +273,7 @@ Example feedback chain:
"Format a tool result for human-readable display. "Format a tool result for human-readable display.
Tools return either: Tools return either:
- A plist: (:status :success :content \"...\") or (:status :error :message \"...\") - A plist: (:status :success :content \"...\ or (:status :error :message \"...\
- A raw value (string, number, etc.) - A raw value (string, number, etc.)
This function normalizes both formats into a consistent string presentation." This function normalizes both formats into a consistent string presentation."
@@ -336,7 +336,7 @@ Example feedback chain:
;; Action was blocked by verification ;; Action was blocked by verification
(progn (progn
(harness-log "ACT BLOCKED: Action failed last-mile deterministic check.") (harness-log "ACT BLOCKED: Action failed last-mile deterministic check.
(setf (getf signal :approved-action) nil) (setf (getf signal :approved-action) nil)
(setf approved nil) (setf approved nil)
(setf feedback verified)) (setf feedback verified))
@@ -393,7 +393,7 @@ Example feedback chain:
These tests verify the Act pipeline. Run with: These tests verify the Act pipeline. Run with:
~(fiveam:run! 'pipeline-act-suite)~ ~(fiveam:run! 'pipeline-act-suite)~
#+begin_src lisp :tangle (expand-file-name "harness/pipeline-act-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle pipeline-act-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(defpackage :opencortex-pipeline-act-tests (defpackage :opencortex-pipeline-act-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:pipeline-act-suite)) (:export #:pipeline-act-suite))
@@ -401,14 +401,14 @@ These tests verify the Act pipeline. Run with:
(in-package :opencortex-pipeline-act-tests) (in-package :opencortex-pipeline-act-tests)
(def-suite pipeline-act-suite (def-suite pipeline-act-suite
:description "Test suite for Act pipeline") :description "Test suite for Act pipeline
(in-suite pipeline-act-suite) (in-suite pipeline-act-suite)
(test test-act-gate-symbolic-guard-bypass (test test-act-gate-symbolic-guard-bypass
"Verify that act-gate proceeds normally when no skill intercepts." "Verify that act-gate proceeds normally when no skill intercepts."
(clrhash opencortex::*skills-registry*) (clrhash opencortex::*skills-registry*)
(let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello")))) (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello)))
(result (opencortex:act-gate signal))) (result (opencortex:act-gate signal)))
(is (eq :acted (getf signal :status))) (is (eq :acted (getf signal :status)))
(is (null result)))) (is (null result))))
@@ -421,8 +421,8 @@ These tests verify the Act pipeline. Run with:
:trigger (lambda (ctx) (declare (ignore ctx)) t) :trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic (lambda (action ctx) :deterministic (lambda (action ctx)
(declare (ignore action ctx)) (declare (ignore action ctx))
(list :type :LOG :payload (list :text "BLOCKED BY SYMBOLIC GUARD")))) (list :type :LOG :payload (list :text "BLOCKED BY SYMBOLIC GUARD)))
(let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :shell :payload (:cmd "ls")))) (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :shell :payload (:cmd "ls)))
(result (opencortex:act-gate signal))) (result (opencortex:act-gate signal)))
(is (eq :acted (getf signal :status))) (is (eq :acted (getf signal :status)))
(is (not (null result))) (is (not (null result)))

4
harness/communication.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle communication.lisp #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/communication.lisp")
#+TITLE: Communication Protocol (communication.lisp) #+TITLE: Communication Protocol (communication.lisp)
#+AUTHOR: Amr #+AUTHOR: Amr
#+FILETAGS: :harness:protocol: #+FILETAGS: :harness:protocol:
@@ -79,7 +79,7 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
** Structural Validation (communication-validator.lisp) ** Structural Validation (communication-validator.lisp)
The validator ensures that incoming messages adhere to the strict property list schema of the communication protocol. The validator ensures that incoming messages adhere to the strict property list schema of the communication protocol.
#+begin_src lisp :tangle communication-validator.lisp #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/communication-validator.lisp")
(in-package :opencortex) (in-package :opencortex)
(defun validate-communication-protocol-schema (msg) (defun validate-communication-protocol-schema (msg)

40
harness/context.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "harness/context.lisp" (expand-file-name "harness/")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/context.lisp")" )
#+TITLE: Peripheral Vision (context.lisp) #+TITLE: Peripheral Vision (context.lisp)
#+AUTHOR: Amr #+AUTHOR: Amr
#+FILETAGS: :harness:context: #+FILETAGS: :harness:context:
@@ -66,7 +66,7 @@ Identifies headlines tagged with ~project~ that have not yet reached a terminal
#+begin_src lisp #+begin_src lisp
(defun context-get-active-projects () (defun context-get-active-projects ()
"Returns headlines tagged as 'project' that are not yet marked DONE." "Returns headlines tagged as 'project' that are not yet marked DONE."
(remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE")) (remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE)
(context-query-store :tag "project" :type :HEADLINE))) (context-query-store :tag "project" :type :HEADLINE)))
#+end_src #+end_src
@@ -100,7 +100,7 @@ Reads the raw literate Org source of a specific skill. This is a foundational ca
(defun context-get-skill-source (skill-name) (defun context-get-skill-source (skill-name)
"Reads the raw literate source of a specific skill for inspection." "Reads the raw literate source of a specific skill for inspection."
(let* ((filename (format nil "~a.org" skill-name)) (let* ((filename (format nil "~a.org" skill-name))
(skills-dir-str (or (getenv "SKILLS_DIR") (namestring (merge-pathnames "notes/" (user-homedir-pathname))))) (skills-dir-str (or (getenv "SKILLS_DIR (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
(skills-dir (uiop:ensure-directory-pathname (context-resolve-path skills-dir-str))) (skills-dir (uiop:ensure-directory-pathname (context-resolve-path skills-dir-str)))
(full-path (merge-pathnames filename skills-dir))) (full-path (merge-pathnames filename skills-dir)))
(if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil))) (if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
@@ -112,7 +112,7 @@ Retrieves the most recent entries from the harness's internal circular log buffe
#+begin_src lisp #+begin_src lisp
(defun context-get-system-logs (&optional limit) (defun context-get-system-logs (&optional limit)
"Retrieves the most recent lines from the harness's internal log." "Retrieves the most recent lines from the harness's internal log."
(let ((log-limit (or limit (ignore-errors (parse-integer (getenv "CONTEXT_LOG_LIMIT"))) 20))) (let ((log-limit (or limit (ignore-errors (parse-integer (getenv "CONTEXT_LOG_LIMIT)) 20)))
(bt:with-lock-held (*logs-lock*) (bt:with-lock-held (*logs-lock*)
(let ((count (min log-limit (length *system-logs*)))) (let ((count (min log-limit (length *system-logs*))))
(subseq *system-logs* 0 count))))) (subseq *system-logs* 0 count)))))
@@ -134,12 +134,12 @@ The semantic threshold is externalized to `CONTEXT_SEMANTIC_THRESHOLD`.
"Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model." "Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
(let* ((id (org-object-id obj)) (let* ((id (org-object-id obj))
(is-foveal (equal id foveal-id)) (is-foveal (equal id foveal-id))
(title (or (getf (org-object-attributes obj) :TITLE) "Untitled")) (title (or (getf (org-object-attributes obj) :TITLE) "Untitled)
(content (org-object-content obj)) (content (org-object-content obj))
(children (org-object-children obj)) (children (org-object-children obj))
(stars (make-string depth :initial-element #\*)) (stars (make-string depth :initial-element #\*))
(obj-vector (org-object-vector obj)) (obj-vector (org-object-vector obj))
(threshold (or semantic-threshold (ignore-errors (read-from-string (getenv "CONTEXT_SEMANTIC_THRESHOLD"))) 0.75)) (threshold (or semantic-threshold (ignore-errors (read-from-string (getenv "CONTEXT_SEMANTIC_THRESHOLD)) 0.75))
(similarity (if (and foveal-vector obj-vector (not is-foveal)) (similarity (if (and foveal-vector obj-vector (not is-foveal))
(cosine-similarity foveal-vector obj-vector) (cosine-similarity foveal-vector obj-vector)
0.0)) 0.0))
@@ -148,13 +148,13 @@ The semantic threshold is externalized to `CONTEXT_SEMANTIC_THRESHOLD`.
;; We always render the foveal node and its immediate children. ;; We always render the foveal node and its immediate children.
;; We render deeper nodes ONLY if they are semantically relevant. ;; We render deeper nodes ONLY if they are semantically relevant.
(should-render (or (<= depth 2) is-foveal is-semantically-relevant)) (should-render (or (<= depth 2) is-foveal is-semantically-relevant))
(output "")) (output
(when should-render (when should-render
(setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id)) (setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id))
(when is-semantically-relevant (when is-semantically-relevant
(setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity)))) (setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity))))
(setf output (concatenate 'string output (format nil ":END:~%"))) (setf output (concatenate 'string output (format nil ":END:~%))
;; Only include full body content if this is the Foveal focus or highly relevant ;; Only include full body content if this is the Foveal focus or highly relevant
(when (and content (or is-foveal is-semantically-relevant)) (when (and content (or is-foveal is-semantically-relevant))
@@ -204,12 +204,12 @@ The primary entry point for context generation. This function identifies active
(ignore-errors (getf (getf signal :payload) :target-id)))) (ignore-errors (getf (getf signal :payload) :target-id))))
(projects (context-get-active-projects)) (projects (context-get-active-projects))
(output "GLOBAL MEMEX AWARENESS (Peripheral Vision): (output "GLOBAL MEMEX AWARENESS (Peripheral Vision):
")) )
(if projects (if projects
(dolist (project projects) (dolist (project projects)
(setf output (concatenate 'string output (setf output (concatenate 'string output
(context-render-to-org project :foveal-id foveal-id)))) (context-render-to-org project :foveal-id foveal-id))))
(setf output (concatenate 'string output "No active projects found.~%"))) (setf output (concatenate 'string output "No active projects found.~%))
output)) output))
#+end_src #+end_src
@@ -217,32 +217,32 @@ The primary entry point for context generation. This function identifies active
Following the Engineering Standards, the peripheral vision extraction and rendering logic must be empirically verified. Following the Engineering Standards, the peripheral vision extraction and rendering logic must be empirically verified.
** Test Suite Context ** Test Suite Context
#+begin_src lisp :tangle (expand-file-name "harness/peripheral-vision-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle peripheral-vision-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(defpackage :opencortex-peripheral-vision-tests (defpackage :opencortex-peripheral-vision-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:vision-suite)) (:export #:vision-suite))
(in-package :opencortex-peripheral-vision-tests) (in-package :opencortex-peripheral-vision-tests)
(def-suite vision-suite (def-suite vision-suite
:description "Verification of Foveal-Peripheral context model.") :description "Verification of Foveal-Peripheral context model.
(in-suite vision-suite) (in-suite vision-suite)
#+end_src #+end_src
** Foveal Rendering Test ** Foveal Rendering Test
Verify that the foveal target is rendered with content, while siblings are skeletal. Verify that the foveal target is rendered with content, while siblings are skeletal.
#+begin_src lisp :tangle (expand-file-name "harness/peripheral-vision-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle peripheral-vision-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(test test-foveal-rendering (test test-foveal-rendering
"Verify that the foveal target is rendered with content, while siblings are skeletal." "Verify that the foveal target is rendered with content, while siblings are skeletal."
(clrhash opencortex::*memory*) (clrhash opencortex::*memory*)
(let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project") (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project
:contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node") :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node
:raw-content "FOVEAL CONTENT" :contents nil) :raw-content "FOVEAL CONTENT" :contents nil)
(:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node") (:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node
:raw-content "PERIPHERAL CONTENT" :contents nil))))) :raw-content "PERIPHERAL CONTENT" :contents nil)))))
(ingest-ast ast) (ingest-ast ast)
;; Test both foveal focus in signal top-level and in payload (legacy) ;; Test both foveal focus in signal top-level and in payload (legacy)
(let ((output (context-assemble-global-awareness (list :foveal-focus "node-foveal")))) (let ((output (context-assemble-global-awareness (list :foveal-focus "node-foveal)))
(is (search "FOVEAL CONTENT" output)) (is (search "FOVEAL CONTENT" output))
(is (search "* Peripheral Node" output)) (is (search "* Peripheral Node" output))
(is (not (search "PERIPHERAL CONTENT" output)))))) (is (not (search "PERIPHERAL CONTENT" output))))))
@@ -251,12 +251,12 @@ Verify that the foveal target is rendered with content, while siblings are skele
** Awareness Budget Test ** Awareness Budget Test
Verify that context-assemble-global-awareness handles multiple projects correctly. Verify that context-assemble-global-awareness handles multiple projects correctly.
#+begin_src lisp :tangle (expand-file-name "harness/peripheral-vision-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle peripheral-vision-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(test test-awareness-budget (test test-awareness-budget
"Verify that context-assemble-global-awareness handles multiple projects." "Verify that context-assemble-global-awareness handles multiple projects."
(clrhash opencortex::*memory*) (clrhash opencortex::*memory*)
(ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS "project") :contents nil)) (ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS "project :contents nil))
(ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS "project") :contents nil)) (ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS "project :contents nil))
(let ((output (context-assemble-global-awareness))) (let ((output (context-assemble-global-awareness)))
(is (search "Project 1" output)) (is (search "Project 1" output))
(is (search "Project 2" output)))) (is (search "Project 2" output))))

76
harness/doctor.org
View File

@@ -23,65 +23,65 @@ Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that mi
* Phase B: Protocol (Success Criteria) * Phase B: Protocol (Success Criteria)
** Package Context ** Package Context
#+begin_src lisp :tangle (expand-file-name "harness/doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(defpackage :opencortex-doctor-tests (defpackage :opencortex-doctor-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:doctor-suite)) (:export #:doctor-suite))
#+end_src #+end_src
#+begin_src lisp :tangle (expand-file-name "harness/doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(in-package :opencortex-doctor-tests) (in-package :opencortex-doctor-tests)
#+end_src #+end_src
#+begin_src lisp :tangle (expand-file-name "harness/doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(def-suite doctor-suite :description "Verification of the System Doctor diagnostic logic") (def-suite doctor-suite :description "Verification of the System Doctor diagnostic logic
#+end_src #+end_src
#+begin_src lisp :tangle (expand-file-name "harness/doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(in-suite doctor-suite) (in-suite doctor-suite)
#+end_src #+end_src
** Dependency Tests ** Dependency Tests
#+begin_src lisp :tangle (expand-file-name "harness/doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(test test-dependency-check-fail (test test-dependency-check-fail
"Verify that missing binaries are correctly identified as failures." "Verify that missing binaries are correctly identified as failures."
(let ((opencortex::*doctor-required-binaries* '("non-existent-binary-123"))) (let ((opencortex::*doctor-required-binaries* '("non-existent-binary-123))
(is (null (opencortex:doctor-check-dependencies))))) (is (null (opencortex:doctor-check-dependencies)))))
#+end_src #+end_src
** Environment Tests ** Environment Tests
#+begin_src lisp :tangle (expand-file-name "harness/doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(test test-env-validation-fail (test test-env-validation-fail
"Verify that an invalid MEMEX_DIR triggers a critical failure." "Verify that an invalid MEMEX_DIR triggers a critical failure."
(let ((old-m (getenv "MEMEX_DIR")) (let ((old-m (getenv "MEMEX_DIR)
(old-s (getenv "SKILLS_DIR"))) (old-s (getenv "SKILLS_DIR))
(unwind-protect (unwind-protect
(progn (progn
(setf (getenv "MEMEX_DIR") "/non/existent/path/999") (setf (getenv "MEMEX_DIR "/non/existent/path/999
(is (null (opencortex:doctor-check-env)))) (is (null (opencortex:doctor-check-env))))
(setf (getenv "MEMEX_DIR") (or old-m "")) (setf (getenv "MEMEX_DIR (or old-m
(setf (getenv "SKILLS_DIR") (or old-s ""))))) (setf (getenv "SKILLS_DIR (or old-s )))
#+end_src #+end_src
* Phase C: Implementation (Build) * Phase C: Implementation (Build)
** Package Context ** Package Context
#+begin_src lisp :tangle (expand-file-name "harness/doctor.lisp" (expand-file-name "harness/")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
(in-package :opencortex) (in-package :opencortex)
#+end_src #+end_src
** Global Configuration ** Global Configuration
#+begin_src lisp :tangle (expand-file-name "harness/doctor.lisp" (expand-file-name "harness/")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
(defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc") (defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc
"List of external binaries required for full system operation.") "List of external binaries required for full system operation.
#+end_src #+end_src
** Dependency Verification ** Dependency Verification
#+begin_src lisp :tangle (expand-file-name "harness/doctor.lisp" (expand-file-name "harness/")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
(defun doctor-check-dependencies () (defun doctor-check-dependencies ()
"Verifies that required external binaries are available in the PATH via a shell probe." "Verifies that required external binaries are available in the PATH via a shell probe."
(let ((all-ok t)) (let ((all-ok t))
(harness-log "DOCTOR: Checking system dependencies...") (harness-log "DOCTOR: Checking system dependencies...
(dolist (dep *doctor-required-binaries*) (dolist (dep *doctor-required-binaries*)
(let ((path (ignore-errors (let ((path (ignore-errors
(uiop:run-program (list "which" dep) (uiop:run-program (list "which" dep)
@@ -95,15 +95,15 @@ Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that mi
#+end_src #+end_src
** Environment & XDG Validation ** Environment & XDG Validation
#+begin_src lisp :tangle (expand-file-name "harness/doctor.lisp" (expand-file-name "harness/")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
(defun doctor-check-env () (defun doctor-check-env ()
"Validates XDG directories and environment configuration against the POSIX standard." "Validates XDG directories and environment configuration against the POSIX standard."
(harness-log "DOCTOR: Checking XDG environment...") (harness-log "DOCTOR: Checking XDG environment...
(let ((all-ok t) (let ((all-ok t)
(config-dir (getenv "OC_CONFIG_DIR")) (config-dir (getenv "OC_CONFIG_DIR)
(data-dir (getenv "OC_DATA_DIR")) (data-dir (getenv "OC_DATA_DIR)
(state-dir (getenv "OC_STATE_DIR")) (state-dir (getenv "OC_STATE_DIR)
(memex-dir (getenv "MEMEX_DIR"))) (memex-dir (getenv "MEMEX_DIR))
(flet ((check-dir (name path critical) (flet ((check-dir (name path critical)
(if (and path (> (length path) 0)) (if (and path (> (length path) 0))
@@ -124,42 +124,42 @@ Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that mi
#+end_src #+end_src
** LLM Connectivity ** LLM Connectivity
#+begin_src lisp :tangle (expand-file-name "harness/doctor.lisp" (expand-file-name "harness/")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
(defun doctor-check-llm () (defun doctor-check-llm ()
"Tests connectivity to primary LLM providers. Non-critical fallback allowed." "Tests connectivity to primary LLM providers. Non-critical fallback allowed."
(harness-log "DOCTOR: Checking LLM connectivity...") (harness-log "DOCTOR: Checking LLM connectivity...
(let ((openrouter-key (getenv "OPENROUTER_API_KEY"))) (let ((openrouter-key (getenv "OPENROUTER_API_KEY))
(if (and openrouter-key (> (length openrouter-key) 0)) (if (and openrouter-key (> (length openrouter-key) 0))
(progn (progn
(harness-log " [OK] OpenRouter API Key detected.") (harness-log " [OK] OpenRouter API Key detected.
t) t)
(progn (progn
(harness-log " [WARN] No OpenRouter API Key. Falling back to local inference only.") (harness-log " [WARN] No OpenRouter API Key. Falling back to local inference only.
t)))) t))))
#+end_src #+end_src
** Orchestration ** Orchestration
#+begin_src lisp :tangle (expand-file-name "harness/doctor.lisp" (expand-file-name "harness/")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
(defun doctor-run-all () (defun doctor-run-all ()
"Executes the full diagnostic suite and returns T if system is healthy." "Executes the full diagnostic suite and returns T if system is healthy."
(harness-log "==================================================") (harness-log "==================================================
(harness-log " OPENCORTEX DOCTOR: Commencing Health Check") (harness-log " OPENCORTEX DOCTOR: Commencing Health Check
(harness-log "==================================================") (harness-log "==================================================
(let ((dep-ok (doctor-check-dependencies)) (let ((dep-ok (doctor-check-dependencies))
(env-ok (doctor-check-env)) (env-ok (doctor-check-env))
(llm-ok (doctor-check-llm))) (llm-ok (doctor-check-llm)))
(harness-log "==================================================") (harness-log "==================================================
(if (and dep-ok env-ok) (if (and dep-ok env-ok)
(progn (progn
(harness-log " ✓ SYSTEM HEALTHY: Ready for ignition.") (harness-log " ✓ SYSTEM HEALTHY: Ready for ignition.
t) t)
(progn (progn
(harness-log " ✗ SYSTEM UNHEALTHY: Fix the errors above.") (harness-log " ✗ SYSTEM UNHEALTHY: Fix the errors above.
nil)))) nil))))
#+end_src #+end_src
** CLI Entry Point ** CLI Entry Point
#+begin_src lisp :tangle (expand-file-name "harness/doctor.lisp" (expand-file-name "harness/")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
(defun doctor-main () (defun doctor-main ()
"Entry point for the 'doctor' CLI command." "Entry point for the 'doctor' CLI command."
(if (doctor-run-all) (if (doctor-run-all)

44
harness/loop.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "harness/loop.lisp" (expand-file-name "harness/")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/loop.lisp")" )
#+TITLE: The Metabolic Loop (loop.lisp) #+TITLE: The Metabolic Loop (loop.lisp)
#+AUTHOR: Amr #+AUTHOR: Amr
#+FILETAGS: :harness:loop: #+FILETAGS: :harness:loop:
@@ -73,14 +73,14 @@ The loop operates in a multi-threaded environment:
(defvar *interrupt-flag* nil (defvar *interrupt-flag* nil
"Atomic flag set by signal handlers to trigger graceful shutdown. "Atomic flag set by signal handlers to trigger graceful shutdown.
Using a dedicated variable avoids race conditions in interrupt handling.") Using a dedicated variable avoids race conditions in interrupt handling.
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock") (defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock
"Mutex protecting *interrupt-flag* access. "Mutex protecting *interrupt-flag* access.
Locking is required because SBCL's interrupt handlers run in uncertain contexts.") Locking is required because SBCL's interrupt handlers run in uncertain contexts.
(defvar *heartbeat-thread* nil (defvar *heartbeat-thread* nil
"Handle to the heartbeat thread, allowing explicit termination on shutdown.") "Handle to the heartbeat thread, allowing explicit termination on shutdown.
#+end_src #+end_src
* The Metabolic Pipeline * The Metabolic Pipeline
@@ -111,12 +111,12 @@ The depth counter prevents infinite recursion—a signal that generates another
(let ((depth (getf current-signal :depth 0)) (let ((depth (getf current-signal :depth 0))
(meta (getf current-signal :meta))) (meta (getf current-signal :meta)))
(when (> depth 10) (when (> depth 10)
(harness-log "METABOLISM ERROR: Max recursion depth reached.") (harness-log "METABOLISM ERROR: Max recursion depth reached.
(return nil)) (return nil))
;; Check for graceful shutdown interrupt ;; Check for graceful shutdown interrupt
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
(harness-log "METABOLISM: Interrupted by shutdown signal.") (harness-log "METABOLISM: Interrupted by shutdown signal.
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil)) (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
(return nil)) (return nil))
@@ -149,7 +149,7 @@ The depth counter prevents infinite recursion—a signal that generates another
;; Only rollback memory on critical errors, not transient tool failures ;; Only rollback memory on critical errors, not transient tool failures
;; This prevents losing recent context due to a single bad API call ;; This prevents losing recent context due to a single bad API call
(unless (member sensor '(:loop-error :tool-error :syntax-error)) (unless (member sensor '(:loop-error :tool-error :syntax-error))
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.") (harness-log "CRITICAL ERROR: Initiating Micro-Rollback.
(rollback-memory 0)) (rollback-memory 0))
;; At deep recursion or known error types, terminate gracefully ;; At deep recursion or known error types, terminate gracefully
@@ -188,10 +188,10 @@ The heartbeat thread ensures the agent remains alive even without external input
#+begin_src lisp #+begin_src lisp
(defvar *auto-save-interval* 300 (defvar *auto-save-interval* 300
"Interval in seconds between automatic memory saves. "Interval in seconds between automatic memory saves.
Defaults to 300 seconds (5 minutes). Set via MEMORY_AUTO_SAVE_INTERVAL env var.") Defaults to 300 seconds (5 minutes). Set via MEMORY_AUTO_SAVE_INTERVAL env var.
(defvar *heartbeat-save-counter* 0 (defvar *heartbeat-save-counter* 0
"Tracks heartbeats since last save, used to calculate auto-save timing.") "Tracks heartbeats since last save, used to calculate auto-save timing.
#+end_src #+end_src
** start-heartbeat: The Pulsing Heart ** start-heartbeat: The Pulsing Heart
@@ -210,8 +210,8 @@ The heartbeat thread ensures the agent remains alive even without external input
- HEARTBEAT_INTERVAL: Seconds between heartbeats (default: 60) - HEARTBEAT_INTERVAL: Seconds between heartbeats (default: 60)
- MEMORY_AUTO_SAVE_INTERVAL: Seconds between auto-saves (default: 300)" - MEMORY_AUTO_SAVE_INTERVAL: Seconds between auto-saves (default: 300)"
(let ((interval (or (ignore-errors (parse-integer (getenv "HEARTBEAT_INTERVAL"))) 60)) (let ((interval (or (ignore-errors (parse-integer (getenv "HEARTBEAT_INTERVAL)) 60))
(auto-save (or (ignore-errors (parse-integer (getenv "MEMORY_AUTO_SAVE_INTERVAL"))) *auto-save-interval*))) (auto-save (or (ignore-errors (parse-integer (getenv "MEMORY_AUTO_SAVE_INTERVAL)) *auto-save-interval*)))
(setf *auto-save-interval* auto-save) (setf *auto-save-interval* auto-save)
(setf *heartbeat-save-counter* 0) (setf *heartbeat-save-counter* 0)
@@ -235,7 +235,7 @@ The heartbeat thread ensures the agent remains alive even without external input
:payload (list :sensor :heartbeat :payload (list :sensor :heartbeat
:unix-time (get-universal-time))))) :unix-time (get-universal-time)))))
:name "opencortex-heartbeat"))))) :name "opencortex-heartbeat))))
#+end_src #+end_src
* Main Entry Point * Main Entry Point
@@ -245,7 +245,7 @@ The heartbeat thread ensures the agent remains alive even without external input
#+begin_src lisp #+begin_src lisp
(defvar *shutdown-save-enabled* t (defvar *shutdown-save-enabled* t
"When T, save memory to disk on graceful shutdown. "When T, save memory to disk on graceful shutdown.
Disable for testing or when memory persistence is handled externally.") Disable for testing or when memory persistence is handled externally.
#+end_src #+end_src
** main: System Bootstrap and Idle Loop ** main: System Bootstrap and Idle Loop
@@ -275,7 +275,7 @@ The main function orchestrates system startup:
The idle loop checks for interrupts and saves memory before exit." The idle loop checks for interrupts and saves memory before exit."
;; Step 1: Load environment variables from standard location ;; Step 1: Load environment variables from standard location
(let* ((home (getenv "HOME")) (let* ((home (getenv "HOME)
(env-file (uiop:merge-pathnames* (env-file (uiop:merge-pathnames*
".local/share/opencortex/.env" ".local/share/opencortex/.env"
(uiop:ensure-directory-pathname home)))) (uiop:ensure-directory-pathname home))))
@@ -298,19 +298,19 @@ The main function orchestrates system startup:
(sb-sys:enable-interrupt sb-unix:sigint (sb-sys:enable-interrupt sb-unix:sigint
(lambda (sig code scp) (lambda (sig code scp)
(declare (ignore sig code scp)) (declare (ignore sig code scp))
(harness-log "SHUTDOWN: SIGINT received. Saving memory...") (harness-log "SHUTDOWN: SIGINT received. Saving memory...
(when *shutdown-save-enabled* (when *shutdown-save-enabled*
(save-memory-to-disk)) (save-memory-to-disk))
(uiop:quit 0))) (uiop:quit 0)))
;; Step 7: Idle loop - sleep in chunks, checking for interrupts ;; Step 7: Idle loop - sleep in chunks, checking for interrupts
(let ((sleep-interval (or (ignore-errors (let ((sleep-interval (or (ignore-errors
(parse-integer (getenv "DAEMON_SLEEP_INTERVAL"))) (parse-integer (getenv "DAEMON_SLEEP_INTERVAL))
3600))) 3600)))
(loop (loop
;; Check for interrupt before each sleep cycle ;; Check for interrupt before each sleep cycle
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
(harness-log "SHUTDOWN: Interrupt flag set. Saving memory...") (harness-log "SHUTDOWN: Interrupt flag set. Saving memory...
(when *shutdown-save-enabled* (when *shutdown-save-enabled*
(save-memory-to-disk)) (save-memory-to-disk))
(return)) (return))
@@ -324,7 +324,7 @@ The main function orchestrates system startup:
These tests verify the metabolic loop and error recovery. Run with: These tests verify the metabolic loop and error recovery. Run with:
~(fiveam:run! 'immune-suite)~ ~(fiveam:run! 'immune-suite)~
#+begin_src lisp :tangle (expand-file-name "harness/immune-system-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle immune-system-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(defpackage :opencortex-immune-system-tests (defpackage :opencortex-immune-system-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:immune-suite)) (:export #:immune-suite))
@@ -332,7 +332,7 @@ These tests verify the metabolic loop and error recovery. Run with:
(in-package :opencortex-immune-system-tests) (in-package :opencortex-immune-system-tests)
(def-suite immune-suite (def-suite immune-suite
:description "Verification of the Immune System (Core Error Hooks)") :description "Verification of the Immune System (Core Error Hooks)
(in-suite immune-suite) (in-suite immune-suite)
@@ -342,9 +342,9 @@ These tests verify the metabolic loop and error recovery. Run with:
(opencortex:defskill :evil-skill (opencortex:defskill :evil-skill
:priority 100 :priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input)) :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input))
:probabilistic (lambda (ctx) (error "CRITICAL BRAIN FAILURE")) :probabilistic (lambda (ctx) (error "CRITICAL BRAIN FAILURE)
:deterministic nil) :deterministic nil)
(opencortex:harness-log "CLEAN LOG") (opencortex:harness-log "CLEAN LOG
(opencortex:process-signal '(:type :EVENT :payload (:sensor :user-input))) (opencortex:process-signal '(:type :EVENT :payload (:sensor :user-input)))
(let ((logs (opencortex:context-get-system-logs 20))) (let ((logs (opencortex:context-get-system-logs 20)))
(is (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs)))))) (is (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs))))))

94
harness/manifest.org
View File

@@ -9,7 +9,7 @@ The *System Manifest* defines the structural components of the OpenCortex. It se
* Implementation * Implementation
** Main System ** Main System
#+begin_src lisp :tangle (expand-file-name "opencortex.asd") #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/opencortex.asd")
(defsystem :opencortex (defsystem :opencortex
:name "opencortex" :name "opencortex"
:author "Amr Gharbeia" :author "Amr Gharbeia"
@@ -18,73 +18,73 @@ The *System Manifest* defines the structural components of the OpenCortex. It se
:description "The Probabilistic-Deterministic Lisp Machine" :description "The Probabilistic-Deterministic Lisp Machine"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid) :depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
:serial t :serial t
:components ((:file "harness/package") :components ((:file "package
(:file "harness/skills") (:file "skills
(:file "harness/communication") (:file "communication
(:file "harness/communication-validator") (:file "communication-validator
(:file "harness/memory") (:file "memory
(:file "harness/context") (:file "context
(:file "harness/perceive") (:file "perceive
(:file "harness/reason") (:file "reason
(:file "harness/act") (:file "act
(:file "harness/loop"))) (:file "loop))
#+end_src #+end_src
** Test System ** Test System
#+begin_src lisp :tangle (expand-file-name "opencortex.asd") #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/opencortex.asd")
(defsystem :opencortex/tests (defsystem :opencortex/tests
:depends-on (:opencortex :fiveam) :depends-on (:opencortex :fiveam)
:components ((:file "tests/pipeline-act-tests") :components ((:file "pipeline-act-tests
(:file "tests/boot-sequence-tests") (:file "boot-sequence-tests
(:file "tests/immune-system-tests") (:file "immune-system-tests
(:file "tests/memory-tests") (:file "memory-tests
(:file "tests/pipeline-perceive-tests") (:file "pipeline-perceive-tests
(:file "tests/pipeline-reason-tests") (:file "pipeline-reason-tests
(:file "tests/peripheral-vision-tests") (:file "peripheral-vision-tests
(:file "tests/emacs-edit-tests") (:file "emacs-edit-tests
(:file "tests/engineering-standards-tests") (:file "engineering-standards-tests
(:file "tests/lisp-utils-tests") (:file "lisp-utils-tests
(:file "tests/literate-programming-tests") (:file "literate-programming-tests
(:file "tests/self-edit-tests") (:file "self-edit-tests
(:file "tests/tool-permissions-tests") (:file "tool-permissions-tests
(:file "tests/diagnostics-tests") (:file "diagnostics-tests
(:file "tests/config-manager-tests") (:file "config-manager-tests
(:file "tests/gateway-manager-tests") (:file "gateway-manager-tests
(:file "tests/tui-tests") (:file "tui-tests
(:file "tests/llm-gateway-tests"))) (:file "llm-gateway-tests))
#+end_src #+end_src
** TUI System ** TUI System
#+begin_src lisp :tangle (expand-file-name "opencortex.asd") #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/opencortex.asd")
(defsystem :opencortex/tui (defsystem :opencortex/tui
:depends-on (:opencortex :croatoan :usocket :bordeaux-threads) :depends-on (:opencortex :croatoan :usocket :bordeaux-threads)
:components ((:file "harness/tui-client"))) :components ((:file "tui-client))
#+end_src #+end_src
** Test Orchestrator ** Test Orchestrator
#+begin_src lisp :tangle (expand-file-name "run-all-tests.lisp") #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/run-all-tests.lisp")
(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname))) (load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))
(let ((oc-dir (or (getenv "OC_DATA_DIR") (let ((oc-dir (or (getenv "OC_DATA_DIR
(namestring (truename "./"))))) (namestring (truename "./))))
(push (uiop:ensure-directory-pathname oc-dir) asdf:*central-registry*)) (push (uiop:ensure-directory-pathname oc-dir) asdf:*central-registry*))
(ql:quickload '(:opencortex :opencortex/tui :opencortex/tests) :silent t) (ql:quickload '(:opencortex :opencortex/tui :opencortex/tests) :silent t)
(format t "~%=== Initializing Skills BEFORE loading tests ===~%") (format t "~%=== Initializing Skills BEFORE loading tests ===~%
(opencortex:initialize-all-skills) (opencortex:initialize-all-skills)
(format t "~%=== Running ALL Test Suites ===~%") (format t "~%=== Running ALL Test Suites ===~%
(dolist (suite-spec '(("OPENCORTEX-BOOT-TESTS" "BOOT-SUITE") (dolist (suite-spec '(("OPENCORTEX-BOOT-TESTS" "BOOT-SUITE
("OPENCORTEX-COMMUNICATION-TESTS" "COMMUNICATION-PROTOCOL-SUITE") ("OPENCORTEX-COMMUNICATION-TESTS" "COMMUNICATION-PROTOCOL-SUITE
("OPENCORTEX-PIPELINE-ACT-TESTS" "PIPELINE-ACT-SUITE") ("OPENCORTEX-PIPELINE-ACT-TESTS" "PIPELINE-ACT-SUITE
("OPENCORTEX-MEMORY-TESTS" "MEMORY-SUITE") ("OPENCORTEX-MEMORY-TESTS" "MEMORY-SUITE
("OPENCORTEX-ENGINEERING-STANDARDS-TESTS" "ENGINEERING-STANDARDS-SUITE") ("OPENCORTEX-ENGINEERING-STANDARDS-TESTS" "ENGINEERING-STANDARDS-SUITE
("OPENCORTEX-DIAGNOSTICS-TESTS" "DIAGNOSTICS-SUITE") ("OPENCORTEX-DIAGNOSTICS-TESTS" "DIAGNOSTICS-SUITE
("OPENCORTEX-GATEWAY-MANAGER-TESTS" "GATEWAY-SUITE") ("OPENCORTEX-GATEWAY-MANAGER-TESTS" "GATEWAY-SUITE
("OPENCORTEX-TUI-TESTS" "TUI-SUITE") ("OPENCORTEX-TUI-TESTS" "TUI-SUITE
("OPENCORTEX-LLM-GATEWAY-TESTS" "LLM-GATEWAY-SUITE"))) ("OPENCORTEX-LLM-GATEWAY-TESTS" "LLM-GATEWAY-SUITE))
(let ((pkg (find-package (first suite-spec)))) (let ((pkg (find-package (first suite-spec))))
(when pkg (when pkg
(let ((suite-sym (find-symbol (second suite-spec) pkg))) (let ((suite-sym (find-symbol (second suite-spec) pkg)))
@@ -92,6 +92,6 @@ The *System Manifest* defines the structural components of the OpenCortex. It se
(format t "~&--- Suite: ~A ---~%" (first suite-spec)) (format t "~&--- Suite: ~A ---~%" (first suite-spec))
(fiveam:run! suite-sym)))))) (fiveam:run! suite-sym))))))
(format t "~%=== ALL TESTS COMPLETE ===~%") (format t "~%=== ALL TESTS COMPLETE ===~%
#+end_src #+end_src

28
harness/memory.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle memory.lisp #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")
#+TITLE: The System Memory (memory.lisp) #+TITLE: The System Memory (memory.lisp)
#+AUTHOR: Amr #+AUTHOR: Amr
#+FILETAGS: :harness:memory: #+FILETAGS: :harness:memory:
@@ -32,14 +32,14 @@ flowchart TD
#+end_src #+end_src
** Package Context ** Package Context
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(in-package :opencortex) (in-package :opencortex)
#+end_src #+end_src
** The Object Repository ** The Object Repository
The `*memory*` is the global hash table that holds every Org element by its unique ID. This is the "live RAM" of the agent's memory. The `*memory*` is the global hash table that holds every Org element by its unique ID. This is the "live RAM" of the agent's memory.
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(defvar *memory* (make-hash-table :test 'equal)) (defvar *memory* (make-hash-table :test 'equal))
(defvar *history-store* (make-hash-table :test 'equal) (defvar *history-store* (make-hash-table :test 'equal)
@@ -49,7 +49,7 @@ The `*memory*` is the global hash table that holds every Org element by its uniq
** The Data Structure (org-object) ** The Data Structure (org-object)
Every element in the Memex (headlines, paragraphs, etc.) is represented by an `org-object` structure. It contains both semantic metadata (attributes, content) and structural metadata (parent/child pointers, Merkle hashes). Every element in the Memex (headlines, paragraphs, etc.) is represented by an `org-object` structure. It contains both semantic metadata (attributes, content) and structural metadata (parent/child pointers, Merkle hashes).
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(defstruct org-object (defstruct org-object
id type attributes content vector parent-id children version last-sync hash) id type attributes content vector parent-id children version last-sync hash)
@@ -61,7 +61,7 @@ Every element in the Memex (headlines, paragraphs, etc.) is represented by an `o
** Merkle Tree Integrity (compute-merkle-hash) ** Merkle Tree Integrity (compute-merkle-hash)
The `compute-merkle-hash` function ensures the cryptographic integrity of the knowledge graph. A node's hash depends on its own properties and the hashes of all its children. This creates a recursive fingerprint where any change to a single note propagates up to the root hash. The `compute-merkle-hash` function ensures the cryptographic integrity of the knowledge graph. A node's hash depends on its own properties and the hashes of all its children. This creates a recursive fingerprint where any change to a single note propagates up to the root hash.
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(defun compute-merkle-hash (id type attributes content child-hashes) (defun compute-merkle-hash (id type attributes content child-hashes)
"Computes a SHA-256 Merkle hash for a node based on its core properties and children's hashes." "Computes a SHA-256 Merkle hash for a node based on its core properties and children's hashes."
(let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v))) (let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
@@ -78,7 +78,7 @@ The `compute-merkle-hash` function ensures the cryptographic integrity of the kn
** Ingesting the AST (ingest-ast) ** Ingesting the AST (ingest-ast)
The `ingest-ast` function is the primary bridge between the external world (Emacs/JSON) and the internal Lisp machine. It recursively parses an Org-mode Abstract Syntax Tree (AST) into `org-object` structures and registers them in the store. The `ingest-ast` function is the primary bridge between the external world (Emacs/JSON) and the internal Lisp machine. It recursively parses an Org-mode Abstract Syntax Tree (AST) into `org-object` structures and registers them in the store.
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(defun ingest-ast (ast &optional parent-id) (defun ingest-ast (ast &optional parent-id)
"Parses an Org AST into the recursive Lisp Memory with Merkle hashing." "Parses an Org AST into the recursive Lisp Memory with Merkle hashing."
(let* ((type (getf ast :type)) (let* ((type (getf ast :type))
@@ -117,7 +117,7 @@ The `ingest-ast` function is the primary bridge between the external world (Emac
** Memory Snapshots (snapshot-memory) ** Memory Snapshots (snapshot-memory)
Because objects are stored immutably in the `*history-store*`, a snapshot is a lightweight shallow copy of the active `*memory*` pointers. The system maintains a rolling buffer of 20 snapshots, allowing for near-instant, zero-cost rollback. Because objects are stored immutably in the `*history-store*`, a snapshot is a lightweight shallow copy of the active `*memory*` pointers. The system maintains a rolling buffer of 20 snapshots, allowing for near-instant, zero-cost rollback.
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(defvar *object-store-snapshots* nil) (defvar *object-store-snapshots* nil)
(defun copy-hash-table (hash-table) (defun copy-hash-table (hash-table)
@@ -144,7 +144,7 @@ Because objects are stored immutably in the `*history-store*`, a snapshot is a l
** Memory Rollback (rollback-memory) ** Memory Rollback (rollback-memory)
Restores the state of the Memex from one of the previous snapshots. Restores the state of the Memex from one of the previous snapshots.
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(defun rollback-memory (&optional (index 0)) (defun rollback-memory (&optional (index 0))
"Restores the Memory to a previously captured snapshot using immutable history pointers." "Restores the Memory to a previously captured snapshot using immutable history pointers."
(let ((snapshot (nth index *object-store-snapshots*))) (let ((snapshot (nth index *object-store-snapshots*)))
@@ -157,7 +157,7 @@ Restores the state of the Memex from one of the previous snapshots.
** Disk Persistence (save-memory / load-memory) ** Disk Persistence (save-memory / load-memory)
Essential for surviving crashes. Saves the in-memory hash tables to disk and loads them back on restart. Essential for surviving crashes. Saves the in-memory hash tables to disk and loads them back on restart.
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(defvar *memory-snapshot-path* nil (defvar *memory-snapshot-path* nil
"Path to the memory snapshot file. Set from MEMORY_SNAPSHOT_PATH env or default. "Path to the memory snapshot file. Set from MEMORY_SNAPSHOT_PATH env or default.
@@ -210,7 +210,7 @@ Reconstitutes alists into hash tables."
** Semantic Search (get-embedding, semantic-search) ** Semantic Search (get-embedding, semantic-search)
Support for vector embeddings via Ollama and semantic search with cosine similarity. Support for vector embeddings via Ollama and semantic search with cosine similarity.
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(defvar *embedding-cache* (make-hash-table :test 'equal) (defvar *embedding-cache* (make-hash-table :test 'equal)
"Cache for embeddings to avoid redundant API calls. "Cache for embeddings to avoid redundant API calls.
@@ -259,7 +259,7 @@ Returns up to LIMIT objects with similarity >= MIN-SIMILARITY, sorted by similar
#+end_src #+end_src
** Cognitive Tool: Semantic Search ** Cognitive Tool: Semantic Search
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(def-cognitive-tool :semantic-search (def-cognitive-tool :semantic-search
"Searches memory for objects semantically similar to a query." "Searches memory for objects semantically similar to a query."
((:query :type :string :description "The search query. ((:query :type :string :description "The search query.
@@ -272,7 +272,7 @@ Returns up to LIMIT objects with similarity >= MIN-SIMILARITY, sorted by similar
#+end_src #+end_src
** Cognitive Tool: Generate Embeddings ** Cognitive Tool: Generate Embeddings
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(def-cognitive-tool :generate-embeddings (def-cognitive-tool :generate-embeddings
"Generates vector embeddings for given text via the configured embedding backend (Ollama)." "Generates vector embeddings for given text via the configured embedding backend (Ollama)."
((:texts :type :list :description "List of text strings to embed.) ((:texts :type :list :description "List of text strings to embed.)
@@ -295,7 +295,7 @@ Returns up to LIMIT objects with similarity >= MIN-SIMILARITY, sorted by similar
** Lookup Utilities ** Lookup Utilities
Basic functions for retrieving objects by ID or type. Basic functions for retrieving objects by ID or type.
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(defun org-id-new () (defun org-id-new ()
"Generates a new UUID string for Org-mode identification." "Generates a new UUID string for Org-mode identification."
(string-downcase (format nil "~a" (uuid:make-v4-uuid)))) (string-downcase (format nil "~a" (uuid:make-v4-uuid))))
@@ -325,7 +325,7 @@ Basic functions for retrieving objects by ID or type.
** Structural Helpers ** Structural Helpers
Utility functions for AST traversal and path resolution. Utility functions for AST traversal and path resolution.
#+begin_src lisp :tangle memory.lisp" ) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
(defun find-headline-missing-id (ast) (defun find-headline-missing-id (ast)
"Traverses an AST to find headlines that lack an :ID: property." "Traverses an AST to find headlines that lack an :ID: property."
(when (listp ast) (when (listp ast)

2
harness/package.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle package.lisp #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/package.lisp")
#+TITLE: System Interface (package.lisp) #+TITLE: System Interface (package.lisp)
#+AUTHOR: Amr #+AUTHOR: Amr
#+FILETAGS: :harness:interface: #+FILETAGS: :harness:interface:

20
harness/perceive.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "harness/perceive.lisp" (expand-file-name "harness/")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/perceive.lisp")" )
#+TITLE: Stage 1: Perceive (perceive.lisp) #+TITLE: Stage 1: Perceive (perceive.lisp)
#+AUTHOR: Amr #+AUTHOR: Amr
#+FILETAGS: :harness:perceive: #+FILETAGS: :harness:perceive:
@@ -70,7 +70,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
so they run in separate threads to avoid blocking the main pipeline. so they run in separate threads to avoid blocking the main pipeline.
Other sensors (:heartbeat, :interrupt, :buffer-update) are processed Other sensors (:heartbeat, :interrupt, :buffer-update) are processed
synchronously to maintain temporal ordering.") synchronously to maintain temporal ordering.
#+end_src #+end_src
** Foveal Focus State ** Foveal Focus State
@@ -83,7 +83,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
responses. When editing a specific note, the agent knows which responses. When editing a specific note, the agent knows which
note you're referring to without needing explicit ID references. note you're referring to without needing explicit ID references.
Updated on :point-update events from Emacs.") Updated on :point-update events from Emacs.
#+end_src #+end_src
* Stimulus Injection * Stimulus Injection
@@ -113,7 +113,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
;; Ensure metadata exists ;; Ensure metadata exists
(unless meta (unless meta
(setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal"))) (setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal))
;; Attach reply stream if provided ;; Attach reply stream if provided
(when stream (when stream
@@ -131,7 +131,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
(invoke-restart 'skip-event)))) (invoke-restart 'skip-event))))
(process-signal raw-message)) (process-signal raw-message))
(skip-event () nil))) (skip-event () nil)))
:name "opencortex-async-task") :name "opencortex-async-task
;; Sync: process in main thread with recovery ;; Sync: process in main thread with recovery
(restart-case (restart-case
@@ -140,7 +140,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
(invoke-restart 'skip-event)))) (invoke-restart 'skip-event))))
(process-signal raw-message)) (process-signal raw-message))
(skip-event () (skip-event ()
(harness-log "SYSTEM RECOVERY: Stimulus dropped.")))))) (harness-log "SYSTEM RECOVERY: Stimulus dropped.)))))
#+end_src #+end_src
* The Perceive Gate * The Perceive Gate
@@ -170,7 +170,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
;; Log the incoming signal for debugging ;; Log the incoming signal for debugging
(harness-log "GATE [Perceive]: ~a (~a) [Source: ~s]" (harness-log "GATE [Perceive]: ~a (~a) [Source: ~s]"
type (or sensor "no-sensor") (getf meta :source)) type (or sensor "no-sensor (getf meta :source))
;; Handle EVENT type sensors ;; Handle EVENT type sensors
(cond ((eq type :EVENT) (cond ((eq type :EVENT)
@@ -227,7 +227,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
These tests verify the Perceive pipeline. Run with: These tests verify the Perceive pipeline. Run with:
~(fiveam:run! 'pipeline-perceive-suite)~ ~(fiveam:run! 'pipeline-perceive-suite)~
#+begin_src lisp :tangle (expand-file-name "harness/pipeline-perceive-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle pipeline-perceive-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(defpackage :opencortex-pipeline-perceive-tests (defpackage :opencortex-pipeline-perceive-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:pipeline-perceive-suite)) (:export #:pipeline-perceive-suite))
@@ -235,14 +235,14 @@ These tests verify the Perceive pipeline. Run with:
(in-package :opencortex-pipeline-perceive-tests) (in-package :opencortex-pipeline-perceive-tests)
(def-suite pipeline-perceive-suite (def-suite pipeline-perceive-suite
:description "Test suite for Perceive pipeline") :description "Test suite for Perceive pipeline
(in-suite pipeline-perceive-suite) (in-suite pipeline-perceive-suite)
(test test-perceive-gate (test test-perceive-gate
"Perceive gate should update the object store and normalize signal." "Perceive gate should update the object store and normalize signal."
(clrhash opencortex::*memory*) (clrhash opencortex::*memory*)
(let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil)))) (let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test :contents nil))))
(result (perceive-gate signal))) (result (perceive-gate signal)))
(is (eq :perceived (getf result :status))) (is (eq :perceived (getf result :status)))
(is (not (null (gethash "test-node" opencortex::*memory*)))))) (is (not (null (gethash "test-node" opencortex::*memory*))))))

54
harness/reason.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "harness/reason.lisp" (expand-file-name "harness/")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/reason.lisp")" )
#+TITLE: Stage 2: Reason (reason.lisp) #+TITLE: Stage 2: Reason (reason.lisp)
#+AUTHOR: Amr #+AUTHOR: Amr
#+FILETAGS: :harness:reason: #+FILETAGS: :harness:reason:
@@ -23,7 +23,7 @@ The LLM proposes; the skills verify. This is the "Bouncer Pattern" - the determi
The Reason stage communicates exclusively through property lists (plists). This design choice reflects the homoiconic nature of Lisp - plists are native data structures that can be read, written, and manipulated by the same code that processes them. The Reason stage communicates exclusively through property lists (plists). This design choice reflects the homoiconic nature of Lisp - plists are native data structures that can be read, written, and manipulated by the same code that processes them.
A plist message like: A plist message like:
: (TYPE :REQUEST TARGET :CLI PAYLOAD (ACTION :MESSAGE TEXT "Hello")) : (TYPE :REQUEST TARGET :CLI PAYLOAD (ACTION :MESSAGE TEXT "Hello)
Is simultaneously: Is simultaneously:
- Human-readable text - Human-readable text
@@ -46,17 +46,17 @@ The probabilistic engine is responsible for all neural/LLM operations. It mainta
#+begin_src lisp #+begin_src lisp
(defvar *probabilistic-backends* (make-hash-table :test 'equal) (defvar *probabilistic-backends* (make-hash-table :test 'equal)
"Registry mapping provider keywords (:openrouter, :ollama) to their calling functions.") "Registry mapping provider keywords (:openrouter, :ollama) to their calling functions.
(defvar *provider-cascade* nil (defvar *provider-cascade* nil
"Ordered list of provider keywords to try. First available provider wins.") "Ordered list of provider keywords to try. First available provider wins.
(defvar *model-selector-fn* nil (defvar *model-selector-fn* nil
"Optional function that selects a specific model for each provider. "Optional function that selects a specific model for each provider.
Signature: (funcall fn provider context) => model-name-string") Signature: (funcall fn provider context) => model-name-string
(defvar *consensus-enabled-p* nil (defvar *consensus-enabled-p* nil
"When T, run multiple providers and compare results for critical decisions.") "When T, run multiple providers and compare results for critical decisions.
#+end_src #+end_src
** register-probabilistic-backend: Backend Registration ** register-probabilistic-backend: Backend Registration
@@ -68,8 +68,8 @@ The probabilistic engine is responsible for all neural/LLM operations. It mainta
NAME is a keyword like :openrouter or :ollama. NAME is a keyword like :openrouter or :ollama.
FN is a function with signature: (funcall fn prompt system-prompt &key model) FN is a function with signature: (funcall fn prompt system-prompt &key model)
returning either: returning either:
- (list :status :success :content \"response text\") - (list :status :success :content \"response text\
- (list :status :error :message \"error description\") - (list :status :error :message \"error description\
- a simple string on success - a simple string on success
Example registration: Example registration:
@@ -82,7 +82,7 @@ The probabilistic engine is responsible for all neural/LLM operations. It mainta
#+begin_src lisp #+begin_src lisp
(defun probabilistic-call (prompt &key (defun probabilistic-call (prompt &key
(system-prompt "You are the Probabilistic engine.") (system-prompt "You are the Probabilistic engine.
(cascade nil) (cascade nil)
(context nil)) (context nil))
"Dispatch a neural request through the provider cascade. "Dispatch a neural request through the provider cascade.
@@ -121,7 +121,7 @@ The probabilistic engine is responsible for all neural/LLM operations. It mainta
;; All providers failed ;; All providers failed
(list :type :LOG (list :type :LOG
:payload (list :text "Neural Cascade Failure: All providers exhausted."))))) :payload (list :text "Neural Cascade Failure: All providers exhausted.))))
#+end_src #+end_src
* Cognitive Proposal Generation (Think) * Cognitive Proposal Generation (Think)
@@ -144,9 +144,9 @@ The `think` function is the heart of the probabilistic engine. It constructs a p
(if (and text (stringp text)) (if (and text (stringp text))
(let ((cleaned text)) (let ((cleaned text))
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned "")) (setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned
(setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned "")) (setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned
(setf cleaned (cl-ppcre:regex-replace-all "```" cleaned "")) (setf cleaned (cl-ppcre:regex-replace-all "```" cleaned
(string-trim '(#\Space #\Newline #\Tab) cleaned)) (string-trim '(#\Space #\Newline #\Tab) cleaned))
text)) text))
#+end_src #+end_src
@@ -164,8 +164,8 @@ The `think` function is the heart of the probabilistic engine. It constructs a p
making the plist compatible with standard Lisp property accessors. making the plist compatible with standard Lisp property accessors.
Example transformation: Example transformation:
(TYPE REQUEST PAYLOAD (ACTION MESSAGE TEXT \"Hi\")) (TYPE REQUEST PAYLOAD (ACTION MESSAGE TEXT \"Hi\)
=> (:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"Hi\"))" => (:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"Hi\)"
(when (listp plist) (when (listp plist)
(loop for (k . rest) on plist by #'cddr (loop for (k . rest) on plist by #'cddr
@@ -193,14 +193,14 @@ The `think` function is the heart of the probabilistic engine. It constructs a p
This constraint makes parsing deterministic and prevents rambling. This constraint makes parsing deterministic and prevents rambling.
Returns a plist with structure: Returns a plist with structure:
(:TYPE :REQUEST :TARGET :CLI :PAYLOAD (:ACTION :MESSAGE :TEXT \"...\"))" (:TYPE :REQUEST :TARGET :CLI :PAYLOAD (:ACTION :MESSAGE :TEXT \"...\)"
;; Gather context components ;; Gather context components
(let* ((active-skill (find-triggered-skill context)) (let* ((active-skill (find-triggered-skill context))
(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 (getenv "MEMEX_ASSISTANT") "Agent")) (assistant-name (or (getenv "MEMEX_ASSISTANT "Agent)
(rejection-trace (proto-get (proto-get context :payload) :rejection-trace))) (rejection-trace (proto-get (proto-get context :payload) :rejection-trace)))
;; Generate prompt from skill or raw text ;; Generate prompt from skill or raw text
@@ -212,12 +212,12 @@ The `think` function is the heart of the probabilistic engine. It constructs a p
(let ((p (proto-get (proto-get context :payload) :text))) (let ((p (proto-get (proto-get context :payload) :text)))
(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 ;; Inject Reflection Loop feedback if a previous proposal was rejected
(reflection-feedback (if rejection-trace (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) (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~a "IDENTITY: ~a~a
@@ -228,10 +228,10 @@ Your task is to generate exactly ONE valid Lisp plist response.
MANDATE: Respond with ONE Lisp plist. Never output prose. MANDATE: Respond with ONE Lisp plist. Never output prose.
IMPORTANT: To reply to the user, you MUST use: IMPORTANT: To reply to the user, you MUST use:
(:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"<Response Text>\")) (:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"<Response Text>\)
To call a tool, you MUST use: To call a tool, you MUST use:
(:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"<name>\" :ARGS (:arg1 \"val\")) (:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"<name>\" :ARGS (:arg1 \"val\)
MANDATORY VALIDATION RULE: Before declaring any Lisp code edit complete, MANDATORY VALIDATION RULE: Before declaring any Lisp code edit complete,
you MUST call the `:validate-lisp` tool with the proposed code. If the tool you MUST call the `:validate-lisp` tool with the proposed code. If the tool
@@ -432,7 +432,7 @@ The deterministic engine runs all registered skills' verification functions. Thi
(last-rejection nil)) (last-rejection nil))
(loop (loop
(when (<= retries 0) (when (<= retries 0)
(harness-log "REASON: Reflection loop exhausted. Final rejection.") (harness-log "REASON: Reflection loop exhausted. Final rejection.
(setf (getf signal :approved-action) last-rejection) (setf (getf signal :approved-action) last-rejection)
(setf (getf signal :status) :reasoned) (setf (getf signal :status) :reasoned)
(return signal)) (return signal))
@@ -472,7 +472,7 @@ The deterministic engine runs all registered skills' verification functions. Thi
These tests verify the Reason (cognitive) pipeline. Run with: These tests verify the Reason (cognitive) pipeline. Run with:
~(fiveam:run! 'pipeline-reason-suite)~ ~(fiveam:run! 'pipeline-reason-suite)~
#+begin_src lisp :tangle (expand-file-name "harness/pipeline-reason-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests")) #+begin_src lisp :tangle pipeline-reason-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR ". "/harness "/tests)
(defpackage :opencortex-pipeline-reason-tests (defpackage :opencortex-pipeline-reason-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:pipeline-reason-suite)) (:export #:pipeline-reason-suite))
@@ -480,7 +480,7 @@ These tests verify the Reason (cognitive) pipeline. Run with:
(in-package :opencortex-pipeline-reason-tests) (in-package :opencortex-pipeline-reason-tests)
(def-suite pipeline-reason-suite (def-suite pipeline-reason-suite
:description "Test suite for Reason pipeline") :description "Test suite for Reason pipeline
(in-suite pipeline-reason-suite) (in-suite pipeline-reason-suite)
@@ -491,10 +491,10 @@ These tests verify the Reason (cognitive) pipeline. Run with:
(opencortex::defskill :mock-safety (opencortex::defskill :mock-safety
:priority 50 :priority 50
:trigger (lambda (ctx) t) :trigger (lambda (ctx) t)
:probabilistic (lambda (ctx) "Mock probabilistic") :probabilistic (lambda (ctx) "Mock probabilistic
:deterministic (lambda (action ctx) :deterministic (lambda (action ctx)
(list :type :LOG :payload (list :text "Action rejected by skill heuristics")))) (list :type :LOG :payload (list :text "Action rejected by skill heuristics)))
(let* ((candidate (list :type :REQUEST :payload (list :action :eval :code "(shell-command \"rm -rf /\")"))) (let* ((candidate (list :type :REQUEST :payload (list :action :eval :code "(shell-command \"rm -rf /\))
(signal (list :type :EVENT :candidate candidate)) (signal (list :type :EVENT :candidate candidate))
(result (deterministic-verify candidate signal))) (result (deterministic-verify candidate signal)))
(is (eq :LOG (getf result :type))) (is (eq :LOG (getf result :type)))

2
harness/setup.org
View File

@@ -23,7 +23,7 @@ To maintain sovereignty, the harness must remain a "dumb" bus. It should not kno
** The Installer Script (opencortex.sh) ** The Installer Script (opencortex.sh)
The shell script is the primary entry point. It handles the initial git clone, dependency installation, and literate tangle. The shell script is the primary entry point. It handles the initial git clone, dependency installation, and literate tangle.
#+begin_src bash :tangle (expand-file-name "harness/../opencortex.sh") #+begin_src bash :tangle ../opencortex.sh
#!/bin/bash #!/bin/bash
# (The content here is a duplicate of the main opencortex.sh for literate consistency) # (The content here is a duplicate of the main opencortex.sh for literate consistency)
# [Note: Implementation is already verified in the top-level script] # [Note: Implementation is already verified in the top-level script]

2
harness/skills.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle skills.lisp #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/skills.lisp")
#+TITLE: The Skill Engine (skills.lisp) #+TITLE: The Skill Engine (skills.lisp)
#+AUTHOR: Amr #+AUTHOR: Amr
#+FILETAGS: :harness:skills: #+FILETAGS: :harness:skills:

74
harness/tui-client.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
:PROPERTIES: :PROPERTIES:
:ID: tui-client-spec :ID: tui-client-spec
:CREATED: [2026-04-17 Fri 11:00] :CREATED: [2026-04-17 Fri 11:00]
@@ -22,26 +22,26 @@ A simple MVP console is insufficient for a Lisp Machine. To reach v0.2.0, the TU
* Phase B: Protocol (Success Criteria) * Phase B: Protocol (Success Criteria)
** Test Suite Context ** Test Suite Context
#+begin_src lisp :tangle ((expand-file-name "tui-tests.lisp")) #+begin_src lisp :tangle (tui-tests.lisp)
(defpackage :opencortex-tui-tests (defpackage :opencortex-tui-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:tui-suite)) (:export #:tui-suite))
#+end_src #+end_src
#+begin_src lisp :tangle ((expand-file-name "tui-tests.lisp")) #+begin_src lisp :tangle (tui-tests.lisp)
(in-package :opencortex-tui-tests) (in-package :opencortex-tui-tests)
#+end_src #+end_src
#+begin_src lisp :tangle ((expand-file-name "tui-tests.lisp")) #+begin_src lisp :tangle (tui-tests.lisp)
(def-suite tui-suite :description "Verification of the TUI parsing and styling logic") (def-suite tui-suite :description "Verification of the TUI parsing and styling logic
#+end_src #+end_src
#+begin_src lisp :tangle ((expand-file-name "tui-tests.lisp")) #+begin_src lisp :tangle (tui-tests.lisp)
(in-suite tui-suite) (in-suite tui-suite)
#+end_src #+end_src
** Command Parsing Tests ** Command Parsing Tests
#+begin_src lisp :tangle ((expand-file-name "tui-tests.lisp")) #+begin_src lisp :tangle (tui-tests.lisp)
(test test-tui-connection-drop (test test-tui-connection-drop
"Tier 2 Chaos: Verify that handle-return degrades gracefully when the daemon connection is lost." "Tier 2 Chaos: Verify that handle-return degrades gracefully when the daemon connection is lost."
(let ((opencortex.tui::*incoming-msgs* nil) (let ((opencortex.tui::*incoming-msgs* nil)
@@ -57,81 +57,81 @@ A simple MVP console is insufficient for a Lisp Machine. To reach v0.2.0, the TU
* Phase C: Implementation (Build) * Phase C: Implementation (Build)
** Package Context ** Package Context
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(in-package :cl-user) (in-package :cl-user)
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defpackage :opencortex.tui (defpackage :opencortex.tui
(:use :cl :croatoan) (:use :cl :croatoan)
(:export :main)) (:export :main))
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(in-package :opencortex.tui) (in-package :opencortex.tui)
#+end_src #+end_src
** Global State ** Global State
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *daemon-host* "127.0.0.1") (defvar *daemon-host* "127.0.0.1
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *daemon-port* 9105) (defvar *daemon-port* 9105)
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *socket* nil) (defvar *socket* nil)
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *stream* nil) (defvar *stream* nil)
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *chat-history* (list) "Full chronological log of messages.") (defvar *chat-history* (list) "Full chronological log of messages.
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *scroll-index* 0 "Offset for history rendering.") (defvar *scroll-index* 0 "Offset for history rendering.
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *status-text* "Connecting...") (defvar *status-text* "Connecting...
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t)) (defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t))
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *command-history* (make-array 0 :element-type 't :fill-pointer 0 :adjustable t)) (defvar *command-history* (make-array 0 :element-type 't :fill-pointer 0 :adjustable t))
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *history-index* -1) (defvar *history-index* -1)
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *is-running* t) (defvar *is-running* t)
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *queue-lock* (bt:make-lock)) (defvar *queue-lock* (bt:make-lock))
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defvar *incoming-msgs* nil) (defvar *incoming-msgs* nil)
#+end_src #+end_src
** Utilities ** Utilities
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defun enqueue-msg (msg) (defun enqueue-msg (msg)
"Thread-safe addition to incoming message queue." "Thread-safe addition to incoming message queue."
(bt:with-lock-held (*queue-lock*) (bt:with-lock-held (*queue-lock*)
(setf *incoming-msgs* (append *incoming-msgs* (list msg))))) (setf *incoming-msgs* (append *incoming-msgs* (list msg)))))
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defun dequeue-msgs () (defun dequeue-msgs ()
"Thread-safe retrieval of incoming messages." "Thread-safe retrieval of incoming messages."
(bt:with-lock-held (*queue-lock*) (bt:with-lock-held (*queue-lock*)
@@ -142,7 +142,7 @@ A simple MVP console is insufficient for a Lisp Machine. To reach v0.2.0, the TU
#+end_src #+end_src
** Styling Engine ** Styling Engine
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defun get-line-style (text) (defun get-line-style (text)
"Determines croatoan attributes based on content patterns." "Determines croatoan attributes based on content patterns."
(cond (cond
@@ -154,7 +154,7 @@ A simple MVP console is insufficient for a Lisp Machine. To reach v0.2.0, the TU
#+end_src #+end_src
** Rendering Orchestrator ** Rendering Orchestrator
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defun render-chat (win) (defun render-chat (win)
"Renders the chat history with scrolling and styling." "Renders the chat history with scrolling and styling."
(clear win) (clear win)
@@ -172,14 +172,14 @@ A simple MVP console is insufficient for a Lisp Machine. To reach v0.2.0, the TU
#+end_src #+end_src
** Input Handling ** Input Handling
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defun handle-backspace () (defun handle-backspace ()
"Deletes last character from input buffer." "Deletes last character from input buffer."
(when (> (fill-pointer *input-buffer*) 0) (when (> (fill-pointer *input-buffer*) 0)
(decf (fill-pointer *input-buffer*)))) (decf (fill-pointer *input-buffer*))))
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defun handle-return (stream) (defun handle-return (stream)
"Process input buffer as message or command." "Process input buffer as message or command."
(let ((cmd (coerce *input-buffer* 'string))) (let ((cmd (coerce *input-buffer* 'string)))
@@ -193,14 +193,14 @@ A simple MVP console is insufficient for a Lisp Machine. To reach v0.2.0, the TU
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))) :PAYLOAD (list :SENSOR :user-input :TEXT cmd))))
(finish-output stream)) (finish-output stream))
(error (c) (error (c)
(enqueue-msg "ERROR: Connection to daemon lost.") (enqueue-msg "ERROR: Connection to daemon lost.
(setf *is-running* nil)))) (setf *is-running* nil))))
(when (string= cmd "/exit") (setf *is-running* nil)) (when (string= cmd "/exit (setf *is-running* nil))
(when (string= cmd "/clear") (setf *chat-history* nil)))) (when (string= cmd "/clear (setf *chat-history* nil))))
#+end_src #+end_src
** Main Entry Point ** Main Entry Point
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp") #+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
(defun main () (defun main ()
"Initializes ncurses and starts the TUI event loop." "Initializes ncurses and starts the TUI event loop."
(handler-case (handler-case

22
skills/org-skill-bouncer.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-bouncer.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-bouncer.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: bouncer-agent-skill :ID: bouncer-agent-skill
:CREATED: [2026-04-11 Sat 15:20] :CREATED: [2026-04-11 Sat 15:20]
@@ -22,7 +22,7 @@ Think of Policy as the constitution and Bouncer as the bouncer at the door:
High-risk actions don't simply pass or fail—they can enter the "Flight Plan" approval workflow: High-risk actions don't simply pass or fail—they can enter the "Flight Plan" approval workflow:
1. Bouncer intercepts a risky action 1. Bouncer intercepts a risky action
2. Creates an Org node ("Flight Plan") describing the action 2. Creates an Org node ("Flight Plan describing the action
3. User manually approves the flight plan in Emacs 3. User manually approves the flight plan in Emacs
4. Bouncer detects approval on next heartbeat 4. Bouncer detects approval on next heartbeat
5. Action is re-injected with `approved = t` flag, bypassing the gate 5. Action is re-injected with `approved = t` flag, bypassing the gate
@@ -94,11 +94,11 @@ Detects when shell commands try to send data to untrusted network destinations.
#+begin_src lisp #+begin_src lisp
(defvar *bouncer-network-whitelist* (defvar *bouncer-network-whitelist*
'("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com") '("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com
"Domains that the Bouncer considers safe for outbound connections. "Domains that the Bouncer considers safe for outbound connections.
This whitelist should be minimal—only services explicitly configured This whitelist should be minimal—only services explicitly configured
as gateways. All other outbound connections require approval.") as gateways. All other outbound connections require approval.
(defun bouncer-check-network-exfil (cmd) (defun bouncer-check-network-exfil (cmd)
"Detects if CMD attempts to contact an unwhitelisted external host. "Detects if CMD attempts to contact an unwhitelisted external host.
@@ -156,7 +156,7 @@ Detects when shell commands try to send data to untrusted network destinations.
;; Extract cmd from direct shell or tool-mediated shell call ;; Extract cmd from direct shell or tool-mediated shell call
(cmd (or (getf payload :cmd) (cmd (or (getf payload :cmd)
(when (and (eq target :tool) (when (and (eq target :tool)
(equal (getf payload :tool) "shell")) (equal (getf payload :tool) "shell)
(getf (getf payload :args) :cmd)))) (getf (getf payload :args) :cmd))))
(approved (getf action :approved))) (approved (getf action :approved)))
@@ -179,10 +179,10 @@ Detects when shell commands try to send data to untrusted network destinations.
;; Shell commands targeting unknown hosts require approval ;; Shell commands targeting unknown hosts require approval
((and (or (eq target :shell) ((and (or (eq target :shell)
(and (eq target :tool) (and (eq target :tool)
(equal (getf payload :tool) "shell"))) (equal (getf payload :tool) "shell))
(bouncer-check-network-exfil cmd)) (bouncer-check-network-exfil cmd))
(harness-log "SECURITY WARNING: External network call detected. Queuing for approval.") (harness-log "SECURITY WARNING: External network call detected. Queuing for approval.
(list :type :EVENT (list :type :EVENT
:payload (list :sensor :approval-required :payload (list :sensor :approval-required
@@ -192,7 +192,7 @@ Detects when shell commands try to send data to untrusted network destinations.
;; Shell execution, file repair, and eval require approval ;; Shell execution, file repair, and eval require approval
((or (member target '(:shell)) ((or (member target '(:shell))
(and (eq target :tool) (and (eq target :tool)
(member (getf payload :tool) '("shell" "repair-file") :test #'string=)) (member (getf payload :tool) '("shell" "repair-file :test #'string=))
(and (eq target :emacs) (and (eq target :emacs)
(eq (getf payload :action) :eval))) (eq (getf payload :action) :eval)))
@@ -234,7 +234,7 @@ When a flight plan is approved in Emacs, the Bouncer detects it and re-injects t
Returns T if any flight plans were processed." Returns T if any flight plans were processed."
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED")) (let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED)
(found-any nil)) (found-any nil))
(dolist (node approved-nodes) (dolist (node approved-nodes)
@@ -259,7 +259,7 @@ When a flight plan is approved in Emacs, the Bouncer detects it and re-injects t
(inject-stimulus action) (inject-stimulus action)
;; Mark the flight plan as done ;; Mark the flight plan as done
(setf (getf (org-object-attributes node) :TODO) "DONE") (setf (getf (org-object-attributes node) :TODO) "DONE
(setq found-any t)))))) (setq found-any t))))))
@@ -299,7 +299,7 @@ When the Bouncer intercepts a high-risk action, it creates a flight plan node fo
:attributes (list :attributes (list
:TITLE "Flight Plan: High-Risk Action" :TITLE "Flight Plan: High-Risk Action"
:TODO "PLAN" :TODO "PLAN"
:TAGS '("FLIGHT_PLAN") :TAGS '("FLIGHT_PLAN
:ACTION (format nil "~s" blocked-action)))))) :ACTION (format nil "~s" blocked-action))))))
#+end_src #+end_src

18
skills/org-skill-cli-gateway.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-cli-gateway.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-cli-gateway.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: cli-gateway-skill :ID: cli-gateway-skill
:CREATED: [2026-04-13 Mon 17:00] :CREATED: [2026-04-13 Mon 17:00]
@@ -31,21 +31,21 @@ The *CLI Gateway* is the primary sensory and actuating interface for human inter
(finish-output stream) (finish-output stream)
(format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING))) (format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING)))
(finish-output stream)) (finish-output stream))
(harness-log "CLI ERROR: No active or open reply stream for signal.")) (harness-log "CLI ERROR: No active or open reply stream for signal.)
(error (c) (harness-log "CLI ACTUATOR ERROR: ~a" c))))) (error (c) (harness-log "CLI ACTUATOR ERROR: ~a" c)))))
(defun handle-cli-slash-command (cmd stream) (defun handle-cli-slash-command (cmd stream)
(cond (cond
((string= cmd "/exit") (return-from handle-cli-slash-command :exit)) ((string= cmd "/exit (return-from handle-cli-slash-command :exit))
(t (format stream "~a" (frame-message (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (format nil "Unknown command: ~a" cmd)))))))) (t (format stream "~a" (frame-message (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (format nil "Unknown command: ~a" cmd))))))))
(defun handle-cli-client (stream) (defun handle-cli-client (stream)
"Reads framed messages from a CLI client and injects them as stimuli." "Reads framed messages from a CLI client and injects them as stimuli."
(harness-log "CLI: Client connected.") (harness-log "CLI: Client connected.
(handler-case (handler-case
(progn (progn
;; 1. Send Handshake ;; 1. Send Handshake
(format stream "~a" (frame-message (make-hello-message "0.1.0"))) (format stream "~a" (frame-message (make-hello-message "0.1.0))
(finish-output stream) (finish-output stream)
(format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING))) (format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING)))
(finish-output stream) (finish-output stream)
@@ -63,11 +63,11 @@ The *CLI Gateway* is the primary sensory and actuating interface for human inter
(progn (progn
;; Default meta if missing ;; Default meta if missing
(unless meta (unless meta
(setf (getf msg :meta) (list :SOURCE :CLI :SESSION-ID "default"))) (setf (getf msg :meta) (list :SOURCE :CLI :SESSION-ID "default))
(harness-log "CLI: Received input -> ~s" msg) (harness-log "CLI: Received input -> ~s" msg)
(inject-stimulus msg :stream stream))))))))) (inject-stimulus msg :stream stream)))))))))
(error (c) (harness-log "CLI CLIENT DISCONNECT: ~a" c))) (error (c) (harness-log "CLI CLIENT DISCONNECT: ~a" c)))
(harness-log "CLI: Client disconnected.")) (harness-log "CLI: Client disconnected.)
(defun start-cli-gateway (&optional (port *cli-port*)) (defun start-cli-gateway (&optional (port *cli-port*))
"Starts the TCP listener for local CLI clients." "Starts the TCP listener for local CLI clients."
@@ -82,9 +82,9 @@ The *CLI Gateway* is the primary sensory and actuating interface for human inter
(bt:make-thread (lambda () (bt:make-thread (lambda ()
(unwind-protect (handle-cli-client stream) (unwind-protect (handle-cli-client stream)
(usocket:socket-close socket))) (usocket:socket-close socket)))
:name "opencortex-cli-client-handler"))) :name "opencortex-cli-client-handler))
(usocket:socket-close *cli-server-socket*))) (usocket:socket-close *cli-server-socket*)))
:name "opencortex-cli-gateway")) :name "opencortex-cli-gateway)
(harness-log "CLI: Gateway listening on port ~a" port)) (harness-log "CLI: Gateway listening on port ~a" port))
(register-actuator :CLI #'execute-cli-action) (register-actuator :CLI #'execute-cli-action)

98
skills/org-skill-config-manager.org
View File

@@ -16,78 +16,78 @@ Secrets are appended to `~/.config/opencortex/.env`, while structural metadata i
* Phase B: Protocol (Success Criteria) * Phase B: Protocol (Success Criteria)
** Test Suite Context ** Test Suite Context
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/config-manager-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/config-manager-tests.lisp")" )
(defpackage :opencortex-config-manager-tests (defpackage :opencortex-config-manager-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:config-suite)) (:export #:config-suite))
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/config-manager-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/config-manager-tests.lisp")" )
(in-package :opencortex-config-manager-tests) (in-package :opencortex-config-manager-tests)
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/config-manager-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/config-manager-tests.lisp")" )
(def-suite config-suite :description "Verification of the Config Manager skill") (def-suite config-suite :description "Verification of the Config Manager skill
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/config-manager-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/config-manager-tests.lisp")" )
(in-suite config-suite) (in-suite config-suite)
#+end_src #+end_src
** Registry Tests ** Registry Tests
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/config-manager-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/config-manager-tests.lisp")" )
(test test-provider-registration (test test-provider-registration
"Verify that multiple providers can be registered and saved." "Verify that multiple providers can be registered and saved."
(let ((opencortex::*providers* nil)) (let ((opencortex::*providers* nil))
(opencortex:register-provider :ollama '(:url "http://localhost:11434")) (opencortex:register-provider :ollama '(:url "http://localhost:11434)
(is (equal "http://localhost:11434" (getf (getf opencortex::*providers* :ollama) :url))))) (is (equal "http://localhost:11434" (getf (getf opencortex::*providers* :ollama) :url)))))
(test test-get-oc-config-dir-default (test test-get-oc-config-dir-default
"Verify get-oc-config-dir returns XDG-compliant path when env not set." "Verify get-oc-config-dir returns XDG-compliant path when env not set."
(let ((orig-env (getenv "OC_CONFIG_DIR"))) (let ((orig-env (getenv "OC_CONFIG_DIR))
(unwind-protect (unwind-protect
(progn (progn
(setf (getenv "OC_CONFIG_DIR") nil) (setf (getenv "OC_CONFIG_DIR nil)
(let ((dir (opencortex:get-oc-config-dir))) (let ((dir (opencortex:get-oc-config-dir)))
(is (search ".config/opencortex" (namestring dir))))) (is (search ".config/opencortex" (namestring dir)))))
(if orig-env (if orig-env
(setf (getenv "OC_CONFIG_DIR") orig-env) (setf (getenv "OC_CONFIG_DIR orig-env)
(setf (getenv "OC_CONFIG_DIR") nil))))) (setf (getenv "OC_CONFIG_DIR nil)))))
(test test-get-oc-config-dir-env-override (test test-get-oc-config-dir-env-override
"Verify get-oc-config-dir uses OC_CONFIG_DIR when set." "Verify get-oc-config-dir uses OC_CONFIG_DIR when set."
(let ((orig-env (getenv "OC_CONFIG_DIR"))) (let ((orig-env (getenv "OC_CONFIG_DIR))
(unwind-protect (unwind-protect
(progn (progn
(setf (getenv "OC_CONFIG_DIR") "/tmp/test-opencortex-config") (setf (getenv "OC_CONFIG_DIR "/tmp/test-opencortex-config
(let ((dir (opencortex:get-oc-config-dir))) (let ((dir (opencortex:get-oc-config-dir)))
(is (string= "/tmp/test-opencortex-config/" (namestring dir))))) (is (string= "/tmp/test-opencortex-config/" (namestring dir)))))
(if orig-env (if orig-env
(setf (getenv "OC_CONFIG_DIR") orig-env) (setf (getenv "OC_CONFIG_DIR orig-env)
(setf (getenv "OC_CONFIG_DIR") nil))))) (setf (getenv "OC_CONFIG_DIR nil)))))
(test test-save-providers-roundtrip (test test-save-providers-roundtrip
"Verify save-providers writes and providers can be reloaded." "Verify save-providers writes and providers can be reloaded."
(let ((opencortex::*providers* nil) (let ((opencortex::*providers* nil)
(test-dir "/tmp/test-opencortex-config/") (test-dir "/tmp/test-opencortex-config/
(orig-env (getenv "OC_CONFIG_DIR"))) (orig-env (getenv "OC_CONFIG_DIR))
(unwind-protect (unwind-protect
(progn (progn
(setf (getenv "OC_CONFIG_DIR") test-dir) (setf (getenv "OC_CONFIG_DIR test-dir)
(opencortex:register-provider :openai '(:key "test-key-123" :model "gpt-4")) (opencortex:register-provider :openai '(:key "test-key-123" :model "gpt-4)
(opencortex:save-providers) (opencortex:save-providers)
(let ((loaded-provs (uiop:read-file-string (merge-pathnames "providers.lisp" (uiop:ensure-directory-pathname test-dir))))) (let ((loaded-provs (uiop:read-file-string (merge-pathnames "providers.lisp" (uiop:ensure-directory-pathname test-dir)))))
(is (search "openai" loaded-provs)) (is (search "openai" loaded-provs))
(is (search "test-key-123" loaded-provs)))) (is (search "test-key-123" loaded-provs))))
(uiop:delete-directory-tree (uiop:ensure-directory-pathname test-dir) :validate t) (uiop:delete-directory-tree (uiop:ensure-directory-pathname test-dir) :validate t)
(if orig-env (if orig-env
(setf (getenv "OC_CONFIG_DIR") orig-env) (setf (getenv "OC_CONFIG_DIR orig-env)
(setf (getenv "OC_CONFIG_DIR") nil))))) (setf (getenv "OC_CONFIG_DIR nil)))))
(test test-configure-provider-validation (test test-configure-provider-validation
"Verify configure-provider validates required fields." "Verify configure-provider validates required fields."
(let ((opencortex::*providers* nil)) (let ((opencortex::*providers* nil))
(opencortex:register-provider :ollama '(:url "http://localhost:11434")) (opencortex:register-provider :ollama '(:url "http://localhost:11434)
(let ((cfg (getf opencortex::*providers* :ollama))) (let ((cfg (getf opencortex::*providers* :ollama)))
(is (equal "http://localhost:11434" (getf cfg :url)))))) (is (equal "http://localhost:11434" (getf cfg :url))))))
#+end_src #+end_src
@@ -95,39 +95,39 @@ Secrets are appended to `~/.config/opencortex/.env`, while structural metadata i
* Phase C: Implementation (Build) * Phase C: Implementation (Build)
** Package Context ** Package Context
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-config-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-config-manager.lisp")" )
(in-package :opencortex) (in-package :opencortex)
#+end_src #+end_src
** Skill Metadata ** Skill Metadata
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-config-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-config-manager.lisp")" )
(defparameter *skill-config-manager* (defparameter *skill-config-manager*
'(:name "config-manager" '(:name "config-manager"
:description "Manages system settings and LLM provider configurations." :description "Manages system settings and LLM provider configurations."
:capabilities (:configure-provider :run-setup-wizard) :capabilities (:configure-provider :run-setup-wizard)
:type :deterministic) :type :deterministic)
"Skill metadata for the Config Manager.") "Skill metadata for the Config Manager.
#+end_src #+end_src
** Provider Templates ** Provider Templates
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-config-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-config-manager.lisp")" )
(defvar *provider-templates* (defvar *provider-templates*
'((:ollama . (:name "Ollama (Local)" :fields ((:url :label "URL") (:model :label "Model")) :default-url "http://localhost:11434" :default-model "llama3")) '((:ollama . (:name "Ollama (Local)" :fields ((:url :label "URL (:model :label "Model) :default-url "http://localhost:11434" :default-model "llama3)
(:openrouter . (:name "OpenRouter" :fields ((:key :label "API Key" :secret t) (:model :label "Model")) :default-model "anthropic/claude-3-opus-20240229")) (:openrouter . (:name "OpenRouter" :fields ((:key :label "API Key" :secret t) (:model :label "Model) :default-model "anthropic/claude-3-opus-20240229)
(:openai . (:name "OpenAI" :fields ((:key :label "API Key" :secret t) (:model :label "Model")) :default-model "gpt-4-turbo")) (:openai . (:name "OpenAI" :fields ((:key :label "API Key" :secret t) (:model :label "Model) :default-model "gpt-4-turbo)
(:groq . (:name "Groq" :fields ((:key :label "API Key" :secret t) (:model :label "Model")) :default-model "mixtral-8x7b-32768")) (:groq . (:name "Groq" :fields ((:key :label "API Key" :secret t) (:model :label "Model) :default-model "mixtral-8x7b-32768)
(:gemini . (:name "Google Gemini" :fields ((:key :label "API Key" :secret t) (:model :label "Model")) :default-model "gemini-1.5-pro")) (:gemini . (:name "Google Gemini" :fields ((:key :label "API Key" :secret t) (:model :label "Model) :default-model "gemini-1.5-pro)
(:anthropic . (:name "Anthropic" :fields ((:key :label "API Key" :secret t) (:model :label "Model")) :default-model "claude-3-5-sonnet-20240620"))) (:anthropic . (:name "Anthropic" :fields ((:key :label "API Key" :secret t) (:model :label "Model) :default-model "claude-3-5-sonnet-20240620))
"Templates for supported LLM providers.") "Templates for supported LLM providers.
#+end_src #+end_src
** Registry Persistence ** Registry Persistence
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-config-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-config-manager.lisp")" )
(defvar *providers* nil "Global registry of configured LLM providers.") (defvar *providers* nil "Global registry of configured LLM providers.
(defun get-oc-config-dir () (defun get-oc-config-dir ()
"Returns the XDG-compliant config directory for OpenCortex." "Returns the XDG-compliant config directory for OpenCortex."
(let ((env (getenv "OC_CONFIG_DIR"))) (let ((env (getenv "OC_CONFIG_DIR))
(if (and env (> (length env) 0)) (if (and env (> (length env) 0))
(uiop:ensure-directory-pathname env) (uiop:ensure-directory-pathname env)
(uiop:merge-pathnames* ".config/opencortex/" (user-homedir-pathname))))) (uiop:merge-pathnames* ".config/opencortex/" (user-homedir-pathname)))))
@@ -144,8 +144,8 @@ Secrets are appended to `~/.config/opencortex/.env`, while structural metadata i
(format t "~a~@[ [~a]~]: " label default) (format t "~a~@[ [~a]~]: " label default)
(finish-output) (finish-output)
(let ((input (read-line))) (let ((input (read-line)))
(if (string= input "") (if (string= input "
(or default "") (or default "
input))) input)))
(defun save-secret (provider field val) (defun save-secret (provider field val)
@@ -159,14 +159,14 @@ Secrets are appended to `~/.config/opencortex/.env`, while structural metadata i
#+end_src #+end_src
** Registry API ** Registry API
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-config-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-config-manager.lisp")" )
(defun register-provider (id config) (defun register-provider (id config)
"Update the global provider registry." "Update the global provider registry."
(setf (getf *providers* id) config)) (setf (getf *providers* id) config))
#+end_src #+end_src
** Setup Wizard Implementation ** Setup Wizard Implementation
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-config-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-config-manager.lisp")" )
(defun configure-provider (id) (defun configure-provider (id)
"Guided configuration for a specific LLM provider template." "Guided configuration for a specific LLM provider template."
(let* ((template (cdr (assoc id *provider-templates*))) (let* ((template (cdr (assoc id *provider-templates*)))
@@ -187,26 +187,26 @@ Secrets are appended to `~/.config/opencortex/.env`, while structural metadata i
(format t "✓ ~a metadata registered.~%" (getf template :name)))) (format t "✓ ~a metadata registered.~%" (getf template :name))))
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-config-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-config-manager.lisp")" )
(defun run-setup-wizard () (defun run-setup-wizard ()
"Entry point for the interactive OpenCortex Lisp Setup Wizard." "Entry point for the interactive OpenCortex Lisp Setup Wizard."
(format t "=== OpenCortex: Advanced Setup Wizard ===~%") (format t "=== OpenCortex: Advanced Setup Wizard ===~%
(let ((user (prompt-for "Your Name" "User")) (let ((user (prompt-for "Your Name" "User)
(agent (prompt-for "Agent Name" "OpenCortex"))) (agent (prompt-for "Agent Name" "OpenCortex))
(format t "Welcome, ~a. I am ~a.~%" user agent)) (format t "Welcome, ~a. I am ~a.~%" user agent))
(format t "~%Available Providers:~%") (format t "~%Available Providers:~%
(loop for (id . data) in *provider-templates* do (format t " ~a: ~a~%" id (getf data :name))) (loop for (id . data) in *provider-templates* do (format t " ~a: ~a~%" id (getf data :name)))
(format t "~%Enter provider IDs to configure (comma separated, or 'all'): ") (format t "~%Enter provider IDs to configure (comma separated, or 'all'):
(finish-output) (finish-output)
(let* ((input (read-line)) (let* ((input (read-line))
(ids (if (string= input "all") (ids (if (string= input "all
(mapcar #'car *provider-templates*) (mapcar #'car *provider-templates*)
(mapcar (lambda (s) (intern (string-upcase (string-trim " " s)) :keyword)) (mapcar (lambda (s) (intern (string-upcase (string-trim " " s)) :keyword))
(uiop:split-string input :separator ","))))) (uiop:split-string input :separator ",))))
(dolist (id ids) (dolist (id ids)
(when (assoc id *provider-templates*) (when (assoc id *provider-templates*)
(configure-provider id)))) (configure-provider id))))
(save-providers) (save-providers)
(format t "~%Setup complete. Running diagnostics...~%") (format t "~%Setup complete. Running diagnostics...~%
(doctor-run-all)) (doctor-run-all))
#+end_src #+end_src

50
skills/org-skill-credentials-vault.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-credentials-vault.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-credentials-vault.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: credentials-vault-skill :ID: credentials-vault-skill
:CREATED: [2026-04-09 Thu] :CREATED: [2026-04-09 Thu]
@@ -36,10 +36,10 @@ The vault provides a secure lookup table in RAM, backed by the persistent Memory
** 2. Semantic Interfaces ** 2. Semantic Interfaces
#+begin_src lisp #+begin_src lisp
(defun vault-get-secret (provider &key type) (defun vault-get-secret (provider &key type)
"Retrieves a secret (api-key or session) for a provider.") "Retrieves a secret (api-key or session) for a provider.
(defun vault-set-secret (provider secret &key type) (defun vault-set-secret (provider secret &key type)
"Securely stores a secret and triggers a Merkle snapshot.") "Securely stores a secret and triggers a Merkle snapshot.
#+end_src #+end_src
* Phase C: Success (QUALITY) * Phase C: Success (QUALITY)
@@ -54,7 +54,7 @@ The vault provides a secure lookup table in RAM, backed by the persistent Memory
- [ ] *Onboarding Verification:* The cookie handshake successfully hydrates the vault. - [ ] *Onboarding Verification:* The cookie handshake successfully hydrates the vault.
** 2. TDD Plan ** 2. TDD Plan
Tests in `tests/vault-tests.lisp` will verify: Tests in `vault-tests.lisp` will verify:
1. Retrieval of keys from both `.env` (fallback) and Vault (primary). 1. Retrieval of keys from both `.env` (fallback) and Vault (primary).
2. Redaction of keys in log strings. 2. Redaction of keys in log strings.
3. Successful version increment in the Memory after `vault-set-secret`. 3. Successful version increment in the Memory after `vault-set-secret`.
@@ -70,7 +70,7 @@ We maintain an in-memory hash table for secrets, which is hydrated from and pers
#+begin_src lisp #+begin_src lisp
(defvar opencortex::*vault-memory* (make-hash-table :test 'equal) (defvar opencortex::*vault-memory* (make-hash-table :test 'equal)
"In-memory cache of sensitive credentials.") "In-memory cache of sensitive credentials.
#+end_src #+end_src
** Helper: Secret Masking ** Helper: Secret Masking
@@ -81,7 +81,7 @@ The `vault-mask-string` function ensures that diagnostic output never contains t
"Returns a masked version of a sensitive string." "Returns a masked version of a sensitive string."
(if (and str (> (length str) 8)) (if (and str (> (length str) 8))
(format nil "~a...~a" (subseq str 0 4) (subseq str (- (length str) 4))) (format nil "~a...~a" (subseq str 0 4) (subseq str (- (length str) 4)))
"[REDACTED]")) "[REDACTED])
#+end_src #+end_src
** Retrieval (vault-get-secret) ** Retrieval (vault-get-secret)
@@ -96,15 +96,15 @@ This function is the secure getter for all system secrets. It prioritizes the Va
val val
;; Fallback to environment ;; Fallback to environment
(let ((env-var (case provider (let ((env-var (case provider
((:gemini :gemini-api) "GEMINI_API_KEY") ((:gemini :gemini-api) "GEMINI_API_KEY
(:openai "OPENAI_API_KEY") (:openai "OPENAI_API_KEY
(:anthropic "ANTHROPIC_API_KEY") (:anthropic "ANTHROPIC_API_KEY
(:groq "GROQ_API_KEY") (:groq "GROQ_API_KEY
(:openrouter "OPENROUTER_API_KEY") (:openrouter "OPENROUTER_API_KEY
(:telegram "TELEGRAM_BOT_TOKEN") (:telegram "TELEGRAM_BOT_TOKEN
(:signal "SIGNAL_ACCOUNT_NUMBER") (:signal "SIGNAL_ACCOUNT_NUMBER
(:matrix-homeserver "MATRIX_HOMESERVER") (:matrix-homeserver "MATRIX_HOMESERVER
(:matrix-token "MATRIX_ACCESS_TOKEN") (:matrix-token "MATRIX_ACCESS_TOKEN
(t nil)))) (t nil))))
(when (and env-var (eq type :api-key)) (when (and env-var (eq type :api-key))
(getenv env-var)))))) (getenv env-var))))))
@@ -129,11 +129,11 @@ Retained from the legacy Google skill, this provides the instructions for the au
#+begin_src lisp #+begin_src lisp
(defun vault-onboard-gemini-web () (defun vault-onboard-gemini-web ()
"Instructions for the Autonomous Cookie Handshake." "Instructions for the Autonomous Cookie Handshake."
(harness-log "--- GEMINI WEB ONBOARDING ---") (harness-log "--- GEMINI WEB ONBOARDING ---
(harness-log "1. Visit gemini.google.com") (harness-log "1. Visit gemini.google.com
(harness-log "2. Run the 'Get Gemini Cookies' Bookmarklet.") (harness-log "2. Run the 'Get Gemini Cookies' Bookmarklet.
(harness-log " CODE: javascript:(function(){const c=document.cookie.split('; ').reduce((r,v)=>{const [n,val]=v.split('=');r[n]=val;return r},{});const target=['__Secure-1PSID','__Secure-1PSIDTS'];const out=target.map(n=>({name:n,value:c[n]}));prompt('Copy JSON:',JSON.stringify(out));})();") (harness-log " CODE: javascript:(function(){const c=document.cookie.split('; ').reduce((r,v)=>{const [n,val]=v.split('=');r[n]=val;return r},{});const target=['__Secure-1PSID','__Secure-1PSIDTS'];const out=target.map(n=>({name:n,value:c[n]}));prompt('Copy JSON:',JSON.stringify(out));})();
(harness-log "PLATFORM GUIDE: Chrome/Firefox/Safari all support Bookmarklets via 'Add Page' or 'New Bookmark'.") (harness-log "PLATFORM GUIDE: Chrome/Firefox/Safari all support Bookmarklets via 'Add Page' or 'New Bookmark'.
t) t)
#+end_src #+end_src
@@ -154,23 +154,23 @@ Retained from the legacy Google skill, this provides the instructions for the au
Note: Tests disabled in jail load. Note: Tests disabled in jail load.
** 1. Unit Tests (FiveAM) ** 1. Unit Tests (FiveAM)
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-credentials-vault.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-credentials-vault.lisp")" )
#| #|
(defpackage :opencortex-vault-tests (defpackage :opencortex-vault-tests
(:use :cl :fiveam :opencortex)) (:use :cl :fiveam :opencortex))
(in-package :opencortex-vault-tests) (in-package :opencortex-vault-tests)
(def-suite vault-suite :description "Tests for the Credentials Vault.") (def-suite vault-suite :description "Tests for the Credentials Vault.
(in-suite vault-suite) (in-suite vault-suite)
(test test-masking (test test-masking
(is (equal "sk-t...-key" (opencortex::vault-mask-string "sk-test-key"))) (is (equal "sk-t...-key" (opencortex::vault-mask-string "sk-test-key))
(is (equal "[REDACTED]" (opencortex::vault-mask-string "short")))) (is (equal "[REDACTED]" (opencortex::vault-mask-string "short)))
(test test-vault-persistence (test test-vault-persistence
"Verify that setting a secret triggers a snapshot (mock check)." "Verify that setting a secret triggers a snapshot (mock check)."
(let ((old-version (opencortex::org-object-version (gethash "root" *memory*)))) (let ((old-version (opencortex::org-object-version (gethash "root" *memory*))))
(opencortex:vault-set-secret :test "secret-val") (opencortex:vault-set-secret :test "secret-val
(is (> (opencortex::org-object-version (gethash "root" *memory*)) old-version)))) (is (> (opencortex::org-object-version (gethash "root" *memory*)) old-version))))
|# |#
#+end_src #+end_src

68
skills/org-skill-diagnostics.org
View File

@@ -18,61 +18,61 @@ The skill strictly validates the POSIX standard paths resolved during bootstrap,
* Phase B: Protocol (Success Criteria) * Phase B: Protocol (Success Criteria)
** Test Suite Context ** Test Suite Context
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/diagnostics-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/diagnostics-tests.lisp")" )
(defpackage :opencortex-diagnostics-tests (defpackage :opencortex-diagnostics-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:diagnostics-suite)) (:export #:diagnostics-suite))
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/diagnostics-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/diagnostics-tests.lisp")" )
(in-package :opencortex-diagnostics-tests) (in-package :opencortex-diagnostics-tests)
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/diagnostics-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/diagnostics-tests.lisp")" )
(def-suite diagnostics-suite :description "Verification of the Diagnostics skill") (def-suite diagnostics-suite :description "Verification of the Diagnostics skill
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/diagnostics-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/diagnostics-tests.lisp")" )
(in-suite diagnostics-suite) (in-suite diagnostics-suite)
#+end_src #+end_src
** Dependency Tests ** Dependency Tests
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/diagnostics-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/diagnostics-tests.lisp")" )
(test test-dependency-check-fail (test test-dependency-check-fail
"Verify that missing binaries are correctly identified as failures." "Verify that missing binaries are correctly identified as failures."
(let ((opencortex::*doctor-required-binaries* '("non-existent-binary-123"))) (let ((opencortex::*doctor-required-binaries* '("non-existent-binary-123))
(is (null (opencortex:doctor-check-dependencies))))) (is (null (opencortex:doctor-check-dependencies)))))
#+end_src #+end_src
* Phase C: Implementation (Build) * Phase C: Implementation (Build)
** Package Context ** Package Context
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-diagnostics.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-diagnostics.lisp")" )
(in-package :opencortex) (in-package :opencortex)
#+end_src #+end_src
** Skill Metadata ** Skill Metadata
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-diagnostics.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-diagnostics.lisp")" )
(defparameter *skill-diagnostics* (defparameter *skill-diagnostics*
'(:name "diagnostics" '(:name "diagnostics"
:description "Performs system health checks and environment validation." :description "Performs system health checks and environment validation."
:capabilities (:run-diagnostics) :capabilities (:run-diagnostics)
:type :deterministic) :type :deterministic)
"Skill metadata for the Diagnostics component.") "Skill metadata for the Diagnostics component.
#+end_src #+end_src
** Global Configuration ** Global Configuration
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-diagnostics.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-diagnostics.lisp")" )
(defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc") (defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc
"List of external binaries required for full system operation.") "List of external binaries required for full system operation.
#+end_src #+end_src
** Dependency Verification ** Dependency Verification
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-diagnostics.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-diagnostics.lisp")" )
(defun doctor-check-dependencies () (defun doctor-check-dependencies ()
"Verifies that required external binaries are available in the PATH via a shell probe." "Verifies that required external binaries are available in the PATH via a shell probe."
(let ((all-ok t)) (let ((all-ok t))
(harness-log "DOCTOR: Checking system dependencies...") (harness-log "DOCTOR: Checking system dependencies...
(dolist (dep *doctor-required-binaries*) (dolist (dep *doctor-required-binaries*)
(let ((path (ignore-errors (let ((path (ignore-errors
(uiop:run-program (list "which" dep) (uiop:run-program (list "which" dep)
@@ -86,15 +86,15 @@ The skill strictly validates the POSIX standard paths resolved during bootstrap,
#+end_src #+end_src
** Environment & XDG Validation ** Environment & XDG Validation
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-diagnostics.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-diagnostics.lisp")" )
(defun doctor-check-env () (defun doctor-check-env ()
"Validates XDG directories and environment configuration against the POSIX standard." "Validates XDG directories and environment configuration against the POSIX standard."
(harness-log "DOCTOR: Checking XDG environment...") (harness-log "DOCTOR: Checking XDG environment...
(let ((all-ok t) (let ((all-ok t)
(config-dir (getenv "OC_CONFIG_DIR")) (config-dir (getenv "OC_CONFIG_DIR)
(data-dir (getenv "OC_DATA_DIR")) (data-dir (getenv "OC_DATA_DIR)
(state-dir (getenv "OC_STATE_DIR")) (state-dir (getenv "OC_STATE_DIR)
(memex-dir (getenv "MEMEX_DIR"))) (memex-dir (getenv "MEMEX_DIR))
(flet ((check-dir (name path critical) (flet ((check-dir (name path critical)
(if (and path (> (length path) 0)) (if (and path (> (length path) 0))
@@ -115,42 +115,42 @@ The skill strictly validates the POSIX standard paths resolved during bootstrap,
#+end_src #+end_src
** LLM Connectivity ** LLM Connectivity
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-diagnostics.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-diagnostics.lisp")" )
(defun doctor-check-llm () (defun doctor-check-llm ()
"Tests connectivity to primary LLM providers. Non-critical fallback allowed." "Tests connectivity to primary LLM providers. Non-critical fallback allowed."
(harness-log "DOCTOR: Checking LLM connectivity...") (harness-log "DOCTOR: Checking LLM connectivity...
(let ((openrouter-key (getenv "OPENROUTER_API_KEY"))) (let ((openrouter-key (getenv "OPENROUTER_API_KEY))
(if (and openrouter-key (> (length openrouter-key) 0)) (if (and openrouter-key (> (length openrouter-key) 0))
(progn (progn
(harness-log " [OK] OpenRouter API Key detected.") (harness-log " [OK] OpenRouter API Key detected.
t) t)
(progn (progn
(harness-log " [WARN] No OpenRouter API Key. Falling back to local inference only.") (harness-log " [WARN] No OpenRouter API Key. Falling back to local inference only.
t)))) t))))
#+end_src #+end_src
** Orchestration ** Orchestration
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-diagnostics.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-diagnostics.lisp")" )
(defun doctor-run-all () (defun doctor-run-all ()
"Executes the full diagnostic suite and returns T if system is healthy." "Executes the full diagnostic suite and returns T if system is healthy."
(harness-log "==================================================") (harness-log "==================================================
(harness-log " OPENCORTEX DOCTOR: Commencing Health Check") (harness-log " OPENCORTEX DOCTOR: Commencing Health Check
(harness-log "==================================================") (harness-log "==================================================
(let ((dep-ok (doctor-check-dependencies)) (let ((dep-ok (doctor-check-dependencies))
(env-ok (doctor-check-env)) (env-ok (doctor-check-env))
(llm-ok (doctor-check-llm))) (llm-ok (doctor-check-llm)))
(harness-log "==================================================") (harness-log "==================================================
(if (and dep-ok env-ok) (if (and dep-ok env-ok)
(progn (progn
(harness-log " ✓ SYSTEM HEALTHY: Ready for ignition.") (harness-log " ✓ SYSTEM HEALTHY: Ready for ignition.
t) t)
(progn (progn
(harness-log " ✗ SYSTEM UNHEALTHY: Fix the errors above.") (harness-log " ✗ SYSTEM UNHEALTHY: Fix the errors above.
nil)))) nil))))
#+end_src #+end_src
** CLI Entry Point ** CLI Entry Point
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-diagnostics.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-diagnostics.lisp")" )
(defun doctor-main () (defun doctor-main ()
"Entry point for the 'doctor' CLI command." "Entry point for the 'doctor' CLI command."
(if (doctor-run-all) (if (doctor-run-all)

66
skills/org-skill-emacs-edit.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-emacs-edit.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-emacs-edit.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: emacs-edit-skill :ID: emacs-edit-skill
:CREATED: [2026-04-23 Thu] :CREATED: [2026-04-23 Thu]
@@ -91,11 +91,11 @@ Converts AST back to org format, preserving structure.
INDENT-LEVEL is number of leading asterisks." INDENT-LEVEL is number of leading asterisks."
(let* ((level (or indent-level 1)) (let* ((level (or indent-level 1))
(stars (make-string level :initial-element #\*)) (stars (make-string level :initial-element #\*))
(title (or (getf (getf ast :properties) :TITLE) "")) (title (or (getf (getf ast :properties) :TITLE)
(todo (getf (getf ast :properties) :TODO))) (todo (getf (getf ast :properties) :TODO)))
(format nil "~a ~a~%~a" (format nil "~a ~a~%~a"
stars stars
(if todo (format nil "[~a] " (string-upcase todo)) "") (if todo (format nil "[~a] " (string-upcase todo)) "
title))) title)))
(defun emacs-edit-print-properties (props) (defun emacs-edit-print-properties (props)
@@ -143,13 +143,13 @@ Preserves structure including #+begin_src blocks."
;; Code block (preserve exactly) ;; Code block (preserve exactly)
((eq type :src-block) ((eq type :src-block)
(let ((lang (or (getf ast :language) "")) (let ((lang (or (getf ast :language)
(code (or (getf ast :value) ""))) (code (or (getf ast :value) )
(format nil "#+begin_src ~a~%~a~%#+end_src~%" (format nil "#+begin_src ~a~%~a~%#+end_src~%"
lang code))) lang code)))
;; Unknown - return as-is ;; Unknown - return as-is
(t (format nil ""))))) (t (format nil )))
#+end_src #+end_src
** Read Operation ** Read Operation
@@ -157,7 +157,7 @@ Parse org file to AST.
#+begin_src lisp #+begin_src lisp
(defvar *org-parser-cache* (make-hash-table :test 'equal) (defvar *org-parser-cache* (make-hash-table :test 'equal)
"Cache for parsed org files.") "Cache for parsed org files.
(defun emacs-edit-parse-file (file-path) (defun emacs-edit-parse-file (file-path)
"Parses an org FILE-PATH using existing ingest-ast. "Parses an org FILE-PATH using existing ingest-ast.
@@ -203,7 +203,7 @@ Returns modified AST."
(let* ((new-id (emacs-edit-generate-id)) (let* ((new-id (emacs-edit-generate-id))
(new-props (list :ID new-id (new-props (list :ID new-id
:TITLE title :TITLE title
:TODO (or todo "TODO") :TODO (or todo "TODO
:CREATED (format nil "[~a]" :CREATED (format nil "[~a]"
(multiple-value-bind (s mi h d mo y) (multiple-value-bind (s mi h d mo y)
(decode-universal-time (get-universal-time)) (decode-universal-time (get-universal-time))
@@ -327,18 +327,18 @@ Exposes operations to the Probabilistic Engine.
(def-cognitive-tool :org-read (def-cognitive-tool :org-read
"Reads an org-mode file and parses it to structured AST. "Reads an org-mode file and parses it to structured AST.
Use this BEFORE modifying org files to understand their structure." Use this BEFORE modifying org files to understand their structure."
((:file :type :string :description "Path to the org file")) ((:file :type :string :description "Path to the org file)
:body (lambda (args) :body (lambda (args)
(let ((file (getf args :file))) (let ((file (getf args :file)))
(if (uiop:file-exists-p file) (if (uiop:file-exists-p file)
(emacs-edit-modify file :read) (emacs-edit-modify file :read)
(list :status :error :reason "File not found"))))) (list :status :error :reason "File not found))))
(def-cognitive-tool :org-write (def-cognitive-tool :org-write
"Writes previously parsed AST back to an org file. "Writes previously parsed AST back to an org file.
Use this AFTER modifications to save changes." Use this AFTER modifications to save changes."
((:file :type :string :description "Path to the org file") ((:file :type :string :description "Path to the org file
(:ast :type :list :description "The AST to write")) (:ast :type :list :description "The AST to write)
:body (lambda (args) :body (lambda (args)
(let ((file (getf args :file)) (let ((file (getf args :file))
(ast (getf args :ast))) (ast (getf args :ast)))
@@ -347,14 +347,14 @@ Use this AFTER modifications to save changes."
(def-cognitive-tool :org-add-headline (def-cognitive-tool :org-add-headline
"Adds a new headline to an org file." "Adds a new headline to an org file."
((:file :type :string :description "Path to the org file") ((:file :type :string :description "Path to the org file
(:title :type :string :description "Headline title") (:title :type :string :description "Headline title
(:todo :type :string :description "TODO state (default TODO)") (:todo :type :string :description "TODO state (default TODO)
(:properties :type :list :description "Plist of properties")) (:properties :type :list :description "Plist of properties)
:body (lambda (args) :body (lambda (args)
(let ((file (getf args :file)) (let ((file (getf args :file))
(title (getf args :title)) (title (getf args :title))
(todo (getf args :todo "TODO")) (todo (getf args :todo "TODO)
(properties (getf args :properties))) (properties (getf args :properties)))
(emacs-edit-modify file :add-headline (emacs-edit-modify file :add-headline
:params (list :title title :todo todo :properties properties)) :params (list :title title :todo todo :properties properties))
@@ -362,10 +362,10 @@ Use this AFTER modifications to save changes."
(def-cognitive-tool :org-set-property (def-cognitive-tool :org-set-property
"Sets a property on an existing headline (by ID or title)." "Sets a property on an existing headline (by ID or title)."
((:file :type :string :description "Path to the org file") ((:file :type :string :description "Path to the org file
(:target :type :string :description "Headline ID or title") (:target :type :string :description "Headline ID or title
(:property :type :string :description "Property name") (:property :type :string :description "Property name
(:value :type :string :description "Property value")) (:value :type :string :description "Property value)
:body (lambda (args) :body (lambda (args)
(let ((file (getf args :file)) (let ((file (getf args :file))
(target (getf args :target)) (target (getf args :target))
@@ -377,9 +377,9 @@ Use this AFTER modifications to save changes."
(def-cognitive-tool :org-set-todo (def-cognitive-tool :org-set-todo
"Sets the TODO state of a headline." "Sets the TODO state of a headline."
((:file :type :string :description "Path to the org file") ((:file :type :string :description "Path to the org file
(:target :type :string :description "Headline ID or title") (:target :type :string :description "Headline ID or title
(:state :type :string :description "New TODO state (TODO, DONE, etc)")) (:state :type :string :description "New TODO state (TODO, DONE, etc))
:body (lambda (args) :body (lambda (args)
(let ((file (getf args :file)) (let ((file (getf args :file))
(target (getf args :target)) (target (getf args :target))
@@ -390,7 +390,7 @@ Use this AFTER modifications to save changes."
#+end_src #+end_src
* Phase E: Chaos (Verification) * Phase E: Chaos (Verification)
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/emacs-edit-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/emacs-edit-tests.lisp")" )
(defpackage :opencortex-emacs-edit-tests (defpackage :opencortex-emacs-edit-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:emacs-edit-suite)) (:export #:emacs-edit-suite))
@@ -398,7 +398,7 @@ Use this AFTER modifications to save changes."
(in-package :opencortex-emacs-edit-tests) (in-package :opencortex-emacs-edit-tests)
(def-suite emacs-edit-suite (def-suite emacs-edit-suite
:description "Tests for Emacs Edit skill.") :description "Tests for Emacs Edit skill.
(in-suite emacs-edit-suite) (in-suite emacs-edit-suite)
@@ -409,22 +409,22 @@ Use this AFTER modifications to save changes."
(is (not (string= id1 id2))))) ;; Likely unique (is (not (string= id1 id2))))) ;; Likely unique
(test id-format (test id-format
(let ((formatted (emacs-edit-id-format "abc12345"))) (let ((formatted (emacs-edit-id-format "abc12345))
(is (search "id:" formatted)))) (is (search "id:" formatted))))
(test property-setter (test property-setter
(let ((ast (list :type :headline (let ((ast (list :type :headline
:properties (list :ID "id:test123" :TITLE "Test") :properties (list :ID "id:test123" :TITLE "Test
:contents nil))) :contents nil)))
(emacs-edit-set-property ast "id:test123" :STATUS "ACTIVE") (emacs-edit-set-property ast "id:test123" :STATUS "ACTIVE
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE")))) (is (string= (getf (getf ast :properties) :STATUS) "ACTIVE)))
(test todo-setter (test todo-setter
(let ((ast (list :type :headline (let ((ast (list :type :headline
:properties (list :ID "id:todo001" :TITLE "Task") :properties (list :ID "id:todo001" :TITLE "Task
:contents nil))) :contents nil)))
(emacs-edit-set-todo ast "id:todo001" "DONE") (emacs-edit-set-todo ast "id:todo001" "DONE
(is (string= (getf (getf ast :properties) :TODO) "DONE")))) (is (string= (getf (getf ast :properties) :TODO) "DONE)))
#+end_src #+end_src
* See Also * See Also

40
skills/org-skill-engineering-standards.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-engineering-standards.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-engineering-standards.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: 37f2b59f-4537-4cca-ac7f-5c24b9e2e773 :ID: 37f2b59f-4537-4cca-ac7f-5c24b9e2e773
:CREATED: [2026-03-30 Mon 21:16] :CREATED: [2026-03-30 Mon 21:16]
@@ -57,17 +57,17 @@ Every significant fix or architectural decision MUST be documented in an org fil
* Enforcement Implementation * Enforcement Implementation
** Package Context ** Package Context
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-engineering-standards.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-engineering-standards.lisp")" )
(in-package :opencortex) (in-package :opencortex)
#+end_src #+end_src
** Global Configuration ** Global Configuration
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-engineering-standards.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-engineering-standards.lisp")" )
(defvar *engineering-std-project-root* nil (defvar *engineering-std-project-root* nil
"Path to the project root for enforcement checks.") "Path to the project root for enforcement checks.
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-engineering-standards.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-engineering-standards.lisp")" )
(defstruct engineering-violation (defstruct engineering-violation
(phase nil) (phase nil)
(rule nil) (rule nil)
@@ -76,7 +76,7 @@ Every significant fix or architectural decision MUST be documented in an org fil
#+end_src #+end_src
** CDD Utilities: Tier 1 ** CDD Utilities: Tier 1
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-engineering-standards.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-engineering-standards.lisp")" )
(defun check-structural-balance (file-path) (defun check-structural-balance (file-path)
"Tier 1 Chaos: Verifies that a Lisp file is syntactically balanced." "Tier 1 Chaos: Verifies that a Lisp file is syntactically balanced."
(handler-case (handler-case
@@ -90,56 +90,56 @@ Every significant fix or architectural decision MUST be documented in an org fil
#+end_src #+end_src
** Git Protocol ** Git Protocol
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-engineering-standards.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-engineering-standards.lisp")" )
(defun verify-git-clean-p (&optional (dir *engineering-std-project-root*)) (defun verify-git-clean-p (&optional (dir *engineering-std-project-root*))
"Returns T if the git repository at DIR has no uncommitted changes." "Returns T if the git repository at DIR has no uncommitted changes."
(when dir (when dir
(let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain") (let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain
:output :string :output :string
:ignore-error-status t))) :ignore-error-status t)))
(string= "" (string-trim '(#\Space #\Newline #\Tab) status))))) (string= "" (string-trim '(#\Space #\Newline #\Tab) status)))))
#+end_src #+end_src
** Initializer ** Initializer
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-engineering-standards.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-engineering-standards.lisp")" )
(defun engineering-std-init () (defun engineering-std-init ()
"Initialize the enforcement system." "Initialize the enforcement system."
(let ((env-root (or (getenv "OC_DATA_DIR") (let ((env-root (or (getenv "OC_DATA_DIR
"/home/user/.local/share/opencortex"))) "/home/user/.local/share/opencortex))
(setf *engineering-std-project-root* (uiop:ensure-directory-pathname env-root)) (setf *engineering-std-project-root* (uiop:ensure-directory-pathname env-root))
(harness-log "ENGINEERING STANDARDS: CDD Protocol Active."))) (harness-log "ENGINEERING STANDARDS: CDD Protocol Active.))
#+end_src #+end_src
;; Auto-initialize on load ;; Auto-initialize on load
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-engineering-standards.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-engineering-standards.lisp")" )
(engineering-std-init) (engineering-std-init)
#+end_src #+end_src
* Test Suite * Test Suite
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/engineering-standards-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/engineering-standards-tests.lisp")" )
(defpackage :opencortex-engineering-standards-tests (defpackage :opencortex-engineering-standards-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:engineering-standards-suite)) (:export #:engineering-standards-suite))
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/engineering-standards-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/engineering-standards-tests.lisp")" )
(in-package :opencortex-engineering-standards-tests) (in-package :opencortex-engineering-standards-tests)
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/engineering-standards-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/engineering-standards-tests.lisp")" )
(def-suite engineering-standards-suite (def-suite engineering-standards-suite
:description "Tests for Engineering Standards enforcement") :description "Tests for Engineering Standards enforcement
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/engineering-standards-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/engineering-standards-tests.lisp")" )
(in-suite engineering-standards-suite) (in-suite engineering-standards-suite)
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/engineering-standards-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/engineering-standards-tests.lisp")" )
(test git-clean-check-clean (test git-clean-check-clean
"verify-git-clean-p returns T when git tree is clean." "verify-git-clean-p returns T when git tree is clean."
(let ((tmp-dir "/tmp/eng-std-test-clean/")) (let ((tmp-dir "/tmp/eng-std-test-clean/)
(uiop:ensure-all-directories-exist (list tmp-dir)) (uiop:ensure-all-directories-exist (list tmp-dir))
(uiop:run-program (list "git" "init" tmp-dir) :output nil) (uiop:run-program (list "git" "init" tmp-dir) :output nil)
(is (eq t (opencortex::verify-git-clean-p (uiop:ensure-directory-pathname tmp-dir)))) (is (eq t (opencortex::verify-git-clean-p (uiop:ensure-directory-pathname tmp-dir))))

6
skills/org-skill-gardener.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-gardener.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-gardener.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: gardener-skill :ID: gardener-skill
:CREATED: [2026-04-13 Mon 18:50] :CREATED: [2026-04-13 Mon 18:50]
@@ -47,7 +47,7 @@ We track the last audit time to ensure the Gardener doesn't over-consume resourc
#+begin_src lisp #+begin_src lisp
(defvar *gardener-last-audit* 0 (defvar *gardener-last-audit* 0
"The universal-time of the last full Memex audit.") "The universal-time of the last full Memex audit.
#+end_src #+end_src
** Audit: Broken Links ** Audit: Broken Links
@@ -115,7 +115,7 @@ The Gardener's deterministic gate performs the actual analysis and logs the resu
(setf *gardener-last-audit* (get-universal-time)) (setf *gardener-last-audit* (get-universal-time))
;; Return a log to stop the loop ;; Return a log to stop the loop
(list :type :LOG :payload (list :text "Gardener audit complete.")))) (list :type :LOG :payload (list :text "Gardener audit complete.)))
#+end_src #+end_src
** Skill Registration ** Skill Registration

40
skills/org-skill-gateway-manager.org
View File

@@ -13,26 +13,26 @@ In a traditional AI wrapper, the user manually edits a config file to add a bot
* Phase B: Protocol (Success Criteria) * Phase B: Protocol (Success Criteria)
** Test Suite Context ** Test Suite Context
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/gateway-manager-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/gateway-manager-tests.lisp")" )
(defpackage :opencortex-gateway-manager-tests (defpackage :opencortex-gateway-manager-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:gateway-suite)) (:export #:gateway-suite))
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/gateway-manager-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/gateway-manager-tests.lisp")" )
(in-package :opencortex-gateway-manager-tests) (in-package :opencortex-gateway-manager-tests)
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/gateway-manager-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/gateway-manager-tests.lisp")" )
(def-suite gateway-suite :description "Verification of the Gateway Manager skill") (def-suite gateway-suite :description "Verification of the Gateway Manager skill
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/gateway-manager-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/gateway-manager-tests.lisp")" )
(in-suite gateway-suite) (in-suite gateway-suite)
#+end_src #+end_src
** Logic Tests ** Logic Tests
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/gateway-manager-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/gateway-manager-tests.lisp")" )
(test test-gateway-registration (test test-gateway-registration
"Verify that the skill can register a new gateway metadata block." "Verify that the skill can register a new gateway metadata block."
(let ((opencortex::*gateways* nil)) (let ((opencortex::*gateways* nil))
@@ -42,7 +42,7 @@ In a traditional AI wrapper, the user manually edits a config file to add a bot
(test test-gateway-multiple-platforms (test test-gateway-multiple-platforms
"Verify that multiple gateways can be registered simultaneously." "Verify that multiple gateways can be registered simultaneously."
(let ((opencortex::*gateways* nil)) (let ((opencortex::*gateways* nil))
(opencortex:skill-gateway-register :telegram '(:status :verified :token "abc123")) (opencortex:skill-gateway-register :telegram '(:status :verified :token "abc123)
(opencortex:skill-gateway-register :signal '(:status :unverified)) (opencortex:skill-gateway-register :signal '(:status :unverified))
(is (eq (getf (getf opencortex::*gateways* :telegram) :status) :verified)) (is (eq (getf (getf opencortex::*gateways* :telegram) :status) :verified))
(is (eq (getf (getf opencortex::*gateways* :signal) :status) :unverified)))) (is (eq (getf (getf opencortex::*gateways* :signal) :status) :unverified))))
@@ -51,27 +51,27 @@ In a traditional AI wrapper, the user manually edits a config file to add a bot
* Phase C: Implementation (Build) * Phase C: Implementation (Build)
** Package Context ** Package Context
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-gateway-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-gateway-manager.lisp")" )
(in-package :opencortex) (in-package :opencortex)
#+end_src #+end_src
** Capability Definition ** Capability Definition
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-gateway-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-gateway-manager.lisp")" )
(defparameter *skill-gateway-manager* (defparameter *skill-gateway-manager*
'(:name "gateway-manager" '(:name "gateway-manager"
:description "Manages connections to external chat platforms." :description "Manages connections to external chat platforms."
:capabilities (:link-gateway :list-gateways) :capabilities (:link-gateway :list-gateways)
:type :deterministic) :type :deterministic)
"Skill metadata for the Gateway Manager.") "Skill metadata for the Gateway Manager.
#+end_src #+end_src
** Registry Persistence ** Registry Persistence
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-gateway-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-gateway-manager.lisp")" )
(defvar *gateways* nil "The internal registry of configured gateways.") (defvar *gateways* nil "The internal registry of configured gateways.
#+end_src #+end_src
** Persistence Stubs ** Persistence Stubs
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-gateway-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-gateway-manager.lisp")" )
(defun save-gateways () (defun save-gateways ()
"Persist gateway metadata to XDG Config directory." "Persist gateway metadata to XDG Config directory."
(let ((path (merge-pathnames "gateways.lisp" (get-oc-config-dir)))) (let ((path (merge-pathnames "gateways.lisp" (get-oc-config-dir))))
@@ -81,14 +81,14 @@ In a traditional AI wrapper, the user manually edits a config file to add a bot
#+end_src #+end_src
** Registration Logic ** Registration Logic
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-gateway-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-gateway-manager.lisp")" )
(defun skill-gateway-register (platform metadata) (defun skill-gateway-register (platform metadata)
"Internal function to update the gateway registry." "Internal function to update the gateway registry."
(setf (getf *gateways* platform) metadata)) (setf (getf *gateways* platform) metadata))
#+end_src #+end_src
** Telegram Verification ** Telegram Verification
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-gateway-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-gateway-manager.lisp")" )
(defun skill-gateway-verify-telegram (token) (defun skill-gateway-verify-telegram (token)
"Verifies a Telegram bot token via the getMe API." "Verifies a Telegram bot token via the getMe API."
(let ((url (format nil "https://api.telegram.org/bot~a/getMe" token))) (let ((url (format nil "https://api.telegram.org/bot~a/getMe" token)))
@@ -98,18 +98,18 @@ In a traditional AI wrapper, the user manually edits a config file to add a bot
(if (cdr (assoc :ok data)) (if (cdr (assoc :ok data))
(let ((result (cdr (assoc :result data)))) (let ((result (cdr (assoc :result data))))
(list :status :verified :username (cdr (assoc :username result)))) (list :status :verified :username (cdr (assoc :username result))))
(list :status :failed :error "Invalid Token"))) (list :status :failed :error "Invalid Token))
(error (c) (list :status :failed :error (format nil "~a" c)))))) (error (c) (list :status :failed :error (format nil "~a" c))))))
#+end_src #+end_src
** Linkage Command ** Linkage Command
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-gateway-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-gateway-manager.lisp")" )
(defun skill-gateway-link (platform token) (defun skill-gateway-link (platform token)
"Primary capability to link a new platform. Returns status plist." "Primary capability to link a new platform. Returns status plist."
(harness-log "GATEWAY: Attempting to link ~a..." platform) (harness-log "GATEWAY: Attempting to link ~a..." platform)
(let ((verification (cond (let ((verification (cond
((eq platform :telegram) (skill-gateway-verify-telegram token)) ((eq platform :telegram) (skill-gateway-verify-telegram token))
(t (list :status :verified :info "Platform verification pending implementation"))))) (t (list :status :verified :info "Platform verification pending implementation))))
(if (eq (getf verification :status) :verified) (if (eq (getf verification :status) :verified)
(progn (progn
(save-secret platform :token token) (save-secret platform :token token)
@@ -120,7 +120,7 @@ In a traditional AI wrapper, the user manually edits a config file to add a bot
#+end_src #+end_src
** CLI Main Wrapper ** CLI Main Wrapper
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-gateway-manager.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-gateway-manager.lisp")" )
(defun gateway-manager-main (platform token) (defun gateway-manager-main (platform token)
"Main entry point for CLI-driven linkage." "Main entry point for CLI-driven linkage."
(if (and platform token) (if (and platform token)
@@ -128,6 +128,6 @@ In a traditional AI wrapper, the user manually edits a config file to add a bot
(format t "RESULT: ~s~%" result) (format t "RESULT: ~s~%" result)
(uiop:quit 0)) (uiop:quit 0))
(progn (progn
(format t "Usage: opencortex link <PLATFORM> <TOKEN>~%") (format t "Usage: opencortex link <PLATFORM> <TOKEN>~%
(uiop:quit 1)))) (uiop:quit 1))))
#+end_src #+end_src

6
skills/org-skill-homoiconic-memory.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-homoiconic-memory.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-homoiconic-memory.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: homoiconic-memory-skill :ID: homoiconic-memory-skill
:CREATED: [2026-04-10 Fri] :CREATED: [2026-04-10 Fri]
@@ -18,12 +18,12 @@ The *Homoiconic Memory* skill provides the core persistence layer for OpenCortex
(defun memory-org-to-json (source) (defun memory-org-to-json (source)
"Converts Org-mode source to JSON AST." "Converts Org-mode source to JSON AST."
(declare (ignore source)) (declare (ignore source))
"") "
(defun memory-json-to-org (ast) (defun memory-json-to-org (ast)
"Converts JSON AST back to Org-mode text." "Converts JSON AST back to Org-mode text."
(declare (ignore ast)) (declare (ignore ast))
"") "
(defun memory-normalize-ast (ast) (defun memory-normalize-ast (ast)
"Recursively ensures ID uniqueness across the AST." "Recursively ensures ID uniqueness across the AST."

30
skills/org-skill-lisp-utils.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-lisp-utils.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-lisp-utils.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: lisp-utils-skill :ID: lisp-utils-skill
:CREATED: [2026-04-23 Thu] :CREATED: [2026-04-23 Thu]
@@ -54,7 +54,7 @@ Returns (VALUES t nil) if clean, or (VALUES nil reason-string line col)."
(cond (escaped (setf escaped nil)) (cond (escaped (setf escaped nil))
((char= ch #\\) (setf escaped t)) ((char= ch #\\) (setf escaped t))
(in-string (in-string
(when (char= ch #\") (setf in-string nil))) (when (char= ch #\ (setf in-string nil)))
((char= ch #\;) ((char= ch #\;)
(loop while (and (< i (1- (length code-string))) (loop while (and (< i (1- (length code-string)))
(not (char= (char code-string (1+ i)) #\Newline))) (not (char= (char code-string (1+ i)) #\Newline)))
@@ -63,7 +63,7 @@ Returns (VALUES t nil) if clean, or (VALUES nil reason-string line col)."
((char= ch #\Newline) ((char= ch #\Newline)
(incf line) (incf line)
(setf col 0)) (setf col 0))
((char= ch #\") ((char= ch #\
(setf in-string t)) (setf in-string t))
((char= ch #\() ((char= ch #\()
(push (list :paren line col) stack) (push (list :paren line col) stack)
@@ -122,7 +122,7 @@ Returns (VALUES t nil) if clean, or (VALUES nil error-message nil nil)."
(with-input-from-string (stream (format nil "(progn ~a)" code-string)) (with-input-from-string (stream (format nil "(progn ~a)" code-string))
(loop for form = (read stream nil :eof) until (eq form :eof) (loop for form = (read stream nil :eof) until (eq form :eof)
do (unless (lisp-utils-ast-walk form) do (unless (lisp-utils-ast-walk form)
(return-from lisp-utils-check-semantic (values nil "Unsafe symbol detected"))))) (return-from lisp-utils-check-semantic (values nil "Unsafe symbol detected))))
(values t nil)) (values t nil))
(error (c) (values nil (format nil "~a" c))))))) (error (c) (values nil (format nil "~a" c)))))))
@@ -147,19 +147,19 @@ Returns (VALUES t nil) if clean, or (VALUES nil error-message nil nil)."
(def-cognitive-tool :validate-lisp (def-cognitive-tool :validate-lisp
"Deterministically validates Lisp code for structural, syntactic, and semantic correctness." "Deterministically validates Lisp code for structural, syntactic, and semantic correctness."
((:code :type :string :description "The Lisp code string to validate.") ((:code :type :string :description "The Lisp code string to validate.
(:strict :type :boolean :description "If non-nil, enforces the semantic whitelist.")) (:strict :type :boolean :description "If non-nil, enforces the semantic whitelist.)
:body (lambda (args) :body (lambda (args)
(let ((code (getf args :code)) (let ((code (getf args :code))
(strict (getf args :strict))) (strict (getf args :strict)))
(if (and code (stringp code)) (if (and code (stringp code))
(lisp-utils-validate code :strict strict) (lisp-utils-validate code :strict strict)
(list :status :error :reason "Missing :code argument."))))) (list :status :error :reason "Missing :code argument.))))
#+end_src #+end_src
* Test Suite * Test Suite
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/lisp-utils-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/lisp-utils-tests.lisp")" )
(defpackage :opencortex-lisp-utils-tests (defpackage :opencortex-lisp-utils-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:lisp-utils-suite)) (:export #:lisp-utils-suite))
@@ -167,31 +167,31 @@ Returns (VALUES t nil) if clean, or (VALUES nil error-message nil nil)."
(in-package :opencortex-lisp-utils-tests) (in-package :opencortex-lisp-utils-tests)
(def-suite lisp-utils-suite (def-suite lisp-utils-suite
:description "Tests for the Lisp Validator structural, syntactic, and semantic gates") :description "Tests for the Lisp Validator structural, syntactic, and semantic gates
(in-suite lisp-utils-suite) (in-suite lisp-utils-suite)
(test structural-balanced (test structural-balanced
(is (eq t (opencortex:lisp-utils-check-structural "(+ 1 2)")))) (is (eq t (opencortex:lisp-utils-check-structural "(+ 1 2))))
(test structural-unbalanced-open (test structural-unbalanced-open
(multiple-value-bind (ok reason) (opencortex:lisp-utils-check-structural "(+ 1 2") (multiple-value-bind (ok reason) (opencortex:lisp-utils-check-structural "(+ 1 2
(is (null ok)) (is (null ok))
(is (search "Unbalanced" reason)))) (is (search "Unbalanced" reason))))
(test structural-unbalanced-close (test structural-unbalanced-close
(multiple-value-bind (ok reason) (opencortex:lisp-utils-check-structural "+ 1 2)") (multiple-value-bind (ok reason) (opencortex:lisp-utils-check-structural "+ 1 2)
(is (null ok)) (is (null ok))
(is (search "Unexpected" reason)))) (is (search "Unexpected" reason))))
(test syntactic-valid (test syntactic-valid
(is (eq t (opencortex:lisp-utils-check-syntactic "(+ 1 2)")))) (is (eq t (opencortex:lisp-utils-check-syntactic "(+ 1 2))))
(test semantic-safe (test semantic-safe
(is (eq t (opencortex:lisp-utils-check-semantic "(+ 1 2)")))) (is (eq t (opencortex:lisp-utils-check-semantic "(+ 1 2))))
(test semantic-blocked-eval (test semantic-blocked-eval
(multiple-value-bind (ok reason) (opencortex:lisp-utils-check-semantic "(eval '(+ 1 2))") (multiple-value-bind (ok reason) (opencortex:lisp-utils-check-semantic "(eval '(+ 1 2))
(is (null ok)) (is (null ok))
(is (search "Unsafe" reason)))) (is (search "Unsafe" reason))))

60
skills/org-skill-literate-programming.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-literate-programming.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-literate-programming.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: literate-programming-skill-2026 :ID: literate-programming-skill-2026
:CREATED: [2026-04-25 Sat] :CREATED: [2026-04-25 Sat]
@@ -74,8 +74,8 @@ Code without surrounding prose is a bug report waiting to happen.
(escaped (setf escaped nil)) (escaped (setf escaped nil))
((char= ch #\\) (setf escaped t)) ((char= ch #\\) (setf escaped t))
;; String boundaries ;; String boundaries
(in-string (when (char= ch #\") (setf in-string nil))) (in-string (when (char= ch #\ (setf in-string nil)))
((char= ch #\") (setf in-string t)) ((char= ch #\ (setf in-string t))
;; Comment boundaries (skip to end of line) ;; Comment boundaries (skip to end of line)
((char= ch #\;) ((char= ch #\;)
(loop while (and (< i (1- (length code-string))) (loop while (and (< i (1- (length code-string)))
@@ -128,8 +128,8 @@ Code without surrounding prose is a bug report waiting to happen.
(dolist (line (uiop:split-string raw-block :separator '(#\Newline))) (dolist (line (uiop:split-string raw-block :separator '(#\Newline)))
(let ((trimmed (string-trim '(#\Space #\Tab #\Return) line))) (let ((trimmed (string-trim '(#\Space #\Tab #\Return) line)))
(when (and (plusp (length trimmed)) (when (and (plusp (length trimmed))
(not (string= (subseq trimmed 0 (min 12 (length trimmed))) ":PROPERTIES:")) (not (string= (subseq trimmed 0 (min 12 (length trimmed))) ":PROPERTIES:)
(not (string= (subseq trimmed 0 (min 5 (length trimmed))) ":END:"))) (not (string= (subseq trimmed 0 (min 5 (length trimmed))) ":END:))
(push line clean-lines)))) (push line clean-lines))))
(let ((code (format nil "~{~a~^~%~}" (nreverse clean-lines)))) (let ((code (format nil "~{~a~^~%~}" (nreverse clean-lines))))
(multiple-value-bind (ok reason) (literate-check-block-balance code) (multiple-value-bind (ok reason) (literate-check-block-balance code)
@@ -148,15 +148,15 @@ Verifies that tangled `.lisp` files are in sync with their Org source. Violation
#+begin_src lisp #+begin_src lisp
(defvar *tangle-targets* (defvar *tangle-targets*
'(("skills/org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp") '(("org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp
("skills/org-skill-literate-programming.org" . "library/gen/org-skill-literate-programming.lisp") ("org-skill-literate-programming.org" . "library/gen/org-skill-literate-programming.lisp
("harness/memory.org" . "library/memory.lisp") ("harness/memory.org" . "library/memory.lisp
("harness/loop.org" . "library/loop.lisp") ("harness/loop.org" . "library/loop.lisp
("harness/perceive.org" . "library/perceive.lisp") ("harness/perceive.org" . "library/perceive.lisp
("harness/reason.org" . "library/reason.lisp") ("harness/reason.org" . "library/reason.lisp
("harness/act.org" . "library/act.lisp") ("harness/act.org" . "library/act.lisp
("harness/skills.org" . "library/skills.lisp") ("harness/skills.org" . "library/skills.lisp
("harness/communication.org" . "library/communication.lisp"))) ("harness/communication.org" . "library/communication.lisp))
(defvar *lp-project-root* nil) (defvar *lp-project-root* nil)
@@ -225,9 +225,9 @@ The LP skill runs at priority 1100 (just below engineering-standards at 1000).
(defun lp-init () (defun lp-init ()
"Initialize the LP system with project root." "Initialize the LP system with project root."
(unless *lp-initialized* (unless *lp-initialized*
(let ((env-root (or (getenv "OPENCORTEX_ROOT") (let ((env-root (or (getenv "OPENCORTEX_ROOT
(getenv "MEMEX_DIR") (getenv "MEMEX_DIR
"/home/user/memex/projects/opencortex"))) "/home/user/memex/projects/opencortex))
(lp-set-project-root env-root) (lp-set-project-root env-root)
(setf *lp-initialized* t) (setf *lp-initialized* t)
(harness-log "LITERATE PROGRAMMING: Initialized with root ~a" *lp-project-root*)))) (harness-log "LITERATE PROGRAMMING: Initialized with root ~a" *lp-project-root*))))
@@ -241,7 +241,7 @@ The LP skill runs at priority 1100 (just below engineering-standards at 1000).
These tests verify the LP enforcement logic. Run with: These tests verify the LP enforcement logic. Run with:
~(fiveam:run! 'literate-programming-suite)~ ~(fiveam:run! 'literate-programming-suite)~
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/literate-programming-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/literate-programming-tests.lisp")" )
(defpackage :opencortex-literate-programming-tests (defpackage :opencortex-literate-programming-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:literate-programming-suite)) (:export #:literate-programming-suite))
@@ -249,14 +249,14 @@ These tests verify the LP enforcement logic. Run with:
(in-package :opencortex-literate-programming-tests) (in-package :opencortex-literate-programming-tests)
(def-suite literate-programming-suite (def-suite literate-programming-suite
:description "Tests for Literate Programming enforcement") :description "Tests for Literate Programming enforcement
(in-suite literate-programming-suite) (in-suite literate-programming-suite)
(test tangle-sync-detects-stale-lisp (test tangle-sync-detects-stale-lisp
"check-tangle-sync returns violation when .lisp is newer than .org" "check-tangle-sync returns violation when .lisp is newer than .org"
(let* ((root (uiop:ensure-directory-pathname "/tmp/lp-test/")) (let* ((root (uiop:ensure-directory-pathname "/tmp/lp-test/)
(tmp-org (merge-pathnames "skills/test-skill.org" root)) (tmp-org (merge-pathnames "test-skill.org" root))
(tmp-lisp (merge-pathnames "library/gen/test-skill.lisp" root))) (tmp-lisp (merge-pathnames "library/gen/test-skill.lisp" root)))
(uiop:ensure-all-directories-exist (list (directory-namestring tmp-org) (directory-namestring tmp-lisp))) (uiop:ensure-all-directories-exist (list (directory-namestring tmp-org) (directory-namestring tmp-lisp)))
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f)) (with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
@@ -264,7 +264,7 @@ These tests verify the LP enforcement logic. Run with:
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f)) (with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
(let ((orig-targets opencortex::*tangle-targets*)) (let ((orig-targets opencortex::*tangle-targets*))
(setf opencortex::*tangle-targets* (setf opencortex::*tangle-targets*
(cons '("skills/test-skill.org" . "library/gen/test-skill.lisp") orig-targets)) (cons '("test-skill.org" . "library/gen/test-skill.lisp orig-targets))
(unwind-protect (unwind-protect
(let ((result (opencortex::check-tangle-sync root))) (let ((result (opencortex::check-tangle-sync root)))
(is (listp result)) (is (listp result))
@@ -276,8 +276,8 @@ These tests verify the LP enforcement logic. Run with:
(test tangle-sync-passes-when-synced (test tangle-sync-passes-when-synced
"check-tangle-sync returns nil when .org is newer than .lisp" "check-tangle-sync returns nil when .org is newer than .lisp"
(let* ((root (uiop:ensure-directory-pathname "/tmp/lp-test2/")) (let* ((root (uiop:ensure-directory-pathname "/tmp/lp-test2/)
(tmp-org (merge-pathnames "skills/test-skill2.org" root)) (tmp-org (merge-pathnames "test-skill2.org" root))
(tmp-lisp (merge-pathnames "library/gen/test-skill2.lisp" root))) (tmp-lisp (merge-pathnames "library/gen/test-skill2.lisp" root)))
(uiop:ensure-all-directories-exist (list (directory-namestring tmp-org) (directory-namestring tmp-lisp))) (uiop:ensure-all-directories-exist (list (directory-namestring tmp-org) (directory-namestring tmp-lisp)))
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f)) (with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
@@ -285,7 +285,7 @@ These tests verify the LP enforcement logic. Run with:
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f)) (with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
(let ((orig-targets opencortex::*tangle-targets*)) (let ((orig-targets opencortex::*tangle-targets*))
(setf opencortex::*tangle-targets* (setf opencortex::*tangle-targets*
(cons '("skills/test-skill2.org" . "library/gen/test-skill2.lisp") orig-targets)) (cons '("test-skill2.org" . "library/gen/test-skill2.lisp orig-targets))
(unwind-protect (unwind-protect
(let ((result (opencortex::check-tangle-sync root))) (let ((result (opencortex::check-tangle-sync root)))
(is (null result))) (is (null result)))
@@ -295,12 +295,12 @@ These tests verify the LP enforcement logic. Run with:
(test tangle-sync-passes-when-synced (test tangle-sync-passes-when-synced
"check-tangle-sync returns nil when .org is newer than .lisp" "check-tangle-sync returns nil when .org is newer than .lisp"
(let ((tmp-org "/tmp/test-skill2.org") (let ((tmp-org "/tmp/test-skill2.org
(tmp-lisp "/tmp/test-skill2.lisp")) (tmp-lisp "/tmp/test-skill2.lisp)
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f)) (with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
(sleep 1) (sleep 1)
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f)) (with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
(let* ((root (uiop:ensure-directory-pathname "/tmp/")) (let* ((root (uiop:ensure-directory-pathname "/tmp/)
(result (opencortex::check-tangle-sync root))) (result (opencortex::check-tangle-sync root)))
(is (null result))) (is (null result)))
(uiop:delete-file-if-exists tmp-org) (uiop:delete-file-if-exists tmp-org)
@@ -308,11 +308,11 @@ These tests verify the LP enforcement logic. Run with:
(test block-balance-valid (test block-balance-valid
"literate-check-block-balance returns T for balanced code" "literate-check-block-balance returns T for balanced code"
(is (eq t (opencortex::literate-check-block-balance "(defun test () t)")))) (is (eq t (opencortex::literate-check-block-balance "(defun test () t))))
(test block-balance-invalid (test block-balance-invalid
"literate-check-block-balance returns NIL for unbalanced code" "literate-check-block-balance returns NIL for unbalanced code"
(multiple-value-bind (ok reason) (opencortex::literate-check-block-balance "(defun test ()") (multiple-value-bind (ok reason) (opencortex::literate-check-block-balance "(defun test ()
(is (null ok)) (is (null ok))
(is (stringp reason)))) (is (stringp reason))))
#+end_src #+end_src

18
skills/org-skill-llama-backend.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-llama-backend.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-llama-backend.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: llama-backend-skill :ID: llama-backend-skill
:CREATED: [2026-04-17 Fri 20:00] :CREATED: [2026-04-17 Fri 20:00]
@@ -15,7 +15,7 @@ The *Llama.cpp Backend* allows the OpenCortex to use local, air-gapped inference
This skill acts as a proxy between the OpenCortex kernel and the Lisp-agnostic `llama.cpp` REST API. It implements the standard backend signature required by `register-probabilistic-backend`. This skill acts as a proxy between the OpenCortex kernel and the Lisp-agnostic `llama.cpp` REST API. It implements the standard backend signature required by `register-probabilistic-backend`.
** 2. Semantic Interfaces ** 2. Semantic Interfaces
- Endpoint: `(getenv "LLAMACPP_ENDPOINT")` (e.g., "http://10.10.10.x:8080") - Endpoint: `(getenv "LLAMACPP_ENDPOINT` (e.g., "http://10.10.10.x:8080
- Method: `POST /completion` - Method: `POST /completion`
- Response: JSON (parsed into Lisp) - Response: JSON (parsed into Lisp)
@@ -28,22 +28,22 @@ This skill acts as a proxy between the OpenCortex kernel and the Lisp-agnostic `
** The Inference Engine (llama-inference) ** The Inference Engine (llama-inference)
#+begin_src lisp #+begin_src lisp
(defun llama-inference (prompt system-prompt &key (model "local-model")) (defun llama-inference (prompt system-prompt &key (model "local-model)
"Sends a completion request to the local llama.cpp server." "Sends a completion request to the local llama.cpp server."
(let ((endpoint (getenv "LLAMACPP_ENDPOINT"))) (let ((endpoint (getenv "LLAMACPP_ENDPOINT))
(unless endpoint (unless endpoint
(harness-log "LLAMA ERROR: LLAMACPP_ENDPOINT not set in environment.") (harness-log "LLAMA ERROR: LLAMACPP_ENDPOINT not set in environment.
(return-from llama-inference (list :error "LLAMACPP_ENDPOINT_MISSING"))) (return-from llama-inference (list :error "LLAMACPP_ENDPOINT_MISSING))
(handler-case (handler-case
(let* ((full-prompt (format nil "System: ~a~%User: ~a~%Assistant:" system-prompt prompt)) (let* ((full-prompt (format nil "System: ~a~%User: ~a~%Assistant:" system-prompt prompt))
(payload (cl-json:encode-json-to-string (payload (cl-json:encode-json-to-string
`((:prompt . ,full-prompt) `((:prompt . ,full-prompt)
(:n_predict . 1024) (:n_predict . 1024)
(:stop . ("User:" "System:"))))) (:stop . ("User:" "System:))))
(response (dex:post (format nil "~a/completion" endpoint) (response (dex:post (format nil "~a/completion" endpoint)
:content payload :content payload
:headers '(("Content-Type" . "application/json")))) :headers '(("Content-Type" . "application/json)))
(data (cl-json:decode-json-from-string response))) (data (cl-json:decode-json-from-string response)))
(cdr (assoc :content data))) (cdr (assoc :content data)))
(error (c) (error (c)
@@ -55,7 +55,7 @@ This skill acts as a proxy between the OpenCortex kernel and the Lisp-agnostic `
#+begin_src lisp #+begin_src lisp
(progn (progn
(register-probabilistic-backend :llama #'llama-inference) (register-probabilistic-backend :llama #'llama-inference)
(harness-log "LLAMA: Local backend registered and active.")) (harness-log "LLAMA: Local backend registered and active.)
(defskill :skill-llama-backend (defskill :skill-llama-backend
:priority 50 :priority 50

52
skills/org-skill-llm-gateway.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-llm-gateway.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-llm-gateway.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: llm-gateway-spec :ID: llm-gateway-spec
:CREATED: [2026-04-10 Thu] :CREATED: [2026-04-10 Thu]
@@ -11,52 +11,52 @@
The *LLM Gateway* skill provides a unified interface for interacting with multiple Large Language Model providers. The *LLM Gateway* skill provides a unified interface for interacting with multiple Large Language Model providers.
* Test Suite * Test Suite
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/llm-gateway-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/llm-gateway-tests.lisp")" )
(defpackage :opencortex-llm-gateway-tests (defpackage :opencortex-llm-gateway-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:llm-gateway-suite)) (:export #:llm-gateway-suite))
(in-package :opencortex-llm-gateway-tests) (in-package :opencortex-llm-gateway-tests)
(def-suite llm-gateway-suite :description "Tests for the LLM Gateway skill") (def-suite llm-gateway-suite :description "Tests for the LLM Gateway skill
(in-suite llm-gateway-suite) (in-suite llm-gateway-suite)
(test test-llm-gateway-timeout (test test-llm-gateway-timeout
"Tier 2 Chaos: Verify that LLM Gateway handles connection failures gracefully." "Tier 2 Chaos: Verify that LLM Gateway handles connection failures gracefully."
;; Point to a non-existent port to force a connection error ;; Point to a non-existent port to force a connection error
(let ((old-host (getenv "OLLAMA_HOST"))) (let ((old-host (getenv "OLLAMA_HOST))
(unwind-protect (unwind-protect
(progn (progn
(setf (getenv "OLLAMA_HOST") "localhost:1") (setf (getenv "OLLAMA_HOST "localhost:1
(let ((fn (or (find-symbol "EXECUTE-LLM-REQUEST" :opencortex.skills.org-skill-llm-gateway) (let ((fn (or (find-symbol "EXECUTE-LLM-REQUEST" :opencortex.skills.org-skill-llm-gateway)
(find-symbol "EXECUTE-LLM-REQUEST" :opencortex)))) (find-symbol "EXECUTE-LLM-REQUEST" :opencortex))))
(if fn (if fn
(let ((result (funcall fn :prompt "hello" :provider :ollama))) (let ((result (funcall fn :prompt "hello" :provider :ollama)))
(is (eq (getf result :status) :error)) (is (eq (getf result :status) :error))
(is (uiop:string-prefix-p "Ollama Failure" (getf result :message)))) (is (uiop:string-prefix-p "Ollama Failure" (getf result :message))))
(fail "Could not find EXECUTE-LLM-REQUEST symbol")))) (fail "Could not find EXECUTE-LLM-REQUEST symbol)))
(setf (getenv "OLLAMA_HOST") old-host)))) (setf (getenv "OLLAMA_HOST old-host))))
#+end_src #+end_src
* Implementation * Implementation
** Package Context ** Package Context
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-llm-gateway.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-llm-gateway.lisp")" )
(in-package :opencortex) (in-package :opencortex)
#+end_src #+end_src
** Skill Metadata ** Skill Metadata
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-llm-gateway.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-llm-gateway.lisp")" )
(defparameter *skill-llm-gateway* (defparameter *skill-llm-gateway*
'(:name "llm-gateway" '(:name "llm-gateway"
:description "Unified provider-agnostic LLM interface." :description "Unified provider-agnostic LLM interface."
:capabilities (:ask-llm :get-embedding) :capabilities (:ask-llm :get-embedding)
:type :probabilistic) :type :probabilistic)
"Skill metadata for the LLM Gateway.") "Skill metadata for the LLM Gateway.
#+end_src #+end_src
** Request Execution ** Request Execution
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-llm-gateway.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-llm-gateway.lisp")" )
(defun execute-llm-request (&key prompt system-prompt provider model) (defun execute-llm-request (&key prompt system-prompt provider model)
"Generic executor for all LLM providers." "Generic executor for all LLM providers."
(let* ((active-provider (or provider :ollama)) (let* ((active-provider (or provider :ollama))
@@ -64,41 +64,41 @@ The *LLM Gateway* skill provides a unified interface for interacting with multip
(full-prompt (if system-prompt (format nil "~a~%~%~a" system-prompt prompt) prompt))) (full-prompt (if system-prompt (format nil "~a~%~%~a" system-prompt prompt) prompt)))
(case active-provider (case active-provider
(:ollama (:ollama
(let* ((host (or (getenv "OLLAMA_HOST") "localhost:11434")) (let* ((host (or (getenv "OLLAMA_HOST "localhost:11434)
(url (format nil "http://~a/api/generate" host)) (url (format nil "http://~a/api/generate" host))
(body (cl-json:encode-json-to-string `((model . ,(or model "llama3")) (prompt . ,full-prompt) (stream . :false))))) (body (cl-json:encode-json-to-string `((model . ,(or model "llama3) (prompt . ,full-prompt) (stream . :false)))))
(handler-case (handler-case
(let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body)) (let* ((response (dex:post url :headers '(("Content-Type" . "application/json) :content body))
(json (cl-json:decode-json-from-string response))) (json (cl-json:decode-json-from-string response)))
(list :status :success :content (cdr (assoc :response json)))) (list :status :success :content (cdr (assoc :response json))))
(error (c) (list :status :error :message (format nil "Ollama Failure: ~a" c)))))) (error (c) (list :status :error :message (format nil "Ollama Failure: ~a" c))))))
(t (list :status :error :message "Provider not implemented"))))) (t (list :status :error :message "Provider not implemented))))
#+end_src #+end_src
** Cognitive Tools ** Cognitive Tools
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-llm-gateway.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-llm-gateway.lisp")" )
(def-cognitive-tool :get-ollama-embedding (def-cognitive-tool :get-ollama-embedding
"Generates vector embeddings via Ollama API." "Generates vector embeddings via Ollama API."
((:text :type :string :description "Text to embed.")) ((:text :type :string :description "Text to embed.)
:body (lambda (args) :body (lambda (args)
(let ((text (getf args :text))) (let ((text (getf args :text)))
(let* ((host (or (getenv "OLLAMA_HOST") "localhost:11434")) (let* ((host (or (getenv "OLLAMA_HOST "localhost:11434)
(url (format nil "http://~a/api/embeddings" host)) (url (format nil "http://~a/api/embeddings" host))
(body (cl-json:encode-json-to-string `((model . "nomic-embed-text") (prompt . ,text))))) (body (cl-json:encode-json-to-string `((model . "nomic-embed-text (prompt . ,text)))))
(handler-case (handler-case
(let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body)) (let* ((response (dex:post url :headers '(("Content-Type" . "application/json) :content body))
(json (cl-json:decode-json-from-string response))) (json (cl-json:decode-json-from-string response)))
(cdr (assoc :embedding json))) (cdr (assoc :embedding json)))
(error (c) (harness-log "OLLAMA EMBED ERROR: ~a" c) nil)))))) (error (c) (harness-log "OLLAMA EMBED ERROR: ~a" c) nil))))))
#+end_src #+end_src
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-llm-gateway.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-llm-gateway.lisp")" )
(def-cognitive-tool :ask-llm (def-cognitive-tool :ask-llm
"Unified interface for interacting with LLM providers." "Unified interface for interacting with LLM providers."
((:prompt :type :string :description "The user prompt") ((:prompt :type :string :description "The user prompt
(:system-prompt :type :string :description "The system prompt (optional)") (:system-prompt :type :string :description "The system prompt (optional)
(:provider :type :keyword :description "The provider (e.g., :ollama, :openai)") (:provider :type :keyword :description "The provider (e.g., :ollama, :openai)
(:model :type :string :description "The model name")) (:model :type :string :description "The model name)
:body (lambda (args) :body (lambda (args)
(execute-llm-request :prompt (getf args :prompt) (execute-llm-request :prompt (getf args :prompt)
:system-prompt (getf args :system-prompt) :system-prompt (getf args :system-prompt)
@@ -107,7 +107,7 @@ The *LLM Gateway* skill provides a unified interface for interacting with multip
#+end_src #+end_src
** Skill Registration ** Skill Registration
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-llm-gateway.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-llm-gateway.lisp")" )
(defskill :skill-llm-gateway (defskill :skill-llm-gateway
:priority 50 :priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) t) :trigger (lambda (ctx) (declare (ignore ctx)) t)

18
skills/org-skill-peripheral-vision.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-peripheral-vision.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-peripheral-vision.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: org-skill-peripheral-vision :ID: org-skill-peripheral-vision
:CREATED: [2026-04-12 Sun 14:15] :CREATED: [2026-04-12 Sun 14:15]
@@ -45,10 +45,10 @@ Move context pruning and rendering logic out of `context.lisp` to allow for more
#+end_src #+end_src
\n#+begin_src lisp \n#+begin_src lisp
(defun context-render-to-org (obj &key depth foveal-id semantic-threshold foveal-vector) (defun context-render-to-org (obj &key depth foveal-id semantic-threshold foveal-vector)
"Recursively renders an org-object with foveal-peripheral pruning.") "Recursively renders an org-object with foveal-peripheral pruning.
(defun context-assemble-global-awareness (&optional signal) (defun context-assemble-global-awareness (&optional signal)
"Assembles the full context block for a neural request.") "Assembles the full context block for a neural request.
#+end_src #+end_src
* Phase D: Build (Implementation) * Phase D: Build (Implementation)
@@ -60,7 +60,7 @@ Move context pruning and rendering logic out of `context.lisp` to allow for more
"Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model." "Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
(let* ((id (org-object-id obj)) (let* ((id (org-object-id obj))
(is-foveal (equal id foveal-id)) (is-foveal (equal id foveal-id))
(title (or (getf (org-object-attributes obj) :TITLE) "Untitled")) (title (or (getf (org-object-attributes obj) :TITLE) "Untitled)
(content (org-object-content obj)) (content (org-object-content obj))
(children (org-object-children obj)) (children (org-object-children obj))
(stars (make-string depth :initial-element #\*)) (stars (make-string depth :initial-element #\*))
@@ -73,13 +73,13 @@ Move context pruning and rendering logic out of `context.lisp` to allow for more
;; We always render the foveal node and its immediate children. ;; We always render the foveal node and its immediate children.
;; We render deeper nodes ONLY if they are semantically relevant. ;; We render deeper nodes ONLY if they are semantically relevant.
(should-render (or (<= depth 2) is-foveal is-semantically-relevant)) (should-render (or (<= depth 2) is-foveal is-semantically-relevant))
(output "")) (output
(when should-render (when should-render
(setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id)) (setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id))
(when (and is-semantically-relevant (> similarity 0)) (when (and is-semantically-relevant (> similarity 0))
(setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity)))) (setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity))))
(setf output (concatenate 'string output (format nil ":END:~%"))) (setf output (concatenate 'string output (format nil ":END:~%))
;; Only include full body content if this is the Foveal focus or highly relevant ;; Only include full body content if this is the Foveal focus or highly relevant
(when (and content (or is-foveal is-semantically-relevant)) (when (and content (or is-foveal is-semantically-relevant))
@@ -106,14 +106,14 @@ Move context pruning and rendering logic out of `context.lisp` to allow for more
(foveal-vector (when foveal-id (org-object-vector (lookup-object foveal-id)))) (foveal-vector (when foveal-id (org-object-vector (lookup-object foveal-id))))
(projects (context-get-active-projects)) (projects (context-get-active-projects))
(output "GLOBAL MEMEX AWARENESS (Peripheral Vision): (output "GLOBAL MEMEX AWARENESS (Peripheral Vision):
")) )
(if projects (if projects
(dolist (project projects) (dolist (project projects)
(setf output (concatenate 'string output (setf output (concatenate 'string output
(context-render-to-org project (context-render-to-org project
:foveal-id foveal-id :foveal-id foveal-id
:foveal-vector foveal-vector)))) :foveal-vector foveal-vector))))
(setf output (concatenate 'string output "No active projects found.~%"))) (setf output (concatenate 'string output "No active projects found.~%))
output)) output))
#+end_src #+end_src
@@ -121,7 +121,7 @@ Move context pruning and rendering logic out of `context.lisp` to allow for more
#+begin_src lisp #+begin_src lisp
(defskill :skill-peripheral-vision (defskill :skill-peripheral-vision
:priority 90 :priority 90
:dependencies ("org-skill-embedding") :dependencies ("org-skill-embedding
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:perceive :context-refresh))) :trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:perceive :context-refresh)))
:probabilistic nil :probabilistic nil
:deterministic (lambda (action ctx) :deterministic (lambda (action ctx)

34
skills/org-skill-policy.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-policy.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-policy.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: 47425a43-2be0-423c-8509-22592cfe9c9e :ID: 47425a43-2be0-423c-8509-22592cfe9c9e
:CREATED: [2026-04-07 Tue 12:57] :CREATED: [2026-04-07 Tue 12:57]
@@ -50,7 +50,7 @@ Every skill executes within its own jailed package namespace, inheriting core ha
#+end_src #+end_src
* Global Policy Configuration * Global Policy Configuration
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-policy.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-policy.lisp")" )
(defvar *policy-invariant-priorities* (defvar *policy-invariant-priorities*
'((:transparency . 500) '((:transparency . 500)
(:autonomy . 400) (:autonomy . 400)
@@ -64,10 +64,10 @@ Higher numbers take precedence.
When two invariants conflict, the higher priority wins. When two invariants conflict, the higher priority wins.
Example: Modularity (250) takes precedence over Mentorship (200), Example: Modularity (250) takes precedence over Mentorship (200),
meaning a change that would fatten the harness is blocked meaning a change that would fatten the harness is blocked
even if it would be educational.") even if it would be educational.
(defvar *proprietary-domain-watchlist* (defvar *proprietary-domain-watchlist*
'("googleapis.com" "api.openai.com" "anthropic.com" "api.groq.com" "openrouter.ai") '("googleapis.com" "api.openai.com" "anthropic.com" "api.groq.com" "openrouter.ai
"Domains representing centralized, proprietary control. "Domains representing centralized, proprietary control.
Actions targeting these are logged as autonomy debt, not hard-blocked. Actions targeting these are logged as autonomy debt, not hard-blocked.
@@ -75,17 +75,17 @@ even if it would be educational.")
is permitted under the strategic mandate for autonomy. is permitted under the strategic mandate for autonomy.
Strategic goal: Replace all proprietary APIs with local alternatives. Strategic goal: Replace all proprietary APIs with local alternatives.
Tactical reality: Use what's available while building toward that goal.") Tactical reality: Use what's available while building toward that goal.
(defvar *policy-max-skill-size-chars* 50000 (defvar *policy-max-skill-size-chars* 50000
"Maximum recommended size for a skill file tangled from an Org note. "Maximum recommended size for a skill file tangled from an Org note.
This is a soft limit—the check warns but does not block. This is a soft limit—the check warns but does not block.
A large, well-documented skill is acceptable; a small, poorly-documented A large, well-documented skill is acceptable; a small, poorly-documented
one that adds unnecessary complexity is not.") one that adds unnecessary complexity is not.
(defvar *modularity-protected-paths* (defvar *modularity-protected-paths*
'("harness/" "opencortex.asd") '("harness/" "opencortex.asd
"Paths that constitute the unbreakable core of the system. "Paths that constitute the unbreakable core of the system.
Any action targeting these paths must include a :modularity-justification Any action targeting these paths must include a :modularity-justification
@@ -101,7 +101,7 @@ even if it would be educational.")
- Policy and security - Policy and security
- LLM integration - LLM integration
- Domain-specific functionality - Domain-specific functionality
- New actuators") - New actuators
(defvar *mentorship-required-actions* (defvar *mentorship-required-actions*
'(:create-skill :eval :modify-file :write-file :replace '(:create-skill :eval :modify-file :write-file :replace
@@ -109,13 +109,13 @@ even if it would be educational.")
"Actions that trigger the Mentorship invariant. "Actions that trigger the Mentorship invariant.
These are high-impact actions that should come with explanations These are high-impact actions that should come with explanations
not just for the user, but for future debugging and maintenance.") not just for the user, but for future debugging and maintenance.
(defvar *cloud-only-backends* '(:openrouter :openai :anthropic :groq :gemini-api) (defvar *cloud-only-backends* '(:openrouter :openai :anthropic :groq :gemini-api)
"Backends requiring internet connection and external infrastructure. "Backends requiring internet connection and external infrastructure.
These are acceptable as fallbacks when local inference is unavailable, These are acceptable as fallbacks when local inference is unavailable,
but should be logged as sustainability debt for tracking purposes.") but should be logged as sustainability debt for tracking purposes.
#+end_src #+end_src
@@ -168,7 +168,7 @@ At the gate:
(return-from policy-check-transparency (return-from policy-check-transparency
(list :type :LOG (list :type :LOG
:payload (list :level :error :payload (list :level :error
:text "POLICY [Transparency]: Action is not a valid plist. Rejected.")))) :text "POLICY [Transparency]: Action is not a valid plist. Rejected.)))
(let* ((payload (getf action :payload)) (let* ((payload (getf action :payload))
(target (or (getf action :target) (getf action :TARGET))) (target (or (getf action :target) (getf action :TARGET)))
@@ -185,7 +185,7 @@ At the gate:
(return-from policy-check-transparency (return-from policy-check-transparency
(list :type :LOG (list :type :LOG
:payload (list :level :error :payload (list :level :error
:text "POLICY [Transparency]: User-facing action missing :explanation. Blocked.")))) :text "POLICY [Transparency]: User-facing action missing :explanation. Blocked.)))
action)) action))
#+end_src #+end_src
@@ -210,12 +210,12 @@ Every action should increase the user's independence from centralized, proprieta
Returns the first matched domain, or NIL if clean." Returns the first matched domain, or NIL if clean."
(let* ((payload (getf action :payload)) (let* ((payload (getf action :payload))
(text (or (getf payload :text) (getf payload :TEXT) "")) (text (or (getf payload :text) (getf payload :TEXT)
(cmd (or (getf payload :cmd) (cmd (or (getf payload :cmd)
(getf payload :CMD) (getf payload :CMD)
(when (equal (getf payload :tool) "shell") (when (equal (getf payload :tool) "shell
(getf (getf payload :args) :cmd)) (getf (getf payload :args) :cmd))
""))
(haystack (concatenate 'string text cmd))) (haystack (concatenate 'string text cmd)))
(dolist (domain *proprietary-domain-watchlist* nil) (dolist (domain *proprietary-domain-watchlist* nil)
@@ -379,13 +379,13 @@ The agent's goal is not to "do it for the user," but to "empower the user." Ever
(getf payload :tool)))) (getf payload :tool))))
(when (or (member act *mentorship-required-actions*) (when (or (member act *mentorship-required-actions*)
(member tool '("shell" "eval" "repair-file"))) (member tool '("shell" "eval" "repair-file))
(unless note (unless note
(return-from policy-check-mentorship (return-from policy-check-mentorship
(list :type :LOG (list :type :LOG
:payload (list :level :error :payload (list :level :error
:text "POLICY [Mentorship]: High-impact action missing :mentorship-note. Explain what you are doing and why. Blocked."))))) :text "POLICY [Mentorship]: High-impact action missing :mentorship-note. Explain what you are doing and why. Blocked.))))
action)) action))
#+end_src #+end_src

14
skills/org-skill-protocol-validator.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-protocol-validator.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-protocol-validator.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: org-skill-communication-protocol-validator :ID: org-skill-communication-protocol-validator
:CREATED: [2026-04-12 Sun 14:35] :CREATED: [2026-04-12 Sun 14:35]
@@ -40,7 +40,7 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
#+begin_src lisp #+begin_src lisp
(defun validate-communication-protocol-schema (msg) (defun validate-communication-protocol-schema (msg)
"Returns T if the message is valid, NIL (and signals error) otherwise.") "Returns T if the message is valid, NIL (and signals error) otherwise.
#+end_src #+end_src
* Phase D: Build (Implementation) * Phase D: Build (Implementation)
@@ -66,20 +66,20 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
(let ((target (proto-get msg :target)) (let ((target (proto-get msg :target))
(source (proto-get (proto-get msg :meta) :source))) (source (proto-get (proto-get msg :meta) :source)))
(unless (or target source) (unless (or target source)
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target and no :source in :meta to infer it")) (error "Communication Protocol Schema Error: REQUEST missing mandatory :target and no :source in :meta to infer it)
(unless (proto-get msg :payload) (unless (proto-get msg :payload)
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))) (error "Communication Protocol Schema Error: REQUEST missing mandatory :payload)))
(:EVENT (:EVENT
(let ((payload (proto-get msg :payload))) (let ((payload (proto-get msg :payload)))
(unless (and payload (listp payload)) (unless (and payload (listp payload))
(error "Communication Protocol Schema Error: EVENT missing or invalid :payload")) (error "Communication Protocol Schema Error: EVENT missing or invalid :payload)
(unless (or (proto-get payload :action) (proto-get payload :sensor)) (unless (or (proto-get payload :action) (proto-get payload :sensor))
(error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor")))) (error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor)))
(:RESPONSE (:RESPONSE
(unless (proto-get msg :payload) (unless (proto-get msg :payload)
(error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload")))) (error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload)))
t)) t))
#+end_src #+end_src

16
skills/org-skill-scribe.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-scribe.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-scribe.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: scribe-skill :ID: scribe-skill
:CREATED: [2026-04-13 Mon 18:40] :CREATED: [2026-04-13 Mon 18:40]
@@ -37,7 +37,7 @@ The Scribe reacts to the `:heartbeat` sensor. It maintains a state file (`scribe
** 2. Semantic Interfaces ** 2. Semantic Interfaces
- Trigger: `(:sensor :heartbeat)` - Trigger: `(:sensor :heartbeat)`
- Action: `(:type :REQUEST :target :system :action :create-note :title "..." :content "..." :source-id "...")` - Action: `(:type :REQUEST :target :system :action :create-note :title "..." :content "..." :source-id "...`
* Phase D: Build (Implementation) * Phase D: Build (Implementation)
@@ -51,7 +51,7 @@ We track the last processed universal time to avoid redundant distillation.
#+begin_src lisp #+begin_src lisp
(defvar *scribe-last-checkpoint* 0 (defvar *scribe-last-checkpoint* 0
"The universal-time of the last successful distillation run.") "The universal-time of the last successful distillation run.
(defun scribe-load-state () (defun scribe-load-state ()
"Loads the scribe checkpoint from the state directory." "Loads the scribe checkpoint from the state directory."
@@ -98,7 +98,7 @@ The LLM is tasked with identifying atomic concepts within the raw text.
(let* ((payload (getf context :payload)) (let* ((payload (getf context :payload))
(nodes (scribe-get-distillable-nodes))) (nodes (scribe-get-distillable-nodes)))
(if nodes (if nodes
(let ((text-to-process "")) (let ((text-to-process
(dolist (node nodes) (dolist (node nodes)
(setf text-to-process (concatenate 'string text-to-process (setf text-to-process (concatenate 'string text-to-process
(format nil "ID: ~a~%TITLE: ~a~%CONTENT: ~a~%---~%" (format nil "ID: ~a~%TITLE: ~a~%CONTENT: ~a~%---~%"
@@ -111,7 +111,7 @@ Extract ATOMIC EVERGREEN NOTES from this text.
RULES: RULES:
1. One note per distinct concept. 1. One note per distinct concept.
2. Output a list of Lisp plists: ((:title \"...\" :content \"...\" :source-id \"...\") ...) 2. Output a list of Lisp plists: ((:title \"...\" :content \"...\" :source-id \"...\ ...)
3. The content should be in Org-mode format. 3. The content should be in Org-mode format.
4. Keep titles descriptive and snake_case. 4. Keep titles descriptive and snake_case.
@@ -132,7 +132,7 @@ The deterministic gate receives the list of proposed notes and writes them to th
(let* ((title (getf note :title)) (let* ((title (getf note :title))
(content (getf note :content)) (content (getf note :content))
(source-id (getf note :source-id)) (source-id (getf note :source-id))
(filename (format nil "~a.org" (string-downcase (cl-ppcre:regex-replace-all " " title "_")))) (filename (format nil "~a.org" (string-downcase (cl-ppcre:regex-replace-all " " title "_)))
(path (merge-pathnames filename notes-dir))) (path (merge-pathnames filename notes-dir)))
(if (uiop:file-exists-p path) (if (uiop:file-exists-p path)
(with-open-file (out path :direction :output :if-exists :append) (with-open-file (out path :direction :output :if-exists :append)
@@ -154,9 +154,9 @@ The deterministic gate receives the list of proposed notes and writes them to th
(harness-log "SCRIBE: Committing ~a atomic notes..." (length data)) (harness-log "SCRIBE: Committing ~a atomic notes..." (length data))
(scribe-commit-notes data) (scribe-commit-notes data)
(scribe-save-state) (scribe-save-state)
(harness-log "SCRIBE: Distillation complete.") (harness-log "SCRIBE: Distillation complete.
;; Return a log event to stop the loop ;; Return a log event to stop the loop
(list :type :LOG :payload (list :text "Distillation successful."))))) (list :type :LOG :payload (list :text "Distillation successful.))))
#+end_src #+end_src
** Skill Registration ** Skill Registration

84
skills/org-skill-self-edit.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-self-edit.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-self-edit.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: self-edit-001 :ID: self-edit-001
:END: :END:
@@ -53,7 +53,7 @@ Extract file and line info from error context.
(defun self-edit-parse-location (context) (defun self-edit-parse-location (context)
"Extracts file and line from error context payload." "Extracts file and line from error context payload."
(let* ((payload (getf context :payload)) (let* ((payload (getf context :payload))
(message (getf payload :message "")) (message (getf payload :message
(file (or (getf payload :file) (file (or (getf payload :file)
(when (search "file" message) (when (search "file" message)
(car (cl-ppcre:all-matches-as-strings "[a-zA-Z0-9_/-]+\\.lisp" message))))) (car (cl-ppcre:all-matches-as-strings "[a-zA-Z0-9_/-]+\\.lisp" message)))))
@@ -86,11 +86,11 @@ Returns list with :status and :message keys."
new-code))) new-code)))
(with-open-file (out target-file :direction :output :if-exists :supersede) (with-open-file (out target-file :direction :output :if-exists :supersede)
(write-string new-content out)) (write-string new-content out))
(harness-log "SELF-EDIT: Edit applied successfully.") (harness-log "SELF-EDIT: Edit applied successfully.
(list :status :success :message "Edit applied.")) (list :status :success :message "Edit applied.)
(progn (progn
(harness-log "SELF-EDIT: Pattern not found in file.") (harness-log "SELF-EDIT: Pattern not found in file.
(list :status :error :message "Pattern not found in file."))) (list :status :error :message "Pattern not found in file.))
(error (c) (error (c)
(harness-log "SELF-EDIT: Edit failed: ~a" c) (harness-log "SELF-EDIT: Edit failed: ~a" c)
(rollback-memory 0) (rollback-memory 0)
@@ -101,9 +101,9 @@ Returns list with :status and :message keys."
#+begin_src lisp #+begin_src lisp
(def-cognitive-tool :self-edit (def-cognitive-tool :self-edit
"Applies a surgical code modification to a file with automatic rollback on failure." "Applies a surgical code modification to a file with automatic rollback on failure."
((:file :type :string :description "Path to the target file") ((:file :type :string :description "Path to the target file
(:old :type :string :description "The code block to find") (:old :type :string :description "The code block to find
(:new :type :string :description "The code block to replace with")) (:new :type :string :description "The code block to replace with)
:body (lambda (args) :body (lambda (args)
(let* ((file (getf args :file)) (let* ((file (getf args :file))
(old (getf args :old)) (old (getf args :old))
@@ -125,9 +125,9 @@ Hooks into syntax-error events for self-repair.
(cond (cond
((eq sensor :syntax-error) ((eq sensor :syntax-error)
"You are the Self-Edit Agent. A syntax error occurred. "You are the Self-Edit Agent. A syntax error occurred.
Provide a fixed version of the code as a lisp form.") Provide a fixed version of the code as a lisp form.
((eq sensor :repair-request) ((eq sensor :repair-request)
"You are the Self-Edit Agent. Apply the surgical fix to the file.") "You are the Self-Edit Agent. Apply the surgical fix to the file.
(t nil)))) (t nil))))
:deterministic (lambda (action ctx) :deterministic (lambda (action ctx)
(let* ((payload (getf ctx :payload)) (let* ((payload (getf ctx :payload))
@@ -135,16 +135,16 @@ Provide a fixed version of the code as a lisp form.")
(cond (cond
((eq sensor :syntax-error) ((eq sensor :syntax-error)
(let ((code (getf payload :code))) (let ((code (getf payload :code)))
(harness-log "SELF-EDIT: Fast paren balancing...") (harness-log "SELF-EDIT: Fast paren balancing...
(let ((balanced (self-edit-balance-parens code))) (let ((balanced (self-edit-balance-parens code)))
(handler-case (handler-case
(progn (progn
(read-from-string balanced) (read-from-string balanced)
(harness-log "SELF-EDIT: Fast fix SUCCESS.") (harness-log "SELF-EDIT: Fast fix SUCCESS.
(list :status :success :repaired balanced)) (list :status :success :repaired balanced))
(error () (error ()
(harness-log "SELF-EDIT: Fast fix failed, need neural repair.") (harness-log "SELF-EDIT: Fast fix failed, need neural repair.
(list :status :error :reason "needs-llm")))))) (list :status :error :reason "needs-llm)))))
((eq sensor :repair-request) ((eq sensor :repair-request)
(let ((file (getf payload :file)) (let ((file (getf payload :file))
(old (getf payload :old)) (old (getf payload :old))
@@ -157,7 +157,7 @@ Provide a fixed version of the code as a lisp form.")
#+begin_src lisp #+begin_src lisp
(def-cognitive-tool :balance-parens (def-cognitive-tool :balance-parens
"Balances parentheses in a code string." "Balances parentheses in a code string."
((:code :type :string :description "The code to balance")) ((:code :type :string :description "The code to balance)
:body (lambda (args) :body (lambda (args)
(let* ((code (getf args :code)) (let* ((code (getf args :code))
(balanced (self-edit-balance-parens code))) (balanced (self-edit-balance-parens code)))
@@ -174,7 +174,7 @@ Swap compiled skill files without breaking active sockets.
#+begin_src lisp #+begin_src lisp
(defvar *self-edit-skills-backup* nil (defvar *self-edit-skills-backup* nil
"Backup of skill registry before hot-reload.") "Backup of skill registry before hot-reload.
(defun self-edit-hot-reload-skill (skill-name gen-path) (defun self-edit-hot-reload-skill (skill-name gen-path)
"Reloads a skill from its compiled .lisp source. "Reloads a skill from its compiled .lisp source.
@@ -189,7 +189,7 @@ Swap compiled skill files without breaking active sockets.
Returns (values :success t) or (values :error message)." Returns (values :success t) or (values :error message)."
(unless *skills-registry* (unless *skills-registry*
(return-from self-edit-hot-reload-skill (return-from self-edit-hot-reload-skill
(values :error "Skills engine not initialized"))) (values :error "Skills engine not initialized))
(unless (uiop:file-exists-p gen-path) (unless (uiop:file-exists-p gen-path)
(return-from self-edit-hot-reload-skill (return-from self-edit-hot-reload-skill
(values :error (format nil "Skill file not found: ~a" gen-path)))) (values :error (format nil "Skill file not found: ~a" gen-path))))
@@ -202,7 +202,7 @@ Swap compiled skill files without breaking active sockets.
;; Step 2: Compile new skill ;; Step 2: Compile new skill
(let ((compiled (compile-file gen-path))) (let ((compiled (compile-file gen-path)))
(unless compiled (unless compiled
(error "Compilation returned nil"))) (error "Compilation returned nil))
;; Step 3: Load the compiled skill ;; Step 3: Load the compiled skill
(load gen-path) (load gen-path)
;; Step 4: Verify skill is in registry ;; Step 4: Verify skill is in registry
@@ -212,7 +212,7 @@ Swap compiled skill files without breaking active sockets.
(harness-log "SELF-EDIT: Hot-reloaded skill ~a from ~a" (harness-log "SELF-EDIT: Hot-reloaded skill ~a from ~a"
skill-name gen-path) skill-name gen-path)
(values :success t)) (values :success t))
(error "Skill not registered after reload")))) (error "Skill not registered after reload)))
(error (e) (error (e)
;; Step 5: Rollback ;; Step 5: Rollback
(when *self-edit-skills-backup* (when *self-edit-skills-backup*
@@ -228,8 +228,8 @@ Swap compiled skill files without breaking active sockets.
#+begin_src lisp #+begin_src lisp
(def-cognitive-tool :reload-skill (def-cognitive-tool :reload-skill
"Hot-reloads a skill from its compiled source file without restarting the system." "Hot-reloads a skill from its compiled source file without restarting the system."
((:skill-name :type :string :description "Name of the skill to reload (e.g. :skill-engineering-standards)") ((:skill-name :type :string :description "Name of the skill to reload (e.g. :skill-engineering-standards)
(:gen-path :type :string :description "Absolute path to the compiled .lisp file")) (:gen-path :type :string :description "Absolute path to the compiled .lisp file)
:body (lambda (args) :body (lambda (args)
(let ((name (getf args :skill-name)) (let ((name (getf args :skill-name))
(path (getf args :gen-path))) (path (getf args :gen-path)))
@@ -239,7 +239,7 @@ Swap compiled skill files without breaking active sockets.
* Phase E: Verification * Phase E: Verification
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/self-edit-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/self-edit-tests.lisp")" )
(defpackage :opencortex-self-edit-tests (defpackage :opencortex-self-edit-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:self-edit-suite)) (:export #:self-edit-suite))
@@ -247,42 +247,42 @@ Swap compiled skill files without breaking active sockets.
(in-package :opencortex-self-edit-tests) (in-package :opencortex-self-edit-tests)
(def-suite self-edit-suite (def-suite self-edit-suite
:description "Tests for Self-Edit skill.") :description "Tests for Self-Edit skill.
(in-suite self-edit-suite) (in-suite self-edit-suite)
(test balance-parens-balanced (test balance-parens-balanced
(let ((result (opencortex::self-edit-balance-parens "(+ 1 2)"))) (let ((result (opencortex::self-edit-balance-parens "(+ 1 2)))
(is (string= result "(+ 1 2)")) (is (string= result "(+ 1 2))
(is (not (null (read-from-string result)))))) (is (not (null (read-from-string result))))))
(test balance-parens-missing-open (test balance-parens-missing-open
(let ((result (opencortex::self-edit-balance-parens "+ 1 2)"))) (let ((result (opencortex::self-edit-balance-parens "+ 1 2)))
(is (string= result "(+ 1 2)")) (is (string= result "(+ 1 2))
(is (not (null (read-from-string result)))))) (is (not (null (read-from-string result))))))
(test balance-parens-missing-close (test balance-parens-missing-close
(let ((result (opencortex::self-edit-balance-parens "(+ 1 2"))) (let ((result (opencortex::self-edit-balance-parens "(+ 1 2))
(is (string= result "(+ 1 2)")) (is (string= result "(+ 1 2))
(is (not (null (read-from-string result)))))) (is (not (null (read-from-string result))))))
(test balance-parens-deep (test balance-parens-deep
(let ((result (opencortex::self-edit-balance-parens "((lambda (x) (if x (+ 1 2) 3))"))) (let ((result (opencortex::self-edit-balance-parens "((lambda (x) (if x (+ 1 2) 3))))
(is (string= result "((lambda (x) (if x (+ 1 2) 3)))")) (is (string= result "((lambda (x) (if x (+ 1 2) 3))))
(is (not (null (read-from-string result)))))) (is (not (null (read-from-string result))))))
(test balance-parens-empty (test balance-parens-empty
(let ((result (opencortex::self-edit-balance-parens ""))) (let ((result (opencortex::self-edit-balance-parens )
(is (string= result "")))) (is (string= result ))
(test test-self-edit-apply-success (test test-self-edit-apply-success
"Verify self-edit-apply performs surgical replacement correctly." "Verify self-edit-apply performs surgical replacement correctly."
(let ((test-file "/tmp/self-edit-test.lisp")) (let ((test-file "/tmp/self-edit-test.lisp)
(unwind-protect (unwind-protect
(progn (progn
(with-open-file (out test-file :direction :output :if-exists :supersede) (with-open-file (out test-file :direction :output :if-exists :supersede)
(write-string "(defun hello () (format t \"world~%\"))" out)) (write-string "(defun hello () (format t \"world~%\)" out))
(let ((result (opencortex::self-edit-apply test-file "world" "universe"))) (let ((result (opencortex::self-edit-apply test-file "world" "universe))
(is (eq (getf result :status) :success)) (is (eq (getf result :status) :success))
(let ((content (uiop:read-file-string test-file))) (let ((content (uiop:read-file-string test-file)))
(is (search "universe" content)) (is (search "universe" content))
@@ -291,32 +291,32 @@ Swap compiled skill files without breaking active sockets.
(test test-self-edit-apply-not-found (test test-self-edit-apply-not-found
"Verify self-edit-apply returns error when pattern not found." "Verify self-edit-apply returns error when pattern not found."
(let ((test-file "/tmp/self-edit-test2.lisp")) (let ((test-file "/tmp/self-edit-test2.lisp)
(unwind-protect (unwind-protect
(progn (progn
(with-open-file (out test-file :direction :output :if-exists :supersede) (with-open-file (out test-file :direction :output :if-exists :supersede)
(write-string "(defun hello () t)" out)) (write-string "(defun hello () t)" out))
(let ((result (opencortex::self-edit-apply test-file "nonexistent-pattern" "new"))) (let ((result (opencortex::self-edit-apply test-file "nonexistent-pattern" "new))
(is (eq (getf result :status) :error)) (is (eq (getf result :status) :error))
(is (search "not found" (getf result :message))))) (is (search "not found" (getf result :message)))))
(uiop:delete-file-if-exists test-file)))) (uiop:delete-file-if-exists test-file))))
(test test-self-edit-apply-file-not-found (test test-self-edit-apply-file-not-found
"Verify self-edit-apply returns error when file does not exist." "Verify self-edit-apply returns error when file does not exist."
(let ((result (opencortex::self-edit-apply "/nonexistent/path/file.lisp" "old" "new"))) (let ((result (opencortex::self-edit-apply "/nonexistent/path/file.lisp" "old" "new))
(is (eq (getf result :status) :error)) (is (eq (getf result :status) :error))
(is (search "not found" (getf result :message))))) (is (search "not found" (getf result :message)))))
(test test-self-edit-parse-location-from-payload (test test-self-edit-parse-location-from-payload
"Verify self-edit-parse-location extracts file/line from payload." "Verify self-edit-parse-location extracts file/line from payload."
(let ((context '(:payload (:file "/tmp/test.lisp" :line 42 :message "error")))) (let ((context '(:payload (:file "/tmp/test.lisp" :line 42 :message "error)))
(let ((result (opencortex::self-edit-parse-location context))) (let ((result (opencortex::self-edit-parse-location context)))
(is (equal "/tmp/test.lisp" (getf result :file))) (is (equal "/tmp/test.lisp" (getf result :file)))
(is (eq 42 (getf result :line)))))) (is (eq 42 (getf result :line))))))
(test test-self-edit-parse-location-from-message (test test-self-edit-parse-location-from-message
"Verify self-edit-parse-location extracts file/line from error message." "Verify self-edit-parse-location extracts file/line from error message."
(let ((context '(:payload (:message "Error in /home/user/project/foo.lisp at line 99")))) (let ((context '(:payload (:message "Error in /home/user/project/foo.lisp at line 99)))
(let ((result (opencortex::self-edit-parse-location context))) (let ((result (opencortex::self-edit-parse-location context)))
(is (listp result)) (is (listp result))
(is (getf result :line)) (is (getf result :line))

24
skills/org-skill-self-fix.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-self-fix.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-self-fix.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: 65891ce2-a465-49e6-a0c1-be13d3288d55 :ID: 65891ce2-a465-49e6-a0c1-be13d3288d55
:CREATED: [2026-03-30 Mon 21:16] :CREATED: [2026-03-30 Mon 21:16]
@@ -29,7 +29,7 @@ This skill enables self-editing by applying surgical fixes to files (including s
(old-code (getf payload :old)) (old-code (getf payload :old))
(new-code (getf payload :new)) (new-code (getf payload :new))
(is-skill (and (stringp (namestring target-file)) (is-skill (and (stringp (namestring target-file))
(search "skills/" (namestring target-file))))) (search "" (namestring target-file)))))
(opencortex:snapshot-memory) (opencortex:snapshot-memory)
(opencortex:harness-log "SELF-FIX - Attempting surgical fix on ~a..." target-file) (opencortex:harness-log "SELF-FIX - Attempting surgical fix on ~a..." target-file)
@@ -47,19 +47,19 @@ This skill enables self-editing by applying surgical fixes to files (including s
(opencortex:harness-log "SELF-FIX - Reloading modified skill ~a..." target-file) (opencortex:harness-log "SELF-FIX - Reloading modified skill ~a..." target-file)
(if (opencortex:load-skill-from-org target-file) (if (opencortex:load-skill-from-org target-file)
(progn (progn
(opencortex:harness-log "SELF-FIX SUCCESS - Applied and reloaded.") (opencortex:harness-log "SELF-FIX SUCCESS - Applied and reloaded.
t) t)
(progn (progn
(opencortex:harness-log "SELF-FIX FAILURE - Skill reload failed. Rolling back.") (opencortex:harness-log "SELF-FIX FAILURE - Skill reload failed. Rolling back.
(with-open-file (out target-file :direction :output :if-exists :supersede) (with-open-file (out target-file :direction :output :if-exists :supersede)
(write-string content out)) (write-string content out))
(opencortex:rollback-memory 0) (opencortex:rollback-memory 0)
nil))) nil)))
(progn (progn
(opencortex:harness-log "SELF-FIX SUCCESS - Applied fix to file.") (opencortex:harness-log "SELF-FIX SUCCESS - Applied fix to file.
t))) t)))
(progn (opencortex:harness-log "SELF-FIX FAILURE - Pattern not found.") nil))) (progn (opencortex:harness-log "SELF-FIX FAILURE - Pattern not found. nil)))
(progn (opencortex:harness-log "SELF-FIX FAILURE - File not found.") nil)) (progn (opencortex:harness-log "SELF-FIX FAILURE - File not found. nil))
(error (c) (error (c)
(opencortex:harness-log "SELF-FIX CRASH - ~a. Rolling back." c) (opencortex:harness-log "SELF-FIX CRASH - ~a. Rolling back." c)
(opencortex:rollback-memory 0) (opencortex:rollback-memory 0)
@@ -70,13 +70,13 @@ This skill enables self-editing by applying surgical fixes to files (including s
#+begin_src lisp #+begin_src lisp
(def-cognitive-tool :repair-file (def-cognitive-tool :repair-file
"Applies a surgical code modification to a file and reloads the skill if applicable." "Applies a surgical code modification to a file and reloads the skill if applicable."
((:file :type :string :description "Path to the target file") ((:file :type :string :description "Path to the target file
(:old :type :string :description "The literal code block to find") (:old :type :string :description "The literal code block to find
(:new :type :string :description "The literal code block to replace it with")) (:new :type :string :description "The literal code block to replace it with)
:body (lambda (args) :body (lambda (args)
(if (self-fix-apply (list :payload args) nil) (if (self-fix-apply (list :payload args) nil)
"REPAIR SUCCESSFUL." "REPAIR SUCCESSFUL."
"REPAIR FAILED."))) "REPAIR FAILED.))
#+end_src #+end_src
** Skill Definition ** Skill Definition
@@ -86,7 +86,7 @@ This skill enables self-editing by applying surgical fixes to files (including s
:trigger (lambda (context) (eq (getf (getf context :payload) :sensor) :repair-request)) :trigger (lambda (context) (eq (getf (getf context :payload) :sensor) :repair-request))
:probabilistic (lambda (context) :probabilistic (lambda (context)
(format nil "You are the opencortex Repair Actuator. Synthesize a surgical fix for the reported failure. (format nil "You are the opencortex Repair Actuator. Synthesize a surgical fix for the reported failure.
Return a Lisp plist for :repair-file.")) Return a Lisp plist for :repair-file.)
:deterministic (lambda (action context) :deterministic (lambda (action context)
(let ((payload (getf action :payload))) (let ((payload (getf action :payload)))
(self-fix-apply action context)))) (self-fix-apply action context))))

8
skills/org-skill-shell-actuator.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-shell-actuator.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-shell-actuator.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: shell-actuator-skill :ID: shell-actuator-skill
:CREATED: [2026-04-12 Sun] :CREATED: [2026-04-12 Sun]
@@ -12,10 +12,10 @@ The *Shell Actuator* provides a controlled interface for the OpenCortex to execu
* Implementation * Implementation
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-shell-actuator.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-shell-actuator.lisp")" )
(in-package :opencortex) (in-package :opencortex)
(defparameter *allowed-commands* '("ls" "git" "rg" "grep" "date" "echo" "cat" "node" "python3" "sbcl")) (defparameter *allowed-commands* '("ls" "git" "rg" "grep" "date" "echo" "cat" "node" "python3" "sbcl)
(defparameter *shell-metacharacters* '(#\; #\& #\| #\> #\< #\$ #\` #\\ #\!)) (defparameter *shell-metacharacters* '(#\; #\& #\| #\> #\< #\$ #\` #\\ #\!))
@@ -43,7 +43,7 @@ The *Shell Actuator* provides a controlled interface for the OpenCortex to execu
(multiple-value-bind (stdout stderr exit-code) (multiple-value-bind (stdout stderr exit-code)
(uiop:run-program cmd-string :output :string :error-output :string :ignore-error-status t) (uiop:run-program cmd-string :output :string :error-output :string :ignore-error-status t)
(opencortex:inject-stimulus (opencortex:inject-stimulus
`(:TYPE :EVENT :PAYLOAD (:SENSOR :shell-response :cmd ,cmd-string :stdout ,(or stdout "") :stderr ,(or stderr "") :exit-code ,exit-code)) `(:TYPE :EVENT :PAYLOAD (:SENSOR :shell-response :cmd ,cmd-string :stdout ,(or stdout " :stderr ,(or stderr " :exit-code ,exit-code))
:stream (getf context :reply-stream))))))) :stream (getf context :reply-stream)))))))
(defun trigger-skill-shell-actuator (context) (defun trigger-skill-shell-actuator (context)

40
skills/org-skill-tool-permissions.org
View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-tool-permissions.lisp" (expand-file-name "")) #+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-tool-permissions.lisp")" )
:PROPERTIES: :PROPERTIES:
:ID: tool-permissions-skill-001 :ID: tool-permissions-skill-001
:CREATED: [2026-04-23 Thu] :CREATED: [2026-04-23 Thu]
@@ -32,7 +32,7 @@ Tool permissions and embedding generation via multiple providers.
(in-package :opencortex) (in-package :opencortex)
(defvar *tool-permissions* (make-hash-table :test 'equal) (defvar *tool-permissions* (make-hash-table :test 'equal)
"Hash table mapping tool names to :allow/:deny/:ask.") "Hash table mapping tool names to :allow/:deny/:ask.
(defun get-tool-permission (tool-name) (defun get-tool-permission (tool-name)
(let ((key (string-downcase (string tool-name)))) (let ((key (string-downcase (string tool-name))))
@@ -53,29 +53,29 @@ Tool permissions and embedding generation via multiple providers.
(def-cognitive-tool :get-embedding (def-cognitive-tool :get-embedding
"Generates vector embeddings via Ollama or llama.cpp API." "Generates vector embeddings via Ollama or llama.cpp API."
((:text :type :string :description "Text to embed.")) ((:text :type :string :description "Text to embed.)
:body (lambda (args) :body (lambda (args)
(let* ((text (getf args :text)) (let* ((text (getf args :text))
(provider (or (getenv "EMBEDDING_PROVIDER") "ollama")) (provider (or (getenv "EMBEDDING_PROVIDER "ollama)
(model (or (getenv "EMBEDDING_MODEL") "nomic-embed-text")) (model (or (getenv "EMBEDDING_MODEL "nomic-embed-text)
(embedding nil)) (embedding nil))
(cond (cond
((string= provider "ollama") ((string= provider "ollama
(let* ((host (or (getenv "OLLAMA_HOST") "localhost:11434")) (let* ((host (or (getenv "OLLAMA_HOST "localhost:11434)
(url (format nil "http://~a/api/embeddings" host)) (url (format nil "http://~a/api/embeddings" host))
(body (cl-json:encode-json-to-string `((model . ,model) (prompt . ,text))))) (body (cl-json:encode-json-to-string `((model . ,model) (prompt . ,text)))))
(handler-case (handler-case
(let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body :connect-timeout 5 :read-timeout 30)) (let* ((response (dex:post url :headers '(("Content-Type" . "application/json) :content body :connect-timeout 5 :read-timeout 30))
(json (cl-json:decode-json-from-string response)) (json (cl-json:decode-json-from-string response))
(vec (cdr (assoc :embedding json)))) (vec (cdr (assoc :embedding json))))
(when vec (setf embedding vec))) (when vec (setf embedding vec)))
(error (c) (harness-log "EMBEDDING: Ollama failed: ~a" c))))) (error (c) (harness-log "EMBEDDING: Ollama failed: ~a" c)))))
((string= provider "llama.cpp") ((string= provider "llama.cpp
(let* ((host (or (getenv "LLAMA_HOST") "localhost:8080")) (let* ((host (or (getenv "LLAMA_HOST "localhost:8080)
(url (format nil "http://~a/v1/embeddings" host)) (url (format nil "http://~a/v1/embeddings" host))
(body (cl-json:encode-json-to-string `((model . ,model) (input . ,text))))) (body (cl-json:encode-json-to-string `((model . ,model) (input . ,text)))))
(handler-case (handler-case
(let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body :connect-timeout 5 :read-timeout 30)) (let* ((response (dex:post url :headers '(("Content-Type" . "application/json) :content body :connect-timeout 5 :read-timeout 30))
(json (cl-json:decode-json-from-string response)) (json (cl-json:decode-json-from-string response))
(data (cdr (assoc :data json))) (data (cdr (assoc :data json)))
(vec (when data (cdr (assoc :embedding (car data)))))) (vec (when data (cdr (assoc :embedding (car data))))))
@@ -83,13 +83,13 @@ Tool permissions and embedding generation via multiple providers.
(error (c) (harness-log "EMBEDDING: llama.cpp failed: ~a" c)))))) (error (c) (harness-log "EMBEDDING: llama.cpp failed: ~a" c))))))
(if embedding (if embedding
(list :status :success :vector embedding) (list :status :success :vector embedding)
(list :status :error :message "Embedding generation failed"))))) (list :status :error :message "Embedding generation failed))))
(def-cognitive-tool :tool-permissions (def-cognitive-tool :tool-permissions
"View or set tool permission tiers." "View or set tool permission tiers."
((:tool :type :string :description "Tool name") ((:tool :type :string :description "Tool name
(:action :type :keyword :description "Action: :get, :set, :list" :default :get) (:action :type :keyword :description "Action: :get, :set, :list" :default :get)
(:tier :type :keyword :description "For :set: :allow/:deny/:ask")) (:tier :type :keyword :description "For :set: :allow/:deny/:ask)
:body (lambda (args) :body (lambda (args)
(let ((tool (getf args :tool)) (let ((tool (getf args :tool))
(action (getf args :action :get)) (action (getf args :action :get))
@@ -101,14 +101,14 @@ Tool permissions and embedding generation via multiple providers.
(:list (let ((r nil)) (:list (let ((r nil))
(maphash (lambda (k v) (push (list :tool k :permission v) r)) *tool-permissions*) (maphash (lambda (k v) (push (list :tool k :permission v) r)) *tool-permissions*)
(list :status :success :tools r))) (list :status :success :tools r)))
(t (list :status :error :message "Invalid action")))))) (t (list :status :error :message "Invalid action)))))
;; Defaults ;; Defaults
(set-tool-permission :shell :deny) (set-tool-permission :shell :deny)
(set-tool-permission :delete-file :deny) (set-tool-permission :delete-file :deny)
(set-tool-permission :eval :ask) (set-tool-permission :eval :ask)
(set-tool-permission :write-file :ask) (set-tool-permission :write-file :ask)
(harness-log "TOOL PERMISSIONS: Initialized") (harness-log "TOOL PERMISSIONS: Initialized
(defskill :skill-tool-permissions (defskill :skill-tool-permissions
:priority 600 :priority 600
@@ -135,7 +135,7 @@ Tool permissions and embedding generation via multiple providers.
These tests verify tool permissions. Run with: These tests verify tool permissions. Run with:
~(fiveam:run! 'tool-permissions-suite)~ ~(fiveam:run! 'tool-permissions-suite)~
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/tool-permissions-tests.lisp" (expand-file-name "")) #+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/tool-permissions-tests.lisp")" )
(defpackage :opencortex-tool-permissions-tests (defpackage :opencortex-tool-permissions-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :opencortex)
(:export #:tool-permissions-suite)) (:export #:tool-permissions-suite))
@@ -143,18 +143,18 @@ These tests verify tool permissions. Run with:
(in-package :opencortex-tool-permissions-tests) (in-package :opencortex-tool-permissions-tests)
(def-suite tool-permissions-suite (def-suite tool-permissions-suite
:description "Tests for Tool Permissions skill") :description "Tests for Tool Permissions skill
(in-suite tool-permissions-suite) (in-suite tool-permissions-suite)
(test default-permission-is-allow (test default-permission-is-allow
"Verify default permission is :allow." "Verify default permission is :allow."
(is (eq (get-tool-permission "unknown-tool") :allow))) (is (eq (get-tool-permission "unknown-tool :allow)))
(test set-and-get-permission (test set-and-get-permission
"Verify setting and getting permissions." "Verify setting and getting permissions."
(set-tool-permission "test-tool-abc" :deny) (set-tool-permission "test-tool-abc" :deny)
(is (eq (get-tool-permission "test-tool-abc") :deny))) (is (eq (get-tool-permission "test-tool-abc :deny)))
(test permission-gate-allow (test permission-gate-allow
"Verify :allow tier passes through." "Verify :allow tier passes through."