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

This commit is contained in:
2026-04-28 18:22:49 -04:00
parent a2d6c5ae38
commit 357efbdb59
35 changed files with 641 additions and 641 deletions

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "harness/act.lisp" (expand-file-name "harness/"))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/act.lisp")" )
#+TITLE: Stage 3: Act (act.lisp)
#+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)))

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle communication.lisp
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/communication.lisp")
#+TITLE: Communication Protocol (communication.lisp)
#+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)

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "harness/context.lisp" (expand-file-name "harness/"))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/context.lisp")" )
#+TITLE: Peripheral Vision (context.lisp)
#+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))))

View File

@@ -23,65 +23,65 @@ Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that mi
* Phase B: Protocol (Success Criteria)
** 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)

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "harness/loop.lisp" (expand-file-name "harness/"))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/loop.lisp")" )
#+TITLE: The Metabolic Loop (loop.lisp)
#+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))))))

View File

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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle memory.lisp
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/memory.lisp")
#+TITLE: The System Memory (memory.lisp)
#+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)

View File

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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "harness/perceive.lisp" (expand-file-name "harness/"))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/perceive.lisp")" )
#+TITLE: Stage 1: Perceive (perceive.lisp)
#+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*))))))

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (expand-file-name "harness/reason.lisp" (expand-file-name "harness/"))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/harness/reason.lisp")" )
#+TITLE: Stage 2: Reason (reason.lisp)
#+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)))

View File

@@ -23,7 +23,7 @@ To maintain sovereignty, the harness must remain a "dumb" bus. It should not kno
** The Installer Script (opencortex.sh)
The 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]

View File

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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/tui-client.lisp")
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR "/tui-client.lisp
:PROPERTIES:
: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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-bouncer.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-bouncer.lisp")" )
:PROPERTIES:
: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 minimalonly 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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-cli-gateway.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-cli-gateway.lisp")" )
:PROPERTIES:
: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)

View File

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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-credentials-vault.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-credentials-vault.lisp")" )
:PROPERTIES:
: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

View File

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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-emacs-edit.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-emacs-edit.lisp")" )
:PROPERTIES:
: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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-engineering-standards.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-engineering-standards.lisp")" )
:PROPERTIES:
: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))))

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-gardener.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-gardener.lisp")" )
:PROPERTIES:
: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

View File

@@ -13,26 +13,26 @@ In a traditional AI wrapper, the user manually edits a config file to add a bot
* Phase B: Protocol (Success Criteria)
** 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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-homoiconic-memory.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-homoiconic-memory.lisp")" )
:PROPERTIES:
: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."

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-lisp-utils.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-lisp-utils.lisp")" )
:PROPERTIES:
: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))))

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-literate-programming.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-literate-programming.lisp")" )
:PROPERTIES:
: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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-llama-backend.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-llama-backend.lisp")" )
:PROPERTIES:
: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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-llm-gateway.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-llm-gateway.lisp")" )
:PROPERTIES:
: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)

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-peripheral-vision.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-peripheral-vision.lisp")" )
:PROPERTIES:
: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)

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-policy.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-policy.lisp")" )
:PROPERTIES:
: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 limitthe 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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-protocol-validator.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-protocol-validator.lisp")" )
:PROPERTIES:
: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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-scribe.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-scribe.lisp")" )
:PROPERTIES:
: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

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-self-edit.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-self-edit.lisp")" )
:PROPERTIES:
: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))

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-self-fix.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-self-fix.lisp")" )
:PROPERTIES:
: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))))

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-shell-actuator.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-shell-actuator.lisp")" )
:PROPERTIES:
: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)

View File

@@ -1,4 +1,4 @@
#+PROPERTY: header-args:lisp :tangle (concat (getenv "INSTALL_DIR") "/skills/org-skill-tool-permissions.lisp" (expand-file-name ""))
#+PROPERTY: header-args:lisp :tangle (concat (identity (getenv "INSTALL_DIR")) "/skills/org-skill-tool-permissions.lisp")" )
:PROPERTIES:
: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."