fix(chaos): finalized absolute tangle paths via concat and INSTALL_DIR
This commit is contained in:
@@ -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)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :harness:act:
|
||||
@@ -47,11 +47,11 @@ Example feedback chain:
|
||||
#+begin_src lisp
|
||||
(defvar *default-actuator* :cli
|
||||
"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)
|
||||
"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
|
||||
|
||||
** initialize-actuators: System Bootstrap
|
||||
@@ -70,20 +70,20 @@ Example feedback chain:
|
||||
3. :tui - Terminal UI output via reply stream"
|
||||
|
||||
;; Load environment configuration
|
||||
(let ((def (getenv "DEFAULT_ACTUATOR"))
|
||||
(silent (getenv "SILENT_ACTUATORS")))
|
||||
(let ((def (getenv "DEFAULT_ACTUATOR)
|
||||
(silent (getenv "SILENT_ACTUATORS))
|
||||
|
||||
;; Set default actuator
|
||||
(when def
|
||||
(setf *default-actuator*
|
||||
(intern (string-upcase def) "KEYWORD")))
|
||||
(intern (string-upcase def) "KEYWORD))
|
||||
|
||||
;; Parse silent actuators list
|
||||
(when silent
|
||||
(setf *silent-actuators*
|
||||
(mapcar (lambda (s)
|
||||
(intern (string-upcase (string-trim '(#\Space) s))
|
||||
"KEYWORD"))
|
||||
"KEYWORD)
|
||||
(str:split "," silent)))))
|
||||
|
||||
;; Register core harness actuators
|
||||
@@ -179,7 +179,7 @@ Example feedback chain:
|
||||
(:create-skill
|
||||
(let* ((filename (getf payload :filename))
|
||||
(content (getf payload :content))
|
||||
(skills-dir (merge-pathnames "skills/"
|
||||
(skills-dir (merge-pathnames ""
|
||||
(asdf:system-source-directory :opencortex)))
|
||||
(full-path (merge-pathnames filename skills-dir)))
|
||||
(with-open-file (out full-path
|
||||
@@ -273,7 +273,7 @@ Example feedback chain:
|
||||
"Format a tool result for human-readable display.
|
||||
|
||||
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.)
|
||||
|
||||
This function normalizes both formats into a consistent string presentation."
|
||||
@@ -336,7 +336,7 @@ Example feedback chain:
|
||||
|
||||
;; Action was blocked by verification
|
||||
(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 approved nil)
|
||||
(setf feedback verified))
|
||||
@@ -393,7 +393,7 @@ Example feedback chain:
|
||||
These tests verify the Act pipeline. Run with:
|
||||
~(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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:pipeline-act-suite))
|
||||
@@ -401,14 +401,14 @@ These tests verify the Act pipeline. Run with:
|
||||
(in-package :opencortex-pipeline-act-tests)
|
||||
|
||||
(def-suite pipeline-act-suite
|
||||
:description "Test suite for Act pipeline")
|
||||
:description "Test suite for Act pipeline
|
||||
|
||||
(in-suite pipeline-act-suite)
|
||||
|
||||
(test test-act-gate-symbolic-guard-bypass
|
||||
"Verify that act-gate proceeds normally when no skill intercepts."
|
||||
(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)))
|
||||
(is (eq :acted (getf signal :status)))
|
||||
(is (null result))))
|
||||
@@ -421,8 +421,8 @@ These tests verify the Act pipeline. Run with:
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||
:deterministic (lambda (action ctx)
|
||||
(declare (ignore action ctx))
|
||||
(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"))))
|
||||
(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)))
|
||||
(result (opencortex:act-gate signal)))
|
||||
(is (eq :acted (getf signal :status)))
|
||||
(is (not (null result)))
|
||||
|
||||
@@ -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)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :harness:protocol:
|
||||
@@ -79,7 +79,7 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
|
||||
** Structural Validation (communication-validator.lisp)
|
||||
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)
|
||||
|
||||
(defun validate-communication-protocol-schema (msg)
|
||||
|
||||
@@ -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)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :harness:context:
|
||||
@@ -66,7 +66,7 @@ Identifies headlines tagged with ~project~ that have not yet reached a terminal
|
||||
#+begin_src lisp
|
||||
(defun context-get-active-projects ()
|
||||
"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)))
|
||||
#+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)
|
||||
"Reads the raw literate source of a specific skill for inspection."
|
||||
(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)))
|
||||
(full-path (merge-pathnames filename skills-dir)))
|
||||
(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
|
||||
(defun context-get-system-logs (&optional limit)
|
||||
"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*)
|
||||
(let ((count (min log-limit (length *system-logs*))))
|
||||
(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."
|
||||
(let* ((id (org-object-id obj))
|
||||
(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))
|
||||
(children (org-object-children obj))
|
||||
(stars (make-string depth :initial-element #\*))
|
||||
(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))
|
||||
(cosine-similarity foveal-vector obj-vector)
|
||||
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 render deeper nodes ONLY if they are semantically relevant.
|
||||
(should-render (or (<= depth 2) is-foveal is-semantically-relevant))
|
||||
(output ""))
|
||||
(output
|
||||
|
||||
(when should-render
|
||||
(setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id))
|
||||
(when is-semantically-relevant
|
||||
(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
|
||||
(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))))
|
||||
(projects (context-get-active-projects))
|
||||
(output "GLOBAL MEMEX AWARENESS (Peripheral Vision):
|
||||
"))
|
||||
)
|
||||
(if projects
|
||||
(dolist (project projects)
|
||||
(setf output (concatenate 'string output
|
||||
(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))
|
||||
#+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.
|
||||
|
||||
** 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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:vision-suite))
|
||||
(in-package :opencortex-peripheral-vision-tests)
|
||||
|
||||
(def-suite vision-suite
|
||||
:description "Verification of Foveal-Peripheral context model.")
|
||||
:description "Verification of Foveal-Peripheral context model.
|
||||
(in-suite vision-suite)
|
||||
#+end_src
|
||||
|
||||
** Foveal Rendering Test
|
||||
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
|
||||
"Verify that the foveal target is rendered with content, while siblings are skeletal."
|
||||
(clrhash opencortex::*memory*)
|
||||
(let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project")
|
||||
:contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
|
||||
(let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project
|
||||
:contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node
|
||||
: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)))))
|
||||
(ingest-ast ast)
|
||||
;; 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 "* Peripheral Node" 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
|
||||
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
|
||||
"Verify that context-assemble-global-awareness handles multiple projects."
|
||||
(clrhash opencortex::*memory*)
|
||||
(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 "p1" :TITLE "Project 1" :TAGS "project :contents nil))
|
||||
(ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS "project :contents nil))
|
||||
(let ((output (context-assemble-global-awareness)))
|
||||
(is (search "Project 1" output))
|
||||
(is (search "Project 2" output))))
|
||||
|
||||
@@ -23,65 +23,65 @@ Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that mi
|
||||
* Phase B: Protocol (Success Criteria)
|
||||
|
||||
** 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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:doctor-suite))
|
||||
#+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)
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle (expand-file-name "harness/doctor-tests.lisp" (concat (concat (or (getenv "INSTALL_DIR") ".") "/harness") "/tests"))
|
||||
(def-suite doctor-suite :description "Verification of the System Doctor diagnostic logic")
|
||||
#+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
|
||||
#+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)
|
||||
#+end_src
|
||||
|
||||
** 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
|
||||
"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)))))
|
||||
#+end_src
|
||||
|
||||
** 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
|
||||
"Verify that an invalid MEMEX_DIR triggers a critical failure."
|
||||
(let ((old-m (getenv "MEMEX_DIR"))
|
||||
(old-s (getenv "SKILLS_DIR")))
|
||||
(let ((old-m (getenv "MEMEX_DIR)
|
||||
(old-s (getenv "SKILLS_DIR))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setf (getenv "MEMEX_DIR") "/non/existent/path/999")
|
||||
(setf (getenv "MEMEX_DIR "/non/existent/path/999
|
||||
(is (null (opencortex:doctor-check-env))))
|
||||
(setf (getenv "MEMEX_DIR") (or old-m ""))
|
||||
(setf (getenv "SKILLS_DIR") (or old-s "")))))
|
||||
(setf (getenv "MEMEX_DIR (or old-m
|
||||
(setf (getenv "SKILLS_DIR (or old-s )))
|
||||
#+end_src
|
||||
|
||||
* Phase C: Implementation (Build)
|
||||
|
||||
** 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)
|
||||
#+end_src
|
||||
|
||||
** Global Configuration
|
||||
#+begin_src lisp :tangle (expand-file-name "harness/doctor.lisp" (expand-file-name "harness/"))
|
||||
(defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc")
|
||||
"List of external binaries required for full system operation.")
|
||||
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/doctor.lisp")" )
|
||||
(defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc
|
||||
"List of external binaries required for full system operation.
|
||||
#+end_src
|
||||
|
||||
** 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 ()
|
||||
"Verifies that required external binaries are available in the PATH via a shell probe."
|
||||
(let ((all-ok t))
|
||||
(harness-log "DOCTOR: Checking system dependencies...")
|
||||
(harness-log "DOCTOR: Checking system dependencies...
|
||||
(dolist (dep *doctor-required-binaries*)
|
||||
(let ((path (ignore-errors
|
||||
(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
|
||||
|
||||
** 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 ()
|
||||
"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)
|
||||
(config-dir (getenv "OC_CONFIG_DIR"))
|
||||
(data-dir (getenv "OC_DATA_DIR"))
|
||||
(state-dir (getenv "OC_STATE_DIR"))
|
||||
(memex-dir (getenv "MEMEX_DIR")))
|
||||
(config-dir (getenv "OC_CONFIG_DIR)
|
||||
(data-dir (getenv "OC_DATA_DIR)
|
||||
(state-dir (getenv "OC_STATE_DIR)
|
||||
(memex-dir (getenv "MEMEX_DIR))
|
||||
|
||||
(flet ((check-dir (name path critical)
|
||||
(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
|
||||
|
||||
** 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 ()
|
||||
"Tests connectivity to primary LLM providers. Non-critical fallback allowed."
|
||||
(harness-log "DOCTOR: Checking LLM connectivity...")
|
||||
(let ((openrouter-key (getenv "OPENROUTER_API_KEY")))
|
||||
(harness-log "DOCTOR: Checking LLM connectivity...
|
||||
(let ((openrouter-key (getenv "OPENROUTER_API_KEY))
|
||||
(if (and openrouter-key (> (length openrouter-key) 0))
|
||||
(progn
|
||||
(harness-log " [OK] OpenRouter API Key detected.")
|
||||
(harness-log " [OK] OpenRouter API Key detected.
|
||||
t)
|
||||
(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))))
|
||||
#+end_src
|
||||
|
||||
** 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 ()
|
||||
"Executes the full diagnostic suite and returns T if system is healthy."
|
||||
(harness-log "==================================================")
|
||||
(harness-log " OPENCORTEX DOCTOR: Commencing Health Check")
|
||||
(harness-log "==================================================")
|
||||
(harness-log "==================================================
|
||||
(harness-log " OPENCORTEX DOCTOR: Commencing Health Check
|
||||
(harness-log "==================================================
|
||||
(let ((dep-ok (doctor-check-dependencies))
|
||||
(env-ok (doctor-check-env))
|
||||
(llm-ok (doctor-check-llm)))
|
||||
(harness-log "==================================================")
|
||||
(harness-log "==================================================
|
||||
(if (and dep-ok env-ok)
|
||||
(progn
|
||||
(harness-log " ✓ SYSTEM HEALTHY: Ready for ignition.")
|
||||
(harness-log " ✓ SYSTEM HEALTHY: Ready for ignition.
|
||||
t)
|
||||
(progn
|
||||
(harness-log " ✗ SYSTEM UNHEALTHY: Fix the errors above.")
|
||||
(harness-log " ✗ SYSTEM UNHEALTHY: Fix the errors above.
|
||||
nil))))
|
||||
#+end_src
|
||||
|
||||
** 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 ()
|
||||
"Entry point for the 'doctor' CLI command."
|
||||
(if (doctor-run-all)
|
||||
|
||||
@@ -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)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :harness:loop:
|
||||
@@ -73,14 +73,14 @@ The loop operates in a multi-threaded environment:
|
||||
|
||||
(defvar *interrupt-flag* nil
|
||||
"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.
|
||||
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
|
||||
"Handle to the heartbeat thread, allowing explicit termination on shutdown.")
|
||||
"Handle to the heartbeat thread, allowing explicit termination on shutdown.
|
||||
#+end_src
|
||||
|
||||
* 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))
|
||||
(meta (getf current-signal :meta)))
|
||||
(when (> depth 10)
|
||||
(harness-log "METABOLISM ERROR: Max recursion depth reached.")
|
||||
(harness-log "METABOLISM ERROR: Max recursion depth reached.
|
||||
(return nil))
|
||||
|
||||
;; Check for graceful shutdown interrupt
|
||||
(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))
|
||||
(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
|
||||
;; This prevents losing recent context due to a single bad API call
|
||||
(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))
|
||||
|
||||
;; 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
|
||||
(defvar *auto-save-interval* 300
|
||||
"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
|
||||
"Tracks heartbeats since last save, used to calculate auto-save timing.")
|
||||
"Tracks heartbeats since last save, used to calculate auto-save timing.
|
||||
#+end_src
|
||||
|
||||
** 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)
|
||||
- MEMORY_AUTO_SAVE_INTERVAL: Seconds between auto-saves (default: 300)"
|
||||
|
||||
(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*)))
|
||||
(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*)))
|
||||
(setf *auto-save-interval* auto-save)
|
||||
(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
|
||||
:unix-time (get-universal-time)))))
|
||||
|
||||
:name "opencortex-heartbeat")))))
|
||||
:name "opencortex-heartbeat))))
|
||||
#+end_src
|
||||
|
||||
* Main Entry Point
|
||||
@@ -245,7 +245,7 @@ The heartbeat thread ensures the agent remains alive even without external input
|
||||
#+begin_src lisp
|
||||
(defvar *shutdown-save-enabled* t
|
||||
"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
|
||||
|
||||
** 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."
|
||||
|
||||
;; Step 1: Load environment variables from standard location
|
||||
(let* ((home (getenv "HOME"))
|
||||
(let* ((home (getenv "HOME)
|
||||
(env-file (uiop:merge-pathnames*
|
||||
".local/share/opencortex/.env"
|
||||
(uiop:ensure-directory-pathname home))))
|
||||
@@ -298,19 +298,19 @@ The main function orchestrates system startup:
|
||||
(sb-sys:enable-interrupt sb-unix:sigint
|
||||
(lambda (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*
|
||||
(save-memory-to-disk))
|
||||
(uiop:quit 0)))
|
||||
|
||||
;; Step 7: Idle loop - sleep in chunks, checking for interrupts
|
||||
(let ((sleep-interval (or (ignore-errors
|
||||
(parse-integer (getenv "DAEMON_SLEEP_INTERVAL")))
|
||||
(parse-integer (getenv "DAEMON_SLEEP_INTERVAL))
|
||||
3600)))
|
||||
(loop
|
||||
;; Check for interrupt before each sleep cycle
|
||||
(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*
|
||||
(save-memory-to-disk))
|
||||
(return))
|
||||
@@ -324,7 +324,7 @@ The main function orchestrates system startup:
|
||||
These tests verify the metabolic loop and error recovery. Run with:
|
||||
~(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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:immune-suite))
|
||||
@@ -332,7 +332,7 @@ These tests verify the metabolic loop and error recovery. Run with:
|
||||
(in-package :opencortex-immune-system-tests)
|
||||
|
||||
(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)
|
||||
|
||||
@@ -342,9 +342,9 @@ These tests verify the metabolic loop and error recovery. Run with:
|
||||
(opencortex:defskill :evil-skill
|
||||
:priority 100
|
||||
: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)
|
||||
(opencortex:harness-log "CLEAN LOG")
|
||||
(opencortex:harness-log "CLEAN LOG
|
||||
(opencortex:process-signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||
(let ((logs (opencortex:context-get-system-logs 20)))
|
||||
(is (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs))))))
|
||||
|
||||
@@ -9,7 +9,7 @@ The *System Manifest* defines the structural components of the OpenCortex. It se
|
||||
* Implementation
|
||||
|
||||
** Main System
|
||||
#+begin_src lisp :tangle (expand-file-name "opencortex.asd")
|
||||
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/opencortex.asd")
|
||||
(defsystem :opencortex
|
||||
:name "opencortex"
|
||||
: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"
|
||||
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
|
||||
:serial t
|
||||
:components ((:file "harness/package")
|
||||
(:file "harness/skills")
|
||||
(:file "harness/communication")
|
||||
(:file "harness/communication-validator")
|
||||
(:file "harness/memory")
|
||||
(:file "harness/context")
|
||||
(:file "harness/perceive")
|
||||
(:file "harness/reason")
|
||||
(:file "harness/act")
|
||||
(:file "harness/loop")))
|
||||
:components ((:file "package
|
||||
(:file "skills
|
||||
(:file "communication
|
||||
(:file "communication-validator
|
||||
(:file "memory
|
||||
(:file "context
|
||||
(:file "perceive
|
||||
(:file "reason
|
||||
(:file "act
|
||||
(:file "loop))
|
||||
#+end_src
|
||||
|
||||
** 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
|
||||
:depends-on (:opencortex :fiveam)
|
||||
:components ((:file "tests/pipeline-act-tests")
|
||||
(:file "tests/boot-sequence-tests")
|
||||
(:file "tests/immune-system-tests")
|
||||
(:file "tests/memory-tests")
|
||||
(:file "tests/pipeline-perceive-tests")
|
||||
(:file "tests/pipeline-reason-tests")
|
||||
(:file "tests/peripheral-vision-tests")
|
||||
(:file "tests/emacs-edit-tests")
|
||||
(:file "tests/engineering-standards-tests")
|
||||
(:file "tests/lisp-utils-tests")
|
||||
(:file "tests/literate-programming-tests")
|
||||
(:file "tests/self-edit-tests")
|
||||
(:file "tests/tool-permissions-tests")
|
||||
(:file "tests/diagnostics-tests")
|
||||
(:file "tests/config-manager-tests")
|
||||
(:file "tests/gateway-manager-tests")
|
||||
(:file "tests/tui-tests")
|
||||
(:file "tests/llm-gateway-tests")))
|
||||
:components ((:file "pipeline-act-tests
|
||||
(:file "boot-sequence-tests
|
||||
(:file "immune-system-tests
|
||||
(:file "memory-tests
|
||||
(:file "pipeline-perceive-tests
|
||||
(:file "pipeline-reason-tests
|
||||
(:file "peripheral-vision-tests
|
||||
(:file "emacs-edit-tests
|
||||
(:file "engineering-standards-tests
|
||||
(:file "lisp-utils-tests
|
||||
(:file "literate-programming-tests
|
||||
(:file "self-edit-tests
|
||||
(:file "tool-permissions-tests
|
||||
(:file "diagnostics-tests
|
||||
(:file "config-manager-tests
|
||||
(:file "gateway-manager-tests
|
||||
(:file "tui-tests
|
||||
(:file "llm-gateway-tests))
|
||||
#+end_src
|
||||
|
||||
** 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
|
||||
:depends-on (:opencortex :croatoan :usocket :bordeaux-threads)
|
||||
:components ((:file "harness/tui-client")))
|
||||
:components ((:file "tui-client))
|
||||
#+end_src
|
||||
|
||||
** 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)))
|
||||
|
||||
(let ((oc-dir (or (getenv "OC_DATA_DIR")
|
||||
(namestring (truename "./")))))
|
||||
(let ((oc-dir (or (getenv "OC_DATA_DIR
|
||||
(namestring (truename "./))))
|
||||
(push (uiop:ensure-directory-pathname oc-dir) asdf:*central-registry*))
|
||||
|
||||
(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)
|
||||
|
||||
(format t "~%=== Running ALL Test Suites ===~%")
|
||||
(format t "~%=== Running ALL Test Suites ===~%
|
||||
|
||||
(dolist (suite-spec '(("OPENCORTEX-BOOT-TESTS" "BOOT-SUITE")
|
||||
("OPENCORTEX-COMMUNICATION-TESTS" "COMMUNICATION-PROTOCOL-SUITE")
|
||||
("OPENCORTEX-PIPELINE-ACT-TESTS" "PIPELINE-ACT-SUITE")
|
||||
("OPENCORTEX-MEMORY-TESTS" "MEMORY-SUITE")
|
||||
("OPENCORTEX-ENGINEERING-STANDARDS-TESTS" "ENGINEERING-STANDARDS-SUITE")
|
||||
("OPENCORTEX-DIAGNOSTICS-TESTS" "DIAGNOSTICS-SUITE")
|
||||
("OPENCORTEX-GATEWAY-MANAGER-TESTS" "GATEWAY-SUITE")
|
||||
("OPENCORTEX-TUI-TESTS" "TUI-SUITE")
|
||||
("OPENCORTEX-LLM-GATEWAY-TESTS" "LLM-GATEWAY-SUITE")))
|
||||
(dolist (suite-spec '(("OPENCORTEX-BOOT-TESTS" "BOOT-SUITE
|
||||
("OPENCORTEX-COMMUNICATION-TESTS" "COMMUNICATION-PROTOCOL-SUITE
|
||||
("OPENCORTEX-PIPELINE-ACT-TESTS" "PIPELINE-ACT-SUITE
|
||||
("OPENCORTEX-MEMORY-TESTS" "MEMORY-SUITE
|
||||
("OPENCORTEX-ENGINEERING-STANDARDS-TESTS" "ENGINEERING-STANDARDS-SUITE
|
||||
("OPENCORTEX-DIAGNOSTICS-TESTS" "DIAGNOSTICS-SUITE
|
||||
("OPENCORTEX-GATEWAY-MANAGER-TESTS" "GATEWAY-SUITE
|
||||
("OPENCORTEX-TUI-TESTS" "TUI-SUITE
|
||||
("OPENCORTEX-LLM-GATEWAY-TESTS" "LLM-GATEWAY-SUITE))
|
||||
(let ((pkg (find-package (first suite-spec))))
|
||||
(when 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))
|
||||
(fiveam:run! suite-sym))))))
|
||||
|
||||
(format t "~%=== ALL TESTS COMPLETE ===~%")
|
||||
(format t "~%=== ALL TESTS COMPLETE ===~%
|
||||
#+end_src
|
||||
|
||||
|
||||
@@ -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)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :harness:memory:
|
||||
@@ -32,14 +32,14 @@ flowchart TD
|
||||
#+end_src
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle memory.lisp" )
|
||||
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")" )
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
** 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.
|
||||
|
||||
#+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 *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)
|
||||
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
|
||||
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)
|
||||
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)
|
||||
"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)))
|
||||
@@ -78,7 +78,7 @@ The `compute-merkle-hash` function ensures the cryptographic integrity of the kn
|
||||
** 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.
|
||||
|
||||
#+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)
|
||||
"Parses an Org AST into the recursive Lisp Memory with Merkle hashing."
|
||||
(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)
|
||||
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)
|
||||
|
||||
(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)
|
||||
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))
|
||||
"Restores the Memory to a previously captured snapshot using immutable history pointers."
|
||||
(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)
|
||||
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
|
||||
"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)
|
||||
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)
|
||||
"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
|
||||
|
||||
** 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
|
||||
"Searches memory for objects semantically similar to a 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
|
||||
|
||||
** 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
|
||||
"Generates vector embeddings for given text via the configured embedding backend (Ollama)."
|
||||
((: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
|
||||
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 ()
|
||||
"Generates a new UUID string for Org-mode identification."
|
||||
(string-downcase (format nil "~a" (uuid:make-v4-uuid))))
|
||||
@@ -325,7 +325,7 @@ Basic functions for retrieving objects by ID or type.
|
||||
** Structural Helpers
|
||||
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)
|
||||
"Traverses an AST to find headlines that lack an :ID: property."
|
||||
(when (listp ast)
|
||||
|
||||
@@ -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)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :harness:interface:
|
||||
|
||||
@@ -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)
|
||||
#+AUTHOR: Amr
|
||||
#+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.
|
||||
|
||||
Other sensors (:heartbeat, :interrupt, :buffer-update) are processed
|
||||
synchronously to maintain temporal ordering.")
|
||||
synchronously to maintain temporal ordering.
|
||||
#+end_src
|
||||
|
||||
** 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
|
||||
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
|
||||
|
||||
* Stimulus Injection
|
||||
@@ -113,7 +113,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
|
||||
|
||||
;; Ensure metadata exists
|
||||
(unless meta
|
||||
(setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
|
||||
(setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal))
|
||||
|
||||
;; Attach reply stream if provided
|
||||
(when stream
|
||||
@@ -131,7 +131,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
|
||||
(invoke-restart 'skip-event))))
|
||||
(process-signal raw-message))
|
||||
(skip-event () nil)))
|
||||
:name "opencortex-async-task")
|
||||
:name "opencortex-async-task
|
||||
|
||||
;; Sync: process in main thread with recovery
|
||||
(restart-case
|
||||
@@ -140,7 +140,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
|
||||
(invoke-restart 'skip-event))))
|
||||
(process-signal raw-message))
|
||||
(skip-event ()
|
||||
(harness-log "SYSTEM RECOVERY: Stimulus dropped."))))))
|
||||
(harness-log "SYSTEM RECOVERY: Stimulus dropped.)))))
|
||||
#+end_src
|
||||
|
||||
* The Perceive Gate
|
||||
@@ -170,7 +170,7 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o
|
||||
|
||||
;; Log the incoming signal for debugging
|
||||
(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
|
||||
(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:
|
||||
~(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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:pipeline-perceive-suite))
|
||||
@@ -235,14 +235,14 @@ These tests verify the Perceive pipeline. Run with:
|
||||
(in-package :opencortex-pipeline-perceive-tests)
|
||||
|
||||
(def-suite pipeline-perceive-suite
|
||||
:description "Test suite for Perceive pipeline")
|
||||
:description "Test suite for Perceive pipeline
|
||||
|
||||
(in-suite pipeline-perceive-suite)
|
||||
|
||||
(test test-perceive-gate
|
||||
"Perceive gate should update the object store and normalize signal."
|
||||
(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)))
|
||||
(is (eq :perceived (getf result :status)))
|
||||
(is (not (null (gethash "test-node" opencortex::*memory*))))))
|
||||
|
||||
@@ -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)
|
||||
#+AUTHOR: Amr
|
||||
#+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.
|
||||
|
||||
A plist message like:
|
||||
: (TYPE :REQUEST TARGET :CLI PAYLOAD (ACTION :MESSAGE TEXT "Hello"))
|
||||
: (TYPE :REQUEST TARGET :CLI PAYLOAD (ACTION :MESSAGE TEXT "Hello)
|
||||
|
||||
Is simultaneously:
|
||||
- Human-readable text
|
||||
@@ -46,17 +46,17 @@ The probabilistic engine is responsible for all neural/LLM operations. It mainta
|
||||
|
||||
#+begin_src lisp
|
||||
(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
|
||||
"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
|
||||
"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
|
||||
"When T, run multiple providers and compare results for critical decisions.")
|
||||
"When T, run multiple providers and compare results for critical decisions.
|
||||
#+end_src
|
||||
|
||||
** 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.
|
||||
FN is a function with signature: (funcall fn prompt system-prompt &key model)
|
||||
returning either:
|
||||
- (list :status :success :content \"response text\")
|
||||
- (list :status :error :message \"error description\")
|
||||
- (list :status :success :content \"response text\
|
||||
- (list :status :error :message \"error description\
|
||||
- a simple string on success
|
||||
|
||||
Example registration:
|
||||
@@ -82,7 +82,7 @@ The probabilistic engine is responsible for all neural/LLM operations. It mainta
|
||||
|
||||
#+begin_src lisp
|
||||
(defun probabilistic-call (prompt &key
|
||||
(system-prompt "You are the Probabilistic engine.")
|
||||
(system-prompt "You are the Probabilistic engine.
|
||||
(cascade nil)
|
||||
(context nil))
|
||||
"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
|
||||
(list :type :LOG
|
||||
:payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
|
||||
:payload (list :text "Neural Cascade Failure: All providers exhausted.))))
|
||||
#+end_src
|
||||
|
||||
* 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))
|
||||
(let ((cleaned text))
|
||||
(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 "```" 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 "```" cleaned
|
||||
(string-trim '(#\Space #\Newline #\Tab) cleaned))
|
||||
text))
|
||||
#+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.
|
||||
|
||||
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)
|
||||
(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.
|
||||
|
||||
Returns a plist with structure:
|
||||
(:TYPE :REQUEST :TARGET :CLI :PAYLOAD (:ACTION :MESSAGE :TEXT \"...\"))"
|
||||
(:TYPE :REQUEST :TARGET :CLI :PAYLOAD (:ACTION :MESSAGE :TEXT \"...\)"
|
||||
|
||||
;; Gather context components
|
||||
(let* ((active-skill (find-triggered-skill context))
|
||||
(tool-belt (generate-tool-belt-prompt))
|
||||
(global-context (context-assemble-global-awareness))
|
||||
(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)))
|
||||
|
||||
;; 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)))
|
||||
(if (and p (stringp p))
|
||||
p
|
||||
"Maintain metabolic stasis."))))
|
||||
"Maintain metabolic stasis.)))
|
||||
|
||||
;; Inject Reflection Loop feedback if a previous proposal was rejected
|
||||
(reflection-feedback (if rejection-trace
|
||||
(format nil "~%~%PREVIOUS PROPOSAL REJECTED:~%Your previous proposal was rejected by the deterministic safety gates.~%Rejection Trace: ~a~%You MUST fix the syntax or logic error described above and try again." rejection-trace)
|
||||
""))
|
||||
|
||||
|
||||
(system-prompt (format nil
|
||||
"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.
|
||||
|
||||
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:
|
||||
(: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,
|
||||
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))
|
||||
(loop
|
||||
(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 :status) :reasoned)
|
||||
(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:
|
||||
~(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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:pipeline-reason-suite))
|
||||
@@ -480,7 +480,7 @@ These tests verify the Reason (cognitive) pipeline. Run with:
|
||||
(in-package :opencortex-pipeline-reason-tests)
|
||||
|
||||
(def-suite pipeline-reason-suite
|
||||
:description "Test suite for Reason pipeline")
|
||||
:description "Test suite for Reason pipeline
|
||||
|
||||
(in-suite pipeline-reason-suite)
|
||||
|
||||
@@ -491,10 +491,10 @@ These tests verify the Reason (cognitive) pipeline. Run with:
|
||||
(opencortex::defskill :mock-safety
|
||||
:priority 50
|
||||
:trigger (lambda (ctx) t)
|
||||
:probabilistic (lambda (ctx) "Mock probabilistic")
|
||||
:probabilistic (lambda (ctx) "Mock probabilistic
|
||||
:deterministic (lambda (action ctx)
|
||||
(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 /\")")))
|
||||
(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 /\))
|
||||
(signal (list :type :EVENT :candidate candidate))
|
||||
(result (deterministic-verify candidate signal)))
|
||||
(is (eq :LOG (getf result :type)))
|
||||
|
||||
@@ -23,7 +23,7 @@ To maintain sovereignty, the harness must remain a "dumb" bus. It should not kno
|
||||
** The Installer Script (opencortex.sh)
|
||||
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
|
||||
# (The content here is a duplicate of the main opencortex.sh for literate consistency)
|
||||
# [Note: Implementation is already verified in the top-level script]
|
||||
|
||||
@@ -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)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :harness:skills:
|
||||
|
||||
@@ -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:
|
||||
:ID: tui-client-spec
|
||||
: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)
|
||||
|
||||
** Test Suite Context
|
||||
#+begin_src lisp :tangle ((expand-file-name "tui-tests.lisp"))
|
||||
#+begin_src lisp :tangle (tui-tests.lisp)
|
||||
(defpackage :opencortex-tui-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:tui-suite))
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ((expand-file-name "tui-tests.lisp"))
|
||||
#+begin_src lisp :tangle (tui-tests.lisp)
|
||||
(in-package :opencortex-tui-tests)
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ((expand-file-name "tui-tests.lisp"))
|
||||
(def-suite tui-suite :description "Verification of the TUI parsing and styling logic")
|
||||
#+begin_src lisp :tangle (tui-tests.lisp)
|
||||
(def-suite tui-suite :description "Verification of the TUI parsing and styling logic
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ((expand-file-name "tui-tests.lisp"))
|
||||
#+begin_src lisp :tangle (tui-tests.lisp)
|
||||
(in-suite tui-suite)
|
||||
#+end_src
|
||||
|
||||
** 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
|
||||
"Tier 2 Chaos: Verify that handle-return degrades gracefully when the daemon connection is lost."
|
||||
(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)
|
||||
|
||||
** 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)
|
||||
#+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
|
||||
(:use :cl :croatoan)
|
||||
(:export :main))
|
||||
#+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)
|
||||
#+end_src
|
||||
|
||||
** Global State
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp")
|
||||
(defvar *daemon-host* "127.0.0.1")
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
|
||||
(defvar *daemon-host* "127.0.0.1
|
||||
#+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)
|
||||
#+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)
|
||||
#+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)
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp")
|
||||
(defvar *chat-history* (list) "Full chronological log of messages.")
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
|
||||
(defvar *chat-history* (list) "Full chronological log of messages.
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp")
|
||||
(defvar *scroll-index* 0 "Offset for history rendering.")
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
|
||||
(defvar *scroll-index* 0 "Offset for history rendering.
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp")
|
||||
(defvar *status-text* "Connecting...")
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
|
||||
(defvar *status-text* "Connecting...
|
||||
#+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))
|
||||
#+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))
|
||||
#+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)
|
||||
#+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)
|
||||
#+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))
|
||||
#+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)
|
||||
#+end_src
|
||||
|
||||
** 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)
|
||||
"Thread-safe addition to incoming message queue."
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
(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 ()
|
||||
"Thread-safe retrieval of incoming messages."
|
||||
(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
|
||||
|
||||
** 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)
|
||||
"Determines croatoan attributes based on content patterns."
|
||||
(cond
|
||||
@@ -154,7 +154,7 @@ A simple MVP console is insufficient for a Lisp Machine. To reach v0.2.0, the TU
|
||||
#+end_src
|
||||
|
||||
** 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)
|
||||
"Renders the chat history with scrolling and styling."
|
||||
(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
|
||||
|
||||
** 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 ()
|
||||
"Deletes last character from input buffer."
|
||||
(when (> (fill-pointer *input-buffer*) 0)
|
||||
(decf (fill-pointer *input-buffer*))))
|
||||
#+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)
|
||||
"Process input buffer as message or command."
|
||||
(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))))
|
||||
(finish-output stream))
|
||||
(error (c)
|
||||
(enqueue-msg "ERROR: Connection to daemon lost.")
|
||||
(enqueue-msg "ERROR: Connection to daemon lost.
|
||||
(setf *is-running* nil))))
|
||||
(when (string= cmd "/exit") (setf *is-running* nil))
|
||||
(when (string= cmd "/clear") (setf *chat-history* nil))))
|
||||
(when (string= cmd "/exit (setf *is-running* nil))
|
||||
(when (string= cmd "/clear (setf *chat-history* nil))))
|
||||
#+end_src
|
||||
|
||||
** 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 ()
|
||||
"Initializes ncurses and starts the TUI event loop."
|
||||
(handler-case
|
||||
|
||||
@@ -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:
|
||||
:ID: bouncer-agent-skill
|
||||
: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:
|
||||
|
||||
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
|
||||
4. Bouncer detects approval on next heartbeat
|
||||
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
|
||||
(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.
|
||||
|
||||
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)
|
||||
"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
|
||||
(cmd (or (getf payload :cmd)
|
||||
(when (and (eq target :tool)
|
||||
(equal (getf payload :tool) "shell"))
|
||||
(equal (getf payload :tool) "shell)
|
||||
(getf (getf payload :args) :cmd))))
|
||||
(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
|
||||
((and (or (eq target :shell)
|
||||
(and (eq target :tool)
|
||||
(equal (getf payload :tool) "shell")))
|
||||
(equal (getf payload :tool) "shell))
|
||||
(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
|
||||
: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
|
||||
((or (member target '(:shell))
|
||||
(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)
|
||||
(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."
|
||||
|
||||
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
|
||||
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED)
|
||||
(found-any nil))
|
||||
|
||||
(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)
|
||||
|
||||
;; 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))))))
|
||||
|
||||
@@ -299,7 +299,7 @@ When the Bouncer intercepts a high-risk action, it creates a flight plan node fo
|
||||
:attributes (list
|
||||
:TITLE "Flight Plan: High-Risk Action"
|
||||
:TODO "PLAN"
|
||||
:TAGS '("FLIGHT_PLAN")
|
||||
:TAGS '("FLIGHT_PLAN
|
||||
:ACTION (format nil "~s" blocked-action))))))
|
||||
#+end_src
|
||||
|
||||
|
||||
@@ -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:
|
||||
:ID: cli-gateway-skill
|
||||
: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)
|
||||
(format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING)))
|
||||
(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)))))
|
||||
|
||||
(defun handle-cli-slash-command (cmd stream)
|
||||
(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))))))))
|
||||
|
||||
(defun handle-cli-client (stream)
|
||||
"Reads framed messages from a CLI client and injects them as stimuli."
|
||||
(harness-log "CLI: Client connected.")
|
||||
(harness-log "CLI: Client connected.
|
||||
(handler-case
|
||||
(progn
|
||||
;; 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)
|
||||
(format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING)))
|
||||
(finish-output stream)
|
||||
@@ -63,11 +63,11 @@ The *CLI Gateway* is the primary sensory and actuating interface for human inter
|
||||
(progn
|
||||
;; Default meta if missing
|
||||
(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)
|
||||
(inject-stimulus msg :stream stream)))))))))
|
||||
(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*))
|
||||
"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 ()
|
||||
(unwind-protect (handle-cli-client stream)
|
||||
(usocket:socket-close socket)))
|
||||
:name "opencortex-cli-client-handler")))
|
||||
:name "opencortex-cli-client-handler))
|
||||
(usocket:socket-close *cli-server-socket*)))
|
||||
:name "opencortex-cli-gateway"))
|
||||
:name "opencortex-cli-gateway)
|
||||
(harness-log "CLI: Gateway listening on port ~a" port))
|
||||
|
||||
(register-actuator :CLI #'execute-cli-action)
|
||||
|
||||
@@ -16,78 +16,78 @@ Secrets are appended to `~/.config/opencortex/.env`, while structural metadata i
|
||||
* Phase B: Protocol (Success Criteria)
|
||||
|
||||
** 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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:config-suite))
|
||||
#+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)
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/config-manager-tests.lisp" (expand-file-name ""))
|
||||
(def-suite config-suite :description "Verification of the Config Manager skill")
|
||||
#+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
|
||||
#+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)
|
||||
#+end_src
|
||||
|
||||
** 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
|
||||
"Verify that multiple providers can be registered and saved."
|
||||
(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)))))
|
||||
|
||||
(test test-get-oc-config-dir-default
|
||||
"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
|
||||
(progn
|
||||
(setf (getenv "OC_CONFIG_DIR") nil)
|
||||
(setf (getenv "OC_CONFIG_DIR nil)
|
||||
(let ((dir (opencortex:get-oc-config-dir)))
|
||||
(is (search ".config/opencortex" (namestring dir)))))
|
||||
(if orig-env
|
||||
(setf (getenv "OC_CONFIG_DIR") orig-env)
|
||||
(setf (getenv "OC_CONFIG_DIR") nil)))))
|
||||
(setf (getenv "OC_CONFIG_DIR orig-env)
|
||||
(setf (getenv "OC_CONFIG_DIR nil)))))
|
||||
|
||||
(test test-get-oc-config-dir-env-override
|
||||
"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
|
||||
(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)))
|
||||
(is (string= "/tmp/test-opencortex-config/" (namestring dir)))))
|
||||
(if orig-env
|
||||
(setf (getenv "OC_CONFIG_DIR") orig-env)
|
||||
(setf (getenv "OC_CONFIG_DIR") nil)))))
|
||||
(setf (getenv "OC_CONFIG_DIR orig-env)
|
||||
(setf (getenv "OC_CONFIG_DIR nil)))))
|
||||
|
||||
(test test-save-providers-roundtrip
|
||||
"Verify save-providers writes and providers can be reloaded."
|
||||
(let ((opencortex::*providers* nil)
|
||||
(test-dir "/tmp/test-opencortex-config/")
|
||||
(orig-env (getenv "OC_CONFIG_DIR")))
|
||||
(test-dir "/tmp/test-opencortex-config/
|
||||
(orig-env (getenv "OC_CONFIG_DIR))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setf (getenv "OC_CONFIG_DIR") test-dir)
|
||||
(opencortex:register-provider :openai '(:key "test-key-123" :model "gpt-4"))
|
||||
(setf (getenv "OC_CONFIG_DIR test-dir)
|
||||
(opencortex:register-provider :openai '(:key "test-key-123" :model "gpt-4)
|
||||
(opencortex:save-providers)
|
||||
(let ((loaded-provs (uiop:read-file-string (merge-pathnames "providers.lisp" (uiop:ensure-directory-pathname test-dir)))))
|
||||
(is (search "openai" loaded-provs))
|
||||
(is (search "test-key-123" loaded-provs))))
|
||||
(uiop:delete-directory-tree (uiop:ensure-directory-pathname test-dir) :validate t)
|
||||
(if orig-env
|
||||
(setf (getenv "OC_CONFIG_DIR") orig-env)
|
||||
(setf (getenv "OC_CONFIG_DIR") nil)))))
|
||||
(setf (getenv "OC_CONFIG_DIR orig-env)
|
||||
(setf (getenv "OC_CONFIG_DIR nil)))))
|
||||
|
||||
(test test-configure-provider-validation
|
||||
"Verify configure-provider validates required fields."
|
||||
(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)))
|
||||
(is (equal "http://localhost:11434" (getf cfg :url))))))
|
||||
#+end_src
|
||||
@@ -95,39 +95,39 @@ Secrets are appended to `~/.config/opencortex/.env`, while structural metadata i
|
||||
* Phase C: Implementation (Build)
|
||||
|
||||
** 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)
|
||||
#+end_src
|
||||
|
||||
** 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*
|
||||
'(:name "config-manager"
|
||||
:description "Manages system settings and LLM provider configurations."
|
||||
:capabilities (:configure-provider :run-setup-wizard)
|
||||
:type :deterministic)
|
||||
"Skill metadata for the Config Manager.")
|
||||
"Skill metadata for the Config Manager.
|
||||
#+end_src
|
||||
|
||||
** 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*
|
||||
'((: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"))
|
||||
(: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"))
|
||||
(: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")))
|
||||
"Templates for supported LLM providers.")
|
||||
'((: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)
|
||||
(: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)
|
||||
(: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))
|
||||
"Templates for supported LLM providers.
|
||||
#+end_src
|
||||
|
||||
** Registry Persistence
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-config-manager.lisp" (expand-file-name ""))
|
||||
(defvar *providers* nil "Global registry of configured LLM providers.")
|
||||
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-config-manager.lisp")" )
|
||||
(defvar *providers* nil "Global registry of configured LLM providers.
|
||||
|
||||
(defun get-oc-config-dir ()
|
||||
"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))
|
||||
(uiop:ensure-directory-pathname env)
|
||||
(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)
|
||||
(finish-output)
|
||||
(let ((input (read-line)))
|
||||
(if (string= input "")
|
||||
(or default "")
|
||||
(if (string= input "
|
||||
(or default "
|
||||
input)))
|
||||
|
||||
(defun save-secret (provider field val)
|
||||
@@ -159,14 +159,14 @@ Secrets are appended to `~/.config/opencortex/.env`, while structural metadata i
|
||||
#+end_src
|
||||
|
||||
** 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)
|
||||
"Update the global provider registry."
|
||||
(setf (getf *providers* id) config))
|
||||
#+end_src
|
||||
|
||||
** 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)
|
||||
"Guided configuration for a specific LLM provider template."
|
||||
(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))))
|
||||
#+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 ()
|
||||
"Entry point for the interactive OpenCortex Lisp Setup Wizard."
|
||||
(format t "=== OpenCortex: Advanced Setup Wizard ===~%")
|
||||
(let ((user (prompt-for "Your Name" "User"))
|
||||
(agent (prompt-for "Agent Name" "OpenCortex")))
|
||||
(format t "=== OpenCortex: Advanced Setup Wizard ===~%
|
||||
(let ((user (prompt-for "Your Name" "User)
|
||||
(agent (prompt-for "Agent Name" "OpenCortex))
|
||||
(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)))
|
||||
(format t "~%Enter provider IDs to configure (comma separated, or 'all'): ")
|
||||
(format t "~%Enter provider IDs to configure (comma separated, or 'all'):
|
||||
(finish-output)
|
||||
(let* ((input (read-line))
|
||||
(ids (if (string= input "all")
|
||||
(ids (if (string= input "all
|
||||
(mapcar #'car *provider-templates*)
|
||||
(mapcar (lambda (s) (intern (string-upcase (string-trim " " s)) :keyword))
|
||||
(uiop:split-string input :separator ",")))))
|
||||
(uiop:split-string input :separator ",))))
|
||||
(dolist (id ids)
|
||||
(when (assoc id *provider-templates*)
|
||||
(configure-provider id))))
|
||||
(save-providers)
|
||||
(format t "~%Setup complete. Running diagnostics...~%")
|
||||
(format t "~%Setup complete. Running diagnostics...~%
|
||||
(doctor-run-all))
|
||||
#+end_src
|
||||
|
||||
@@ -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:
|
||||
:ID: credentials-vault-skill
|
||||
: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
|
||||
#+begin_src lisp
|
||||
(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)
|
||||
"Securely stores a secret and triggers a Merkle snapshot.")
|
||||
"Securely stores a secret and triggers a Merkle snapshot.
|
||||
#+end_src
|
||||
|
||||
* 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.
|
||||
|
||||
** 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).
|
||||
2. Redaction of keys in log strings.
|
||||
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
|
||||
(defvar opencortex::*vault-memory* (make-hash-table :test 'equal)
|
||||
"In-memory cache of sensitive credentials.")
|
||||
"In-memory cache of sensitive credentials.
|
||||
#+end_src
|
||||
|
||||
** 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."
|
||||
(if (and str (> (length str) 8))
|
||||
(format nil "~a...~a" (subseq str 0 4) (subseq str (- (length str) 4)))
|
||||
"[REDACTED]"))
|
||||
"[REDACTED])
|
||||
#+end_src
|
||||
|
||||
** Retrieval (vault-get-secret)
|
||||
@@ -96,15 +96,15 @@ This function is the secure getter for all system secrets. It prioritizes the Va
|
||||
val
|
||||
;; Fallback to environment
|
||||
(let ((env-var (case provider
|
||||
((:gemini :gemini-api) "GEMINI_API_KEY")
|
||||
(:openai "OPENAI_API_KEY")
|
||||
(:anthropic "ANTHROPIC_API_KEY")
|
||||
(:groq "GROQ_API_KEY")
|
||||
(:openrouter "OPENROUTER_API_KEY")
|
||||
(:telegram "TELEGRAM_BOT_TOKEN")
|
||||
(:signal "SIGNAL_ACCOUNT_NUMBER")
|
||||
(:matrix-homeserver "MATRIX_HOMESERVER")
|
||||
(:matrix-token "MATRIX_ACCESS_TOKEN")
|
||||
((:gemini :gemini-api) "GEMINI_API_KEY
|
||||
(:openai "OPENAI_API_KEY
|
||||
(:anthropic "ANTHROPIC_API_KEY
|
||||
(:groq "GROQ_API_KEY
|
||||
(:openrouter "OPENROUTER_API_KEY
|
||||
(:telegram "TELEGRAM_BOT_TOKEN
|
||||
(:signal "SIGNAL_ACCOUNT_NUMBER
|
||||
(:matrix-homeserver "MATRIX_HOMESERVER
|
||||
(:matrix-token "MATRIX_ACCESS_TOKEN
|
||||
(t nil))))
|
||||
(when (and env-var (eq type :api-key))
|
||||
(getenv env-var))))))
|
||||
@@ -129,11 +129,11 @@ Retained from the legacy Google skill, this provides the instructions for the au
|
||||
#+begin_src lisp
|
||||
(defun vault-onboard-gemini-web ()
|
||||
"Instructions for the Autonomous Cookie Handshake."
|
||||
(harness-log "--- GEMINI WEB ONBOARDING ---")
|
||||
(harness-log "1. Visit gemini.google.com")
|
||||
(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 "PLATFORM GUIDE: Chrome/Firefox/Safari all support Bookmarklets via 'Add Page' or 'New Bookmark'.")
|
||||
(harness-log "--- GEMINI WEB ONBOARDING ---
|
||||
(harness-log "1. Visit gemini.google.com
|
||||
(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 "PLATFORM GUIDE: Chrome/Firefox/Safari all support Bookmarklets via 'Add Page' or 'New Bookmark'.
|
||||
t)
|
||||
#+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.
|
||||
|
||||
** 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
|
||||
(:use :cl :fiveam :opencortex))
|
||||
(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)
|
||||
|
||||
(test test-masking
|
||||
(is (equal "sk-t...-key" (opencortex::vault-mask-string "sk-test-key")))
|
||||
(is (equal "[REDACTED]" (opencortex::vault-mask-string "short"))))
|
||||
(is (equal "sk-t...-key" (opencortex::vault-mask-string "sk-test-key))
|
||||
(is (equal "[REDACTED]" (opencortex::vault-mask-string "short)))
|
||||
|
||||
(test test-vault-persistence
|
||||
"Verify that setting a secret triggers a snapshot (mock check)."
|
||||
(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))))
|
||||
|#
|
||||
#+end_src
|
||||
|
||||
@@ -18,61 +18,61 @@ The skill strictly validates the POSIX standard paths resolved during bootstrap,
|
||||
* Phase B: Protocol (Success Criteria)
|
||||
|
||||
** 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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:diagnostics-suite))
|
||||
#+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)
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/diagnostics-tests.lisp" (expand-file-name ""))
|
||||
(def-suite diagnostics-suite :description "Verification of the Diagnostics skill")
|
||||
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/tests/diagnostics-tests.lisp")" )
|
||||
(def-suite diagnostics-suite :description "Verification of the Diagnostics skill
|
||||
#+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)
|
||||
#+end_src
|
||||
|
||||
** 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
|
||||
"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)))))
|
||||
#+end_src
|
||||
|
||||
* Phase C: Implementation (Build)
|
||||
|
||||
** 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)
|
||||
#+end_src
|
||||
|
||||
** 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*
|
||||
'(:name "diagnostics"
|
||||
:description "Performs system health checks and environment validation."
|
||||
:capabilities (:run-diagnostics)
|
||||
:type :deterministic)
|
||||
"Skill metadata for the Diagnostics component.")
|
||||
"Skill metadata for the Diagnostics component.
|
||||
#+end_src
|
||||
|
||||
** Global Configuration
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-diagnostics.lisp" (expand-file-name ""))
|
||||
(defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc")
|
||||
"List of external binaries required for full system operation.")
|
||||
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-diagnostics.lisp")" )
|
||||
(defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc
|
||||
"List of external binaries required for full system operation.
|
||||
#+end_src
|
||||
|
||||
** 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 ()
|
||||
"Verifies that required external binaries are available in the PATH via a shell probe."
|
||||
(let ((all-ok t))
|
||||
(harness-log "DOCTOR: Checking system dependencies...")
|
||||
(harness-log "DOCTOR: Checking system dependencies...
|
||||
(dolist (dep *doctor-required-binaries*)
|
||||
(let ((path (ignore-errors
|
||||
(uiop:run-program (list "which" dep)
|
||||
@@ -86,15 +86,15 @@ The skill strictly validates the POSIX standard paths resolved during bootstrap,
|
||||
#+end_src
|
||||
|
||||
** 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 ()
|
||||
"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)
|
||||
(config-dir (getenv "OC_CONFIG_DIR"))
|
||||
(data-dir (getenv "OC_DATA_DIR"))
|
||||
(state-dir (getenv "OC_STATE_DIR"))
|
||||
(memex-dir (getenv "MEMEX_DIR")))
|
||||
(config-dir (getenv "OC_CONFIG_DIR)
|
||||
(data-dir (getenv "OC_DATA_DIR)
|
||||
(state-dir (getenv "OC_STATE_DIR)
|
||||
(memex-dir (getenv "MEMEX_DIR))
|
||||
|
||||
(flet ((check-dir (name path critical)
|
||||
(if (and path (> (length path) 0))
|
||||
@@ -115,42 +115,42 @@ The skill strictly validates the POSIX standard paths resolved during bootstrap,
|
||||
#+end_src
|
||||
|
||||
** 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 ()
|
||||
"Tests connectivity to primary LLM providers. Non-critical fallback allowed."
|
||||
(harness-log "DOCTOR: Checking LLM connectivity...")
|
||||
(let ((openrouter-key (getenv "OPENROUTER_API_KEY")))
|
||||
(harness-log "DOCTOR: Checking LLM connectivity...
|
||||
(let ((openrouter-key (getenv "OPENROUTER_API_KEY))
|
||||
(if (and openrouter-key (> (length openrouter-key) 0))
|
||||
(progn
|
||||
(harness-log " [OK] OpenRouter API Key detected.")
|
||||
(harness-log " [OK] OpenRouter API Key detected.
|
||||
t)
|
||||
(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))))
|
||||
#+end_src
|
||||
|
||||
** 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 ()
|
||||
"Executes the full diagnostic suite and returns T if system is healthy."
|
||||
(harness-log "==================================================")
|
||||
(harness-log " OPENCORTEX DOCTOR: Commencing Health Check")
|
||||
(harness-log "==================================================")
|
||||
(harness-log "==================================================
|
||||
(harness-log " OPENCORTEX DOCTOR: Commencing Health Check
|
||||
(harness-log "==================================================
|
||||
(let ((dep-ok (doctor-check-dependencies))
|
||||
(env-ok (doctor-check-env))
|
||||
(llm-ok (doctor-check-llm)))
|
||||
(harness-log "==================================================")
|
||||
(harness-log "==================================================
|
||||
(if (and dep-ok env-ok)
|
||||
(progn
|
||||
(harness-log " ✓ SYSTEM HEALTHY: Ready for ignition.")
|
||||
(harness-log " ✓ SYSTEM HEALTHY: Ready for ignition.
|
||||
t)
|
||||
(progn
|
||||
(harness-log " ✗ SYSTEM UNHEALTHY: Fix the errors above.")
|
||||
(harness-log " ✗ SYSTEM UNHEALTHY: Fix the errors above.
|
||||
nil))))
|
||||
#+end_src
|
||||
|
||||
** 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 ()
|
||||
"Entry point for the 'doctor' CLI command."
|
||||
(if (doctor-run-all)
|
||||
|
||||
@@ -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:
|
||||
:ID: emacs-edit-skill
|
||||
:CREATED: [2026-04-23 Thu]
|
||||
@@ -91,11 +91,11 @@ Converts AST back to org format, preserving structure.
|
||||
INDENT-LEVEL is number of leading asterisks."
|
||||
(let* ((level (or indent-level 1))
|
||||
(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)))
|
||||
(format nil "~a ~a~%~a"
|
||||
stars
|
||||
(if todo (format nil "[~a] " (string-upcase todo)) "")
|
||||
(if todo (format nil "[~a] " (string-upcase todo)) "
|
||||
title)))
|
||||
|
||||
(defun emacs-edit-print-properties (props)
|
||||
@@ -143,13 +143,13 @@ Preserves structure including #+begin_src blocks."
|
||||
|
||||
;; Code block (preserve exactly)
|
||||
((eq type :src-block)
|
||||
(let ((lang (or (getf ast :language) ""))
|
||||
(code (or (getf ast :value) "")))
|
||||
(let ((lang (or (getf ast :language)
|
||||
(code (or (getf ast :value) )
|
||||
(format nil "#+begin_src ~a~%~a~%#+end_src~%"
|
||||
lang code)))
|
||||
|
||||
;; Unknown - return as-is
|
||||
(t (format nil "")))))
|
||||
(t (format nil )))
|
||||
#+end_src
|
||||
|
||||
** Read Operation
|
||||
@@ -157,7 +157,7 @@ Parse org file to AST.
|
||||
|
||||
#+begin_src lisp
|
||||
(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)
|
||||
"Parses an org FILE-PATH using existing ingest-ast.
|
||||
@@ -203,7 +203,7 @@ Returns modified AST."
|
||||
(let* ((new-id (emacs-edit-generate-id))
|
||||
(new-props (list :ID new-id
|
||||
:TITLE title
|
||||
:TODO (or todo "TODO")
|
||||
:TODO (or todo "TODO
|
||||
:CREATED (format nil "[~a]"
|
||||
(multiple-value-bind (s mi h d mo y)
|
||||
(decode-universal-time (get-universal-time))
|
||||
@@ -327,18 +327,18 @@ Exposes operations to the Probabilistic Engine.
|
||||
(def-cognitive-tool :org-read
|
||||
"Reads an org-mode file and parses it to structured AST.
|
||||
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)
|
||||
(let ((file (getf args :file)))
|
||||
(if (uiop:file-exists-p file)
|
||||
(emacs-edit-modify file :read)
|
||||
(list :status :error :reason "File not found")))))
|
||||
(list :status :error :reason "File not found))))
|
||||
|
||||
(def-cognitive-tool :org-write
|
||||
"Writes previously parsed AST back to an org file.
|
||||
Use this AFTER modifications to save changes."
|
||||
((:file :type :string :description "Path to the org file")
|
||||
(:ast :type :list :description "The AST to write"))
|
||||
((:file :type :string :description "Path to the org file
|
||||
(:ast :type :list :description "The AST to write)
|
||||
:body (lambda (args)
|
||||
(let ((file (getf args :file))
|
||||
(ast (getf args :ast)))
|
||||
@@ -347,14 +347,14 @@ Use this AFTER modifications to save changes."
|
||||
|
||||
(def-cognitive-tool :org-add-headline
|
||||
"Adds a new headline to an org file."
|
||||
((:file :type :string :description "Path to the org file")
|
||||
(:title :type :string :description "Headline title")
|
||||
(:todo :type :string :description "TODO state (default TODO)")
|
||||
(:properties :type :list :description "Plist of properties"))
|
||||
((:file :type :string :description "Path to the org file
|
||||
(:title :type :string :description "Headline title
|
||||
(:todo :type :string :description "TODO state (default TODO)
|
||||
(:properties :type :list :description "Plist of properties)
|
||||
:body (lambda (args)
|
||||
(let ((file (getf args :file))
|
||||
(title (getf args :title))
|
||||
(todo (getf args :todo "TODO"))
|
||||
(todo (getf args :todo "TODO)
|
||||
(properties (getf args :properties)))
|
||||
(emacs-edit-modify file :add-headline
|
||||
: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
|
||||
"Sets a property on an existing headline (by ID or title)."
|
||||
((:file :type :string :description "Path to the org file")
|
||||
(:target :type :string :description "Headline ID or title")
|
||||
(:property :type :string :description "Property name")
|
||||
(:value :type :string :description "Property value"))
|
||||
((:file :type :string :description "Path to the org file
|
||||
(:target :type :string :description "Headline ID or title
|
||||
(:property :type :string :description "Property name
|
||||
(:value :type :string :description "Property value)
|
||||
:body (lambda (args)
|
||||
(let ((file (getf args :file))
|
||||
(target (getf args :target))
|
||||
@@ -377,9 +377,9 @@ Use this AFTER modifications to save changes."
|
||||
|
||||
(def-cognitive-tool :org-set-todo
|
||||
"Sets the TODO state of a headline."
|
||||
((:file :type :string :description "Path to the org file")
|
||||
(:target :type :string :description "Headline ID or title")
|
||||
(:state :type :string :description "New TODO state (TODO, DONE, etc)"))
|
||||
((:file :type :string :description "Path to the org file
|
||||
(:target :type :string :description "Headline ID or title
|
||||
(:state :type :string :description "New TODO state (TODO, DONE, etc))
|
||||
:body (lambda (args)
|
||||
(let ((file (getf args :file))
|
||||
(target (getf args :target))
|
||||
@@ -390,7 +390,7 @@ Use this AFTER modifications to save changes."
|
||||
#+end_src
|
||||
|
||||
* 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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:emacs-edit-suite))
|
||||
@@ -398,7 +398,7 @@ Use this AFTER modifications to save changes."
|
||||
(in-package :opencortex-emacs-edit-tests)
|
||||
|
||||
(def-suite emacs-edit-suite
|
||||
:description "Tests for Emacs Edit skill.")
|
||||
:description "Tests for Emacs Edit skill.
|
||||
|
||||
(in-suite emacs-edit-suite)
|
||||
|
||||
@@ -409,22 +409,22 @@ Use this AFTER modifications to save changes."
|
||||
(is (not (string= id1 id2))))) ;; Likely unique
|
||||
|
||||
(test id-format
|
||||
(let ((formatted (emacs-edit-id-format "abc12345")))
|
||||
(let ((formatted (emacs-edit-id-format "abc12345))
|
||||
(is (search "id:" formatted))))
|
||||
|
||||
(test property-setter
|
||||
(let ((ast (list :type :headline
|
||||
:properties (list :ID "id:test123" :TITLE "Test")
|
||||
:properties (list :ID "id:test123" :TITLE "Test
|
||||
:contents nil)))
|
||||
(emacs-edit-set-property ast "id:test123" :STATUS "ACTIVE")
|
||||
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
|
||||
(emacs-edit-set-property ast "id:test123" :STATUS "ACTIVE
|
||||
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE)))
|
||||
|
||||
(test todo-setter
|
||||
(let ((ast (list :type :headline
|
||||
:properties (list :ID "id:todo001" :TITLE "Task")
|
||||
:properties (list :ID "id:todo001" :TITLE "Task
|
||||
:contents nil)))
|
||||
(emacs-edit-set-todo ast "id:todo001" "DONE")
|
||||
(is (string= (getf (getf ast :properties) :TODO) "DONE"))))
|
||||
(emacs-edit-set-todo ast "id:todo001" "DONE
|
||||
(is (string= (getf (getf ast :properties) :TODO) "DONE)))
|
||||
#+end_src
|
||||
|
||||
* See Also
|
||||
|
||||
@@ -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:
|
||||
:ID: 37f2b59f-4537-4cca-ac7f-5c24b9e2e773
|
||||
: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
|
||||
|
||||
** 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)
|
||||
#+end_src
|
||||
|
||||
** 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
|
||||
"Path to the project root for enforcement checks.")
|
||||
"Path to the project root for enforcement checks.
|
||||
#+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
|
||||
(phase nil)
|
||||
(rule nil)
|
||||
@@ -76,7 +76,7 @@ Every significant fix or architectural decision MUST be documented in an org fil
|
||||
#+end_src
|
||||
|
||||
** 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)
|
||||
"Tier 1 Chaos: Verifies that a Lisp file is syntactically balanced."
|
||||
(handler-case
|
||||
@@ -90,56 +90,56 @@ Every significant fix or architectural decision MUST be documented in an org fil
|
||||
#+end_src
|
||||
|
||||
** 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*))
|
||||
"Returns T if the git repository at DIR has no uncommitted changes."
|
||||
(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
|
||||
:ignore-error-status t)))
|
||||
(string= "" (string-trim '(#\Space #\Newline #\Tab) status)))))
|
||||
#+end_src
|
||||
|
||||
** 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 ()
|
||||
"Initialize the enforcement system."
|
||||
(let ((env-root (or (getenv "OC_DATA_DIR")
|
||||
"/home/user/.local/share/opencortex")))
|
||||
(let ((env-root (or (getenv "OC_DATA_DIR
|
||||
"/home/user/.local/share/opencortex))
|
||||
(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
|
||||
|
||||
;; 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)
|
||||
#+end_src
|
||||
|
||||
* 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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:engineering-standards-suite))
|
||||
#+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)
|
||||
#+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
|
||||
:description "Tests for Engineering Standards enforcement")
|
||||
:description "Tests for Engineering Standards enforcement
|
||||
#+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)
|
||||
#+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
|
||||
"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:run-program (list "git" "init" tmp-dir) :output nil)
|
||||
(is (eq t (opencortex::verify-git-clean-p (uiop:ensure-directory-pathname tmp-dir))))
|
||||
|
||||
@@ -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:
|
||||
:ID: gardener-skill
|
||||
: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
|
||||
(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
|
||||
|
||||
** 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))
|
||||
;; 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
|
||||
|
||||
** Skill Registration
|
||||
|
||||
@@ -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)
|
||||
|
||||
** 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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:gateway-suite))
|
||||
#+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)
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/gateway-manager-tests.lisp" (expand-file-name ""))
|
||||
(def-suite gateway-suite :description "Verification of the Gateway Manager skill")
|
||||
#+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
|
||||
#+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)
|
||||
#+end_src
|
||||
|
||||
** 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
|
||||
"Verify that the skill can register a new gateway metadata block."
|
||||
(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
|
||||
"Verify that multiple gateways can be registered simultaneously."
|
||||
(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))
|
||||
(is (eq (getf (getf opencortex::*gateways* :telegram) :status) :verified))
|
||||
(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)
|
||||
|
||||
** 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)
|
||||
#+end_src
|
||||
|
||||
** 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*
|
||||
'(:name "gateway-manager"
|
||||
:description "Manages connections to external chat platforms."
|
||||
:capabilities (:link-gateway :list-gateways)
|
||||
:type :deterministic)
|
||||
"Skill metadata for the Gateway Manager.")
|
||||
"Skill metadata for the Gateway Manager.
|
||||
#+end_src
|
||||
|
||||
** Registry Persistence
|
||||
#+begin_src lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-gateway-manager.lisp" (expand-file-name ""))
|
||||
(defvar *gateways* nil "The internal registry of configured gateways.")
|
||||
#+begin_src lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-gateway-manager.lisp")" )
|
||||
(defvar *gateways* nil "The internal registry of configured gateways.
|
||||
#+end_src
|
||||
|
||||
** 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 ()
|
||||
"Persist gateway metadata to XDG Config directory."
|
||||
(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
|
||||
|
||||
** 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)
|
||||
"Internal function to update the gateway registry."
|
||||
(setf (getf *gateways* platform) metadata))
|
||||
#+end_src
|
||||
|
||||
** 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)
|
||||
"Verifies a Telegram bot token via the getMe API."
|
||||
(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))
|
||||
(let ((result (cdr (assoc :result data))))
|
||||
(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))))))
|
||||
#+end_src
|
||||
|
||||
** 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)
|
||||
"Primary capability to link a new platform. Returns status plist."
|
||||
(harness-log "GATEWAY: Attempting to link ~a..." platform)
|
||||
(let ((verification (cond
|
||||
((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)
|
||||
(progn
|
||||
(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
|
||||
|
||||
** 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)
|
||||
"Main entry point for CLI-driven linkage."
|
||||
(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)
|
||||
(uiop:quit 0))
|
||||
(progn
|
||||
(format t "Usage: opencortex link <PLATFORM> <TOKEN>~%")
|
||||
(format t "Usage: opencortex link <PLATFORM> <TOKEN>~%
|
||||
(uiop:quit 1))))
|
||||
#+end_src
|
||||
|
||||
@@ -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:
|
||||
:ID: homoiconic-memory-skill
|
||||
: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)
|
||||
"Converts Org-mode source to JSON AST."
|
||||
(declare (ignore source))
|
||||
"")
|
||||
"
|
||||
|
||||
(defun memory-json-to-org (ast)
|
||||
"Converts JSON AST back to Org-mode text."
|
||||
(declare (ignore ast))
|
||||
"")
|
||||
"
|
||||
|
||||
(defun memory-normalize-ast (ast)
|
||||
"Recursively ensures ID uniqueness across the AST."
|
||||
|
||||
@@ -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:
|
||||
:ID: lisp-utils-skill
|
||||
: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))
|
||||
((char= ch #\\) (setf escaped t))
|
||||
(in-string
|
||||
(when (char= ch #\") (setf in-string nil)))
|
||||
(when (char= ch #\ (setf in-string nil)))
|
||||
((char= ch #\;)
|
||||
(loop while (and (< i (1- (length code-string)))
|
||||
(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)
|
||||
(incf line)
|
||||
(setf col 0))
|
||||
((char= ch #\")
|
||||
((char= ch #\
|
||||
(setf in-string t))
|
||||
((char= ch #\()
|
||||
(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))
|
||||
(loop for form = (read stream nil :eof) until (eq form :eof)
|
||||
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))
|
||||
(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
|
||||
"Deterministically validates Lisp code for structural, syntactic, and semantic correctness."
|
||||
((:code :type :string :description "The Lisp code string to validate.")
|
||||
(:strict :type :boolean :description "If non-nil, enforces the semantic whitelist."))
|
||||
((:code :type :string :description "The Lisp code string to validate.
|
||||
(:strict :type :boolean :description "If non-nil, enforces the semantic whitelist.)
|
||||
:body (lambda (args)
|
||||
(let ((code (getf args :code))
|
||||
(strict (getf args :strict)))
|
||||
(if (and code (stringp code))
|
||||
(lisp-utils-validate code :strict strict)
|
||||
(list :status :error :reason "Missing :code argument.")))))
|
||||
(list :status :error :reason "Missing :code argument.))))
|
||||
#+end_src
|
||||
|
||||
* 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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(: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)
|
||||
|
||||
(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)
|
||||
|
||||
(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
|
||||
(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 (search "Unbalanced" reason))))
|
||||
|
||||
(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 (search "Unexpected" reason))))
|
||||
|
||||
(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
|
||||
(is (eq t (opencortex:lisp-utils-check-semantic "(+ 1 2)"))))
|
||||
(is (eq t (opencortex:lisp-utils-check-semantic "(+ 1 2))))
|
||||
|
||||
(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 (search "Unsafe" reason))))
|
||||
|
||||
|
||||
@@ -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:
|
||||
:ID: literate-programming-skill-2026
|
||||
:CREATED: [2026-04-25 Sat]
|
||||
@@ -74,8 +74,8 @@ Code without surrounding prose is a bug report waiting to happen.
|
||||
(escaped (setf escaped nil))
|
||||
((char= ch #\\) (setf escaped t))
|
||||
;; String boundaries
|
||||
(in-string (when (char= ch #\") (setf in-string nil)))
|
||||
((char= ch #\") (setf in-string t))
|
||||
(in-string (when (char= ch #\ (setf in-string nil)))
|
||||
((char= ch #\ (setf in-string t))
|
||||
;; Comment boundaries (skip to end of line)
|
||||
((char= ch #\;)
|
||||
(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)))
|
||||
(let ((trimmed (string-trim '(#\Space #\Tab #\Return) line)))
|
||||
(when (and (plusp (length trimmed))
|
||||
(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 12 (length trimmed))) ":PROPERTIES:)
|
||||
(not (string= (subseq trimmed 0 (min 5 (length trimmed))) ":END:))
|
||||
(push line clean-lines))))
|
||||
(let ((code (format nil "~{~a~^~%~}" (nreverse clean-lines))))
|
||||
(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
|
||||
(defvar *tangle-targets*
|
||||
'(("skills/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")
|
||||
("harness/memory.org" . "library/memory.lisp")
|
||||
("harness/loop.org" . "library/loop.lisp")
|
||||
("harness/perceive.org" . "library/perceive.lisp")
|
||||
("harness/reason.org" . "library/reason.lisp")
|
||||
("harness/act.org" . "library/act.lisp")
|
||||
("harness/skills.org" . "library/skills.lisp")
|
||||
("harness/communication.org" . "library/communication.lisp")))
|
||||
'(("org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp
|
||||
("org-skill-literate-programming.org" . "library/gen/org-skill-literate-programming.lisp
|
||||
("harness/memory.org" . "library/memory.lisp
|
||||
("harness/loop.org" . "library/loop.lisp
|
||||
("harness/perceive.org" . "library/perceive.lisp
|
||||
("harness/reason.org" . "library/reason.lisp
|
||||
("harness/act.org" . "library/act.lisp
|
||||
("harness/skills.org" . "library/skills.lisp
|
||||
("harness/communication.org" . "library/communication.lisp))
|
||||
|
||||
(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 ()
|
||||
"Initialize the LP system with project root."
|
||||
(unless *lp-initialized*
|
||||
(let ((env-root (or (getenv "OPENCORTEX_ROOT")
|
||||
(getenv "MEMEX_DIR")
|
||||
"/home/user/memex/projects/opencortex")))
|
||||
(let ((env-root (or (getenv "OPENCORTEX_ROOT
|
||||
(getenv "MEMEX_DIR
|
||||
"/home/user/memex/projects/opencortex))
|
||||
(lp-set-project-root env-root)
|
||||
(setf *lp-initialized* t)
|
||||
(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:
|
||||
~(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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:literate-programming-suite))
|
||||
@@ -249,14 +249,14 @@ These tests verify the LP enforcement logic. Run with:
|
||||
(in-package :opencortex-literate-programming-tests)
|
||||
|
||||
(def-suite literate-programming-suite
|
||||
:description "Tests for Literate Programming enforcement")
|
||||
:description "Tests for Literate Programming enforcement
|
||||
|
||||
(in-suite literate-programming-suite)
|
||||
|
||||
(test tangle-sync-detects-stale-lisp
|
||||
"check-tangle-sync returns violation when .lisp is newer than .org"
|
||||
(let* ((root (uiop:ensure-directory-pathname "/tmp/lp-test/"))
|
||||
(tmp-org (merge-pathnames "skills/test-skill.org" root))
|
||||
(let* ((root (uiop:ensure-directory-pathname "/tmp/lp-test/)
|
||||
(tmp-org (merge-pathnames "test-skill.org" 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)))
|
||||
(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))
|
||||
(let ((orig-targets 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
|
||||
(let ((result (opencortex::check-tangle-sync root)))
|
||||
(is (listp result))
|
||||
@@ -276,8 +276,8 @@ These tests verify the LP enforcement logic. Run with:
|
||||
|
||||
(test tangle-sync-passes-when-synced
|
||||
"check-tangle-sync returns nil when .org is newer than .lisp"
|
||||
(let* ((root (uiop:ensure-directory-pathname "/tmp/lp-test2/"))
|
||||
(tmp-org (merge-pathnames "skills/test-skill2.org" root))
|
||||
(let* ((root (uiop:ensure-directory-pathname "/tmp/lp-test2/)
|
||||
(tmp-org (merge-pathnames "test-skill2.org" 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)))
|
||||
(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))
|
||||
(let ((orig-targets 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
|
||||
(let ((result (opencortex::check-tangle-sync root)))
|
||||
(is (null result)))
|
||||
@@ -295,12 +295,12 @@ These tests verify the LP enforcement logic. Run with:
|
||||
|
||||
(test tangle-sync-passes-when-synced
|
||||
"check-tangle-sync returns nil when .org is newer than .lisp"
|
||||
(let ((tmp-org "/tmp/test-skill2.org")
|
||||
(tmp-lisp "/tmp/test-skill2.lisp"))
|
||||
(let ((tmp-org "/tmp/test-skill2.org
|
||||
(tmp-lisp "/tmp/test-skill2.lisp)
|
||||
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
|
||||
(sleep 1)
|
||||
(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)))
|
||||
(is (null result)))
|
||||
(uiop:delete-file-if-exists tmp-org)
|
||||
@@ -308,11 +308,11 @@ These tests verify the LP enforcement logic. Run with:
|
||||
|
||||
(test block-balance-valid
|
||||
"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
|
||||
"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 (stringp reason))))
|
||||
#+end_src
|
||||
|
||||
@@ -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:
|
||||
:ID: llama-backend-skill
|
||||
: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`.
|
||||
|
||||
** 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`
|
||||
- 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)
|
||||
#+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."
|
||||
(let ((endpoint (getenv "LLAMACPP_ENDPOINT")))
|
||||
(let ((endpoint (getenv "LLAMACPP_ENDPOINT))
|
||||
(unless endpoint
|
||||
(harness-log "LLAMA ERROR: LLAMACPP_ENDPOINT not set in environment.")
|
||||
(return-from llama-inference (list :error "LLAMACPP_ENDPOINT_MISSING")))
|
||||
(harness-log "LLAMA ERROR: LLAMACPP_ENDPOINT not set in environment.
|
||||
(return-from llama-inference (list :error "LLAMACPP_ENDPOINT_MISSING))
|
||||
|
||||
(handler-case
|
||||
(let* ((full-prompt (format nil "System: ~a~%User: ~a~%Assistant:" system-prompt prompt))
|
||||
(payload (cl-json:encode-json-to-string
|
||||
`((:prompt . ,full-prompt)
|
||||
(:n_predict . 1024)
|
||||
(:stop . ("User:" "System:")))))
|
||||
(:stop . ("User:" "System:))))
|
||||
(response (dex:post (format nil "~a/completion" endpoint)
|
||||
:content payload
|
||||
:headers '(("Content-Type" . "application/json"))))
|
||||
:headers '(("Content-Type" . "application/json)))
|
||||
(data (cl-json:decode-json-from-string response)))
|
||||
(cdr (assoc :content data)))
|
||||
(error (c)
|
||||
@@ -55,7 +55,7 @@ This skill acts as a proxy between the OpenCortex kernel and the Lisp-agnostic `
|
||||
#+begin_src lisp
|
||||
(progn
|
||||
(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
|
||||
:priority 50
|
||||
|
||||
@@ -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:
|
||||
:ID: llm-gateway-spec
|
||||
: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.
|
||||
|
||||
* 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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:llm-gateway-suite))
|
||||
|
||||
(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)
|
||||
|
||||
(test test-llm-gateway-timeout
|
||||
"Tier 2 Chaos: Verify that LLM Gateway handles connection failures gracefully."
|
||||
;; 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
|
||||
(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)
|
||||
(find-symbol "EXECUTE-LLM-REQUEST" :opencortex))))
|
||||
(if fn
|
||||
(let ((result (funcall fn :prompt "hello" :provider :ollama)))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (uiop:string-prefix-p "Ollama Failure" (getf result :message))))
|
||||
(fail "Could not find EXECUTE-LLM-REQUEST symbol"))))
|
||||
(setf (getenv "OLLAMA_HOST") old-host))))
|
||||
(fail "Could not find EXECUTE-LLM-REQUEST symbol)))
|
||||
(setf (getenv "OLLAMA_HOST old-host))))
|
||||
#+end_src
|
||||
|
||||
* Implementation
|
||||
|
||||
** 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)
|
||||
#+end_src
|
||||
|
||||
** 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*
|
||||
'(:name "llm-gateway"
|
||||
:description "Unified provider-agnostic LLM interface."
|
||||
:capabilities (:ask-llm :get-embedding)
|
||||
:type :probabilistic)
|
||||
"Skill metadata for the LLM Gateway.")
|
||||
"Skill metadata for the LLM Gateway.
|
||||
#+end_src
|
||||
|
||||
** 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)
|
||||
"Generic executor for all LLM providers."
|
||||
(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)))
|
||||
(case active-provider
|
||||
(: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))
|
||||
(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
|
||||
(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)))
|
||||
(list :status :success :content (cdr (assoc :response json))))
|
||||
(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
|
||||
|
||||
** 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
|
||||
"Generates vector embeddings via Ollama API."
|
||||
((:text :type :string :description "Text to embed."))
|
||||
((:text :type :string :description "Text to embed.)
|
||||
:body (lambda (args)
|
||||
(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))
|
||||
(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
|
||||
(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)))
|
||||
(cdr (assoc :embedding json)))
|
||||
(error (c) (harness-log "OLLAMA EMBED ERROR: ~a" c) nil))))))
|
||||
#+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
|
||||
"Unified interface for interacting with LLM providers."
|
||||
((:prompt :type :string :description "The user prompt")
|
||||
(:system-prompt :type :string :description "The system prompt (optional)")
|
||||
(:provider :type :keyword :description "The provider (e.g., :ollama, :openai)")
|
||||
(:model :type :string :description "The model name"))
|
||||
((:prompt :type :string :description "The user prompt
|
||||
(:system-prompt :type :string :description "The system prompt (optional)
|
||||
(:provider :type :keyword :description "The provider (e.g., :ollama, :openai)
|
||||
(:model :type :string :description "The model name)
|
||||
:body (lambda (args)
|
||||
(execute-llm-request :prompt (getf args :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
|
||||
|
||||
** 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
|
||||
:priority 50
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||
|
||||
@@ -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:
|
||||
:ID: org-skill-peripheral-vision
|
||||
: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
|
||||
\n#+begin_src lisp
|
||||
(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)
|
||||
"Assembles the full context block for a neural request.")
|
||||
"Assembles the full context block for a neural request.
|
||||
#+end_src
|
||||
|
||||
* 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."
|
||||
(let* ((id (org-object-id obj))
|
||||
(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))
|
||||
(children (org-object-children obj))
|
||||
(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 render deeper nodes ONLY if they are semantically relevant.
|
||||
(should-render (or (<= depth 2) is-foveal is-semantically-relevant))
|
||||
(output ""))
|
||||
(output
|
||||
|
||||
(when should-render
|
||||
(setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id))
|
||||
(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 ":END:~%")))
|
||||
(setf output (concatenate 'string output (format nil ":END:~%))
|
||||
|
||||
;; Only include full body content if this is the Foveal focus or highly 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))))
|
||||
(projects (context-get-active-projects))
|
||||
(output "GLOBAL MEMEX AWARENESS (Peripheral Vision):
|
||||
"))
|
||||
)
|
||||
(if projects
|
||||
(dolist (project projects)
|
||||
(setf output (concatenate 'string output
|
||||
(context-render-to-org project
|
||||
:foveal-id foveal-id
|
||||
:foveal-vector foveal-vector))))
|
||||
(setf output (concatenate 'string output "No active projects found.~%")))
|
||||
(setf output (concatenate 'string output "No active projects found.~%))
|
||||
output))
|
||||
#+end_src
|
||||
|
||||
@@ -121,7 +121,7 @@ Move context pruning and rendering logic out of `context.lisp` to allow for more
|
||||
#+begin_src lisp
|
||||
(defskill :skill-peripheral-vision
|
||||
:priority 90
|
||||
:dependencies ("org-skill-embedding")
|
||||
:dependencies ("org-skill-embedding
|
||||
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:perceive :context-refresh)))
|
||||
:probabilistic nil
|
||||
:deterministic (lambda (action ctx)
|
||||
|
||||
@@ -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:
|
||||
:ID: 47425a43-2be0-423c-8509-22592cfe9c9e
|
||||
: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
|
||||
|
||||
* 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*
|
||||
'((:transparency . 500)
|
||||
(:autonomy . 400)
|
||||
@@ -64,10 +64,10 @@ Higher numbers take precedence.
|
||||
When two invariants conflict, the higher priority wins.
|
||||
Example: Modularity (250) takes precedence over Mentorship (200),
|
||||
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*
|
||||
'("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.
|
||||
|
||||
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.
|
||||
|
||||
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
|
||||
"Maximum recommended size for a skill file tangled from an Org note.
|
||||
|
||||
This is a soft limit—the check warns but does not block.
|
||||
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*
|
||||
'("harness/" "opencortex.asd")
|
||||
'("harness/" "opencortex.asd
|
||||
"Paths that constitute the unbreakable core of the system.
|
||||
|
||||
Any action targeting these paths must include a :modularity-justification
|
||||
@@ -101,7 +101,7 @@ even if it would be educational.")
|
||||
- Policy and security
|
||||
- LLM integration
|
||||
- Domain-specific functionality
|
||||
- New actuators")
|
||||
- New actuators
|
||||
|
||||
(defvar *mentorship-required-actions*
|
||||
'(:create-skill :eval :modify-file :write-file :replace
|
||||
@@ -109,13 +109,13 @@ even if it would be educational.")
|
||||
"Actions that trigger the Mentorship invariant.
|
||||
|
||||
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)
|
||||
"Backends requiring internet connection and external infrastructure.
|
||||
|
||||
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
|
||||
|
||||
|
||||
@@ -168,7 +168,7 @@ At the gate:
|
||||
(return-from policy-check-transparency
|
||||
(list :type :LOG
|
||||
: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))
|
||||
(target (or (getf action :target) (getf action :TARGET)))
|
||||
@@ -185,7 +185,7 @@ At the gate:
|
||||
(return-from policy-check-transparency
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text "POLICY [Transparency]: User-facing action missing :explanation. Blocked."))))
|
||||
:text "POLICY [Transparency]: User-facing action missing :explanation. Blocked.)))
|
||||
|
||||
action))
|
||||
#+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."
|
||||
|
||||
(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)
|
||||
(getf payload :CMD)
|
||||
(when (equal (getf payload :tool) "shell")
|
||||
(when (equal (getf payload :tool) "shell
|
||||
(getf (getf payload :args) :cmd))
|
||||
""))
|
||||
|
||||
(haystack (concatenate 'string text cmd)))
|
||||
|
||||
(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))))
|
||||
|
||||
(when (or (member act *mentorship-required-actions*)
|
||||
(member tool '("shell" "eval" "repair-file")))
|
||||
(member tool '("shell" "eval" "repair-file))
|
||||
|
||||
(unless note
|
||||
(return-from policy-check-mentorship
|
||||
(list :type :LOG
|
||||
: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))
|
||||
#+end_src
|
||||
|
||||
@@ -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:
|
||||
:ID: org-skill-communication-protocol-validator
|
||||
:CREATED: [2026-04-12 Sun 14:35]
|
||||
@@ -40,7 +40,7 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
|
||||
|
||||
#+begin_src lisp
|
||||
(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
|
||||
|
||||
* Phase D: Build (Implementation)
|
||||
@@ -66,20 +66,20 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
|
||||
(let ((target (proto-get msg :target))
|
||||
(source (proto-get (proto-get msg :meta) :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)
|
||||
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload"))))
|
||||
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload)))
|
||||
|
||||
(:EVENT
|
||||
(let ((payload (proto-get msg :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))
|
||||
(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
|
||||
(unless (proto-get msg :payload)
|
||||
(error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
|
||||
(error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload)))
|
||||
|
||||
t))
|
||||
#+end_src
|
||||
|
||||
@@ -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:
|
||||
:ID: scribe-skill
|
||||
: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
|
||||
- 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)
|
||||
|
||||
@@ -51,7 +51,7 @@ We track the last processed universal time to avoid redundant distillation.
|
||||
|
||||
#+begin_src lisp
|
||||
(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 ()
|
||||
"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))
|
||||
(nodes (scribe-get-distillable-nodes)))
|
||||
(if nodes
|
||||
(let ((text-to-process ""))
|
||||
(let ((text-to-process
|
||||
(dolist (node nodes)
|
||||
(setf text-to-process (concatenate 'string text-to-process
|
||||
(format nil "ID: ~a~%TITLE: ~a~%CONTENT: ~a~%---~%"
|
||||
@@ -111,7 +111,7 @@ Extract ATOMIC EVERGREEN NOTES from this text.
|
||||
|
||||
RULES:
|
||||
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.
|
||||
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))
|
||||
(content (getf note :content))
|
||||
(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)))
|
||||
(if (uiop:file-exists-p path)
|
||||
(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))
|
||||
(scribe-commit-notes data)
|
||||
(scribe-save-state)
|
||||
(harness-log "SCRIBE: Distillation complete.")
|
||||
(harness-log "SCRIBE: Distillation complete.
|
||||
;; 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
|
||||
|
||||
** Skill Registration
|
||||
|
||||
@@ -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:
|
||||
:ID: self-edit-001
|
||||
:END:
|
||||
@@ -53,7 +53,7 @@ Extract file and line info from error context.
|
||||
(defun self-edit-parse-location (context)
|
||||
"Extracts file and line from error context payload."
|
||||
(let* ((payload (getf context :payload))
|
||||
(message (getf payload :message ""))
|
||||
(message (getf payload :message
|
||||
(file (or (getf payload :file)
|
||||
(when (search "file" 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)))
|
||||
(with-open-file (out target-file :direction :output :if-exists :supersede)
|
||||
(write-string new-content out))
|
||||
(harness-log "SELF-EDIT: Edit applied successfully.")
|
||||
(list :status :success :message "Edit applied."))
|
||||
(harness-log "SELF-EDIT: Edit applied successfully.
|
||||
(list :status :success :message "Edit applied.)
|
||||
(progn
|
||||
(harness-log "SELF-EDIT: Pattern not found in file.")
|
||||
(list :status :error :message "Pattern not found in file.")))
|
||||
(harness-log "SELF-EDIT: Pattern not found in file.
|
||||
(list :status :error :message "Pattern not found in file.))
|
||||
(error (c)
|
||||
(harness-log "SELF-EDIT: Edit failed: ~a" c)
|
||||
(rollback-memory 0)
|
||||
@@ -101,9 +101,9 @@ Returns list with :status and :message keys."
|
||||
#+begin_src lisp
|
||||
(def-cognitive-tool :self-edit
|
||||
"Applies a surgical code modification to a file with automatic rollback on failure."
|
||||
((:file :type :string :description "Path to the target file")
|
||||
(:old :type :string :description "The code block to find")
|
||||
(:new :type :string :description "The code block to replace with"))
|
||||
((:file :type :string :description "Path to the target file
|
||||
(:old :type :string :description "The code block to find
|
||||
(:new :type :string :description "The code block to replace with)
|
||||
:body (lambda (args)
|
||||
(let* ((file (getf args :file))
|
||||
(old (getf args :old))
|
||||
@@ -125,9 +125,9 @@ Hooks into syntax-error events for self-repair.
|
||||
(cond
|
||||
((eq sensor :syntax-error)
|
||||
"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)
|
||||
"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))))
|
||||
:deterministic (lambda (action ctx)
|
||||
(let* ((payload (getf ctx :payload))
|
||||
@@ -135,16 +135,16 @@ Provide a fixed version of the code as a lisp form.")
|
||||
(cond
|
||||
((eq sensor :syntax-error)
|
||||
(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)))
|
||||
(handler-case
|
||||
(progn
|
||||
(read-from-string balanced)
|
||||
(harness-log "SELF-EDIT: Fast fix SUCCESS.")
|
||||
(harness-log "SELF-EDIT: Fast fix SUCCESS.
|
||||
(list :status :success :repaired balanced))
|
||||
(error ()
|
||||
(harness-log "SELF-EDIT: Fast fix failed, need neural repair.")
|
||||
(list :status :error :reason "needs-llm"))))))
|
||||
(harness-log "SELF-EDIT: Fast fix failed, need neural repair.
|
||||
(list :status :error :reason "needs-llm)))))
|
||||
((eq sensor :repair-request)
|
||||
(let ((file (getf payload :file))
|
||||
(old (getf payload :old))
|
||||
@@ -157,7 +157,7 @@ Provide a fixed version of the code as a lisp form.")
|
||||
#+begin_src lisp
|
||||
(def-cognitive-tool :balance-parens
|
||||
"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)
|
||||
(let* ((code (getf args :code))
|
||||
(balanced (self-edit-balance-parens code)))
|
||||
@@ -174,7 +174,7 @@ Swap compiled skill files without breaking active sockets.
|
||||
|
||||
#+begin_src lisp
|
||||
(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)
|
||||
"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)."
|
||||
(unless *skills-registry*
|
||||
(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)
|
||||
(return-from self-edit-hot-reload-skill
|
||||
(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
|
||||
(let ((compiled (compile-file gen-path)))
|
||||
(unless compiled
|
||||
(error "Compilation returned nil")))
|
||||
(error "Compilation returned nil))
|
||||
;; Step 3: Load the compiled skill
|
||||
(load gen-path)
|
||||
;; 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"
|
||||
skill-name gen-path)
|
||||
(values :success t))
|
||||
(error "Skill not registered after reload"))))
|
||||
(error "Skill not registered after reload)))
|
||||
(error (e)
|
||||
;; Step 5: Rollback
|
||||
(when *self-edit-skills-backup*
|
||||
@@ -228,8 +228,8 @@ Swap compiled skill files without breaking active sockets.
|
||||
#+begin_src lisp
|
||||
(def-cognitive-tool :reload-skill
|
||||
"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)")
|
||||
(:gen-path :type :string :description "Absolute path to the compiled .lisp file"))
|
||||
((: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)
|
||||
:body (lambda (args)
|
||||
(let ((name (getf args :skill-name))
|
||||
(path (getf args :gen-path)))
|
||||
@@ -239,7 +239,7 @@ Swap compiled skill files without breaking active sockets.
|
||||
|
||||
* 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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:self-edit-suite))
|
||||
@@ -247,42 +247,42 @@ Swap compiled skill files without breaking active sockets.
|
||||
(in-package :opencortex-self-edit-tests)
|
||||
|
||||
(def-suite self-edit-suite
|
||||
:description "Tests for Self-Edit skill.")
|
||||
:description "Tests for Self-Edit skill.
|
||||
|
||||
(in-suite self-edit-suite)
|
||||
|
||||
(test balance-parens-balanced
|
||||
(let ((result (opencortex::self-edit-balance-parens "(+ 1 2)")))
|
||||
(is (string= result "(+ 1 2)"))
|
||||
(let ((result (opencortex::self-edit-balance-parens "(+ 1 2)))
|
||||
(is (string= result "(+ 1 2))
|
||||
(is (not (null (read-from-string result))))))
|
||||
|
||||
(test balance-parens-missing-open
|
||||
(let ((result (opencortex::self-edit-balance-parens "+ 1 2)")))
|
||||
(is (string= result "(+ 1 2)"))
|
||||
(let ((result (opencortex::self-edit-balance-parens "+ 1 2)))
|
||||
(is (string= result "(+ 1 2))
|
||||
(is (not (null (read-from-string result))))))
|
||||
|
||||
(test balance-parens-missing-close
|
||||
(let ((result (opencortex::self-edit-balance-parens "(+ 1 2")))
|
||||
(is (string= result "(+ 1 2)"))
|
||||
(let ((result (opencortex::self-edit-balance-parens "(+ 1 2))
|
||||
(is (string= result "(+ 1 2))
|
||||
(is (not (null (read-from-string result))))))
|
||||
|
||||
(test balance-parens-deep
|
||||
(let ((result (opencortex::self-edit-balance-parens "((lambda (x) (if x (+ 1 2) 3))")))
|
||||
(is (string= result "((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 (not (null (read-from-string result))))))
|
||||
|
||||
(test balance-parens-empty
|
||||
(let ((result (opencortex::self-edit-balance-parens "")))
|
||||
(is (string= result ""))))
|
||||
(let ((result (opencortex::self-edit-balance-parens )
|
||||
(is (string= result ))
|
||||
|
||||
(test test-self-edit-apply-success
|
||||
"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
|
||||
(progn
|
||||
(with-open-file (out test-file :direction :output :if-exists :supersede)
|
||||
(write-string "(defun hello () (format t \"world~%\"))" out))
|
||||
(let ((result (opencortex::self-edit-apply test-file "world" "universe")))
|
||||
(write-string "(defun hello () (format t \"world~%\)" out))
|
||||
(let ((result (opencortex::self-edit-apply test-file "world" "universe))
|
||||
(is (eq (getf result :status) :success))
|
||||
(let ((content (uiop:read-file-string test-file)))
|
||||
(is (search "universe" content))
|
||||
@@ -291,32 +291,32 @@ Swap compiled skill files without breaking active sockets.
|
||||
|
||||
(test test-self-edit-apply-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
|
||||
(progn
|
||||
(with-open-file (out test-file :direction :output :if-exists :supersede)
|
||||
(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 (search "not found" (getf result :message)))))
|
||||
(uiop:delete-file-if-exists test-file))))
|
||||
|
||||
(test test-self-edit-apply-file-not-found
|
||||
"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 (search "not found" (getf result :message)))))
|
||||
|
||||
(test test-self-edit-parse-location-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)))
|
||||
(is (equal "/tmp/test.lisp" (getf result :file)))
|
||||
(is (eq 42 (getf result :line))))))
|
||||
|
||||
(test test-self-edit-parse-location-from-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)))
|
||||
(is (listp result))
|
||||
(is (getf result :line))
|
||||
|
||||
@@ -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:
|
||||
:ID: 65891ce2-a465-49e6-a0c1-be13d3288d55
|
||||
: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))
|
||||
(new-code (getf payload :new))
|
||||
(is-skill (and (stringp (namestring target-file))
|
||||
(search "skills/" (namestring target-file)))))
|
||||
(search "" (namestring target-file)))))
|
||||
|
||||
(opencortex:snapshot-memory)
|
||||
(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)
|
||||
(if (opencortex:load-skill-from-org target-file)
|
||||
(progn
|
||||
(opencortex:harness-log "SELF-FIX SUCCESS - Applied and reloaded.")
|
||||
(opencortex:harness-log "SELF-FIX SUCCESS - Applied and reloaded.
|
||||
t)
|
||||
(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)
|
||||
(write-string content out))
|
||||
(opencortex:rollback-memory 0)
|
||||
nil)))
|
||||
(progn
|
||||
(opencortex:harness-log "SELF-FIX SUCCESS - Applied fix to file.")
|
||||
(opencortex:harness-log "SELF-FIX SUCCESS - Applied fix to file.
|
||||
t)))
|
||||
(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 - Pattern not found. nil)))
|
||||
(progn (opencortex:harness-log "SELF-FIX FAILURE - File not found. nil))
|
||||
(error (c)
|
||||
(opencortex:harness-log "SELF-FIX CRASH - ~a. Rolling back." c)
|
||||
(opencortex:rollback-memory 0)
|
||||
@@ -70,13 +70,13 @@ This skill enables self-editing by applying surgical fixes to files (including s
|
||||
#+begin_src lisp
|
||||
(def-cognitive-tool :repair-file
|
||||
"Applies a surgical code modification to a file and reloads the skill if applicable."
|
||||
((:file :type :string :description "Path to the target file")
|
||||
(:old :type :string :description "The literal code block to find")
|
||||
(:new :type :string :description "The literal code block to replace it with"))
|
||||
((:file :type :string :description "Path to the target file
|
||||
(:old :type :string :description "The literal code block to find
|
||||
(:new :type :string :description "The literal code block to replace it with)
|
||||
:body (lambda (args)
|
||||
(if (self-fix-apply (list :payload args) nil)
|
||||
"REPAIR SUCCESSFUL."
|
||||
"REPAIR FAILED.")))
|
||||
"REPAIR FAILED.))
|
||||
#+end_src
|
||||
|
||||
** 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))
|
||||
:probabilistic (lambda (context)
|
||||
(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)
|
||||
(let ((payload (getf action :payload)))
|
||||
(self-fix-apply action context))))
|
||||
|
||||
@@ -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:
|
||||
:ID: shell-actuator-skill
|
||||
:CREATED: [2026-04-12 Sun]
|
||||
@@ -12,10 +12,10 @@ The *Shell Actuator* provides a controlled interface for the OpenCortex to execu
|
||||
|
||||
* 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)
|
||||
|
||||
(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* '(#\; #\& #\| #\> #\< #\$ #\` #\\ #\!))
|
||||
|
||||
@@ -43,7 +43,7 @@ The *Shell Actuator* provides a controlled interface for the OpenCortex to execu
|
||||
(multiple-value-bind (stdout stderr exit-code)
|
||||
(uiop:run-program cmd-string :output :string :error-output :string :ignore-error-status t)
|
||||
(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)))))))
|
||||
|
||||
(defun trigger-skill-shell-actuator (context)
|
||||
|
||||
@@ -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:
|
||||
:ID: tool-permissions-skill-001
|
||||
:CREATED: [2026-04-23 Thu]
|
||||
@@ -32,7 +32,7 @@ Tool permissions and embedding generation via multiple providers.
|
||||
(in-package :opencortex)
|
||||
|
||||
(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)
|
||||
(let ((key (string-downcase (string tool-name))))
|
||||
@@ -53,29 +53,29 @@ Tool permissions and embedding generation via multiple providers.
|
||||
|
||||
(def-cognitive-tool :get-embedding
|
||||
"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)
|
||||
(let* ((text (getf args :text))
|
||||
(provider (or (getenv "EMBEDDING_PROVIDER") "ollama"))
|
||||
(model (or (getenv "EMBEDDING_MODEL") "nomic-embed-text"))
|
||||
(provider (or (getenv "EMBEDDING_PROVIDER "ollama)
|
||||
(model (or (getenv "EMBEDDING_MODEL "nomic-embed-text)
|
||||
(embedding nil))
|
||||
(cond
|
||||
((string= provider "ollama")
|
||||
(let* ((host (or (getenv "OLLAMA_HOST") "localhost:11434"))
|
||||
((string= provider "ollama
|
||||
(let* ((host (or (getenv "OLLAMA_HOST "localhost:11434)
|
||||
(url (format nil "http://~a/api/embeddings" host))
|
||||
(body (cl-json:encode-json-to-string `((model . ,model) (prompt . ,text)))))
|
||||
(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))
|
||||
(vec (cdr (assoc :embedding json))))
|
||||
(when vec (setf embedding vec)))
|
||||
(error (c) (harness-log "EMBEDDING: Ollama failed: ~a" c)))))
|
||||
((string= provider "llama.cpp")
|
||||
(let* ((host (or (getenv "LLAMA_HOST") "localhost:8080"))
|
||||
((string= provider "llama.cpp
|
||||
(let* ((host (or (getenv "LLAMA_HOST "localhost:8080)
|
||||
(url (format nil "http://~a/v1/embeddings" host))
|
||||
(body (cl-json:encode-json-to-string `((model . ,model) (input . ,text)))))
|
||||
(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))
|
||||
(data (cdr (assoc :data json)))
|
||||
(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))))))
|
||||
(if 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
|
||||
"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)
|
||||
(:tier :type :keyword :description "For :set: :allow/:deny/:ask"))
|
||||
(:tier :type :keyword :description "For :set: :allow/:deny/:ask)
|
||||
:body (lambda (args)
|
||||
(let ((tool (getf args :tool))
|
||||
(action (getf args :action :get))
|
||||
@@ -101,14 +101,14 @@ Tool permissions and embedding generation via multiple providers.
|
||||
(:list (let ((r nil))
|
||||
(maphash (lambda (k v) (push (list :tool k :permission v) r)) *tool-permissions*)
|
||||
(list :status :success :tools r)))
|
||||
(t (list :status :error :message "Invalid action"))))))
|
||||
(t (list :status :error :message "Invalid action)))))
|
||||
|
||||
;; Defaults
|
||||
(set-tool-permission :shell :deny)
|
||||
(set-tool-permission :delete-file :deny)
|
||||
(set-tool-permission :eval :ask)
|
||||
(set-tool-permission :write-file :ask)
|
||||
(harness-log "TOOL PERMISSIONS: Initialized")
|
||||
(harness-log "TOOL PERMISSIONS: Initialized
|
||||
|
||||
(defskill :skill-tool-permissions
|
||||
:priority 600
|
||||
@@ -135,7 +135,7 @@ Tool permissions and embedding generation via multiple providers.
|
||||
These tests verify tool permissions. Run with:
|
||||
~(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
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:tool-permissions-suite))
|
||||
@@ -143,18 +143,18 @@ These tests verify tool permissions. Run with:
|
||||
(in-package :opencortex-tool-permissions-tests)
|
||||
|
||||
(def-suite tool-permissions-suite
|
||||
:description "Tests for Tool Permissions skill")
|
||||
:description "Tests for Tool Permissions skill
|
||||
|
||||
(in-suite tool-permissions-suite)
|
||||
|
||||
(test 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
|
||||
"Verify setting and getting permissions."
|
||||
(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
|
||||
"Verify :allow tier passes through."
|
||||
|
||||
Reference in New Issue
Block a user