ARCH: Finalize semantic reorganization, skill jailing, and unified CLI
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 4s

This commit is contained in:
2026-04-22 11:38:13 -04:00
parent 60f2c152e0
commit 6c333af7aa
51 changed files with 974 additions and 717 deletions

View File

@@ -10,7 +10,7 @@ The Act stage performs the final side-effects of the reasoning engine. It routes
** Actuator Configuration
The core harness can be configured via environment variables to operate silently or target different default outputs.
#+begin_src lisp :tangle ../src/act.lisp
#+begin_src lisp :tangle ../library/act.lisp
(in-package :opencortex)
(defvar *default-actuator* :cli)
@@ -41,7 +41,7 @@ The core harness can be configured via environment variables to operate silently
** Dispatching Actions
The `dispatch-action` function is the primary router. It identifies the target actuator and executes the requested side-effects.
#+begin_src lisp :tangle ../src/act.lisp
#+begin_src lisp :tangle ../library/act.lisp
(defun dispatch-action (action context)
(let ((payload (proto-get action :payload)))
(when (eq (proto-get payload :sensor) :heartbeat)
@@ -67,7 +67,7 @@ The `dispatch-action` function is the primary router. It identifies the target a
** Internal System Actions
The `:system` actuator handles internal harness commands like code evaluation and dynamic skill loading.
#+begin_src lisp :tangle ../src/act.lisp
#+begin_src lisp :tangle ../library/act.lisp
(defun execute-system-action (action context)
"Processes internal harness commands. (ACTUATOR)"
(declare (ignore context))
@@ -88,7 +88,7 @@ The `:system` actuator handles internal harness commands like code evaluation an
** Cognitive Tool Actuation
The `:tool` actuator handles the execution of registered cognitive tools.
#+begin_src lisp :tangle ../src/act.lisp
#+begin_src lisp :tangle ../library/act.lisp
(defun format-tool-result (tool-name result)
"Intelligently formats a tool result for user display."
(if (listp result)
@@ -131,7 +131,7 @@ The `:tool` actuator handles the execution of registered cognitive tools.
** The Act Gate
The final stage of the metabolic loop. It performs a "last-mile" safety check before dispatching the action to the registered actuator.
#+begin_src lisp :tangle ../src/act.lisp
#+begin_src lisp :tangle ../library/act.lisp
(defun act-gate (signal)
"Final Stage: Actuation and feedback generation."
(let* ((approved (getf signal :approved-action))

View File

@@ -10,7 +10,7 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
* Implementation (communication.lisp)
#+begin_src lisp :tangle ../src/package.lisp
#+begin_src lisp :tangle ../library/package.lisp
(in-package :opencortex)
(defun proto-get (plist key)
@@ -21,7 +21,7 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
(or (getf plist up) (getf plist dn))))
#+end_src
#+begin_src lisp :tangle ../src/communication.lisp
#+begin_src lisp :tangle ../library/communication.lisp
(in-package :opencortex)
(defvar *actuator-registry* (make-hash-table :test 'equalp)
@@ -84,7 +84,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 ../src/communication-validator.lisp
#+begin_src lisp :tangle ../library/communication-validator.lisp
(in-package :opencortex)
(defun validate-communication-protocol-schema (msg)
@@ -129,7 +129,7 @@ The validator ensures that incoming messages adhere to the strict property list
** Message Framing (communication.lisp)
Frames a message with a hex length prefix and ensures all data is serializable.
#+begin_src lisp :tangle ../src/communication.lisp
#+begin_src lisp :tangle ../library/communication.lisp
(defun sanitize-protocol-message (msg)
"Recursively strips non-serializable objects from a protocol plist."
(if (and msg (listp msg))

View File

@@ -37,14 +37,14 @@ The ~context.lisp~ module provides the deterministic functional layer for queryi
** Package Context
We begin by ensuring we are executing within the correct isolated package namespace.
#+begin_src lisp :tangle ../src/context.lisp
#+begin_src lisp :tangle ../library/context.lisp
(in-package :opencortex)
#+end_src
** Querying the Store (context-query-store)
A generalized filter for the Memory. This function allows skills to perform high-level semantic sweeps of the Memex based on tags, TODO states, or Org element types. It returns a list of ~org-object~ structures.
#+begin_src lisp :tangle ../src/context.lisp
#+begin_src lisp :tangle ../library/context.lisp
(defun context-query-store (&key tag todo-state type)
"Filters the Memory based on tags, todo states, or types."
(let ((results nil))
@@ -62,7 +62,7 @@ A generalized filter for the Memory. This function allows skills to perform high
** Active Projects (context-get-active-projects)
Identifies headlines tagged with ~project~ that have not yet reached a terminal ~DONE~ state. This provides the primary high-level structure for the agent's global awareness.
#+begin_src lisp :tangle ../src/context.lisp
#+begin_src lisp :tangle ../library/context.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"))
@@ -72,7 +72,7 @@ Identifies headlines tagged with ~project~ that have not yet reached a terminal
** Completed Tasks (context-get-recent-completed-tasks)
Retrieves a list of tasks that have reached the terminal ~DONE~ state. This is useful for providing the agent with historical context or for generating summaries of recent work.
#+begin_src lisp :tangle ../src/context.lisp
#+begin_src lisp :tangle ../library/context.lisp
(defun context-get-recent-completed-tasks ()
"Retrieves recently finished tasks from the store."
(context-query-store :todo-state "DONE" :type :HEADLINE))
@@ -81,7 +81,7 @@ Retrieves a list of tasks that have reached the terminal ~DONE~ state. This is u
** Capability Discovery (context-list-all-skills)
Provides a sorted list of all currently loaded skills. In a "Self-Writing" environment, the agent must be able to discover and understand its own capabilities. This function provides the metadata necessary for the agent to decide which skill to trigger or how to resolve dependencies.
#+begin_src lisp :tangle ../src/context.lisp
#+begin_src lisp :tangle ../library/context.lisp
(defun context-list-all-skills ()
"Provides a sorted overview of currently loaded system capabilities."
(let ((results nil))
@@ -95,7 +95,7 @@ Provides a sorted list of all currently loaded skills. In a "Self-Writing" envir
** Skill Inspection (context-get-skill-source)
Reads the raw literate Org source of a specific skill. This is a foundational capability for an agent expected to eventually "self-write" or perform its own maintenance. By reading the literate source, the agent can understand the *intent* behind a skill's logic before proposing a modification. We use the `SKILLS_DIR` environment variable to locate the source files.
#+begin_src lisp :tangle ../src/context.lisp
#+begin_src lisp :tangle ../library/context.lisp
(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))
@@ -108,7 +108,7 @@ Reads the raw literate Org source of a specific skill. This is a foundational ca
** Harness Logs (context-get-system-logs)
Retrieves the most recent entries from the harness's internal circular log buffer. This allows the Probabilistic Engine to see recent errors or successful dispatches, enabling it to course-correct or explain failures to the user. The log limit is externalized to `CONTEXT_LOG_LIMIT`.
#+begin_src lisp :tangle ../src/context.lisp
#+begin_src lisp :tangle ../library/context.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 (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20)))
@@ -128,7 +128,7 @@ It implements the following deterministic logic:
The semantic threshold is externalized to `CONTEXT_SEMANTIC_THRESHOLD`.
#+begin_src lisp :tangle ../src/context.lisp
#+begin_src lisp :tangle ../library/context.lisp
(defun context-render-to-org (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil))
"Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
(let* ((id (org-object-id obj))
@@ -177,7 +177,7 @@ The semantic threshold is externalized to `CONTEXT_SEMANTIC_THRESHOLD`.
** Path Resolution (context-resolve-path)
A utility function that expands environment variables (like ~$HOME~ or ~$MEMEX_ROOT~) within path strings. This ensures that the agent can interact with files across different machine configurations without hardcoding absolute paths. This version is more robust, supporting multiple environment variables throughout the string.
#+begin_src lisp :tangle ../src/context.lisp
#+begin_src lisp :tangle ../library/context.lisp
(defun context-resolve-path (path-string)
"Expands environment variables and strips literal quotes from a path string."
(let ((path (if (stringp path-string)
@@ -196,7 +196,7 @@ A utility function that expands environment variables (like ~$HOME~ or ~$MEMEX_R
** Global Awareness (context-assemble-global-awareness)
The primary entry point for context generation. This function identifies active projects and the current user focus (captured during the Perceive stage), then invokes the recursive renderer to assemble the pruned Org-mode skeletal outline sent to the LLM.
#+begin_src lisp :tangle ../src/context.lisp
#+begin_src lisp :tangle ../library/context.lisp
(defun context-assemble-global-awareness (&optional signal)
"Produces a high-level skeletal outline of the current Memory for the LLM."
(let* ((foveal-id (or (getf signal :foveal-focus)

View File

@@ -13,7 +13,7 @@ The Metabolic Loop is the high-level coordinator of the OpenCortex. It orchestra
** Package and Variables
The loop requires thread-safe interrupt handling to ensure that the agent can be stopped gracefully without leaving the Lisp image in an inconsistent state.
#+begin_src lisp :tangle ../src/loop.lisp
#+begin_src lisp :tangle ../library/loop.lisp
(in-package :opencortex)
(defvar *interrupt-flag* nil)
@@ -24,7 +24,7 @@ The loop requires thread-safe interrupt handling to ensure that the agent can be
** The Metabolic Pipeline
The `process-signal` function is the core metabolic processor. It iterates through the Perceive-Reason-Act gates until the signal is fully processed or an error state is reached. We have refined the error handling to ensure that memory rollbacks only occur on critical system failures, preventing transient tool errors from wiping short-term cognitive state.
#+begin_src lisp :tangle ../src/loop.lisp
#+begin_src lisp :tangle ../library/loop.lisp
(defun process-signal (signal)
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
(let ((current-signal signal))
@@ -64,7 +64,7 @@ The `process-signal` function is the core metabolic processor. It iterates throu
** Heartbeat Mechanism
The heartbeat ensures the agent remains "alive" even in the absence of external stimuli, allowing for latent reflection and periodic maintenance. The interval is externalized to the `HEARTBEAT_INTERVAL` environment variable.
#+begin_src lisp :tangle ../src/loop.lisp
#+begin_src lisp :tangle ../library/loop.lisp
(defun start-heartbeat ()
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL."
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
@@ -81,7 +81,7 @@ The heartbeat ensures the agent remains "alive" even in the absence of external
** Main Entry Point
The `main` function initializes the environment, loads skills, and starts the heartbeat. It now includes a graceful shutdown handler for `SIGINT` (Ctrl+C) and uses `DAEMON_SLEEP_INTERVAL` to control its idle rhythm.
#+begin_src lisp :tangle ../src/loop.lisp
#+begin_src lisp :tangle ../library/loop.lisp
(defun main ()
"Entry point for the Skeleton MVP. Handles initialization and graceful shutdown."
(let* ((home (uiop:getenv "HOME"))

View File

@@ -38,18 +38,15 @@ This system defines the core "Thin Harness." It includes the protocol, the objec
:description "The Probabilistic-Deterministic Lisp Machine Harness"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
:serial t
:components ((:file "src/package")
(:file "src/skills")
(:file "src/policy")
(:file "src/communication-validator")
(:file "src/communication")
(:file "src/memory")
(:file "src/context")
(:file "src/probabilistic")
(:file "src/perceive")
(:file "src/reason")
(:file "src/act")
(:file "src/loop"))
:components ((:file "library/package")
(:file "library/skills")
(:file "library/communication")
(:file "library/memory")
(:file "library/context")
(:file "library/perceive")
(:file "library/reason")
(:file "library/act")
(:file "library/loop"))
:build-operation "program-op"
:build-pathname "opencortex-server"
:entry-point "opencortex:main")
@@ -82,5 +79,5 @@ This system defines the native Croatoan TUI client.
#+begin_src lisp :tangle ../opencortex.asd
(defsystem :opencortex/tui
:depends-on (:opencortex :croatoan :usocket :bordeaux-threads)
:components ((:file "src/tui-client")))
:components ((:file "library/tui-client")))
#+end_src

View File

@@ -31,14 +31,14 @@ flowchart TD
#+end_src
** Package Context
#+begin_src lisp :tangle ../src/memory.lisp
#+begin_src lisp :tangle ../library/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 ../src/memory.lisp
#+begin_src lisp :tangle ../library/memory.lisp
(defvar *memory* (make-hash-table :test 'equal))
(defvar *history-store* (make-hash-table :test 'equal)
@@ -48,7 +48,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 ../src/memory.lisp
#+begin_src lisp :tangle ../library/memory.lisp
(defstruct org-object
id type attributes content vector parent-id children version last-sync hash)
#+end_src
@@ -56,7 +56,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 ../src/memory.lisp
#+begin_src lisp :tangle ../library/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)))
@@ -73,7 +73,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 ../src/memory.lisp
#+begin_src lisp :tangle ../library/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))
@@ -112,7 +112,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 ../src/memory.lisp
#+begin_src lisp :tangle ../library/memory.lisp
(defvar *object-store-snapshots* nil)
(defun copy-hash-table (hash-table)
@@ -134,7 +134,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 ../src/memory.lisp
#+begin_src lisp :tangle ../library/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*)))
@@ -147,7 +147,7 @@ Restores the state of the Memex from one of the previous snapshots.
** Lookup Utilities
Basic functions for retrieving objects by ID or type.
#+begin_src lisp :tangle ../src/memory.lisp
#+begin_src lisp :tangle ../library/memory.lisp
(defun org-id-new ()
"Generates a new UUID string for Org-mode identification."
(string-downcase (format nil "~a" (uuid:make-v4-uuid))))
@@ -176,7 +176,7 @@ Basic functions for retrieving objects by ID or type.
** Structural Helpers
Utility functions for AST traversal and path resolution.
#+begin_src lisp :tangle ../src/memory.lisp
#+begin_src lisp :tangle ../library/memory.lisp
(defun find-headline-missing-id (ast)
"Traverses an AST to find headlines that lack an :ID: property."
(when (listp ast)

View File

@@ -18,7 +18,7 @@ flowchart TD
#+end_src
** Public API Export
#+begin_src lisp :tangle ../src/package.lisp
#+begin_src lisp :tangle ../library/package.lisp
(defpackage :opencortex
(:use :cl)
(:export
@@ -138,7 +138,7 @@ flowchart TD
#:find-headline-missing-id))
#+end_src
#+begin_src lisp :tangle ../src/package.lisp
#+begin_src lisp :tangle ../library/package.lisp
(in-package :opencortex)
(defun proto-get (plist key)
@@ -151,7 +151,7 @@ flowchart TD
#+end_src
#+begin_src lisp :tangle ../src/package.lisp
#+begin_src lisp :tangle ../library/package.lisp
(in-package :opencortex)
(defun proto-get (plist key)
@@ -165,27 +165,27 @@ flowchart TD
#+end_src
** Package Implementation
#+begin_src lisp :tangle ../src/package.lisp
#+begin_src lisp :tangle ../library/package.lisp
(in-package :opencortex)
#+end_src
** Harness Logging State
The harness maintains a thread-safe circular log buffer to provide context for debugging and neural reasoning.
#+begin_src lisp :tangle ../src/package.lisp
#+begin_src lisp :tangle ../library/package.lisp
(defvar *system-logs* nil)
(defvar *logs-lock* (bt:make-lock "harness-logs-lock"))
(defvar *max-log-history* 100)
#+end_src
** Skills Registry
#+begin_src lisp :tangle ../src/package.lisp
#+begin_src lisp :tangle ../library/package.lisp
(defvar *skills-registry* (make-hash-table :test 'equal)
"Global registry of all loaded skills.")
#+end_src
** Skill Telemetry State
#+begin_src lisp :tangle ../src/package.lisp
#+begin_src lisp :tangle ../library/package.lisp
(defvar *skill-telemetry* (make-hash-table :test 'equal))
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock"))
#+end_src
@@ -193,7 +193,7 @@ The harness maintains a thread-safe circular log buffer to provide context for d
** Telemetry Implementation
The system tracks the performance and reliability of individual skills. This logic is currently preserved in the package layer for future expansion into a dedicated telemetry skill.
#+begin_src lisp :tangle ../src/package.lisp
#+begin_src lisp :tangle ../library/package.lisp
(defun harness-track-telemetry (skill-name duration status)
"Updates performance metrics for a specific skill. Status should be :success or :rejected."
(when skill-name
@@ -208,7 +208,7 @@ The system tracks the performance and reliability of individual skills. This log
** Cognitive Tool Registry
The Tool Registry allows the agent to interact with the physical world. Every tool must define a guard (for security) and a body (for execution).
#+begin_src lisp :tangle ../src/package.lisp
#+begin_src lisp :tangle ../library/package.lisp
(defvar *cognitive-tools* (make-hash-table :test 'equal))
(defstruct cognitive-tool
@@ -231,7 +231,7 @@ The Tool Registry allows the agent to interact with the physical world. Every to
** Harness Logging Implementation
Centralized logging function. It simultaneously writes to standard output and the in-memory circular buffer.
#+begin_src lisp :tangle ../src/package.lisp
#+begin_src lisp :tangle ../library/package.lisp
(defun harness-log (msg &rest args)
"Centralized logging for the harness."
(let ((formatted-msg (apply #'format nil msg args)))

View File

@@ -10,7 +10,7 @@ The Perceive stage is the "sensory cortex" of the OpenCortex. It takes raw stimu
** Async Sensor Routing
To prevent blocking the main pipeline, certain sensors (like user commands or chat messages) are processed asynchronously in their own threads.
#+begin_src lisp :tangle ../src/perceive.lisp
#+begin_src lisp :tangle ../library/perceive.lisp
(in-package :opencortex)
(defvar *async-sensors* '(:chat-message :delegation :user-command)
@@ -20,7 +20,7 @@ To prevent blocking the main pipeline, certain sensors (like user commands or ch
** Foveal Focus State
The system tracks the user's current point of interaction to provide context to the reasoning engine.
#+begin_src lisp :tangle ../src/perceive.lisp
#+begin_src lisp :tangle ../library/perceive.lisp
(defvar *foveal-focus-id* nil
"The Org ID of the node the user is currently interacting with.")
#+end_src
@@ -28,7 +28,7 @@ The system tracks the user's current point of interaction to provide context to
** Stimulus Injection
The entry point for raw messages. It determines if the signal should be processed synchronously or asynchronously.
#+begin_src lisp :tangle ../src/perceive.lisp
#+begin_src lisp :tangle ../library/perceive.lisp
(defun inject-stimulus (raw-message &key stream (depth 0))
"Enqueues a raw message into the reactive signal pipeline."
(let* ((payload (getf raw-message :payload))
@@ -56,7 +56,7 @@ The entry point for raw messages. It determines if the signal should be processe
** The Perceive Gate
The initial stage of the metabolic loop. It logs the signal, performs selective memory snapshots, and updates the Memory graph based on incoming AST updates.
#+begin_src lisp :tangle ../src/perceive.lisp
#+begin_src lisp :tangle ../library/perceive.lisp
(defun perceive-gate (signal)
"Initial processing: Normalizes raw stimuli and updates memory."
(let* ((payload (getf signal :payload))

View File

@@ -10,12 +10,12 @@ The Reason stage is the cognitive engine of the OpenCortex. It bridges the gap b
* Cognition Engine (reason.lisp)
** Package Context
#+begin_src lisp :tangle ../src/reason.lisp
#+begin_src lisp :tangle ../library/reason.lisp
(in-package :opencortex)
#+end_src
** Neural Backend Registry
#+begin_src lisp :tangle ../src/reason.lisp
#+begin_src lisp :tangle ../library/reason.lisp
(defvar *probabilistic-backends* (make-hash-table :test 'equal))
(defvar *provider-cascade* nil)
(defvar *model-selector-fn* nil)
@@ -27,7 +27,7 @@ The Reason stage is the cognitive engine of the OpenCortex. It bridges the gap b
#+end_src
** Probabilistic Reasoning (probabilistic-call)
#+begin_src lisp :tangle ../src/reason.lisp
#+begin_src lisp :tangle ../library/reason.lisp
(defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil))
"Dispatches a neural request through the provider cascade. Returns a Lisp plist or a failure log."
(let ((backends (or cascade *provider-cascade*)))
@@ -47,7 +47,7 @@ The Reason stage is the cognitive engine of the OpenCortex. It bridges the gap b
#+end_src
** Cognitive Proposal (Think)
#+begin_src lisp :tangle ../src/reason.lisp
#+begin_src lisp :tangle ../library/reason.lisp
(defun strip-markdown (text)
"Strips common markdown code block markers from text."
(if (and text (stringp text))
@@ -104,7 +104,7 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o
#+end_src
** Deterministic Verification
#+begin_src lisp :tangle ../src/reason.lisp
#+begin_src lisp :tangle ../library/reason.lisp
(defun deterministic-verify (proposed-action context)
"Iterates through all skill deterministic-gates sorted by priority."
(let ((current-action proposed-action)
@@ -128,7 +128,7 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o
#+end_src
** Reasoning Gate (The Pipeline Stage)
#+begin_src lisp :tangle ../src/reason.lisp
#+begin_src lisp :tangle ../library/reason.lisp
(defun reason-gate (signal)
"Unified Stage: Combines Probabilistic proposals and Deterministic verification."
(let* ((type (proto-get signal :type))

View File

@@ -102,9 +102,9 @@ setup_system() {
mkdir -p "$M_DIR" "$M_DIR/notes" "$M_DIR/areas" "$M_DIR/resources" "$M_DIR/archives" "$M_DIR/system" "$M_DIR/inbox" "$M_DIR/daily" "$M_DIR/projects"
fi
mkdir -p src
for f in literate/*.org; do
emacs --batch --eval "(require 'org)" --eval "(org-babel-tangle-file \"$f\")" >/dev/null 2>&1 || true
mkdir -p library
for f in harness/*.org skills/*.org; do
emacs -Q --batch --eval "(require 'org)" --eval "(org-babel-tangle-file \"$f\")" >/dev/null 2>&1 || true
done
mkdir -p "$HOME/.local/bin"
@@ -162,7 +162,7 @@ TARGET_PORT=${PORT:-$DEFAULT_PORT}
TARGET_HOST=${HOST:-$DEFAULT_HOST}
# If uninitialized, force setup.
if [ ! -f "$SCRIPT_DIR/src/package.lisp" ] || [ ! -f "$SCRIPT_DIR/.env" ]; then
if [ ! -f "$SCRIPT_DIR/library/package.lisp" ] || [ ! -f "$SCRIPT_DIR/.env" ]; then
COMMAND="setup"
fi
@@ -209,9 +209,29 @@ case "$COMMAND" in
echo ""
fi
if command_exists socat; then
exec socat - TCP:$TARGET_HOST:$TARGET_PORT
echo -e "Connected to OpenCortex on $TARGET_HOST:$TARGET_PORT (Channel: CLI)"
while true; do
read -p "User: " MESSAGE
if [ -z "$MESSAGE" ]; then continue; fi
if [ "$MESSAGE" = "/exit" ]; then break; fi
# Frame the message
PAYLOAD="(:TYPE :EVENT :META (:SOURCE :CLI) :PAYLOAD (:SENSOR :USER-INPUT :TEXT \"$MESSAGE\"))"
LEN=$(printf "%s" "$PAYLOAD" | wc -c)
HEXLEN=$(printf "%06x" $LEN)
# Send and read response
(printf "%s%s" "$HEXLEN" "$PAYLOAD" | nc -N $TARGET_HOST $TARGET_PORT) | while read -r LINE; do
CLEAN=$(echo "$LINE" | sed 's/^......//')
if [[ "$CLEAN" == *":TEXT"* ]]; then
TEXT=$(echo "$CLEAN" | sed -n 's/.*:TEXT "\([^"]*\)".*/\1/p')
echo -e "Agent: $TEXT"
fi
done
done
else
exec nc $TARGET_HOST $TARGET_PORT
echo "Error: socat required for CLI interaction."
exit 1
fi
;;
@@ -224,7 +244,7 @@ esac
#+end_src
** Metabolic Docker Infrastructure (Dockerfile)
#+begin_src dockerfile :tangle ../Dockerfile
#+begin_src dockerfile :tangle ../infrastructure/docker/Dockerfile
FROM debian:bullseye-slim
ENV DEBIAN_FRONTEND=noninteractive

View File

@@ -10,7 +10,7 @@ A static, hardcoded architecture is inherently fragile. The ~opencortex~ Skill E
** Global Skill Registry
#+begin_src lisp :tangle ../src/skills.lisp
#+begin_src lisp :tangle ../library/skills.lisp
(in-package :opencortex)
(defun COSINE-SIMILARITY (v1 v2) 1.0) ; Stub
@@ -66,7 +66,7 @@ A static, hardcoded architecture is inherently fragile. The ~opencortex~ Skill E
#+end_src
** Skill File Analysis (parse-skill-metadata)
#+begin_src lisp :tangle ../src/skills.lisp
#+begin_src lisp :tangle ../library/skills.lisp
(defun parse-skill-metadata (filepath)
"Extracts ID and DEPENDS_ON tags using robust regex scanning."
(let ((dependencies nil)
@@ -85,7 +85,7 @@ A static, hardcoded architecture is inherently fragile. The ~opencortex~ Skill E
#+end_src
** Dependency Resolution (topological-sort-skills)
#+begin_src lisp :tangle ../src/skills.lisp
#+begin_src lisp :tangle ../library/skills.lisp
(defun topological-sort-skills (skills-dir)
"Returns a list of skill filepaths sorted by dependency (dependencies first)."
(let ((files (uiop:directory-files skills-dir "org-skill-*.org"))
@@ -129,7 +129,7 @@ A static, hardcoded architecture is inherently fragile. The ~opencortex~ Skill E
#+end_src
** Jailed Loading (load-skill-from-org)
#+begin_src lisp :tangle ../src/skills.lisp
#+begin_src lisp :tangle ../library/skills.lisp
(defun validate-lisp-syntax (code-string)
"Checks if a string contains valid, readable Common Lisp forms."
(handler-case
@@ -156,9 +156,7 @@ A static, hardcoded architecture is inherently fragile. The ~opencortex~ Skill E
(dolist (line lines)
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line))
(if (search ":tangle" (string-downcase clean-line))
(setf in-lisp-block nil)
(setf in-lisp-block t)))
(setf in-lisp-block t))
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line))
(setf in-lisp-block nil))
(in-lisp-block
@@ -174,7 +172,7 @@ A static, hardcoded architecture is inherently fragile. The ~opencortex~ Skill E
(harness-log "HARNESS: Jailing skill '~a' in package ~a" skill-base-name pkg-name)
(unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl))))
(do-external-symbols (sym (find-package :opencortex)) (shadowing-import sym new-pkg))))
(use-package :opencortex new-pkg)))
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
(eval (read-from-string (format nil "(progn ~a)" lisp-code))))
(setf (skill-entry-status entry) :ready)
@@ -209,7 +207,7 @@ A static, hardcoded architecture is inherently fragile. The ~opencortex~ Skill E
#+end_src
** Initializing All Skills (initialize-all-skills)
#+begin_src lisp :tangle ../src/skills.lisp
#+begin_src lisp :tangle ../library/skills.lisp
(defun initialize-all-skills ()
"Scans the directory defined by SKILLS_DIR and hot-loads skills using topological order."
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
@@ -255,7 +253,7 @@ A static, hardcoded architecture is inherently fragile. The ~opencortex~ Skill E
#+end_src
** Toolbelt Prompt Generation (generate-tool-belt-prompt)
#+begin_src lisp :tangle ../src/skills.lisp
#+begin_src lisp :tangle ../library/skills.lisp
(defun generate-tool-belt-prompt ()
"Aggregates all registered cognitive tools into a descriptive prompt."
(let ((output (format nil "AVAILABLE TOOLS:
@@ -280,7 +278,7 @@ EXAMPLES:
** The Default Tool Belt
*** The Eval Tool (Internal Inspection)
#+begin_src lisp :tangle ../src/skills.lisp
#+begin_src lisp :tangle ../library/skills.lisp
(def-cognitive-tool :eval "Evaluates raw Common Lisp code in the harness image. Use this for complex calculations or internal state inspection."
((:code :type :string :description "The Lisp code to evaluate"))
:guard (lambda (args context)
@@ -298,7 +296,7 @@ EXAMPLES:
#+end_src
*** The Grep Tool (File Discovery)
#+begin_src lisp :tangle ../src/skills.lisp
#+begin_src lisp :tangle ../library/skills.lisp
(def-cognitive-tool :grep-search "Searches for a pattern in the project files."
((:pattern :type :string :description "The regex pattern to search for")
(:dir :type :string :description "Directory to search in (default is project root)"))
@@ -310,7 +308,7 @@ EXAMPLES:
#+end_src
*** The Shell Tool (Machine Actuation)
#+begin_src lisp :tangle ../src/skills.lisp
#+begin_src lisp :tangle ../library/skills.lisp
(def-cognitive-tool :shell "Executes a shell command on the local machine. Use this for file operations, system checks, or running tests."
((:cmd :type :string :description "The full bash command to execute"))
:guard (lambda (args context)

View File

@@ -10,7 +10,7 @@
The OpenCortex TUI Client is a standalone Common Lisp application built on **Croatoan**. It provides a real-time, multi-window interface for interacting with the OpenCortex daemon.
* Implementation
#+begin_src lisp :tangle ../src/tui-client.lisp
#+begin_src lisp :tangle ../library/tui-client.lisp
(in-package :cl-user)
(defpackage :opencortex.tui
(:use :cl :croatoan)

View File

@@ -0,0 +1,109 @@
(in-package :opencortex)
(defun bouncer-scan-secrets (text)
"Returns the name of the secret found in TEXT, or NIL if clean."
(when (and text (stringp text))
(let ((found-secret nil))
(maphash (lambda (key val)
(when (and val (stringp val) (> (length val) 5))
(when (search val text)
(setf found-secret key))))
opencortex::*vault-memory*)
found-secret)))
(defun bouncer-check-network-exfil (cmd)
"Returns T if the command appears to target an unwhitelisted external host."
(when (and cmd (stringp cmd))
;; Basic check for common data exfiltration tools being used with IPs/URLs
(let ((network-whitelist '("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")))
(when (cl-ppcre:scan "(http|https|ftp)://([\\w\\.-]+)" cmd)
(multiple-value-bind (match regs)
(cl-ppcre:scan-to-strings "(http|https|ftp)://([\\w\\.-]+)" cmd)
(declare (ignore match))
(let ((domain (aref regs 1)))
(not (some (lambda (safe) (search safe domain)) network-whitelist))))))))
(defun bouncer-check (action context)
"The 5-Vector security gate. Blocks or queues actions based on risk."
(let* ((target (getf action :target))
(payload (getf action :payload))
(text (or (getf payload :text) (getf action :text)))
;; 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"))
(getf (getf payload :args) :cmd))))
(approved (getf action :approved)))
(cond
;; 0. Bypass for already approved actions
(approved action)
;; 1. Secret Exposure Vector (Hard Block)
((and text (bouncer-scan-secrets text))
(let ((secret-name (bouncer-scan-secrets text)))
(harness-log "SECURITY VIOLATION: Blocked leak of secret ~a" secret-name)
`(:type :log :payload (:level :error :text ,(format nil "Action blocked: Potential exposure of ~a" secret-name)))))
;; 2. Network Exfiltration Vector (Authorization Required)
((and (or (eq target :shell)
(and (eq target :tool) (equal (getf payload :tool) "shell")))
(bouncer-check-network-exfil cmd))
(harness-log "SECURITY WARNING: External network call detected. Queuing for approval.")
`(:type :EVENT :payload (:sensor :approval-required :action ,action)))
;; 3. High-Impact Target Vector (Authorization Required)
((or (member target '(:shell))
(and (eq target :tool) (member (getf payload :tool) '("shell" "repair-file") :test #'string=))
(and (eq target :EMACS) (eq (getf payload :action) :eval)))
(harness-log "SECURITY: High-impact action ~a requires approval." (or (getf payload :tool) target))
`(:type :EVENT :payload (:sensor :approval-required :action ,action)))
;; 4. Default Pass
(t action))))
(defun bouncer-process-approvals ()
"Scans the object store for APPROVED flight plans and re-injects their actions."
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
(found-any nil))
(dolist (node approved-nodes)
(let* ((tags (getf (org-object-attributes node) :TAGS))
(action-str (getf (org-object-attributes node) :ACTION)))
(when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
(harness-log "BOUNCER: Found approved flight plan ~a. Re-injecting..." (org-object-id node))
(let ((action (ignore-errors (read-from-string action-str))))
(when action
;; Mark as approved to bypass the gate
(setf (getf action :approved) t)
(inject-stimulus action)
;; Mark as DONE
(setf (getf (org-object-attributes node) :TODO) "DONE")
(setq found-any t))))))
found-any))
(defun bouncer-deterministic-gate (action context)
"Main gate for the bouncer skill."
(let* ((payload (getf context :payload))
(sensor (getf payload :sensor)))
(case sensor
(:approval-required
(let* ((blocked-action (getf payload :action))
(id (org-id-new)))
(harness-log "BOUNCER: Creating flight plan node...")
;; Create the node in Emacs (or inbox)
(list :type :REQUEST :target :EMACS :action :insert-node
:id id :attributes `(:TITLE "Flight Plan: High-Risk Action"
:TODO "PLAN"
:TAGS ("FLIGHT_PLAN")
:ACTION ,(format nil "~s" blocked-action)))))
(:heartbeat
;; Periodically check for approvals
(bouncer-process-approvals)
(if action (bouncer-check action context) action))
(otherwise
(if action (bouncer-check action context) action)))))
(defskill :skill-bouncer
:priority 150
:trigger (lambda (ctx) t) ;; Bouncer evaluates all actions deterministically
:probabilistic nil
:deterministic #'bouncer-deterministic-gate)

View File

@@ -0,0 +1,81 @@
(defvar *cli-port* 9105)
(defvar *cli-server-socket* nil)
(defvar *cli-server-thread* nil)
(defun execute-cli-action (action context)
"Sends a framed message back to the connected CLI client."
(let* ((payload (proto-get action :PAYLOAD))
(meta (getf context :meta))
(stream (getf meta :reply-stream)))
(handler-case
(if (and stream (open-stream-p stream))
(progn
(format stream "~a" (frame-message action))
(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."))
(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))
(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.")
(handler-case
(progn
;; 1. Send Handshake
(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)
;; 2. Communication Loop
(loop
(let ((msg (read-framed-message stream)))
(cond ((eq msg :eof) (return))
((eq msg :error) (return))
(t (let* ((payload (proto-get msg :payload))
(text (proto-get payload :text))
(meta (proto-get msg :meta)))
(if (and text (stringp text) (char= (char text 0) #\/))
(when (eq (handle-cli-slash-command text stream) :exit) (return))
(progn
;; Default meta if missing
(unless meta
(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."))
(defun start-cli-gateway (&optional (port *cli-port*))
"Starts the TCP listener for local CLI clients."
(setf *cli-server-socket* (usocket:socket-listen "0.0.0.0" port :reuse-address t))
(setf *cli-server-thread*
(bt:make-thread
(lambda ()
(unwind-protect
(loop
(let* ((socket (usocket:socket-accept *cli-server-socket*))
(stream (usocket:socket-stream socket)))
(bt:make-thread (lambda ()
(unwind-protect (handle-cli-client stream)
(usocket:socket-close socket)))
:name "opencortex-cli-client-handler")))
(usocket:socket-close *cli-server-socket*)))
:name "opencortex-cli-gateway"))
(harness-log "CLI: Gateway listening on port ~a" port))
(register-actuator :CLI #'execute-cli-action)
(defskill :skill-gateway-cli
:priority 200
:trigger (lambda (ctx) (declare (ignore ctx)) nil)
:probabilistic nil
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))
(start-cli-gateway)

View File

@@ -0,0 +1,82 @@
(defun vault-get-secret (provider &key type)
"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.")
(defvar opencortex::*vault-memory* (make-hash-table :test 'equal)
"In-memory cache of sensitive credentials.")
(defun vault-mask-string (str)
"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]"))
(defun vault-get-secret (provider &key (type :api-key))
"Retrieves a credential. Type can be :api-key or :session."
(let* ((key (format nil "~a-~a" provider type))
(val (gethash key opencortex::*vault-memory*)))
(if val
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")
(t nil))))
(when (and env-var (eq type :api-key))
(uiop:getenv env-var))))))
(defun vault-set-secret (provider secret &key (type :api-key))
"Securely stores a secret and triggers a Merkle snapshot."
(let ((key (format nil "~a-~a" provider type)))
(setf (gethash key opencortex::*vault-memory*) secret)
(harness-log "VAULT - Updated ~a for ~a. Triggering Merkle snapshot..." type provider)
(snapshot-memory)
t))
(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'.")
t)
(progn
(defskill :skill-credentials-vault
:priority 200 ; High priority, foundational
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :onboarding-request))
:probabilistic nil
:deterministic (lambda (action ctx)
(vault-onboard-gemini-web)
action)))
#|
(defpackage :opencortex-vault-tests
(:use :cl :fiveam :opencortex))
(in-package :opencortex-vault-tests)
(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"))))
(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")
(is (> (opencortex::org-object-version (gethash "root" *memory*)) old-version))))
|#

View File

@@ -0,0 +1,68 @@
(in-package :opencortex)
(defvar *gardener-last-audit* 0
"The universal-time of the last full Memex audit.")
(defun gardener-find-broken-links ()
"Returns a list of broken ID links found in the Memex."
(let ((broken nil))
(maphash (lambda (id obj)
(let ((content (org-object-content obj)))
(when content
(cl-ppcre:do-register-groups (target-id) ("id:([A-Za-z0-9-]+)" content)
(unless (lookup-object target-id)
(push (list :source id :broken-target target-id) broken))))))
*memory*)
broken))
(defun gardener-find-orphans ()
"Returns a list of IDs for headlines that are structurally isolated."
(let ((inbound (make-hash-table :test 'equal))
(outbound (make-hash-table :test 'equal))
(orphans nil))
;; 1. Map all connections
(maphash (lambda (id obj)
(let ((content (org-object-content obj)))
(when content
(cl-ppcre:do-register-groups (target-id) ("id:([A-Za-z0-9-]+)" content)
(setf (gethash id outbound) t)
(setf (gethash target-id inbound) t)))))
*memory*)
;; 2. Identify nodes with zero connections
(maphash (lambda (id obj)
(declare (ignore obj))
(unless (or (gethash id inbound) (gethash id outbound))
(push id orphans)))
*memory*)
orphans))
(defun gardener-deterministic-gate (action context)
"Main gate for the Gardener skill. Audits graph integrity."
(declare (ignore action context))
(let ((broken (gardener-find-broken-links))
(orphans (gardener-find-orphans)))
(when (or broken orphans)
(harness-log "GARDENER: Audit found ~a broken links and ~a orphans."
(length broken) (length orphans))
(dolist (link broken)
(harness-log " [BROKEN LINK] Node ~a -> ~a" (getf link :source) (getf link :broken-target)))
(dolist (orphan orphans)
(harness-log " [ORPHAN] Node ~a is isolated." orphan)))
(setf *gardener-last-audit* (get-universal-time))
;; Return a log to stop the loop
(list :type :LOG :payload (list :text "Gardener audit complete."))))
(defskill :skill-gardener
:priority 40
:trigger (lambda (ctx)
(let* ((payload (getf ctx :payload))
(sensor (getf payload :sensor)))
(and (eq sensor :heartbeat)
;; Only audit once per day
(> (- (get-universal-time) *gardener-last-audit*) 86400))))
:probabilistic nil
:deterministic #'gardener-deterministic-gate)

View File

@@ -0,0 +1,28 @@
(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."
(declare (ignore ast))
nil)
(defun make-memory-node (headline &key content properties children)
"Constructor for a normalized Org node alist."
(declare (ignore headline))
(list :TYPE :HEADLINE
:PROPERTIES (or properties nil)
:CONTENT content
:CONTENTS children))
(defskill :skill-homoiconic-memory
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil)
:probabilistic nil
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))

View File

@@ -0,0 +1,33 @@
(in-package :opencortex)
(defun llama-inference (prompt system-prompt &key (model "local-model"))
"Sends a completion request to the local llama.cpp server."
(let ((endpoint (uiop:getenv "LLAMACPP_ENDPOINT")))
(unless endpoint
(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:")))))
(response (dex:post (format nil "~a/completion" endpoint)
:content payload
:headers '(("Content-Type" . "application/json"))))
(data (cl-json:decode-json-from-string response)))
(cdr (assoc :content data)))
(error (c)
(harness-log "LLAMA ERROR: Connection failed -> ~a" c)
(list :error (format nil "~a" c))))))
(progn
(register-probabilistic-backend :llama #'llama-inference)
(harness-log "LLAMA: Local backend registered and active."))
(defskill :skill-llama-backend
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil) ; Pure infrastructure skill
:probabilistic nil
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))

View File

@@ -0,0 +1,110 @@
(defun get-nested (alist &rest keys)
"Recursively extracts nested values from an alist, handling both objects and arrays."
(let ((val alist))
(dolist (k keys)
;; Descend into arrays (cl-json style: ((key . val)) or ( ( (key . val) ) ))
(loop while (and (listp val) (listp (car val)) (not (keywordp (caar val))))
do (setf val (car val)))
(let ((pair (or (assoc k val)
(assoc (intern (string-upcase (string k)) :keyword) val)
(assoc (intern (string-downcase (string k)) :keyword) val))))
(if pair
(setf val (cdr pair))
(return-from get-nested nil))))
val))
(defun execute-llm-request (prompt system-prompt &key provider model)
"Unified entry point for all LLM providers. Respects the global cascade."
(let* ((active-provider (or provider (car opencortex::*provider-cascade*) :openrouter))
(api-key (vault-get-secret active-provider :type :api-key))
(full-prompt (format nil "~a~%~%Prompt: ~a" system-prompt prompt)))
(harness-log "PROBABILISTIC ENGINE: Requesting ~a (Model: ~s)"
active-provider (or model "default"))
;; If the specifically requested provider has no key, try falling back to the cascade
(when (or (null api-key) (string= api-key ""))
(harness-log "GATEWAY: Provider ~a has no key. Cascade fallback would trigger here." active-provider)
(return-from execute-llm-request (list :status :error :message "API Key missing.")))
(case active-provider
(:gemini-web
(let ((res (uiop:symbol-call :opencortex.skills.org-skill-web-research :ask-gemini-web full-prompt)))
(if res (list :status :success :content res) (list :status :error :message "Web Research Failure"))))
(:ollama
(let* ((host (or (uiop: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)))))
(handler-case
(progn
(harness-log "LLM DEBUG: Requesting Ollama...")
(let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body :connect-timeout 5 :read-timeout 60))
(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 ;; Cloud Providers (Anthropic, Gemini API, Groq, OpenAI, OpenRouter)
(let* ((endpoint (case active-provider
(:anthropic "https://api.anthropic.com/v1/messages")
(:gemini-api (format nil "https://generativelanguage.googleapis.com/v1/models/~a:generateContent" (or model "gemini-1.5-flash-latest")))
(:groq "https://api.groq.com/openai/v1/chat/completions")
(:openai "https://api.openai.com/v1/chat/completions")
(:openrouter "https://openrouter.ai/api/v1/chat/completions")))
(headers (case active-provider
(:anthropic `(("Content-Type" . "application/json") ("x-api-key" . ,api-key) ("anthropic-version" . "2023-06-01")))
(:gemini-api `(("Content-Type" . "application/json") ("x-goog-api-key" . ,api-key)))
(:openrouter `(("Content-Type" . "application/json") ("Authorization" . ,(format nil "Bearer ~a" api-key))
("HTTP-Referer" . "https://github.com/amr/opencortex") ("X-Title" . "opencortex Autonomous Kernel")))
(t `(("Content-Type" . "application/json") ("Authorization" . ,(format nil "Bearer ~a" api-key))))))
(body (case active-provider
(:anthropic (cl-json:encode-json-to-string `((model . ,(or model "claude-3-5-sonnet-20240620")) (max_tokens . 4096) (system . ,system-prompt) (messages . (( (role . "user") (content . ,prompt) ))))))
(:gemini-api (cl-json:encode-json-to-string `((contents . (((parts . (((text . ,full-prompt))))))))))
(t (cl-json:encode-json-to-string `((model . ,(or model (case active-provider (:groq "llama-3.3-70b-versatile") (t "google/gemini-2.0-flash-001"))))
(messages . (( (role . "system") (content . ,system-prompt) ) ( (role . "user") (content . ,prompt) )))))))))
(handler-case
(progn
(harness-log "LLM DEBUG: Requesting ~a..." active-provider)
(let* ((response (dex:post endpoint :headers headers :content body :connect-timeout 10 :read-timeout 30))
(json (cl-json:decode-json-from-string response)))
(let ((content (case active-provider
(:anthropic (get-nested json :content :text))
(:gemini-api (get-nested json :candidates :parts :text))
(t (get-nested json :choices :message :content)))))
(if content
(list :status :success :content content)
(list :status :error :message (format nil "Failed to parse ~a response structure." active-provider))))))
(error (c) (list :status :error :message (format nil "LLM Gateway Failure (~a): ~a" active-provider c)))))))))
;; Initialize Cascade
(let* ((env-cascade (uiop:getenv "PROVIDER_CASCADE"))
(default-list '(:openrouter :openai :anthropic :groq :gemini-api :ollama))
(final-list (if (and env-cascade (not (string= env-cascade "")))
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
(uiop:split-string env-cascade :separator '(#\,)))
default-list)))
(setf opencortex::*provider-cascade* final-list)
(opencortex:harness-log "PROBABILISTIC: Neural Cascade Initialized -> ~a" final-list))
;; Register Providers
(dolist (p '(:anthropic :gemini-api :gemini-web :groq :ollama :openrouter :openai))
(opencortex:register-probabilistic-backend p (lambda (prompt system-prompt &key model)
(execute-llm-request prompt system-prompt :provider p :model model))))
(def-cognitive-tool :ask-llm
"Queries an LLM provider via the unified gateway."
((:prompt :type :string :description "The user prompt.")
(:system-prompt :type :string :description "The system instructions.")
(:provider :type :keyword :description "Optional specific provider.")
(:model :type :string :description "Optional specific model ID."))
:body (lambda (args)
(execute-llm-request (getf args :prompt)
(or (getf args :system-prompt) "You are a helpful assistant.")
:provider (getf args :provider)
:model (getf args :model))))
(defskill :skill-llm-gateway
:priority 150
:trigger (lambda (context) (declare (ignore context)) nil)
:probabilistic (lambda (context) (declare (ignore context)) nil)
:deterministic (lambda (action context) (declare (ignore context)) action))

View File

@@ -0,0 +1,76 @@
(defun context-render-to-org (obj &key depth foveal-id semantic-threshold foveal-vector)
"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.")
(defun context-render-to-org (obj &key (depth 1) (foveal-id nil) (semantic-threshold 0.75) (foveal-vector nil))
"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"))
(content (org-object-content obj))
(children (org-object-children obj))
(stars (make-string depth :initial-element #\*))
(obj-vector (org-object-vector obj))
(similarity (if (and foveal-vector obj-vector (not is-foveal))
(cosine-similarity foveal-vector obj-vector)
0.0))
(is-semantically-relevant (>= similarity semantic-threshold))
;; We always render depth 1 and 2 (Projects and main tasks).
;; 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 ""))
(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:~%")))
;; Only include full body content if this is the Foveal focus or highly relevant
(when (and content (or is-foveal is-semantically-relevant))
(setf output (concatenate 'string output content (string #\Newline))))
;; Recursively render children
(dolist (child-id children)
(let ((child-obj (lookup-object child-id)))
(when child-obj
;; If the current node is Foveal, its children should be rendered (depth effectively resets)
(let ((next-foveal (if is-foveal child-id foveal-id)))
(setf output (concatenate 'string output
(context-render-to-org child-obj
:depth (1+ depth)
:foveal-id next-foveal
:semantic-threshold semantic-threshold
:foveal-vector foveal-vector))))))))
output))
(defun context-assemble-global-awareness (&optional signal)
"Produces a high-level skeletal outline of the current Memory for the LLM."
(let* ((payload (when signal (getf signal :payload)))
(foveal-id (when payload (getf payload :target-id)))
(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.~%")))
output))
(defskill :skill-peripheral-vision
:priority 90
:dependencies ("org-skill-embedding")
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:perceive :context-refresh)))
:probabilistic nil
:deterministic (lambda (action ctx)
(declare (ignore action ctx))
;; This skill primarily provides the context-assemble-global-awareness function
;; used by the probabilistic-gate, rather than handling specific actions.
nil))

View File

@@ -0,0 +1,39 @@
(in-package :opencortex)
(defun validate-communication-protocol-schema (msg)
"Strict structural validation for incoming communication protocol messages."
(unless (listp msg)
(error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
(let ((type (let ((raw (proto-get msg :type))) (if (keywordp raw) (intern (string-upcase (string raw)) :keyword) raw))))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS :CHAT))
(progn (harness-log "REJECTED MSG: ~s" msg) (error "Communication Protocol Schema Error: Invalid message type '~a'" type)))
(case type
(:REQUEST
(unless (proto-get msg :target)
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
(unless (proto-get msg :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"))
(unless (or (proto-get payload :action) (proto-get payload :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"))))
t))
(defskill :skill-communication-protocol-validator
:priority 95
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
:probabilistic nil
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(validate-communication-protocol-schema action)
action))

View File

@@ -0,0 +1,108 @@
(in-package :opencortex)
(defvar *scribe-last-checkpoint* 0
"The universal-time of the last successful distillation run.")
(defun scribe-load-state ()
"Loads the scribe checkpoint from the state directory."
(let ((state-file (uiop:merge-pathnames* "state/scribe-checkpoint.lisp" (asdf:system-source-directory :opencortex))))
(if (uiop:file-exists-p state-file)
(setf *scribe-last-checkpoint* (read-from-string (uiop:read-file-string state-file)))
(setf *scribe-last-checkpoint* 0))))
(defun scribe-save-state ()
"Saves the current universal-time as the new checkpoint."
(let ((state-file (uiop:merge-pathnames* "state/scribe-checkpoint.lisp" (asdf:system-source-directory :opencortex))))
(ensure-directories-exist state-file)
(with-open-file (out state-file :direction :output :if-exists :supersede)
(format out "~a" (get-universal-time)))))
(defun scribe-get-distillable-nodes ()
"Returns a list of org-objects from the daily/ folder that require distillation."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(let* ((attrs (org-object-attributes obj))
(tags (getf attrs :TAGS))
(type (org-object-type obj))
(version (org-object-version obj)))
(when (and (eq type :HEADLINE)
(> version *scribe-last-checkpoint*)
(not (member "@personal" tags :test #'string-equal)))
(push obj results))))
*memory*)
results))
(defun probabilistic-skill-scribe (context)
"Generates the extraction prompt for the Scribe."
(let* ((payload (getf context :payload))
(nodes (scribe-get-distillable-nodes)))
(if nodes
(let ((text-to-process ""))
(dolist (node nodes)
(setf text-to-process (concatenate 'string text-to-process
(format nil "ID: ~a~%TITLE: ~a~%CONTENT: ~a~%---~%"
(org-object-id node)
(getf (org-object-attributes node) :TITLE)
(org-object-content node)))))
(format nil "DISTILLATION TASK:
Below are raw chronological logs from my daily journal.
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 \"...\") ...)
3. The content should be in Org-mode format.
4. Keep titles descriptive and snake_case.
TEXT:
~a" text-to-process))
nil)))
(defun scribe-commit-notes (proposals)
"Writes proposed atomic notes to the notes/ directory. Appends if the note exists."
(let ((notes-dir (uiop:merge-pathnames* "notes/" (asdf:system-source-directory :opencortex))))
(ensure-directories-exist notes-dir)
(dolist (note proposals)
(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 "_"))))
(path (merge-pathnames filename notes-dir)))
(if (uiop:file-exists-p path)
(with-open-file (out path :direction :output :if-exists :append)
(format out "~%~%* Appended insight from ~a~%~a" source-id content))
(with-open-file (out path :direction :output :if-exists :supersede)
(format out ":PROPERTIES:~%:ID: ~a~%:SOURCE_ID: ~a~%:END:~%#+TITLE: ~a~%~%~a"
(org-id-new) source-id title content)))
(harness-log "SCRIBE: Processed evergreen note ~a" filename)))))
(defun verify-skill-scribe (action context)
"Executes the note creation and marks source nodes as distilled."
(declare (ignore context))
(let ((data (cond ((and (listp action) (eq (getf action :type) :REQUEST))
(getf (getf action :payload) :payload))
((and (listp action) (not (member (getf action :type) '(:LOG :EVENT))))
action)
(t nil))))
(when data
(harness-log "SCRIBE: Committing ~a atomic notes..." (length data))
(scribe-commit-notes data)
(scribe-save-state)
(harness-log "SCRIBE: Distillation complete.")
;; Return a log event to stop the loop
(list :type :LOG :payload (list :text "Distillation successful.")))))
(defskill :skill-scribe
:priority 50
:trigger (lambda (ctx)
(let* ((payload (getf ctx :payload))
(sensor (getf payload :sensor)))
(and (eq sensor :heartbeat)
;; Only run once per hour to check if we need to distill
(> (- (get-universal-time) *scribe-last-checkpoint*) 3600)
(scribe-get-distillable-nodes))))
:probabilistic #'probabilistic-skill-scribe
:deterministic #'verify-skill-scribe)
(scribe-load-state)

View File

@@ -0,0 +1,56 @@
(defparameter *allowed-commands* '("ls" "git" "rg" "grep" "date" "echo" "cat" "node" "python3" "sbcl"))
(defparameter *shell-metacharacters* '(#\; #\& #\| #\> #\< #\$ #\` #\\ #\!))
(defun shell-command-safe-p (cmd-string)
"Returns T if the command string contains no dangerous metacharacters."
(not (some (lambda (char) (find char cmd-string)) *shell-metacharacters*)))
(defun execute-shell-safely (action context)
(let* ((payload (getf action :PAYLOAD))
(cmd-string (getf payload :cmd))
(executable (car (uiop:split-string (string-trim " " cmd-string) :separator '(#\Space)))))
(cond
((not (shell-command-safe-p cmd-string))
(opencortex:inject-stimulus
`(:TYPE :EVENT :PAYLOAD (:SENSOR :shell-response :cmd ,cmd-string :stdout "" :stderr "ERROR - Security Violation: Dangerous metacharacters detected." :exit-code 1))
:stream (getf context :reply-stream)))
((not (member executable *allowed-commands* :test #'string=))
(opencortex:inject-stimulus
`(:TYPE :EVENT :PAYLOAD (:SENSOR :shell-response :cmd ,cmd-string :stdout "" :stderr "ERROR - Command not in security whitelist." :exit-code 1))
:stream (getf context :reply-stream)))
(t
(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))
:stream (getf context :reply-stream)))))))
(defun trigger-skill-shell-actuator (context)
(let ((type (getf context :TYPE))
(payload (getf context :PAYLOAD)))
(and (eq type :EVENT)
(eq (getf payload :SENSOR) :shell-response))))
(defun probabilistic-skill-shell-actuator (context)
(let* ((p (getf context :PAYLOAD))
(cmd (getf p :cmd))
(stdout (getf p :stdout))
(stderr (getf p :stderr))
(exit-code (getf p :exit-code)))
(format nil "SHELL COMMAND RESULT:
Command: ~a
Exit Code: ~a
STDOUT: ~a
STDERR: ~a" cmd exit-code stdout stderr)))
(opencortex:register-actuator :shell #'execute-shell-safely)
(defskill :skill-shell-actuator
:priority 80
:trigger #'trigger-skill-shell-actuator
:probabilistic #'probabilistic-skill-shell-actuator
:deterministic (lambda (action context) (declare (ignore context)) action))

View File

@@ -134,9 +134,7 @@
(dolist (line lines)
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line))
(if (search ":tangle" (string-downcase clean-line))
(setf in-lisp-block nil)
(setf in-lisp-block t)))
(setf in-lisp-block t))
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line))
(setf in-lisp-block nil))
(in-lisp-block
@@ -152,7 +150,7 @@
(harness-log "HARNESS: Jailing skill '~a' in package ~a" skill-base-name pkg-name)
(unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl))))
(do-external-symbols (sym (find-package :opencortex)) (shadowing-import sym new-pkg))))
(use-package :opencortex new-pkg)))
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
(eval (read-from-string (format nil "(progn ~a)" lisp-code))))
(setf (skill-entry-status entry) :ready)

View File

@@ -6,18 +6,15 @@
:description "The Probabilistic-Deterministic Lisp Machine Harness"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
:serial t
:components ((:file "src/package")
(:file "src/skills")
(:file "src/policy")
(:file "src/communication-validator")
(:file "src/communication")
(:file "src/memory")
(:file "src/context")
(:file "src/probabilistic")
(:file "src/perceive")
(:file "src/reason")
(:file "src/act")
(:file "src/loop"))
:components ((:file "library/package")
(:file "library/skills")
(:file "library/communication")
(:file "library/memory")
(:file "library/context")
(:file "library/perceive")
(:file "library/reason")
(:file "library/act")
(:file "library/loop"))
:build-operation "program-op"
:build-pathname "opencortex-server"
:entry-point "opencortex:main")
@@ -40,4 +37,4 @@
(defsystem :opencortex/tui
:depends-on (:opencortex :croatoan :usocket :bordeaux-threads)
:components ((:file "src/tui-client")))
:components ((:file "library/tui-client")))

View File

@@ -92,9 +92,9 @@ setup_system() {
mkdir -p "$M_DIR" "$M_DIR/notes" "$M_DIR/areas" "$M_DIR/resources" "$M_DIR/archives" "$M_DIR/system" "$M_DIR/inbox" "$M_DIR/daily" "$M_DIR/projects"
fi
mkdir -p src
for f in literate/*.org; do
emacs --batch --eval "(require 'org)" --eval "(org-babel-tangle-file \"$f\")" >/dev/null 2>&1 || true
mkdir -p library
for f in harness/*.org skills/*.org; do
emacs -Q --batch --eval "(require 'org)" --eval "(org-babel-tangle-file \"$f\")" >/dev/null 2>&1 || true
done
mkdir -p "$HOME/.local/bin"
@@ -152,7 +152,7 @@ TARGET_PORT=${PORT:-$DEFAULT_PORT}
TARGET_HOST=${HOST:-$DEFAULT_HOST}
# If uninitialized, force setup.
if [ ! -f "$SCRIPT_DIR/src/package.lisp" ] || [ ! -f "$SCRIPT_DIR/.env" ]; then
if [ ! -f "$SCRIPT_DIR/library/package.lisp" ] || [ ! -f "$SCRIPT_DIR/.env" ]; then
COMMAND="setup"
fi
@@ -199,9 +199,29 @@ case "$COMMAND" in
echo ""
fi
if command_exists socat; then
exec socat - TCP:$TARGET_HOST:$TARGET_PORT
echo -e "Connected to OpenCortex on $TARGET_HOST:$TARGET_PORT (Channel: CLI)"
while true; do
read -p "User: " MESSAGE
if [ -z "$MESSAGE" ]; then continue; fi
if [ "$MESSAGE" = "/exit" ]; then break; fi
# Frame the message
PAYLOAD="(:TYPE :EVENT :META (:SOURCE :CLI) :PAYLOAD (:SENSOR :USER-INPUT :TEXT \"$MESSAGE\"))"
LEN=$(printf "%s" "$PAYLOAD" | wc -c)
HEXLEN=$(printf "%06x" $LEN)
# Send and read response
(printf "%s%s" "$HEXLEN" "$PAYLOAD" | nc -N $TARGET_HOST $TARGET_PORT) | while read -r LINE; do
CLEAN=$(echo "$LINE" | sed 's/^......//')
if [[ "$CLEAN" == *":TEXT"* ]]; then
TEXT=$(echo "$CLEAN" | sed -n 's/.*:TEXT "\([^"]*\)".*/\1/p')
echo -e "Agent: $TEXT"
fi
done
done
else
exec nc $TARGET_HOST $TARGET_PORT
echo "Error: socat required for CLI interaction."
exit 1
fi
;;

View File

@@ -12,7 +12,7 @@
The *Deterministic Engine Bouncer* is the authorization gate for high-risk actions. It serializes intercepted actions into Org nodes ("Flight Plans") and re-injects them once manually approved by the Autonomous.
* Package Context
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-bouncer.lisp
(in-package :opencortex)
#+end_src
@@ -22,7 +22,7 @@ The Bouncer ensures the action is "safe" by inspecting the payload content via D
** Secret Exposure Check
Retrieves all active secrets from the vault and scans the payload for potential leaks.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-bouncer.lisp
(defun bouncer-scan-secrets (text)
"Returns the name of the secret found in TEXT, or NIL if clean."
(when (and text (stringp text))
@@ -38,7 +38,7 @@ Retrieves all active secrets from the vault and scans the payload for potential
** Network Exfiltration Check
Inspects shell commands for unwhitelisted domains or IP addresses.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-bouncer.lisp
(defun bouncer-check-network-exfil (cmd)
"Returns T if the command appears to target an unwhitelisted external host."
(when (and cmd (stringp cmd))
@@ -55,7 +55,7 @@ Inspects shell commands for unwhitelisted domains or IP addresses.
* Runtime Guard (bouncer-check)
The primary entry point for all high-impact actions. It blocks or queues actions based on risk vectors.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-bouncer.lisp
(defun bouncer-check (action context)
"The 5-Vector security gate. Blocks or queues actions based on risk."
(let* ((target (getf action :target))
@@ -98,7 +98,7 @@ The primary entry point for all high-impact actions. It blocks or queues actions
* Approval Processing
The Bouncer periodically scans the Memex for approved "Flight Plans" and re-injects them into the metabolic loop.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-bouncer.lisp
(defun bouncer-process-approvals ()
"Scans the object store for APPROVED flight plans and re-injects their actions."
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
@@ -123,7 +123,7 @@ The Bouncer periodically scans the Memex for approved "Flight Plans" and re-inje
The Bouncer skill reacts to approval requirements by creating flight plan nodes, and periodically checks for manual approvals via heartbeats.
** Skill Logic
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-bouncer.lisp
(defun bouncer-deterministic-gate (action context)
"Main gate for the bouncer skill."
(let* ((payload (getf context :payload))
@@ -148,7 +148,7 @@ The Bouncer skill reacts to approval requirements by creating flight plan nodes,
#+end_src
** Skill Registration
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-bouncer.lisp
(defskill :skill-bouncer
:priority 150
:trigger (lambda (ctx) t) ;; Bouncer evaluates all actions deterministically

View File

@@ -11,11 +11,7 @@ The *CLI Gateway* is the primary sensory and actuating interface for human inter
* Implementation
#+begin_src lisp
(in-package :cl-user)
(defpackage :opencortex.skills.org-skill-cli-gateway
(:use :cl :opencortex))
(in-package :opencortex.skills.org-skill-cli-gateway)
#+begin_src lisp :tangle ../library/gen/org-skill-cli-gateway.lisp
(defvar *cli-port* 9105)
(defvar *cli-server-socket* nil)

View File

@@ -33,7 +33,7 @@ Securely manage all authentication tokens required for the opencortex to operate
The vault provides a secure lookup table in RAM, backed by the persistent Memory. Access is restricted to internal kernel requests and explicitly authorized deterministic gates.
** 2. Semantic Interfaces
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-credentials-vault.lisp
(defun vault-get-secret (provider &key type)
"Retrieves a secret (api-key or session) for a provider.")
@@ -61,13 +61,13 @@ Tests in `tests/vault-tests.lisp` will verify:
* Phase D: Build (Implementation)
** Package Context
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-credentials-vault.lisp
#+end_src
** Vault State
We maintain an in-memory hash table for secrets, which is hydrated from and persisted to the Memory.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-credentials-vault.lisp
(defvar opencortex::*vault-memory* (make-hash-table :test 'equal)
"In-memory cache of sensitive credentials.")
#+end_src
@@ -75,7 +75,7 @@ We maintain an in-memory hash table for secrets, which is hydrated from and pers
** Helper: Secret Masking
The `vault-mask-string` function ensures that diagnostic output never contains the full plaintext of a sensitive token.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-credentials-vault.lisp
(defun vault-mask-string (str)
"Returns a masked version of a sensitive string."
(if (and str (> (length str) 8))
@@ -86,7 +86,7 @@ The `vault-mask-string` function ensures that diagnostic output never contains t
** Retrieval (vault-get-secret)
This function is the secure getter for all system secrets. It prioritizes the Vault (Memory) and falls back to environment variables for legacy compatibility.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-credentials-vault.lisp
(defun vault-get-secret (provider &key (type :api-key))
"Retrieves a credential. Type can be :api-key or :session."
(let* ((key (format nil "~a-~a" provider type))
@@ -112,7 +112,7 @@ This function is the secure getter for all system secrets. It prioritizes the Va
** Persistence (vault-set-secret)
When a secret is updated, we immediately snapshot the Memory to ensure the credential change is versioned and durable.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-credentials-vault.lisp
(defun vault-set-secret (provider secret &key (type :api-key))
"Securely stores a secret and triggers a Merkle snapshot."
(let ((key (format nil "~a-~a" provider type)))
@@ -125,7 +125,7 @@ When a secret is updated, we immediately snapshot the Memory to ensure the crede
** Onboarding Logic
Retained from the legacy Google skill, this provides the instructions for the autonomous cookie handshake.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-credentials-vault.lisp
(defun vault-onboard-gemini-web ()
"Instructions for the Autonomous Cookie Handshake."
(harness-log "--- GEMINI WEB ONBOARDING ---")
@@ -137,7 +137,7 @@ Retained from the legacy Google skill, this provides the instructions for the au
#+end_src
** Registration
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-credentials-vault.lisp
(progn
(defskill :skill-credentials-vault
:priority 200 ; High priority, foundational
@@ -153,7 +153,7 @@ 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
#+begin_src lisp :tangle ../library/gen/org-skill-credentials-vault.lisp
#|
(defpackage :opencortex-vault-tests
(:use :cl :fiveam :opencortex))

View File

@@ -37,14 +37,14 @@ The Gardener runs on a low-priority heartbeat. It performs a "Deep Audit" of the
* Phase D: Build (Implementation)
** Package Context
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-gardener.lisp
(in-package :opencortex)
#+end_src
** State: Maintenance Cycle
We track the last audit time to ensure the Gardener doesn't over-consume resources.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-gardener.lisp
(defvar *gardener-last-audit* 0
"The universal-time of the last full Memex audit.")
#+end_src
@@ -52,7 +52,7 @@ We track the last audit time to ensure the Gardener doesn't over-consume resourc
** Audit: Broken Links
Scans the content of all objects for `id:` links and verifies the targets exist.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-gardener.lisp
(defun gardener-find-broken-links ()
"Returns a list of broken ID links found in the Memex."
(let ((broken nil))
@@ -69,7 +69,7 @@ Scans the content of all objects for `id:` links and verifies the targets exist.
** Audit: Orphaned Nodes
Identifies nodes that are not linked to and do not link to anything else.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-gardener.lisp
(defun gardener-find-orphans ()
"Returns a list of IDs for headlines that are structurally isolated."
(let ((inbound (make-hash-table :test 'equal))
@@ -95,7 +95,7 @@ Identifies nodes that are not linked to and do not link to anything else.
** Skill Logic: The Audit Pass
The Gardener's deterministic gate performs the actual analysis and logs the results. In future versions, it will generate probabilistic repair proposals.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-gardener.lisp
(defun gardener-deterministic-gate (action context)
"Main gate for the Gardener skill. Audits graph integrity."
(declare (ignore action context))
@@ -118,7 +118,7 @@ The Gardener's deterministic gate performs the actual analysis and logs the resu
#+end_src
** Skill Registration
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-gardener.lisp
(defskill :skill-gardener
:priority 40
:trigger (lambda (ctx)

View File

@@ -11,11 +11,7 @@ The *Homoiconic Memory* skill provides the core persistence layer for OpenCortex
* Implementation
#+begin_src lisp
(in-package :cl-user)
(defpackage :opencortex.skills.org-skill-homoiconic-memory
(:use :cl :opencortex))
(in-package :opencortex.skills.org-skill-homoiconic-memory)
#+begin_src lisp :tangle ../library/gen/org-skill-homoiconic-memory.lisp
(defun memory-org-to-json (source)
"Converts Org-mode source to JSON AST."

View File

@@ -21,12 +21,12 @@ This skill acts as a proxy between the OpenCortex kernel and the Lisp-agnostic `
* Phase D: Build (Implementation)
** Package Context
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-llama-backend.lisp
(in-package :opencortex)
#+end_src
** The Inference Engine (llama-inference)
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-llama-backend.lisp
(defun llama-inference (prompt system-prompt &key (model "local-model"))
"Sends a completion request to the local llama.cpp server."
(let ((endpoint (uiop:getenv "LLAMACPP_ENDPOINT")))
@@ -51,7 +51,7 @@ This skill acts as a proxy between the OpenCortex kernel and the Lisp-agnostic `
#+end_src
** Registration
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-llama-backend.lisp
(progn
(register-probabilistic-backend :llama #'llama-inference)
(harness-log "LLAMA: Local backend registered and active."))

View File

@@ -19,11 +19,7 @@ The gateway utilizes a functional dispatch pattern. A single entry point, `execu
* Phase D: Build (Implementation)
** Implementation
#+begin_src lisp
(in-package :cl-user)
(defpackage :opencortex.skills.org-skill-llm-gateway
(:use :cl :opencortex))
(in-package :opencortex.skills.org-skill-llm-gateway)
#+begin_src lisp :tangle ../library/gen/org-skill-llm-gateway.lisp
(defun get-nested (alist &rest keys)
"Recursively extracts nested values from an alist, handling both objects and arrays."

View File

@@ -37,7 +37,7 @@ Move context pruning and rendering logic out of `context.lisp` to allow for more
** 2. Semantic Interfaces
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-peripheral-vision.lisp
(defun context-render-to-org (obj &key depth foveal-id semantic-threshold foveal-vector)
"Recursively renders an org-object with foveal-peripheral pruning.")
@@ -48,7 +48,7 @@ Move context pruning and rendering logic out of `context.lisp` to allow for more
* Phase D: Build (Implementation)
** Foveal-Peripheral Pruning
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-peripheral-vision.lisp
(defun context-render-to-org (obj &key (depth 1) (foveal-id nil) (semantic-threshold 0.75) (foveal-vector nil))
"Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
@@ -112,7 +112,7 @@ Move context pruning and rendering logic out of `context.lisp` to allow for more
#+end_src
* Registration
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-peripheral-vision.lisp
(defskill :skill-peripheral-vision
:priority 90
:dependencies ("org-skill-embedding")

View File

@@ -13,7 +13,7 @@ The *opencortex* is a probabilistic-deterministic harness for a personal operati
* Package Context
Every skill executes within its own jailed package namespace, while inheriting core harness symbols.
#+begin_src lisp :tangle ../src/policy.lisp
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
(in-package :opencortex)
#+end_src
@@ -23,7 +23,7 @@ This document contains the *Core System Policy*. These are non-negotiable philos
** 1. Autonomy Above All
Every action must increase the user's independence from centralized, proprietary platforms. If a tool or library introduces a dependency on a non-autonomous entity, it must be flagged for replacement.
#+begin_src lisp :tangle ../src/policy.lisp
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
(defun policy-check-autonomy (action context)
"Ensures the action does not violate the Autonomy invariant."
(declare (ignore context))
@@ -47,7 +47,7 @@ Prioritize local, energy-efficient, and offline-first architectures. The "Memex"
* The Policy Gate
The main deterministic entry point for the policy skill. It orchestrates the various invariant checks and delegates to engineering standards.
#+begin_src lisp :tangle ../src/policy.lisp
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
(defun policy-deterministic-gate (action context)
"The main policy gate. Sub-calls engineering standards if available."
(let ((current-action (policy-check-autonomy action context)))
@@ -64,7 +64,7 @@ The main deterministic entry point for the policy skill. It orchestrates the var
Every action performed by an agent in this environment must also adhere to the [[file:org-skill-engineering-standards.org][Engineering Standards]].
** Skill Registration
#+begin_src lisp :tangle ../src/policy.lisp
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
(defskill :skill-policy
:priority 100
:trigger (lambda (ctx) t)

View File

@@ -45,7 +45,7 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
* Phase D: Build (Implementation)
** Schema Enforcement
#+begin_src lisp :tangle ../src/communication-validator.lisp
#+begin_src lisp :tangle ../library/gen/org-skill-protocol-validator.lisp
(in-package :opencortex)
(defun validate-communication-protocol-schema (msg)
@@ -79,7 +79,7 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
#+end_src
* Registration
#+begin_src lisp :tangle ../src/communication-validator.lisp
#+begin_src lisp :tangle ../library/gen/org-skill-protocol-validator.lisp
(defskill :skill-communication-protocol-validator
:priority 95
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))

View File

@@ -41,14 +41,14 @@ The Scribe reacts to the `:heartbeat` sensor. It maintains a state file (`scribe
* Phase D: Build (Implementation)
** Package Context
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-scribe.lisp
(in-package :opencortex)
#+end_src
** State: Checkpoint Management
We track the last processed universal time to avoid redundant distillation.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-scribe.lisp
(defvar *scribe-last-checkpoint* 0
"The universal-time of the last successful distillation run.")
@@ -70,7 +70,7 @@ We track the last processed universal time to avoid redundant distillation.
** Filtering: Privacy & Relevance
The Scribe only cares about non-personal, non-distilled headlines.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-scribe.lisp
(defun scribe-get-distillable-nodes ()
"Returns a list of org-objects from the daily/ folder that require distillation."
(let ((results nil))
@@ -91,7 +91,7 @@ The Scribe only cares about non-personal, non-distilled headlines.
** Probabilistic: Extraction Prompt
The LLM is tasked with identifying atomic concepts within the raw text.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-scribe.lisp
(defun probabilistic-skill-scribe (context)
"Generates the extraction prompt for the Scribe."
(let* ((payload (getf context :payload))
@@ -122,7 +122,7 @@ TEXT:
** Deterministic: Note Committal
The deterministic gate receives the list of proposed notes and writes them to the filesystem.
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-scribe.lisp
(defun scribe-commit-notes (proposals)
"Writes proposed atomic notes to the notes/ directory. Appends if the note exists."
(let ((notes-dir (uiop:merge-pathnames* "notes/" (asdf:system-source-directory :opencortex))))
@@ -159,7 +159,7 @@ The deterministic gate receives the list of proposed notes and writes them to th
#+end_src
** Skill Registration
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-scribe.lisp
(defskill :skill-scribe
:priority 50
:trigger (lambda (ctx)
@@ -174,6 +174,6 @@ The deterministic gate receives the list of proposed notes and writes them to th
#+end_src
** Initialization
#+begin_src lisp
#+begin_src lisp :tangle ../library/gen/org-skill-scribe.lisp
(scribe-load-state)
#+end_src

View File

@@ -11,11 +11,7 @@ The *Shell Actuator* provides a controlled interface for the OpenCortex to execu
* Implementation
#+begin_src lisp
(in-package :cl-user)
(defpackage :opencortex.skills.org-skill-shell-actuator
(:use :cl :opencortex))
(in-package :opencortex.skills.org-skill-shell-actuator)
#+begin_src lisp :tangle ../library/gen/org-skill-shell-actuator.lisp
(defparameter *allowed-commands* '("ls" "git" "rg" "grep" "date" "echo" "cat" "node" "python3" "sbcl"))

View File

@@ -1,424 +0,0 @@
;;; opencortex.el --- Probabilistic-Deterministic Lisp Machine Kernel for Org-mode -*- lexical-binding: t; -*-
;; Copyright (C) 2026 Amr
;;
;; Author: Amr
;; Version: 0.1.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: convenience, org
;; URL: https://github.com/amr/opencortex
;;; Commentary:
;; opencortex provides a Probabilistic-Deterministic Lisp Machine interface for Emacs.
;; It acts as the sensor/actuator array, communicating with a persistent
;; Common Lisp daemon over a high-speed communication protocol socket.
;;; Code:
(require 'json)
(require 'cl-lib)
(require 'org-id)
(require 'org-element)
(defgroup opencortex nil
"Emacs interface for the opencortex Common Lisp daemon."
:group 'org)
(defcustom opencortex-port 9105
"The port the opencortex daemon is listening on."
:type 'integer
:group 'opencortex)
(defcustom opencortex-host "127.0.0.1"
"The host the opencortex daemon is running on."
:type 'string
:group 'opencortex)
(defcustom opencortex-executable-path "opencortex-server"
"Path to the compiled opencortex-server binary.
If nil, Emacs will not attempt to start the daemon automatically and
will assume you have started it manually (e.g., via SBCL)."
:type '(choice (string :tag "Path to executable")
(const :tag "Manual daemon management" nil))
:group 'opencortex)
(defvar opencortex--network-process nil
"The network process connected to the daemon.")
(defvar opencortex--daemon-process nil
"The spawned daemon child process.")
(defun opencortex--start-daemon ()
"Start the daemon binary if not already running."
(when (and opencortex-executable-path
(not (process-live-p opencortex--daemon-process)))
(message "opencortex: Starting daemon (%s)..." opencortex-executable-path)
(setq opencortex--daemon-process
(make-process
:name "opencortex-daemon"
:buffer "*opencortex-daemon*"
:command (list opencortex-executable-path (number-to-string opencortex-port))
:connection-type 'pipe))
;; Give it a moment to bind to the port
(sleep-for 1.0)))
(defun opencortex-connect ()
"Connect to the opencortex daemon, starting it if necessary."
(interactive)
(when opencortex--network-process
(delete-process opencortex--network-process))
(opencortex--start-daemon)
(condition-case err
(progn
(setq opencortex--network-process
(make-network-process
:name "opencortex"
:buffer "*opencortex*"
:family 'ipv4
:host opencortex-host
:service opencortex-port
:filter #'opencortex--filter
:sentinel #'opencortex--sentinel))
(message "opencortex: Connected to daemon."))
(error
(message "opencortex: Failed to connect to daemon at %s:%s. Ensure it is running. Error: %s"
opencortex-host opencortex-port (error-message-string err)))))
(defun opencortex-disconnect ()
"Disconnect from the opencortex daemon."
(interactive)
(when opencortex--network-process
(delete-process opencortex--network-process)
(setq opencortex--network-process nil)
(message "opencortex: Disconnected from network."))
(when opencortex--daemon-process
(delete-process opencortex--daemon-process)
(setq opencortex--daemon-process nil)
(message "opencortex: Killed daemon process.")))
(defun opencortex--filter (proc string)
"Handle incoming communication protocol messages from the daemon via PROC with STRING."
(let ((buf (process-buffer proc)))
(when (buffer-live-p buf)
(with-current-buffer buf
(goto-char (point-max))
(insert string)
(opencortex--process-buffer buf proc)))))
(defun opencortex--process-buffer (buffer &optional proc)
"Process the communication protocol message BUFFER, optionally using PROC."
(with-current-buffer buffer
(goto-char (point-min))
(while (>= (buffer-size) 6)
(let* ((len-str (buffer-substring (point-min) (+ (point-min) 6)))
(msg-len (string-to-number len-str 16)))
(if (>= (buffer-size) (+ 6 msg-len))
(let* ((msg-start (+ (point-min) 6))
(msg-end (+ msg-start msg-len))
(msg-str (buffer-substring msg-start msg-end))
(plist (car (read-from-string msg-str))))
(delete-region (point-min) msg-end)
(opencortex--handle-message proc plist))
;; Message incomplete, stop loop
(goto-char (point-max))
(setq msg-len 1000000)))))) ; Break loop
(defun opencortex--plist-get (plist prop)
"Case-insensitive keyword lookup for communication protocol compatibility."
(or (plist-get plist prop)
(plist-get plist (intern (upcase (symbol-name prop))))
(plist-get plist (intern (downcase (symbol-name prop))))))
(defun opencortex--handle-message (proc plist)
"Route and execute incoming communication protocol messages from PROC using PLIST."
(let ((type (opencortex--plist-get plist :type))
(id (opencortex--plist-get plist :id))
(payload (or (opencortex--plist-get plist :payload) plist)))
(cond
((member type '(:request :REQUEST))
(opencortex--execute-request proc id payload))
((member type '(:response :RESPONSE))
(message "opencortex: Received response for ID %s" id))
((member type '(:log :LOG))
(let ((text (opencortex--plist-get payload :text))
(meta (opencortex--plist-get plist :meta)))
(opencortex--insert-to-history (concat "[reasoning" (if meta (format " (%s)" (opencortex--plist-get meta :source)) "") "] " text "\n") 'opencortex-system-face)))
(t (message "opencortex: Received unknown message type %s" type)))))
(defun opencortex--execute-request (proc id payload)
"Execute an actuator request from the daemon via PROC with ID and PAYLOAD."
(let ((action (opencortex--plist-get payload :action)))
(cond
((member action '(:eval :EVAL))
(let ((code (opencortex--plist-get payload :code)))
(condition-case err
(let ((result (eval (read code))))
(opencortex-send
`(:type :RESPONSE :id ,id :payload (:status :success :result ,(format "%s" result)))))
(error
(opencortex-send
`(:type :RESPONSE :id ,id :payload (:status :error :message ,(error-message-string err))))))))
((member action '(:message :MESSAGE))
(message "opencortex [DAEMON]: %s" (opencortex--plist-get payload :text))
(opencortex-send `(:type :RESPONSE :id ,id :payload (:status :success))))
((member action '(:insert-at-end :INSERT-AT-END))
(let ((text (opencortex--plist-get payload :text)))
(opencortex--insert-to-history (concat "\nAGENT: " text "\n\n"))
(opencortex-send `(:type :RESPONSE :id ,id :payload (:status :success)))))
((member action '(:refactor-subtree :REFACTOR-SUBTREE))
(let ((target-id (opencortex--plist-get payload :target-id))
(properties (opencortex--plist-get payload :properties)))
(condition-case err
(save-excursion
(when target-id (org-id-goto target-id))
(dolist (prop properties)
(org-set-property (car prop) (cdr prop)))
(opencortex-send `(:type :RESPONSE :id ,id :payload (:status :success))))
(error
(opencortex-send
`(:type :RESPONSE :id ,id :payload (:status :error :message ,(error-message-string err))))))))
(t
(message "opencortex: Unknown action %s" action)
(opencortex-send `(:type :RESPONSE :id ,id :payload (:status :unsupported)))))))
(defun opencortex--sentinel (proc event)
"Handle network process PROC lifecycle EVENT."
(when (string-match "finished" event)
(setq opencortex--network-process nil)
(message "opencortex: Connection lost.")))
(defun opencortex-send (plist)
"Send a Lisp PLIST to the daemon using communication protocol framing."
(let* ((msg (prin1-to-string plist))
(len (length msg))
(framed (format "%06x%s" len msg)))
(if (and opencortex--network-process (process-live-p opencortex--network-process))
(process-send-string opencortex--network-process framed)
(message "opencortex (offline): %s" framed))))
(defun opencortex--buffer-to-sexp ()
"Transform the current Org buffer into a pure Lisp AST (plist)."
(opencortex--clean-element (org-element-parse-buffer)))
(defun opencortex--clean-element (element)
"Recursively transform an Org ELEMENT into a pure Lisp plist."
(cond
((listp element)
(let* ((type (car element))
(props (nth 1 element))
(children (nthcdr 2 element))
(cleaned-props nil))
;; Filter and transform properties
(cl-loop for (key val) on props by 'cddr do
(unless (member key '(:standard-properties :parent :buffer))
(let ((json-val (cond
((stringp val) val)
((numberp val) val)
((booleanp val) val)
(t (format "%s" val)))))
(setq cleaned-props (plist-put cleaned-props key json-val)))))
;; Explicitly capture TODO state
(let ((todo (org-element-property :todo-keyword element)))
(when todo
(setq cleaned-props (plist-put cleaned-props :TODO-STATE (format "%s" todo)))))
(list :type type
:properties cleaned-props
:contents (mapcar #'opencortex--clean-element children))))
((stringp element) element)
(t (format "%s" element))))
;;; Sensors
(defun opencortex-notify-save ()
"Sensor: Notify daemon with full Semantic Perception (AST) when saved."
(when (and opencortex--network-process (derived-mode-p 'org-mode))
(opencortex-send
`(:type :EVENT
:payload (:sensor :buffer-update
:file ,(buffer-file-name)
:state :saved
:ast ,(opencortex--buffer-to-sexp))))))
(defun opencortex-notify-point ()
"Sensor: Notify daemon of the element currently at point (Incremental Perception).
This is much faster than parsing the entire buffer and allows for real-time
responsiveness to the user's cursor position."
(when (and opencortex--network-process (derived-mode-p 'org-mode))
(let ((element (org-element-at-point)))
(opencortex-send
`(:type :EVENT
:payload (:sensor :point-update
:file ,(buffer-file-name)
:element ,(opencortex--clean-element element)))))))
;;; Interaction Commands
(defun opencortex-set-model-cascade (cascade-string)
"Set the ordered list of LLM providers to use as fallbacks.
CASCADE-STRING should be a comma-separated list of keywords,
e.g., ':gemini,:openai,:ollama'."
(interactive "sEnter model cascade (e.g. :gemini,:openai): ")
(unless opencortex--network-process
(opencortex-connect))
(let ((cascade (mapcar #'intern (split-string cascade-string ","))))
(opencortex-send
`(:type :REQUEST
:id ,(truncate (float-time))
:target :system
:payload (:action :set-cascade :cascade ,cascade)))
(message "opencortex: Requesting model cascade update to %s" cascade)))
(defgroup opencortex-faces nil
"Faces for the opencortex chat interface."
:group 'opencortex)
(defface opencortex-user-face
'((((class color) (background dark)) :foreground "LightSkyBlue" :weight bold)
(((class color) (background light)) :foreground "blue" :weight bold)
(t :weight bold :underline t))
"Face for user messages in chat history."
:group 'opencortex-faces)
(defface opencortex-system-face
'((t :slant italic :foreground "gray50"))
"Face for system and reasoning logs."
:group 'opencortex-faces)
(defun opencortex-chat ()
"Modern chat interface for the opencortex kernel.
Opens a history buffer and a dedicated input area."
(interactive)
(let ((chat-buf (get-buffer-create "*opencortex-chat*"))
(input-buf (get-buffer-create "*opencortex-input*")))
;; History Buffer Setup
(with-current-buffer chat-buf
(unless (eq major-mode 'special-mode)
(special-mode)
(let ((inhibit-read-only t))
(erase-buffer)
(insert "--- opencortex History ---\n\n"))))
;; Input Buffer Setup
(with-current-buffer input-buf
(unless (eq major-mode 'org-mode)
(org-mode)
(local-set-key (kbd "C-c C-c") #'opencortex-chat-send)
(local-set-key (kbd "C-c C-k") #'opencortex-interrupt))
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max))
(insert "# Type your message and press C-c C-c to send.\n")))
;; Layout: Chat History (Top), Input Area (Bottom)
(delete-other-windows)
(switch-to-buffer chat-buf)
(let ((win (split-window-below -6))) ; 6 lines for input
(set-window-buffer win input-buf)
(select-window win))))
(defun opencortex-interrupt ()
"Interrupt the opencortex reasoning loop."
(interactive)
(unless opencortex--network-process
(opencortex-connect))
(opencortex-send
`(:type :EVENT
:payload (:sensor :interrupt)))
(message "opencortex: Interrupt signal sent."))
(defun opencortex--insert-to-history (text &optional face)
"Insert TEXT into the chat history buffer with optional FACE and scroll."
(let ((buf (get-buffer-create "*opencortex-chat*")))
(with-current-buffer buf
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-max))
(insert (if face (propertize text 'face face) text)))
;; Force scroll in all windows showing this buffer
(walk-windows
(lambda (w)
(when (eq (window-buffer w) buf)
(set-window-point w (point-max))))
nil t)))))
(defun opencortex-chat-send ()
"Send the current chat buffer content to the agent."
(interactive)
(unless opencortex--network-process
(opencortex-connect))
(let* ((text (buffer-substring-no-properties (point-min) (point-max)))
(clean-text (string-trim (replace-regexp-in-string "^#.*\n" "" text))))
(when (> (length clean-text) 0)
;; Append to history with styling
(opencortex--insert-to-history (concat "YOU: " clean-text "\n\n") 'opencortex-user-face)
;; Clear input buffer
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max))
(insert "# Type your message and press C-c C-c to send.\n"))
;; Send to daemon
(opencortex-send
`(:type :EVENT
:meta (:source :emacs)
:payload (:sensor :user-input
:text ,clean-text)))
(message "opencortex: Message sent."))))
(defun opencortex-auth-google (code)
"Submit the Google OAuth authorization CODE to the daemon."
(interactive "sEnter Google Authorization Code: ")
(unless opencortex--network-process
(opencortex-connect))
(opencortex-send
`(:type :REQUEST
:id ,(truncate (float-time))
:target :system
:payload (:action :auth-google-code :code ,code)))
(message "opencortex: Authorization code sent to daemon."))
(defun opencortex-organize-subtree ()
...
"Command: Ask the agent to organize the current Org subtree."
(interactive)
(opencortex-run-command :organize-subtree))
(defun opencortex-summarize-buffer ()
"Command: Ask the agent to summarize the current buffer."
(interactive)
(opencortex-run-command :summarize-buffer))
(defun opencortex-run-command (command-type)
"Generic runner for high-level COMMAND-TYPE."
(unless opencortex--network-process
(opencortex-connect))
(let ((ast (opencortex--buffer-to-sexp)))
(opencortex-send
`(:type :EVENT
:payload (:sensor :user-command
:command ,command-type
:file ,(buffer-file-name)
:ast ,ast)))
(message "opencortex: Requesting '%s'..." command-type)))
;;;###autoload
(define-minor-mode opencortex-mode
"Global minor mode for the opencortex Probabilistic-Deterministic kernel.
When enabled, this mode starts the Lisp daemon (if configured)
and establishes the network connection to enable proactive
Org-mode sensing."
:global t
:group 'opencortex
(if opencortex-mode
(progn
(add-hook 'after-save-hook #'opencortex-notify-save)
(add-hook 'post-command-hook #'opencortex-notify-point)
(add-hook 'kill-emacs-hook #'opencortex-disconnect)
(opencortex-connect))
(remove-hook 'after-save-hook #'opencortex-notify-save)
(remove-hook 'post-command-hook #'opencortex-notify-point)
(remove-hook 'kill-emacs-hook #'opencortex-disconnect)
(opencortex-disconnect)))
(provide 'opencortex)
;;; opencortex.el ends here

View File

@@ -1,123 +0,0 @@
(in-package :opencortex)
(defvar *probabilistic-backends* (make-hash-table :test 'equal))
(defvar *provider-cascade* nil)
(defun register-probabilistic-backend (name fn) (setf (gethash name *probabilistic-backends*) fn))
(defvar *model-selector-fn* nil "A function called with (provider context) to return a model ID.")
(defvar *consensus-enabled-p* nil "If T, ask-probabilistic queries all backends in parallel.")
(defun ask-probabilistic (prompt &key (system-prompt "You are the Probabilistic engine of a Probabilistic-Deterministic Lisp Machine.") (cascade nil) (context nil))
"Dispatches a neural request through the provider cascade or parallel consensus."
(let ((backends (cond
((and cascade (listp cascade)) cascade)
((functionp cascade) (funcall cascade context))
(t *provider-cascade*))))
(if *consensus-enabled-p*
;; PARALLEL CONSENSUS MODE
(let ((results nil)
(threads nil)
(lock (bt:make-lock)))
(dolist (backend backends)
(let ((backend-fn (gethash backend *probabilistic-backends*)))
(when backend-fn
(push (bt:make-thread
(lambda ()
(harness-log "PROBABILISTIC [Consensus]: Querying backend ~a..." backend)
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
(result (ignore-errors
(if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt)))))
(bt:with-lock-held (lock)
(push result results)))))
threads))))
;; Wait for all threads with a timeout (e.g., 30s)
(let ((start-time (get-universal-time)))
(loop while (and (< (length results) (length threads))
(< (- (get-universal-time) start-time) 30))
do (sleep 0.1)))
;; Return the list of raw results (filtering out nils or errors)
(let ((valid-results (remove-if-not #'stringp results)))
(if valid-results
(format nil "~{~a~^|CONSENSUS-SEP|~}" valid-results)
"(:type :LOG :payload (:text \"Neural Consensus Failure\"))")))
;; SEQUENTIAL CASCADE MODE
(or (dolist (backend backends)
(let ((backend-fn (gethash backend *probabilistic-backends*)))
(when backend-fn
(harness-log "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
(result (if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
(unless (or (null result)
(and (stringp result) (search ":LOG" result) (or (search "Failure" result) (search "missing" result))))
(return result))))))
"(:type :LOG :payload (:text \"Neural Cascade Failure\"))"))))
(defun think (context)
"Invokes the neural Probabilistic engine to propose a Lisp action based on context."
(let ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt))
(global-context (context-assemble-global-awareness)))
(if active-skill
(progn
(harness-log "PROBABILISTIC: Engaging skill '~a'~%" (skill-name active-skill))
(let* ((prompt-generator (skill-probabilistic-prompt active-skill))
(raw-prompt (when prompt-generator (funcall prompt-generator context)))
(full-system-prompt (concatenate 'string
"ACTUATOR IDENTITY: You are the pure Lisp actuator for the opencortex kernel.
MANDATE: Output EXACTLY ONE Common Lisp property list starting with (:type :REQUEST).
ZERO CONVERSATION: Do not explain. Do not say 'Okay'. Do not use markdown blocks.
STRICT RULE: Do not output multiple lists. Do not chain multiple requests.
DO NOT embed tool calls inside text strings.
"
global-context
"
"
tool-belt
"
IMPORTANT: To reply to the user, you MUST use:
(:type :REQUEST :target :emacs :action :insert-at-end :buffer \"*opencortex-chat*\" :text \"* <Response Text>\")
To call a tool, you MUST use:
(:type :REQUEST :target :tool :action :call :tool \"<name>\" :args (:arg1 \"val\"))
")))
(if (and raw-prompt (> (length raw-prompt) 1))
(let* ((thought (ask-probabilistic raw-prompt :system-prompt full-system-prompt :context context))
(raw-thoughts (cl-ppcre:split (cl-ppcre:quote-meta-chars "|CONSENSUS-SEP|") thought))
(suggestions nil))
(dolist (raw-thought raw-thoughts)
(harness-log "PROBABILISTIC RAW: ~a~%" raw-thought)
(let* ((cleaned-thought
(let ((match (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" raw-thought)))
(if match
(let ((regs (nth-value 1 (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" raw-thought))))
(if (and regs (> (length regs) 0)) (elt regs 0) raw-thought))
(string-trim '(#\Space #\Newline #\Tab) raw-thought))))
(suggestion (handler-case (read-from-string cleaned-thought)
(error (c)
;; EMIT ASYNCHRONOUS REPAIR STIMULUS
(list :type :EVENT :payload
(list :sensor :syntax-error
:code cleaned-thought
:error (format nil "~a" c)))))))
(harness-log "PROBABILISTIC Suggestion: ~a~%" cleaned-thought)
(when (and suggestion (listp suggestion))
(push suggestion suggestions))))
(if (and *consensus-enabled-p* suggestions)
(nreverse suggestions)
(first (nreverse suggestions))))
'(:type :LOG :payload (:text "Skill triggered (Deterministic only)")))))
nil)))
(defun distill-prompt (full-prompt successful-output)
(let ((system-instr "You are a Meta-Cognitive Prompt Architect. DISTILL into template."))
(ask-probabilistic (format nil "PROMPT: ~a~%RESULT: ~a" full-prompt successful-output) :system-prompt system-instr)))