Compare commits
14 Commits
f0d27ac9f3
...
v0.1.0
| Author | SHA1 | Date | |
|---|---|---|---|
| 321d0fa852 | |||
| 8d26d55c4f | |||
| 1f10e51309 | |||
| 2cdd8fe1a4 | |||
| b2d85ac4ae | |||
| cbd786e6b1 | |||
| 586847bd02 | |||
| 6bfc95e136 | |||
| 620267a8df | |||
| b62b7f1095 | |||
| aae6938880 | |||
| 76040c1f48 | |||
| 6c333af7aa | |||
| 60f2c152e0 |
88
.env.example
88
.env.example
@@ -1,50 +1,72 @@
|
||||
# opencortex: Neural Engine Configuration
|
||||
# Core LLM Providers
|
||||
LLAMACPP_ENDPOINT="http://localhost:8080"
|
||||
GEMINI_API_KEY="your_gemini_key_here"
|
||||
ANTHROPIC_API_KEY="your_anthropic_key_here"
|
||||
OPENAI_API_KEY="your_openai_key_here"
|
||||
GROQ_API_KEY="your_groq_key_here"
|
||||
# opencortex: Environment Configuration Template
|
||||
# Copy this to .env and fill in your values
|
||||
|
||||
# =============================================================================
|
||||
# IDENTITY
|
||||
# =============================================================================
|
||||
MEMEX_USER="YourName"
|
||||
MEMEX_ASSISTANT="AgentName"
|
||||
|
||||
# =============================================================================
|
||||
# LLM PROVIDERS (OpenRouter recommended as primary)
|
||||
# =============================================================================
|
||||
OPENROUTER_API_KEY="your_openrouter_key_here"
|
||||
OPENAI_API_KEY="your_openai_key_here"
|
||||
ANTHROPIC_API_KEY="your_anthropic_key_here"
|
||||
GROQ_API_KEY="your_groq_api_key_here"
|
||||
GEMINI_API_KEY="your_gemini_key_here"
|
||||
|
||||
# Legacy/Default (Optional)
|
||||
LLM_API_KEY="your_api_key_here"
|
||||
LLM_ENDPOINT="https://generativelanguage.googleapis.com/v1beta/models/gemini-pro:generateContent"
|
||||
# Cascade order (first available provider wins)
|
||||
PROVIDER_CASCADE="openrouter,openai,anthropic,groq,gemini-api,ollama"
|
||||
|
||||
# Communication Gateways
|
||||
# =============================================================================
|
||||
# LOCAL LLM (Ollama - runs offline)
|
||||
# =============================================================================
|
||||
OLLAMA_HOST="localhost:11434"
|
||||
|
||||
# llama.cpp backend (for local GGUF models)
|
||||
LLAMACPP_ENDPOINT="http://localhost:8080"
|
||||
|
||||
# =============================================================================
|
||||
# MESSAGING GATEWAYS (optional)
|
||||
# =============================================================================
|
||||
TELEGRAM_BOT_TOKEN="your_telegram_bot_token_here"
|
||||
SIGNAL_ACCOUNT_NUMBER="+1..."
|
||||
|
||||
# System 2: Symbolic Constraints
|
||||
SAFETY_BLOCK_SHELL=true
|
||||
GTD_ENFORCE_INTEGRITY=true
|
||||
|
||||
# Harness Protocol Daemon Configuration
|
||||
# =============================================================================
|
||||
# DAEMON CONFIGURATION
|
||||
# =============================================================================
|
||||
ORG_AGENT_DAEMON_PORT=9105
|
||||
ORG_AGENT_WEB_PORT=8080
|
||||
DAEMON_HOST="0.0.0.0"
|
||||
HEARTBEAT_INTERVAL=60
|
||||
DAEMON_SLEEP_INTERVAL=3600
|
||||
|
||||
# Outbound Communication Defaults
|
||||
DEFAULT_ACTUATOR="cli"
|
||||
SILENT_ACTUATORS="cli,system-message,emacs"
|
||||
|
||||
# Core Skill Requirements
|
||||
# A comma-separated list of skill Org files (without extension) required for boot.
|
||||
# =============================================================================
|
||||
# SECURITY
|
||||
# =============================================================================
|
||||
SAFETY_BLOCK_SHELL=true
|
||||
PROTOCOL_ENFORCE_HMAC=false
|
||||
PROTOCOL_HMAC_SECRET="change-this-to-a-secure-random-string"
|
||||
|
||||
# =============================================================================
|
||||
# BOOTSTRAP
|
||||
# =============================================================================
|
||||
MANDATORY_SKILLS="org-skill-policy,org-skill-bouncer"
|
||||
|
||||
# Context Management & Peripheral Vision
|
||||
# =============================================================================
|
||||
# CONTEXT / MEMORY
|
||||
# =============================================================================
|
||||
CONTEXT_SEMANTIC_THRESHOLD=0.75
|
||||
CONTEXT_LOG_LIMIT=20
|
||||
|
||||
# Memex Integration
|
||||
# Inside Docker, /app/ is the root for consolidated notes
|
||||
# =============================================================================
|
||||
# MEMEX STRUCTURE
|
||||
# =============================================================================
|
||||
MEMEX_DIR="$HOME/memex"
|
||||
ZETTELKASTEN_DIR="$HOME/memex/notes"
|
||||
SKILLS_DIR="skills/"
|
||||
|
||||
# PARA Structure (Consolidated)
|
||||
ZETTELKASTEN_DIR="$HOME/memex/notes"
|
||||
INBOX_DIR="$HOME/memex/inbox"
|
||||
DAILY_DIR="$HOME/memex/daily"
|
||||
PROJECTS_DIR="$HOME/memex/projects"
|
||||
@@ -52,15 +74,3 @@ AREAS_DIR="$HOME/memex/areas"
|
||||
RESOURCES_DIR="$HOME/memex/resources"
|
||||
ARCHIVES_DIR="$HOME/memex/archives"
|
||||
SYSTEM_DIR="$HOME/memex/system"
|
||||
|
||||
# Identity Configuration
|
||||
MEMEX_USER="YourName"
|
||||
MEMEX_ASSISTANT="AgentName"
|
||||
RECIPIENT_ID="+1..." # For Signal/Telegram delivery
|
||||
|
||||
# Harness Protocol Integrity & Authentication (HMAC-SHA256)
|
||||
PROTOCOL_ENFORCE_HMAC=false
|
||||
PROTOCOL_HMAC_SECRET="change-this-to-a-secure-random-string"
|
||||
|
||||
# Neural Reasoning Cascade Order (Comma-separated keywords)
|
||||
PROVIDER_CASCADE="openrouter,openai,anthropic,groq,gemini-api,ollama"
|
||||
|
||||
25
.github/ISSUE_TEMPLATE/bug_report.yml
vendored
Normal file
25
.github/ISSUE_TEMPLATE/bug_report.yml
vendored
Normal file
@@ -0,0 +1,25 @@
|
||||
name: Bug Report
|
||||
|
||||
about: Report something that is not working as expected.
|
||||
|
||||
---
|
||||
|
||||
**Describe the bug**
|
||||
A clear description of what went wrong.
|
||||
|
||||
**To Reproduce**
|
||||
Steps to reproduce the behavior:
|
||||
1. Go to '...'
|
||||
2. Run '...'
|
||||
3. See error
|
||||
|
||||
**Expected behavior**
|
||||
What you expected to happen.
|
||||
|
||||
**Environment:**
|
||||
- OS: [e.g. Debian 12, macOS 14]
|
||||
- SBCL version: [e.g. 2.4.0]
|
||||
- OpenCortex version: [e.g. v0.1.0]
|
||||
|
||||
**Additional context**
|
||||
Any other relevant information (logs, stack traces, etc.)
|
||||
22
.github/ISSUE_TEMPLATE/feature_request.yml
vendored
Normal file
22
.github/ISSUE_TEMPLATE/feature_request.yml
vendored
Normal file
@@ -0,0 +1,22 @@
|
||||
name: Feature Request
|
||||
|
||||
about: Suggest a new feature or enhancement.
|
||||
|
||||
---
|
||||
|
||||
**Describe the problem**
|
||||
What problem does this feature solve?
|
||||
|
||||
**Describe the ideal solution**
|
||||
A clear description of what you want to happen.
|
||||
|
||||
**Describe alternatives considered**
|
||||
Any alternative solutions you've considered.
|
||||
|
||||
**Additional context**
|
||||
Any other relevant context (mockups, related issues, etc.)
|
||||
|
||||
**Implementation suggestion**
|
||||
(Optional) If you have thoughts on how to implement this in pure Common Lisp + Org-mode:
|
||||
- Which skill should own this?
|
||||
- Should it be a =def-cognitive-tool=, a new skill, or an enhancement to an existing one?
|
||||
45
.github/workflows/lint.yml
vendored
Normal file
45
.github/workflows/lint.yml
vendored
Normal file
@@ -0,0 +1,45 @@
|
||||
name: Lint
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: [main]
|
||||
pull_request:
|
||||
branches: [main]
|
||||
|
||||
jobs:
|
||||
lint:
|
||||
runs-on: ubuntu-latest
|
||||
container:
|
||||
image: ubuntu:latest
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
|
||||
- name: Install dependencies
|
||||
run: |
|
||||
apt-get update && apt-get install -y --no-install-recommends \
|
||||
git emacs-nox
|
||||
|
||||
- name: Check for forbidden patterns
|
||||
run: |
|
||||
grep -r "json\." --include="*.lisp" . && \
|
||||
echo "ERROR: Found JSON usage in Lisp files" && exit 1 || \
|
||||
echo "OK: No JSON in Lisp files"
|
||||
|
||||
- name: Check literate granularity
|
||||
run: |
|
||||
find . -name "*.org" -path "./skills/*" -exec grep -L "#+begin_src lisp" {} \; | \
|
||||
grep -v "CLA\|CONTRIBUTING\|CHANGELOG" && \
|
||||
echo "WARNING: Some skills lack lisp blocks" || \
|
||||
echo "OK: All skills have lisp blocks"
|
||||
|
||||
- name: Verify .lisp files are generated
|
||||
run: |
|
||||
for f in library/gen/*.lisp; do
|
||||
org="${f%.lisp}.org"
|
||||
if [ -f "$org" ]; then
|
||||
: # generated, OK
|
||||
else
|
||||
echo "WARNING: $f has no corresponding .org source"
|
||||
fi
|
||||
done
|
||||
31
.github/workflows/release.yml
vendored
Normal file
31
.github/workflows/release.yml
vendored
Normal file
@@ -0,0 +1,31 @@
|
||||
name: Release
|
||||
|
||||
on:
|
||||
push:
|
||||
tags:
|
||||
- 'v*'
|
||||
|
||||
jobs:
|
||||
release:
|
||||
runs-on: ubuntu-latest
|
||||
permissions:
|
||||
contents: write
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
|
||||
- name: Create tarball
|
||||
run: |
|
||||
git archive --format=tar.gz --prefix=opencortex-$(git describe --tags) HEAD -o opencortex.tar.gz
|
||||
|
||||
- name: Create zipball
|
||||
run: |
|
||||
git archive --format=zip --prefix=opencortex-$(git describe --tags) HEAD -o opencortex.zip
|
||||
|
||||
- name: Upload to GitHub Release
|
||||
uses: softprops/action-gh-release@v2
|
||||
with:
|
||||
files: |
|
||||
opencortex.tar.gz
|
||||
opencortex.zip
|
||||
generate_release_notes: true
|
||||
44
.github/workflows/test.yml
vendored
Normal file
44
.github/workflows/test.yml
vendored
Normal file
@@ -0,0 +1,44 @@
|
||||
name: Tests
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: [main]
|
||||
pull_request:
|
||||
branches: [main]
|
||||
|
||||
jobs:
|
||||
test:
|
||||
runs-on: ubuntu-latest
|
||||
container:
|
||||
image: statusoftech/sbcl:2.4.0
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
|
||||
- name: Install dependencies
|
||||
run: |
|
||||
apt-get update && apt-get install -y --no-install-recommends \
|
||||
git curl openssl make automake autoconf gcc clisp python3 python3-pip
|
||||
|
||||
- name: Install Quicklisp
|
||||
run: |
|
||||
curl -L https://beta.quicklisp.org/quicklisp.lisp -o /tmp/quicklisp.lisp
|
||||
sbcl --non-interactive \
|
||||
--load /tmp/quicklisp.lisp \
|
||||
--eval '(quicklisp-quickstart:install :path "~/quicklisp/")' \
|
||||
--eval '(ql:add-to-init-file)'
|
||||
|
||||
- name: Install ASDF systems
|
||||
run: |
|
||||
sbcl --non-interactive \
|
||||
--eval '(ql:quickload :opencortex)'
|
||||
env:
|
||||
HOME: /root
|
||||
|
||||
- name: Run tests
|
||||
run: |
|
||||
sbcl --non-interactive \
|
||||
--eval '(ql:quickload :opencortex/tests)' \
|
||||
--eval '(uiop:quit 0)'
|
||||
env:
|
||||
HOME: /root
|
||||
3
.gitignore
vendored
3
.gitignore
vendored
@@ -6,6 +6,3 @@ opencortex-server
|
||||
\#*#
|
||||
opencortex-tui
|
||||
test_input.txt
|
||||
opencortex-server
|
||||
environment/logs/
|
||||
library/gen/
|
||||
|
||||
432
README.org
432
README.org
@@ -1,107 +1,407 @@
|
||||
#+TITLE: OpenCortex: The Conductor of your Life Stack
|
||||
|
||||
#+CAPTION: A neurosymbolic AI agent framework for the 100-year Memex
|
||||
#+ATTR_HTML: :width 800
|
||||
|
||||
*opencortex* is a minimalist, extensible AI agent framework designed to manage and continuously organize your personal knowledge base. It transforms a static collection of plaintext notes into a live, programmable [[https://en.wikipedia.org/wiki/Memex][Memex]]—an automated, personalized memory system where humans and AI collaborate in the exact same workspace.
|
||||
|
||||
* The Problem with Current AI Agents
|
||||
|
||||
The current ecosystem of AI agents (typically built in Python or TypeScript) is overwhelmingly built on architectural choices that prioritize rapid prototyping over long-term reliability, security, and self-modification:
|
||||
|
||||
1. *The Format Trap (Markdown & JSON):* Most agents force a painful translation layer. Humans write in Markdown, which lacks a strict Abstract Syntax Tree (AST)—a rigorous, nested representation of data that machines need to parse context reliably. Machines, in turn, output JSON, which is hostile for human thought and note-taking. The result is a fractured workspace where the agent's memory and the human's memory are fundamentally incompatible.
|
||||
2. *The Language Trap (Python & TypeScript):* Python and TypeScript are fantastic for gluing together APIs, but they are poorly suited for an agent that needs to safely read, write, and execute its own code at runtime. Their underlying structures are complex and opaque, making autonomous self-editing incredibly brittle and dangerous.
|
||||
3. *The Probabilistic Trap:* Almost all modern agents rely entirely on /probabilistic/ reasoning. We ask an AI model to guess a shell command or write a Python script, and then blindly pipe that output to a terminal. Without a rigorous, /deterministic/ layer to formally verify the model's proposals before execution, these systems are fundamentally unsafe.
|
||||
** 1. The Format Trap (Markdown & JSON)
|
||||
|
||||
Most agents force a painful translation layer. Humans write in Markdown, which lacks a strict Abstract Syntax Tree (AST)—a rigorous, nested representation of data that machines need to parse context reliably. Machines, in turn, output JSON, which is hostile for human thought and note-taking.
|
||||
|
||||
The result is a fractured workspace where the agent's memory and the human's memory are fundamentally incompatible. You cannot see what the agent sees. The agent cannot naturally work with your notes.
|
||||
|
||||
** 2. The Language Trap (Python & TypeScript)
|
||||
|
||||
Python and TypeScript are fantastic for gluing together APIs, but they are poorly suited for an agent that needs to safely read, write, and execute its own code at runtime. Their underlying structures are complex and opaque, making autonomous self-editing incredibly brittle and dangerous.
|
||||
|
||||
How do you trust an agent to modify its own Python code when Python's AST is so complex that even human programmers need IDEs to navigate it?
|
||||
|
||||
** 3. The Probabilistic Trap
|
||||
|
||||
Almost all modern agents rely entirely on /probabilistic/ reasoning. We ask an AI model to guess a shell command or write a Python script, and then blindly pipe that output to a terminal. Without a rigorous, /deterministic/ layer to formally verify the model's proposals before execution, these systems are fundamentally unsafe.
|
||||
|
||||
The model might hallucinate a command. It might output valid syntax that still does something dangerous. Without a deterministic gate, there's nothing between the guess and the terminal.
|
||||
|
||||
* The Vision: A Modern, Homoiconic Memex
|
||||
|
||||
opencortex abandons these fragile paradigms by returning to first principles and embracing two historically powerful technologies: *Org-mode* and *Common Lisp*.
|
||||
openCortex abandons these fragile paradigms by returning to first principles and embracing two historically powerful technologies: *Org-mode* and *Common Lisp*.
|
||||
|
||||
** 1. Org-mode: The Universal Language
|
||||
Instead of wrestling with Markdown parsers or hiding data in opaque databases, opencortex mandates that *Org-mode is the native AST for both humans and machines.*
|
||||
** Org-mode: The Universal Language
|
||||
|
||||
Org-mode is unique because it seamlessly brings together human-readable prose, structured metadata (properties and tags), lifecycle states (TODO/DONE), and executable code blocks into a single plain-text file. The code is the data, and the data is the interface. When the agent "remembers" a fact or schedules a task, it writes an Org headline. You read exactly what the agent reads.
|
||||
Instead of wrestling with Markdown parsers or hiding data in opaque databases, openCortex mandates that *Org-mode is the native AST for both humans and machines.*
|
||||
|
||||
** 2. Common Lisp: The Engine of Self-Modification
|
||||
There is a beautiful irony to opencortex: Lisp was invented in 1958 specifically to achieve Artificial Intelligence, and it has been waiting nearly 70 years for /this exact moment/ in computing history.
|
||||
Org-mode is unique because it seamlessly brings together:
|
||||
- Human-readable prose
|
||||
- Structured metadata (properties and tags)
|
||||
- Lifecycle states (TODO/DONE/PLAN)
|
||||
- Executable code blocks
|
||||
|
||||
Lisp possesses a unique property called *Homoiconicity*: the primary representation of the program is also a data structure (nested lists) within the language itself. Because Lisp code /is/ Lisp data, it is trivially easy for an AI to generate, manipulate, and safely evaluate new tools at runtime. This makes Lisp the ultimate, un-brittle language for a "self-writing" agent.
|
||||
...all in a single plain-text file. The code is the data, and the data is the interface. When the agent "remembers" a fact or schedules a task, it writes an Org headline. You read exactly what the agent reads.
|
||||
|
||||
** 3. The Probabilistic-Deterministic Loop
|
||||
opencortex does not let AI models touch your system directly. Instead, it splits cognition into two distinct engines:
|
||||
- *The Probabilistic Engine (Neural/Dynamic):* Provides semantic understanding and dynamic reasoning. It utilizes a **Dynamic LLM Cascade** (OpenRouter, Ollama, Anthropic) to ensure the agent always has a "brain," falling back to local models if cloud services are unavailable.
|
||||
- *The Deterministic Engine (Logic/Safety):* Intercepts LLM proposals and formally verifies them against your security rules (the "Bouncer" pattern) before execution.
|
||||
This is not a compromise—it's the design principle. The agent's memory and your memory are the same format, the same file, the same text.
|
||||
|
||||
** Common Lisp: The Engine of Self-Modification
|
||||
|
||||
There is a beautiful irony to openCortex: Lisp was invented in 1958 specifically to achieve Artificial Intelligence, and it has been waiting nearly 70 years for /this exact moment/ in computing history.
|
||||
|
||||
Lisp possesses a unique property called *Homoiconicity*: the primary representation of the program is also a data structure (nested lists) within the language itself. Because Lisp code /is/ Lisp data, it is trivially easy for an AI to generate, manipulate, and safely evaluate new tools at runtime.
|
||||
|
||||
This makes Lisp the ultimate, un-brittle language for a "self-writing" agent. The agent doesn't need an AST parser—it can simply read and write lists directly. The agent doesn't need a code generator—it can write Lisp that executes Lisp.
|
||||
|
||||
** The Probabilistic-Deterministic Loop
|
||||
|
||||
openCortex does not let AI models touch your system directly. Instead, it splits cognition into two distinct engines:
|
||||
|
||||
1. *The Probabilistic Engine (Neural/Dynamic):* Provides semantic understanding and dynamic reasoning. It utilizes a **Dynamic LLM Cascade** (OpenRouter, Ollama, Anthropic) to ensure the agent always has a "brain," falling back to local models if cloud services are unavailable.
|
||||
|
||||
2. *The Deterministic Engine (Logic/Safety):* Intercepts LLM proposals and formally verifies them against your security rules (the "Bouncer" pattern) before execution.
|
||||
|
||||
#+begin_src mermaid
|
||||
flowchart LR
|
||||
subgraph Probabilistic["Probabilistic Engine (LLM)"]
|
||||
LLM[LLM Call]
|
||||
end
|
||||
|
||||
subgraph Deterministic["Deterministic Engine (Skills)"]
|
||||
Policy[Policy Skill<br/>Constitutional invariants]
|
||||
Bouncer[Bouncer Skill<br/>Security vectors]
|
||||
Validator[Lisp Validator<br/>Structural verification]
|
||||
end
|
||||
|
||||
subgraph Actuation["Actuation"]
|
||||
Shell[Shell Actuator]
|
||||
TUI[TUI Client]
|
||||
Emacs[Emacs Gateway]
|
||||
end
|
||||
|
||||
LLM -->|Proposes action| Deterministic
|
||||
Policy -->|Checks| Bouncer
|
||||
Bouncer -->|Verifies| Validator
|
||||
Validator -->|Approves| Actuation
|
||||
Actuation -->|Feeds back| LLM
|
||||
#+end_src
|
||||
|
||||
* Architecture: Thin Harness, Fat Skills
|
||||
|
||||
To guarantee long-term stability, opencortex enforces a strict architectural boundary inspired by the "thin harness, fat skills" philosophy.
|
||||
To guarantee long-term stability, openCortex enforces a strict architectural boundary inspired by the "thin harness, fat skills" philosophy.
|
||||
|
||||
** The Minimalist Harness
|
||||
|
||||
The Lisp microkernel is a thin, unbreakable harness strictly responsible for:
|
||||
1. *The Memory:* Maintaining the live graph of your Memex in RAM.
|
||||
2. *The Unified Envelope:* A protocol-agnostic communication layer that ensures TUI, CLI, and remote gateways (Signal, Telegram) are treated as equal citizens.
|
||||
3. *The Metabolic Cycle:* Moving signals through the Perceive -> Reason -> Act pipeline.
|
||||
|
||||
| Layer | Responsibility | Examples |
|
||||
|-------|----------------|----------|
|
||||
| *Perceive* | Normalize sensory input | CLI parsing, Emacs events, heartbeats |
|
||||
| *Reason* | Bridge neural and deterministic | LLM dispatch, response parsing, skill routing |
|
||||
| *Act* | Execute approved actions | Shell commands, tool calls, UI output |
|
||||
| *Memory* | Live object store | Org-object graph, snapshots, rollback |
|
||||
|
||||
What the harness does /not/ contain:
|
||||
- Policy rules (those are skills)
|
||||
- LLM integrations (those are skills)
|
||||
- Domain-specific functionality (those are skills)
|
||||
|
||||
** Literate, Single-File Skills
|
||||
In opencortex, a Skill is simply a *single .org file* containing everything: the documentation, the AI instructions, and the deterministic Lisp code. When the system boots, it compiles these skills directly into the live Lisp image.
|
||||
|
||||
** The Anatomy: Three Data Stores
|
||||
1. *The Linguistic Substrate (The Memex):* A collection of plain-text Org-mode files on your local disk. This is the ultimate Source of Truth. Because it is plaintext, it is human-editable, version-controllable, and platform-independent. In OpenCortex, your notes, tasks, and code aren't just "data"—they are the agent's actual configuration and memory.
|
||||
2. *The Lisp Memory (RAM):* A live, homoiconic graph of Lisp objects. Upon boot, OpenCortex ingests your Memex files and transforms them into a high-performance in-memory graph.
|
||||
- *Why RAM?* Traditional databases require expensive joins and context-switching to traverse complex associations. By keeping the entire graph in RAM, OpenCortex can perform semantic traversals and logical inferences at native Lisp speeds.
|
||||
- *Homoiconicity:* Since the program (Lisp) and the data (Lisp objects) share the same structure, the agent can manipulate its own memory as easily as it manipulates its own code.
|
||||
3. *The Telemetry Store (External):* A high-volume database for sub-deterministic sensory data (system metrics, sensor logs) that the agent monitors and distills into Org-mode "insights."
|
||||
In openCortex, a Skill is simply a *single .org file* containing everything:
|
||||
- The documentation (prose explaining the skill's purpose)
|
||||
- The AI instructions (how the LLM should use this skill)
|
||||
- The deterministic code (Lisp that verifies/proposes actions)
|
||||
|
||||
** The Psychology: The 2x2 Cognitive Matrix
|
||||
| | Probabilistic (Neural/Intuitive) | Deterministic (Deterministic/Logical) |
|
||||
| Foreground (Active) | *The Interface:* Fast AI models for conversation and multimodal ingestion. | *The Steward:* Lisp engine that safely retrieves data and enforces security rules. |
|
||||
| Background (Passive) | *The Editor:* Deep AI models finding patterns while you sleep. | *The Librarian:* Lisp engine maintaining data integrity and filing notes. |
|
||||
When the system boots, it compiles these skills directly into the live Lisp image. Skills are hot-reloadable without restarting the daemon.
|
||||
|
||||
** The Physiology: Five Core Processes
|
||||
1. *Perception:* Automatically vectorizes your input and sets the "Foreground Focus."
|
||||
2. *Reasoning:* Uses Lisp-native logic to reconcile contradictions.
|
||||
3. *Distillation:* Background loop extracting concepts into permanent, evergreen notes (The Scribe).
|
||||
4. *Reflection:* Heartbeat-driven process maintaining structural health (The Gardener).
|
||||
5. *Sensation:* Monitors telemetry data and flags significant anomalies.
|
||||
#+begin_src mermaid
|
||||
flowchart TD
|
||||
subgraph Skill["Skill: policy.org"]
|
||||
Docs["Documentation<br/>'This skill enforces...'"]
|
||||
AI["AI Instructions<br/>'When the user asks about...'"]
|
||||
Code["Deterministic Code<br/>'(defun policy-check-...)'"]
|
||||
end
|
||||
|
||||
* Quick Start (The Zero-to-One Experience)
|
||||
subgraph Harness["Harness Core"]
|
||||
Package["package.lisp"]
|
||||
Loop["loop.lisp"]
|
||||
Perceive["perceive.lisp"]
|
||||
Reason["reason.lisp"]
|
||||
Act["act.lisp"]
|
||||
end
|
||||
|
||||
OpenCortex can be installed and booted with a single command:
|
||||
|
||||
#+begin_src bash
|
||||
curl -sSL https://raw.githubusercontent.com/gharbeia/opencortex/main/opencortex.sh | bash -s -- setup
|
||||
Code --> |Compiles into| Harness
|
||||
Harness --> |Runs| Pipeline
|
||||
Pipeline --> |Feeds| Skill
|
||||
#+end_src
|
||||
|
||||
After installation, start interacting immediately:
|
||||
** The Metabolic Pipeline
|
||||
|
||||
#+begin_src bash
|
||||
# Start the rich Terminal UI
|
||||
opencortex tui
|
||||
Every signal in openCortex moves through the same three-stage pipeline:
|
||||
|
||||
# Or use the raw CLI
|
||||
opencortex cli
|
||||
1. *Perceive:* Normalize raw input into a standardized Signal
|
||||
2. *Reason:* Generate a proposal via LLM, verify via skills
|
||||
3. *Act:* Execute the approved action, generate feedback
|
||||
|
||||
#+begin_src mermaid
|
||||
sequenceDiagram
|
||||
participant User
|
||||
participant Gateway
|
||||
participant Perceive
|
||||
participant Reason
|
||||
participant Act
|
||||
participant User
|
||||
|
||||
User->>Gateway: "Write a note about X"
|
||||
Gateway->>Perceive: Raw message
|
||||
Perceive->>Perceive: Normalize to Signal
|
||||
Perceive->>Reason: Signal
|
||||
Reason->>Reason: LLM generates proposal
|
||||
Reason->>Reason: Skills verify proposal
|
||||
Reason->>Act: Approved action
|
||||
Act->>Act: Execute action
|
||||
Act->>Reason: Feedback signal
|
||||
Reason->>Perceive: New signal
|
||||
Perceive->>Gateway: Response
|
||||
Gateway->>User: "Done"
|
||||
#+end_src
|
||||
|
||||
** The Skill Registry
|
||||
|
||||
Skills are discovered, sorted by dependency, and loaded at boot:
|
||||
|
||||
#+begin_src mermaid
|
||||
flowchart LR
|
||||
subgraph Discovery["Skill Discovery"]
|
||||
Scan["Scan skills/ directory"]
|
||||
Sort["Topological sort by DEPENDS_ON"]
|
||||
end
|
||||
|
||||
subgraph Loading["Skill Loading"]
|
||||
Validate["Validate syntax"]
|
||||
Jail["Jail in package namespace"]
|
||||
Register["Register in catalog"]
|
||||
end
|
||||
|
||||
Scan --> Sort --> Validate --> Jail --> Register
|
||||
#+end_src
|
||||
|
||||
* The Three Data Stores
|
||||
|
||||
openCortex maintains three distinct representations of your knowledge:
|
||||
|
||||
| Store | Format | Location | Purpose |
|
||||
|-------|--------|----------|---------|
|
||||
| *Source of Truth* | Plaintext .org files | `~/memex/` | Human-readable, version-controlled |
|
||||
| *Active Brain* | RAM (Lisp hash tables) | Memory | Fast, live, queryable |
|
||||
| *Snapshots* | Binary .snap files | `~/.opencortex/` | Crash recovery, rollback |
|
||||
|
||||
The Active Brain is built from the Source of Truth on boot and kept in sync via:
|
||||
- Buffer updates from Emacs (when you edit)
|
||||
- Heartbeat snapshots (periodic persistence)
|
||||
- Graceful shutdown saves
|
||||
|
||||
* The Evolutionary Roadmap
|
||||
|
||||
** v0.1.0: The Autonomous Foundation (Current Release)
|
||||
The initial MVP establishing a secure, auditable Lisp kernel. Features a robust metabolic pipeline, mandatory skill enforcement, and background distillation (The Scribe).
|
||||
openCortex's roadmap is designed working backwards from SOTA parity (V 1.0.0), guided by a critical analysis of four reference systems: OpenCode, Claude Code (leaked source), GBrain, and OpenClaw/Hermes. Every borrowed concept is reimplemented in pure Lisp. Every rejected pattern is documented.
|
||||
|
||||
** v0.2.0: Interactive Refinement & Self-Editing
|
||||
Elevating the user interface and granting the kernel the physical capability to edit its own source code.
|
||||
- *Autonomous Self-Editing:* Implementation of File I/O cognitive tools (`:read-file`, `:write-file`, `:replace-string`) and whitelisting `emacs` for autonomous `org-babel-tangle` operations.
|
||||
- *High-Fidelity TUI:* Transitioning to a rich, native Lisp TUI via `croatoan` with scrollable history and multi-line input.
|
||||
- *Skill Hot-Reloading:* A dedicated mechanism to safely swap compiled Lisp code into the live image without severing client connections.
|
||||
- *Automated PATH Handling:* Zero-config installation where the `opencortex` binary is automatically injected into the user's environment.
|
||||
** Non-Negotiable Identity
|
||||
- Pure Common Lisp + Org-mode. No JSON. No YAML. No external databases.
|
||||
- Single-address-space memory (Lisp hash tables in RAM — we *are* the memory).
|
||||
- "Thin harness, fat skills" — complexity lives at the edges, not the kernel.
|
||||
- One agent composed of many skills. No sub-agent topologies.
|
||||
- Plists everywhere — homoiconic communication between all components.
|
||||
|
||||
** v1.0.0: The Verified Wrapper (Next Major Target)
|
||||
Achieving feature parity with SOTA autonomous agents but with Lisp-grade mathematical security.
|
||||
- *The Tools are External:* Standard bash shell, headless browser (via Playwright), and standard file I/O.
|
||||
- *The Safety is Internal:* The Bouncer and Formal Verification gates mathematically prove actions are safe before they touch the OS.
|
||||
*** OpenCode: Borrowed / Rejected
|
||||
|
||||
** v2.0.0: The Cannibalization
|
||||
Replacing string-based tool wrappers with native Lisp data structures to eliminate LLM fragility.
|
||||
- *Cannibalizing the Browser:* Ingesting the DOM as a native Lisp AST rather than fighting with Playwright scripts.
|
||||
- *Cannibalizing the Shell:* Moving from bash execution to native OS API bindings. Emacs becomes a viewport for the live AST, not a master.
|
||||
| Feature | Decision | Rationale |
|
||||
|---------|----------|-----------|
|
||||
| Permission filtering before LLM sees tools | BORROW | Hook into =generate-tool-belt-prompt= to exclude denied tools. We have =:guard= but no pre-filter. |
|
||||
| Hook system (session start/end) | BORROW | Already designing event-orchestrator. Expose via =#+HOOK:= properties. |
|
||||
| Skills with YAML frontmatter | REJECT | Our Org-mode =:PROPERTIES:= + =#+FILETAGS= already do this. |
|
||||
|
||||
** v3.0.0: True Symbolic Determinism
|
||||
The great inversion. The Lisp engine takes the wheel, and the LLM is relegated to a mere semantic translation layer for the messy outside world.
|
||||
- *Deterministic Planning:* The core reasoning engine uses formal logic and graph traversal to plan and execute workflows.
|
||||
- *Self-Correcting Syntax:* The Lisp engine catches and repairs hallucinated syntax errors without consulting the LLM.
|
||||
*** Claude Code: Borrowed / Rejected
|
||||
|
||||
| Feature | Decision | Rationale |
|
||||
|---------|----------|-----------|
|
||||
| ULTRAPLAN / structured task decomposition | BORROW (reimplement) | LLM already generates plist actions. Add task-tree skill that decomposes into Org-mode headline DAGs with terminal states. |
|
||||
| 43 integrated tools | BORROW (approach) | Start with ~3. Build more as skills. Keep =def-cognitive-tool= pattern. |
|
||||
| 4-tier permission chain (ask/allow/deny) | BORROW (concept) | Three-tier per-tool permission: ask/allow/deny stored in org-objects. |
|
||||
| Multi-agent hub-and-spoke topology | REJECT | We have one agent. Concurrency via bordeaux-threads (shared memory). Skills ARE the specialization — intra-process, not inter-process. |
|
||||
| Mailbox pattern for dangerous ops | REJECT | Jailed skill packages + Policy skill already provide isolation. Bouncer gate satisfies "worker can't self-approve". |
|
||||
|
||||
*** GBrain: Borrowed / Rejected
|
||||
|
||||
| Feature | Decision | Rationale |
|
||||
|---------|----------|-----------|
|
||||
| RESOLVER.md intent routing | BORROW (concept) | =find-triggered-skill= already does this. Enhance with multi-skill triggers for complex intents. |
|
||||
| Three search modes (keyword, hybrid, direct) | BORROW | Keep keyword + direct. Hybrid/vector via local Ollama embeddings — no external DBs. |
|
||||
| Memory segmentation (brain/agent/session) | BORROW (concept) | Extend org-object with =:scope= property: =:memex= (permanent), =:session= (ephemeral), =:project= (scoped). |
|
||||
| 20+ cron jobs for background work | BORROW (concept) | Heartbeat already does this. Enhance with Event Orchestrator's cron registry — pure Lisp. |
|
||||
| Sub-agent model routing for cost | BORROW (concept) | Our =*model-selector-fn*= already selects models. Extend to route by complexity tier. |
|
||||
| Postgres + pgvector | REJECT | Single-address-space hash tables. No external databases. |
|
||||
|
||||
*** opencortex-contrib: Integrate / Reject
|
||||
|
||||
| Skill | Decision | Rationale |
|
||||
|-------|----------|-----------|
|
||||
| self-fix + lisp-repair | INTEGRATE | Merge into =org-skill-self-edit=. Our memory has snapshot/rollback. Add =repair-file= as cognitive tool. |
|
||||
| event-orchestrator | INTEGRATE | Merge hooks + cron + routing into ONE skill. Our loop has no unified orchestration. |
|
||||
| formal-verification | INTEGRATE | =def-invariant= macro + =verify-action-formally= belong in =org-skill-policy.org= as additional checks. |
|
||||
| engineering-standards | INTEGRATE | Git-clean-p gate + "Commit Before Modify" belong in Policy. |
|
||||
| sub-agent-manager | REJECT | Redundant with BT threads. Our =defskill= pattern (trigger + probabilistic + deterministic) is intra-process specialization — same goal, zero process overhead. |
|
||||
| embedding-generator | BORROW | Ollama embeddings for semantic search — no external vector DB. |
|
||||
| playwright + web-research | DEFER | V 0.5.0. Browser automation via Python bridge. |
|
||||
|
||||
** Version Roadmap
|
||||
|
||||
*** v0.1.0: The Autonomous Foundation — CURRENT RELEASE ✅
|
||||
|
||||
The secure, auditable Lisp kernel. All core infrastructure in place.
|
||||
|
||||
| Component | Status | Notes |
|
||||
|-----------|--------|-------|
|
||||
| Perceive-Reason-Act pipeline | ✅ | 3-stage metabolic loop |
|
||||
| Skills engine with jailed loading | ✅ | defskill, topological sort, hot-reload |
|
||||
| Policy skill (6 invariants) | ✅ | Transparency, Autonomy, Bloat, Modularity, Mentorship, Sustainability |
|
||||
| Bouncer skill | ✅ | Command whitelist guard functions |
|
||||
| Memory (org-object + Merkle) | ✅ | Hash tables, snapshots, rollback |
|
||||
| Lisp validator skill | ✅ | Syntax validation before eval |
|
||||
| Scribe + Gardener skills | ✅ | Heartbeat-driven distillation + audit |
|
||||
| LLM gateway (OpenRouter + Ollama) | ✅ | Provider cascade |
|
||||
| Shell actuator | ✅ | Safe command execution |
|
||||
| Emacs bridge via Swank | ✅ | Point/buffer updates |
|
||||
| FiveAM test suite | ✅ | Memory, boot, pipeline, act, communication |
|
||||
| Credentials vault | ✅ | Encrypted storage |
|
||||
|
||||
*** v0.2.0: Self-Improvement + Local LLMs — NEXT
|
||||
|
||||
Priority: Self-editing is the foundation of all growth. Full org-mode manipulation makes the agent a true Emacs citizen.
|
||||
|
||||
| Feature | Source | Implementation |
|
||||
|---------|--------|----------------|
|
||||
| org-skill-self-edit (self-modification) | contrib self-fix + lisp-repair | Hook into =:syntax-error= events. Deterministic: auto-balance parens. Probabilistic: LLM surgical fix. Memory rollback on failure. |
|
||||
| org-skill-emacs-edit (full org manipulation) | Own need | Read org buffers, parse AST, create/update/delete headlines, set properties, manage TODO, handle links. Uses org-element. |
|
||||
| Local vector search (Ollama embeddings) | contrib embedding-generator | =generate-embeddings= via Ollama. Add =:vector= to org-object. Semantic search with cosine similarity. |
|
||||
| Tool permission tiers (ask/allow/deny) | Claude Code | Per-tool permission plist in org-object. =generate-tool-belt-prompt= filters denied tools. |
|
||||
| Skill hot-reload (=:reload-skill= tool) | Own need | Swap compiled skill files without breaking sockets. |
|
||||
|
||||
*** v0.3.0: Event Orchestration + Context Awareness
|
||||
|
||||
Priority: Unified control plane, deep project understanding before complex work.
|
||||
|
||||
| Feature | Source | Implementation |
|
||||
|---------|--------|----------------|
|
||||
| org-skill-event-orchestrator (hooks+cron+routing) | contrib event-orchestrator | Merge *hook-registry* + *cron-registry* + complexity classifier. Hooks via =#+HOOK:=. Three tiers: =:REFLEX= (no LLM), =:COGNITION= (light LLM), =:REASONING= (full LLM). |
|
||||
| org-skill-context-manager (project scoping) | contrib context-manager | Stack-based context. =push-context= / =pop-context=. Path resolution relative to current context. |
|
||||
| Memory scope segmentation | GBrain | =:scope= on org-objects: memex/session/project. Scope-aware retrieval. |
|
||||
| Model-tier routing (cost optimization) | GBrain | Heartbeat → smallest model. User input → medium. Complex reasoning → large. |
|
||||
| Slash commands (TUI ergonomics) | Own need | =M-x= style command palette. =/-= prefix. Commands defined in org-mode. |
|
||||
|
||||
*** v0.4.0: Long-Horizon Planning + Git Workflows
|
||||
|
||||
Priority: Real engineering work spans dozens of steps. Structured tracking, failure handling, course correction.
|
||||
|
||||
| Feature | Source | Implementation |
|
||||
|---------|--------|----------------|
|
||||
| org-skill-long-horizon (task tree DAG) | Claude Code ULTRAPLAN | Decompose tasks into Org-mode headline trees. Terminal states: =:done= / =:blocked= / =:stuck=. Parent summarises children. Branch pruning. |
|
||||
| org-skill-git-steward (version control) | contrib git-steward | Status, diff, commit, push, branch. Policy enforces commit-before-modify. |
|
||||
| TDD runner integration | contrib tdd-runner | FiveAM on file save. =:test-failure= events. Hook into self-fix for auto-repair. |
|
||||
| Deep Emacs integration | Own need | Full org-agenda awareness. Clock time, refile, archive. |
|
||||
|
||||
*** v0.5.0: Creator + Architect + GTD
|
||||
|
||||
Priority: Agent bootstraps itself. Creates skills autonomously, designs projects from PRDs, tracks work.
|
||||
|
||||
| Feature | Source | Implementation |
|
||||
|---------|--------|----------------|
|
||||
| org-skill-creator (autonomous skill generation) | contrib creator | LLM drafts complete skill org-file. Mandatory: syntax validation → jail-load → test → register. |
|
||||
| org-skill-architect (PRD → PROTOCOL) | contrib architect | Scan =:STATUS: FROZEN= PRDs. Generate Phase B PROTOCOL. |
|
||||
| org-skill-gtd (project tracking) | contrib gtd | Full GTD cycle. org-gtd v4.0 DAG (=:TRIGGER:=, =:BLOCKER:=). |
|
||||
| Consensus loop (multi-model agreement) | contrib consensus | Run multiple providers, compare results, detect disagreements. |
|
||||
| Web research (Playwright browsing) | contrib playwright | Headless Chromium via Python bridge. Gemini Web UI automation. |
|
||||
|
||||
*** v1.0.0: SOTA Parity
|
||||
|
||||
Feature-complete agent, competitive with commercial agents. All borrowed concepts reimplemented in pure Lisp.
|
||||
|
||||
| Area | Status | Notes |
|
||||
|------|--------|-------|
|
||||
| Self-improvement | ✅ v0.2.0 | Self-edit + lisp-repair = Claude Code self-debug parity |
|
||||
| Planning | ✅ v0.4.0 | Task tree DAGs = ULTRAPLAN equivalent |
|
||||
| Tool ecosystem | 🟡 v0.4.0 | 10+ tools (expand from 3) |
|
||||
| Context window | ✅ v0.3.0 | Semantic search + scope segmentation |
|
||||
| Safety | ✅ v0.1.0 | 6 Policy invariants + formal verification |
|
||||
| Multi-step tasks | ✅ v0.4.0 | Task trees with terminal states |
|
||||
| Code editing | ✅ v0.2.0 | Full file read/write via org manipulation |
|
||||
| Memory | 🟡 v0.2.0 | Add vector recall to org-object |
|
||||
| Emacs integration | ✅ v0.2.0 | Full org-mode control — exceeds Claude Code |
|
||||
| Autonomy | ✅ v0.1.0 | 100% local capable (Ollama) — exceeds Claude Code |
|
||||
|
||||
*** v2.0.0: Lisp Machine Emergence
|
||||
|
||||
The agent moves from "using Lisp" to "being Lisp."
|
||||
|
||||
| Feature | Implementation |
|
||||
|---------|----------------|
|
||||
| Lisp editor (Lish) | Org-mode as IDE. Org-babel for interactive evaluation. Full REPL in TUI. |
|
||||
| Shell replacement (Lish) | Lisp-based shell that speaks plists. Org-mode buffers as file system. |
|
||||
|
||||
*** v3.0.0: Neurosymbolic Maturity
|
||||
|
||||
| Feature | Implementation |
|
||||
|---------|----------------|
|
||||
| Deterministic planner | Planner as pure Lisp function. No LLM for scheduling. |
|
||||
| Self-correcting gates | Gates learn from false positives (user override patterns). |
|
||||
|
||||
*** v4.0.0: AI Stack Internalized
|
||||
|
||||
| Feature | Implementation |
|
||||
|---------|----------------|
|
||||
| Llama.cpp in Lisp | FFI binding to llama.cpp. No Python. |
|
||||
| Weights as sexps | Neural weights as Lisp data structures. |
|
||||
|
||||
*** v5.0.0: True Agency
|
||||
|
||||
| Feature | Implementation |
|
||||
|---------|----------------|
|
||||
| World models | Agent builds predictive models of user behavior, project dynamics, system state. |
|
||||
| Temporal reasoning | The agent reasons about time: scheduling, deadlines, elapsed duration. |
|
||||
| Goal persistence | Goals survive restarts. Long-term projects tracked in org-objects. |
|
||||
|
||||
** Design Principles
|
||||
|
||||
** 1. Radical Transparency
|
||||
|
||||
If you can't explain it, you can't do it. Every action must be auditable. Hidden reasoning is forbidden.
|
||||
|
||||
** 2. Autonomy First
|
||||
|
||||
Dependency on proprietary systems is debt. Prefer local, offline-capable solutions.
|
||||
|
||||
** 3. Zero Bloat
|
||||
|
||||
Complexity must be earned, not anticipated. The harness must remain minimal.
|
||||
|
||||
** 4. Modularity
|
||||
|
||||
The kernel must survive even if all skills fail. Complexity belongs at the edges.
|
||||
|
||||
** 5. Mentorship
|
||||
|
||||
Teaching is the highest form of assistance. Every action should increase capability.
|
||||
|
||||
** 6. Sustainability
|
||||
|
||||
Build for the 100-year horizon. Design for offline operation, local inference.
|
||||
|
||||
* Contributing
|
||||
|
||||
See [[file:docs/CONTRIBUTING.org][CONTRIBUTING.org]] for the Literate Granularity standard and skill creation guidelines.
|
||||
|
||||
* License
|
||||
|
||||
openCortex is released under the [[file:LICENSE][AGPLv3 license]].
|
||||
|
||||
See [[file:CLA.org][CLA.org]] for the Contributor License Agreement.
|
||||
@@ -31,7 +31,7 @@ Example Registration:
|
||||
#+end_src
|
||||
|
||||
* The Unified Envelope (Communication Protocol)
|
||||
All inter-process communication occurs via the Unified Envelope.
|
||||
All inter-process communication occurs via the Unified Envelope. Do not use legacy specific types like `:CHAT`.
|
||||
- Always use semantic types: `:REQUEST`, `:EVENT`, `:RESPONSE`, `:STATUS`, `:LOG`.
|
||||
- Include routing metadata in the `:META` block (e.g., `(:SOURCE :TUI)`).
|
||||
- Ensure generated `:REQUEST` messages include a mandatory `:TARGET` field.
|
||||
|
||||
@@ -6,46 +6,51 @@
|
||||
* Introduction
|
||||
Welcome to OpenCortex v0.1.0 (The Autonomous Foundation). OpenCortex is a neurosymbolic AI agent and a Lisp Machine operating system designed to autonomously maintain your Memex (knowledge base) and interact with you via multiple, equal-citizen interfaces.
|
||||
|
||||
* Quick Start Installation
|
||||
OpenCortex can be installed and booted with a single command:
|
||||
* Installation
|
||||
OpenCortex is bootstrapped via a single shell script.
|
||||
|
||||
#+begin_src bash
|
||||
curl -sSL https://raw.githubusercontent.com/gharbeia/opencortex/main/opencortex.sh | bash -s -- setup
|
||||
git clone ssh://git@10.10.10.201:2222/amr/opencortex.git
|
||||
cd opencortex
|
||||
./opencortex.sh setup
|
||||
#+end_src
|
||||
|
||||
This command will:
|
||||
1. Bootstrap the OpenCortex repository into \`~/.opencortex\`.
|
||||
2. Install system dependencies (SBCL, Quicklisp, etc.).
|
||||
3. Interactively guide you through the initial configuration.
|
||||
4. Tangle the literate source code.
|
||||
5. Awaken the background daemon.
|
||||
This process will install SBCL, Quicklisp, and prompt you to create a `.env` file for your API keys.
|
||||
|
||||
* Configuration
|
||||
The system is configured via a \`.env\` file in the project root. Key variables include:
|
||||
The system is configured via a `.env` file in the project root. Essential variables include:
|
||||
|
||||
- \`LLM_API_KEY\`: Your provider key (e.g., \`OPENROUTER_API_KEY\`, \`OPENAI_API_KEY\`).
|
||||
- \`PROVIDER_CASCADE\`: The fallback order for LLM providers (e.g., \`openrouter,ollama,anthropic\`).
|
||||
- \`MEMEX_DIR\`: The absolute path to your knowledge base (defaults to \`~/memex\`).
|
||||
- `OPENROUTER_API_KEY`: Your LLM provider key.
|
||||
- `PROVIDER_CASCADE`: The fallback order for LLM providers (e.g., `openrouter,ollama,anthropic`).
|
||||
- `MEMEX_DIR`: The absolute path to your knowledge base (defaults to `~/memex`).
|
||||
|
||||
* Interacting with OpenCortex
|
||||
Once the daemon is running, you can connect via any supported client.
|
||||
Because of the Unified Envelope Architecture, the kernel treats all clients as interchangeable. You must first boot the background daemon:
|
||||
|
||||
#+begin_src bash
|
||||
./opencortex.sh --boot &
|
||||
#+end_src
|
||||
|
||||
** Terminal User Interface (TUI)
|
||||
For a rich terminal experience with history and background worker status:
|
||||
For a rich, split-pane terminal experience:
|
||||
#+begin_src bash
|
||||
opencortex tui
|
||||
./opencortex.sh tui
|
||||
#+end_src
|
||||
|
||||
** Command Line Interface (CLI)
|
||||
For raw, pipe-friendly interaction:
|
||||
#+begin_src bash
|
||||
opencortex cli
|
||||
./opencortex.sh cli
|
||||
#+end_src
|
||||
|
||||
** Emacs Integration
|
||||
OpenCortex functions as your "foveal vision" inside Emacs.
|
||||
1. Ensure `org-agent.el` is loaded.
|
||||
2. Run `M-x opencortex-connect`.
|
||||
3. Interact via the `*opencortex-chat*` buffer.
|
||||
|
||||
* The Memex Structure
|
||||
OpenCortex manages a local folder structure representing your "Memex".
|
||||
- *Nodes:* Every Org-mode headline is a "node" in the agent's memory graph.
|
||||
- *Source of Truth:* Plaintext files are the definitive state.
|
||||
- *Autonomous Workers:*
|
||||
- The \`Scribe\` distills chronological logs into structured Zettelkasten notes.
|
||||
- The \`Gardener\` repairs links and flags orphaned nodes.
|
||||
OpenCortex assumes a local folder structure representing your "Memex".
|
||||
- Core memories and identities are mapped to Org-mode files.
|
||||
- The `Scribe` background worker distills chronological logs into structured Zettelkasten notes.
|
||||
- The `Gardener` continuously repairs broken links and flags orphaned nodes.
|
||||
390
harness/act.org
390
harness/act.org
@@ -5,50 +5,91 @@
|
||||
|
||||
* Stage 3: Act (act.lisp)
|
||||
|
||||
** Architectural Intent: Actuation
|
||||
The Act stage performs the final physical side-effects of the metabolic pipeline. It takes an approved **Action** (the result of the Reasoning stage) and routes it to the correct physical **Actuator**.
|
||||
** Architectural Intent: The Last Mile
|
||||
|
||||
Actuators are the "hands" of the OpenCortex. They can be local (printing to a terminal), virtual (executing a shell command), or remote (sending a Matrix message). Crucially, the core microharness does not know *how* to talk to these services; it only knows how to *dispatch* to the registered actuator functions.
|
||||
The Act stage is where cognition meets reality. After the Probabilistic engine proposes and the Deterministic engine verifies, Act executes the approved action.
|
||||
|
||||
The key insight of the Act stage is that *execution is the point of no return*. Once a command is sent to the shell or a file is written, side effects have occurred. Therefore, Act implements a "last-mile" safety check - even after skills have verified the action, there's a final validation before dispatch.
|
||||
|
||||
** Why Separate Actuators?
|
||||
|
||||
The actuator pattern decouples /what to do/ from /how to do it/:
|
||||
|
||||
- The reasoning engine generates action plists like `(:TYPE :REQUEST :TARGET :SHELL :PAYLOAD ...)`
|
||||
- The actuator interprets the target and executes appropriately
|
||||
- Adding a new actuator (Telegram, Matrix, etc.) doesn't require changing the reasoning code
|
||||
|
||||
This follows the Open/Closed principle: open for extension, closed for modification.
|
||||
|
||||
** The Feedback Loop
|
||||
|
||||
Act is unique in the pipeline because it can generate new signals. When a tool executes and returns data, that data becomes a new signal that feeds back into Perceive → Reason → Act.
|
||||
|
||||
Example feedback chain:
|
||||
1. User asks "What files changed today?"
|
||||
2. Reason generates shell command action
|
||||
3. Act executes shell, gets file list
|
||||
4. Act returns file list as feedback signal
|
||||
5. Reason processes file list, generates human-readable response
|
||||
6. Act displays response
|
||||
|
||||
* Package Context
|
||||
|
||||
** Pipeline Initialization
|
||||
#+begin_src lisp :tangle ../library/act.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
* Actuator Configuration
|
||||
|
||||
** Default Actuator
|
||||
** Actuator Registry Variables
|
||||
|
||||
#+begin_src lisp :tangle ../library/act.lisp
|
||||
(defvar *default-actuator* :cli
|
||||
"The fallback actuator used if a signal has no source or target metadata.")
|
||||
#+end_src
|
||||
"The actuator used when no explicit target is specified.
|
||||
Override with DEFAULT_ACTUATOR environment variable.")
|
||||
|
||||
** Silent Actuators
|
||||
To prevent infinite feedback loops, certain actuators are flagged as "silent." Results from these actuators are logged but do not trigger a fresh metabolic cycle.
|
||||
|
||||
#+begin_src lisp :tangle ../library/act.lisp
|
||||
(defvar *silent-actuators* '(:cli :system-message :emacs)
|
||||
"List of actuators whose feedback should not re-enter the Reasoning stage.")
|
||||
"List of actuators that don't generate tool-output feedback.
|
||||
These typically have their own feedback mechanisms (CLI prints directly, etc.)")
|
||||
#+end_src
|
||||
|
||||
** Initialization Logic (initialize-actuators)
|
||||
This function hydrates the actuator configuration from the environment and registers the core built-in actuators.
|
||||
** initialize-actuators: System Bootstrap
|
||||
|
||||
#+begin_src lisp :tangle ../library/act.lisp
|
||||
(defun initialize-actuators ()
|
||||
"Loads actuator routing defaults from environment variables and registers core harness actuators."
|
||||
"Load actuator configuration from environment and register core actuators.
|
||||
|
||||
Environment variables:
|
||||
- DEFAULT_ACTUATOR: Keyword for default target (:cli, :shell, etc.)
|
||||
- SILENT_ACTUATORS: Comma-separated list of actuators that skip feedback
|
||||
|
||||
Registers three core actuators:
|
||||
1. :system - Internal commands (eval, create-skill, message)
|
||||
2. :tool - Cognitive tool execution
|
||||
3. :tui - Terminal UI output via reply stream"
|
||||
|
||||
;; Load environment configuration
|
||||
(let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
|
||||
(silent (uiop:getenv "SILENT_ACTUATORS")))
|
||||
|
||||
;; Set default actuator
|
||||
(when def
|
||||
(setf *default-actuator* (intern (string-upcase def) "KEYWORD")))
|
||||
(setf *default-actuator*
|
||||
(intern (string-upcase def) "KEYWORD")))
|
||||
|
||||
;; Parse silent actuators list
|
||||
(when silent
|
||||
(setf *silent-actuators*
|
||||
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) "KEYWORD"))
|
||||
(mapcar (lambda (s)
|
||||
(intern (string-upcase (string-trim '(#\Space) s))
|
||||
"KEYWORD"))
|
||||
(str:split "," silent)))))
|
||||
|
||||
|
||||
;; Register core harness actuators
|
||||
(register-actuator :system #'execute-system-action)
|
||||
(register-actuator :tool #'execute-tool-action)
|
||||
|
||||
;; TUI actuator: sends response back through the reply stream
|
||||
(register-actuator :tui (lambda (action context)
|
||||
(let* ((meta (getf context :meta))
|
||||
(stream (getf meta :reply-stream)))
|
||||
@@ -57,81 +98,123 @@ This function hydrates the actuator configuration from the environment and regis
|
||||
(finish-output stream))))))
|
||||
#+end_src
|
||||
|
||||
* Primary Routing
|
||||
* Action Dispatching
|
||||
|
||||
** Dispatching Logic (dispatch-action)
|
||||
The primary router. It identifies the target actuator based on the Signal's `:META` source or the Action's `:TARGET`.
|
||||
** dispatch-action: The Router
|
||||
|
||||
#+begin_src lisp :tangle ../library/act.lisp
|
||||
(defun dispatch-action (action context)
|
||||
"Routes an approved action to its registered physical actuator."
|
||||
(let ((payload (proto-get action :payload)))
|
||||
;; Optimization: Heartbeats are system events, not actions.
|
||||
(when (eq (proto-get payload :sensor) :heartbeat)
|
||||
(return-from dispatch-action nil)))
|
||||
"Route an approved action to its registered actuator.
|
||||
|
||||
(when (and action (listp action))
|
||||
(let* ((meta (proto-get context :meta))
|
||||
(source (proto-get meta :source))
|
||||
(raw-target (or (ignore-errors (getf action :TARGET))
|
||||
(ignore-errors (getf action :target))
|
||||
source
|
||||
*default-actuator*))
|
||||
(target (intern (string-upcase (string raw-target)) :keyword))
|
||||
(actuator-fn (gethash target *actuator-registry*)))
|
||||
;; Propagation: Ensure outbound action inherits metadata
|
||||
(when (and meta (null (getf action :meta)))
|
||||
(setf (getf action :meta) meta))
|
||||
(if actuator-fn
|
||||
(funcall actuator-fn action context)
|
||||
(harness-log "ACT ERROR: No actuator for ~s (from ~s)" target raw-target)))))
|
||||
ACTION is a plist with structure:
|
||||
(:TYPE :REQUEST :TARGET :shell :PAYLOAD (...))
|
||||
|
||||
CONTEXT is the signal being processed (for metadata access)
|
||||
|
||||
The target is resolved in order of priority:
|
||||
1. Explicit :target in the action
|
||||
2. :source from the original signal's metadata
|
||||
3. *default-actuator* configuration variable
|
||||
|
||||
Returns the actuator's result (may be a feedback signal or NIL)."
|
||||
|
||||
(let ((payload (proto-get action :payload)))
|
||||
|
||||
;; Heartbeats don't generate actuation
|
||||
(when (eq (proto-get payload :sensor) :heartbeat)
|
||||
(return-from dispatch-action nil))
|
||||
|
||||
(when (and action (listp action))
|
||||
(let* ((meta (proto-get context :meta))
|
||||
(source (proto-get meta :source))
|
||||
(raw-target (or (ignore-errors (getf action :TARGET))
|
||||
(ignore-errors (getf action :target))
|
||||
source
|
||||
*default-actuator*))
|
||||
(target (intern (string-upcase (string raw-target)) :keyword))
|
||||
(actuator-fn (gethash target *actuator-registry*)))
|
||||
|
||||
;; Preserve metadata in outbound action
|
||||
(when (and meta (null (getf action :meta)))
|
||||
(setf (getf action :meta) meta))
|
||||
|
||||
;; Execute or log error
|
||||
(if actuator-fn
|
||||
(funcall actuator-fn action context)
|
||||
(harness-log "ACT ERROR: No actuator registered for '~s' (requested by ~s)"
|
||||
target raw-target))))))
|
||||
#+end_src
|
||||
|
||||
* Built-in Actuators
|
||||
* Actuator Implementations
|
||||
|
||||
** System Actuator (execute-system-action)
|
||||
Handles meta-operations like hot-loading skills or evaluating raw Lisp within the image.
|
||||
** execute-system-action: Internal Commands
|
||||
|
||||
#+begin_src lisp :tangle ../library/act.lisp
|
||||
(defun execute-system-action (action context)
|
||||
"Processes internal harness commands. (ACTUATOR)"
|
||||
"Execute internal harness commands.
|
||||
|
||||
This actuator handles meta-commands that affect the harness itself,
|
||||
rather than external side effects. Commands include:
|
||||
|
||||
- :eval - Evaluate arbitrary Lisp code (DANGEROUS, validate first!)
|
||||
- :create-skill - Write a new skill org file and reload
|
||||
- :message - Log a message to the harness log
|
||||
|
||||
These commands bypass the normal actuator system since they operate
|
||||
on the harness internals rather than external systems."
|
||||
|
||||
(declare (ignore context))
|
||||
(let* ((payload (ignore-errors (getf action :payload)))
|
||||
|
||||
(let* ((payload (ignore-errors (getf action :payload)))
|
||||
(cmd (ignore-errors (getf payload :action))))
|
||||
|
||||
(case cmd
|
||||
(:eval (let ((code (getf payload :code)))
|
||||
(eval (read-from-string code))))
|
||||
(:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content))
|
||||
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :opencortex)))
|
||||
(full-path (merge-pathnames filename skills-dir)))
|
||||
(with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out))
|
||||
(load-skill-from-org full-path)))
|
||||
(:message (harness-log "ACT [System]: ~a" (getf payload :text)))
|
||||
(t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd)))))
|
||||
;; Evaluate Lisp code - guarded by lisp-validator skill
|
||||
(:eval
|
||||
(let ((code (getf payload :code)))
|
||||
(eval (read-from-string code))))
|
||||
|
||||
;; Create and load a new skill from content
|
||||
(:create-skill
|
||||
(let* ((filename (getf payload :filename))
|
||||
(content (getf payload :content))
|
||||
(skills-dir (merge-pathnames "skills/"
|
||||
(asdf:system-source-directory :opencortex)))
|
||||
(full-path (merge-pathnames filename skills-dir)))
|
||||
(with-open-file (out full-path
|
||||
:direction :output
|
||||
:if-exists :supersede)
|
||||
(write-string content out))
|
||||
(load-skill-from-org full-path)))
|
||||
|
||||
;; Log an informational message
|
||||
(:message
|
||||
(harness-log "ACT [System]: ~a" (getf payload :text)))
|
||||
|
||||
;; Unknown command
|
||||
(t
|
||||
(harness-log "ACT ERROR [System]: Unknown command '~s'" cmd)))))
|
||||
#+end_src
|
||||
|
||||
** Tool Result Formatting (format-tool-result)
|
||||
A UI helper that distills technical LLM responses into human-readable text.
|
||||
|
||||
#+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)
|
||||
(let ((status (getf result :status))
|
||||
(content (getf result :content))
|
||||
(msg (getf result :message)))
|
||||
(cond ((and (eq status :success) content) (format nil "~a" content))
|
||||
((and (eq status :error) msg) (format nil "ERROR [~a]: ~a" tool-name msg))
|
||||
(t (format nil "TOOL [~a] RESULT: ~s" tool-name result))))
|
||||
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
|
||||
#+end_src
|
||||
|
||||
** Tool Actuator (execute-tool-action)
|
||||
The engine for physical interaction. It executes a cognitive tool and generates feedback signals for the user.
|
||||
** execute-tool-action: Cognitive Tool Execution
|
||||
|
||||
#+begin_src lisp :tangle ../library/act.lisp
|
||||
(defun execute-tool-action (action context)
|
||||
"Executes a registered cognitive tool and generates feedback signals. (ACTUATOR)"
|
||||
"Execute a registered cognitive tool.
|
||||
|
||||
Tools are registered functions with:
|
||||
- A guard function (optional, for safety checks)
|
||||
- A body function (the actual implementation)
|
||||
- Metadata (description, parameter specs)
|
||||
|
||||
This actuator:
|
||||
1. Looks up the tool by name
|
||||
2. Runs the guard function (if present)
|
||||
3. Executes the body function with parsed arguments
|
||||
4. Returns a feedback signal with the result
|
||||
|
||||
The feedback mechanism allows tool results to trigger further reasoning."
|
||||
|
||||
(let* ((payload (getf action :payload))
|
||||
(tool-name (getf payload :tool))
|
||||
(tool-args (getf payload :args))
|
||||
@@ -139,74 +222,167 @@ The engine for physical interaction. It executes a cognitive tool and generates
|
||||
(meta (getf context :meta))
|
||||
(source (getf meta :source))
|
||||
(tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
|
||||
|
||||
(if tool
|
||||
(handler-case
|
||||
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
|
||||
;; Parse arguments (handle both flat and nested plists)
|
||||
(let* ((clean-args (if (and (listp tool-args)
|
||||
(listp (car tool-args)))
|
||||
(car tool-args)
|
||||
tool-args))
|
||||
(result (funcall (cognitive-tool-body tool) clean-args)))
|
||||
(let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
|
||||
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))))
|
||||
;; UI Propagation: Send distilled text result back to the source client
|
||||
(when source
|
||||
(dispatch-action (list :TYPE :REQUEST :TARGET source
|
||||
:PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result)))
|
||||
context))
|
||||
feedback))
|
||||
|
||||
;; Format result for source
|
||||
(when source
|
||||
(dispatch-action (list :TYPE :REQUEST
|
||||
:TARGET source
|
||||
:PAYLOAD (list :ACTION :MESSAGE
|
||||
:TEXT (format-tool-result tool-name result)))
|
||||
context))
|
||||
|
||||
;; Return feedback signal for potential further processing
|
||||
(list :TYPE :EVENT
|
||||
:DEPTH (1+ depth)
|
||||
:META meta
|
||||
:PAYLOAD (list :SENSOR :tool-output
|
||||
:RESULT result
|
||||
:TOOL tool-name)))
|
||||
|
||||
;; Tool execution error
|
||||
(error (c)
|
||||
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
|
||||
:PAYLOAD (list :SENSOR :tool-error :tool tool-name :message (format nil "~a" c)))))
|
||||
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
|
||||
:PAYLOAD (list :SENSOR :tool-error :message "Tool not found")))))
|
||||
(list :TYPE :EVENT
|
||||
:DEPTH (1+ depth)
|
||||
:META meta
|
||||
:PAYLOAD (list :SENSOR :tool-error
|
||||
:TOOL tool-name
|
||||
:MESSAGE (format nil "~a" c)))))
|
||||
|
||||
;; Tool not found
|
||||
(list :TYPE :EVENT
|
||||
:DEPTH (1+ depth)
|
||||
:META meta
|
||||
:PAYLOAD (list :SENSOR :tool-error
|
||||
:MESSAGE (format nil "Tool '~a' not found" tool-name)))))
|
||||
#+end_src
|
||||
|
||||
* The Final Pipeline Stage
|
||||
** format-tool-result: Human-Readable Output
|
||||
|
||||
** Act Gate (act-gate)
|
||||
The exit point of the metabolic pipeline. It applies a last-mile safety check via the Deterministic Engine and dispatches the signal to the physical world.
|
||||
#+begin_src lisp :tangle ../library/act.lisp
|
||||
(defun format-tool-result (tool-name result)
|
||||
"Format a tool result for human-readable display.
|
||||
|
||||
Tools return either:
|
||||
- A plist: (:status :success :content \"...\") or (:status :error :message \"...\")
|
||||
- A raw value (string, number, etc.)
|
||||
|
||||
This function normalizes both formats into a consistent string presentation."
|
||||
|
||||
(if (listp result)
|
||||
(let ((status (getf result :status))
|
||||
(content (getf result :content))
|
||||
(msg (getf result :message)))
|
||||
(cond
|
||||
((and (eq status :success) content)
|
||||
(format nil "~a" content))
|
||||
((and (eq status :error) msg)
|
||||
(format nil "ERROR [~a]: ~a" tool-name msg))
|
||||
(t
|
||||
(format nil "TOOL [~a] RESULT: ~s" tool-name result))))
|
||||
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
|
||||
#+end_src
|
||||
|
||||
* The Act Gate
|
||||
|
||||
** act-gate: Final Pipeline Stage
|
||||
|
||||
#+begin_src lisp :tangle ../library/act.lisp
|
||||
(defun act-gate (signal)
|
||||
"Final Stage: Actuation and feedback generation."
|
||||
"Final stage of the metabolic pipeline: Actuation.
|
||||
|
||||
This stage has three responsibilities:
|
||||
|
||||
1. Last-mile safety check: Run deterministic gates one more time
|
||||
before execution (handles race conditions, concurrent modifications)
|
||||
|
||||
2. Actuation: Dispatch the approved action to its target actuator
|
||||
|
||||
3. Feedback generation: If the action produced results, create a
|
||||
feedback signal that feeds back into the pipeline
|
||||
|
||||
Modifies the signal:
|
||||
- :approved-action - May be modified by last-mile verification
|
||||
- :status - Set to :acted
|
||||
|
||||
Returns a feedback signal if the action produced results, otherwise NIL."
|
||||
|
||||
(let* ((approved (getf signal :approved-action))
|
||||
(type (getf signal :type))
|
||||
(meta (getf signal :meta))
|
||||
(source (getf meta :source))
|
||||
(feedback nil)
|
||||
;; context must keep internal objects for actuators to function
|
||||
(context signal))
|
||||
|
||||
;; 1. Last-Mile Safety Check (The Bouncer & Deterministic Gates)
|
||||
|
||||
;; Step 1: Last-mile deterministic verification
|
||||
;; This catches any issues that arose between reasoning and acting
|
||||
(when approved
|
||||
(let* ((original-type (getf approved :type))
|
||||
(verified (deterministic-verify approved signal)))
|
||||
(if (and (listp verified)
|
||||
|
||||
;; Check if deterministic verification blocked the action
|
||||
(if (and (listp verified)
|
||||
(member (getf verified :type) '(:LOG :EVENT :log :event))
|
||||
(not (member original-type '(:LOG :EVENT :log :event))))
|
||||
|
||||
;; Action was blocked by verification
|
||||
(progn
|
||||
(harness-log "ACT BLOCKED: Action failed last-mile deterministic check.")
|
||||
(setf (getf signal :approved-action) nil)
|
||||
(setf approved nil)
|
||||
(setf feedback verified))
|
||||
|
||||
;; Action passed verification
|
||||
(progn
|
||||
(setf (getf signal :approved-action) verified)
|
||||
(setf approved verified)))))
|
||||
|
||||
;; 2. Actuation Logic
|
||||
;; Step 2: Actuation based on signal type
|
||||
(case type
|
||||
(:REQUEST (dispatch-action signal context))
|
||||
(:LOG (dispatch-action signal context))
|
||||
(:EVENT
|
||||
;; Explicit requests go directly to dispatch
|
||||
(:REQUEST
|
||||
(dispatch-action signal context))
|
||||
|
||||
;; Log messages also dispatch
|
||||
(:LOG
|
||||
(dispatch-action signal context))
|
||||
|
||||
;; Events with approved actions dispatch to their target
|
||||
(:EVENT
|
||||
(if approved
|
||||
(let* ((target (getf approved :target))
|
||||
(result (dispatch-action approved context)))
|
||||
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
|
||||
(setf feedback result))
|
||||
((and result (not (member target *silent-actuators*)))
|
||||
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
|
||||
:payload (list :sensor :tool-output :result result :tool approved))))))
|
||||
;; Fallback: route generic stimuli back to their origin
|
||||
|
||||
;; Determine feedback based on actuator response
|
||||
(cond
|
||||
;; Actuator returned a signal - use it as feedback
|
||||
((and (listp result)
|
||||
(member (getf result :type) '(:EVENT :LOG)))
|
||||
(setf feedback result))
|
||||
|
||||
;; Non-silent actuator with result - format as tool-output
|
||||
((and result
|
||||
(not (member target *silent-actuators*)))
|
||||
(setf feedback (list :type :EVENT
|
||||
:depth (1+ (getf signal :depth 0))
|
||||
:meta meta
|
||||
:payload (list :sensor :tool-output
|
||||
:result result
|
||||
:tool approved))))))
|
||||
|
||||
;; No approved action, but have source - might be raw event
|
||||
(when source
|
||||
(dispatch-action signal context)))))
|
||||
|
||||
|
||||
;; Step 3: Update signal status
|
||||
(setf (getf signal :status) :acted)
|
||||
feedback))
|
||||
#+end_src
|
||||
#+end_src
|
||||
@@ -4,32 +4,139 @@
|
||||
#+STARTUP: content
|
||||
|
||||
* Communication Protocol (communication.lisp)
|
||||
** Architectural Intent: Secure Inter-Process Communication & Deterministic Framing
|
||||
|
||||
** Architectural Intent: Secure Inter-Process Communication
|
||||
The Communication Protocol is the bridge between the OpenCortex microharness and the outside world. To maintain the "Zero-Bloat" mandate, the protocol must be:
|
||||
1. **Lightweight:** Minimal overhead for low-latency terminal interaction.
|
||||
2. **Deterministic:** Strict S-expression framing to prevent injection attacks.
|
||||
3. **Transport-Agnostic:** Capable of running over TCP, Unix Sockets, or Standard I/O.
|
||||
The ~communication.lisp~ module defines the low-level transport and framing logic for OpenCortex stimuli.
|
||||
|
||||
By utilizing a length-prefixed S-expression format (the "Unified Envelope"), we ensure that both human-readable text and complex Lisp data structures can be transmitted securely without the fragility of JSON or the overhead of Protobuf.
|
||||
* Implementation (communication.lisp)
|
||||
|
||||
** Pipeline Initialization
|
||||
#+begin_src lisp :tangle ../library/communication.lisp
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(in-package :opencortex)
|
||||
|
||||
(defun proto-get (plist key)
|
||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
||||
(let* ((s (string key))
|
||||
(up (intern (string-upcase s) :keyword))
|
||||
(dn (intern (string-downcase s) :keyword)))
|
||||
(or (getf plist up) (getf plist dn))))
|
||||
#+end_src
|
||||
|
||||
* Message Framing
|
||||
#+begin_src lisp :tangle ../library/communication.lisp
|
||||
(in-package :opencortex)
|
||||
|
||||
** Frame Serialization (frame-message)
|
||||
Every message leaving the harness must be "framed." This involves two steps:
|
||||
1. *Sanitization:* Stripping raw Lisp objects (like streams or sockets) that cannot be serialized.
|
||||
2. *Prefixed Framing:* Calculating the length of the S-expression and prepending it as a 6-character hexadecimal string.
|
||||
(defvar *actuator-registry* (make-hash-table :test 'equalp)
|
||||
"Global registry mapping target keywords to their physical actuator functions.")
|
||||
|
||||
Example Frame: ~00001c(:TYPE :STATUS :SCRIBE :IDLE)~
|
||||
(defun register-actuator (name fn)
|
||||
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
|
||||
(let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword))))
|
||||
(setf (gethash key *actuator-registry*) fn)))
|
||||
|
||||
(defun frame-message (msg-plist)
|
||||
"Frames a Lisp plist with a 6-character hex length and a newline for stream integrity."
|
||||
(let* ((*print-pretty* nil)
|
||||
(*print-circle* nil)
|
||||
(msg-string (format nil "~s" msg-plist))
|
||||
(len (length msg-string)))
|
||||
(format nil "~6,'0x~a~%" len msg-string)))
|
||||
|
||||
(defun read-framed-message (stream)
|
||||
"Reads a hex-length prefixed S-expression from the stream securely. Skips leading whitespace."
|
||||
(let ((length-buffer (make-string 6)))
|
||||
(handler-case
|
||||
(progn
|
||||
;; 1. Skip leading whitespace (newlines, spaces, etc.)
|
||||
(loop for char = (peek-char nil stream nil :eof)
|
||||
while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
|
||||
do (read-char stream))
|
||||
|
||||
;; 2. Read the 6-char hex length
|
||||
(let ((count (read-sequence length-buffer stream)))
|
||||
(cond ((< count 6) :eof)
|
||||
(t (let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
|
||||
(if (not len)
|
||||
(progn
|
||||
(harness-log "PROTOCOL ERROR: Invalid header ~s. Attempting resync..." length-buffer)
|
||||
:error)
|
||||
(let ((msg-buffer (make-string len)))
|
||||
(read-sequence msg-buffer stream)
|
||||
(let ((*read-eval* nil)
|
||||
(*print-pretty* nil))
|
||||
(handler-case
|
||||
(let ((msg (read-from-string msg-buffer)))
|
||||
(validate-communication-protocol-schema msg)
|
||||
msg)
|
||||
(error (c)
|
||||
(harness-log "PROTOCOL PARSE ERROR: ~a in ~s" c msg-buffer)
|
||||
:error))))))))))
|
||||
(error (c)
|
||||
(harness-log "PROTOCOL READ ERROR: ~a" c)
|
||||
:error))))
|
||||
|
||||
(defun make-hello-message (version)
|
||||
"Constructs the standard HELLO handshake message."
|
||||
(list :TYPE :EVENT
|
||||
:PAYLOAD (list :ACTION :handshake
|
||||
:VERSION version
|
||||
:CAPABILITIES '(:AUTH :SWANK :ORG-AST))))
|
||||
#+end_src
|
||||
|
||||
** 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 ../library/communication-validator.lisp
|
||||
(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))
|
||||
(progn (harness-log "REJECTED MSG: ~s" msg) (error "Communication Protocol Schema Error: Invalid message type '~a'" type)))
|
||||
|
||||
(case type
|
||||
(:REQUEST
|
||||
;; Allow missing :target if :source is present in :meta, since reason-gate
|
||||
;; will infer :target from :source downstream. This preserves "equality of
|
||||
;; clients" — gateways need not duplicate routing logic.
|
||||
(let ((target (proto-get msg :target))
|
||||
(source (proto-get (proto-get msg :meta) :source)))
|
||||
(unless (or target source)
|
||||
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target and no :source in :meta to infer it"))
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
** Message Framing (communication.lisp)
|
||||
Frames a message with a hex length prefix and ensures all data is serializable.
|
||||
|
||||
#+begin_src lisp :tangle ../library/communication.lisp
|
||||
(defun sanitize-protocol-message (msg)
|
||||
"Recursively strips non-serializable objects (streams, sockets) from a protocol plist."
|
||||
"Recursively strips non-serializable objects from a protocol plist."
|
||||
(if (and msg (listp msg))
|
||||
(let ((clean nil))
|
||||
(loop for (k v) on msg by #'cddr
|
||||
@@ -38,9 +145,7 @@ Example Frame: ~00001c(:TYPE :STATUS :SCRIBE :IDLE)~
|
||||
(push (if (listp v) (sanitize-protocol-message v) v) clean)))
|
||||
(nreverse clean))
|
||||
msg))
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ../library/communication.lisp
|
||||
(defun frame-message (msg)
|
||||
"Serializes a message plist and prefixes it with a 6-character hex length."
|
||||
(let* ((sanitized (sanitize-protocol-message msg))
|
||||
@@ -48,44 +153,3 @@ Example Frame: ~00001c(:TYPE :STATUS :SCRIBE :IDLE)~
|
||||
(len (length payload)))
|
||||
(format nil "~6,'0x~a" len payload)))
|
||||
#+end_src
|
||||
|
||||
* Message Ingestion
|
||||
|
||||
** Framed Message Reader (read-framed-message)
|
||||
The inverse of framing. This function reads exactly the number of bytes specified by the hex-length prefix. This "byte-counted" reading is a critical security measure—it prevents buffer overflow attacks and "slowloris" type hung connections.
|
||||
|
||||
#+begin_src lisp :tangle ../library/communication.lisp
|
||||
(defun read-framed-message (stream)
|
||||
"Reads a hex-prefixed message from a stream. Returns the parsed Lisp plist or :EOF."
|
||||
(handler-case
|
||||
(let ((len-buf (make-string 6)))
|
||||
;; 1. Read the length prefix
|
||||
(let ((count (read-sequence len-buf stream)))
|
||||
(if (< count 6)
|
||||
:eof
|
||||
(let ((len (ignore-errors (parse-integer len-buf :radix 16))))
|
||||
(if (and len (> len 0))
|
||||
;; 2. Read exactly 'len' bytes
|
||||
(let ((payload-buf (make-string len)))
|
||||
(read-sequence payload-buf stream)
|
||||
(let ((*read-eval* nil))
|
||||
(read-from-string payload-buf)))
|
||||
:error)))))
|
||||
(error (c)
|
||||
(harness-log "PROTOCOL ERROR: ~a" c)
|
||||
:error)))
|
||||
#+end_src
|
||||
|
||||
* Semantic Handshakes
|
||||
|
||||
** Hello Message (make-hello-message)
|
||||
The first message sent by the daemon upon client connection. It advertises the protocol version and the agent's current capabilities.
|
||||
|
||||
#+begin_src lisp :tangle ../library/communication.lisp
|
||||
(defun make-hello-message (version)
|
||||
"Constructs the standard HELLO handshake message."
|
||||
(list :TYPE :EVENT
|
||||
:PAYLOAD (list :ACTION :handshake
|
||||
:VERSION version
|
||||
:CAPABILITIES '(:AUTH :SWANK :ORG-AST))))
|
||||
#+end_src
|
||||
|
||||
@@ -4,92 +4,259 @@
|
||||
#+STARTUP: content
|
||||
|
||||
* Peripheral Vision (context.lisp)
|
||||
** Architectural Intent: Context Optimization & The Foveal-Peripheral Hybrid
|
||||
|
||||
** Architectural Intent: Contextual Awareness
|
||||
The Context stage (often referred to as "Peripheral Vision") is responsible for assembling the situational awareness that the Probabilistic Engine needs to make informed decisions.
|
||||
A common failure mode for Large Language Models (LLMs) is the "Lost in the Middle" phenomenon, where the model's reasoning accuracy degrades as its context window becomes saturated with irrelevant data. Naive approaches to context management—such as simple character-count truncation or sliding windows—often sever the structural relationships that define an Org-mode Memex.
|
||||
|
||||
In most agent frameworks, context is provided as a massive, unstructured text dump of recent chat history. OpenCortex takes a more sophisticated approach:
|
||||
1. **Foveal Focus:** The data immediately relevant to the current task (e.g., the specific Org headline being edited).
|
||||
2. **Peripheral Awareness:** Low-resolution metadata about the rest of the Memex (e.g., list of active projects, recent system logs, current time/location).
|
||||
3. **Semantic Retrieval:** Utilizing vector embeddings to pull in semantically related nodes from the long-term memory.
|
||||
The ~opencortex~ harness implements a deterministic, tree-aware solution: the **Foveal-Peripheral Hybrid Model**.
|
||||
|
||||
By balancing these three layers, we provide the agent with a "Wide Angle" view of the user's life without overflowing the LLM's context window.
|
||||
*** 1. The Foveal Focus (High Resolution)
|
||||
When the harness prepares a prompt for the Probabilistic Engine, it identifies a "Foveal Focus"—typically the specific Org headline or task the user is currently interacting with. This node, along with its immediate children and semantically relevant neighbors, is rendered at "High Resolution," meaning its full body text, properties, and metadata are included in the prompt.
|
||||
|
||||
*** 2. The Peripheral Vision (Low Resolution)
|
||||
To maintain global awareness without bloating the context window, the rest of the Memex is rendered at "Low Resolution." The harness recursively walks the Memory and generates a skeletal outline consisting only of titles and IDs. This gives the LLM a "mental map" of the entire system, allowing it to reference other projects or skills without needing to see their full content until they are explicitly brought into focus.
|
||||
|
||||
*** 3. Deterministic Tree-Walking
|
||||
By leveraging Common Lisp's strengths in recursive tree manipulation, the harness can surgically prune the AST before it ever reaches the LLM. This ensures that the structural hierarchy of the Memex is preserved perfectly, even when the content is compressed.
|
||||
|
||||
** The Context Pipeline
|
||||
#+begin_src mermaid
|
||||
flowchart TD
|
||||
Store[(Memory)] --> Filter[Context Query Filter]
|
||||
Filter --> Identification{Identify Foveal ID}
|
||||
Identification --> Foveal[Render Focus: Full Content]
|
||||
Identification --> Peripheral[Render Outline: Titles Only]
|
||||
Foveal --> Assembly[Assemble Global Awareness String]
|
||||
Peripheral --> Assembly
|
||||
Assembly --> LLM[Probabilistic Engine Proposal]
|
||||
#+end_src
|
||||
|
||||
* Context Assembly (context.lisp)
|
||||
The ~context.lisp~ module provides the deterministic functional layer for querying the Memory and transforming its internal pointers into the precise context strings required for neural reasoning.
|
||||
|
||||
** Package Context
|
||||
We begin by ensuring we are executing within the correct isolated package namespace.
|
||||
|
||||
** Pipeline Initialization
|
||||
#+begin_src lisp :tangle ../library/context.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
* Awareness Assembly
|
||||
|
||||
** Project Awareness (context-get-active-projects)
|
||||
Identifies current active work by querying the Org Memory for nodes with the ~:PROJECT:~ tag or ~NEXT~ status.
|
||||
** 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 ../library/context.lisp
|
||||
(defun context-get-active-projects ()
|
||||
"Retrieves a list of project headlines currently marked as NEXT or in progress."
|
||||
(let ((all-projects (list-objects-with-attribute :CATEGORY "Project")))
|
||||
(loop for p in all-projects
|
||||
collect (list :id (org-object-id p)
|
||||
:title (getf (org-object-attributes p) :TITLE)))))
|
||||
#+end_src
|
||||
|
||||
** Historical Awareness (context-get-recent-completed-tasks)
|
||||
Provides short-term memory of what was recently achieved, allowing the agent to maintain continuity.
|
||||
|
||||
#+begin_src lisp :tangle ../library/context.lisp
|
||||
(defun context-get-recent-completed-tasks (&optional (limit 5))
|
||||
"Retrieves the last N tasks marked as DONE from the memory history."
|
||||
(let ((all-completed (list-objects-with-attribute :TODO "DONE")))
|
||||
(subseq (sort all-completed #'> :key #'org-object-version)
|
||||
0 (min limit (length all-completed)))))
|
||||
#+end_src
|
||||
|
||||
** Skill Awareness (context-list-all-skills)
|
||||
Allows the agent to understand its own capabilities by listing the human-readable descriptions of all loaded Literate Skills.
|
||||
|
||||
#+begin_src lisp :tangle ../library/context.lisp
|
||||
(defun context-list-all-skills ()
|
||||
"Returns a list of registered skills and their documentation."
|
||||
(defun context-query-store (&key tag todo-state type)
|
||||
"Filters the Memory based on tags, todo states, or types."
|
||||
(let ((results nil))
|
||||
(maphash (lambda (id skill)
|
||||
(push (list :id id :name (skill-name skill)) results))
|
||||
*skills-registry*)
|
||||
(maphash (lambda (id obj)
|
||||
(declare (ignore id))
|
||||
(let* ((attrs (org-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
|
||||
(when (and type (not (eq (org-object-type obj) type))) (setf match nil))
|
||||
(when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
|
||||
(when (and todo-state (not (equal state todo-state))) (setf match nil))
|
||||
(when match (push obj results))))
|
||||
*memory*)
|
||||
results))
|
||||
#+end_src
|
||||
|
||||
** System Awareness (context-get-system-logs)
|
||||
Crucial for self-debugging. Provides the agent with the internal logs so it can explain why a previous action failed or was blocked by a Bouncer.
|
||||
** 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 ../library/context.lisp
|
||||
(defun context-get-system-logs ()
|
||||
"Retrieves the in-memory circular log buffer."
|
||||
(bt:with-lock-held (*logs-lock*)
|
||||
(format nil "~{~a~%~}" (reverse *system-logs*))))
|
||||
(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"))
|
||||
(context-query-store :tag "project" :type :HEADLINE)))
|
||||
#+end_src
|
||||
|
||||
* Global Context Generation
|
||||
|
||||
** Awareness Assembly (context-assemble-global-awareness)
|
||||
This function acts as the "Contextual Conductor." It synthesizes the various awareness layers into a single, high-signal string suitable for the LLM system prompt.
|
||||
** 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 ../library/context.lisp
|
||||
(defun context-assemble-global-awareness ()
|
||||
"Assembles the full context block for a neural request."
|
||||
(let ((projects (context-get-active-projects))
|
||||
(time (multiple-value-bind (s m h d mo y) (get-decoded-time) (format nil "~a-~a-~a ~a:~a:~a" y mo d h m s))))
|
||||
(format nil "CURRENT_TIME: ~a. ACTIVE_PROJECTS: ~s. FOVEAL_FOCUS: ~a"
|
||||
time
|
||||
projects
|
||||
(or *foveal-focus-id* "None"))))
|
||||
(defun context-get-recent-completed-tasks ()
|
||||
"Retrieves recently finished tasks from the store."
|
||||
(context-query-store :todo-state "DONE" :type :HEADLINE))
|
||||
#+end_src
|
||||
|
||||
** Semantic Context Query (context-query-store)
|
||||
A hook for future vector-based retrieval. In the MVP, it performs a simple keyword search over the Memory graph.
|
||||
** 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 ../library/context.lisp
|
||||
(defun context-query-store (query &key (limit 5))
|
||||
"Placeholder for semantic/vector search over the Memex."
|
||||
(declare (ignore query limit))
|
||||
nil)
|
||||
(defun context-list-all-skills ()
|
||||
"Provides a sorted overview of currently loaded system capabilities."
|
||||
(let ((results nil))
|
||||
(maphash (lambda (name skill)
|
||||
(declare (ignore name))
|
||||
(push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
|
||||
*skills-registry*)
|
||||
(sort results #'> :key (lambda (x) (getf x :priority)))))
|
||||
#+end_src
|
||||
|
||||
** 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 ../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))
|
||||
(skills-dir-str (or (uiop:getenv "SKILLS_DIR") (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
|
||||
(skills-dir (uiop:ensure-directory-pathname (context-resolve-path skills-dir-str)))
|
||||
(full-path (merge-pathnames filename skills-dir)))
|
||||
(if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
|
||||
#+end_src
|
||||
|
||||
** 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 ../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)))
|
||||
(bt:with-lock-held (*logs-lock*)
|
||||
(let ((count (min log-limit (length *system-logs*))))
|
||||
(subseq *system-logs* 0 count)))))
|
||||
#+end_src
|
||||
|
||||
** AST to Org Rendering (context-render-to-org)
|
||||
This is the core engine of the Foveal-Peripheral model. It recursively transforms the internal ~org-object~ graph back into an Org-mode string.
|
||||
|
||||
It implements the following deterministic logic:
|
||||
1. **Depth 1 & 2:** Always rendered (High-level mental map).
|
||||
2. **Foveal Node:** Rendered with full body content.
|
||||
3. **Semantic Neighbors:** Rendered with full content if their similarity score exceeds the threshold.
|
||||
4. **Peripheral Nodes:** Rendered as skeletal headlines (titles and IDs only).
|
||||
|
||||
The semantic threshold is externalized to `CONTEXT_SEMANTIC_THRESHOLD`.
|
||||
|
||||
#+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))
|
||||
(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))
|
||||
(threshold (or semantic-threshold (ignore-errors (read-from-string (uiop:getenv "CONTEXT_SEMANTIC_THRESHOLD"))) 0.75))
|
||||
(similarity (if (and foveal-vector obj-vector (not is-foveal))
|
||||
(cosine-similarity foveal-vector obj-vector)
|
||||
0.0))
|
||||
(is-semantically-relevant (>= similarity 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 is-semantically-relevant
|
||||
(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 threshold
|
||||
:foveal-vector foveal-vector))))))))
|
||||
output))
|
||||
#+end_src
|
||||
|
||||
** 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 ../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)
|
||||
(string-trim '(#\" #\' #\Space) path-string)
|
||||
path-string)))
|
||||
(if (and (stringp path) (search "$" path))
|
||||
(let ((result path))
|
||||
(ppcre:do-register-groups (var-name) ("\\$([A-Za-z0-9_]+)" path)
|
||||
(let ((var-val (uiop:getenv var-name)))
|
||||
(when var-val
|
||||
(setf result (ppcre:regex-replace (format nil "\\$~a" var-name) result var-val)))))
|
||||
result)
|
||||
path)))
|
||||
#+end_src
|
||||
|
||||
** 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 ../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)
|
||||
(ignore-errors (getf (getf signal :payload) :target-id))))
|
||||
(projects (context-get-active-projects))
|
||||
(output "GLOBAL MEMEX AWARENESS (Peripheral Vision):
|
||||
"))
|
||||
(if projects
|
||||
(dolist (project projects)
|
||||
(setf output (concatenate 'string output
|
||||
(context-render-to-org project :foveal-id foveal-id))))
|
||||
(setf output (concatenate 'string output "No active projects found.~%")))
|
||||
output))
|
||||
#+end_src
|
||||
|
||||
* Phase E: Chaos (Verification)
|
||||
Following the Engineering Standards, the peripheral vision extraction and rendering logic must be empirically verified.
|
||||
|
||||
** Test Suite Context
|
||||
#+begin_src lisp :tangle ../tests/peripheral-vision-tests.lisp
|
||||
(defpackage :opencortex-peripheral-vision-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:vision-suite))
|
||||
(in-package :opencortex-peripheral-vision-tests)
|
||||
|
||||
(def-suite vision-suite
|
||||
:description "Verification of Foveal-Peripheral context model.")
|
||||
(in-suite vision-suite)
|
||||
#+end_src
|
||||
|
||||
** Foveal Rendering Test
|
||||
Verify that the foveal target is rendered with content, while siblings are skeletal.
|
||||
|
||||
#+begin_src lisp :tangle ../tests/peripheral-vision-tests.lisp
|
||||
(test test-foveal-rendering
|
||||
"Verify that the foveal target is rendered with content, while siblings are skeletal."
|
||||
(clrhash opencortex::*memory*)
|
||||
(let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project")
|
||||
:contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
|
||||
:raw-content "FOVEAL CONTENT" :contents nil)
|
||||
(:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
|
||||
:raw-content "PERIPHERAL CONTENT" :contents nil)))))
|
||||
(ingest-ast ast)
|
||||
;; Test both foveal focus in signal top-level and in payload (legacy)
|
||||
(let ((output (context-assemble-global-awareness (list :foveal-focus "node-foveal"))))
|
||||
(is (search "FOVEAL CONTENT" output))
|
||||
(is (search "* Peripheral Node" output))
|
||||
(is (not (search "PERIPHERAL CONTENT" output))))))
|
||||
#+end_src
|
||||
|
||||
** Awareness Budget Test
|
||||
Verify that context-assemble-global-awareness handles multiple projects correctly.
|
||||
|
||||
#+begin_src lisp :tangle ../tests/peripheral-vision-tests.lisp
|
||||
(test test-awareness-budget
|
||||
"Verify that context-assemble-global-awareness handles multiple projects."
|
||||
(clrhash opencortex::*memory*)
|
||||
(ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS "project") :contents nil))
|
||||
(ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS "project") :contents nil))
|
||||
(let ((output (context-assemble-global-awareness)))
|
||||
(is (search "Project 1" output))
|
||||
(is (search "Project 2" output))))
|
||||
#+end_src
|
||||
|
||||
287
harness/loop.org
287
harness/loop.org
@@ -4,137 +4,284 @@
|
||||
#+STARTUP: content
|
||||
|
||||
* The Metabolic Loop (loop.lisp)
|
||||
** Architectural Intent
|
||||
|
||||
** Architectural Intent: The Heartbeat
|
||||
The Metabolic Loop is the high-level coordinator of the OpenCortex. It orchestrates the flow of energy (information) through the system by recursively calling the metabolic stages: Perceive, Reason, and Act.
|
||||
The Metabolic Loop is the /cranial nerve reflex/ of OpenCortex. While skills provide specialized intelligence, the loop provides the fundamental rhythm of existence: the continuous processing of signals from perception through cognition to action.
|
||||
|
||||
Inspired by biological metabolism, the loop ensures that every stimulus is processed until it reaches "stasis" (no further actions required) or an error occurs. This recursive design allows the agent to chain multiple thoughts and tool calls together into a single cohesive cognitive session.
|
||||
Unlike a simple event loop, the Metabolic Loop implements a sophisticated error recovery model. When the system encounters an error, it distinguishes between:
|
||||
|
||||
1. *Transient errors* (tool failures, network timeouts) - recoverable, no state rollback
|
||||
2. *Critical errors* (undefined functions, malformed data structures) - require memory rollback
|
||||
3. *Recursive loops* (signals generating more signals indefinitely) - depth limit enforcement
|
||||
|
||||
This design ensures the agent remains stable under adverse conditions while preserving the ability to recover from genuine system failures.
|
||||
|
||||
** Why Separate Perceive-Reason-Act?
|
||||
|
||||
The three-stage pipeline mirrors the classical sense-think-act paradigm but with a crucial difference: each stage is a pure function that transforms a signal. This allows:
|
||||
|
||||
- *Perceive* to normalize raw input into a standardized signal format
|
||||
- *Reason* to transform the perceived signal into an approved action (or reject it)
|
||||
- *Act* to execute the approved action and potentially generate a feedback signal
|
||||
|
||||
The feedback loop (Act returning a signal that feeds back into Perceive) enables complex multi-step operations where each action can trigger subsequent reasoning.
|
||||
|
||||
** Thread Safety
|
||||
|
||||
The loop operates in a multi-threaded environment:
|
||||
- The main thread runs the heartbeat and idle loop
|
||||
- Async sensors spawn threads for non-blocking I/O
|
||||
- Interrupt handling requires mutex protection to prevent race conditions
|
||||
|
||||
* Package and Thread-Safe Variables
|
||||
|
||||
** Pipeline Initialization
|
||||
#+begin_src lisp :tangle ../library/loop.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
* Concurrency and Interrupts
|
||||
|
||||
** Metabolic Interrupt Flag
|
||||
The harness must be able to stop gracefully. We use a thread-safe flag to signal the daemon to exit its primary loop.
|
||||
|
||||
#+begin_src lisp :tangle ../library/loop.lisp
|
||||
(defvar *interrupt-flag* nil
|
||||
"Thread-safe signal to halt the metabolic pipeline and daemon.")
|
||||
#+end_src
|
||||
"Atomic flag set by signal handlers to trigger graceful shutdown.
|
||||
Using a dedicated variable avoids race conditions in interrupt handling.")
|
||||
|
||||
#+begin_src lisp :tangle ../library/loop.lisp
|
||||
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock")
|
||||
"Protects the interrupt flag from concurrent access.")
|
||||
#+end_src
|
||||
"Mutex protecting *interrupt-flag* access.
|
||||
Locking is required because SBCL's interrupt handlers run in uncertain contexts.")
|
||||
|
||||
** Heartbeat Thread Reference
|
||||
#+begin_src lisp :tangle ../library/loop.lisp
|
||||
(defvar *heartbeat-thread* nil
|
||||
"Reference to the background thread driving autonomous reflection.")
|
||||
"Handle to the heartbeat thread, allowing explicit termination on shutdown.")
|
||||
#+end_src
|
||||
|
||||
* The Metabolic Pipeline
|
||||
|
||||
** Signal Processor (process-signal)
|
||||
The primary cognitive processor. It takes a normalized signal and pushes it through the gates. If a gate generates "Feedback" (e.g., a tool result), the function recursively processes that feedback as a new stimulus.
|
||||
** process-signal: The Core Engine
|
||||
|
||||
This function implements the Perceive-Reason-Act pipeline. It processes a signal through all three stages and handles the feedback loop where Actions can generate new signals.
|
||||
|
||||
The depth counter prevents infinite recursion—a signal that generates another signal that generates another, etc. By limiting to depth 10, we ensure the system eventually converges or gracefully terminates.
|
||||
|
||||
#+begin_src lisp :tangle ../library/loop.lisp
|
||||
(defun process-signal (signal)
|
||||
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
|
||||
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act.
|
||||
|
||||
SIGNAL is a property list with the following structure:
|
||||
- :type - :EVENT, :REQUEST, :RESPONSE, etc.
|
||||
- :payload - The actual content (sensor data, approved actions, etc.)
|
||||
- :meta - Metadata including source, session, reply stream
|
||||
- :depth - Recursion depth counter (starts at 0)
|
||||
- :status - Processing status (:perceived, :reasoned, :acted)
|
||||
|
||||
Returns NIL when processing is complete, or a new signal for feedback loop."
|
||||
|
||||
(let ((current-signal signal))
|
||||
(loop while current-signal do
|
||||
|
||||
;; Depth limiting prevents infinite recursion from feedback loops
|
||||
(let ((depth (getf current-signal :depth 0))
|
||||
(meta (getf current-signal :meta)))
|
||||
;; Safety: Prevent infinite cognitive recursion.
|
||||
(when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil))
|
||||
|
||||
;; Check for graceful shutdown.
|
||||
(when (> depth 10)
|
||||
(harness-log "METABOLISM ERROR: Max recursion depth reached.")
|
||||
(return nil))
|
||||
|
||||
;; Check for graceful shutdown interrupt
|
||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
||||
(harness-log "METABOLISM: Interrupted.")
|
||||
(harness-log "METABOLISM: Interrupted by shutdown signal.")
|
||||
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
|
||||
(return nil))
|
||||
|
||||
|
||||
;; The three-stage pipeline wrapped in error handling
|
||||
(handler-case
|
||||
(progn
|
||||
;; Stage 1: Ingest and Normalize
|
||||
;; Stage 1: Perceive - normalize sensory input
|
||||
(setf current-signal (perceive-gate current-signal))
|
||||
;; Stage 2: Cogitate and Verify
|
||||
|
||||
;; Stage 2: Reason - generate and verify action proposals
|
||||
(setf current-signal (reason-gate current-signal))
|
||||
;; Stage 3: Actuate and Generate Feedback
|
||||
|
||||
;; Stage 3: Act - execute approved actions
|
||||
(let ((feedback (act-gate current-signal)))
|
||||
(if feedback
|
||||
;; Action generated a feedback signal - continue processing
|
||||
(progn
|
||||
;; Inheritance: Metadata must persist across recursive cycles.
|
||||
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
|
||||
;; Preserve metadata from original signal
|
||||
(unless (getf feedback :meta)
|
||||
(setf (getf feedback :meta) meta))
|
||||
(setf current-signal feedback))
|
||||
;; No feedback - pipeline complete
|
||||
(setf current-signal nil))))
|
||||
|
||||
;; Error recovery with differentiated response
|
||||
(error (c)
|
||||
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
||||
(harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
|
||||
;; Resilience: Only rollback on critical system errors.
|
||||
|
||||
;; Only rollback memory on critical errors, not transient tool failures
|
||||
;; This prevents losing recent context due to a single bad API call
|
||||
(unless (member sensor '(:loop-error :tool-error :syntax-error))
|
||||
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
|
||||
(rollback-memory 0))
|
||||
;; If recursion is shallow, attempt to notify the user of the error.
|
||||
|
||||
;; At deep recursion or known error types, terminate gracefully
|
||||
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
|
||||
(setf current-signal nil)
|
||||
(setf current-signal (list :type :EVENT :depth (1+ depth) :meta meta
|
||||
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
|
||||
;; Otherwise, convert error to a loop-error signal for retry
|
||||
(setf current-signal
|
||||
(list :type :EVENT
|
||||
:depth (1+ depth)
|
||||
:meta meta
|
||||
:payload (list :sensor :loop-error
|
||||
:message (format nil "~a" c)
|
||||
:depth depth)))))))))))
|
||||
#+end_src
|
||||
|
||||
* Autonomous Reflection
|
||||
** The Feedback Loop Explained
|
||||
|
||||
** Heartbeat Mechanism (start-heartbeat)
|
||||
The heartbeat ensures the agent remains "alive" even in the absence of external stimuli. It allows background workers like the Scribe and Gardener to trigger periodically.
|
||||
The pipeline implements a feedback loop where Act can return a new signal:
|
||||
|
||||
1. User input arrives → Perceive normalizes it
|
||||
2. Reason generates an action → Act executes it
|
||||
3. If the action was a tool call that returned new information → Act returns a feedback signal
|
||||
4. Feedback signal feeds back into step 1 for further reasoning
|
||||
|
||||
This enables multi-step workflows where each action can trigger additional analysis.
|
||||
|
||||
* Heartbeat Mechanism
|
||||
|
||||
The heartbeat thread ensures the agent remains alive even without external input. It drives two critical functions:
|
||||
|
||||
1. **Latent reflection** - the agent can think without external prompting
|
||||
2. **Periodic maintenance** - memory auto-save, orphan detection, etc.
|
||||
|
||||
** Heartbeat Configuration Variables
|
||||
|
||||
#+begin_src lisp :tangle ../library/loop.lisp
|
||||
(defvar *auto-save-interval* 300
|
||||
"Interval in seconds between automatic memory saves.
|
||||
Defaults to 300 seconds (5 minutes). Set via MEMORY_AUTO_SAVE_INTERVAL env var.")
|
||||
|
||||
(defvar *heartbeat-save-counter* 0
|
||||
"Tracks heartbeats since last save, used to calculate auto-save timing.")
|
||||
#+end_src
|
||||
|
||||
** start-heartbeat: The Pulsing Heart
|
||||
|
||||
#+begin_src lisp :tangle ../library/loop.lisp
|
||||
(defun start-heartbeat ()
|
||||
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL (default: 60s)."
|
||||
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
|
||||
(setf *heartbeat-thread*
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(loop
|
||||
(sleep interval)
|
||||
;; Note: inject-stimulus is synchronous for heartbeats to prevent task accumulation.
|
||||
(inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
|
||||
"Starts the background heartbeat thread.
|
||||
|
||||
The heartbeat runs in a dedicated thread to avoid blocking the main
|
||||
signal processing loop. Each heartbeat:
|
||||
|
||||
1. Injects a :HEARTBEAT signal into the metabolic pipeline
|
||||
2. Checks if memory should be auto-saved (based on interval ratio)
|
||||
|
||||
Configuration via environment:
|
||||
- HEARTBEAT_INTERVAL: Seconds between heartbeats (default: 60)
|
||||
- MEMORY_AUTO_SAVE_INTERVAL: Seconds between auto-saves (default: 300)"
|
||||
|
||||
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60))
|
||||
(auto-save (or (ignore-errors (parse-integer (uiop:getenv "MEMORY_AUTO_SAVE_INTERVAL"))) *auto-save-interval*)))
|
||||
(setf *auto-save-interval* auto-save)
|
||||
(setf *heartbeat-save-counter* 0)
|
||||
|
||||
(setf *heartbeat-thread*
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(loop
|
||||
;; Wait for interval
|
||||
(sleep interval)
|
||||
|
||||
;; Update counter and check if it's time to save
|
||||
(incf *heartbeat-save-counter*)
|
||||
(when (>= *heartbeat-save-counter* (/ *auto-save-interval* interval))
|
||||
(setf *heartbeat-save-counter* 0)
|
||||
(save-memory-to-disk))
|
||||
|
||||
;; Inject heartbeat signal - this runs through the full pipeline
|
||||
;; allowing the agent to do latent reflection even with no input
|
||||
(inject-stimulus
|
||||
(list :type :EVENT
|
||||
:payload (list :sensor :heartbeat
|
||||
:unix-time (get-universal-time)))))
|
||||
|
||||
:name "opencortex-heartbeat"))))
|
||||
#+end_src
|
||||
|
||||
* Lifecycle Management
|
||||
* Main Entry Point
|
||||
|
||||
** Main Daemon Entry Point (main)
|
||||
Initializes the image, boots the gateways, and enters the primary idle loop.
|
||||
** Shutdown Configuration
|
||||
|
||||
#+begin_src lisp :tangle ../library/loop.lisp
|
||||
(defvar *shutdown-save-enabled* t
|
||||
"When T, save memory to disk on graceful shutdown.
|
||||
Disable for testing or when memory persistence is handled externally.")
|
||||
#+end_src
|
||||
|
||||
** main: System Bootstrap and Idle Loop
|
||||
|
||||
The main function orchestrates system startup:
|
||||
|
||||
1. Load environment variables from ~/.local/share/opencortex/.env
|
||||
2. Restore memory from previous snapshot (crash recovery)
|
||||
3. Initialize actuators and load all skills
|
||||
4. Start the heartbeat thread
|
||||
5. Register SIGINT handler for graceful Ctrl+C shutdown
|
||||
6. Enter idle loop (sleeping in 1-hour increments)
|
||||
|
||||
#+begin_src lisp :tangle ../library/loop.lisp
|
||||
(defun main ()
|
||||
"Primary entry point for the OpenCortex daemon."
|
||||
;; 1. Environment Hydration
|
||||
"Entry point for OpenCortex. Initializes the system and enters idle loop.
|
||||
|
||||
Startup sequence:
|
||||
1. Load environment from ~/.local/share/opencortex/.env
|
||||
2. Restore memory from disk (if snapshot exists)
|
||||
3. Initialize actuators (shell, cli, system)
|
||||
4. Load all skills from SKILLS_DIR
|
||||
5. Start heartbeat thread
|
||||
6. Register SIGINT handler for graceful shutdown
|
||||
7. Enter idle loop (sleeps in DAEMON_SLEEP_INTERVAL chunks)
|
||||
|
||||
The idle loop checks for interrupts and saves memory before exit."
|
||||
|
||||
;; Step 1: Load environment variables from standard location
|
||||
(let* ((home (uiop:getenv "HOME"))
|
||||
(env-file (uiop:merge-pathnames* ".local/share/opencortex/.env" (uiop:ensure-directory-pathname home))))
|
||||
(when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file)))
|
||||
|
||||
;; 2. System Bootstrap
|
||||
(env-file (uiop:merge-pathnames*
|
||||
".local/share/opencortex/.env"
|
||||
(uiop:ensure-directory-pathname home))))
|
||||
(when (uiop:file-exists-p env-file)
|
||||
(cl-dotenv:load-env env-file)))
|
||||
|
||||
;; Step 2: Crash recovery - load memory from previous snapshot
|
||||
(load-memory-from-disk)
|
||||
|
||||
;; Step 3-4: Initialize actuators and load skills
|
||||
(initialize-actuators)
|
||||
(initialize-all-skills)
|
||||
|
||||
;; 3. Wake up the heart.
|
||||
;; Step 5: Start the heartbeat
|
||||
(start-heartbeat)
|
||||
|
||||
;; 4. OS Signal Handling (SBCL specific)
|
||||
|
||||
;; Step 6: Register graceful shutdown handler
|
||||
;; SBCL-specific: catches Ctrl+C (SIGINT) and saves before exit
|
||||
#+sbcl
|
||||
(sb-sys:enable-interrupt sb-unix:sigint
|
||||
(lambda (sig code scp)
|
||||
(declare (ignore sig code scp))
|
||||
(harness-log "SHUTDOWN: SIGINT received. Exiting...")
|
||||
(sb-sys:enable-interrupt sb-unix:sigint
|
||||
(lambda (sig code scp)
|
||||
(declare (ignore sig code scp))
|
||||
(harness-log "SHUTDOWN: SIGINT received. Saving memory...")
|
||||
(when *shutdown-save-enabled*
|
||||
(save-memory-to-disk))
|
||||
(uiop:quit 0)))
|
||||
|
||||
;; 5. Primary Idle Loop
|
||||
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
|
||||
(loop
|
||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (return))
|
||||
;; Step 7: Idle loop - sleep in chunks, checking for interrupts
|
||||
(let ((sleep-interval (or (ignore-errors
|
||||
(parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL")))
|
||||
3600)))
|
||||
(loop
|
||||
;; Check for interrupt before each sleep cycle
|
||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
||||
(harness-log "SHUTDOWN: Interrupt flag set. Saving memory...")
|
||||
(when *shutdown-save-enabled*
|
||||
(save-memory-to-disk))
|
||||
(return))
|
||||
|
||||
;; Sleep in configured intervals (default: 1 hour)
|
||||
(sleep sleep-interval))))
|
||||
#+end_src
|
||||
#+end_src
|
||||
@@ -5,29 +5,79 @@
|
||||
|
||||
* Manifest (opencortex.asd)
|
||||
|
||||
** Architectural Intent: The ASDF Skeleton
|
||||
The ~opencortex.asd~ file is the physical blueprint of the Lisp Machine. It uses **Another System Definition Facility (ASDF)** to orchestrate the compilation, dependency resolution, and loading of all harness modules.
|
||||
** Architectural Intent: The Thin Harness Philosophy
|
||||
|
||||
In standard Common Lisp projects, dependency graphs can be complex and non-linear. However, the OpenCortex harness mandates a strict, linear bootstrap sequence.
|
||||
The ~opencortex.asd~ file is the physical blueprint of the Lisp Machine. It uses **ASDF** (Another System Definition Facility) to orchestrate compilation and loading of all harness modules.
|
||||
|
||||
*** Strict Serial Loading (:serial t)
|
||||
The harness uses the ~:serial t~ flag. This is a critical design choice that ensures every file is compiled and loaded in the exact order it appears in the ~:components~ list.
|
||||
- *Why?* This eliminates "macro-not-found" errors by guaranteeing that the ~package.lisp~ (where the core namespace is defined) and ~skills.lisp~ (where core macros are defined) are always established before any behavioral logic or dynamic skills are loaded.
|
||||
The core design principle is *Thin Harness, Fat Skills*:
|
||||
|
||||
*** Separation of Concerns
|
||||
The manifest defines three distinct systems to minimize runtime bloat and maximize portability.
|
||||
- **Harness** = The minimal, unbreakable core (protocol, signal processing, memory)
|
||||
- **Skills** = The intelligence layer (policy, validation, actuation, LLM integration)
|
||||
|
||||
This separation means:
|
||||
- The harness rarely changes (immune system)
|
||||
- Skills can be hot-loaded, modified, and swapped without touching the core
|
||||
- Bugs in skills don't crash the system
|
||||
|
||||
** Why ASDF?**
|
||||
|
||||
ASDF is the de facto standard for Common Lisp project management. It:
|
||||
1. Handles dependency resolution and loading order
|
||||
2. Compiles files in the right order (preventing "undefined function" errors)
|
||||
3. Supports system building for deployment
|
||||
4. Integrates with Quicklisp for dependency management
|
||||
|
||||
* The Build Pipeline
|
||||
|
||||
#+begin_src mermaid
|
||||
flowchart TD
|
||||
Org[Literate Org Files] -- Tangle --> Lisp[Source .lisp Files]
|
||||
Lisp --> ASDF[ASDF Manifest: .asd]
|
||||
Org[Literate Org Files] -- Org-Babel Tangle --> Lisp[Source .lisp Files]
|
||||
Lisp --> ASDF[ASDF Manifest: opencortex.asd]
|
||||
ASDF --> Loader[SBCL Compiler / Loader]
|
||||
Loader --> Image[Live Harness Image]
|
||||
Image -- Build --> Binary[Standalone Binary]
|
||||
|
||||
subgraph Skills["Skills Layer (Dynamic)"]
|
||||
S1[Policy Skill]
|
||||
S2[Bouncer Skill]
|
||||
S3[LLM Gateway]
|
||||
S4[...other skills]
|
||||
end
|
||||
|
||||
Image --> Skills
|
||||
#+end_src
|
||||
|
||||
** Core Harness System
|
||||
This system defines the "Thin Harness"—the minimalist microkernel responsible for the protocol and the metabolic loop.
|
||||
* Design Decisions
|
||||
|
||||
** Strict Serial Loading
|
||||
|
||||
The harness uses ~:serial t~ in the ASDF definition. This means:
|
||||
|
||||
1. Files are loaded in order: package → skills → communication → memory → context → perceive → reason → act → loop
|
||||
2. ~package.lisp~ is always loaded before any code that uses its symbols
|
||||
3. ~skills.lisp~ (defining macros like ~defskill~, ~def-cognitive-tool~) loads before skills
|
||||
|
||||
This eliminates "macro not found" errors that plague non-linear loading systems.
|
||||
|
||||
** Why Not Module Dependencies?**
|
||||
|
||||
Traditional ASDF uses ~:depends-on~ to declare dependencies. We use ~:serial t~ because:
|
||||
|
||||
1. *Explicit is better than implicit* - the loading order is visible in one place
|
||||
2. *Prevents circular dependencies* - skills are loaded after the harness, never before
|
||||
3. *Simpler debugging* - when something fails, the loading order is always clear
|
||||
|
||||
** Isolation of Tests
|
||||
|
||||
The testing system (~:opencortex/tests~) is separate from the production system (~:opencortex~). This means:
|
||||
|
||||
- Production deployments don't load FiveAM (saves memory, reduces attack surface)
|
||||
- Tests can be run independently: ~(ql:quickload :opencortex/tests)~
|
||||
- Test data doesn't pollute the production image
|
||||
|
||||
* System Definitions
|
||||
|
||||
** Main Harness System
|
||||
|
||||
#+begin_src lisp :tangle ../opencortex.asd
|
||||
(defsystem :opencortex
|
||||
@@ -36,51 +86,144 @@ This system defines the "Thin Harness"—the minimalist microkernel responsible
|
||||
:version "0.1.0"
|
||||
:license "AGPLv3"
|
||||
: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"))
|
||||
|
||||
:depends-on (:usocket ; TCP socket networking
|
||||
:bordeaux-threads ; Threading (heartbeat, async sensors)
|
||||
:dexador ; HTTP client (LLM APIs)
|
||||
:uiop ; Portable I/O, file operations
|
||||
:cl-dotenv ; Environment variable loading
|
||||
:cl-ppcre ; Regular expressions (parsing)
|
||||
:hunchentoot ; HTTP server (optional web interface)
|
||||
:ironclad ; Cryptography (Merkle hashing)
|
||||
:str ; String utilities
|
||||
:cl-json ; JSON parsing/serialization
|
||||
:uuid) ; UUID generation for org-mode IDs
|
||||
|
||||
:serial t ; Load files in order listed below
|
||||
|
||||
:components ((:file "library/package") ; Package definitions, core vars
|
||||
(:file "library/skills") ; Skill engine, cognitive tools
|
||||
(:file "library/communication") ; Protocol, framing, validation
|
||||
(:file "library/memory") ; Org-object store, snapshots
|
||||
(:file "library/context") ; Context assembly, query
|
||||
(:file "library/perceive") ; Stage 1: Sensory normalization
|
||||
(:file "library/reason") ; Stage 2: Neural + deterministic
|
||||
(:file "library/act") ; Stage 3: Actuation
|
||||
(:file "library/loop")) ; Main entry, heartbeat
|
||||
|
||||
:build-operation "program-op"
|
||||
:build-pathname "opencortex-server"
|
||||
:entry-point "opencortex:main")
|
||||
#+end_src
|
||||
|
||||
** Verification Suite
|
||||
The Verification Suite contains the empirical tests required by the Engineering Standards. It is isolated from the core system to ensure that production environments do not load the FiveAM framework or test data.
|
||||
** Test System
|
||||
|
||||
#+begin_src lisp :tangle ../opencortex.asd
|
||||
(defsystem :opencortex/tests
|
||||
:depends-on (:opencortex :fiveam)
|
||||
:depends-on (:opencortex ; The harness we're testing
|
||||
:fiveam) ; Testing framework
|
||||
|
||||
:components ((:file "tests/communication-tests")
|
||||
(:file "tests/pipeline-tests")
|
||||
(:file "tests/act-tests")
|
||||
(:file "tests/boot-sequence-tests")
|
||||
(:file "tests/memory-tests")
|
||||
(:file "tests/immune-system-tests"))
|
||||
:perform (test-op (o s)
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :communication-protocol-suite :opencortex-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :opencortex-pipeline-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :safety-suite :opencortex-safety-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :opencortex-boot-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :memory-suite :opencortex-memory-tests))
|
||||
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :opencortex-immune-system-tests))))
|
||||
|
||||
:perform (test-op (o s)
|
||||
(uiop:symbol-call :fiveam :run! :communication-protocol-suite)
|
||||
(uiop:symbol-call :fiveam :run! :pipeline-suite)
|
||||
(uiop:symbol-call :fiveam :run! :safety-suite)
|
||||
(uiop:symbol-call :fiveam :run! :boot-suite)
|
||||
(uiop:symbol-call :fiveam :run! :memory-suite)
|
||||
(uiop:symbol-call :fiveam :run! :immune-suite)))
|
||||
#+end_src
|
||||
|
||||
** TUI Client
|
||||
The TUI Client is a standalone consumer of the OpenCortex protocol. It uses the ~croatoan~ library for native terminal rendering.
|
||||
** TUI Client System
|
||||
|
||||
#+begin_src lisp :tangle ../opencortex.asd
|
||||
(defsystem :opencortex/tui
|
||||
:depends-on (:opencortex :croatoan :usocket :bordeaux-threads)
|
||||
:components ((:file "src/tui-client")))
|
||||
:depends-on (:opencortex ; The daemon we're connecting to
|
||||
:croatoan ; Terminal UI library
|
||||
:usocket ; Socket communication
|
||||
:bordeaux-threads) ; Background listening thread
|
||||
|
||||
:components ((:file "library/tui-client")))
|
||||
#+end_src
|
||||
|
||||
* The Harness Boundary Contract
|
||||
|
||||
** Why a Boundary Contract?
|
||||
|
||||
The harness is the immune system of OpenCortex. If it grows fat (accumulating features, dependencies, complexity), it becomes harder to:
|
||||
- Verify for security
|
||||
- Debug when things go wrong
|
||||
- Maintain across versions
|
||||
|
||||
The Boundary Contract defines what IS the harness vs. what belongs in skills.
|
||||
|
||||
** Primary Boundary Files
|
||||
|
||||
| File | Purpose | Modification |
|
||||
|------|---------|--------------|
|
||||
| ~harness/*.org~ | Literate source of truth | Only via Org edits + tangle |
|
||||
| ~opencortex.asd~ | System manifest | Only via Org edits + tangle |
|
||||
| ~library/*.lisp~ | Tangled from .org | NEVER edit directly |
|
||||
|
||||
** Generated Artifacts (NOT Primary)
|
||||
|
||||
The ~library/*.lisp~ files are tangles from the ~harness/*.org~ files. They are derivative artifacts. Direct modification violates the Literate Granularity standard.
|
||||
|
||||
** Protected Paths
|
||||
|
||||
The Policy skill guards these paths by default:
|
||||
|
||||
#+begin_src lisp
|
||||
(defvar *modularity-protected-paths*
|
||||
'("harness/"
|
||||
"opencortex.asd"
|
||||
"library/package.lisp"
|
||||
"library/communication.lisp"
|
||||
"library/memory.lisp"
|
||||
"library/context.lisp"
|
||||
"library/perceive.lisp"
|
||||
"library/reason.lisp"
|
||||
"library/act.lisp"
|
||||
"library/loop.lisp"))
|
||||
#+end_src
|
||||
|
||||
Any agent action proposing to modify these files must include a ~:modularity-justification~ field explaining why the change cannot be implemented as a skill.
|
||||
|
||||
** Enforcement Chain
|
||||
|
||||
1. *Policy Skill* (priority 500) - Checks for missing justifications
|
||||
2. *Bouncer Skill* (priority 100) - Intercepts unauthorized modifications
|
||||
3. *Git Hooks* (optional) - Prevents direct .lisp commits
|
||||
|
||||
* Quick Reference
|
||||
|
||||
** Building the System
|
||||
|
||||
#+begin_src bash
|
||||
# Development: Load source
|
||||
(ql:quickload :opencortex)
|
||||
|
||||
# Build standalone binary
|
||||
(asdf:make :opencortex)
|
||||
|
||||
# Run tests
|
||||
(ql:quickload :opencortex/tests)
|
||||
(asdf:test-system :opencortex/tests)
|
||||
#+end_src
|
||||
|
||||
** Loading Order
|
||||
|
||||
1. ~library/package.lisp~ - Creates ~:opencortex~ package
|
||||
2. ~library/skills.lisp~ - Defines ~defskill~, ~def-cognitive-tool~ macros
|
||||
3. ~library/communication.lisp~ - Protocol, framing, validation
|
||||
4. ~library/memory.lisp~ - Org-object, Merkle tree, snapshots
|
||||
5. ~library/context.lisp~ - Context assembly functions
|
||||
6. ~library/perceive.lisp~ - Stage 1: Perceive gate
|
||||
7. ~library/reason.lisp~ - Stage 2: Reason (think + verify)
|
||||
8. ~library/act.lisp~ - Stage 3: Act (dispatch + execute)
|
||||
9. ~library/loop.lisp~ - Main entry point, heartbeat
|
||||
@@ -1,61 +1,64 @@
|
||||
#+TITLE: Homoiconic Memory (memory.lisp)
|
||||
#+TITLE: The System Memory (memory.lisp)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :harness:memory:
|
||||
#+STARTUP: content
|
||||
|
||||
* Homoiconic Memory (memory.lisp)
|
||||
* The System Memory (memory.lisp)
|
||||
** Architectural Intent: The Single Address Space (Live Memory)
|
||||
|
||||
** Architectural Intent: The Live Graph
|
||||
The Memory module is the "conscious mind" of the OpenCortex. Unlike traditional agents that rely on slow, external databases (SQL or Vector), OpenCortex maintains your entire Memex as a live, homoiconic graph of Lisp objects in RAM.
|
||||
Yes, the Memory module is the cognitive bedrock of the opencortex. It is not a database; it is the agent's live, active "brain" state.
|
||||
|
||||
*** Why RAM-First?
|
||||
1. **Zero-Latency Inference:** Traversing complex associations between notes and tasks occurs at native Lisp speeds, without the overhead of context-switching to a database driver.
|
||||
2. **Unified Data Model:** Since the program (Lisp) and the data (the Memory) share the same structure, the agent can manipulate its own memory as naturally as it manipulates its own code.
|
||||
3. **Graph Sovereignty:** By keeping the graph in-process, we ensure that the user's private knowledge base never leaves the host machine unless explicitly requested by a gateway.
|
||||
Traditional architectures rely on external databases (SQLite, Vector DBs) which introduce I/O latency and structural impedance. The opencortex architecture chooses a different path: the **Single Address Space**. By treating the entire knowledge base as a graph of Lisp pointers, we achieve microsecond recollection and total structural transparency.
|
||||
|
||||
** Pipeline Initialization
|
||||
- **Pointer-Based Reasoning:** By loading the entire knowledge graph into a live Common Lisp hash table, we achieve microsecond recollection. The harness doesn't "search a file"; it traverses a memory pointer.
|
||||
- **Memory Imaging:** The ability to snapshot the Lisp image allows the agent to resume its entire cognitive state instantly, solving the "Cold Start" problem.
|
||||
- **Merkle-Tree Integrity:** Every node in the Memory is cryptographically hashed. By recursively hashing content and children, the root hash provides a single, immutable fingerprint of the entire system state.
|
||||
|
||||
** System Architecture
|
||||
#+begin_src mermaid
|
||||
flowchart TD
|
||||
subgraph LispMachine[Lisp Machine]
|
||||
H[Harness Pipeline] --> OS[(Memory)]
|
||||
S1[Skill: Architect] --> OS
|
||||
S2[Skill: Analyst] --> OS
|
||||
S3[Skill: GTD] --> OS
|
||||
H -- Pointers --> S1
|
||||
H -- Pointers --> S2
|
||||
end
|
||||
subgraph IPCSlow[External Layer]
|
||||
E[Emacs / Actuators] -. communication protocol .-> H
|
||||
end
|
||||
#+end_src
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../library/memory.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
* Core Data Structures
|
||||
|
||||
** The Object Registry
|
||||
#+begin_src lisp :tangle ../library/memory.lisp
|
||||
(defvar *memory* (make-hash-table :test 'equal)
|
||||
"The primary in-memory graph of all Org-mode entities, keyed by their unique ID.")
|
||||
#+end_src
|
||||
|
||||
** The History Store (Merkle History)
|
||||
OpenCortex maintains a history of memory states to allow for "Micro-Rollbacks" if a skill or tool execution results in an inconsistent state.
|
||||
** 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 ../library/memory.lisp
|
||||
(defvar *history-store* (make-array 0 :fill-pointer 0 :adjustable t)
|
||||
"A versioned log of the memory state, allowing for temporal traversal and rollback.")
|
||||
(defvar *memory* (make-hash-table :test 'equal))
|
||||
|
||||
(defvar *history-store* (make-hash-table :test 'equal)
|
||||
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
|
||||
#+end_src
|
||||
|
||||
** The Org-Object Definition
|
||||
Every headline, paragraph, or task in the Memex is represented as an ~org-object~.
|
||||
** The Data Structure (org-object)
|
||||
Every element in the Memex (headlines, paragraphs, etc.) is represented by an `org-object` structure. It contains both semantic metadata (attributes, content) and structural metadata (parent/child pointers, Merkle hashes).
|
||||
|
||||
#+begin_src lisp :tangle ../library/memory.lisp
|
||||
(defstruct org-object
|
||||
"The fundamental unit of knowledge in the OpenCortex."
|
||||
id
|
||||
type
|
||||
attributes
|
||||
parent-id
|
||||
children
|
||||
version
|
||||
last-sync
|
||||
vector
|
||||
content
|
||||
hash)
|
||||
id type attributes content vector parent-id children version last-sync hash)
|
||||
|
||||
;; Enable serialization via make-load-form (standard CL)
|
||||
(defmethod make-load-form ((obj org-object) &optional env)
|
||||
(make-load-form-saving-slots obj :environment env))
|
||||
#+end_src
|
||||
|
||||
* Integrity and Hashing
|
||||
|
||||
** Merkle Hashing (compute-merkle-hash)
|
||||
To ensure data integrity and detect changes during external edits, we utilize Merkle-tree hashing. A node's hash is derived from its own content plus the hashes of its children.
|
||||
** 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 ../library/memory.lisp
|
||||
(defun compute-merkle-hash (id type attributes content child-hashes)
|
||||
@@ -64,87 +67,278 @@ To ensure data integrity and detect changes during external edits, we utilize Me
|
||||
(sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
|
||||
(attr-string (format nil "~s" sorted-alist))
|
||||
(children-string (format nil "~{~a~}" child-hashes))
|
||||
(raw-data (format nil "~a|~a|~a|~a|~a" id type attr-string (or content "") children-string)))
|
||||
(ironclad:byte-array-to-hex-string
|
||||
(ironclad:digest-sequence :sha256 (ironclad:ascii-string-to-byte-array raw-data)))))
|
||||
(data-string (format nil "ID:~a|TYPE:~s|ATTRS:~a|CONTENT:~a|CHILDREN:~a"
|
||||
id type attr-string (or content "") children-string))
|
||||
(digester (ironclad:make-digest :sha256)))
|
||||
(ironclad:update-digest digester (ironclad:ascii-string-to-byte-array data-string))
|
||||
(ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))
|
||||
#+end_src
|
||||
|
||||
* Memory Ingestion
|
||||
|
||||
** AST Ingestion (ingest-ast)
|
||||
The primary mechanism for translating raw Org-mode Abstract Syntax Trees (provided by Emacs or a parser) into the live Lisp graph.
|
||||
** 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 ../library/memory.lisp
|
||||
(defun ingest-ast (ast &optional parent-id)
|
||||
"Recursively parses an Org AST into the Lisp Memory registry."
|
||||
"Parses an Org AST into the recursive Lisp Memory with Merkle hashing."
|
||||
(let* ((type (getf ast :type))
|
||||
(properties (getf ast :properties))
|
||||
(id (or (getf properties :ID) (uuid:make-v4-uuid)))
|
||||
(content (getf ast :content))
|
||||
(children (getf ast :contents))
|
||||
(child-ids nil))
|
||||
|
||||
;; Recursively ingest children and collect their IDs
|
||||
(dolist (child children)
|
||||
(let ((child-obj (ingest-ast child id)))
|
||||
(when child-obj (push (org-object-id child-obj) child-ids))))
|
||||
|
||||
(let ((obj (make-org-object :id id
|
||||
:type type
|
||||
:attributes properties
|
||||
:parent-id parent-id
|
||||
:children (nreverse child-ids)
|
||||
:content content
|
||||
:version (get-universal-time))))
|
||||
(props (getf ast :properties))
|
||||
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
|
||||
(contents (getf ast :contents))
|
||||
(raw-content (when (eq type :HEADLINE)
|
||||
(format nil "~a~%~a" (getf props :TITLE) (or (cl:getf ast :raw-content) ""))))
|
||||
(should-embed (and raw-content (equal (getf props :EMBED) "t")))
|
||||
(child-ids nil)
|
||||
(child-hashes nil))
|
||||
(dolist (child contents)
|
||||
(when (listp child)
|
||||
(let ((child-id (ingest-ast child id)))
|
||||
(push child-id child-ids)
|
||||
(let ((child-id-val child-id))
|
||||
(let ((child-obj (lookup-object child-id-val)))
|
||||
(when child-obj (push (org-object-hash child-obj) child-hashes)))))))
|
||||
(setf child-ids (nreverse child-ids))
|
||||
(setf child-hashes (nreverse child-hashes))
|
||||
(let* ((hash (compute-merkle-hash id type props raw-content child-hashes))
|
||||
(existing-obj (gethash hash *history-store*))
|
||||
(obj (or existing-obj
|
||||
(make-org-object
|
||||
:id id :type type :attributes props :content raw-content
|
||||
:vector (when should-embed (get-embedding raw-content))
|
||||
:parent-id parent-id :children child-ids
|
||||
:version (get-universal-time) :last-sync (get-universal-time)
|
||||
:hash hash))))
|
||||
(unless existing-obj
|
||||
(setf (gethash hash *history-store*) obj))
|
||||
(setf (gethash id *memory*) obj)
|
||||
obj)))
|
||||
id)))
|
||||
#+end_src
|
||||
|
||||
* Retrieval and Search
|
||||
** 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.
|
||||
|
||||
** Object Lookup (lookup-object)
|
||||
#+begin_src lisp :tangle ../library/memory.lisp
|
||||
(defun lookup-object (id)
|
||||
"Retrieves an object from memory by its ID."
|
||||
(defvar *object-store-snapshots* nil)
|
||||
|
||||
(defun copy-hash-table (hash-table)
|
||||
"Creates a shallow copy of a hash table."
|
||||
(let ((new-table (make-hash-table :test (hash-table-test hash-table)
|
||||
:size (hash-table-size hash-table))))
|
||||
(maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table)
|
||||
new-table))
|
||||
|
||||
(defun snapshot-memory ()
|
||||
"Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers."
|
||||
(let ((snapshot (copy-hash-table *memory*)))
|
||||
(push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
|
||||
(when (> (length *object-store-snapshots*) 20)
|
||||
(setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))
|
||||
(harness-log "MEMORY - CoW Memory snapshot created.")))
|
||||
#+end_src
|
||||
|
||||
** Memory Rollback (rollback-memory)
|
||||
Restores the state of the Memex from one of the previous snapshots.
|
||||
|
||||
#+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*)))
|
||||
(if snapshot
|
||||
(progn (setf *memory* (copy-hash-table (getf snapshot :data)))
|
||||
(harness-log "MEMORY - Memory rolled back to snapshot ~a" index))
|
||||
(harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
|
||||
#+end_src
|
||||
|
||||
** Disk Persistence (save-memory / load-memory)
|
||||
Essential for surviving crashes. Saves the in-memory hash tables to disk and loads them back on restart. The path is controlled by the `MEMORY_SNAPSHOT_PATH` environment variable.
|
||||
|
||||
#+begin_src lisp :tangle ../library/memory.lisp
|
||||
(defvar *memory-snapshot-path* nil
|
||||
"Path to the memory snapshot file. Set from MEMORY_SNAPSHOT_PATH env or default.")
|
||||
|
||||
(defun ensure-memory-snapshot-path ()
|
||||
"Initializes the snapshot path from environment or default location."
|
||||
(or *memory-snapshot-path*
|
||||
(let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH")))
|
||||
(setf *memory-snapshot-path*
|
||||
(or env-path
|
||||
(uiop:merge-pathnames* "memory.snap" (user-homedir-pathname)))))))
|
||||
|
||||
(defun save-memory-to-disk ()
|
||||
"Serializes *memory* and *history-store* to disk for crash recovery.
|
||||
Converts hash tables to alists for proper serialization."
|
||||
(let ((path (ensure-memory-snapshot-path)))
|
||||
(with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create)
|
||||
(format stream ";; OpenCortex Memory Snapshot~%")
|
||||
(format stream ";; Created: ~a~%~%" (format nil "~a" (get-universal-time)))
|
||||
(let ((memory-alist nil)
|
||||
(history-alist nil))
|
||||
(maphash (lambda (k v) (push (cons k v) memory-alist)) *memory*)
|
||||
(maphash (lambda (k v) (push (cons k v) history-alist)) *history-store*)
|
||||
(prin1 (list :memory memory-alist :history-store history-alist) stream)))
|
||||
(harness-log "MEMORY - Saved to ~a" path)
|
||||
path))
|
||||
|
||||
(defun load-memory-from-disk ()
|
||||
"Loads *memory* and *history-store* from disk if the snapshot exists.
|
||||
Reconstitutes alists into hash tables."
|
||||
(let ((path (ensure-memory-snapshot-path)))
|
||||
(when (uiop:file-exists-p path)
|
||||
(handler-case
|
||||
(with-open-file (stream path :direction :input)
|
||||
(let ((data (read stream nil)))
|
||||
(when data
|
||||
(let ((memory-alist (getf data :memory))
|
||||
(history-alist (getf data :history-store)))
|
||||
(setf *memory* (make-hash-table :test 'equal :size (length memory-alist)))
|
||||
(dolist (kv memory-alist)
|
||||
(setf (gethash (car kv) *memory*) (cdr kv)))
|
||||
(setf *history-store* (make-hash-table :test 'equal :size (length history-alist)))
|
||||
(dolist (kv history-alist)
|
||||
(setf (gethash (car kv) *history-store*) (cdr kv)))
|
||||
(harness-log "MEMORY - Loaded from ~a (~a objects)" path (hash-table-size *memory*))))))
|
||||
(error (c)
|
||||
(harness-log "MEMORY WARNING - Failed to load snapshot: ~a" c))))
|
||||
t))
|
||||
#+end_src
|
||||
|
||||
** Lookup Utilities
|
||||
Basic functions for retrieving objects by ID or type.
|
||||
|
||||
#+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))))
|
||||
|
||||
(defun lookup-object (id)
|
||||
"Retrieves an object from the store by its unique ID."
|
||||
(gethash id *memory*))
|
||||
#+end_src
|
||||
|
||||
** Semantic Attribute Search (list-objects-with-attribute)
|
||||
Allows for querying the memory based on metadata (e.g., finding all nodes tagged :PROJECT:).
|
||||
|
||||
#+begin_src lisp :tangle ../library/memory.lisp
|
||||
(defun list-objects-with-attribute (key value)
|
||||
"Returns a list of objects that possess the specified attribute pair."
|
||||
(defun list-objects-by-type (type)
|
||||
"Returns a list of all objects matching a specific Org element type."
|
||||
(let ((results nil))
|
||||
(maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *memory*)
|
||||
results))
|
||||
(defun list-objects-with-attribute (attr-name value)
|
||||
"Returns a list of all objects where ATTR-NAME matches VALUE."
|
||||
(let ((results nil))
|
||||
(maphash (lambda (id obj)
|
||||
(declare (ignore id))
|
||||
(when (equal (getf (org-object-attributes obj) key) value)
|
||||
(push obj results)))
|
||||
(let ((attrs (org-object-attributes obj)))
|
||||
(when (equal (getf attrs attr-name) value)
|
||||
(push obj results))))
|
||||
*memory*)
|
||||
results))
|
||||
#+end_src
|
||||
|
||||
* Persistence and Resilience
|
||||
|
||||
** Memory Snapshots (snapshot-memory)
|
||||
Captures the current state of the memory graph.
|
||||
** Structural Helpers
|
||||
Utility functions for AST traversal and path resolution.
|
||||
|
||||
#+begin_src lisp :tangle ../library/memory.lisp
|
||||
(defun snapshot-memory ()
|
||||
"Creates a deep copy of the memory hash table and pushes it to the history store."
|
||||
(let ((new-snap (make-hash-table :test 'equal)))
|
||||
(maphash (lambda (k v) (setf (gethash k new-snap) (copy-org-object v))) *memory*)
|
||||
(vector-push-extend new-snap *history-store*)))
|
||||
(defun find-headline-missing-id (ast)
|
||||
"Traverses an AST to find headlines that lack an :ID: property."
|
||||
(when (listp ast)
|
||||
(if (and (eq (getf ast :type) :HEADLINE) (not (getf (getf ast :properties) :ID)))
|
||||
ast
|
||||
(cl:some #'find-headline-missing-id (getf ast :contents)))))
|
||||
|
||||
(defun file-name-nondirectory (path)
|
||||
"Extracts the filename from a full path string."
|
||||
(let ((pos (position #\/ path :from-end t))) (if pos (subseq path (1+ pos)) path)))
|
||||
#+end_src
|
||||
|
||||
** Micro-Rollbacks (rollback-memory)
|
||||
The primary defense against accidental memory corruption by faulty skills.
|
||||
* Phase E: Chaos (Verification)
|
||||
Following the Engineering Standards, the Memory must be empirically verified through automated testing. The following test suite ensures the mathematical integrity of the Merkle hashes and the behavioral correctness of the immutable versioning and rollback systems.
|
||||
|
||||
#+begin_src lisp :tangle ../library/memory.lisp
|
||||
(defun rollback-memory (&optional (steps 1))
|
||||
"Restores the memory to a previous snapshot state."
|
||||
(let ((index (- (length *history-store*) steps 1)))
|
||||
(when (>= index 0)
|
||||
(setf *memory* (aref *history-store* index))
|
||||
(harness-log "IMMUNE SYSTEM: Memory rolled back ~a steps." steps))))
|
||||
#+begin_src lisp :tangle ../tests/memory-tests.lisp
|
||||
(defpackage :opencortex-memory-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:memory-suite))
|
||||
|
||||
(in-package :opencortex-memory-tests)
|
||||
|
||||
(def-suite memory-suite
|
||||
:description "Tests for the Merkle-Tree Memory.")
|
||||
|
||||
(in-suite memory-suite)
|
||||
|
||||
(test merkle-hash-consistency
|
||||
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil))
|
||||
(ast2 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
|
||||
(clrhash *memory*)
|
||||
(let ((id1 (ingest-ast ast1)))
|
||||
(let ((hash1 (org-object-hash (lookup-object id1))))
|
||||
(clrhash *memory*)
|
||||
(let ((id2 (ingest-ast ast2)))
|
||||
(let ((hash2 (org-object-hash (lookup-object id2))))
|
||||
(is (equal hash1 hash2))))))))
|
||||
|
||||
(test merkle-hash-cascading
|
||||
(let* ((ast-leaf '(:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))
|
||||
(ast-root-full '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
||||
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))))
|
||||
(id-root (progn (clrhash *memory*) (ingest-ast ast-root-full)))
|
||||
(initial-root-hash (org-object-hash (lookup-object id-root))))
|
||||
|
||||
;; Now ingest a modified version (title change)
|
||||
(let* ((ast-root-modified '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
||||
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf Modified") :contents nil))))
|
||||
(id-root-mod (progn (clrhash *memory*) (ingest-ast ast-root-modified)))
|
||||
(modified-root-hash (org-object-hash (lookup-object id-root-mod))))
|
||||
(is (not (equal initial-root-hash modified-root-hash))))))
|
||||
|
||||
(test history-store-immutability
|
||||
"Verify that *history-store* retains old versions even after *memory* updates."
|
||||
(clrhash *memory*)
|
||||
(clrhash *history-store*)
|
||||
(let* ((ast-v1 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 1") :contents nil))
|
||||
(id-v1 (ingest-ast ast-v1))
|
||||
(obj-v1 (lookup-object id-v1))
|
||||
(hash-v1 (org-object-hash obj-v1)))
|
||||
|
||||
(let* ((ast-v2 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 2") :contents nil))
|
||||
(id-v2 (ingest-ast ast-v2))
|
||||
(obj-v2 (lookup-object id-v2))
|
||||
(hash-v2 (org-object-hash obj-v2)))
|
||||
|
||||
;; The active pointer should be v2
|
||||
(is (equal (org-object-hash (lookup-object "test-node")) hash-v2))
|
||||
|
||||
;; Both v1 and v2 should exist in the immutable history store
|
||||
(is (not (null (gethash hash-v1 *history-store*))))
|
||||
(is (not (null (gethash hash-v2 *history-store*))))
|
||||
|
||||
;; Modifying v2 should not affect v1 in the history store
|
||||
(is (equal (org-object-content (gethash hash-v1 *history-store*)) "Version 1
|
||||
"))
|
||||
(is (equal (org-object-content (gethash hash-v2 *history-store*)) "Version 2
|
||||
")))))
|
||||
|
||||
(test cow-snapshot-and-rollback
|
||||
"Verify that lightweight snapshots can accurately restore previous pointer states."
|
||||
(clrhash *memory*)
|
||||
(clrhash *history-store*)
|
||||
(setf *object-store-snapshots* nil)
|
||||
|
||||
(let* ((ast-v1 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State A") :contents nil))
|
||||
(id-v1 (ingest-ast ast-v1))
|
||||
(hash-v1 (org-object-hash (lookup-object id-v1))))
|
||||
|
||||
;; Take a snapshot at State A
|
||||
(snapshot-memory)
|
||||
|
||||
(let* ((ast-v2 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State B") :contents nil))
|
||||
(id-v2 (ingest-ast ast-v2))
|
||||
(hash-v2 (org-object-hash (lookup-object id-v2))))
|
||||
|
||||
;; Verify we are currently in State B
|
||||
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v2))
|
||||
|
||||
;; Rollback to State A (index 0 because we only took 1 snapshot)
|
||||
(rollback-memory 0)
|
||||
|
||||
;; Verify we are back in State A
|
||||
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v1))
|
||||
|
||||
;; Verify State B is still safely in the history store (no data loss)
|
||||
(is (not (null (gethash hash-v2 *history-store*)))))))
|
||||
#+end_src
|
||||
|
||||
@@ -22,7 +22,7 @@ flowchart TD
|
||||
(defpackage :opencortex
|
||||
(:use :cl)
|
||||
(:export
|
||||
;; --- Communication Protocol ---
|
||||
;; --- communication protocol ---
|
||||
#:frame-message
|
||||
#:read-framed-message
|
||||
#:PROTO-GET
|
||||
@@ -138,62 +138,9 @@ flowchart TD
|
||||
#:find-headline-missing-id))
|
||||
#+end_src
|
||||
|
||||
** Package Implementation Initialization
|
||||
Ensuring the compiler enters the correct namespace for all subsequent definitions.
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
* System State Management
|
||||
The package layer manages the core data structures that represent the live state of the harness.
|
||||
|
||||
** Harness Logging State
|
||||
OpenCortex maintains a thread-safe circular log buffer. This is critical for two reasons:
|
||||
1. *Neural Introspection:* The probabilistic engine can read the recent system logs to understand why an action failed.
|
||||
2. *Real-time Debugging:* Clients can subscribe to a live log stream without needing to read the physical log file.
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defvar *system-logs* nil
|
||||
"Thread-safe list of the most recent system messages.")
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defvar *logs-lock* (bt:make-lock "harness-logs-lock")
|
||||
"Protects the circular log buffer from race conditions during concurrent skill execution.")
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defvar *max-log-history* 100
|
||||
"The maximum number of entries to preserve in the in-memory log buffer.")
|
||||
#+end_src
|
||||
|
||||
** Skills Registry
|
||||
All Literate Skills, once compiled, are registered here. This allows for topological sorting and priority-based execution.
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defvar *skills-registry* (make-hash-table :test 'equal)
|
||||
"Global registry of all loaded skills, keyed by their unique identifier.")
|
||||
#+end_src
|
||||
|
||||
** Skill Telemetry State
|
||||
To ensure the system remains performant and reliable, the harness tracks execution metrics for every skill.
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defvar *skill-telemetry* (make-hash-table :test 'equal)
|
||||
"Stores execution duration and failure counts for every registered skill.")
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock")
|
||||
"Protects the telemetry store from concurrent updates.")
|
||||
#+end_src
|
||||
|
||||
* Support Functions
|
||||
|
||||
** Protocol Property Access (proto-get)
|
||||
Lisp keywords can be inconsistent between capitalized and lowercase versions depending on the client (e.g., Emacs vs. Python socket). ~proto-get~ provides a robust abstraction to ensure the system correctly extracts values regardless of keyword casing.
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defun proto-get (plist key)
|
||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
||||
(let* ((s (string key))
|
||||
@@ -202,8 +149,49 @@ Lisp keywords can be inconsistent between capitalized and lowercase versions dep
|
||||
(or (getf plist up) (getf plist dn))))
|
||||
#+end_src
|
||||
|
||||
** Telemetry Tracking
|
||||
The ~harness-track-telemetry~ function provides the hook for the metabolic loop to report performance data.
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(in-package :opencortex)
|
||||
|
||||
(defun proto-get (plist key)
|
||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
||||
(let* ((s (string key))
|
||||
(up (intern (string-upcase s) :keyword))
|
||||
(dn (intern (string-downcase s) :keyword)))
|
||||
(or (getf plist up) (getf plist dn))))
|
||||
#+end_src
|
||||
|
||||
#+end_src
|
||||
|
||||
** Package Implementation
|
||||
#+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 ../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 ../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 ../library/package.lisp
|
||||
(defvar *skill-telemetry* (make-hash-table :test 'equal))
|
||||
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock"))
|
||||
#+end_src
|
||||
|
||||
** 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 ../library/package.lisp
|
||||
(defun harness-track-telemetry (skill-name duration status)
|
||||
@@ -217,36 +205,21 @@ The ~harness-track-telemetry~ function provides the hook for the metabolic loop
|
||||
(setf (gethash skill-name *skill-telemetry*) entry)))))
|
||||
#+end_src
|
||||
|
||||
* Cognitive Tooling System
|
||||
The Tool Registry is the agent's physical interface. It separates the /proposal/ of an action from its /execution/.
|
||||
|
||||
** Tool Structure
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defvar *cognitive-tools* (make-hash-table :test 'equal)
|
||||
"The active set of physical capabilities available to the agent.")
|
||||
#+end_src
|
||||
** 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 ../library/package.lisp
|
||||
(defvar *cognitive-tools* (make-hash-table :test 'equal))
|
||||
|
||||
(defstruct cognitive-tool
|
||||
"Represents a physical or virtual capability with explicit documentation and security guards."
|
||||
name
|
||||
description
|
||||
parameters
|
||||
guard
|
||||
body)
|
||||
#+end_src
|
||||
|
||||
** Tool Registration Macro (def-cognitive-tool)
|
||||
We use a macro to ensure that tools are consistently registered and accessible to the LLM's "tool-belt" prompt generator.
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defmacro def-cognitive-tool (name description parameters &key guard body)
|
||||
"Registers a new cognitive tool.
|
||||
NAME: Keyword identifier.
|
||||
DESCRIPTION: Human-readable intent (used in LLM prompts).
|
||||
PARAMETERS: List of property lists defining arguments.
|
||||
GUARD: (context -> boolean) function to prevent unsafe calls.
|
||||
BODY: The actual Lisp execution logic."
|
||||
"Registers a new cognitive tool into the global registry. Parameters must be a list of property lists."
|
||||
`(setf (gethash (string-downcase (string ',name)) *cognitive-tools*)
|
||||
(make-cognitive-tool :name (string-downcase (string ',name))
|
||||
:description ,description
|
||||
@@ -255,14 +228,12 @@ We use a macro to ensure that tools are consistently registered and accessible t
|
||||
:body ,body)))
|
||||
#+end_src
|
||||
|
||||
* Logging Implementation
|
||||
|
||||
** Centralized Logging (harness-log)
|
||||
The primary mechanism for system transparency. It ensures all activity is both visible to the user and recorded for neural reasoning.
|
||||
** Harness Logging Implementation
|
||||
Centralized logging function. It simultaneously writes to standard output and the in-memory circular buffer.
|
||||
|
||||
#+begin_src lisp :tangle ../library/package.lisp
|
||||
(defun harness-log (msg &rest args)
|
||||
"Centralized logging for the harness. Writes to STDOUT and the thread-safe circular buffer."
|
||||
"Centralized logging for the harness."
|
||||
(let ((formatted-msg (apply #'format nil msg args)))
|
||||
(bt:with-lock-held (*logs-lock*)
|
||||
(push formatted-msg *system-logs*)
|
||||
@@ -271,3 +242,5 @@ The primary mechanism for system transparency. It ensures all activity is both v
|
||||
(format t "~a~%" formatted-msg)
|
||||
(finish-output)))
|
||||
#+end_src
|
||||
|
||||
|
||||
|
||||
@@ -5,102 +5,218 @@
|
||||
|
||||
* Stage 1: Perceive (perceive.lisp)
|
||||
|
||||
** Architectural Intent: Sensory Ingestion
|
||||
The Perceive stage is the "sensory cortex" of the OpenCortex. Its primary responsibility is to take raw, unstructured stimuli from the outside world—whether from a TCP socket, a system interrupt, or a background heartbeat—and normalize them into high-fidelity internal **Signals**.
|
||||
** Architectural Intent: Sensory Normalization
|
||||
|
||||
Normalization is critical because it shields the subsequent reasoning and actuation stages from the messiness of different transport protocols. Whether a message arrives via a TUI, a Signal bot, or an internal timer, the core "Brain" perceives a consistent Lisp property list.
|
||||
The Perceive stage is the "sensory cortex" of OpenCortex. Its job is to take raw stimuli from the outside world and transform them into standardized Signals that the rest of the pipeline can process.
|
||||
|
||||
** Pipeline Initialization
|
||||
Ensuring we are in the correct namespace for sensory processing.
|
||||
Raw stimuli come from diverse sources:
|
||||
- Terminal input (CLI)
|
||||
- Emacs org-mode buffers (via swank)
|
||||
- Telegram/Signal messages
|
||||
- Heartbeats (internal clock)
|
||||
- Shell command outputs
|
||||
|
||||
Each source has its own format and protocol. Perceive normalizes all of them into the Signal format:
|
||||
|
||||
: (TYPE :EVENT META (...) PAYLOAD (...))
|
||||
|
||||
** Why Normalize?
|
||||
|
||||
Without normalization, each downstream component (Reason, Act) would need to understand each input format. With normalization:
|
||||
|
||||
1. The gateway layer (CLI, Emacs, Telegram) just sends raw messages
|
||||
2. Perceive transforms them into Signals
|
||||
3. Reason and Act work with a single, consistent format
|
||||
4. Adding new input sources only requires gateway code, not changes to the core
|
||||
|
||||
** The Signal Format
|
||||
|
||||
Signals are property lists with a consistent structure:
|
||||
|
||||
| Key | Description |
|
||||
|-----|-------------|
|
||||
| :type | :EVENT, :REQUEST, :RESPONSE, :LOG |
|
||||
| :payload | The actual content (sensor data, actions, etc.) |
|
||||
| :meta | Metadata: source, session, reply stream |
|
||||
| :status | Processing status: :perceived, :reasoned, :acted |
|
||||
| :depth | Recursion depth for feedback loops |
|
||||
| :approved-action | Set by Reason, executed by Act |
|
||||
| :foveal-focus | ID of the node user is interacting with |
|
||||
|
||||
** Async vs Sync Processing
|
||||
|
||||
Some sensors (user input, chat messages) are processed asynchronously in dedicated threads. This prevents:
|
||||
- A slow API call from blocking the entire system
|
||||
- Race conditions when multiple inputs arrive simultaneously
|
||||
|
||||
Other sensors (heartbeats, interrupts) are processed synchronously to maintain ordering guarantees.
|
||||
|
||||
* Package Context
|
||||
|
||||
#+begin_src lisp :tangle ../library/perceive.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
** Sensory Concurrency (Async Sensors)
|
||||
To maintain the agent's responsiveness, we distinguish between "Fast" and "Slow" sensors. Sensors that require extensive processing or external API calls are routed to asynchronous threads to prevent blocking the main metabolic pipeline.
|
||||
* Sensor Configuration
|
||||
|
||||
** Async Sensor Registry
|
||||
|
||||
#+begin_src lisp :tangle ../library/perceive.lisp
|
||||
(defvar *async-sensors* '(:chat-message :delegation :user-command)
|
||||
"List of sensors that should be processed asynchronously to avoid blocking gateways.")
|
||||
"Sensors that are processed in dedicated threads.
|
||||
|
||||
These sensors can block (waiting for API responses, user input, etc.)
|
||||
so they run in separate threads to avoid blocking the main pipeline.
|
||||
|
||||
Other sensors (:heartbeat, :interrupt, :buffer-update) are processed
|
||||
synchronously to maintain temporal ordering.")
|
||||
#+end_src
|
||||
|
||||
** Foveal Focus (User Context)
|
||||
The system tracks the user's current point of interaction (the "foveal focus"). This provides immediate situational awareness to the reasoning engine, allowing it to prioritize the data the human is currently looking at.
|
||||
** Foveal Focus State
|
||||
|
||||
#+begin_src lisp :tangle ../library/perceive.lisp
|
||||
(defvar *foveal-focus-id* nil
|
||||
"The Org ID of the node the user is currently interacting with.")
|
||||
"The Org ID of the node the user is currently interacting with.
|
||||
|
||||
This enables the reasoning engine to provide contextually relevant
|
||||
responses. When editing a specific note, the agent knows which
|
||||
note you're referring to without needing explicit ID references.
|
||||
|
||||
Updated on :point-update events from Emacs.")
|
||||
#+end_src
|
||||
|
||||
* Primary Ingress
|
||||
* Stimulus Injection
|
||||
|
||||
** Stimulus Injection (inject-stimulus)
|
||||
The ~inject-stimulus~ function is the universal gateway into the OpenCortex mind. It performs two critical tasks:
|
||||
1. *Envelope Wrapping:* Ensures that every raw message is wrapped in a ~:META~ envelope, preserving the source and session information.
|
||||
2. *Dispatching:* Determines whether to run the metabolism synchronously or in a new thread.
|
||||
** inject-stimulus: Entry Point
|
||||
|
||||
#+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))
|
||||
"Inject a raw message into the signal processing pipeline.
|
||||
|
||||
RAW-MESSAGE is a property list that will be normalized into a Signal.
|
||||
STREAM is an optional output stream for responses (used by TUI/CLI).
|
||||
DEPTH tracks recursion depth for feedback loops.
|
||||
|
||||
This function determines whether to process synchronously or
|
||||
asynchronously based on the sensor type, then calls process-signal
|
||||
to run through the Perceive -> Reason -> Act pipeline.
|
||||
|
||||
Error handling: Uses restarts to prevent individual signals from
|
||||
crashing the entire system. Failed signals are logged and dropped."
|
||||
|
||||
(let* ((payload (getf raw-message :payload))
|
||||
(sensor (getf payload :sensor))
|
||||
(meta (getf raw-message :meta))
|
||||
(async-p (or (getf payload :async-p) (member sensor *async-sensors*))))
|
||||
|
||||
;; Ensure META exists and contains the stream if provided
|
||||
(unless meta (setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
|
||||
(when stream (setf (getf meta :reply-stream) stream))
|
||||
(async-p (or (getf payload :async-p)
|
||||
(member sensor *async-sensors*))))
|
||||
|
||||
;; Ensure metadata exists
|
||||
(unless meta
|
||||
(setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
|
||||
|
||||
;; Attach reply stream if provided
|
||||
(when stream
|
||||
(setf (getf meta :reply-stream) stream))
|
||||
|
||||
(setf (getf raw-message :meta) meta)
|
||||
|
||||
(if async-p
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(restart-case (handler-bind ((error (lambda (c) (harness-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event))))
|
||||
(process-signal raw-message))
|
||||
(skip-event () nil)))
|
||||
(if async-p
|
||||
;; Async: process in dedicated thread
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(restart-case
|
||||
(handler-bind ((error (lambda (c)
|
||||
(harness-log "ASYNC ERROR: ~a" c)
|
||||
(invoke-restart 'skip-event))))
|
||||
(process-signal raw-message))
|
||||
(skip-event () nil)))
|
||||
:name "opencortex-async-task")
|
||||
(restart-case (handler-bind ((error (lambda (c) (harness-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event))))
|
||||
(process-signal raw-message))
|
||||
(skip-event () (harness-log "SYSTEM RECOVERY: Stimulus dropped.~%"))))))
|
||||
|
||||
;; Sync: process in main thread with recovery
|
||||
(restart-case
|
||||
(handler-bind ((error (lambda (c)
|
||||
(harness-log "SYSTEM ERROR: ~a" c)
|
||||
(invoke-restart 'skip-event))))
|
||||
(process-signal raw-message))
|
||||
(skip-event ()
|
||||
(harness-log "SYSTEM RECOVERY: Stimulus dropped."))))))
|
||||
#+end_src
|
||||
|
||||
* The Perceive Stage
|
||||
* The Perceive Gate
|
||||
|
||||
** Perception Gate (perceive-gate)
|
||||
The first official stage of the metabolic loop. It performs "Pre-Cognitive" work:
|
||||
1. *Logging:* Recording the arrival of the signal.
|
||||
2. *State Sync:* If the signal contains an AST update (e.g., from Emacs), it immediately updates the in-memory graph.
|
||||
3. *Merkle Checkpointing:* Before modifying memory, it creates a snapshot to allow for emergency rollbacks.
|
||||
** perceive-gate: Signal Normalization
|
||||
|
||||
#+begin_src lisp :tangle ../library/perceive.lisp
|
||||
(defun perceive-gate (signal)
|
||||
"Initial processing: Normalizes raw stimuli and updates memory."
|
||||
"Stage 1 of the metabolic pipeline: Normalize sensory input.
|
||||
|
||||
This function:
|
||||
1. Logs the incoming signal for debugging
|
||||
2. Handles special sensor types (:buffer-update, :point-update, etc.)
|
||||
3. Updates the Memory graph with incoming data
|
||||
4. Tracks foveal focus (user's current node)
|
||||
5. Sets :status to :perceived
|
||||
|
||||
Modifies the signal in place and returns it for the next stage.
|
||||
|
||||
Memory snapshots are taken before AST updates to enable rollback
|
||||
if the update causes issues."
|
||||
|
||||
(let* ((payload (getf signal :payload))
|
||||
(type (getf signal :type))
|
||||
(meta (getf signal :meta))
|
||||
(sensor (getf payload :sensor)))
|
||||
(harness-log "GATE [Perceive]: ~a (~a) [Source: ~s]" type (or sensor "no-sensor") (getf meta :source))
|
||||
|
||||
|
||||
;; Log the incoming signal for debugging
|
||||
(harness-log "GATE [Perceive]: ~a (~a) [Source: ~s]"
|
||||
type (or sensor "no-sensor") (getf meta :source))
|
||||
|
||||
;; Handle EVENT type sensors
|
||||
(cond ((eq type :EVENT)
|
||||
(case sensor
|
||||
(:buffer-update
|
||||
(let ((ast (getf payload :ast)))
|
||||
(when ast
|
||||
(snapshot-memory)
|
||||
|
||||
;; Org buffer was modified - update memory
|
||||
(:buffer-update
|
||||
(let ((ast (getf payload :ast)))
|
||||
(when ast
|
||||
(snapshot-memory) ; Enable rollback if update causes issues
|
||||
(ingest-ast ast))))
|
||||
(:point-update
|
||||
(let ((element (getf payload :element)))
|
||||
(when element
|
||||
|
||||
;; Point moved to different org node - update focus
|
||||
(:point-update
|
||||
(let ((element (getf payload :element)))
|
||||
(when element
|
||||
(snapshot-memory)
|
||||
(setf *foveal-focus-id* (ignore-errors (getf element :id)))
|
||||
;; Track foveal focus for contextual reasoning
|
||||
(setf *foveal-focus-id*
|
||||
(ignore-errors (getf element :id)))
|
||||
(ingest-ast element))))
|
||||
(:interrupt
|
||||
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t)))))
|
||||
|
||||
;; System interrupt - trigger shutdown
|
||||
(:interrupt
|
||||
(bt:with-lock-held (*interrupt-lock*)
|
||||
(setf *interrupt-flag* t)))))
|
||||
|
||||
;; Log responses from actuators
|
||||
((eq type :RESPONSE)
|
||||
(harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
|
||||
|
||||
(harness-log "GATE [Perceive]: Act Result -> ~a"
|
||||
(getf payload :status))))
|
||||
|
||||
;; Update signal status
|
||||
(setf (getf signal :status) :perceived)
|
||||
(setf (getf signal :foveal-focus) *foveal-focus-id*)
|
||||
signal))
|
||||
#+end_src
|
||||
|
||||
** Sensor Types Reference
|
||||
|
||||
| Sensor | Source | Processing | Description |
|
||||
|--------|--------|------------|-------------|
|
||||
| :user-input | CLI/TUI | Async | Text input from terminal |
|
||||
| :chat-message | Telegram/Signal | Async | Messages from messaging apps |
|
||||
| :heartbeat | Internal | Sync | Periodic maintenance trigger |
|
||||
| :buffer-update | Emacs | Sync | Org buffer was modified |
|
||||
| :point-update | Emacs | Sync | Cursor moved to different headline |
|
||||
| :interrupt | System | Sync | SIGINT received |
|
||||
| :tool-output | Internal | Sync | Result from cognitive tool |
|
||||
| :loop-error | Internal | Sync | Error during signal processing |
|
||||
@@ -5,83 +5,142 @@
|
||||
|
||||
* Stage 2: Reason (reason.lisp)
|
||||
|
||||
** Architectural Intent: Unified Cognition
|
||||
The Reason stage is the cognitive engine of the OpenCortex. Its primary responsibility is to bridge the gap between raw sensory data (Perceive) and physical side-effects (Act).
|
||||
** Architectural Intent: The Dual-Engine Cognitive Architecture
|
||||
|
||||
Cognition is split into two distinct modes:
|
||||
1. **Probabilistic Reasoning:** Utilizing LLMs to generate creative proposals and understand natural language intent.
|
||||
2. **Deterministic Verification:** Utilizing native Lisp logic to verify and constrain the neural proposals against security and physics invariants.
|
||||
The Reason stage implements the core innovation of OpenCortex: the separation of probabilistic reasoning (neural/LLM) from deterministic verification (logic/safety).
|
||||
|
||||
This hybrid approach ensures the agent is both intelligent and mathematically safe.
|
||||
This dual-engine design solves a fundamental problem in AI safety:
|
||||
|
||||
1. *Probabilistic Engine* - Uses LLMs for semantic understanding, natural language generation, and complex reasoning. It is powerful but can hallucinate, make syntax errors, or propose unsafe actions.
|
||||
|
||||
2. *Deterministic Engine* - Uses formal verification (skills) to check LLM proposals before execution. It is slower but provably correct.
|
||||
|
||||
The LLM proposes; the skills verify. This is the "Bouncer Pattern" - the deterministic engine is literally a bouncer that checks the LLM's proposals at the door before letting them through to execution.
|
||||
|
||||
** Why Plists for Communication?
|
||||
|
||||
The Reason stage communicates exclusively through property lists (plists). This design choice reflects the homoiconic nature of Lisp - plists are native data structures that can be read, written, and manipulated by the same code that processes them.
|
||||
|
||||
A plist message like:
|
||||
: (TYPE :REQUEST TARGET :CLI PAYLOAD (ACTION :MESSAGE TEXT "Hello"))
|
||||
|
||||
Is simultaneously:
|
||||
- Human-readable text
|
||||
- Machine-parseable data structure
|
||||
- Executable Lisp code
|
||||
|
||||
This means the reasoning pipeline can generate, modify, and execute its own communication protocol without external parsing.
|
||||
|
||||
* Package Context
|
||||
|
||||
** Pipeline Initialization
|
||||
#+begin_src lisp :tangle ../library/reason.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
* Probabilistic Engine Infrastructure
|
||||
* Probabilistic Engine (Neural/LLM Integration)
|
||||
|
||||
** Neural Backend Registry
|
||||
OpenCortex is provider-agnostic. All neural backends (OpenRouter, Ollama, etc.) register themselves here.
|
||||
The probabilistic engine is responsible for all neural/LLM operations. It maintains a registry of provider backends and implements a cascading failover mechanism.
|
||||
|
||||
** Backend Registry Variables
|
||||
|
||||
#+begin_src lisp :tangle ../library/reason.lisp
|
||||
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
|
||||
"A global mapping of provider identifiers (keywords) to their respective execution functions.")
|
||||
#+end_src
|
||||
"Registry mapping provider keywords (:openrouter, :ollama) to their calling functions.")
|
||||
|
||||
** Provider Cascade Configuration
|
||||
#+begin_src lisp :tangle ../library/reason.lisp
|
||||
(defvar *provider-cascade* nil
|
||||
"An ordered list of providers to attempt if the primary one fails.")
|
||||
#+end_src
|
||||
"Ordered list of provider keywords to try. First available provider wins.")
|
||||
|
||||
#+begin_src lisp :tangle ../library/reason.lisp
|
||||
(defvar *model-selector-fn* nil
|
||||
"A hook for dynamic model selection based on context complexity.")
|
||||
#+end_src
|
||||
"Optional function that selects a specific model for each provider.
|
||||
Signature: (funcall fn provider context) => model-name-string")
|
||||
|
||||
#+begin_src lisp :tangle ../library/reason.lisp
|
||||
(defvar *consensus-enabled-p* nil
|
||||
"Flag to enable parallel multi-model voting (not implemented in MVP).")
|
||||
"When T, run multiple providers and compare results for critical decisions.")
|
||||
#+end_src
|
||||
|
||||
** Backend Registration Helper
|
||||
** register-probabilistic-backend: Backend Registration
|
||||
|
||||
#+begin_src lisp :tangle ../library/reason.lisp
|
||||
(defun register-probabilistic-backend (name fn)
|
||||
"Registers a neural provider with its calling function."
|
||||
"Register a neural provider backend.
|
||||
|
||||
NAME is a keyword like :openrouter or :ollama.
|
||||
FN is a function with signature: (funcall fn prompt system-prompt &key model)
|
||||
returning either:
|
||||
- (list :status :success :content \"response text\")
|
||||
- (list :status :error :message \"error description\")
|
||||
- a simple string on success
|
||||
|
||||
Example registration:
|
||||
(register-probabilistic-backend :openrouter #'openrouter-call)"
|
||||
|
||||
(setf (gethash name *probabilistic-backends*) fn))
|
||||
#+end_src
|
||||
|
||||
* The Cognitive Cycle
|
||||
|
||||
** Probabilistic Call (probabilistic-call)
|
||||
The primary interface for neural reasoning. It iterates through the cascade until a successful response is achieved or the cascade is exhausted.
|
||||
** probabilistic-call: Cascade Dispatch
|
||||
|
||||
#+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."
|
||||
(defun probabilistic-call (prompt &key
|
||||
(system-prompt "You are the Probabilistic engine.")
|
||||
(cascade nil)
|
||||
(context nil))
|
||||
"Dispatch a neural request through the provider cascade.
|
||||
|
||||
PROMPT - The user's query or task description.
|
||||
SYSTEM-PROMPT - Instructions for how the LLM should behave.
|
||||
CASCADE - Override the default provider cascade.
|
||||
CONTEXT - Current signal context (for model selection).
|
||||
|
||||
Returns the LLM response as a string, or a failure plist if all providers fail.
|
||||
|
||||
The cascade mechanism ensures reliability: if OpenRouter is rate-limited,
|
||||
it automatically falls back to OpenAI, then Anthropic, etc."
|
||||
|
||||
(let ((backends (or cascade *provider-cascade*)))
|
||||
(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
|
||||
|
||||
;; Optional model selection based on context
|
||||
(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))))
|
||||
|
||||
;; Normalize result format
|
||||
(cond ((and (listp result) (eq (getf result :status) :success))
|
||||
(return (getf result :content)))
|
||||
((stringp result) (return result))
|
||||
(t (harness-log "PROBABILISTIC: Backend ~a failed: ~a" backend (getf result :message))))))))
|
||||
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
|
||||
((stringp result)
|
||||
(return result))
|
||||
(t
|
||||
(harness-log "PROBABILISTIC: Backend ~a failed: ~a"
|
||||
backend (getf result :message))))))))
|
||||
|
||||
;; All providers failed
|
||||
(list :type :LOG
|
||||
:payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
|
||||
#+end_src
|
||||
|
||||
** LLM Output Sanitization (strip-markdown)
|
||||
Modern LLMs often wrap Lisp code in markdown backticks. This helper ensures the code is clean before the Lisp reader touches it.
|
||||
* Cognitive Proposal Generation (Think)
|
||||
|
||||
The `think` function is the heart of the probabilistic engine. It constructs a prompt from context, sends it to the LLM, and parses the response into a structured action.
|
||||
|
||||
** strip-markdown: Clean LLM Output
|
||||
|
||||
#+begin_src lisp :tangle ../library/reason.lisp
|
||||
(defun strip-markdown (text)
|
||||
"Strips common markdown code block markers from text to ensure valid S-expression parsing."
|
||||
"Strip markdown formatting from LLM output.
|
||||
|
||||
LLMs often wrap their responses in code fences (```lisp ...```).
|
||||
This function removes those markers to extract the raw plist.
|
||||
|
||||
Handles:
|
||||
- Leading code fences with language tags: ```lisp
|
||||
- Trailing code fences: ```
|
||||
- Orphan closing fences: ```"
|
||||
|
||||
(if (and text (stringp text))
|
||||
(let ((cleaned text))
|
||||
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
|
||||
@@ -91,99 +150,295 @@ Modern LLMs often wrap Lisp code in markdown backticks. This helper ensures the
|
||||
text))
|
||||
#+end_src
|
||||
|
||||
** The Thought Process (Think)
|
||||
The core logic that prepares the "mind" for reasoning. It assembles the global awareness (Memex status, recent logs, active tasks) and provides a strict protocol template for the LLM to follow.
|
||||
** normalize-plist-keywords: Fix LLM Keyword Output
|
||||
|
||||
#+begin_src lisp :tangle ../library/reason.lisp
|
||||
(defun normalize-plist-keywords (plist)
|
||||
"Normalize all keys in a plist to keywords.
|
||||
|
||||
LLMs often return plists with unquoted keys: (TYPE REQUEST ...)
|
||||
instead of keyword syntax: (:TYPE :REQUEST ...)
|
||||
|
||||
This function converts all symbol keys to their keyword equivalents,
|
||||
making the plist compatible with standard Lisp property accessors.
|
||||
|
||||
Example transformation:
|
||||
(TYPE REQUEST PAYLOAD (ACTION MESSAGE TEXT \"Hi\"))
|
||||
=> (:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"Hi\"))"
|
||||
|
||||
(when (listp plist)
|
||||
(loop for (k . rest) on plist by #'cddr
|
||||
collect (if (and (symbolp k) (not (keywordp k)))
|
||||
(intern (string k) :keyword)
|
||||
k)
|
||||
collect (car rest))))
|
||||
#+end_src
|
||||
|
||||
** think: Generate Action Proposal
|
||||
|
||||
#+begin_src lisp :tangle ../library/reason.lisp
|
||||
(defun think (context)
|
||||
"Generates a Lisp action proposal based on current context."
|
||||
"Generate a Lisp action proposal based on current context.
|
||||
|
||||
This is the core cognitive function. It:
|
||||
|
||||
1. Finds the most relevant skill based on context
|
||||
2. Assembles global awareness (memory context, system logs)
|
||||
3. Constructs a detailed prompt with available tools
|
||||
4. Calls the LLM via probabilistic-call
|
||||
5. Parses the LLM response into a structured action plist
|
||||
|
||||
The LLM is instructed to respond with exactly ONE plist, never prose.
|
||||
This constraint makes parsing deterministic and prevents rambling.
|
||||
|
||||
Returns a plist with structure:
|
||||
(:TYPE :REQUEST :TARGET :CLI :PAYLOAD (:ACTION :MESSAGE :TEXT \"...\"))"
|
||||
|
||||
;; Gather context components
|
||||
(let* ((active-skill (find-triggered-skill context))
|
||||
(tool-belt (generate-tool-belt-prompt))
|
||||
(global-context (context-assemble-global-awareness))
|
||||
(system-logs (context-get-system-logs))
|
||||
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent")))
|
||||
(let* ((prompt-generator (when active-skill (skill-probabilistic-prompt active-skill)))
|
||||
(raw-prompt (if prompt-generator
|
||||
|
||||
;; Generate prompt from skill or raw text
|
||||
(let* ((prompt-generator (when active-skill
|
||||
(skill-probabilistic-prompt active-skill)))
|
||||
(raw-prompt (if prompt-generator
|
||||
(funcall prompt-generator context)
|
||||
;; Fallback: use raw user input
|
||||
(let ((p (proto-get (proto-get context :payload) :text)))
|
||||
(if (and p (stringp p)) p "Maintain metabolic stasis."))))
|
||||
(system-prompt (format nil "IDENTITY: ~a. MANDATE: Respond with ONE Lisp plist. ~a ~a RECENT_LOGS: ~a
|
||||
(if (and p (stringp p))
|
||||
p
|
||||
"Maintain metabolic stasis."))))
|
||||
(system-prompt (format nil
|
||||
"IDENTITY: ~a
|
||||
|
||||
You are a component of the OpenCortex neurosymbolic AI agent.
|
||||
Your task is to generate exactly ONE valid Lisp plist response.
|
||||
|
||||
MANDATE: Respond with ONE Lisp plist. Never output prose.
|
||||
|
||||
IMPORTANT: To reply to the user, you MUST use:
|
||||
(:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"<Response Text>\"))
|
||||
|
||||
To call a tool, you MUST use:
|
||||
(:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"<name>\" :ARGS (:arg1 \"val\"))
|
||||
|
||||
PROVIDER RULE: Always use the default cascade provider unless a specific model or capability is required for the task."
|
||||
assistant-name global-context tool-belt system-logs)))
|
||||
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
|
||||
MANDATORY VALIDATION RULE: Before declaring any Lisp code edit complete,
|
||||
you MUST call the `:validate-lisp` tool with the proposed code. If the tool
|
||||
returns `:status :error`, read the `:reason` and `:failed` fields, fix the
|
||||
defect, and re-validate. You are strictly forbidden from relying on your
|
||||
own paren-balancing or syntax intuition.
|
||||
|
||||
PROVIDER RULE: Always use the default cascade provider unless a specific
|
||||
model or capability is required for the task.
|
||||
|
||||
AVAILABLE TOOLS:
|
||||
~a
|
||||
|
||||
GLOBAL CONTEXT:
|
||||
~a
|
||||
|
||||
RECENT LOGS:
|
||||
~a"
|
||||
assistant-name
|
||||
tool-belt
|
||||
global-context
|
||||
system-logs)))
|
||||
|
||||
;; Call LLM and process response
|
||||
(let* ((thought (probabilistic-call raw-prompt
|
||||
:system-prompt system-prompt
|
||||
:context context))
|
||||
(cleaned (strip-markdown thought))
|
||||
(meta (proto-get context :meta))
|
||||
(source (proto-get meta :source)))
|
||||
(if (and cleaned (stringp cleaned))
|
||||
|
||||
(when cleaned
|
||||
(harness-log "THINK: LLM raw output = ~a"
|
||||
(subseq cleaned 0 (min 200 (length cleaned)))))
|
||||
|
||||
;; Parse LLM response
|
||||
(if (and cleaned (stringp cleaned) (> (length cleaned) 0))
|
||||
(let ((*read-eval* nil))
|
||||
(if (and (> (length cleaned) 0) (char= (char cleaned 0) #\())
|
||||
(handler-case
|
||||
(if (char= (char cleaned 0) #\()
|
||||
;; Response starts with paren - try to parse as plist
|
||||
(handler-case
|
||||
(let ((parsed (read-from-string cleaned)))
|
||||
(let ((type (proto-get parsed :TYPE))
|
||||
(target (or (proto-get parsed :TARGET) (proto-get parsed :target))))
|
||||
(cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
|
||||
(unless (proto-get parsed :target) (setf (getf parsed :target) (or source :CLI)))
|
||||
parsed)
|
||||
;; Handle raw plists or lists of plists that look like tool calls or data
|
||||
((or (eq target :TOOL) (eq target :tool) (getf parsed :TOOL) (getf parsed :tool)
|
||||
(and (listp parsed) (listp (car parsed)) (keywordp (caar parsed))))
|
||||
(list :TYPE :REQUEST :TARGET :TOOL :PAYLOAD parsed))
|
||||
(t (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))))
|
||||
(error (c) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
|
||||
(list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
|
||||
(when parsed
|
||||
(harness-log "THINK: parsed = ~a" parsed)
|
||||
|
||||
;; Normalize keyword keys (LLM often returns TYPE instead of :TYPE)
|
||||
(let ((parsed-normalized (normalize-plist-keywords parsed))
|
||||
(type (proto-get parsed :TYPE))
|
||||
(target (or (proto-get parsed :TARGET)
|
||||
(proto-get parsed :target))))
|
||||
|
||||
(cond
|
||||
;; Recognized message type - use directly
|
||||
((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
|
||||
(unless (proto-get parsed :target)
|
||||
(setf (getf parsed :target) (or source :CLI)))
|
||||
parsed-normalized)
|
||||
|
||||
;; Tool call detected - wrap in standard envelope
|
||||
((or (eq target :TOOL)
|
||||
(eq target :tool)
|
||||
(getf parsed :TOOL)
|
||||
(getf parsed :tool)
|
||||
(and (listp parsed)
|
||||
(listp (car parsed))
|
||||
(keywordp (caar parsed))))
|
||||
(list :TYPE :REQUEST
|
||||
:TARGET :TOOL
|
||||
:PAYLOAD (normalize-plist-keywords parsed)))
|
||||
|
||||
;; Unknown format - treat as user message
|
||||
(t
|
||||
(list :TYPE :REQUEST
|
||||
:TARGET (or source :CLI)
|
||||
:PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned)))))))
|
||||
(error (c)
|
||||
(harness-log "THINK ERROR: ~a" c)
|
||||
(list :TYPE :REQUEST
|
||||
:TARGET (or source :CLI)
|
||||
:PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
|
||||
|
||||
;; No leading paren - treat as plain text message
|
||||
(list :TYPE :REQUEST
|
||||
:TARGET (or source :CLI)
|
||||
:PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
|
||||
|
||||
;; No response from LLM
|
||||
thought)))))
|
||||
#+end_src
|
||||
|
||||
** Deterministic Verification
|
||||
The final safety check. It iterates through all active skills to verify that the proposed neural action does not violate any invariants.
|
||||
* Deterministic Engine (Formal Verification)
|
||||
|
||||
The deterministic engine runs all registered skills' verification functions. This is where safety checks, policy enforcement, and skill-specific processing happen.
|
||||
|
||||
** deterministic-verify: Skill Chain Verification
|
||||
|
||||
#+begin_src lisp :tangle ../library/reason.lisp
|
||||
(defun deterministic-verify (proposed-action context)
|
||||
"Iterates through all skill deterministic-gates sorted by priority. Ensures absolute safety of the neural proposal."
|
||||
"Run all skill deterministic gates on a proposed action.
|
||||
|
||||
Each skill can define a deterministic function that either:
|
||||
- Passes the action through unchanged
|
||||
- Modifies the action (adds explanation, changes target, etc.)
|
||||
- Blocks the action (returns a :LOG message instead)
|
||||
|
||||
Skills are sorted by priority (highest first). A skill with higher
|
||||
priority can intercept and modify actions before lower-priority
|
||||
skills see them.
|
||||
|
||||
The Bouncer Pattern: If any skill returns a :LOG or :EVENT type,
|
||||
processing stops and that message is returned immediately. This
|
||||
allows skills to veto actions.
|
||||
|
||||
Example skill chain:
|
||||
1. Policy skill (priority 500) - checks for missing explanations
|
||||
2. Protocol validator (priority 95) - validates message schema
|
||||
3. Shell actuator guard (priority 50) - checks command whitelist"
|
||||
|
||||
(let ((current-action proposed-action)
|
||||
(skills nil))
|
||||
(maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
|
||||
|
||||
;; Collect all skills with deterministic functions
|
||||
(maphash (lambda (name skill)
|
||||
(declare (ignore name))
|
||||
(when (skill-deterministic-fn skill)
|
||||
(push skill skills)))
|
||||
*skills-registry*)
|
||||
|
||||
;; Sort by priority (highest first)
|
||||
(setf skills (sort skills #'> :key #'skill-priority))
|
||||
|
||||
;; Run each skill's gate
|
||||
(dolist (skill skills)
|
||||
(let ((trigger (skill-trigger-fn skill))
|
||||
(gate (skill-deterministic-fn skill)))
|
||||
(when (or (null trigger) (ignore-errors (funcall trigger context)))
|
||||
|
||||
;; Skill activates if no trigger or trigger returns true
|
||||
(when (or (null trigger)
|
||||
(ignore-errors (funcall trigger context)))
|
||||
|
||||
;; Run the gate
|
||||
(let ((next-action (funcall gate current-action context)))
|
||||
(let ((original-type (proto-get current-action :type)))
|
||||
(when (and (listp next-action)
|
||||
(member (proto-get next-action :type) '(:LOG :EVENT :log :event))
|
||||
|
||||
;; Check if skill intercepted (returned LOG/EVENT instead of REQUEST)
|
||||
(when (and (listp next-action)
|
||||
(member (proto-get next-action :type)
|
||||
'(:LOG :EVENT :log :event))
|
||||
(or (not (member original-type '(:LOG :EVENT :log :event)))
|
||||
(not (eq next-action current-action))))
|
||||
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
|
||||
|
||||
;; Skill blocked or modified - stop processing
|
||||
(harness-log "DETERMINISTIC: Intercepted by skill '~a'"
|
||||
(skill-name skill))
|
||||
(return-from deterministic-verify next-action)))
|
||||
|
||||
;; Action passed through - continue to next skill
|
||||
(setf current-action next-action)))))
|
||||
|
||||
;; Return final action (may be modified by skills, or original if all passed)
|
||||
current-action))
|
||||
#+end_src
|
||||
|
||||
* The Reasoning Pipeline Stage
|
||||
* Reason Gate (Pipeline Stage)
|
||||
|
||||
** Reasoning Gate (reason-gate)
|
||||
The stage that ties it all together. It filters stimuli that don't require cognition (like internal heartbeat pulses) and executes the hybrid neural-logical loop.
|
||||
** reason-gate: The Stage Function
|
||||
|
||||
#+begin_src lisp :tangle ../library/reason.lisp
|
||||
(defun reason-gate (signal)
|
||||
"Unified Stage: Combines Probabilistic proposals and Deterministic verification."
|
||||
"Stage 2 of the metabolic pipeline: Reason.
|
||||
|
||||
Transforms perceived signals into approved actions by combining:
|
||||
1. Probabilistic reasoning (LLM generates proposal)
|
||||
2. Deterministic verification (skills validate proposal)
|
||||
|
||||
Only processes :EVENT signals with :user-input or :chat-message sensors.
|
||||
Other signals pass through unchanged (heartbeats, tool outputs, etc.).
|
||||
|
||||
Modifies the signal in place by setting:
|
||||
- :approved-action - The final verified action, or NIL
|
||||
- :status - :reasoned
|
||||
|
||||
Returns the modified signal."
|
||||
|
||||
(let* ((type (proto-get signal :type))
|
||||
(payload (proto-get signal :payload))
|
||||
(sensor (proto-get payload :sensor)))
|
||||
;; Optimization: Only reason about user input or chat messages.
|
||||
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
|
||||
|
||||
;; Only reason about user input, not internal signals
|
||||
(unless (and (eq type :EVENT)
|
||||
(member sensor '(:user-input :chat-message)))
|
||||
(return-from reason-gate signal))
|
||||
|
||||
;; Generate proposal via LLM
|
||||
(let ((candidate (think signal)))
|
||||
(if candidate
|
||||
(setf (getf signal :approved-action) (deterministic-verify candidate signal))
|
||||
(setf (getf signal :approved-action) nil))
|
||||
|
||||
(harness-log "REASON: candidate type = ~a" (type-of candidate))
|
||||
|
||||
;; Validate candidate is a proper plist (not an error string or symbol)
|
||||
(if (and candidate
|
||||
(listp candidate)
|
||||
(or (keywordp (car candidate))
|
||||
(eq (car candidate) 'TYPE)
|
||||
(eq (car candidate) 'type)))
|
||||
|
||||
;; Valid proposal - run through deterministic verification
|
||||
(setf (getf signal :approved-action)
|
||||
(deterministic-verify candidate signal))
|
||||
|
||||
;; Invalid response - log and drop
|
||||
(progn
|
||||
(harness-log "REASON: Invalid candidate type ~a, dropping"
|
||||
(type-of candidate))
|
||||
(setf (getf signal :approved-action) nil)))
|
||||
|
||||
(setf (getf signal :status) :reasoned)
|
||||
signal)))
|
||||
#+end_src
|
||||
#+end_src
|
||||
@@ -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
|
||||
@@ -252,7 +272,7 @@ WORKDIR /app
|
||||
COPY . .
|
||||
|
||||
# Initialize system in non-interactive mode
|
||||
RUN mkdir -p /root/memex /app/environment/logs && ./opencortex.sh setup --non-interactive
|
||||
RUN mkdir -p /root/memex && ./opencortex.sh setup --non-interactive
|
||||
|
||||
EXPOSE 9105
|
||||
|
||||
|
||||
@@ -4,136 +4,359 @@
|
||||
#+STARTUP: content
|
||||
|
||||
* The Skill Engine (skills.lisp)
|
||||
** Architectural Intent: Late-Binding Intelligence
|
||||
|
||||
** Architectural Intent: Hot-Reloadable Intelligence
|
||||
The Skill Engine is the modular heart of the OpenCortex. By separating cognitive and physical capabilities into discrete "Skills," we allow the system to evolve without modifying the core Lisp microharness.
|
||||
A static, hardcoded architecture is inherently fragile. The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing the system to discover and integrate new cognitive capabilities (actuators, solvers, sensors) at runtime without a kernel restart.
|
||||
|
||||
*** Core Principles
|
||||
1. **Isolation:** Every skill resides in its own Lisp package, preventing global namespace pollution and variable collisions.
|
||||
2. **Topological Bootstrapping:** Skills can declare dependencies on other skills. The harness automatically calculates the correct loading order.
|
||||
3. **Hot-Reloading:** Since Skills are defined as Literate Org files, the agent can edit, re-tangle, and re-load its own skills at runtime without a system restart.
|
||||
4. **The Bouncer Pattern:** Every skill must define a deterministic gate. This is the primary security layer where native Lisp logic verifies probabilistic AI proposals.
|
||||
** Global Skill Registry
|
||||
|
||||
** Pipeline Initialization
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
* Skill Definition and Registration
|
||||
(defun COSINE-SIMILARITY (v1 v2)
|
||||
"Computes the cosine similarity between two vectors.
|
||||
Both arguments should be sequences of numbers. Returns a value between -1.0 and 1.0."
|
||||
(let ((len1 (length v1)) (len2 (length v2)))
|
||||
(if (or (zerop len1) (zerop len2))
|
||||
0.0
|
||||
(let ((dot-product 0.0d0)
|
||||
(norm1 0.0d0)
|
||||
(norm2 0.0d0))
|
||||
(let ((len (min len1 len2)))
|
||||
(dotimes (i len)
|
||||
(let ((x (coerce (elt v1 i) 'double-float)))
|
||||
(let ((y (coerce (elt v2 i) 'double-float)))
|
||||
(incf dot-product (* x y))
|
||||
(incf norm1 (* x x))
|
||||
(incf norm2 (* y y))))))
|
||||
(if (or (zerop norm1) (zerop norm2))
|
||||
0.0
|
||||
(/ dot-product (sqrt (* norm1 norm2))))))))
|
||||
(defun VAULT-MASK-STRING (s) "[MASKED]") ; Stub
|
||||
(defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
|
||||
|
||||
** The Skill Structure
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(defstruct skill
|
||||
"Represents a hot-reloadable module of intelligence or actuation."
|
||||
name
|
||||
priority
|
||||
dependencies
|
||||
trigger-fn
|
||||
probabilistic-prompt
|
||||
deterministic-fn)
|
||||
#+end_src
|
||||
|
||||
** Skill Registration Macro (defskill)
|
||||
This macro provides a clean interface for skill authors to register their modules. It automatically handles the integration with the global ~*skills-registry*~.
|
||||
(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn)
|
||||
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(defmacro defskill (name &key (priority 0) dependencies trigger probabilistic deterministic)
|
||||
"Registers a new skill into the global harness registry."
|
||||
`(setf (gethash (string-downcase (string ',name)) *skills-registry*)
|
||||
(make-skill :name (string-downcase (string ',name))
|
||||
:priority ,priority
|
||||
:dependencies ,dependencies
|
||||
:trigger-fn ,trigger
|
||||
:probabilistic-prompt ,probabilistic
|
||||
(defvar *skill-catalog* (make-hash-table :test 'equal)
|
||||
"A stateful tracking table for all skill files discovered in the environment.")
|
||||
|
||||
(defstruct skill-entry
|
||||
filename
|
||||
(status :discovered) ;; :discovered, :loading, :ready, :failed
|
||||
error-log
|
||||
(load-time 0))
|
||||
|
||||
(defun find-triggered-skill (context)
|
||||
"Returns the highest priority skill whose trigger matches context AND has a probabilistic prompt."
|
||||
(let ((triggered nil))
|
||||
(maphash (lambda (name skill)
|
||||
(declare (ignore name))
|
||||
(when (and (skill-probabilistic-prompt skill)
|
||||
(ignore-errors (funcall (skill-trigger-fn skill) context)))
|
||||
(push skill triggered)))
|
||||
*skills-registry*)
|
||||
(first (sort triggered #'> :key #'skill-priority))))
|
||||
|
||||
(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic)
|
||||
"Registers a new skill into the global registry."
|
||||
`(setf (gethash (string-downcase (string ,name)) *skills-registry*)
|
||||
(make-skill :name (string-downcase (string ,name))
|
||||
:priority (or ,priority 10)
|
||||
:dependencies ',dependencies
|
||||
:trigger-fn ,trigger
|
||||
:probabilistic-prompt ,probabilistic
|
||||
:deterministic-fn ,deterministic)))
|
||||
|
||||
(defun resolve-skill-dependencies (skill-name)
|
||||
"Recursively resolves dependencies for a given skill name."
|
||||
(let ((resolved nil) (seen nil))
|
||||
(labels ((visit (name)
|
||||
(unless (member name seen :test #'equal)
|
||||
(push name seen)
|
||||
(let ((skill (gethash (string-downcase (string name)) *skills-registry*)))
|
||||
(when skill
|
||||
(dolist (dep (skill-dependencies skill))
|
||||
(visit dep))))
|
||||
(push name resolved))))
|
||||
(visit skill-name)
|
||||
(nreverse resolved))))
|
||||
#+end_src
|
||||
|
||||
* Dynamic Loading System
|
||||
|
||||
** Lisp Syntax Validation (validate-lisp-syntax)
|
||||
Before loading a new skill into the live image, the harness performs a dry-run parse to ensure the code is syntactically valid. This prevents a single hallucinated parenthesis from crashing the entire brain.
|
||||
|
||||
** Skill File Analysis (parse-skill-metadata)
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(defun validate-lisp-syntax (file-path)
|
||||
"Parses a Lisp file without evaluation to verify syntactic integrity."
|
||||
(handler-case
|
||||
(with-open-file (stream file-path)
|
||||
(loop for form = (read stream nil :eof)
|
||||
until (eq form :eof))
|
||||
t)
|
||||
(error (c)
|
||||
(harness-log "SYNTAX ERROR in ~a: ~a" file-path c)
|
||||
nil)))
|
||||
(defun parse-skill-metadata (filepath)
|
||||
"Extracts ID and DEPENDS_ON tags using robust regex scanning."
|
||||
(let ((dependencies nil)
|
||||
(id nil)
|
||||
(content (uiop:read-file-string filepath)))
|
||||
;; Extract ID
|
||||
(multiple-value-bind (match regs)
|
||||
(ppcre:scan-to-strings "(?im:^:ID:\\s*([^\\s\\r\\n]+))" content)
|
||||
(when match (setf id (aref regs 0))))
|
||||
;; Extract all DEPENDS_ON lines
|
||||
(ppcre:do-register-groups (deps-string)
|
||||
("(?im:^#\\+DEPENDS_ON:\\s*(.*))" content)
|
||||
(let ((deps (ppcre:split "\\s+" (string-trim " " deps-string))))
|
||||
(setf dependencies (append dependencies (mapcar (lambda (s) (string-trim "[] " s)) deps)))))
|
||||
(values id (remove-if (lambda (s) (= 0 (length s))) dependencies))))
|
||||
#+end_src
|
||||
|
||||
** Literate Skill Ingestion (load-skill-from-org)
|
||||
The primary mechanism for hot-reloading. It handles the Org-to-Lisp translation and ensures the resulting code is jailed within its own package.
|
||||
|
||||
** Dependency Resolution (topological-sort-skills)
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(defun load-skill-from-org (org-file-path)
|
||||
"Tangles and loads a single Org-mode skill file."
|
||||
(let* ((filename (file-name-nondirectory (namestring org-file-path)))
|
||||
(skill-id (pathname-name org-file-path))
|
||||
(lisp-file (merge-pathnames (concatenate 'string "library/gen/" skill-id ".lisp")
|
||||
(asdf:system-source-directory :opencortex))))
|
||||
(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"))
|
||||
(adj (make-hash-table :test 'equal))
|
||||
(name-to-file (make-hash-table :test 'equal))
|
||||
(id-to-file (make-hash-table :test 'equal))
|
||||
(result nil)
|
||||
(visited (make-hash-table :test 'equal))
|
||||
(stack (make-hash-table :test 'equal)))
|
||||
(dolist (file files)
|
||||
(let ((filename (pathname-name file)))
|
||||
(multiple-value-bind (id deps) (parse-skill-metadata file)
|
||||
(setf (gethash (string-downcase filename) name-to-file) file)
|
||||
(when id (setf (gethash (string-downcase id) id-to-file) file))
|
||||
(setf (gethash (string-downcase filename) adj) deps))))
|
||||
(labels ((visit (file)
|
||||
(let* ((filename (pathname-name file))
|
||||
(node-key (string-downcase filename)))
|
||||
(unless (gethash node-key visited)
|
||||
(setf (gethash node-key stack) t)
|
||||
(dolist (dep (gethash node-key adj))
|
||||
(let* ((is-id-p (uiop:string-prefix-p "id:" (string-downcase dep)))
|
||||
(dep-key (string-downcase (if is-id-p (subseq dep 3) dep)))
|
||||
(dep-file (if is-id-p
|
||||
(gethash dep-key id-to-file)
|
||||
(or (gethash dep-key id-to-file)
|
||||
(gethash dep-key name-to-file)))))
|
||||
(when dep-file
|
||||
(let ((dep-filename (pathname-name dep-file)))
|
||||
(if (gethash (string-downcase dep-filename) stack)
|
||||
(error "Circular dependency detected: ~a -> ~a" filename dep-filename)
|
||||
(visit dep-file))))))
|
||||
(setf (gethash node-key stack) nil)
|
||||
(setf (gethash node-key visited) t)
|
||||
(push file result)))))
|
||||
(let ((filenames (sort (mapcar #'pathname-name files) #'string<)))
|
||||
(dolist (name filenames)
|
||||
(let ((file (gethash (string-downcase name) name-to-file)))
|
||||
(when file (visit file)))))
|
||||
(nreverse result))))
|
||||
#+end_src
|
||||
|
||||
** Jailed Loading (load-skill-from-org)
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(defun validate-lisp-syntax (code-string)
|
||||
"Checks if a string contains valid, readable Common Lisp forms.
|
||||
Delegates to the Lisp Validator skill when available; falls back to a basic
|
||||
reader check during early boot before the validator skill is loaded."
|
||||
(let ((result
|
||||
(if (fboundp 'lisp-validator-validate)
|
||||
(lisp-validator-validate code-string :strict nil)
|
||||
(handler-case
|
||||
(let ((*read-eval* nil))
|
||||
(with-input-from-string (stream (format nil "(progn ~a)" code-string))
|
||||
(loop for form = (read stream nil :eof) until (eq form :eof)))
|
||||
(list :status :success))
|
||||
(error (c)
|
||||
(list :status :error :reason (format nil "~a" c)))))))
|
||||
(if (eq (getf result :status) :success)
|
||||
(values t nil)
|
||||
(values nil (or (getf result :reason) "Lisp Validator rejected code.")))))
|
||||
|
||||
(defun load-skill-from-org (filepath)
|
||||
"Parses and evaluates Lisp blocks with :tangle directives from an Org file.
|
||||
Only loads blocks that specify a .lisp tangle target, ignoring tests and examples."
|
||||
(let* ((skill-base-name (pathname-name filepath))
|
||||
(entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))
|
||||
(setf (skill-entry-status entry) :loading)
|
||||
(setf (gethash skill-base-name *skill-catalog*) entry)
|
||||
|
||||
(ensure-directories-exist lisp-file)
|
||||
(harness-log "LOADER: Loading ~a..." skill-id)
|
||||
(handler-case
|
||||
(let* ((content (uiop:read-file-string filepath))
|
||||
(lines (uiop:split-string content :separator '(#\Newline)))
|
||||
(in-lisp-block nil)
|
||||
(collect-this-block nil)
|
||||
(lisp-code "")
|
||||
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword)))
|
||||
|
||||
(dolist (line lines)
|
||||
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
|
||||
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line))
|
||||
(setf in-lisp-block t)
|
||||
;; Only collect blocks with a :tangle directive pointing to a
|
||||
;; runtime .lisp file (exclude tests and :tangle no)
|
||||
(let ((tl (string-downcase clean-line)))
|
||||
(setf collect-this-block
|
||||
(and (search ":tangle" tl)
|
||||
(not (search ":tangle no" tl))
|
||||
(search ".lisp" tl)
|
||||
(not (search "tests/" tl))
|
||||
(not (search "test/" tl))))))
|
||||
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line))
|
||||
(setf in-lisp-block nil)
|
||||
(setf collect-this-block nil))
|
||||
((and in-lisp-block collect-this-block)
|
||||
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
|
||||
(uiop:string-prefix-p ":END:" (string-upcase clean-line)))
|
||||
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
|
||||
|
||||
(if (= (length lisp-code) 0)
|
||||
(progn (setf (skill-entry-status entry) :ready) t)
|
||||
(progn
|
||||
(multiple-value-bind (valid-p err) (validate-lisp-syntax lisp-code)
|
||||
(unless valid-p (error "Syntax Error: ~a" err)))
|
||||
(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))))
|
||||
(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)
|
||||
t)))
|
||||
(error (c)
|
||||
(let ((msg (format nil "~a" c)))
|
||||
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name msg)
|
||||
(setf (skill-entry-status entry) :failed)
|
||||
(setf (skill-entry-error-log entry) msg)
|
||||
nil)))))
|
||||
|
||||
;; 1. Tangle the Org file into Lisp
|
||||
(uiop:run-program (list "emacs" "--batch" "--eval" "(require 'org)"
|
||||
"--eval" (format nil "(org-babel-tangle-file \"~a\")" org-file-path))
|
||||
:output t)
|
||||
|
||||
;; 2. Verify and Load
|
||||
(if (validate-lisp-syntax lisp-file)
|
||||
(progn
|
||||
(handler-case (load lisp-file)
|
||||
(error (c) (harness-log "LOADER ERROR in skill '~a': ~a" skill-id c)))
|
||||
t)
|
||||
nil)))
|
||||
(defun load-skill-with-timeout (filepath timeout-seconds)
|
||||
"Loads a skill Org file with a hard execution timeout."
|
||||
(let* ((finished nil)
|
||||
(thread (bt:make-thread (lambda ()
|
||||
(if (load-skill-from-org filepath)
|
||||
(setf finished t)
|
||||
(setf finished :error)))
|
||||
:name (format nil "loader-~a" (pathname-name filepath))))
|
||||
(start-time (get-internal-real-time))
|
||||
(timeout-units (truncate (* timeout-seconds internal-time-units-per-second))))
|
||||
(loop
|
||||
(when (eq finished t) (return :success))
|
||||
(when (eq finished :error) (return :error))
|
||||
(unless (bt:thread-alive-p thread) (return :error))
|
||||
(when (> (- (get-internal-real-time) start-time) timeout-units)
|
||||
(harness-log "HARNESS: Timing out skill ~a..." (pathname-name filepath))
|
||||
#+sbcl (sb-thread:terminate-thread thread)
|
||||
#-sbcl (bt:destroy-thread thread)
|
||||
(return :timeout))
|
||||
(sleep 0.05))))
|
||||
#+end_src
|
||||
|
||||
* Bootstrapping Logic
|
||||
|
||||
** Dependency Sorting (topological-sort-skills)
|
||||
Ensures that foundational skills (like the Bouncer or Policy engine) are always loaded before higher-level actuators.
|
||||
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(defun topological-sort-skills (skills)
|
||||
"Calculates the correct loading order based on #+DEPENDS_ON metadata."
|
||||
;; Placeholder: Currently sorts by priority as a proxy for dependencies.
|
||||
(sort skills #'> :key #'skill-priority))
|
||||
#+end_src
|
||||
|
||||
** Registry Initialization (initialize-all-skills)
|
||||
The high-level boot sequence for the skill engine.
|
||||
|
||||
** Initializing All Skills (initialize-all-skills)
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(defun initialize-all-skills ()
|
||||
"Discovers and loads all Org files in the SKILLS_DIR."
|
||||
(let* ((skills-dir (uiop:getenv "SKILLS_DIR"))
|
||||
(files (when (and skills-dir (uiop:directory-exists-p skills-dir))
|
||||
(uiop:directory-files skills-dir "*.org"))))
|
||||
(dolist (f files)
|
||||
(load-skill-from-org f))
|
||||
(harness-log "LOADER: Boot Complete. [Ready: ~a] [Failed: 0]" (hash-table-count *skills-registry*))))
|
||||
"Scans the directory defined by SKILLS_DIR and hot-loads skills using topological order."
|
||||
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
|
||||
(skills-dir-str (or env-path (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
|
||||
(resolved-path (context-resolve-path skills-dir-str))
|
||||
(skills-dir (if resolved-path (uiop:ensure-directory-pathname resolved-path) nil)))
|
||||
|
||||
(unless (and skills-dir (uiop:directory-exists-p skills-dir))
|
||||
(harness-log "HARNESS ERROR: Skills directory not found: ~a" skills-dir-str)
|
||||
(return-from initialize-all-skills nil))
|
||||
|
||||
(let ((sorted-files (topological-sort-skills skills-dir)))
|
||||
(let* ((mandatory-env (uiop:getenv "MANDATORY_SKILLS"))
|
||||
(mandatory-skills (if mandatory-env
|
||||
(mapcar (lambda (s) (string-trim '(#\Space #\" #\') s))
|
||||
(uiop:split-string mandatory-env :separator '( #\,)))
|
||||
'("org-skill-policy" "org-skill-bouncer"))))
|
||||
(dolist (req mandatory-skills)
|
||||
(unless (member req sorted-files :key #'pathname-name :test #'string-equal)
|
||||
(error "BOOT FAILURE: Mandatory skill '~a' not found in skills directory: ~a" req (uiop:native-namestring skills-dir))))
|
||||
|
||||
(harness-log "==================================================")
|
||||
(harness-log " LOADER: Initializing ~a skills..." (length sorted-files))
|
||||
|
||||
(dolist (file sorted-files)
|
||||
(let* ((skill-name (pathname-name file))
|
||||
(is-mandatory (member skill-name mandatory-skills :test #'string-equal)))
|
||||
(harness-log " LOADER: Loading ~a..." skill-name)
|
||||
(let ((status (load-skill-with-timeout file 5)))
|
||||
(unless (eq status :success)
|
||||
(if is-mandatory
|
||||
(error "BOOT FAILURE: Mandatory skill '~a' failed to load (Status: ~a)." skill-name status)
|
||||
(harness-log "LOADER WARNING: Skill '~a' failed to load." skill-name))))))
|
||||
|
||||
(let ((ready 0) (failed 0))
|
||||
(maphash (lambda (k v)
|
||||
(declare (ignore k))
|
||||
(if (eq (skill-entry-status v) :ready) (incf ready) (incf failed)))
|
||||
*skill-catalog*)
|
||||
(harness-log " LOADER: Boot Complete. [Ready: ~a] [Failed: ~a]" ready failed)
|
||||
(harness-log "==================================================")
|
||||
(values ready failed))))))
|
||||
#+end_src
|
||||
|
||||
* Cognitive Dispatching
|
||||
|
||||
** Skill Trigger Discovery (find-triggered-skill)
|
||||
Identifies which skill is best suited to handle the current metabolic signal.
|
||||
|
||||
** Toolbelt Prompt Generation (generate-tool-belt-prompt)
|
||||
#+begin_src lisp :tangle ../library/skills.lisp
|
||||
(defun find-triggered-skill (context)
|
||||
"Iterates through the registry and returns the first skill whose trigger returns true."
|
||||
(let ((skills nil))
|
||||
(maphash (lambda (name skill) (declare (ignore name)) (push skill skills)) *skills-registry*)
|
||||
(setf skills (sort skills #'> :key #'skill-priority))
|
||||
(dolist (s skills)
|
||||
(let ((trigger (skill-trigger-fn s)))
|
||||
(when (and trigger (funcall trigger context))
|
||||
(return-from find-triggered-skill s))))
|
||||
nil))
|
||||
(defun generate-tool-belt-prompt ()
|
||||
"Aggregates all registered cognitive tools into a descriptive prompt."
|
||||
(let ((output (format nil "AVAILABLE TOOLS:
|
||||
You can call tools by returning a Lisp plist: (:target :tool :action :call :tool <name> :args (...))
|
||||
|
||||
EXAMPLES:
|
||||
(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\"))
|
||||
(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"autonomousty\"))
|
||||
(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\"))
|
||||
|
||||
---
|
||||
" )))
|
||||
(maphash (lambda (name tool)
|
||||
(setf output (concatenate 'string output
|
||||
(format nil "- ~a: ~a~% Parameters: ~s~%~%"
|
||||
name
|
||||
(cognitive-tool-description tool)
|
||||
(cognitive-tool-parameters tool)))))
|
||||
*cognitive-tools*)
|
||||
output))
|
||||
#+end_src
|
||||
|
||||
** The Default Tool Belt
|
||||
*** The Eval Tool (Internal Inspection)
|
||||
#+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)
|
||||
(declare (ignore context))
|
||||
(let ((code (getf args :code)))
|
||||
(let ((harness-pkg (find-package :opencortex.skills.org-skill-lisp-validator)))
|
||||
(if harness-pkg
|
||||
(uiop:symbol-call :opencortex.skills.org-skill-lisp-validator :lisp-validator-validate code)
|
||||
t))))
|
||||
:body (lambda (args)
|
||||
(let ((code (getf args :code)))
|
||||
(handler-case (let ((result (eval (read-from-string code))))
|
||||
(format nil "~s" result))
|
||||
(error (c) (format nil "ERROR: ~a" c))))))
|
||||
#+end_src
|
||||
|
||||
*** The Grep Tool (File Discovery)
|
||||
#+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)"))
|
||||
:body (lambda (args)
|
||||
(let ((pattern (getf args :pattern))
|
||||
(dir (or (getf args :dir) (uiop:getenv "MEMEX_DIR"))))
|
||||
(uiop:run-program (list "grep" "-r" "-n" "--exclude-dir=node_modules" pattern dir)
|
||||
:output :string :ignore-error-status t))))
|
||||
#+end_src
|
||||
|
||||
*** The Shell Tool (Machine Actuation)
|
||||
#+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)
|
||||
(declare (ignore context))
|
||||
(let ((cmd (getf args :cmd)))
|
||||
(not (or (search "rm -rf /" cmd) (search ":(){ :|:& };:" cmd)))))
|
||||
:body (lambda (args)
|
||||
(let ((cmd (getf args :cmd)))
|
||||
(multiple-value-bind (out err code)
|
||||
(uiop:run-program (list "bash" "-c" cmd) :output :string :error-output :string :ignore-error-status t)
|
||||
(format nil "EXIT-CODE: ~a~%~%STDOUT:~%~a~%~%STDERR:~%~a" code out err)))))
|
||||
#+end_src
|
||||
|
||||
@@ -1,65 +1,44 @@
|
||||
#+TITLE: OpenCortex TUI Client (tui-client.lisp)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :tui:ux:client:
|
||||
:PROPERTIES:
|
||||
:ID: tui-client-spec
|
||||
:CREATED: [2026-04-17 Fri 11:00]
|
||||
:END:
|
||||
#+TITLE: OpenCortex TUI Client (Standalone)
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :tui:ux:client:
|
||||
|
||||
* OpenCortex TUI Client (tui-client.lisp)
|
||||
* Overview
|
||||
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.
|
||||
|
||||
** Architectural Intent: High-Fidelity Interaction
|
||||
The TUI Client is a standalone consumer of the OpenCortex protocol. It uses the ~croatoan~ (ncurses) library to provide a split-pane, interactive terminal experience.
|
||||
|
||||
*** Design Requirements
|
||||
1. **Concurrency:** The client must listen for incoming protocol events (heartbeats, status updates, thoughts) in a background thread to prevent the UI from freezing.
|
||||
2. **Buffer Safety:** User input must be captured in a thread-safe buffer and framed correctly before being sent to the daemon.
|
||||
3. **Transparency:** The status bar must provide real-time feedback on the state of background workers (Scribe and Gardener).
|
||||
|
||||
** Package Context
|
||||
* Implementation
|
||||
#+begin_src lisp :tangle ../library/tui-client.lisp
|
||||
(in-package :cl-user)
|
||||
(defpackage :opencortex.tui (:use :cl :croatoan) (:export :main))
|
||||
(defpackage :opencortex.tui
|
||||
(:use :cl :croatoan)
|
||||
(:export :main))
|
||||
(in-package :opencortex.tui)
|
||||
#+end_src
|
||||
|
||||
* UI State Management
|
||||
|
||||
** Networking and Streams
|
||||
#+begin_src lisp :tangle ../library/tui-client.lisp
|
||||
(defvar *daemon-host* "127.0.0.1")
|
||||
(defvar *daemon-port* 9105)
|
||||
(defvar *socket* nil)
|
||||
(defvar *stream* nil)
|
||||
#+end_src
|
||||
|
||||
** Terminal Buffers
|
||||
#+begin_src lisp :tangle ../library/tui-client.lisp
|
||||
(defvar *chat-history* nil "A list of strings representing the scrollback buffer.")
|
||||
(defvar *input-buffer* (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))
|
||||
(defvar *is-running* t)
|
||||
(defvar *chat-history* (list))
|
||||
(defvar *status-text* "Connecting...")
|
||||
#+end_src
|
||||
|
||||
** Thread-Safe Message Queue
|
||||
We use a simple locked queue to move messages from the background listener thread to the foreground rendering loop.
|
||||
|
||||
#+begin_src lisp :tangle ../library/tui-client.lisp
|
||||
(defvar *msg-queue* nil)
|
||||
(defvar *queue-lock* (bt:make-lock "tui-msg-lock"))
|
||||
(defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t))
|
||||
(defvar *is-running* t)
|
||||
(defvar *queue-lock* (bt:make-lock))
|
||||
(defvar *incoming-msgs* nil)
|
||||
|
||||
(defun enqueue-msg (msg)
|
||||
(bt:with-lock-held (*queue-lock*) (push msg *msg-queue*)))
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
(push msg *incoming-msgs*)))
|
||||
|
||||
(defun dequeue-msgs ()
|
||||
(bt:with-lock-held (*queue-lock*) (let ((m (reverse *msg-queue*))) (setf *msg-queue* nil) m)))
|
||||
#+end_src
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
(let ((msgs (nreverse *incoming-msgs*)))
|
||||
(setf *incoming-msgs* nil)
|
||||
msgs)))
|
||||
|
||||
* Protocol Integration
|
||||
|
||||
** Keyword Sanitization (clean-keywords)
|
||||
Clients often receive data with inconsistent keyword casing. This helper ensures all incoming keys are normalized for easier processing.
|
||||
|
||||
#+begin_src lisp :tangle ../library/tui-client.lisp
|
||||
(defun clean-keywords (msg)
|
||||
"Ensures all keys in a plist are uppercase keywords."
|
||||
(if (listp msg)
|
||||
(let ((clean nil))
|
||||
(loop for (k v) on msg by #'cddr
|
||||
@@ -67,12 +46,7 @@ Clients often receive data with inconsistent keyword casing. This helper ensures
|
||||
(push v clean))
|
||||
(nreverse clean))
|
||||
msg))
|
||||
#+end_src
|
||||
|
||||
** Payload Extraction (format-payload)
|
||||
The core "intelligence" of the TUI display. It recursively searches a protocol payload for the most relevant human-readable content.
|
||||
|
||||
#+begin_src lisp :tangle ../library/tui-client.lisp
|
||||
(defun format-payload (payload)
|
||||
"Extracts human-readable text from a protocol payload, handling nested tool calls."
|
||||
(let* ((action (getf payload :ACTION))
|
||||
@@ -93,12 +67,7 @@ The core "intelligence" of the TUI display. It recursively searches a protocol p
|
||||
(format nil "CALL [~a] (ARGS: ~s)" tool args))))
|
||||
(result (format nil "RESULT: ~a" result))
|
||||
(t (format nil "~s" payload)))))
|
||||
#+end_src
|
||||
|
||||
** Background Listener (listen-thread)
|
||||
Runs as a separate thread. It continuously reads framed messages from the daemon and enqueues them for the UI.
|
||||
|
||||
#+begin_src lisp :tangle ../library/tui-client.lisp
|
||||
(defun listen-thread ()
|
||||
(loop while *is-running* do
|
||||
(handler-case
|
||||
@@ -128,16 +97,8 @@ Runs as a separate thread. It continuously reads framed messages from the daemon
|
||||
(when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
|
||||
(error (c) (setf *status-text* (format nil "Net Error: ~a" c)) (setf *is-running* nil)))
|
||||
(sleep 0.05)))
|
||||
#+end_src
|
||||
|
||||
* Main Interaction Loop
|
||||
|
||||
** TUI Entry Point (main)
|
||||
Initializes the ncurses screen, sets up the window layout, and handles user keyboard input.
|
||||
|
||||
#+begin_src lisp :tangle ../library/tui-client.lisp
|
||||
(defun main ()
|
||||
"Primary entry point for the standalone TUI client."
|
||||
(handler-case
|
||||
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
|
||||
(error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
|
||||
@@ -157,12 +118,11 @@ Initializes the ncurses screen, sets up the window layout, and handles user keyb
|
||||
(setf (input-blocking input-win) nil)
|
||||
|
||||
(loop while *is-running* do
|
||||
;; 1. Handle incoming messages from the queue
|
||||
;; 1. Handle incoming messages
|
||||
(let ((new-msgs (dequeue-msgs)))
|
||||
(when new-msgs
|
||||
(dolist (msg new-msgs)
|
||||
(push msg *chat-history*)
|
||||
;; Maintenance: Cap scrollback to prevent memory bloat
|
||||
(setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))
|
||||
|
||||
(clear chat-win)
|
||||
@@ -172,7 +132,7 @@ Initializes the ncurses screen, sets up the window layout, and handles user keyb
|
||||
(incf line-num)))
|
||||
(refresh chat-win)))
|
||||
|
||||
;; 2. Render Status Bar
|
||||
;; 2. Render Status Bar ONLY if changed
|
||||
(unless (equal *status-text* last-status)
|
||||
(clear status-win)
|
||||
(add-string status-win *status-text* :attributes '(:reverse))
|
||||
@@ -188,7 +148,9 @@ Initializes the ncurses screen, sets up the window layout, and handles user keyb
|
||||
(let ((cmd (coerce *input-buffer* 'string)))
|
||||
(setf (fill-pointer *input-buffer*) 0)
|
||||
(when (> (length cmd) 0)
|
||||
;; Frame and dispatch the message
|
||||
;; Local Echo
|
||||
(enqueue-msg (concatenate 'string "> " cmd))
|
||||
;; Send to Brain
|
||||
(let ((framed (opencortex:frame-message (list :TYPE :EVENT
|
||||
:META (list :SOURCE :tui :SESSION-ID "default")
|
||||
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))))
|
||||
|
||||
@@ -1,46 +0,0 @@
|
||||
#!/bin/bash
|
||||
# opencortex: Bare Metal Installation Script
|
||||
# This script sets up the opencortex daemon on a Linux host (Debian/Fedora).
|
||||
|
||||
set -e
|
||||
|
||||
echo "--- opencortex: Bare Metal Installation ---"
|
||||
|
||||
# 1. Check Dependencies
|
||||
echo "[1/4] Checking dependencies..."
|
||||
for cmd in sbcl curl git ripgrep; do
|
||||
if ! command -v $cmd &> /dev/null; then
|
||||
echo "Error: $cmd is not installed. Please install it first."
|
||||
exit 1
|
||||
fi
|
||||
done
|
||||
|
||||
# 2. Setup Quicklisp
|
||||
if [ ! -d "$HOME/quicklisp" ]; then
|
||||
echo "[2/4] Quicklisp not found. Installing..."
|
||||
curl -O https://beta.quicklisp.org/quicklisp.lisp
|
||||
sbcl --non-interactive --load quicklisp.lisp --eval '(quicklisp-quickstart:install)'
|
||||
rm quicklisp.lisp
|
||||
echo "Quicklisp installed."
|
||||
else
|
||||
echo "[2/4] Quicklisp already installed."
|
||||
fi
|
||||
|
||||
# 3. Build standalone binary
|
||||
echo "[3/4] Building standalone binary..."
|
||||
PROJECT_ROOT=$(pwd)/../..
|
||||
sbcl --non-interactive \
|
||||
--eval "(push \"$PROJECT_ROOT/\" asdf:*central-registry*)" \
|
||||
--eval "(ql:quickload :opencortex)" \
|
||||
--eval "(asdf:make :opencortex)"
|
||||
|
||||
echo "Binary built: $PROJECT_ROOT/opencortex-server"
|
||||
|
||||
# 4. Instructions for Systemd
|
||||
echo "[4/4] Installation complete."
|
||||
echo ""
|
||||
echo "To run as a systemd service:"
|
||||
echo "1. Edit opencortex.service to set correct paths."
|
||||
echo "2. sudo cp opencortex.service /etc/systemd/system/"
|
||||
echo "3. sudo systemctl daemon-reload"
|
||||
echo "4. sudo systemctl enable --now opencortex"
|
||||
@@ -1,18 +0,0 @@
|
||||
[Unit]
|
||||
Description=opencortex: Probabilistic-Deterministic Lisp Machine Kernel
|
||||
After=network.target
|
||||
|
||||
[Service]
|
||||
Type=simple
|
||||
# Update User and WorkingDirectory to match your local setup
|
||||
User=amr
|
||||
WorkingDirectory=/home/amr/.openclaw/workspace/memex/5_projects/opencortex
|
||||
ExecStart=/home/amr/.openclaw/workspace/memex/5_projects/opencortex/opencortex-server
|
||||
Restart=always
|
||||
RestartSec=10
|
||||
|
||||
# Environment variables can be loaded from the .env file
|
||||
EnvironmentFile=/home/amr/.openclaw/workspace/memex/5_projects/opencortex/.env
|
||||
|
||||
[Install]
|
||||
WantedBy=multi-user.target
|
||||
@@ -25,7 +25,7 @@ WORKDIR /app
|
||||
COPY . .
|
||||
|
||||
# Initialize system in non-interactive mode
|
||||
RUN mkdir -p /root/memex /app/environment/logs && ./opencortex.sh setup --non-interactive
|
||||
RUN mkdir -p /root/memex && ./opencortex.sh setup --non-interactive
|
||||
|
||||
EXPOSE 9105
|
||||
|
||||
|
||||
@@ -1,18 +1,19 @@
|
||||
version: '3.8'
|
||||
|
||||
services:
|
||||
opencortex:
|
||||
build:
|
||||
context: ../..
|
||||
dockerfile: deploy/docker/Dockerfile
|
||||
context: .
|
||||
dockerfile: Dockerfile
|
||||
container_name: opencortex
|
||||
restart: unless-stopped
|
||||
ports:
|
||||
- "${ORG_AGENT_DAEMON_PORT:-9105}:${ORG_AGENT_DAEMON_PORT:-9105}"
|
||||
- "${ORG_AGENT_WEB_PORT:-8080}:${ORG_AGENT_WEB_PORT:-8080}"
|
||||
env_file: .env
|
||||
volumes:
|
||||
- /memex:/memex
|
||||
# Mount the entire memex directory (2 levels up from projects/opencortex)
|
||||
- ../..:/memex
|
||||
# Ensure signal-cli state is preserved
|
||||
- signal-state:/root/.local/share/signal-cli
|
||||
ports:
|
||||
- "${ORG_AGENT_DAEMON_PORT:-9105}:9105"
|
||||
- "${ORG_AGENT_WEB_PORT:-8080}:8080"
|
||||
restart: unless-stopped
|
||||
|
||||
networks:
|
||||
sandbox-net:
|
||||
driver: bridge
|
||||
volumes:
|
||||
signal-state:
|
||||
|
||||
@@ -1,10 +1,7 @@
|
||||
(in-package :opencortex)
|
||||
|
||||
(defvar *default-actuator* :cli
|
||||
"The fallback actuator used if a signal has no source or target metadata.")
|
||||
|
||||
(defvar *silent-actuators* '(:cli :system-message :emacs)
|
||||
"List of actuators whose feedback should not re-enter the Reasoning stage.")
|
||||
(defvar *default-actuator* :cli)
|
||||
(defvar *silent-actuators* '(:cli :system-message :emacs))
|
||||
|
||||
(defun initialize-actuators ()
|
||||
"Loads actuator routing defaults from environment variables and registers core harness actuators."
|
||||
@@ -28,12 +25,10 @@
|
||||
(finish-output stream))))))
|
||||
|
||||
(defun dispatch-action (action context)
|
||||
"Routes an approved action to its registered physical actuator."
|
||||
(let ((payload (proto-get action :payload)))
|
||||
;; Optimization: Heartbeats are system events, not actions.
|
||||
(when (eq (proto-get payload :sensor) :heartbeat)
|
||||
(return-from dispatch-action nil)))
|
||||
|
||||
"Routes an approved action to its registered physical actuator."
|
||||
(when (and action (listp action))
|
||||
(let* ((meta (proto-get context :meta))
|
||||
(source (proto-get meta :source))
|
||||
@@ -43,7 +38,7 @@
|
||||
*default-actuator*))
|
||||
(target (intern (string-upcase (string raw-target)) :keyword))
|
||||
(actuator-fn (gethash target *actuator-registry*)))
|
||||
;; Propagation: Ensure outbound action inherits metadata
|
||||
;; Ensure outbound action has meta if context had it
|
||||
(when (and meta (null (getf action :meta)))
|
||||
(setf (getf action :meta) meta))
|
||||
(if actuator-fn
|
||||
@@ -78,7 +73,7 @@
|
||||
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
|
||||
|
||||
(defun execute-tool-action (action context)
|
||||
"Executes a registered cognitive tool and generates feedback signals. (ACTUATOR)"
|
||||
"Executes a registered cognitive tool. (ACTUATOR)"
|
||||
(let* ((payload (getf action :payload))
|
||||
(tool-name (getf payload :tool))
|
||||
(tool-args (getf payload :args))
|
||||
@@ -92,7 +87,7 @@
|
||||
(result (funcall (cognitive-tool-body tool) clean-args)))
|
||||
(let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
|
||||
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))))
|
||||
;; UI Propagation: Send distilled text result back to the source client
|
||||
;; If we have a source, send a status message with the result, formatted for humans
|
||||
(when source
|
||||
(dispatch-action (list :TYPE :REQUEST :TARGET source
|
||||
:PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result)))
|
||||
@@ -138,12 +133,14 @@
|
||||
(if approved
|
||||
(let* ((target (getf approved :target))
|
||||
(result (dispatch-action approved context)))
|
||||
;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
|
||||
;; Otherwise, generate tool-output feedback for non-silent actuators.
|
||||
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
|
||||
(setf feedback result))
|
||||
((and result (not (member target *silent-actuators*)))
|
||||
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
|
||||
:payload (list :sensor :tool-output :result result :tool approved))))))
|
||||
;; Fallback: route generic stimuli back to their origin
|
||||
;; If no approved action but we have a source, this might be a raw event/log stimulus.
|
||||
(when source
|
||||
(dispatch-action signal context)))))
|
||||
|
||||
|
||||
@@ -6,15 +6,20 @@
|
||||
(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))
|
||||
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS))
|
||||
(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")))
|
||||
;; Allow missing :target if :source is present in :meta, since reason-gate
|
||||
;; will infer :target from :source downstream. This preserves "equality of
|
||||
;; clients" — gateways need not duplicate routing logic.
|
||||
(let ((target (proto-get msg :target))
|
||||
(source (proto-get (proto-get msg :meta) :source)))
|
||||
(unless (or target source)
|
||||
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target and no :source in :meta to infer it"))
|
||||
(unless (proto-get msg :payload)
|
||||
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload"))))
|
||||
|
||||
(:EVENT
|
||||
(let ((payload (proto-get msg :payload)))
|
||||
|
||||
@@ -1,7 +1,63 @@
|
||||
(in-package :opencortex)
|
||||
|
||||
(defvar *actuator-registry* (make-hash-table :test 'equalp)
|
||||
"Global registry mapping target keywords to their physical actuator functions.")
|
||||
|
||||
(defun register-actuator (name fn)
|
||||
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
|
||||
(let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword))))
|
||||
(setf (gethash key *actuator-registry*) fn)))
|
||||
|
||||
(defun frame-message (msg-plist)
|
||||
"Frames a Lisp plist with a 6-character hex length and a newline for stream integrity."
|
||||
(let* ((*print-pretty* nil)
|
||||
(*print-circle* nil)
|
||||
(msg-string (format nil "~s" msg-plist))
|
||||
(len (length msg-string)))
|
||||
(format nil "~6,'0x~a~%" len msg-string)))
|
||||
|
||||
(defun read-framed-message (stream)
|
||||
"Reads a hex-length prefixed S-expression from the stream securely. Skips leading whitespace."
|
||||
(let ((length-buffer (make-string 6)))
|
||||
(handler-case
|
||||
(progn
|
||||
;; 1. Skip leading whitespace (newlines, spaces, etc.)
|
||||
(loop for char = (peek-char nil stream nil :eof)
|
||||
while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
|
||||
do (read-char stream))
|
||||
|
||||
;; 2. Read the 6-char hex length
|
||||
(let ((count (read-sequence length-buffer stream)))
|
||||
(cond ((< count 6) :eof)
|
||||
(t (let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
|
||||
(if (not len)
|
||||
(progn
|
||||
(harness-log "PROTOCOL ERROR: Invalid header ~s. Attempting resync..." length-buffer)
|
||||
:error)
|
||||
(let ((msg-buffer (make-string len)))
|
||||
(read-sequence msg-buffer stream)
|
||||
(let ((*read-eval* nil)
|
||||
(*print-pretty* nil))
|
||||
(handler-case
|
||||
(let ((msg (read-from-string msg-buffer)))
|
||||
(validate-communication-protocol-schema msg)
|
||||
msg)
|
||||
(error (c)
|
||||
(harness-log "PROTOCOL PARSE ERROR: ~a in ~s" c msg-buffer)
|
||||
:error))))))))))
|
||||
(error (c)
|
||||
(harness-log "PROTOCOL READ ERROR: ~a" c)
|
||||
:error))))
|
||||
|
||||
(defun make-hello-message (version)
|
||||
"Constructs the standard HELLO handshake message."
|
||||
(list :TYPE :EVENT
|
||||
:PAYLOAD (list :ACTION :handshake
|
||||
:VERSION version
|
||||
:CAPABILITIES '(:AUTH :SWANK :ORG-AST))))
|
||||
|
||||
(defun sanitize-protocol-message (msg)
|
||||
"Recursively strips non-serializable objects (streams, sockets) from a protocol plist."
|
||||
"Recursively strips non-serializable objects from a protocol plist."
|
||||
(if (and msg (listp msg))
|
||||
(let ((clean nil))
|
||||
(loop for (k v) on msg by #'cddr
|
||||
@@ -17,30 +73,3 @@
|
||||
(payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
|
||||
(len (length payload)))
|
||||
(format nil "~6,'0x~a" len payload)))
|
||||
|
||||
(defun read-framed-message (stream)
|
||||
"Reads a hex-prefixed message from a stream. Returns the parsed Lisp plist or :EOF."
|
||||
(handler-case
|
||||
(let ((len-buf (make-string 6)))
|
||||
;; 1. Read the length prefix
|
||||
(let ((count (read-sequence len-buf stream)))
|
||||
(if (< count 6)
|
||||
:eof
|
||||
(let ((len (ignore-errors (parse-integer len-buf :radix 16))))
|
||||
(if (and len (> len 0))
|
||||
;; 2. Read exactly 'len' bytes
|
||||
(let ((payload-buf (make-string len)))
|
||||
(read-sequence payload-buf stream)
|
||||
(let ((*read-eval* nil))
|
||||
(read-from-string payload-buf)))
|
||||
:error)))))
|
||||
(error (c)
|
||||
(harness-log "PROTOCOL ERROR: ~a" c)
|
||||
:error)))
|
||||
|
||||
(defun make-hello-message (version)
|
||||
"Constructs the standard HELLO handshake message."
|
||||
(list :TYPE :EVENT
|
||||
:PAYLOAD (list :ACTION :handshake
|
||||
:VERSION version
|
||||
:CAPABILITIES '(:AUTH :SWANK :ORG-AST))))
|
||||
|
||||
@@ -1,41 +1,119 @@
|
||||
(in-package :opencortex)
|
||||
|
||||
(defun context-get-active-projects ()
|
||||
"Retrieves a list of project headlines currently marked as NEXT or in progress."
|
||||
(let ((all-projects (list-objects-with-attribute :CATEGORY "Project")))
|
||||
(loop for p in all-projects
|
||||
collect (list :id (org-object-id p)
|
||||
:title (getf (org-object-attributes p) :TITLE)))))
|
||||
|
||||
(defun context-get-recent-completed-tasks (&optional (limit 5))
|
||||
"Retrieves the last N tasks marked as DONE from the memory history."
|
||||
(let ((all-completed (list-objects-with-attribute :TODO "DONE")))
|
||||
(subseq (sort all-completed #'> :key #'org-object-version)
|
||||
0 (min limit (length all-completed)))))
|
||||
|
||||
(defun context-list-all-skills ()
|
||||
"Returns a list of registered skills and their documentation."
|
||||
(defun context-query-store (&key tag todo-state type)
|
||||
"Filters the Memory based on tags, todo states, or types."
|
||||
(let ((results nil))
|
||||
(maphash (lambda (id skill)
|
||||
(push (list :id id :name (skill-name skill)) results))
|
||||
*skills-registry*)
|
||||
(maphash (lambda (id obj)
|
||||
(declare (ignore id))
|
||||
(let* ((attrs (org-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
|
||||
(when (and type (not (eq (org-object-type obj) type))) (setf match nil))
|
||||
(when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
|
||||
(when (and todo-state (not (equal state todo-state))) (setf match nil))
|
||||
(when match (push obj results))))
|
||||
*memory*)
|
||||
results))
|
||||
|
||||
(defun context-get-system-logs ()
|
||||
"Retrieves the in-memory circular log buffer."
|
||||
(bt:with-lock-held (*logs-lock*)
|
||||
(format nil "~{~a~%~}" (reverse *system-logs*))))
|
||||
(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"))
|
||||
(context-query-store :tag "project" :type :HEADLINE)))
|
||||
|
||||
(defun context-assemble-global-awareness ()
|
||||
"Assembles the full context block for a neural request."
|
||||
(let ((projects (context-get-active-projects))
|
||||
(time (multiple-value-bind (s m h d mo y) (get-decoded-time) (format nil "~a-~a-~a ~a:~a:~a" y mo d h m s))))
|
||||
(format nil "CURRENT_TIME: ~a. ACTIVE_PROJECTS: ~s. FOVEAL_FOCUS: ~a"
|
||||
time
|
||||
projects
|
||||
(or *foveal-focus-id* "None"))))
|
||||
(defun context-get-recent-completed-tasks ()
|
||||
"Retrieves recently finished tasks from the store."
|
||||
(context-query-store :todo-state "DONE" :type :HEADLINE))
|
||||
|
||||
(defun context-query-store (query &key (limit 5))
|
||||
"Placeholder for semantic/vector search over the Memex."
|
||||
(declare (ignore query limit))
|
||||
nil)
|
||||
(defun context-list-all-skills ()
|
||||
"Provides a sorted overview of currently loaded system capabilities."
|
||||
(let ((results nil))
|
||||
(maphash (lambda (name skill)
|
||||
(declare (ignore name))
|
||||
(push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
|
||||
*skills-registry*)
|
||||
(sort results #'> :key (lambda (x) (getf x :priority)))))
|
||||
|
||||
(defun context-get-skill-source (skill-name)
|
||||
"Reads the raw literate source of a specific skill for inspection."
|
||||
(let* ((filename (format nil "~a.org" skill-name))
|
||||
(skills-dir-str (or (uiop:getenv "SKILLS_DIR") (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
|
||||
(skills-dir (uiop:ensure-directory-pathname (context-resolve-path skills-dir-str)))
|
||||
(full-path (merge-pathnames filename skills-dir)))
|
||||
(if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
|
||||
|
||||
(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)))
|
||||
(bt:with-lock-held (*logs-lock*)
|
||||
(let ((count (min log-limit (length *system-logs*))))
|
||||
(subseq *system-logs* 0 count)))))
|
||||
|
||||
(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))
|
||||
(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))
|
||||
(threshold (or semantic-threshold (ignore-errors (read-from-string (uiop:getenv "CONTEXT_SEMANTIC_THRESHOLD"))) 0.75))
|
||||
(similarity (if (and foveal-vector obj-vector (not is-foveal))
|
||||
(cosine-similarity foveal-vector obj-vector)
|
||||
0.0))
|
||||
(is-semantically-relevant (>= similarity 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 is-semantically-relevant
|
||||
(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 threshold
|
||||
:foveal-vector foveal-vector))))))))
|
||||
output))
|
||||
|
||||
(defun context-resolve-path (path-string)
|
||||
"Expands environment variables and strips literal quotes from a path string."
|
||||
(let ((path (if (stringp path-string)
|
||||
(string-trim '(#\" #\' #\Space) path-string)
|
||||
path-string)))
|
||||
(if (and (stringp path) (search "$" path))
|
||||
(let ((result path))
|
||||
(ppcre:do-register-groups (var-name) ("\\$([A-Za-z0-9_]+)" path)
|
||||
(let ((var-val (uiop:getenv var-name)))
|
||||
(when var-val
|
||||
(setf result (ppcre:regex-replace (format nil "\\$~a" var-name) result var-val)))))
|
||||
result)
|
||||
path)))
|
||||
|
||||
(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)
|
||||
(ignore-errors (getf (getf signal :payload) :target-id))))
|
||||
(projects (context-get-active-projects))
|
||||
(output "GLOBAL MEMEX AWARENESS (Peripheral Vision):
|
||||
"))
|
||||
(if projects
|
||||
(dolist (project projects)
|
||||
(setf output (concatenate 'string output
|
||||
(context-render-to-org project :foveal-id foveal-id))))
|
||||
(setf output (concatenate 'string output "No active projects found.~%")))
|
||||
output))
|
||||
|
||||
109
library/gen/org-skill-bouncer.lisp
Normal file
109
library/gen/org-skill-bouncer.lisp
Normal 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)
|
||||
81
library/gen/org-skill-cli-gateway.lisp
Normal file
81
library/gen/org-skill-cli-gateway.lisp
Normal 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)
|
||||
82
library/gen/org-skill-credentials-vault.lisp
Normal file
82
library/gen/org-skill-credentials-vault.lisp
Normal 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))))
|
||||
|#
|
||||
68
library/gen/org-skill-gardener.lisp
Normal file
68
library/gen/org-skill-gardener.lisp
Normal 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)
|
||||
28
library/gen/org-skill-homoiconic-memory.lisp
Normal file
28
library/gen/org-skill-homoiconic-memory.lisp
Normal 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))
|
||||
231
library/gen/org-skill-lisp-validator.lisp
Normal file
231
library/gen/org-skill-lisp-validator.lisp
Normal file
@@ -0,0 +1,231 @@
|
||||
(in-package :opencortex)
|
||||
|
||||
(defun lisp-validator-check-structural (code-string)
|
||||
"Checks for balanced parens, brackets, and terminated strings.
|
||||
Returns (VALUES t nil) if clean, or (VALUES nil reason-string line col)."
|
||||
(let ((stack nil)
|
||||
(in-string nil)
|
||||
(escaped nil)
|
||||
(line 1)
|
||||
(col 0)
|
||||
(last-open-line 1)
|
||||
(last-open-col 0))
|
||||
(dotimes (i (length code-string)
|
||||
(if (null stack)
|
||||
(values t nil nil nil)
|
||||
(values nil (format nil "Unbalanced '~a' opened at line ~a, col ~a"
|
||||
(caar stack) last-open-line last-open-col)
|
||||
last-open-line last-open-col)))
|
||||
(let ((ch (char code-string i)))
|
||||
(cond (escaped (setf escaped nil))
|
||||
((char= ch #\\) (setf escaped t))
|
||||
(in-string
|
||||
(when (char= ch #\") (setf in-string nil)))
|
||||
((char= ch #\;)
|
||||
;; Skip to end of line
|
||||
(loop while (and (< i (1- (length code-string)))
|
||||
(not (char= (char code-string (1+ i)) #\Newline)))
|
||||
do (incf i))
|
||||
(incf line) (setf col 0))
|
||||
((char= ch #\")
|
||||
(setf in-string t))
|
||||
((member ch '(#\( #\[))
|
||||
(push (list (string ch) line col) stack)
|
||||
(setf last-open-line line last-open-col col))
|
||||
((char= ch #\))
|
||||
(cond ((null stack)
|
||||
(return-from lisp-validator-check-structural
|
||||
(values nil (format nil "Unexpected ')' at line ~a, col ~a" line col) line col)))
|
||||
((string= (caar stack) "[")
|
||||
(return-from lisp-validator-check-structural
|
||||
(values nil (format nil "Mismatched ']' expected at line ~a, col ~a" line col) line col)))
|
||||
(t (pop stack))))
|
||||
((char= ch #\])
|
||||
(cond ((null stack)
|
||||
(return-from lisp-validator-check-structural
|
||||
(values nil (format nil "Unexpected ']' at line ~a, col ~a" line col) line col)))
|
||||
((string= (caar stack) "(")
|
||||
(return-from lisp-validator-check-structural
|
||||
(values nil (format nil "Mismatched ')' expected at line ~a, col ~a" line col) line col)))
|
||||
(t (pop stack))))
|
||||
((char= ch #\Newline)
|
||||
(incf line) (setf col 0)))
|
||||
(unless (char= ch #\Newline) (incf col))))))
|
||||
|
||||
(defun lisp-validator-check-syntactic (code-string)
|
||||
"Checks if the code can be read by SBCL with *read-eval* nil.
|
||||
Returns (VALUES t nil) if clean, or (VALUES nil error-message line col)."
|
||||
(handler-case
|
||||
(let ((*read-eval* nil))
|
||||
(with-input-from-string (stream (format nil "(progn ~a)" code-string))
|
||||
(loop for form = (read stream nil :eof) until (eq form :eof)))
|
||||
(values t nil nil nil))
|
||||
(error (c)
|
||||
(let ((msg (format nil "~a" c)))
|
||||
(values nil msg nil nil)))))
|
||||
|
||||
(defparameter *lisp-validator-whitelist*
|
||||
'(;; Math & Logic
|
||||
+ - * / = < > <= >= 1+ 1- min max mod abs floor ceiling round
|
||||
and or not null eq eql equal string= string-equal char= char-equal
|
||||
;; List Manipulation
|
||||
list cons car cdr cadr cddr cdar caar caddr cdddr append mapcar remove-if remove-if-not
|
||||
length reverse sort nth nthcdr push pop last butlast subseq
|
||||
;; Plists, Alists, and Hash Tables
|
||||
getf gethash assoc acons pairlis rassoc
|
||||
;; Control Flow
|
||||
let let* if cond when unless case typecase prog1 progn
|
||||
;; Strings
|
||||
format concatenate string-downcase string-upcase search subseq replace
|
||||
;; Type predicates
|
||||
stringp numberp integerp listp symbolp keywordp null
|
||||
;; Kernel safe symbols
|
||||
opencortex::harness-log
|
||||
opencortex::snapshot-memory opencortex::rollback-memory
|
||||
opencortex::lookup-object opencortex::list-objects-by-type
|
||||
opencortex::ingest-ast opencortex::find-headline-missing-id
|
||||
opencortex::context-query-store opencortex::context-get-active-projects
|
||||
opencortex::context-get-recent-completed-tasks opencortex::context-list-all-skills
|
||||
opencortex::context-get-system-logs opencortex::context-assemble-global-awareness
|
||||
opencortex::org-object-id opencortex::org-object-type opencortex::org-object-attributes
|
||||
opencortex::org-object-content opencortex::org-object-parent-id
|
||||
opencortex::org-object-children opencortex::org-object-version
|
||||
opencortex::org-object-last-sync opencortex::org-object-hash
|
||||
opencortex::org-object-vector
|
||||
;; Essential macros and special operators
|
||||
declare ignore quote function lambda defun defvar defparameter defmacro
|
||||
;; Safe I/O
|
||||
with-open-file write-string read-line
|
||||
;; Package introspection
|
||||
find-package make-package in-package do-external-symbols find-symbol
|
||||
;; Safe system interaction
|
||||
uiop:run-program uiop:getenv uiop:merge-pathnames* uiop:file-exists-p
|
||||
uiop:directory-exists-p uiop:read-file-string uiop:split-string
|
||||
;; Time
|
||||
get-universal-time get-internal-real-time sleep
|
||||
;; Equality
|
||||
equalp = equal eq eql))
|
||||
"Static whitelist of symbols permitted in the Lisp Validator sandbox."
|
||||
|
||||
(defvar *lisp-validator-registry* nil
|
||||
"List of dynamically registered safe symbols.")
|
||||
|
||||
(defun lisp-validator-register (symbols)
|
||||
"Adds symbols to the global validator registry."
|
||||
(setf *lisp-validator-registry*
|
||||
(append *lisp-validator-registry*
|
||||
(if (listp symbols) symbols (list symbols))))
|
||||
(harness-log "LISP VALIDATOR: Registered ~a new safe symbols."
|
||||
(length (if (listp symbols) symbols (list symbols)))))
|
||||
|
||||
(defun lisp-validator-is-safe (symbol)
|
||||
"Checks if a symbol is in the static whitelist or the dynamic registry."
|
||||
(or (member symbol *lisp-validator-whitelist* :test #'string-equal)
|
||||
(member symbol *lisp-validator-registry* :test #'string-equal)))
|
||||
|
||||
(defun lisp-validator-ast-walk (form)
|
||||
"Recursively walks the Lisp AST. Returns T if safe, NIL if unsafe."
|
||||
(cond
|
||||
;; Self-evaluating objects are safe.
|
||||
((or (stringp form) (numberp form) (keywordp form) (characterp form)) t)
|
||||
;; Symbols used as variables (in non-function position)
|
||||
((symbolp form) (lisp-validator-is-safe form))
|
||||
;; Lists represent function calls or special forms.
|
||||
((listp form)
|
||||
(let ((head (car form)))
|
||||
(cond
|
||||
((eq head 'quote) t)
|
||||
((not (symbolp head)) nil)
|
||||
((lisp-validator-is-safe head)
|
||||
(every #'lisp-validator-ast-walk (cdr form)))
|
||||
(t
|
||||
(harness-log "LISP VALIDATOR: Blocked call to non-whitelisted function ~a" head)
|
||||
nil))))
|
||||
(t nil)))
|
||||
|
||||
(defun lisp-validator-check-semantic (code-string)
|
||||
"Checks if all symbols in CODE-STRING are whitelisted.
|
||||
Returns (VALUES t nil) if clean, or (VALUES nil reason-string nil nil)."
|
||||
(handler-case
|
||||
(let ((*read-eval* nil))
|
||||
(with-input-from-string (stream (format nil "(progn ~a)" code-string))
|
||||
(loop for form = (read stream nil :eof)
|
||||
until (eq form :eof)
|
||||
do (unless (lisp-validator-ast-walk form)
|
||||
(return-from lisp-validator-check-semantic
|
||||
(values nil "Code contains non-whitelisted symbols." nil nil)))))
|
||||
(values t nil nil nil))
|
||||
(error (c)
|
||||
(values nil (format nil "Semantic check failed: ~a" c) nil nil))))
|
||||
|
||||
(defun lisp-validator-validate (code-string &key strict)
|
||||
"Validates Lisp code through structural, syntactic, and optional semantic checks.
|
||||
Returns a plist:
|
||||
(:status :success :checks (:structural t :syntactic t :semantic t))
|
||||
or
|
||||
(:status :error :failed <check-key> :reason <string> :line <n> :col <n>)
|
||||
|
||||
When STRICT is non-nil, the semantic whitelist check is enforced.
|
||||
When STRICT is nil, semantic check is skipped for general validation."
|
||||
(let ((structural-ok nil) (syntactic-ok nil) (semantic-ok nil)
|
||||
(reason nil) (line nil) (col nil))
|
||||
;; Phase 1: Structural
|
||||
(multiple-value-setq (structural-ok reason line col)
|
||||
(lisp-validator-check-structural code-string))
|
||||
(unless structural-ok
|
||||
(return-from lisp-validator-validate
|
||||
(list :status :error :failed :structural :reason reason :line line :col col)))
|
||||
;; Phase 2: Syntactic
|
||||
(multiple-value-setq (syntactic-ok reason line col)
|
||||
(lisp-validator-check-syntactic code-string))
|
||||
(unless syntactic-ok
|
||||
(return-from lisp-validator-validate
|
||||
(list :status :error :failed :syntactic :reason reason :line line :col col)))
|
||||
;; Phase 3: Semantic (only when strict)
|
||||
(when strict
|
||||
(multiple-value-setq (semantic-ok reason line col)
|
||||
(lisp-validator-check-semantic code-string))
|
||||
(unless semantic-ok
|
||||
(return-from lisp-validator-validate
|
||||
(list :status :error :failed :semantic :reason reason :line line :col col))))
|
||||
;; All clear
|
||||
(list :status :success
|
||||
:checks (list :structural t :syntactic t :semantic (or (not strict) semantic-ok)))))
|
||||
|
||||
(def-cognitive-tool :validate-lisp
|
||||
"Deterministically validates Lisp code for structural, syntactic, and semantic correctness.
|
||||
Use this BEFORE declaring any Lisp code edit complete."
|
||||
((:code :type :string :description "The Lisp code string to validate.")
|
||||
(:strict :type :boolean :description "If non-nil, enforces the semantic whitelist."))
|
||||
:body (lambda (args)
|
||||
(let ((code (getf args :code))
|
||||
(strict (getf args :strict)))
|
||||
(if (and code (stringp code))
|
||||
(lisp-validator-validate code :strict strict)
|
||||
(list :status :error :reason "Missing :code argument.")))))
|
||||
|
||||
(defskill :skill-lisp-validator
|
||||
:priority 900
|
||||
:trigger (lambda (ctx)
|
||||
;; Trigger on any eval or shell action, or when validation is explicitly requested
|
||||
(let ((candidate (getf ctx :approved-action)))
|
||||
(when candidate
|
||||
(let ((payload (getf candidate :payload)))
|
||||
(member (getf payload :action) '(:eval :shell))))))
|
||||
:probabilistic nil
|
||||
:deterministic (lambda (action context)
|
||||
(declare (ignore context))
|
||||
(let ((payload (getf action :payload)))
|
||||
(if (eq (getf payload :action) :eval)
|
||||
(let* ((code (getf payload :code))
|
||||
(result (lisp-validator-validate code :strict t)))
|
||||
(if (eq (getf result :status) :error)
|
||||
(progn
|
||||
(harness-log "LISP VALIDATOR: Blocked unsafe :eval action. ~a"
|
||||
(getf result :reason))
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text (format nil "LISP VALIDATOR: Blocked unsafe eval. ~a"
|
||||
(getf result :reason)))))
|
||||
action))
|
||||
action))))
|
||||
33
library/gen/org-skill-llama-backend.lisp
Normal file
33
library/gen/org-skill-llama-backend.lisp
Normal 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))
|
||||
110
library/gen/org-skill-llm-gateway.lisp
Normal file
110
library/gen/org-skill-llm-gateway.lisp
Normal 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))
|
||||
76
library/gen/org-skill-peripheral-vision.lisp
Normal file
76
library/gen/org-skill-peripheral-vision.lisp
Normal 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))
|
||||
225
library/gen/org-skill-policy.lisp
Normal file
225
library/gen/org-skill-policy.lisp
Normal file
@@ -0,0 +1,225 @@
|
||||
(in-package :opencortex)
|
||||
|
||||
(defvar *policy-invariant-priorities*
|
||||
'((:transparency . 500)
|
||||
(:autonomy . 400)
|
||||
(:bloat . 300)
|
||||
(:modularity . 250)
|
||||
(:mentorship . 200)
|
||||
(:sustainability . 100))
|
||||
"Priority alist for policy invariant conflict resolution.
|
||||
Higher numbers take precedence.")
|
||||
|
||||
(defun policy-check-transparency (action context)
|
||||
"Ensures the action is inspectable and user-facing actions carry an explanation.
|
||||
Returns the action if clean, or a blocking LOG event if the action is opaque."
|
||||
(declare (ignore context))
|
||||
(unless (listp action)
|
||||
(return-from policy-check-transparency
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text "POLICY [Transparency]: Action is not a valid plist. Rejected."))))
|
||||
(let* ((payload (getf action :payload))
|
||||
(target (or (getf action :target) (getf action :TARGET)))
|
||||
(explanation (or (getf payload :explanation) (getf payload :EXPLANATION)
|
||||
(getf payload :rationale) (getf payload :RATIONALE))))
|
||||
;; User-facing actions (CLI, TUI, Emacs) must explain themselves
|
||||
(when (and (member target '(:cli :tui :emacs :EMACS :CLI :TUI))
|
||||
(not explanation)
|
||||
(not (member (getf payload :action)
|
||||
'(:handshake :heartbeat :status-update))))
|
||||
(return-from policy-check-transparency
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text "POLICY [Transparency]: User-facing action missing :explanation. Blocked."))))
|
||||
action))
|
||||
|
||||
(defvar *proprietary-domain-watchlist*
|
||||
'("googleapis.com" "api.openai.com" "anthropic.com" "api.groq.com" "openrouter.ai")
|
||||
"Domains that represent centralized, proprietary control.
|
||||
Actions targeting these are logged as autonomy debt, not hard-blocked,
|
||||
because tactical gateway usage is permitted under the strategic mandate.")
|
||||
|
||||
(defun policy-scan-proprietary-references (action)
|
||||
"Scans ACTION text fields for proprietary domain references.
|
||||
Returns the first matched domain, or NIL if clean."
|
||||
(let* ((payload (getf action :payload))
|
||||
(text (or (getf payload :text) (getf payload :TEXT) ""))
|
||||
(cmd (or (getf payload :cmd) (getf payload :CMD)
|
||||
(when (equal (getf payload :tool) "shell")
|
||||
(getf (getf payload :args) :cmd))
|
||||
""))
|
||||
(haystack (concatenate 'string text cmd)))
|
||||
(dolist (domain *proprietary-domain-watchlist* nil)
|
||||
(when (search domain haystack)
|
||||
(return domain)))))
|
||||
|
||||
(defun policy-check-autonomy (action context)
|
||||
"Flags actions that reference proprietary domains. Returns the action
|
||||
with an autonomy debt log appended, or the action itself if clean."
|
||||
(declare (ignore context))
|
||||
(let ((domain (policy-scan-proprietary-references action)))
|
||||
(if domain
|
||||
(progn
|
||||
(harness-log "POLICY [Autonomy]: Detected proprietary reference '~a'. Flagged for replacement." domain)
|
||||
;; Return a side-effect log but DO NOT block the action
|
||||
(list :type :LOG
|
||||
:payload (list :level :warn
|
||||
:text (format nil "Autonomy Debt: Action references proprietary domain '~a'. Consider a local alternative." domain)
|
||||
:original-action action)))
|
||||
action)))
|
||||
|
||||
(defvar *policy-max-skill-size-chars* 50000
|
||||
"Maximum recommended size for a skill file tangled from an Org note.")
|
||||
|
||||
(defun policy-check-bloat (action context)
|
||||
"Warns if a :create-skill action exceeds the bloat threshold.
|
||||
Does not block, because size alone is not a proof of complexity."
|
||||
(declare (ignore context))
|
||||
(let* ((payload (getf action :payload))
|
||||
(act (getf payload :action))
|
||||
(content (getf payload :content)))
|
||||
(when (and (eq act :create-skill)
|
||||
(stringp content)
|
||||
(> (length content) *policy-max-skill-size-chars*))
|
||||
(harness-log "POLICY [Bloat]: Proposed skill is ~a chars. Exceeds ~a char threshold."
|
||||
(length content) *policy-max-skill-size-chars*)
|
||||
(return-from policy-check-bloat
|
||||
(list :type :LOG
|
||||
:payload (list :level :warn
|
||||
:text (format nil "Bloat Warning: Proposed skill (~a chars) exceeds ~a char threshold. Review for earned complexity."
|
||||
(length content) *policy-max-skill-size-chars*)
|
||||
:original-action action))))
|
||||
action))
|
||||
|
||||
(defvar *mentorship-required-actions*
|
||||
'(:create-skill :eval :modify-file :write-file :replace :rename-file :delete-file :shell :create-note)
|
||||
"Actions that trigger the Mentorship invariant.")
|
||||
|
||||
(defun policy-check-mentorship (action context)
|
||||
"Blocks high-impact actions that lack a mentorship note."
|
||||
(declare (ignore context))
|
||||
(let* ((payload (getf action :payload))
|
||||
(act (or (getf payload :action) (getf action :action)))
|
||||
(note (or (getf payload :mentorship-note) (getf payload :MENTORSHIP-NOTE)))
|
||||
(target (or (getf action :target) (getf action :TARGET)))
|
||||
(tool (when (eq target :tool) (getf payload :tool))))
|
||||
(when (or (member act *mentorship-required-actions*)
|
||||
(member tool '("shell" "eval" "repair-file")))
|
||||
(unless note
|
||||
(return-from policy-check-mentorship
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text "POLICY [Mentorship]: High-impact action missing :mentorship-note. Explain what you are doing and why. Blocked.")))))
|
||||
action))
|
||||
|
||||
(defvar *cloud-only-backends* '(:openrouter :openai :anthropic :groq :gemini-api)
|
||||
"Backends that require an internet connection and external infrastructure.")
|
||||
|
||||
(defun policy-check-sustainability (action context)
|
||||
"Logs sustainability debt when the action relies on cloud-only infrastructure.
|
||||
Does not block, because tactical cloud usage is permitted."
|
||||
(let* ((payload (getf context :payload))
|
||||
(backend (getf payload :backend))
|
||||
(provider (getf payload :provider)))
|
||||
(when (or (member backend *cloud-only-backends*)
|
||||
(member provider *cloud-only-backends*))
|
||||
(harness-log "POLICY [Sustainability]: Cloud provider '~a' used. Logged as sustainability debt."
|
||||
(or backend provider))
|
||||
(return-from policy-check-sustainability
|
||||
(list :type :LOG
|
||||
:payload (list :level :warn
|
||||
:text (format nil "Sustainability Debt: Reliance on cloud provider '~a'. Consider Ollama or local inference."
|
||||
(or backend provider))))))
|
||||
action))
|
||||
|
||||
(defvar *modularity-protected-paths*
|
||||
'("harness/" "opencortex.asd")
|
||||
"Paths that constitute the unbreakable core of the system.
|
||||
Any action targeting these paths must include a :modularity-justification.
|
||||
This list is project-specific and should be configured at boot time.")
|
||||
|
||||
(defun policy-check-modularity (action context)
|
||||
"Blocks modifications to the system's protected core unless justified."
|
||||
(declare (ignore context))
|
||||
(let* ((payload (getf action :payload))
|
||||
(target-file (or (getf payload :file) (getf payload :filename)))
|
||||
(justification (or (getf payload :modularity-justification)
|
||||
(getf payload :MODULARITY-JUSTIFICATION))))
|
||||
(when (and target-file
|
||||
(some (lambda (path) (search path target-file)) *modularity-protected-paths*)
|
||||
(not justification))
|
||||
(return-from policy-check-modularity
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text "POLICY [Modularity]: Modification to protected core path blocked. Provide :modularity-justification explaining why this cannot be a skill."
|
||||
:blocked-path target-file))))
|
||||
action))
|
||||
|
||||
(defun policy-explain (invariant-key message &optional original-action)
|
||||
"Formats a policy decision into an auditable explanation plist.
|
||||
INVARIANT-KEY is one of :transparency, :autonomy, :bloat, :modularity, :mentorship, :sustainability.
|
||||
MESSAGE is a human-readable string.
|
||||
ORIGINAL-ACTION is the action that was blocked or modified."
|
||||
(list :type :REQUEST
|
||||
:target (or (ignore-errors (getf (getf original-action :meta) :source)) :cli)
|
||||
:payload (list :action :message
|
||||
:text (format nil "[POLICY ~a] ~a" invariant-key message)
|
||||
:explanation (format nil "Invariant: ~a | Rationale: ~a" invariant-key message)
|
||||
:original-action original-action)))
|
||||
|
||||
(defun policy-run-invariant-checks (action context)
|
||||
"Runs all invariant checks in priority order. Returns the final action,
|
||||
a blocking LOG event, or a warning wrapper."
|
||||
(let ((checks '(policy-check-transparency
|
||||
policy-check-autonomy
|
||||
policy-check-bloat
|
||||
policy-check-modularity
|
||||
policy-check-mentorship
|
||||
policy-check-sustainability)))
|
||||
(dolist (check-fn checks action)
|
||||
(let ((result (funcall check-fn action context)))
|
||||
;; If the check returned a LOG event, treat it as a block/warning
|
||||
(when (and (listp result)
|
||||
(member (getf result :type) '(:LOG :EVENT)))
|
||||
(let ((level (getf (getf result :payload) :level)))
|
||||
(cond ((eq level :error)
|
||||
;; Hard block: return the log event directly
|
||||
(return-from policy-run-invariant-checks result))
|
||||
(t
|
||||
;; Warning: log it, but continue with the original action
|
||||
(harness-log "~a" (getf (getf result :payload) :text))))))))))
|
||||
|
||||
(defun policy-find-engineering-standards-gate ()
|
||||
"Searches for the Engineering Standards gate across known jailed package names.
|
||||
Returns the function symbol, or NIL if unavailable."
|
||||
(dolist (pkg-name '(:opencortex.skills.org-skill-engineering-standards
|
||||
:opencortex.skills.org-skill-engineering
|
||||
:opencortex.skills.engineering-standards)
|
||||
nil)
|
||||
(let ((pkg (find-package pkg-name)))
|
||||
(when pkg
|
||||
(let ((sym (find-symbol "ENGINEERING-STANDARDS-GATE" pkg)))
|
||||
(when (and sym (fboundp sym))
|
||||
(return (symbol-function sym))))))))
|
||||
|
||||
(defun policy-deterministic-gate (action context)
|
||||
"The main policy gate. Runs invariant checks, then delegates to engineering standards if available.
|
||||
Never returns NIL silently; always returns an action or an auditable log event."
|
||||
(let ((current-action (policy-run-invariant-checks action context)))
|
||||
;; If an invariant returned a blocking log, do not proceed further
|
||||
(when (and (listp current-action)
|
||||
(member (getf current-action :type) '(:LOG :EVENT))
|
||||
(eq (getf (getf current-action :payload) :level) :error))
|
||||
(return-from policy-deterministic-gate current-action))
|
||||
;; Delegate to Engineering Standards if loaded
|
||||
(let ((eng-gate (policy-find-engineering-standards-gate)))
|
||||
(when eng-gate
|
||||
(setf current-action (funcall eng-gate current-action context))))
|
||||
current-action))
|
||||
|
||||
(defskill :skill-policy
|
||||
:priority 500
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||
:probabilistic nil
|
||||
:deterministic #'policy-deterministic-gate)
|
||||
44
library/gen/org-skill-protocol-validator.lisp
Normal file
44
library/gen/org-skill-protocol-validator.lisp
Normal file
@@ -0,0 +1,44 @@
|
||||
(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
|
||||
;; Allow missing :target if :source is present in :meta, since reason-gate
|
||||
;; will infer :target from :source downstream. This preserves "equality of
|
||||
;; clients" — gateways need not duplicate routing logic.
|
||||
(let ((target (proto-get msg :target))
|
||||
(source (proto-get (proto-get msg :meta) :source)))
|
||||
(unless (or target source)
|
||||
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target and no :source in :meta to infer it"))
|
||||
(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))
|
||||
108
library/gen/org-skill-scribe.lisp
Normal file
108
library/gen/org-skill-scribe.lisp
Normal 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)
|
||||
56
library/gen/org-skill-shell-actuator.lisp
Normal file
56
library/gen/org-skill-shell-actuator.lisp
Normal 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))
|
||||
@@ -1,13 +1,8 @@
|
||||
(in-package :opencortex)
|
||||
|
||||
(defvar *interrupt-flag* nil
|
||||
"Thread-safe signal to halt the metabolic pipeline and daemon.")
|
||||
|
||||
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock")
|
||||
"Protects the interrupt flag from concurrent access.")
|
||||
|
||||
(defvar *heartbeat-thread* nil
|
||||
"Reference to the background thread driving autonomous reflection.")
|
||||
(defvar *interrupt-flag* nil)
|
||||
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock"))
|
||||
(defvar *heartbeat-thread* nil)
|
||||
|
||||
(defun process-signal (signal)
|
||||
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
|
||||
@@ -15,78 +10,90 @@
|
||||
(loop while current-signal do
|
||||
(let ((depth (getf current-signal :depth 0))
|
||||
(meta (getf current-signal :meta)))
|
||||
;; Safety: Prevent infinite cognitive recursion.
|
||||
(when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil))
|
||||
|
||||
;; Check for graceful shutdown.
|
||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
||||
(harness-log "METABOLISM: Interrupted.")
|
||||
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
|
||||
(return nil))
|
||||
|
||||
(handler-case
|
||||
(progn
|
||||
;; Stage 1: Ingest and Normalize
|
||||
(setf current-signal (perceive-gate current-signal))
|
||||
;; Stage 2: Cogitate and Verify
|
||||
(setf current-signal (reason-gate current-signal))
|
||||
;; Stage 3: Actuate and Generate Feedback
|
||||
(let ((feedback (act-gate current-signal)))
|
||||
;; feedback generation
|
||||
(if feedback
|
||||
(progn
|
||||
;; Inheritance: Metadata must persist across recursive cycles.
|
||||
;; Inherit meta from trigger signal
|
||||
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
|
||||
(setf current-signal feedback))
|
||||
(setf current-signal nil))))
|
||||
(error (c)
|
||||
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
||||
(harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
|
||||
;; Resilience: Only rollback on critical system errors.
|
||||
;; Only rollback on critical errors, not standard tool or loop errors
|
||||
(unless (member sensor '(:loop-error :tool-error :syntax-error))
|
||||
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
|
||||
(rollback-memory 0))
|
||||
;; If recursion is shallow, attempt to notify the user of the error.
|
||||
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
|
||||
(setf current-signal nil)
|
||||
(setf current-signal (list :type :EVENT :depth (1+ depth) :meta meta
|
||||
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
|
||||
|
||||
(defvar *auto-save-interval* 300
|
||||
"Save memory to disk every N seconds. Set from MEMORY_AUTO_SAVE_INTERVAL env.")
|
||||
|
||||
(defvar *heartbeat-save-counter* 0
|
||||
"Counter for auto-save triggers.")
|
||||
|
||||
(defun start-heartbeat ()
|
||||
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL (default: 60s)."
|
||||
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
|
||||
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL."
|
||||
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60))
|
||||
(auto-save (or (ignore-errors (parse-integer (uiop:getenv "MEMORY_AUTO_SAVE_INTERVAL"))) *auto-save-interval*)))
|
||||
(setf *auto-save-interval* auto-save)
|
||||
(setf *heartbeat-save-counter* 0)
|
||||
(setf *heartbeat-thread*
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(loop
|
||||
(sleep interval)
|
||||
;; Note: inject-stimulus is synchronous for heartbeats to prevent task accumulation.
|
||||
(incf *heartbeat-save-counter*)
|
||||
(when (>= *heartbeat-save-counter* (/ *auto-save-interval* interval))
|
||||
(setf *heartbeat-save-counter* 0)
|
||||
(save-memory-to-disk))
|
||||
;; inject-stimulus is synchronous for heartbeats, preventing accumulation.
|
||||
(inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
|
||||
:name "opencortex-heartbeat"))))
|
||||
|
||||
(defvar *shutdown-save-enabled* t
|
||||
"If non-nil, save memory to disk on graceful shutdown.")
|
||||
|
||||
(defun main ()
|
||||
"Primary entry point for the OpenCortex daemon."
|
||||
;; 1. Environment Hydration
|
||||
"Entry point for the Skeleton MVP. Handles initialization and graceful shutdown."
|
||||
(let* ((home (uiop:getenv "HOME"))
|
||||
(env-file (uiop:merge-pathnames* ".local/share/opencortex/.env" (uiop:ensure-directory-pathname home))))
|
||||
(when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file)))
|
||||
|
||||
;; 2. System Bootstrap
|
||||
|
||||
;; Load memory from disk if a snapshot exists
|
||||
(load-memory-from-disk)
|
||||
|
||||
(initialize-actuators)
|
||||
(initialize-all-skills)
|
||||
|
||||
;; 3. Wake up the heart.
|
||||
(start-heartbeat)
|
||||
|
||||
;; 4. OS Signal Handling (SBCL specific)
|
||||
;; Graceful shutdown handler for SBCL
|
||||
#+sbcl
|
||||
(sb-sys:enable-interrupt sb-unix:sigint
|
||||
(lambda (sig code scp)
|
||||
(declare (ignore sig code scp))
|
||||
(harness-log "SHUTDOWN: SIGINT received. Exiting...")
|
||||
(harness-log "SHUTDOWN: SIGINT received. Saving memory...")
|
||||
(when *shutdown-save-enabled* (save-memory-to-disk))
|
||||
(uiop:quit 0)))
|
||||
|
||||
;; 5. Primary Idle Loop
|
||||
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
|
||||
(loop
|
||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (return))
|
||||
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
|
||||
(harness-log "SHUTDOWN: Interrupt flag set. Saving memory...")
|
||||
(when *shutdown-save-enabled* (save-memory-to-disk))
|
||||
(return))
|
||||
(sleep sleep-interval))))
|
||||
|
||||
@@ -1,23 +1,12 @@
|
||||
(in-package :opencortex)
|
||||
|
||||
(defvar *memory* (make-hash-table :test 'equal)
|
||||
"The primary in-memory graph of all Org-mode entities, keyed by their unique ID.")
|
||||
(defvar *memory* (make-hash-table :test 'equal))
|
||||
|
||||
(defvar *history-store* (make-array 0 :fill-pointer 0 :adjustable t)
|
||||
"A versioned log of the memory state, allowing for temporal traversal and rollback.")
|
||||
(defvar *history-store* (make-hash-table :test 'equal)
|
||||
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
|
||||
|
||||
(defstruct org-object
|
||||
"The fundamental unit of knowledge in the OpenCortex."
|
||||
id
|
||||
type
|
||||
attributes
|
||||
parent-id
|
||||
children
|
||||
version
|
||||
last-sync
|
||||
vector
|
||||
content
|
||||
hash)
|
||||
id type attributes content vector parent-id children version last-sync hash)
|
||||
|
||||
(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."
|
||||
@@ -25,57 +14,150 @@
|
||||
(sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
|
||||
(attr-string (format nil "~s" sorted-alist))
|
||||
(children-string (format nil "~{~a~}" child-hashes))
|
||||
(raw-data (format nil "~a|~a|~a|~a|~a" id type attr-string (or content "") children-string)))
|
||||
(ironclad:byte-array-to-hex-string
|
||||
(ironclad:digest-sequence :sha256 (ironclad:ascii-string-to-byte-array raw-data)))))
|
||||
(data-string (format nil "ID:~a|TYPE:~s|ATTRS:~a|CONTENT:~a|CHILDREN:~a"
|
||||
id type attr-string (or content "") children-string))
|
||||
(digester (ironclad:make-digest :sha256)))
|
||||
(ironclad:update-digest digester (ironclad:ascii-string-to-byte-array data-string))
|
||||
(ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))
|
||||
|
||||
(defun ingest-ast (ast &optional parent-id)
|
||||
"Recursively parses an Org AST into the Lisp Memory registry."
|
||||
"Parses an Org AST into the recursive Lisp Memory with Merkle hashing."
|
||||
(let* ((type (getf ast :type))
|
||||
(properties (getf ast :properties))
|
||||
(id (or (getf properties :ID) (uuid:make-v4-uuid)))
|
||||
(content (getf ast :content))
|
||||
(children (getf ast :contents))
|
||||
(child-ids nil))
|
||||
|
||||
;; Recursively ingest children and collect their IDs
|
||||
(dolist (child children)
|
||||
(let ((child-obj (ingest-ast child id)))
|
||||
(when child-obj (push (org-object-id child-obj) child-ids))))
|
||||
|
||||
(let ((obj (make-org-object :id id
|
||||
:type type
|
||||
:attributes properties
|
||||
:parent-id parent-id
|
||||
:children (nreverse child-ids)
|
||||
:content content
|
||||
:version (get-universal-time))))
|
||||
(props (getf ast :properties))
|
||||
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
|
||||
(contents (getf ast :contents))
|
||||
(raw-content (when (eq type :HEADLINE)
|
||||
(format nil "~a~%~a" (getf props :TITLE) (or (cl:getf ast :raw-content) ""))))
|
||||
(should-embed (and raw-content (equal (getf props :EMBED) "t")))
|
||||
(child-ids nil)
|
||||
(child-hashes nil))
|
||||
(dolist (child contents)
|
||||
(when (listp child)
|
||||
(let ((child-id (ingest-ast child id)))
|
||||
(push child-id child-ids)
|
||||
(let ((child-id-val child-id))
|
||||
(let ((child-obj (lookup-object child-id-val)))
|
||||
(when child-obj (push (org-object-hash child-obj) child-hashes)))))))
|
||||
(setf child-ids (nreverse child-ids))
|
||||
(setf child-hashes (nreverse child-hashes))
|
||||
(let* ((hash (compute-merkle-hash id type props raw-content child-hashes))
|
||||
(existing-obj (gethash hash *history-store*))
|
||||
(obj (or existing-obj
|
||||
(make-org-object
|
||||
:id id :type type :attributes props :content raw-content
|
||||
:vector (when should-embed (get-embedding raw-content))
|
||||
:parent-id parent-id :children child-ids
|
||||
:version (get-universal-time) :last-sync (get-universal-time)
|
||||
:hash hash))))
|
||||
(unless existing-obj
|
||||
(setf (gethash hash *history-store*) obj))
|
||||
(setf (gethash id *memory*) obj)
|
||||
obj)))
|
||||
id)))
|
||||
|
||||
(defun lookup-object (id)
|
||||
"Retrieves an object from memory by its ID."
|
||||
(defvar *object-store-snapshots* nil)
|
||||
|
||||
(defun copy-hash-table (hash-table)
|
||||
"Creates a shallow copy of a hash table."
|
||||
(let ((new-table (make-hash-table :test (hash-table-test hash-table)
|
||||
:size (hash-table-size hash-table))))
|
||||
(maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table)
|
||||
new-table))
|
||||
|
||||
(defun snapshot-memory ()
|
||||
"Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers."
|
||||
(let ((snapshot (copy-hash-table *memory*)))
|
||||
(push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
|
||||
(when (> (length *object-store-snapshots*) 20)
|
||||
(setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))
|
||||
(harness-log "MEMORY - CoW Memory snapshot created.")))
|
||||
|
||||
(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*)))
|
||||
(if snapshot
|
||||
(progn (setf *memory* (copy-hash-table (getf snapshot :data)))
|
||||
(harness-log "MEMORY - Memory rolled back to snapshot ~a" index))
|
||||
(harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
|
||||
|
||||
(defvar *memory-snapshot-path* nil
|
||||
"Path to the memory snapshot file. Set from MEMORY_SNAPSHOT_PATH env or default.")
|
||||
|
||||
(defun ensure-memory-snapshot-path ()
|
||||
"Initializes the snapshot path from environment or default location."
|
||||
(or *memory-snapshot-path*
|
||||
(let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH")))
|
||||
(setf *memory-snapshot-path*
|
||||
(or env-path
|
||||
(uiop:merge-pathnames* "memory.snap" (user-homedir-pathname)))))))
|
||||
|
||||
(defun save-memory-to-disk ()
|
||||
"Serializes *memory* and *history-store* to disk for crash recovery.
|
||||
Converts hash tables to alists for proper serialization."
|
||||
(let ((path (ensure-memory-snapshot-path)))
|
||||
(with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create)
|
||||
(format stream ";; OpenCortex Memory Snapshot~%")
|
||||
(format stream ";; Created: ~a~%~%" (format nil "~a" (get-universal-time)))
|
||||
(let ((memory-alist nil)
|
||||
(history-alist nil))
|
||||
(maphash (lambda (k v) (push (cons k v) memory-alist)) *memory*)
|
||||
(maphash (lambda (k v) (push (cons k v) history-alist)) *history-store*)
|
||||
(prin1 (list :memory memory-alist :history-store history-alist) stream)))
|
||||
(harness-log "MEMORY - Saved to ~a" path)
|
||||
path))
|
||||
|
||||
(defun load-memory-from-disk ()
|
||||
"Loads *memory* and *history-store* from disk if the snapshot exists.
|
||||
Reconstitutes alists into hash tables."
|
||||
(let ((path (ensure-memory-snapshot-path)))
|
||||
(when (uiop:file-exists-p path)
|
||||
(handler-case
|
||||
(with-open-file (stream path :direction :input)
|
||||
(let ((data (read stream nil)))
|
||||
(when data
|
||||
(let ((memory-alist (getf data :memory))
|
||||
(history-alist (getf data :history-store)))
|
||||
(setf *memory* (make-hash-table :test 'equal :size (length memory-alist)))
|
||||
(dolist (kv memory-alist)
|
||||
(setf (gethash (car kv) *memory*) (cdr kv)))
|
||||
(setf *history-store* (make-hash-table :test 'equal :size (length history-alist)))
|
||||
(dolist (kv history-alist)
|
||||
(setf (gethash (car kv) *history-store*) (cdr kv)))
|
||||
(harness-log "MEMORY - Loaded from ~a (~a objects)" path (hash-table-size *memory*))))))
|
||||
(error (c)
|
||||
(harness-log "MEMORY WARNING - Failed to load snapshot: ~a" c))))
|
||||
t))
|
||||
|
||||
(defun org-id-new ()
|
||||
"Generates a new UUID string for Org-mode identification."
|
||||
(string-downcase (format nil "~a" (uuid:make-v4-uuid))))
|
||||
|
||||
(defun lookup-object (id)
|
||||
"Retrieves an object from the store by its unique ID."
|
||||
(gethash id *memory*))
|
||||
|
||||
(defun list-objects-with-attribute (key value)
|
||||
"Returns a list of objects that possess the specified attribute pair."
|
||||
(defun list-objects-by-type (type)
|
||||
"Returns a list of all objects matching a specific Org element type."
|
||||
(let ((results nil))
|
||||
(maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *memory*)
|
||||
results))
|
||||
(defun list-objects-with-attribute (attr-name value)
|
||||
"Returns a list of all objects where ATTR-NAME matches VALUE."
|
||||
(let ((results nil))
|
||||
(maphash (lambda (id obj)
|
||||
(declare (ignore id))
|
||||
(when (equal (getf (org-object-attributes obj) key) value)
|
||||
(push obj results)))
|
||||
(let ((attrs (org-object-attributes obj)))
|
||||
(when (equal (getf attrs attr-name) value)
|
||||
(push obj results))))
|
||||
*memory*)
|
||||
results))
|
||||
|
||||
(defun snapshot-memory ()
|
||||
"Creates a deep copy of the memory hash table and pushes it to the history store."
|
||||
(let ((new-snap (make-hash-table :test 'equal)))
|
||||
(maphash (lambda (k v) (setf (gethash k new-snap) (copy-org-object v))) *memory*)
|
||||
(vector-push-extend new-snap *history-store*)))
|
||||
(defun find-headline-missing-id (ast)
|
||||
"Traverses an AST to find headlines that lack an :ID: property."
|
||||
(when (listp ast)
|
||||
(if (and (eq (getf ast :type) :HEADLINE) (not (getf (getf ast :properties) :ID)))
|
||||
ast
|
||||
(cl:some #'find-headline-missing-id (getf ast :contents)))))
|
||||
|
||||
(defun rollback-memory (&optional (steps 1))
|
||||
"Restores the memory to a previous snapshot state."
|
||||
(let ((index (- (length *history-store*) steps 1)))
|
||||
(when (>= index 0)
|
||||
(setf *memory* (aref *history-store* index))
|
||||
(harness-log "IMMUNE SYSTEM: Memory rolled back ~a steps." steps))))
|
||||
(defun file-name-nondirectory (path)
|
||||
"Extracts the filename from a full path string."
|
||||
(let ((pos (position #\/ path :from-end t))) (if pos (subseq path (1+ pos)) path)))
|
||||
|
||||
@@ -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
|
||||
@@ -1,7 +1,7 @@
|
||||
(defpackage :opencortex
|
||||
(:use :cl)
|
||||
(:export
|
||||
;; --- Communication Protocol ---
|
||||
;; --- communication protocol ---
|
||||
#:frame-message
|
||||
#:read-framed-message
|
||||
#:PROTO-GET
|
||||
@@ -40,6 +40,8 @@
|
||||
#:org-object-hash
|
||||
#:snapshot-memory
|
||||
#:rollback-memory
|
||||
#:save-memory-to-disk
|
||||
#:load-memory-from-disk
|
||||
|
||||
;; --- Context API (Peripheral Vision) ---
|
||||
#:context-query-store
|
||||
@@ -118,23 +120,14 @@
|
||||
|
||||
(in-package :opencortex)
|
||||
|
||||
(defvar *system-logs* nil
|
||||
"Thread-safe list of the most recent system messages.")
|
||||
(defun proto-get (plist key)
|
||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
||||
(let* ((s (string key))
|
||||
(up (intern (string-upcase s) :keyword))
|
||||
(dn (intern (string-downcase s) :keyword)))
|
||||
(or (getf plist up) (getf plist dn))))
|
||||
|
||||
(defvar *logs-lock* (bt:make-lock "harness-logs-lock")
|
||||
"Protects the circular log buffer from race conditions during concurrent skill execution.")
|
||||
|
||||
(defvar *max-log-history* 100
|
||||
"The maximum number of entries to preserve in the in-memory log buffer.")
|
||||
|
||||
(defvar *skills-registry* (make-hash-table :test 'equal)
|
||||
"Global registry of all loaded skills, keyed by their unique identifier.")
|
||||
|
||||
(defvar *skill-telemetry* (make-hash-table :test 'equal)
|
||||
"Stores execution duration and failure counts for every registered skill.")
|
||||
|
||||
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock")
|
||||
"Protects the telemetry store from concurrent updates.")
|
||||
(in-package :opencortex)
|
||||
|
||||
(defun proto-get (plist key)
|
||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
||||
@@ -143,6 +136,18 @@
|
||||
(dn (intern (string-downcase s) :keyword)))
|
||||
(or (getf plist up) (getf plist dn))))
|
||||
|
||||
(in-package :opencortex)
|
||||
|
||||
(defvar *system-logs* nil)
|
||||
(defvar *logs-lock* (bt:make-lock "harness-logs-lock"))
|
||||
(defvar *max-log-history* 100)
|
||||
|
||||
(defvar *skills-registry* (make-hash-table :test 'equal)
|
||||
"Global registry of all loaded skills.")
|
||||
|
||||
(defvar *skill-telemetry* (make-hash-table :test 'equal))
|
||||
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock"))
|
||||
|
||||
(defun harness-track-telemetry (skill-name duration status)
|
||||
"Updates performance metrics for a specific skill. Status should be :success or :rejected."
|
||||
(when skill-name
|
||||
@@ -153,11 +158,9 @@
|
||||
(when (eq status :rejected) (incf (getf entry :failures)))
|
||||
(setf (gethash skill-name *skill-telemetry*) entry)))))
|
||||
|
||||
(defvar *cognitive-tools* (make-hash-table :test 'equal)
|
||||
"The active set of physical capabilities available to the agent.")
|
||||
(defvar *cognitive-tools* (make-hash-table :test 'equal))
|
||||
|
||||
(defstruct cognitive-tool
|
||||
"Represents a physical or virtual capability with explicit documentation and security guards."
|
||||
name
|
||||
description
|
||||
parameters
|
||||
@@ -165,12 +168,7 @@
|
||||
body)
|
||||
|
||||
(defmacro def-cognitive-tool (name description parameters &key guard body)
|
||||
"Registers a new cognitive tool.
|
||||
NAME: Keyword identifier.
|
||||
DESCRIPTION: Human-readable intent (used in LLM prompts).
|
||||
PARAMETERS: List of property lists defining arguments.
|
||||
GUARD: (context -> boolean) function to prevent unsafe calls.
|
||||
BODY: The actual Lisp execution logic."
|
||||
"Registers a new cognitive tool into the global registry. Parameters must be a list of property lists."
|
||||
`(setf (gethash (string-downcase (string ',name)) *cognitive-tools*)
|
||||
(make-cognitive-tool :name (string-downcase (string ',name))
|
||||
:description ,description
|
||||
@@ -179,7 +177,7 @@
|
||||
:body ,body)))
|
||||
|
||||
(defun harness-log (msg &rest args)
|
||||
"Centralized logging for the harness. Writes to STDOUT and the thread-safe circular buffer."
|
||||
"Centralized logging for the harness."
|
||||
(let ((formatted-msg (apply #'format nil msg args)))
|
||||
(bt:with-lock-held (*logs-lock*)
|
||||
(push formatted-msg *system-logs*)
|
||||
|
||||
@@ -1,25 +0,0 @@
|
||||
(in-package :opencortex)
|
||||
|
||||
(defun policy-check-autonomy (action context)
|
||||
"Ensures the action does not violate the Autonomy invariant."
|
||||
(declare (ignore context))
|
||||
;; Implementation placeholder: currently permits all actions.
|
||||
;; Future: Scan for non-autonomous domain names or proprietary API endpoints.
|
||||
action)
|
||||
|
||||
(defun policy-deterministic-gate (action context)
|
||||
"The main policy gate. Sub-calls engineering standards if available."
|
||||
(let ((current-action (policy-check-autonomy action context)))
|
||||
(when current-action
|
||||
(let ((eng-pkg (find-package :opencortex.skills.org-skill-engineering-standards)))
|
||||
(when eng-pkg
|
||||
(let ((eng-gate (find-symbol "ENGINEERING-STANDARDS-GATE" eng-pkg)))
|
||||
(when (and eng-gate (fboundp eng-gate))
|
||||
(setf current-action (funcall (symbol-function eng-gate) current-action context)))))))
|
||||
current-action))
|
||||
|
||||
(defskill :skill-policy
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) t)
|
||||
:probabilistic nil
|
||||
:deterministic #'policy-deterministic-gate)
|
||||
@@ -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)))
|
||||
BIN
library/reason.fasl
Normal file
BIN
library/reason.fasl
Normal file
Binary file not shown.
@@ -1,19 +1,12 @@
|
||||
(in-package :opencortex)
|
||||
|
||||
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
|
||||
"A global mapping of provider identifiers (keywords) to their respective execution functions.")
|
||||
|
||||
(defvar *provider-cascade* nil
|
||||
"An ordered list of providers to attempt if the primary one fails.")
|
||||
|
||||
(defvar *model-selector-fn* nil
|
||||
"A hook for dynamic model selection based on context complexity.")
|
||||
|
||||
(defvar *consensus-enabled-p* nil
|
||||
"Flag to enable parallel multi-model voting (not implemented in MVP).")
|
||||
(defvar *probabilistic-backends* (make-hash-table :test 'equal))
|
||||
(defvar *provider-cascade* nil)
|
||||
(defvar *model-selector-fn* nil)
|
||||
(defvar *consensus-enabled-p* nil)
|
||||
|
||||
(defun register-probabilistic-backend (name fn)
|
||||
"Registers a neural provider with its calling function."
|
||||
"Registers a neural provider (e.g., :gemini, :anthropic) with its calling function."
|
||||
(setf (gethash name *probabilistic-backends*) fn))
|
||||
|
||||
(defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil))
|
||||
@@ -34,7 +27,7 @@
|
||||
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
|
||||
|
||||
(defun strip-markdown (text)
|
||||
"Strips common markdown code block markers from text to ensure valid S-expression parsing."
|
||||
"Strips common markdown code block markers from text."
|
||||
(if (and text (stringp text))
|
||||
(let ((cleaned text))
|
||||
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
|
||||
@@ -43,6 +36,15 @@
|
||||
(string-trim '(#\Space #\Newline #\Tab) cleaned))
|
||||
text))
|
||||
|
||||
(defun normalize-plist-keywords (plist)
|
||||
"Normalize all keys in a plist to keywords (e.g., TYPE -> :TYPE)."
|
||||
(when (listp plist)
|
||||
(loop for (k . rest) on plist by #'cddr
|
||||
collect (if (and (symbolp k) (not (keywordp k)))
|
||||
(intern (string k) :keyword)
|
||||
k)
|
||||
collect (car rest))))
|
||||
|
||||
(defun think (context)
|
||||
"Generates a Lisp action proposal based on current context."
|
||||
(let* ((active-skill (find-triggered-skill context))
|
||||
@@ -62,33 +64,37 @@ IMPORTANT: To reply to the user, you MUST use:
|
||||
To call a tool, you MUST use:
|
||||
(:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"<name>\" :ARGS (:arg1 \"val\"))
|
||||
|
||||
PROVIDER RULE: Always use the default cascade provider unless a specific model or capability is required for the task."
|
||||
assistant-name global-context tool-belt system-logs)))
|
||||
MANDATORY VALIDATION RULE: Before declaring any Lisp code edit complete, you MUST call the `:validate-lisp` tool with the proposed code. If the tool returns `:status :error`, read the `:reason` and `:failed` fields, fix the defect, and re-validate. You are strictly forbidden from relying on your own paren-balancing or syntax intuition.
|
||||
|
||||
PROVIDER RULE: Always use the default cascade provider unless a specific model or capability is required for the task."
|
||||
assistant-name global-context tool-belt system-logs)))
|
||||
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
|
||||
(cleaned (strip-markdown thought))
|
||||
(meta (proto-get context :meta))
|
||||
(source (proto-get meta :source)))
|
||||
(harness-log "THINK: raw cleaned = ~a" (subseq cleaned 0 (min 100 (length cleaned))))
|
||||
(if (and cleaned (stringp cleaned))
|
||||
(let ((*read-eval* nil))
|
||||
(if (and (> (length cleaned) 0) (char= (char cleaned 0) #\())
|
||||
(handler-case
|
||||
(let ((parsed (read-from-string cleaned)))
|
||||
(let ((type (proto-get parsed :TYPE))
|
||||
(harness-log "THINK: parsed = ~a" parsed)
|
||||
(let ((parsed-normalized (normalize-plist-keywords parsed))
|
||||
(type (proto-get parsed :TYPE))
|
||||
(target (or (proto-get parsed :TARGET) (proto-get parsed :target))))
|
||||
(cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
|
||||
(unless (proto-get parsed :target) (setf (getf parsed :target) (or source :CLI)))
|
||||
parsed)
|
||||
;; Handle raw plists or lists of plists that look like tool calls or data
|
||||
parsed-normalized)
|
||||
((or (eq target :TOOL) (eq target :tool) (getf parsed :TOOL) (getf parsed :tool)
|
||||
(and (listp parsed) (listp (car parsed)) (keywordp (caar parsed))))
|
||||
(list :TYPE :REQUEST :TARGET :TOOL :PAYLOAD parsed))
|
||||
(list :TYPE :REQUEST :TARGET :TOOL :PAYLOAD (normalize-plist-keywords parsed)))
|
||||
(t (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))))
|
||||
(error (c) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
|
||||
(error (c) (harness-log "THINK ERROR: ~a" c) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
|
||||
(list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
|
||||
thought)))))
|
||||
|
||||
(defun deterministic-verify (proposed-action context)
|
||||
"Iterates through all skill deterministic-gates sorted by priority. Ensures absolute safety of the neural proposal."
|
||||
"Iterates through all skill deterministic-gates sorted by priority."
|
||||
(let ((current-action proposed-action)
|
||||
(skills nil))
|
||||
(maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
|
||||
@@ -113,12 +119,15 @@ PROVIDER RULE: Always use the default cascade provider unless a specific model o
|
||||
(let* ((type (proto-get signal :type))
|
||||
(payload (proto-get signal :payload))
|
||||
(sensor (proto-get payload :sensor)))
|
||||
;; Optimization: Only reason about user input or chat messages.
|
||||
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
|
||||
(return-from reason-gate signal))
|
||||
(let ((candidate (think signal)))
|
||||
(if candidate
|
||||
(harness-log "REASON: candidate = ~a" (type-of candidate))
|
||||
(if (and candidate (listp candidate)
|
||||
(or (keywordp (car candidate)) (eq (car candidate) 'TYPE) (eq (car candidate) 'type)))
|
||||
(setf (getf signal :approved-action) (deterministic-verify candidate signal))
|
||||
(setf (getf signal :approved-action) nil))
|
||||
(progn
|
||||
(harness-log "REASON: Invalid candidate type ~a, dropping" (type-of candidate))
|
||||
(setf (getf signal :approved-action) nil)))
|
||||
(setf (getf signal :status) :reasoned)
|
||||
signal)))
|
||||
|
||||
@@ -1,79 +1,323 @@
|
||||
(in-package :opencortex)
|
||||
|
||||
(defstruct skill
|
||||
"Represents a hot-reloadable module of intelligence or actuation."
|
||||
name
|
||||
priority
|
||||
dependencies
|
||||
trigger-fn
|
||||
probabilistic-prompt
|
||||
deterministic-fn)
|
||||
(defun COSINE-SIMILARITY (v1 v2)
|
||||
"Computes the cosine similarity between two vectors.
|
||||
Both arguments should be sequences of numbers. Returns a value between -1.0 and 1.0."
|
||||
(let ((len1 (length v1)) (len2 (length v2)))
|
||||
(if (or (zerop len1) (zerop len2))
|
||||
0.0
|
||||
(let ((dot-product 0.0d0)
|
||||
(norm1 0.0d0)
|
||||
(norm2 0.0d0))
|
||||
(let ((len (min len1 len2)))
|
||||
(dotimes (i len)
|
||||
(let ((x (coerce (elt v1 i) 'double-float)))
|
||||
(let ((y (coerce (elt v2 i) 'double-float)))
|
||||
(incf dot-product (* x y))
|
||||
(incf norm1 (* x x))
|
||||
(incf norm2 (* y y))))))
|
||||
(if (or (zerop norm1) (zerop norm2))
|
||||
0.0
|
||||
(/ dot-product (sqrt (* norm1 norm2))))))))
|
||||
(defun VAULT-MASK-STRING (s) "[MASKED]") ; Stub
|
||||
(defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
|
||||
|
||||
(defmacro defskill (name &key (priority 0) dependencies trigger probabilistic deterministic)
|
||||
"Registers a new skill into the global harness registry."
|
||||
`(setf (gethash (string-downcase (string ',name)) *skills-registry*)
|
||||
(make-skill :name (string-downcase (string ',name))
|
||||
:priority ,priority
|
||||
:dependencies ,dependencies
|
||||
:trigger-fn ,trigger
|
||||
:probabilistic-prompt ,probabilistic
|
||||
:deterministic-fn ,deterministic)))
|
||||
|
||||
(defun validate-lisp-syntax (file-path)
|
||||
"Parses a Lisp file without evaluation to verify syntactic integrity."
|
||||
(handler-case
|
||||
(with-open-file (stream file-path)
|
||||
(loop for form = (read stream nil :eof)
|
||||
until (eq form :eof))
|
||||
t)
|
||||
(error (c)
|
||||
(harness-log "SYNTAX ERROR in ~a: ~a" file-path c)
|
||||
nil)))
|
||||
(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn)
|
||||
|
||||
(defun load-skill-from-org (org-file-path)
|
||||
"Tangles and loads a single Org-mode skill file."
|
||||
(let* ((filename (file-name-nondirectory (namestring org-file-path)))
|
||||
(skill-id (pathname-name org-file-path))
|
||||
(lisp-file (merge-pathnames (concatenate 'string "library/gen/" skill-id ".lisp")
|
||||
(asdf:system-source-directory :opencortex))))
|
||||
|
||||
(ensure-directories-exist lisp-file)
|
||||
(harness-log "LOADER: Loading ~a..." skill-id)
|
||||
(defvar *skill-catalog* (make-hash-table :test 'equal)
|
||||
"A stateful tracking table for all skill files discovered in the environment.")
|
||||
|
||||
;; 1. Tangle the Org file into Lisp
|
||||
(uiop:run-program (list "emacs" "--batch" "--eval" "(require 'org)"
|
||||
"--eval" (format nil "(org-babel-tangle-file \"~a\")" org-file-path))
|
||||
:output t)
|
||||
|
||||
;; 2. Verify and Load
|
||||
(if (validate-lisp-syntax lisp-file)
|
||||
(progn
|
||||
(handler-case (load lisp-file)
|
||||
(error (c) (harness-log "LOADER ERROR in skill '~a': ~a" skill-id c)))
|
||||
t)
|
||||
nil)))
|
||||
|
||||
(defun topological-sort-skills (skills)
|
||||
"Calculates the correct loading order based on #+DEPENDS_ON metadata."
|
||||
;; Placeholder: Currently sorts by priority as a proxy for dependencies.
|
||||
(sort skills #'> :key #'skill-priority))
|
||||
|
||||
(defun initialize-all-skills ()
|
||||
"Discovers and loads all Org files in the SKILLS_DIR."
|
||||
(let* ((skills-dir (uiop:getenv "SKILLS_DIR"))
|
||||
(files (when (and skills-dir (uiop:directory-exists-p skills-dir))
|
||||
(uiop:directory-files skills-dir "*.org"))))
|
||||
(dolist (f files)
|
||||
(load-skill-from-org f))
|
||||
(harness-log "LOADER: Boot Complete. [Ready: ~a] [Failed: 0]" (hash-table-count *skills-registry*))))
|
||||
(defstruct skill-entry
|
||||
filename
|
||||
(status :discovered) ;; :discovered, :loading, :ready, :failed
|
||||
error-log
|
||||
(load-time 0))
|
||||
|
||||
(defun find-triggered-skill (context)
|
||||
"Iterates through the registry and returns the first skill whose trigger returns true."
|
||||
(let ((skills nil))
|
||||
(maphash (lambda (name skill) (declare (ignore name)) (push skill skills)) *skills-registry*)
|
||||
(setf skills (sort skills #'> :key #'skill-priority))
|
||||
(dolist (s skills)
|
||||
(let ((trigger (skill-trigger-fn s)))
|
||||
(when (and trigger (funcall trigger context))
|
||||
(return-from find-triggered-skill s))))
|
||||
nil))
|
||||
"Returns the highest priority skill whose trigger matches context AND has a probabilistic prompt."
|
||||
(let ((triggered nil))
|
||||
(maphash (lambda (name skill)
|
||||
(declare (ignore name))
|
||||
(when (and (skill-probabilistic-prompt skill)
|
||||
(ignore-errors (funcall (skill-trigger-fn skill) context)))
|
||||
(push skill triggered)))
|
||||
*skills-registry*)
|
||||
(first (sort triggered #'> :key #'skill-priority))))
|
||||
|
||||
(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic)
|
||||
"Registers a new skill into the global registry."
|
||||
`(setf (gethash (string-downcase (string ,name)) *skills-registry*)
|
||||
(make-skill :name (string-downcase (string ,name))
|
||||
:priority (or ,priority 10)
|
||||
:dependencies ',dependencies
|
||||
:trigger-fn ,trigger
|
||||
:probabilistic-prompt ,probabilistic
|
||||
:deterministic-fn ,deterministic)))
|
||||
|
||||
(defun resolve-skill-dependencies (skill-name)
|
||||
"Recursively resolves dependencies for a given skill name."
|
||||
(let ((resolved nil) (seen nil))
|
||||
(labels ((visit (name)
|
||||
(unless (member name seen :test #'equal)
|
||||
(push name seen)
|
||||
(let ((skill (gethash (string-downcase (string name)) *skills-registry*)))
|
||||
(when skill
|
||||
(dolist (dep (skill-dependencies skill))
|
||||
(visit dep))))
|
||||
(push name resolved))))
|
||||
(visit skill-name)
|
||||
(nreverse resolved))))
|
||||
|
||||
(defun parse-skill-metadata (filepath)
|
||||
"Extracts ID and DEPENDS_ON tags using robust regex scanning."
|
||||
(let ((dependencies nil)
|
||||
(id nil)
|
||||
(content (uiop:read-file-string filepath)))
|
||||
;; Extract ID
|
||||
(multiple-value-bind (match regs)
|
||||
(ppcre:scan-to-strings "(?im:^:ID:\\s*([^\\s\\r\\n]+))" content)
|
||||
(when match (setf id (aref regs 0))))
|
||||
;; Extract all DEPENDS_ON lines
|
||||
(ppcre:do-register-groups (deps-string)
|
||||
("(?im:^#\\+DEPENDS_ON:\\s*(.*))" content)
|
||||
(let ((deps (ppcre:split "\\s+" (string-trim " " deps-string))))
|
||||
(setf dependencies (append dependencies (mapcar (lambda (s) (string-trim "[] " s)) deps)))))
|
||||
(values id (remove-if (lambda (s) (= 0 (length s))) dependencies))))
|
||||
|
||||
(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"))
|
||||
(adj (make-hash-table :test 'equal))
|
||||
(name-to-file (make-hash-table :test 'equal))
|
||||
(id-to-file (make-hash-table :test 'equal))
|
||||
(result nil)
|
||||
(visited (make-hash-table :test 'equal))
|
||||
(stack (make-hash-table :test 'equal)))
|
||||
(dolist (file files)
|
||||
(let ((filename (pathname-name file)))
|
||||
(multiple-value-bind (id deps) (parse-skill-metadata file)
|
||||
(setf (gethash (string-downcase filename) name-to-file) file)
|
||||
(when id (setf (gethash (string-downcase id) id-to-file) file))
|
||||
(setf (gethash (string-downcase filename) adj) deps))))
|
||||
(labels ((visit (file)
|
||||
(let* ((filename (pathname-name file))
|
||||
(node-key (string-downcase filename)))
|
||||
(unless (gethash node-key visited)
|
||||
(setf (gethash node-key stack) t)
|
||||
(dolist (dep (gethash node-key adj))
|
||||
(let* ((is-id-p (uiop:string-prefix-p "id:" (string-downcase dep)))
|
||||
(dep-key (string-downcase (if is-id-p (subseq dep 3) dep)))
|
||||
(dep-file (if is-id-p
|
||||
(gethash dep-key id-to-file)
|
||||
(or (gethash dep-key id-to-file)
|
||||
(gethash dep-key name-to-file)))))
|
||||
(when dep-file
|
||||
(let ((dep-filename (pathname-name dep-file)))
|
||||
(if (gethash (string-downcase dep-filename) stack)
|
||||
(error "Circular dependency detected: ~a -> ~a" filename dep-filename)
|
||||
(visit dep-file))))))
|
||||
(setf (gethash node-key stack) nil)
|
||||
(setf (gethash node-key visited) t)
|
||||
(push file result)))))
|
||||
(let ((filenames (sort (mapcar #'pathname-name files) #'string<)))
|
||||
(dolist (name filenames)
|
||||
(let ((file (gethash (string-downcase name) name-to-file)))
|
||||
(when file (visit file)))))
|
||||
(nreverse result))))
|
||||
|
||||
(defun validate-lisp-syntax (code-string)
|
||||
"Checks if a string contains valid, readable Common Lisp forms.
|
||||
Delegates to the Lisp Validator skill when available; falls back to a basic
|
||||
reader check during early boot before the validator skill is loaded."
|
||||
(let ((result
|
||||
(if (fboundp 'lisp-validator-validate)
|
||||
(lisp-validator-validate code-string :strict nil)
|
||||
(handler-case
|
||||
(let ((*read-eval* nil))
|
||||
(with-input-from-string (stream (format nil "(progn ~a)" code-string))
|
||||
(loop for form = (read stream nil :eof) until (eq form :eof)))
|
||||
(list :status :success))
|
||||
(error (c)
|
||||
(list :status :error :reason (format nil "~a" c)))))))
|
||||
(if (eq (getf result :status) :success)
|
||||
(values t nil)
|
||||
(values nil (or (getf result :reason) "Lisp Validator rejected code.")))))
|
||||
|
||||
(defun load-skill-from-org (filepath)
|
||||
"Parses and evaluates Lisp blocks with :tangle directives from an Org file.
|
||||
Only loads blocks that specify a .lisp tangle target, ignoring tests and examples."
|
||||
(let* ((skill-base-name (pathname-name filepath))
|
||||
(entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))
|
||||
(setf (skill-entry-status entry) :loading)
|
||||
(setf (gethash skill-base-name *skill-catalog*) entry)
|
||||
|
||||
(handler-case
|
||||
(let* ((content (uiop:read-file-string filepath))
|
||||
(lines (uiop:split-string content :separator '(#\Newline)))
|
||||
(in-lisp-block nil)
|
||||
(collect-this-block nil)
|
||||
(lisp-code "")
|
||||
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword)))
|
||||
|
||||
(dolist (line lines)
|
||||
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
|
||||
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line))
|
||||
(setf in-lisp-block t)
|
||||
;; Only collect blocks with a :tangle directive pointing to a
|
||||
;; runtime .lisp file (exclude tests and :tangle no)
|
||||
(let ((tl (string-downcase clean-line)))
|
||||
(setf collect-this-block
|
||||
(and (search ":tangle" tl)
|
||||
(not (search ":tangle no" tl))
|
||||
(search ".lisp" tl)
|
||||
(not (search "tests/" tl))
|
||||
(not (search "test/" tl))))))
|
||||
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line))
|
||||
(setf in-lisp-block nil)
|
||||
(setf collect-this-block nil))
|
||||
((and in-lisp-block collect-this-block)
|
||||
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
|
||||
(uiop:string-prefix-p ":END:" (string-upcase clean-line)))
|
||||
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
|
||||
|
||||
(if (= (length lisp-code) 0)
|
||||
(progn (setf (skill-entry-status entry) :ready) t)
|
||||
(progn
|
||||
(multiple-value-bind (valid-p err) (validate-lisp-syntax lisp-code)
|
||||
(unless valid-p (error "Syntax Error: ~a" err)))
|
||||
(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))))
|
||||
(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)
|
||||
t)))
|
||||
(error (c)
|
||||
(let ((msg (format nil "~a" c)))
|
||||
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name msg)
|
||||
(setf (skill-entry-status entry) :failed)
|
||||
(setf (skill-entry-error-log entry) msg)
|
||||
nil)))))
|
||||
|
||||
(defun load-skill-with-timeout (filepath timeout-seconds)
|
||||
"Loads a skill Org file with a hard execution timeout."
|
||||
(let* ((finished nil)
|
||||
(thread (bt:make-thread (lambda ()
|
||||
(if (load-skill-from-org filepath)
|
||||
(setf finished t)
|
||||
(setf finished :error)))
|
||||
:name (format nil "loader-~a" (pathname-name filepath))))
|
||||
(start-time (get-internal-real-time))
|
||||
(timeout-units (truncate (* timeout-seconds internal-time-units-per-second))))
|
||||
(loop
|
||||
(when (eq finished t) (return :success))
|
||||
(when (eq finished :error) (return :error))
|
||||
(unless (bt:thread-alive-p thread) (return :error))
|
||||
(when (> (- (get-internal-real-time) start-time) timeout-units)
|
||||
(harness-log "HARNESS: Timing out skill ~a..." (pathname-name filepath))
|
||||
#+sbcl (sb-thread:terminate-thread thread)
|
||||
#-sbcl (bt:destroy-thread thread)
|
||||
(return :timeout))
|
||||
(sleep 0.05))))
|
||||
|
||||
(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"))
|
||||
(skills-dir-str (or env-path (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
|
||||
(resolved-path (context-resolve-path skills-dir-str))
|
||||
(skills-dir (if resolved-path (uiop:ensure-directory-pathname resolved-path) nil)))
|
||||
|
||||
(unless (and skills-dir (uiop:directory-exists-p skills-dir))
|
||||
(harness-log "HARNESS ERROR: Skills directory not found: ~a" skills-dir-str)
|
||||
(return-from initialize-all-skills nil))
|
||||
|
||||
(let ((sorted-files (topological-sort-skills skills-dir)))
|
||||
(let* ((mandatory-env (uiop:getenv "MANDATORY_SKILLS"))
|
||||
(mandatory-skills (if mandatory-env
|
||||
(mapcar (lambda (s) (string-trim '(#\Space #\" #\') s))
|
||||
(uiop:split-string mandatory-env :separator '( #\,)))
|
||||
'("org-skill-policy" "org-skill-bouncer"))))
|
||||
(dolist (req mandatory-skills)
|
||||
(unless (member req sorted-files :key #'pathname-name :test #'string-equal)
|
||||
(error "BOOT FAILURE: Mandatory skill '~a' not found in skills directory: ~a" req (uiop:native-namestring skills-dir))))
|
||||
|
||||
(harness-log "==================================================")
|
||||
(harness-log " LOADER: Initializing ~a skills..." (length sorted-files))
|
||||
|
||||
(dolist (file sorted-files)
|
||||
(let* ((skill-name (pathname-name file))
|
||||
(is-mandatory (member skill-name mandatory-skills :test #'string-equal)))
|
||||
(harness-log " LOADER: Loading ~a..." skill-name)
|
||||
(let ((status (load-skill-with-timeout file 5)))
|
||||
(unless (eq status :success)
|
||||
(if is-mandatory
|
||||
(error "BOOT FAILURE: Mandatory skill '~a' failed to load (Status: ~a)." skill-name status)
|
||||
(harness-log "LOADER WARNING: Skill '~a' failed to load." skill-name))))))
|
||||
|
||||
(let ((ready 0) (failed 0))
|
||||
(maphash (lambda (k v)
|
||||
(declare (ignore k))
|
||||
(if (eq (skill-entry-status v) :ready) (incf ready) (incf failed)))
|
||||
*skill-catalog*)
|
||||
(harness-log " LOADER: Boot Complete. [Ready: ~a] [Failed: ~a]" ready failed)
|
||||
(harness-log "==================================================")
|
||||
(values ready failed))))))
|
||||
|
||||
(defun generate-tool-belt-prompt ()
|
||||
"Aggregates all registered cognitive tools into a descriptive prompt."
|
||||
(let ((output (format nil "AVAILABLE TOOLS:
|
||||
You can call tools by returning a Lisp plist: (:target :tool :action :call :tool <name> :args (...))
|
||||
|
||||
EXAMPLES:
|
||||
(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\"))
|
||||
(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"autonomousty\"))
|
||||
(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\"))
|
||||
|
||||
---
|
||||
" )))
|
||||
(maphash (lambda (name tool)
|
||||
(setf output (concatenate 'string output
|
||||
(format nil "- ~a: ~a~% Parameters: ~s~%~%"
|
||||
name
|
||||
(cognitive-tool-description tool)
|
||||
(cognitive-tool-parameters tool)))))
|
||||
*cognitive-tools*)
|
||||
output))
|
||||
|
||||
(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)
|
||||
(declare (ignore context))
|
||||
(let ((code (getf args :code)))
|
||||
(let ((harness-pkg (find-package :opencortex.skills.org-skill-lisp-validator)))
|
||||
(if harness-pkg
|
||||
(uiop:symbol-call :opencortex.skills.org-skill-lisp-validator :lisp-validator-validate code)
|
||||
t))))
|
||||
:body (lambda (args)
|
||||
(let ((code (getf args :code)))
|
||||
(handler-case (let ((result (eval (read-from-string code))))
|
||||
(format nil "~s" result))
|
||||
(error (c) (format nil "ERROR: ~a" c))))))
|
||||
|
||||
(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)"))
|
||||
:body (lambda (args)
|
||||
(let ((pattern (getf args :pattern))
|
||||
(dir (or (getf args :dir) (uiop:getenv "MEMEX_DIR"))))
|
||||
(uiop:run-program (list "grep" "-r" "-n" "--exclude-dir=node_modules" pattern dir)
|
||||
:output :string :ignore-error-status t))))
|
||||
|
||||
(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)
|
||||
(declare (ignore context))
|
||||
(let ((cmd (getf args :cmd)))
|
||||
(not (or (search "rm -rf /" cmd) (search ":(){ :|:& };:" cmd)))))
|
||||
:body (lambda (args)
|
||||
(let ((cmd (getf args :cmd)))
|
||||
(multiple-value-bind (out err code)
|
||||
(uiop:run-program (list "bash" "-c" cmd) :output :string :error-output :string :ignore-error-status t)
|
||||
(format nil "EXIT-CODE: ~a~%~%STDOUT:~%~a~%~%STDERR:~%~a" code out err)))))
|
||||
|
||||
@@ -1,28 +1,31 @@
|
||||
(in-package :cl-user)
|
||||
(defpackage :opencortex.tui (:use :cl :croatoan) (:export :main))
|
||||
(defpackage :opencortex.tui
|
||||
(:use :cl :croatoan)
|
||||
(:export :main))
|
||||
(in-package :opencortex.tui)
|
||||
|
||||
(defvar *daemon-host* "127.0.0.1")
|
||||
(defvar *daemon-port* 9105)
|
||||
(defvar *socket* nil)
|
||||
(defvar *stream* nil)
|
||||
|
||||
(defvar *chat-history* nil "A list of strings representing the scrollback buffer.")
|
||||
(defvar *input-buffer* (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))
|
||||
(defvar *is-running* t)
|
||||
(defvar *chat-history* (list))
|
||||
(defvar *status-text* "Connecting...")
|
||||
|
||||
(defvar *msg-queue* nil)
|
||||
(defvar *queue-lock* (bt:make-lock "tui-msg-lock"))
|
||||
(defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t))
|
||||
(defvar *is-running* t)
|
||||
(defvar *queue-lock* (bt:make-lock))
|
||||
(defvar *incoming-msgs* nil)
|
||||
|
||||
(defun enqueue-msg (msg)
|
||||
(bt:with-lock-held (*queue-lock*) (push msg *msg-queue*)))
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
(push msg *incoming-msgs*)))
|
||||
|
||||
(defun dequeue-msgs ()
|
||||
(bt:with-lock-held (*queue-lock*) (let ((m (reverse *msg-queue*))) (setf *msg-queue* nil) m)))
|
||||
(bt:with-lock-held (*queue-lock*)
|
||||
(let ((msgs (nreverse *incoming-msgs*)))
|
||||
(setf *incoming-msgs* nil)
|
||||
msgs)))
|
||||
|
||||
(defun clean-keywords (msg)
|
||||
"Ensures all keys in a plist are uppercase keywords."
|
||||
(if (listp msg)
|
||||
(let ((clean nil))
|
||||
(loop for (k v) on msg by #'cddr
|
||||
@@ -83,7 +86,6 @@
|
||||
(sleep 0.05)))
|
||||
|
||||
(defun main ()
|
||||
"Primary entry point for the standalone TUI client."
|
||||
(handler-case
|
||||
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
|
||||
(error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
|
||||
@@ -103,12 +105,11 @@
|
||||
(setf (input-blocking input-win) nil)
|
||||
|
||||
(loop while *is-running* do
|
||||
;; 1. Handle incoming messages from the queue
|
||||
;; 1. Handle incoming messages
|
||||
(let ((new-msgs (dequeue-msgs)))
|
||||
(when new-msgs
|
||||
(dolist (msg new-msgs)
|
||||
(push msg *chat-history*)
|
||||
;; Maintenance: Cap scrollback to prevent memory bloat
|
||||
(setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))
|
||||
|
||||
(clear chat-win)
|
||||
@@ -118,7 +119,7 @@
|
||||
(incf line-num)))
|
||||
(refresh chat-win)))
|
||||
|
||||
;; 2. Render Status Bar
|
||||
;; 2. Render Status Bar ONLY if changed
|
||||
(unless (equal *status-text* last-status)
|
||||
(clear status-win)
|
||||
(add-string status-win *status-text* :attributes '(:reverse))
|
||||
@@ -134,7 +135,9 @@
|
||||
(let ((cmd (coerce *input-buffer* 'string)))
|
||||
(setf (fill-pointer *input-buffer*) 0)
|
||||
(when (> (length cmd) 0)
|
||||
;; Frame and dispatch the message
|
||||
;; Local Echo
|
||||
(enqueue-msg (concatenate 'string "> " cmd))
|
||||
;; Send to Brain
|
||||
(let ((framed (opencortex:frame-message (list :TYPE :EVENT
|
||||
:META (list :SOURCE :tui :SESSION-ID "default")
|
||||
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))))
|
||||
|
||||
@@ -6,18 +6,16 @@
|
||||
: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/communication-validator")
|
||||
(: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 +38,4 @@
|
||||
|
||||
(defsystem :opencortex/tui
|
||||
:depends-on (:opencortex :croatoan :usocket :bordeaux-threads)
|
||||
:components ((:file "src/tui-client")))
|
||||
:components ((:file "library/tui-client")))
|
||||
|
||||
@@ -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
|
||||
;;
|
||||
|
||||
|
||||
BIN
scripts/__pycache__/ui_driver.cpython-313.pyc
Normal file
BIN
scripts/__pycache__/ui_driver.cpython-313.pyc
Normal file
Binary file not shown.
54
scripts/browser-bridge.py
Normal file
54
scripts/browser-bridge.py
Normal file
@@ -0,0 +1,54 @@
|
||||
#!/usr/bin/env python3
|
||||
import sys
|
||||
import json
|
||||
import base64
|
||||
from playwright.sync_api import sync_playwright
|
||||
|
||||
def run_bridge():
|
||||
# Read command from stdin
|
||||
try:
|
||||
raw_input = sys.stdin.read()
|
||||
if not raw_input:
|
||||
print(json.dumps({"status": "error", "message": "No input provided"}))
|
||||
return
|
||||
|
||||
args = json.loads(raw_input)
|
||||
except Exception as e:
|
||||
print(json.dumps({"status": "error", "message": f"Invalid JSON input: {str(e)}"}))
|
||||
return
|
||||
|
||||
url = args.get("url")
|
||||
action = args.get("action", "extract_text")
|
||||
selector = args.get("selector", "body")
|
||||
|
||||
if not url:
|
||||
print(json.dumps({"status": "error", "message": "No URL provided"}))
|
||||
return
|
||||
|
||||
try:
|
||||
with sync_playwright() as p:
|
||||
browser = p.chromium.launch(headless=True)
|
||||
page = browser.new_page()
|
||||
|
||||
# Navigate and wait for network to be idle
|
||||
page.goto(url, wait_until="networkidle")
|
||||
|
||||
result = {"status": "success", "url": url}
|
||||
|
||||
if action == "extract_text":
|
||||
result["content"] = page.inner_text(selector)
|
||||
elif action == "screenshot":
|
||||
screenshot_bytes = page.screenshot()
|
||||
result["screenshot_base64"] = base64.b64encode(screenshot_bytes).decode("utf-8")
|
||||
else:
|
||||
result["status"] = "error"
|
||||
result["message"] = f"Unknown action: {action}"
|
||||
|
||||
browser.close()
|
||||
print(json.dumps(result))
|
||||
|
||||
except Exception as e:
|
||||
print(json.dumps({"status": "error", "message": f"Playwright Error: {str(e)}"}))
|
||||
|
||||
if __name__ == "__main__":
|
||||
run_bridge()
|
||||
59
scripts/onboard-baremetal.sh
Executable file
59
scripts/onboard-baremetal.sh
Executable file
@@ -0,0 +1,59 @@
|
||||
#!/bin/bash
|
||||
# OpenCortex Final-Mile Installer
|
||||
RED='\033[0;31m'; GREEN='\033[0;32m'; BLUE='\033[0;34m'; YELLOW='\033[0;33m'; NC='\033[0m'
|
||||
echo -e "${BLUE}=== OpenCortex: Baremetal Power-User Setup ===${NC}"
|
||||
|
||||
prompt_user() {
|
||||
local prompt="$1"
|
||||
local default="$2"
|
||||
local var_name="$3"
|
||||
local result=""
|
||||
echo -n -e "${YELLOW}$prompt (default: $default): ${NC}" >&2
|
||||
if read -t 5 result; then :; else result="$default"; echo -e "${BLUE} [Auto-Selected: $default]${NC}" >&2; fi
|
||||
val=${result:-$default}
|
||||
eval "$var_name=\"$val\""
|
||||
}
|
||||
|
||||
# 1. Dependencies
|
||||
if ! command -v sbcl >/dev/null 2>&1; then
|
||||
echo -e "${BLUE}Installing dependencies...${NC}"
|
||||
sudo apt-get update && sudo apt-get install -y sbcl emacs git curl socat || true
|
||||
fi
|
||||
|
||||
# 2. Quicklisp
|
||||
if [ ! -d "$HOME/quicklisp" ]; then
|
||||
curl -O https://beta.quicklisp.org/quicklisp.lisp
|
||||
sbcl --non-interactive --load quicklisp.lisp --eval "(quicklisp-quickstart:install)" --eval "(ql-util:without-prompting (ql:add-to-init-file))"
|
||||
rm quicklisp.lisp
|
||||
fi
|
||||
|
||||
# 3. Tangling
|
||||
echo -e "${BLUE}Tangling source files...${NC}"
|
||||
mkdir -p src
|
||||
for f in literate/*.org; do
|
||||
echo " - Tangling $f"
|
||||
emacs --batch --eval "(require 'org)" --eval "(org-babel-tangle-file \"$f\")" >/dev/null 2>&1
|
||||
done
|
||||
|
||||
# 4. Config
|
||||
if [ ! -f .env ]; then cp .env.example .env; fi
|
||||
prompt_user "What is your name?" "User" "USER_NAME"
|
||||
prompt_user "What shall we name your Assistant?" "OpenCortex" "AGENT_NAME"
|
||||
prompt_user "Select provider (1:Gemini, 2:OpenRouter)" "1" "LLM_CHOICE"
|
||||
|
||||
sed -i "s/MEMEX_USER=.*/MEMEX_USER=\"$USER_NAME\"/g" .env
|
||||
sed -i "s/MEMEX_ASSISTANT=.*/MEMEX_ASSISTANT=\"$AGENT_NAME\"/g" .env
|
||||
|
||||
# 5. Path Alignment
|
||||
INSTALL_DIR="$(cd "$(dirname "$0")/.." && pwd)"
|
||||
sed -i "s|MEMEX_DIR=.*|MEMEX_DIR=\"$(dirname "$INSTALL_DIR")\"|g" .env
|
||||
sed -i "s|SKILLS_DIR=.*|SKILLS_DIR=\"$INSTALL_DIR/skills\"|g" .env
|
||||
|
||||
mkdir -p "$HOME/.local/bin"
|
||||
ln -sf "$INSTALL_DIR/opencortex.sh" "$HOME/.local/bin/opencortex"
|
||||
echo -e "${GREEN}✓ Installed 'opencortex' command to ~/.local/bin${NC}"
|
||||
|
||||
echo -e "\n${GREEN}==============================================${NC}"
|
||||
echo -e " OpenCortex Installation Complete! "
|
||||
echo -e "==============================================${NC}"
|
||||
echo -e "To start: opencortex"
|
||||
20
scripts/org-agent-chat.sh
Executable file
20
scripts/org-agent-chat.sh
Executable file
@@ -0,0 +1,20 @@
|
||||
#!/bin/bash
|
||||
# opencortex-chat: The terminal mouthpiece for the Autonomous Brain.
|
||||
PORT=9105
|
||||
HOST=${1:-localhost}
|
||||
|
||||
# Check for socat (preferred)
|
||||
if command -v socat >/dev/null 2>&1; then
|
||||
# Use socat with READLINE for history and arrow-key support.
|
||||
# It establishes a persistent bidirectional connection.
|
||||
socat READLINE,history=$HOME/.org_agent_history TCP:$HOST:$PORT
|
||||
else
|
||||
# Fallback to nc (netcat) for a single-shot connection if socat is missing.
|
||||
# Note: This is less robust for agents with long-thinking times.
|
||||
echo "WARNING: socat not found. Falling back to nc (no line-editing support)."
|
||||
while true; do
|
||||
read -p "User: " MESSAGE
|
||||
if [ -z "$MESSAGE" ]; then continue; fi
|
||||
echo "$MESSAGE" | nc -N $HOST $PORT
|
||||
done
|
||||
fi
|
||||
85
scripts/ui_driver.py
Executable file
85
scripts/ui_driver.py
Executable file
@@ -0,0 +1,85 @@
|
||||
import pty
|
||||
import os
|
||||
import sys
|
||||
import time
|
||||
import select
|
||||
import re
|
||||
|
||||
class VirtualTerminal:
|
||||
def __init__(self, rows=24, cols=80):
|
||||
self.rows = rows
|
||||
self.cols = cols
|
||||
self.buffer = [[' ' for _ in range(cols)] for _ in range(rows)]
|
||||
self.cursor_y = 0
|
||||
self.cursor_x = 0
|
||||
|
||||
def _strip_ansi(self, text):
|
||||
# Very basic ANSI parser for cursor moves and clears
|
||||
# CSI n ; m H (cursor move)
|
||||
# CSI J (clear screen)
|
||||
# CSI K (clear line)
|
||||
|
||||
# This is a simplified state machine
|
||||
parts = re.split(r'(\x1b\[[0-9;?]*[a-zA-Z])', text)
|
||||
for part in parts:
|
||||
if part.startswith('\x1b['):
|
||||
cmd = part[-1]
|
||||
params = part[2:-1].split(';')
|
||||
if cmd == 'H' or cmd == 'f': # Move cursor
|
||||
self.cursor_y = int(params[0]) - 1 if params[0] else 0
|
||||
self.cursor_x = int(params[1]) - 1 if (len(params) > 1 and params[1]) else 0
|
||||
elif cmd == 'J': # Clear
|
||||
mode = int(params[0]) if params[0] else 0
|
||||
if mode == 2: # Full clear
|
||||
self.buffer = [[' ' for _ in range(self.cols)] for _ in range(self.rows)]
|
||||
elif cmd == 'm': # Attributes - ignore for now
|
||||
pass
|
||||
else:
|
||||
for char in part:
|
||||
if char == '\n':
|
||||
self.cursor_y += 1
|
||||
self.cursor_x = 0
|
||||
elif char == '\r':
|
||||
self.cursor_x = 0
|
||||
elif 0 <= self.cursor_y < self.rows and 0 <= self.cursor_x < self.cols:
|
||||
self.buffer[self.cursor_y][self.cursor_x] = char
|
||||
self.cursor_x += 1
|
||||
|
||||
def get_screen(self):
|
||||
return "\n".join(["".join(row) for row in self.buffer])
|
||||
|
||||
def run_test(command, input_sequence, wait_time=5):
|
||||
pid, fd = pty.fork()
|
||||
if pid == 0:
|
||||
os.environ["TERM"] = "xterm"
|
||||
os.environ["COLUMNS"] = "80"
|
||||
os.environ["LINES"] = "24"
|
||||
os.execvp(command[0], command)
|
||||
else:
|
||||
vt = VirtualTerminal()
|
||||
start_time = time.time()
|
||||
input_sent = False
|
||||
|
||||
while time.time() - start_time < wait_time:
|
||||
r, w, e = select.select([fd], [], [], 0.1)
|
||||
if fd in r:
|
||||
try:
|
||||
data = os.read(fd, 8192).decode(errors='ignore')
|
||||
vt._strip_ansi(data)
|
||||
except OSError:
|
||||
break
|
||||
|
||||
if not input_sent and time.time() - start_time > 2:
|
||||
os.write(fd, input_sequence.encode())
|
||||
input_sent = True
|
||||
|
||||
os.kill(pid, 9)
|
||||
os.waitpid(pid, 0)
|
||||
return vt
|
||||
|
||||
if __name__ == "__main__":
|
||||
# Example usage: python3 ui_driver.py sbcl --eval ...
|
||||
vt = run_test(sys.argv[1:], "Hi\r", wait_time=10)
|
||||
print("--- VIRTUAL SCREEN SNAPSHOT ---")
|
||||
print(vt.get_screen())
|
||||
print(f"--- CURSOR POSITION: ({vt.cursor_y}, {vt.cursor_x}) ---")
|
||||
@@ -1,7 +1,7 @@
|
||||
:PROPERTIES:
|
||||
:ID: bouncer-agent-skill
|
||||
:CREATED: [2026-04-11 Sat 15:20]
|
||||
:EDITED: [2026-04-13 Mon 18:35]
|
||||
:EDITED: [2026-04-22 Wed 16:00]
|
||||
:END:
|
||||
#+DEPENDS_ON: org-skill-credentials-vault
|
||||
#+TITLE: SKILL: Deterministic Engine Bouncer (Authorization Gate)
|
||||
@@ -9,149 +9,373 @@
|
||||
#+FILETAGS: :system:bouncer:authorization:autonomy:
|
||||
|
||||
* Overview
|
||||
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.
|
||||
|
||||
The *Bouncer Skill* is the physical security layer of OpenCortex. While the Policy skill enforces constitutional invariants (transparency, autonomy, modularity), the Bouncer enforces operational security checks.
|
||||
|
||||
Think of Policy as the constitution and Bouncer as the bouncer at the door:
|
||||
- **Policy** asks: "Is this action aligned with our values?"
|
||||
- **Bouncer** asks: "Is this action safe to execute?"
|
||||
|
||||
** The Flight Plan Pattern
|
||||
|
||||
High-risk actions don't simply pass or fail—they can enter the "Flight Plan" approval workflow:
|
||||
|
||||
1. Bouncer intercepts a risky action
|
||||
2. Creates an Org node ("Flight Plan") describing the action
|
||||
3. User manually approves the flight plan in Emacs
|
||||
4. Bouncer detects approval on next heartbeat
|
||||
5. Action is re-injected with `approved = t` flag, bypassing the gate
|
||||
|
||||
This creates human-in-the-loop oversight for dangerous operations without blocking the system entirely.
|
||||
|
||||
** Why a Separate Skill?**
|
||||
|
||||
Security and policy are separated for clarity and auditability:
|
||||
- Policy decisions can be explained (they reference invariants)
|
||||
- Bouncer decisions are technical (they reference threat vectors)
|
||||
|
||||
When something is blocked, the logs clearly show which layer blocked it and why.
|
||||
|
||||
* Package Context
|
||||
#+begin_src lisp
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-bouncer.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
* Deep Packet Inspection (DPI)
|
||||
The Bouncer ensures the action is "safe" by inspecting the payload content via Deep Packet Inspection.
|
||||
* Security Vectors
|
||||
|
||||
** Secret Exposure Check
|
||||
Retrieves all active secrets from the vault and scans the payload for potential leaks.
|
||||
The Bouncer implements the 5-Vector security model:
|
||||
|
||||
#+begin_src lisp
|
||||
| Vector | Threat | Response |
|
||||
|--------|--------|----------|
|
||||
| Secret Exposure | API keys, passwords in output | Hard block |
|
||||
| Network Exfiltration | Data sent to unauthorized hosts | Approval required |
|
||||
| Shell Execution | Arbitrary command execution | Approval required |
|
||||
| File Modification | Writing/deleting files | Soft check |
|
||||
| Eval Execution | Arbitrary code evaluation | Approval required |
|
||||
|
||||
** Secret Exposure Detection
|
||||
|
||||
The vault stores sensitive credentials. This check scans action text for vault secrets to prevent accidental exposure.
|
||||
|
||||
#+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."
|
||||
"Scans TEXT for known secrets from the vault.
|
||||
|
||||
RETURNS: The name of the matched secret, or NIL if text is clean.
|
||||
|
||||
This prevents the catastrophic failure mode where the agent
|
||||
accidentally echoes an API key in its response or log output.
|
||||
|
||||
The check uses substring matching (not regex) for reliability.
|
||||
Only secrets longer than 5 characters are checked to avoid
|
||||
false positives on common words."
|
||||
|
||||
(when (and text (stringp text))
|
||||
|
||||
(let ((found-secret nil))
|
||||
|
||||
(maphash (lambda (key val)
|
||||
;; Only check secrets of meaningful length
|
||||
(when (and val (stringp val) (> (length val) 5))
|
||||
;; Search for secret value in action text
|
||||
(when (search val text)
|
||||
(setf found-secret key))))
|
||||
|
||||
opencortex::*vault-memory*)
|
||||
|
||||
found-secret)))
|
||||
#+end_src
|
||||
|
||||
** Network Exfiltration Check
|
||||
Inspects shell commands for unwhitelisted domains or IP addresses.
|
||||
** Network Exfiltration Detection
|
||||
|
||||
Detects when shell commands try to send data to untrusted network destinations.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-bouncer.lisp
|
||||
(defvar *bouncer-network-whitelist*
|
||||
'("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")
|
||||
"Domains that the Bouncer considers safe for outbound connections.
|
||||
|
||||
This whitelist should be minimal—only services explicitly configured
|
||||
as gateways. All other outbound connections require approval.")
|
||||
|
||||
#+begin_src lisp
|
||||
(defun bouncer-check-network-exfil (cmd)
|
||||
"Returns T if the command appears to target an unwhitelisted external host."
|
||||
"Detects if CMD attempts to contact an unwhitelisted external host.
|
||||
|
||||
Returns T if the command targets an unknown external host.
|
||||
Returns NIL if the command is clean or only contacts whitelisted hosts.
|
||||
|
||||
The check looks for HTTP/HTTPS/FTP URLs and extracts the domain.
|
||||
If the domain isn't in *bouncer-network-whitelist*, it's flagged."
|
||||
|
||||
(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))))))))
|
||||
|
||||
;; Look for URL patterns in the command
|
||||
(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)))
|
||||
|
||||
;; Check if domain is whitelisted
|
||||
(not (some (lambda (safe) (search safe domain))
|
||||
*bouncer-network-whitelist*)))))))
|
||||
#+end_src
|
||||
|
||||
* Runtime Guard (bouncer-check)
|
||||
The primary entry point for all high-impact actions. It blocks or queues actions based on risk vectors.
|
||||
* Runtime Guard
|
||||
|
||||
#+begin_src lisp
|
||||
** bouncer-check: Main Security Gate
|
||||
|
||||
#+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."
|
||||
"The 5-Vector security gate for high-risk actions.
|
||||
|
||||
Evaluates an action against all security vectors and either:
|
||||
- Returns the action unchanged (pass)
|
||||
- Returns a blocking LOG event (hard block)
|
||||
- Returns an approval-required EVENT (soft block)
|
||||
|
||||
Vector evaluation order:
|
||||
1. Already approved actions pass immediately
|
||||
2. Secret exposure → hard block
|
||||
3. Network exfiltration → approval required
|
||||
4. High-impact targets → approval required
|
||||
|
||||
The context parameter is not used directly but provided for
|
||||
consistency with the skill gate signature."
|
||||
|
||||
(declare (ignore context))
|
||||
|
||||
(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))))
|
||||
(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)
|
||||
(cond
|
||||
|
||||
;; Vector 0: Already approved actions pass through
|
||||
(approved
|
||||
action)
|
||||
|
||||
;; Vector 1: Secret Exposure (Hard Block)
|
||||
;; If any vault secret is found in the action text, block immediately
|
||||
((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)))))
|
||||
(harness-log "SECURITY VIOLATION: Blocked potential leak of secret '~a'" secret-name)
|
||||
(list :type :LOG
|
||||
:payload (list :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")))
|
||||
;; Vector 2: Network Exfiltration (Soft Block)
|
||||
;; Shell commands targeting unknown hosts require approval
|
||||
((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)
|
||||
(list :type :EVENT
|
||||
:payload (list :sensor :approval-required
|
||||
:action action)))
|
||||
|
||||
;; Vector 3: High-Impact Targets (Soft Block)
|
||||
;; Shell execution, file repair, and eval require approval
|
||||
((or (member target '(:shell))
|
||||
(and (eq target :tool) (member (getf payload :tool) '("shell" "repair-file") :test #'string=))
|
||||
(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)))
|
||||
(and (eq target :tool)
|
||||
(member (getf payload :tool) '("shell" "repair-file") :test #'string=))
|
||||
(and (eq target :emacs)
|
||||
(eq (getf payload :action) :eval)))
|
||||
|
||||
;; 4. Default Pass
|
||||
(t action))))
|
||||
(harness-log "SECURITY: High-impact action requires approval: ~a"
|
||||
(or (getf payload :tool) target))
|
||||
|
||||
(list :type :EVENT
|
||||
:payload (list :sensor :approval-required
|
||||
:action action)))
|
||||
|
||||
;; Vector 4: Default pass
|
||||
(t
|
||||
action))))
|
||||
#+end_src
|
||||
|
||||
* Approval Processing
|
||||
The Bouncer periodically scans the Memex for approved "Flight Plans" and re-injects them into the metabolic loop.
|
||||
* Flight Plan Workflow
|
||||
|
||||
#+begin_src lisp
|
||||
** Processing Approvals
|
||||
|
||||
When a flight plan is approved in Emacs, the Bouncer detects it and re-injects the action.
|
||||
|
||||
#+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."
|
||||
"Scans the object store for APPROVED flight plans and re-injects them.
|
||||
|
||||
This function is called on every heartbeat, allowing the agent to
|
||||
check for approvals without blocking the main signal pipeline.
|
||||
|
||||
Flight Plan format:
|
||||
- Has TAGS including \"FLIGHT_PLAN\"
|
||||
- Has TODO set to \"APPROVED\"
|
||||
- Has ACTION containing the serialized action plist
|
||||
|
||||
When an approved flight plan is found:
|
||||
1. Deserialize the action from the ACTION attribute
|
||||
2. Mark the action as :approved = t (bypasses security gate)
|
||||
3. Re-inject into the signal pipeline
|
||||
4. Mark the flight plan as DONE
|
||||
|
||||
Returns T if any flight plans were processed."
|
||||
|
||||
(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))
|
||||
|
||||
;; Only process flight plans (not other APPROVED items)
|
||||
(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
|
||||
|
||||
;; Mark as approved to bypass the security gate on re-injection
|
||||
(setf (getf action :approved) t)
|
||||
|
||||
;; Re-inject the action into the signal pipeline
|
||||
(inject-stimulus action)
|
||||
;; Mark as DONE
|
||||
|
||||
;; Mark the flight plan as done
|
||||
(setf (getf (org-object-attributes node) :TODO) "DONE")
|
||||
|
||||
(setq found-any t))))))
|
||||
|
||||
found-any))
|
||||
#+end_src
|
||||
|
||||
* Skill Definition
|
||||
The Bouncer skill reacts to approval requirements by creating flight plan nodes, and periodically checks for manual approvals via heartbeats.
|
||||
** Creating Flight Plans
|
||||
|
||||
** Skill Logic
|
||||
#+begin_src lisp
|
||||
When the Bouncer intercepts a high-risk action, it creates a flight plan node for manual approval.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-bouncer.lisp
|
||||
(defun bouncer-create-flight-plan (blocked-action)
|
||||
"Creates an Org node representing a pending flight plan for manual approval.
|
||||
|
||||
BLOCKED-ACTION is the action plist that was intercepted.
|
||||
|
||||
The flight plan node contains:
|
||||
- A title describing the action
|
||||
- TODO set to PLAN (awaiting approval)
|
||||
- TAGS including FLIGHT_PLAN
|
||||
- ACTION attribute containing the serialized action
|
||||
|
||||
The user reviews the flight plan and changes TODO to APPROVED.
|
||||
On the next heartbeat, bouncer-process-approvals will detect
|
||||
the approval and re-inject the action.
|
||||
|
||||
Returns the generated org-id for the flight plan."
|
||||
|
||||
(let ((id (org-id-new)))
|
||||
(harness-log "BOUNCER: Creating flight plan node '~a'..." id)
|
||||
|
||||
;; Inject a node creation request
|
||||
(list :type :REQUEST
|
||||
:target :emacs
|
||||
:payload (list :action :insert-node
|
||||
:id id
|
||||
:attributes (list
|
||||
:TITLE "Flight Plan: High-Risk Action"
|
||||
:TODO "PLAN"
|
||||
:TAGS '("FLIGHT_PLAN")
|
||||
:ACTION (format nil "~s" blocked-action)))))
|
||||
#+end_src
|
||||
|
||||
* Skill Gate
|
||||
|
||||
** Main Gate Function
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-bouncer.lisp
|
||||
(defun bouncer-deterministic-gate (action context)
|
||||
"Main gate for the bouncer skill."
|
||||
"Main deterministic gate for the Bouncer skill.
|
||||
|
||||
Handles three types of signals:
|
||||
1. :approval-required - Create a flight plan for the blocked action
|
||||
2. :heartbeat - Process any pending approvals
|
||||
3. otherwise - Run security check on the action
|
||||
|
||||
The trigger is always true (bouncer evaluates all actions)
|
||||
because security cannot be selective."
|
||||
|
||||
(let* ((payload (getf context :payload))
|
||||
(sensor (getf payload :sensor)))
|
||||
|
||||
(case sensor
|
||||
|
||||
;; Signal type 1: Action was blocked, create flight plan
|
||||
(: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)))))
|
||||
(let* ((blocked-action (getf payload :action)))
|
||||
(bouncer-create-flight-plan blocked-action)))
|
||||
|
||||
;; Signal type 2: Heartbeat, check for approvals
|
||||
(:heartbeat
|
||||
;; Periodically check for approvals
|
||||
(bouncer-process-approvals)
|
||||
(if action (bouncer-check action context) action))
|
||||
;; After processing approvals, still run the security check
|
||||
(if action
|
||||
(bouncer-check action context)
|
||||
action))
|
||||
|
||||
;; Signal type 3: Normal action, run security check
|
||||
(otherwise
|
||||
(if action (bouncer-check action context) action)))))
|
||||
(if action
|
||||
(bouncer-check action context)
|
||||
action)))))
|
||||
#+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
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||
:probabilistic nil
|
||||
:deterministic #'bouncer-deterministic-gate)
|
||||
#+end_src
|
||||
|
||||
* Quick Reference
|
||||
|
||||
** Security Vectors Summary
|
||||
|
||||
| Vector | Check | Response |
|
||||
|--------|-------|----------|
|
||||
| Secret Exposure | `bouncer-scan-secrets` | Hard block |
|
||||
| Network Exfil | `bouncer-check-network-exfil` | Approval required |
|
||||
| Shell Execution | target = :shell or tool = "shell" | Approval required |
|
||||
| Eval Execution | target = :emacs and action = :eval | Approval required |
|
||||
| File Repair | tool = "repair-file" | Approval required |
|
||||
|
||||
** Flight Plan Lifecycle
|
||||
|
||||
1. High-risk action intercepted → `:approval-required` signal
|
||||
2. Flight plan node created in Emacs with `TODO: PLAN`
|
||||
3. User reviews and sets `TODO: APPROVED`
|
||||
4. Next heartbeat detects approval
|
||||
5. Action re-injected with `approved = t`
|
||||
6. Security gate bypassed, action executes
|
||||
7. Flight plan marked `TODO: DONE`
|
||||
|
||||
* See Also
|
||||
- [[file:org-skill-credentials-vault.org][Credentials Vault]] - Where secrets are stored
|
||||
- [[file:org-skill-policy.org][Policy Skill]] - Constitutional constraints
|
||||
- [[file:../harness/act.org][Act Stage]] - Where gates are invoked
|
||||
@@ -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)
|
||||
|
||||
@@ -1,58 +1,99 @@
|
||||
:PROPERTIES:
|
||||
:ID: credentials-vault-skill
|
||||
:CREATED: [2026-04-09 Thu]
|
||||
:END:
|
||||
#+TITLE: SKILL: Credentials Vault (Universal Literate Note)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :auth:security:infrastructure:autonomy:
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :auth:security:infrastructure:autonomy:
|
||||
#+DEPENDS_ON: id:state-persistence-skill
|
||||
|
||||
* Overview
|
||||
The *Credentials Vault* is the high-security enclave for the OpenCortex. It centralizes the management of LLM API keys, OAuth sessions, and browser cookies. By consolidating these into a single vault, we ensure that sensitive tokens are handled with uniform masking, validation, and Merkle-integrated persistence.
|
||||
|
||||
** Architectural Intent: The Secure Enclave
|
||||
* Phase A: Demand (PRD)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Purpose
|
||||
Securely manage all authentication tokens required for the opencortex to operate.
|
||||
|
||||
** 2. User Needs
|
||||
- *Unified Storage:* Single interface for API keys and Session Cookies.
|
||||
- *Masked Logging:* Ensure credentials never appear in plaintext in `harness-log`.
|
||||
- *Guided Onboarding:* Retain and improve the Google/Gemini cookie handshake.
|
||||
- *Persistence:* Securely save credentials to the Memory via Merkle-Tree snapshots.
|
||||
|
||||
* Phase B: Blueprint (PROTOCOL)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Architectural Intent
|
||||
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.
|
||||
|
||||
The primary goal of the vault is to prevent "Credential Bleed"—the accidental leaking of API keys into logs, terminal history, or neural contexts. It achieves this by providing a unified getter that automatically masks its output for diagnostic use.
|
||||
** 2. Semantic Interfaces
|
||||
#+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.")
|
||||
|
||||
* Implementation
|
||||
(defun vault-set-secret (provider secret &key type)
|
||||
"Securely stores a secret and triggers a Merkle snapshot.")
|
||||
#+end_src
|
||||
|
||||
** Package Initialization
|
||||
#+begin_src lisp
|
||||
(in-package :cl-user)
|
||||
(defpackage :opencortex.skills.org-skill-credentials-vault
|
||||
(:use :cl :opencortex))
|
||||
(in-package :opencortex.skills.org-skill-credentials-vault)
|
||||
* Phase C: Success (QUALITY)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Success Criteria
|
||||
- [ ] *No Plaintext Leaks:* Log output must use `[REDACTED]` for sensitive values.
|
||||
- [ ] *Merkle Integration:* Setting a secret must increment the Memory version.
|
||||
- [ ] *Dual-Path Auth:* Support both `:api-key` and `:session-cookies`.
|
||||
- [ ] *Onboarding Verification:* The cookie handshake successfully hydrates the vault.
|
||||
|
||||
** 2. TDD Plan
|
||||
Tests in `tests/vault-tests.lisp` will verify:
|
||||
1. Retrieval of keys from both `.env` (fallback) and Vault (primary).
|
||||
2. Redaction of keys in log strings.
|
||||
3. Successful version increment in the Memory after `vault-set-secret`.
|
||||
|
||||
* Phase D: Build (Implementation)
|
||||
|
||||
** Package Context
|
||||
#+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, preventing constant disk I/O for auth.")
|
||||
"In-memory cache of sensitive credentials.")
|
||||
#+end_src
|
||||
|
||||
** Helper: Secret Masking (vault-mask-string)
|
||||
Ensures that diagnostic output never contains the full plaintext of a sensitive token. Used by the harness and gateways for transparent but safe logging.
|
||||
** 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. (e.g. sk-a...3f9)"
|
||||
"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]"))
|
||||
#+end_src
|
||||
|
||||
** Retrieval (vault-get-secret)
|
||||
The secure getter for all system secrets. It follows a strict priority:
|
||||
1. **Vault Memory:** High-integrity, versioned storage.
|
||||
2. **Environment Fallback:** OS-level variables for bootstrap and legacy compatibility.
|
||||
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))
|
||||
(val (gethash key opencortex::*vault-memory*)))
|
||||
(if (and val (not (string= val "")))
|
||||
(if val
|
||||
val
|
||||
;; Fallback to environment mapping
|
||||
;; Fallback to environment
|
||||
(let ((env-var (case provider
|
||||
((:gemini :gemini-api) "GEMINI_API_KEY")
|
||||
(:openai "OPENAI_API_KEY")
|
||||
@@ -69,39 +110,73 @@ The secure getter for all system secrets. It follows a strict priority:
|
||||
#+end_src
|
||||
|
||||
** Persistence (vault-set-secret)
|
||||
When a secret is updated, we immediately snapshot the Memory to ensure the change is versioned and durable.
|
||||
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 for durability."
|
||||
"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. Snapshotting memory." type provider)
|
||||
(harness-log "VAULT - Updated ~a for ~a. Triggering Merkle snapshot..." type provider)
|
||||
(snapshot-memory)
|
||||
t))
|
||||
#+end_src
|
||||
|
||||
** Automated Onboarding Instructions
|
||||
Provides instructions for the autonomous cookie handshake (retained from legacy components).
|
||||
** 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 ()
|
||||
"Displays instructions for the Gemini Web cookie handshake."
|
||||
"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)
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-credentials-vault
|
||||
:priority 200 ; Foundational Priority
|
||||
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :onboarding-request))
|
||||
:probabilistic nil
|
||||
:deterministic (lambda (action ctx)
|
||||
(declare (ignore ctx))
|
||||
(vault-onboard-gemini-web)
|
||||
action))
|
||||
** Registration
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-credentials-vault.lisp
|
||||
(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)))
|
||||
#+end_src
|
||||
|
||||
* Phase E: Chaos (Verification)
|
||||
|
||||
Note: Tests disabled in jail load.
|
||||
|
||||
** 1. Unit Tests (FiveAM)
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-credentials-vault.lisp
|
||||
#|
|
||||
(defpackage :opencortex-vault-tests
|
||||
(:use :cl :fiveam :opencortex))
|
||||
(in-package :opencortex-vault-tests)
|
||||
|
||||
(def-suite vault-suite :description "Tests for the Credentials Vault.")
|
||||
(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))))
|
||||
|#
|
||||
#+end_src
|
||||
|
||||
** 2. Chaos Scenarios
|
||||
- *Scenario A (Vault Poisoning):* Inject a malformed session string and verify the `llm-gateway` detects the invalid format and returns a standardized error instead of crashing.
|
||||
- *Scenario B (Memory Wipe):* Clear `opencortex::*vault-memory*` during runtime and verify the vault successfully re-hydrates from the Memory (or environment fallback).
|
||||
|
||||
* Phase F: Memory (RCA)
|
||||
- *[2026-04-09 Thu]:* Consolidated `auth-api-key` and `auth-google-oauth` into this vault. Introduced mandatory masking for all credential-related logging.
|
||||
|
||||
@@ -1,43 +1,60 @@
|
||||
:PROPERTIES:
|
||||
:ID: gardener-skill
|
||||
:CREATED: [2026-04-13 Mon 18:50]
|
||||
:END:
|
||||
#+TITLE: SKILL: Autonomous Gardener (Memex Maintenance)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :gardener:maintenance:memex:autonomy:
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :gardener:maintenance:memex:autonomy:
|
||||
|
||||
* Overview
|
||||
The *Autonomous Gardener* is the metabolic immune system of the Memex. It autonomously audits the knowledge graph for structural decay—broken links, orphaned nodes, and missing metadata—ensuring that the system remains coherent and navigatable over long horizons.
|
||||
|
||||
** Architectural Intent: Graph Integrity
|
||||
In a self-evolving Memex, structural decay is inevitable. Links break as notes are renamed, and nodes become orphaned as projects are abandoned. The Gardener ensures that the "Vibe" of the Memex remains healthy by:
|
||||
1. **Auditing:** Identifying broken `id:` links.
|
||||
2. **Analysis:** Flagging nodes with zero inbound or outbound connections (Orphans).
|
||||
3. **Reporting:** Logging structural issues for user review or future autonomous repair.
|
||||
* Phase A: Demand (PRD)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
* Implementation
|
||||
** 1. Purpose
|
||||
Maintain the structural integrity and "Vibe" of the Memex through autonomous auditing and self-repair proposals.
|
||||
|
||||
** Package Initialization
|
||||
#+begin_src lisp
|
||||
(in-package :cl-user)
|
||||
(defpackage :opencortex.skills.org-skill-gardener
|
||||
(:use :cl :opencortex))
|
||||
(in-package :opencortex.skills.org-skill-gardener)
|
||||
** 2. Success Criteria
|
||||
- [ ] *Link Audit:* Detect `id:` links that point to non-existent objects.
|
||||
- [ ] *Orphan Detection:* Identify headlines that have zero inbound or outbound connections.
|
||||
- [ ] *Reporting:* Log structural issues or propose "Flight Plans" for manual repair.
|
||||
|
||||
* Phase B: Blueprint (PROTOCOL)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Architectural Intent
|
||||
The Gardener runs on a low-priority heartbeat. It performs a "Deep Audit" of the entire `*memory*` graph. Unlike the Scribe, which creates new data, the Gardener focuses on the *relationships* between existing data.
|
||||
|
||||
** 2. Semantic Interfaces
|
||||
- Trigger: `(:sensor :heartbeat)`
|
||||
- Action (Repair): `(:type :REQUEST :target :emacs :action :update-node :id "..." :attributes (...))`
|
||||
|
||||
* Phase D: Build (Implementation)
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-gardener.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
** State: Maintenance Cycle
|
||||
To minimize system overhead, the Gardener only performs a full audit pass periodically.
|
||||
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
|
||||
|
||||
* The Audit Engine
|
||||
** Audit: Broken Links
|
||||
Scans the content of all objects for `id:` links and verifies the targets exist.
|
||||
|
||||
** Link Verification (gardener-find-broken-links)
|
||||
This function performs deep packet inspection of the Memory graph. It utilizes regular expressions to find Org-mode ID links and verifies their targets against the live object registry.
|
||||
|
||||
#+begin_src lisp
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-gardener.lisp
|
||||
(defun gardener-find-broken-links ()
|
||||
"Scans all objects in memory for broken internal ID 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)))
|
||||
@@ -49,12 +66,12 @@ This function performs deep packet inspection of the Memory graph. It utilizes r
|
||||
broken))
|
||||
#+end_src
|
||||
|
||||
** Orphan Detection (gardener-find-orphans)
|
||||
Structural isolation limits the effectiveness of semantic reasoning. This function maps the entire graph topology to identify nodes that have effectively "fallen off" the Memex.
|
||||
** 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 ()
|
||||
"Identifies nodes with zero connectivity in the knowledge graph."
|
||||
"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))
|
||||
@@ -75,14 +92,12 @@ Structural isolation limits the effectiveness of semantic reasoning. This functi
|
||||
orphans))
|
||||
#+end_src
|
||||
|
||||
* Metabolic Integration
|
||||
** 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.
|
||||
|
||||
** Main Audit Gate (gardener-deterministic-gate)
|
||||
The primary execution hook. It performs the audit and translates technical findings into human-readable logs for the harness.
|
||||
|
||||
#+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 and logs reports."
|
||||
"Main gate for the Gardener skill. Audits graph integrity."
|
||||
(declare (ignore action context))
|
||||
(let ((broken (gardener-find-broken-links))
|
||||
(orphans (gardener-find-orphans)))
|
||||
@@ -98,19 +113,19 @@ The primary execution hook. It performs the audit and translates technical findi
|
||||
(harness-log " [ORPHAN] Node ~a is isolated." orphan)))
|
||||
|
||||
(setf *gardener-last-audit* (get-universal-time))
|
||||
;; Stop the pipeline by returning a Log event.
|
||||
(list :type :LOG :payload (list :text "Gardener audit pass complete."))))
|
||||
;; Return a log to stop the loop
|
||||
(list :type :LOG :payload (list :text "Gardener audit complete."))))
|
||||
#+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)
|
||||
(let* ((payload (getf ctx :payload))
|
||||
(sensor (getf payload :sensor)))
|
||||
(and (eq sensor :heartbeat)
|
||||
;; Optimization: Only audit once every 24 hours
|
||||
;; Only audit once per day
|
||||
(> (- (get-universal-time) *gardener-last-audit*) 86400))))
|
||||
:probabilistic nil
|
||||
:deterministic #'gardener-deterministic-gate)
|
||||
|
||||
@@ -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."
|
||||
|
||||
382
skills/org-skill-lisp-validator.org
Normal file
382
skills/org-skill-lisp-validator.org
Normal file
@@ -0,0 +1,382 @@
|
||||
:PROPERTIES:
|
||||
:ID: lisp-validator-skill
|
||||
:CREATED: [2026-04-22 Wed 12:15]
|
||||
:EDITED: [2026-04-22 Wed 12:15]
|
||||
:END:
|
||||
#+TITLE: SKILL: Lisp Validator (Structural & Semantic Gate)
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :security:lisp:ast:autonomy:modularity:
|
||||
|
||||
* Overview
|
||||
The *Lisp Validator* is the primary structural gate for the Probabilistic-Deterministic Lisp Machine. It eliminates the token-waste of probabilistic paren-balancing by providing a deterministic, three-phase validation pipeline: Structural, Syntactic, and Semantic. It is exposed as a cognitive tool so both the harness and the Probabilistic Engine can invoke it before declaring code complete.
|
||||
|
||||
* Phase A: Demand (PRD)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Purpose
|
||||
Provide a deterministic, fast, and auditable validation gate for all Lisp code proposals.
|
||||
|
||||
** 2. User Needs
|
||||
- *Structural Validation:* Detect unbalanced parentheses, brackets, and unterminated strings without invoking the reader.
|
||||
- *Syntactic Validation:* Ensure the code can be read by SBCL with `*read-eval*` disabled.
|
||||
- *Semantic Validation:* Optionally enforce a whitelist of safe symbols for sandboxed execution.
|
||||
- *Tool Exposure:* The Probabilistic Engine must be able to call this as a cognitive tool.
|
||||
|
||||
** 3. Success Criteria
|
||||
- [X] Structural check runs in O(n) and catches all paren/string defects.
|
||||
- [X] Syntactic check catches reader errors and malformed sexps.
|
||||
- [X] Semantic check blocks non-whitelisted symbols when strict mode is enabled.
|
||||
- [X] Returns structured plist for machine parsing and human explanation.
|
||||
|
||||
* Phase B: Blueprint (PROTOCOL)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Architectural Intent
|
||||
A single entry point, `lisp-validator-validate`, runs three sequential checks. Each check is isolated so a failure in one does not obscure failures in others. The function returns a unified result plist.
|
||||
|
||||
** 2. Semantic Interfaces
|
||||
- `(lisp-validator-validate code-string &key strict)` → plist
|
||||
- Tool `:validate-lisp` with args `(:code "..." :strict t/nil)`
|
||||
|
||||
* Phase D: Build (Implementation)
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
** Check 1: Structural Validation (Paren Balance)
|
||||
Scans the raw string character-by-character, tracking open/close pairs for `()`, `[]`, `#()`, and string delimiters `"`. Ignores escaped characters and line comments (`;`). This is O(n) and does not invoke the Lisp reader.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(defun lisp-validator-check-structural (code-string)
|
||||
"Checks for balanced parens, brackets, and terminated strings.
|
||||
Returns (VALUES t nil) if clean, or (VALUES nil reason-string line col)."
|
||||
(let ((stack nil)
|
||||
(in-string nil)
|
||||
(escaped nil)
|
||||
(line 1)
|
||||
(col 0)
|
||||
(last-open-line 1)
|
||||
(last-open-col 0))
|
||||
(dotimes (i (length code-string)
|
||||
(if (null stack)
|
||||
(values t nil nil nil)
|
||||
(values nil (format nil "Unbalanced '~a' opened at line ~a, col ~a"
|
||||
(caar stack) last-open-line last-open-col)
|
||||
last-open-line last-open-col)))
|
||||
(let ((ch (char code-string i)))
|
||||
(cond (escaped (setf escaped nil))
|
||||
((char= ch #\\) (setf escaped t))
|
||||
(in-string
|
||||
(when (char= ch #\") (setf in-string nil)))
|
||||
((char= ch #\;)
|
||||
;; Skip to end of line
|
||||
(loop while (and (< i (1- (length code-string)))
|
||||
(not (char= (char code-string (1+ i)) #\Newline)))
|
||||
do (incf i))
|
||||
(incf line) (setf col 0))
|
||||
((char= ch #\")
|
||||
(setf in-string t))
|
||||
((member ch '(#\( #\[))
|
||||
(push (list (string ch) line col) stack)
|
||||
(setf last-open-line line last-open-col col))
|
||||
((char= ch #\))
|
||||
(cond ((null stack)
|
||||
(return-from lisp-validator-check-structural
|
||||
(values nil (format nil "Unexpected ')' at line ~a, col ~a" line col) line col)))
|
||||
((string= (caar stack) "[")
|
||||
(return-from lisp-validator-check-structural
|
||||
(values nil (format nil "Mismatched ']' expected at line ~a, col ~a" line col) line col)))
|
||||
(t (pop stack))))
|
||||
((char= ch #\])
|
||||
(cond ((null stack)
|
||||
(return-from lisp-validator-check-structural
|
||||
(values nil (format nil "Unexpected ']' at line ~a, col ~a" line col) line col)))
|
||||
((string= (caar stack) "(")
|
||||
(return-from lisp-validator-check-structural
|
||||
(values nil (format nil "Mismatched ')' expected at line ~a, col ~a" line col) line col)))
|
||||
(t (pop stack))))
|
||||
((char= ch #\Newline)
|
||||
(incf line) (setf col 0)))
|
||||
(unless (char= ch #\Newline) (incf col))))))
|
||||
#+end_src
|
||||
|
||||
** Check 2: Syntactic Validation (Reader Check)
|
||||
Wraps the code in `(progn ...)` and attempts to read every top-level form with `*read-eval*` disabled. Catches reader errors, invalid syntax, and malformed sexps that the structural check cannot detect (e.g., invalid reader macros).
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(defun lisp-validator-check-syntactic (code-string)
|
||||
"Checks if the code can be read by SBCL with *read-eval* nil.
|
||||
Returns (VALUES t nil) if clean, or (VALUES nil error-message line col)."
|
||||
(handler-case
|
||||
(let ((*read-eval* nil))
|
||||
(with-input-from-string (stream (format nil "(progn ~a)" code-string))
|
||||
(loop for form = (read stream nil :eof) until (eq form :eof)))
|
||||
(values t nil nil nil))
|
||||
(error (c)
|
||||
(let ((msg (format nil "~a" c)))
|
||||
(values nil msg nil nil)))))
|
||||
#+end_src
|
||||
|
||||
** Check 3: Semantic Validation (Whitelist AST Walk)
|
||||
Recursively walks the parsed AST and verifies that every function call and symbol reference appears on a whitelist. This is the "Deny-by-Default" sandbox. When `strict` is nil, this check is skipped for general validation (e.g., skill loading) but enforced for `:eval` tool execution.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(defparameter *lisp-validator-whitelist*
|
||||
'(;; Math & Logic
|
||||
+ - * / = < > <= >= 1+ 1- min max mod abs floor ceiling round
|
||||
and or not null eq eql equal string= string-equal char= char-equal
|
||||
;; List Manipulation
|
||||
list cons car cdr cadr cddr cdar caar caddr cdddr append mapcar remove-if remove-if-not
|
||||
length reverse sort nth nthcdr push pop last butlast subseq
|
||||
;; Plists, Alists, and Hash Tables
|
||||
getf gethash assoc acons pairlis rassoc
|
||||
;; Control Flow
|
||||
let let* if cond when unless case typecase prog1 progn
|
||||
;; Strings
|
||||
format concatenate string-downcase string-upcase search subseq replace
|
||||
;; Type predicates
|
||||
stringp numberp integerp listp symbolp keywordp null
|
||||
;; Kernel safe symbols
|
||||
opencortex::harness-log
|
||||
opencortex::snapshot-memory opencortex::rollback-memory
|
||||
opencortex::lookup-object opencortex::list-objects-by-type
|
||||
opencortex::ingest-ast opencortex::find-headline-missing-id
|
||||
opencortex::context-query-store opencortex::context-get-active-projects
|
||||
opencortex::context-get-recent-completed-tasks opencortex::context-list-all-skills
|
||||
opencortex::context-get-system-logs opencortex::context-assemble-global-awareness
|
||||
opencortex::org-object-id opencortex::org-object-type opencortex::org-object-attributes
|
||||
opencortex::org-object-content opencortex::org-object-parent-id
|
||||
opencortex::org-object-children opencortex::org-object-version
|
||||
opencortex::org-object-last-sync opencortex::org-object-hash
|
||||
opencortex::org-object-vector
|
||||
;; Essential macros and special operators
|
||||
declare ignore quote function lambda defun defvar defparameter defmacro
|
||||
;; Safe I/O
|
||||
with-open-file write-string read-line
|
||||
;; Package introspection
|
||||
find-package make-package in-package do-external-symbols find-symbol
|
||||
;; Safe system interaction
|
||||
uiop:run-program uiop:getenv uiop:merge-pathnames* uiop:file-exists-p
|
||||
uiop:directory-exists-p uiop:read-file-string uiop:split-string
|
||||
;; Time
|
||||
get-universal-time get-internal-real-time sleep
|
||||
;; Equality
|
||||
equalp = equal eq eql))
|
||||
"Static whitelist of symbols permitted in the Lisp Validator sandbox."
|
||||
|
||||
(defvar *lisp-validator-registry* nil
|
||||
"List of dynamically registered safe symbols.")
|
||||
|
||||
(defun lisp-validator-register (symbols)
|
||||
"Adds symbols to the global validator registry."
|
||||
(setf *lisp-validator-registry*
|
||||
(append *lisp-validator-registry*
|
||||
(if (listp symbols) symbols (list symbols))))
|
||||
(harness-log "LISP VALIDATOR: Registered ~a new safe symbols."
|
||||
(length (if (listp symbols) symbols (list symbols)))))
|
||||
|
||||
(defun lisp-validator-is-safe (symbol)
|
||||
"Checks if a symbol is in the static whitelist or the dynamic registry."
|
||||
(or (member symbol *lisp-validator-whitelist* :test #'string-equal)
|
||||
(member symbol *lisp-validator-registry* :test #'string-equal)))
|
||||
|
||||
(defun lisp-validator-ast-walk (form)
|
||||
"Recursively walks the Lisp AST. Returns T if safe, NIL if unsafe."
|
||||
(cond
|
||||
;; Self-evaluating objects are safe.
|
||||
((or (stringp form) (numberp form) (keywordp form) (characterp form)) t)
|
||||
;; Symbols used as variables (in non-function position)
|
||||
((symbolp form) (lisp-validator-is-safe form))
|
||||
;; Lists represent function calls or special forms.
|
||||
((listp form)
|
||||
(let ((head (car form)))
|
||||
(cond
|
||||
((eq head 'quote) t)
|
||||
((not (symbolp head)) nil)
|
||||
((lisp-validator-is-safe head)
|
||||
(every #'lisp-validator-ast-walk (cdr form)))
|
||||
(t
|
||||
(harness-log "LISP VALIDATOR: Blocked call to non-whitelisted function ~a" head)
|
||||
nil))))
|
||||
(t nil)))
|
||||
|
||||
(defun lisp-validator-check-semantic (code-string)
|
||||
"Checks if all symbols in CODE-STRING are whitelisted.
|
||||
Returns (VALUES t nil) if clean, or (VALUES nil reason-string nil nil)."
|
||||
(handler-case
|
||||
(let ((*read-eval* nil))
|
||||
(with-input-from-string (stream (format nil "(progn ~a)" code-string))
|
||||
(loop for form = (read stream nil :eof)
|
||||
until (eq form :eof)
|
||||
do (unless (lisp-validator-ast-walk form)
|
||||
(return-from lisp-validator-check-semantic
|
||||
(values nil "Code contains non-whitelisted symbols." nil nil)))))
|
||||
(values t nil nil nil))
|
||||
(error (c)
|
||||
(values nil (format nil "Semantic check failed: ~a" c) nil nil))))
|
||||
#+end_src
|
||||
|
||||
** Unified Entry Point
|
||||
Orchestrates the three checks and returns a single structured plist.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(defun lisp-validator-validate (code-string &key strict)
|
||||
"Validates Lisp code through structural, syntactic, and optional semantic checks.
|
||||
Returns a plist:
|
||||
(:status :success :checks (:structural t :syntactic t :semantic t))
|
||||
or
|
||||
(:status :error :failed <check-key> :reason <string> :line <n> :col <n>)
|
||||
|
||||
When STRICT is non-nil, the semantic whitelist check is enforced.
|
||||
When STRICT is nil, semantic check is skipped for general validation."
|
||||
(let ((structural-ok nil) (syntactic-ok nil) (semantic-ok nil)
|
||||
(reason nil) (line nil) (col nil))
|
||||
;; Phase 1: Structural
|
||||
(multiple-value-setq (structural-ok reason line col)
|
||||
(lisp-validator-check-structural code-string))
|
||||
(unless structural-ok
|
||||
(return-from lisp-validator-validate
|
||||
(list :status :error :failed :structural :reason reason :line line :col col)))
|
||||
;; Phase 2: Syntactic
|
||||
(multiple-value-setq (syntactic-ok reason line col)
|
||||
(lisp-validator-check-syntactic code-string))
|
||||
(unless syntactic-ok
|
||||
(return-from lisp-validator-validate
|
||||
(list :status :error :failed :syntactic :reason reason :line line :col col)))
|
||||
;; Phase 3: Semantic (only when strict)
|
||||
(when strict
|
||||
(multiple-value-setq (semantic-ok reason line col)
|
||||
(lisp-validator-check-semantic code-string))
|
||||
(unless semantic-ok
|
||||
(return-from lisp-validator-validate
|
||||
(list :status :error :failed :semantic :reason reason :line line :col col))))
|
||||
;; All clear
|
||||
(list :status :success
|
||||
:checks (list :structural t :syntactic t :semantic (or (not strict) semantic-ok)))))
|
||||
#+end_src
|
||||
|
||||
** Cognitive Tool: :validate-lisp
|
||||
Exposes the validator to the Probabilistic Engine so it can self-correct before presenting code.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(def-cognitive-tool :validate-lisp
|
||||
"Deterministically validates Lisp code for structural, syntactic, and semantic correctness.
|
||||
Use this BEFORE declaring any Lisp code edit complete."
|
||||
((:code :type :string :description "The Lisp code string to validate.")
|
||||
(:strict :type :boolean :description "If non-nil, enforces the semantic whitelist."))
|
||||
:body (lambda (args)
|
||||
(let ((code (getf args :code))
|
||||
(strict (getf args :strict)))
|
||||
(if (and code (stringp code))
|
||||
(lisp-validator-validate code :strict strict)
|
||||
(list :status :error :reason "Missing :code argument.")))))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-lisp-validator.lisp
|
||||
(defskill :skill-lisp-validator
|
||||
:priority 900
|
||||
:trigger (lambda (ctx)
|
||||
;; Trigger on any eval or shell action, or when validation is explicitly requested
|
||||
(let ((candidate (getf ctx :approved-action)))
|
||||
(when candidate
|
||||
(let ((payload (getf candidate :payload)))
|
||||
(member (getf payload :action) '(:eval :shell))))))
|
||||
:probabilistic nil
|
||||
:deterministic (lambda (action context)
|
||||
(declare (ignore context))
|
||||
(let ((payload (getf action :payload)))
|
||||
(if (eq (getf payload :action) :eval)
|
||||
(let* ((code (getf payload :code))
|
||||
(result (lisp-validator-validate code :strict t)))
|
||||
(if (eq (getf result :status) :error)
|
||||
(progn
|
||||
(harness-log "LISP VALIDATOR: Blocked unsafe :eval action. ~a"
|
||||
(getf result :reason))
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text (format nil "LISP VALIDATOR: Blocked unsafe eval. ~a"
|
||||
(getf result :reason)))))
|
||||
action))
|
||||
action))))
|
||||
#+end_src
|
||||
|
||||
* Phase E: Chaos (Verification)
|
||||
#+begin_src lisp :tangle ../tests/lisp-validator-tests.lisp
|
||||
(defpackage :opencortex-lisp-validator-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:lisp-validator-suite))
|
||||
|
||||
(in-package :opencortex-lisp-validator-tests)
|
||||
|
||||
(def-suite lisp-validator-suite
|
||||
:description "Tests for the Lisp Validator structural, syntactic, and semantic gates.")
|
||||
|
||||
(in-suite lisp-validator-suite)
|
||||
|
||||
(test structural-balanced
|
||||
(let ((result (opencortex::lisp-validator-check-structural "(+ 1 2)")))
|
||||
(is (eq result t))))
|
||||
|
||||
(test structural-unbalanced-open
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-structural "(+ 1 2")
|
||||
(is (null ok))
|
||||
(is (search "Unbalanced" reason))
|
||||
(is (= line 1))))
|
||||
|
||||
(test structural-unbalanced-close
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-structural "+ 1 2)")
|
||||
(is (null ok))
|
||||
(is (search "Unexpected" reason)))
|
||||
|
||||
(test structural-mismatched-bracket
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-structural "(let [x 1) x)")
|
||||
(is (null ok))
|
||||
(is (search "Mismatched" reason))))
|
||||
|
||||
(test syntactic-valid
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-syntactic "(+ 1 2) (* 3 4)")
|
||||
(is ok)))
|
||||
|
||||
(test syntactic-invalid-reader
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-syntactic "(1+ 2 #")")
|
||||
(is (null ok))))
|
||||
|
||||
(test semantic-safe
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-semantic "(+ 1 2)")
|
||||
(is ok)))
|
||||
|
||||
(test semantic-blocked-eval
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-semantic "(eval '(+ 1 2))")
|
||||
(is (null ok))))
|
||||
|
||||
(test unified-success
|
||||
(let ((result (opencortex::lisp-validator-validate "(+ 1 2)" :strict t)))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (getf (getf result :checks) :structural))
|
||||
(is (getf (getf result :checks) :syntactic))
|
||||
(is (getf (getf result :checks) :semantic))))
|
||||
|
||||
(test unified-structural-failure
|
||||
(let ((result (opencortex::lisp-validator-validate "(+ 1 2" :strict nil)))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (eq (getf result :failed) :structural))))
|
||||
|
||||
(test unified-semantic-failure-strict
|
||||
(let ((result (opencortex::lisp-validator-validate "(delete-file \"x.txt\")" :strict t)))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (eq (getf result :failed) :semantic))))
|
||||
#+end_src
|
||||
@@ -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."))
|
||||
|
||||
@@ -1,35 +1,31 @@
|
||||
:PROPERTIES:
|
||||
:ID: llm-gateway-skill
|
||||
:CREATED: [2026-04-09 Thu]
|
||||
:EDITED: [2026-04-19 Sun]
|
||||
:END:
|
||||
#+TITLE: SKILL: Unified LLM Gateway (Universal Literate Note)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :llm:gateway:infrastructure:autonomy:
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :llm:gateway:infrastructure:autonomy:
|
||||
#+DEPENDS_ON: org-skill-credentials-vault
|
||||
|
||||
* Overview
|
||||
The *Unified LLM Gateway* is the single sensory and reasoning interface for all neural backends. It consolidates the previously fragmented provider skills into a high-integrity dispatch layer, standardizing credential management, error handling, and payload formatting.
|
||||
|
||||
** Architectural Intent: The Neural Dispatch
|
||||
The gateway utilizes a functional dispatch pattern. A single entry point, ~execute-llm-request~, resolves the provider-specific nuances (URLs, headers, JSON structures) while exposing a uniform interface to the harness.
|
||||
* Phase B: Blueprint (PROTOCOL)
|
||||
|
||||
By abstracting the provider details, we allow the agent to swap "brains" mid-thought based on cost, speed, or task complexity without any change to the core reasoning logic.
|
||||
** 1. Architectural Intent
|
||||
The gateway utilizes a functional dispatch pattern. A single entry point, `execute-llm-request`, resolves the provider-specific nuances (URLs, headers, JSON structures) while exposing a uniform interface to the harness.
|
||||
|
||||
* Implementation
|
||||
* Phase D: Build (Implementation)
|
||||
|
||||
** Package Initialization
|
||||
#+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)
|
||||
#+end_src
|
||||
** Implementation
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-llm-gateway.lisp
|
||||
|
||||
** Data Extraction Helper (get-nested)
|
||||
JSON responses from different providers vary wildly in their nesting depth. ~get-nested~ provides a robust, recursive mechanism to extract values from deeply nested alists, shielding the gateway from parsing errors.
|
||||
|
||||
#+begin_src lisp
|
||||
(defun get-nested (alist &rest keys)
|
||||
"Recursively extracts nested values from an alist, handling both objects and arrays."
|
||||
(let ((val alist))
|
||||
(dolist (k keys)
|
||||
;; Handle cl-json style arrays and nested alists
|
||||
;; 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)
|
||||
@@ -39,15 +35,7 @@ JSON responses from different providers vary wildly in their nesting depth. ~get
|
||||
(setf val (cdr pair))
|
||||
(return-from get-nested nil))))
|
||||
val))
|
||||
#+end_src
|
||||
|
||||
** Unified Request Router (execute-llm-request)
|
||||
The primary entry point for all neural reasoning. It handles:
|
||||
1. *Credential Retrieval:* Securely fetching keys from the Vault.
|
||||
2. *Cascade Fallback:* (Logic for future expansion).
|
||||
3. *Provider Normalization:* Translating a generic prompt into provider-specific JSON.
|
||||
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
@@ -57,23 +45,29 @@ The primary entry point for all neural reasoning. It handles:
|
||||
(harness-log "PROBABILISTIC ENGINE: Requesting ~a (Model: ~s)"
|
||||
active-provider (or model "default"))
|
||||
|
||||
;; Guard: API Key Verification
|
||||
;; 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 ERROR: Provider ~a has no key." active-provider)
|
||||
(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
|
||||
(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))))
|
||||
(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 Provider Normalization (Anthropic, Gemini, OpenAI, OpenRouter)
|
||||
(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")))
|
||||
@@ -92,22 +86,20 @@ The primary entry point for all neural reasoning. It handles:
|
||||
(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
|
||||
(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
|
||||
(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)))))
|
||||
(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)))))))))
|
||||
#+end_src
|
||||
|
||||
** Cascade Initialization
|
||||
The provider cascade determines the failover logic for the agent's cognition.
|
||||
|
||||
#+begin_src lisp
|
||||
;; 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 "")))
|
||||
@@ -116,23 +108,12 @@ The provider cascade determines the failover logic for the agent's cognition.
|
||||
default-list)))
|
||||
(setf opencortex::*provider-cascade* final-list)
|
||||
(opencortex:harness-log "PROBABILISTIC: Neural Cascade Initialized -> ~a" final-list))
|
||||
#+end_src
|
||||
|
||||
** Backend Registration
|
||||
Registers all supported providers into the core ~*probabilistic-backends*~ registry.
|
||||
|
||||
#+begin_src lisp
|
||||
;; 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))))
|
||||
#+end_src
|
||||
|
||||
* Cognitive Tool Integration
|
||||
|
||||
** The ask-llm Tool
|
||||
Provides the agent with the physical capability to query additional neural contexts.
|
||||
|
||||
#+begin_src lisp
|
||||
(def-cognitive-tool :ask-llm
|
||||
"Queries an LLM provider via the unified gateway."
|
||||
((:prompt :type :string :description "The user prompt.")
|
||||
@@ -144,13 +125,10 @@ Provides the agent with the physical capability to query additional neural conte
|
||||
(or (getf args :system-prompt) "You are a helpful assistant.")
|
||||
:provider (getf args :provider)
|
||||
:model (getf args :model))))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-llm-gateway
|
||||
:priority 150
|
||||
:trigger (lambda (context) (declare (ignore context)) nil) ; Passive responder
|
||||
:trigger (lambda (context) (declare (ignore context)) nil)
|
||||
:probabilistic (lambda (context) (declare (ignore context)) nil)
|
||||
:deterministic (lambda (action context) (declare (ignore context)) action))
|
||||
#+end_src
|
||||
|
||||
@@ -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")
|
||||
|
||||
@@ -1,73 +1,583 @@
|
||||
:PROPERTIES:
|
||||
:ID: 47425a43-2be0-423c-8509-22592cfe9c9e
|
||||
:CREATED: [2026-04-07 Tue 12:57]
|
||||
:EDITED: [2026-04-13 Mon 18:30]
|
||||
:EDITED: [2026-04-22 Wed 16:00]
|
||||
:END:
|
||||
#+TITLE: SKILL: System Policy
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :platform:policy:alignment:autonomy:
|
||||
|
||||
* Overview
|
||||
The *opencortex* is a probabilistic-deterministic harness for a personal operating system. It uses Org-mode as its native memory and Common Lisp as its deterministic reasoning engine.
|
||||
|
||||
The *Policy Skill* is the constitutional law of OpenCortex. It defines the non-negotiable constraints that every agentic action must satisfy before reaching the actuator layer.
|
||||
|
||||
Unlike a passive manifesto, Policy is *enforced* by the Deterministic Engine. The LLM proposes; Policy verifies. If an action violates an invariant, Policy blocks it and returns an auditable explanation.
|
||||
|
||||
** Why a Constitutional Approach?**
|
||||
|
||||
AIs fail in two ways:
|
||||
1. *Underconstraint* - They do harmful things because no one told them not to
|
||||
2. *Overconstraint* - They refuse to act because every action triggers a warning
|
||||
|
||||
OpenCortex solves this with a *hierarchy of invariants*:
|
||||
- Some invariants block absolutely (Transparency, Modularity)
|
||||
- Others warn but don't block (Autonomy debt, Sustainability debt)
|
||||
|
||||
This allows the agent to be both *safe* and *usable*.
|
||||
|
||||
** The Philosophical Foundation
|
||||
|
||||
OpenCortex is not just software—it's a *personal operating system* designed for the 100-year horizon. The Memex must outlive:
|
||||
- Cloud services that get discontinued
|
||||
- Programming languages that fall out of fashion
|
||||
- Hardware platforms that become obsolete
|
||||
|
||||
Therefore, Policy encodes not just rules, but *values*:
|
||||
- Radical Transparency → Auditability is non-negotiable
|
||||
- Autonomy → Dependency on proprietary systems is debt, not strength
|
||||
- Zero-Bloat → Complexity is cost, not feature
|
||||
- Modularity → The kernel must survive even if all skills fail
|
||||
- Mentorship → Teaching is the highest form of assistance
|
||||
- Sustainability → Offline capability is a feature, not a limitation
|
||||
|
||||
* Package Context
|
||||
Every skill executes within its own jailed package namespace, while inheriting core harness symbols.
|
||||
|
||||
#+begin_src lisp :tangle ../library/policy.lisp
|
||||
Every skill executes within its own jailed package namespace, inheriting core harness symbols while maintaining isolation from other skills.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
* The Override Hierarchy
|
||||
|
||||
When two invariants conflict, resolution follows a strict priority order. This prevents the agent from freezing on ethical edge cases.
|
||||
|
||||
| Priority | Invariant | Philosophy |
|
||||
|----------|-----------|------------|
|
||||
| 500 | Transparency | If you can't explain it, you can't do it |
|
||||
| 400 | Autonomy | Independence from proprietary control is the primary goal |
|
||||
| 300 | Zero-Bloat | Complexity must be earned, not imported |
|
||||
| 250 | Modularity | Complexity belongs at the edges, not the core |
|
||||
| 200 | Mentorship | Teaching increases capability; doing removes it |
|
||||
| 100 | Sustainability | Offline capability today enables 100-year survival |
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
|
||||
(defvar *policy-invariant-priorities*
|
||||
'((:transparency . 500)
|
||||
(:autonomy . 400)
|
||||
(:bloat . 300)
|
||||
(:modularity . 250)
|
||||
(:mentorship . 200)
|
||||
(:sustainability . 100))
|
||||
"Priority alist for policy invariant conflict resolution.
|
||||
Higher numbers take precedence.
|
||||
|
||||
When two invariants conflict, the higher priority wins.
|
||||
Example: Modularity (250) takes precedence over Mentorship (200),
|
||||
meaning a change that would fatten the harness is blocked
|
||||
even if it would be educational.")
|
||||
#+end_src
|
||||
|
||||
* The Core Invariants
|
||||
This document contains the *Core System Policy*. These are non-negotiable philosophical and technical constraints that every agentic action MUST satisfy. The Deterministic Engine uses these headlines as a "Moral Compass" during the decision stage.
|
||||
|
||||
** 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.
|
||||
** 1. Radical Transparency
|
||||
|
||||
*The maxim: "If you can't explain it, you can't do it."*
|
||||
|
||||
The agent's Thought Stream must be fully auditable. Hidden reasoning or obfuscated logic violates the system's core purpose: a transparent, comprehensible AI assistant.
|
||||
|
||||
At the gate:
|
||||
- Every action must be a valid, inspectable data structure
|
||||
- Every user-facing action must carry an `:explanation`
|
||||
- Log messages must include the triggering invariant
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
|
||||
(defun policy-check-transparency (action context)
|
||||
"Ensures the action is inspectable and user-facing actions carry an explanation.
|
||||
|
||||
TRANSPARENCY CHECK:
|
||||
1. Action must be a valid plist (not opaque data)
|
||||
2. User-facing actions (:cli, :tui, :emacs) must include :explanation
|
||||
3. Heartbeat and handshake messages are exempt (they're system status)
|
||||
|
||||
Returns the action if clean, or a blocking LOG event if violated."
|
||||
|
||||
#+begin_src lisp :tangle ../library/policy.lisp
|
||||
(defun policy-check-autonomy (action context)
|
||||
"Ensures the action does not violate the Autonomy invariant."
|
||||
(declare (ignore context))
|
||||
;; Implementation placeholder: currently permits all actions.
|
||||
;; Future: Scan for non-autonomous domain names or proprietary API endpoints.
|
||||
|
||||
;; Check 1: Action must be a valid plist
|
||||
(unless (listp action)
|
||||
(return-from policy-check-transparency
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text "POLICY [Transparency]: Action is not a valid plist. Rejected."))))
|
||||
|
||||
(let* ((payload (getf action :payload))
|
||||
(target (or (getf action :target) (getf action :TARGET)))
|
||||
(explanation (or (getf payload :explanation)
|
||||
(getf payload :EXPLANATION)
|
||||
(getf payload :rationale)
|
||||
(getf payload :RATIONALE))))
|
||||
|
||||
;; Check 2: User-facing actions require explanation
|
||||
(when (and (member target '(:cli :tui :emacs :EMACS :CLI :TUI))
|
||||
(not explanation)
|
||||
(not (member (getf payload :action)
|
||||
'(:handshake :heartbeat :status-update))))
|
||||
(return-from policy-check-transparency
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text "POLICY [Transparency]: User-facing action missing :explanation. Blocked.")))))
|
||||
|
||||
action)
|
||||
#+end_src
|
||||
|
||||
** 2. Technical Mastery & Mentorship
|
||||
The agent's goal is not to "do it for the user," but to "empower the user." Every autonomous action must be explained at a level that increases the user's technical understanding of the Lisp Machine.
|
||||
** 2. Autonomy Above All
|
||||
|
||||
*The maxim: "Every dependency is debt."*
|
||||
|
||||
Every action should increase the user's independence from centralized, proprietary platforms. When the system uses a proprietary API, it's logged as "autonomy debt"—acceptable tactically, but flagged for eventual replacement.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
|
||||
(defvar *proprietary-domain-watchlist*
|
||||
'("googleapis.com" "api.openai.com" "anthropic.com" "api.groq.com" "openrouter.ai")
|
||||
"Domains representing centralized, proprietary control.
|
||||
|
||||
Actions targeting these are logged as autonomy debt, not hard-blocked.
|
||||
This is because tactical gateway usage (Telegram, Signal, OpenRouter)
|
||||
is permitted under the strategic mandate for autonomy.
|
||||
|
||||
Strategic goal: Replace all proprietary APIs with local alternatives.
|
||||
Tactical reality: Use what's available while building toward that goal.")
|
||||
|
||||
(defun policy-scan-proprietary-references (action)
|
||||
"Scans ACTION text fields for proprietary domain references.
|
||||
|
||||
Searches in:
|
||||
- :text and :TEXT in payload
|
||||
- :cmd and :CMD in payload
|
||||
- :cmd in args (for shell tool calls)
|
||||
|
||||
Returns the first matched domain, or NIL if clean."
|
||||
|
||||
(let* ((payload (getf action :payload))
|
||||
(text (or (getf payload :text) (getf payload :TEXT) ""))
|
||||
(cmd (or (getf payload :cmd)
|
||||
(getf payload :CMD)
|
||||
(when (equal (getf payload :tool) "shell")
|
||||
(getf (getf payload :args) :cmd))
|
||||
""))
|
||||
(haystack (concatenate 'string text cmd)))
|
||||
|
||||
(dolist (domain *proprietary-domain-watchlist* nil)
|
||||
(when (search domain haystack)
|
||||
(return domain)))))
|
||||
|
||||
(defun policy-check-autonomy (action context)
|
||||
"Flags actions that reference proprietary domains.
|
||||
|
||||
Does NOT block the action—this is a warning, not a veto.
|
||||
The agent can use proprietary services tactically, but must
|
||||
be aware that each usage is a step away from full autonomy.
|
||||
|
||||
Returns a warning LOG if proprietary reference detected,
|
||||
or the original action if clean."
|
||||
|
||||
(declare (ignore context))
|
||||
|
||||
(let ((domain (policy-scan-proprietary-references action)))
|
||||
|
||||
(if domain
|
||||
(progn
|
||||
(harness-log "POLICY [Autonomy]: Detected proprietary reference '~a'. Flagged for replacement." domain)
|
||||
;; Return a warning log but DO NOT block the action
|
||||
(list :type :LOG
|
||||
:payload (list :level :warn
|
||||
:text (format nil "Autonomy Debt: Action references proprietary domain '~a'. Consider a local alternative." domain)
|
||||
:original-action action)))
|
||||
|
||||
action))
|
||||
#+end_src
|
||||
|
||||
** 3. Zero-Bloat Mandate
|
||||
The system harness must remain minimalist. "Just-in-case" code is a security vulnerability. Complexity must be earned, not imported.
|
||||
|
||||
** 4. Radical Transparency
|
||||
The agent's "Thought Stream" must be fully auditable. Hidden reasoning or obfuscated logic is a violation of the system's design principles.
|
||||
*The maxim: "Complexity is cost, not feature."*
|
||||
|
||||
** 5. Long-Term Sustainability
|
||||
Prioritize local, energy-efficient, and offline-first architectures. The "Memex" should be functional in a 100-year horizon.
|
||||
The system harness must remain minimalist. "Just-in-case" code is a security vulnerability. Complexity must be earned through demonstrated need, not anticipation of future use.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
|
||||
(defvar *policy-max-skill-size-chars* 50000
|
||||
"Maximum recommended size for a skill file tangled from an Org note.
|
||||
|
||||
This is a soft limit—the check warns but does not block.
|
||||
A large, well-documented skill is acceptable; a small, poorly-documented
|
||||
one that adds unnecessary complexity is not.")
|
||||
|
||||
(defun policy-check-bloat (action context)
|
||||
"Warns if a :create-skill action exceeds the bloat threshold.
|
||||
|
||||
Size alone is not proof of complexity—a 50KB skill that's well-designed
|
||||
is better than a 5KB skill that's spaghetti. This check flags for review,
|
||||
not automatic rejection.
|
||||
|
||||
Returns a warning LOG if threshold exceeded, or original action if clean."
|
||||
|
||||
(declare (ignore context))
|
||||
|
||||
(let* ((payload (getf action :payload))
|
||||
(act (getf payload :action))
|
||||
(content (getf payload :content)))
|
||||
|
||||
(when (and (eq act :create-skill)
|
||||
(stringp content)
|
||||
(> (length content) *policy-max-skill-size-chars*))
|
||||
|
||||
(harness-log "POLICY [Bloat]: Proposed skill is ~a chars. Exceeds ~a char threshold."
|
||||
(length content) *policy-max-skill-size-chars*)
|
||||
|
||||
(return-from policy-check-bloat
|
||||
(list :type :LOG
|
||||
:payload (list :level :warn
|
||||
:text (format nil "Bloat Warning: Proposed skill (~a chars) exceeds ~a char threshold. Review for earned complexity."
|
||||
(length content) *policy-max-skill-size-chars*)
|
||||
:original-action action))))
|
||||
|
||||
action)
|
||||
#+end_src
|
||||
|
||||
** 4. Modularity
|
||||
|
||||
*The maxim: "The kernel must survive even if all skills fail."*
|
||||
|
||||
Every system should be decomposed into a minimal, unbreakable core and hot-swappable capabilities. Complexity must live at the edges, never in the kernel.
|
||||
|
||||
This is the most important invariant for system stability. If the harness grows fat, it becomes:
|
||||
- Harder to verify for security
|
||||
- Harder to debug when things go wrong
|
||||
- Harder to maintain across versions
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
|
||||
(defvar *modularity-protected-paths*
|
||||
'("harness/" "opencortex.asd")
|
||||
"Paths that constitute the unbreakable core of the system.
|
||||
|
||||
Any action targeting these paths must include a :modularity-justification
|
||||
explaining why the change cannot be implemented as a skill.
|
||||
|
||||
The Thin Harness principle: What belongs in the harness?
|
||||
- Core signal processing (Perceive-Reason-Act loop)
|
||||
- Memory and persistence primitives
|
||||
- Protocol definition and validation
|
||||
- Skills register and dispatch
|
||||
|
||||
What belongs in skills?
|
||||
- Policy and security
|
||||
- LLM integration
|
||||
- Domain-specific functionality
|
||||
- New actuators")
|
||||
|
||||
(defun policy-check-modularity (action context)
|
||||
"Blocks modifications to the system's protected core unless justified.
|
||||
|
||||
MODULARITY CHECK:
|
||||
1. If the action targets a protected path
|
||||
2. And no :modularity-justification is provided
|
||||
3. Then block with an explanation
|
||||
|
||||
The justification should explain WHY the change cannot be a skill.
|
||||
Common valid reasons:
|
||||
- The change fixes a bug in the harness itself
|
||||
- The change adds a primitive that skills cannot implement
|
||||
- The change is required for security hardening
|
||||
|
||||
Invalid reasons:
|
||||
- 'It's easier to modify the harness'
|
||||
- 'Skills are too slow'
|
||||
- 'I want to keep it all in one place'"
|
||||
|
||||
(declare (ignore context))
|
||||
|
||||
(let* ((payload (getf action :payload))
|
||||
(target-file (or (getf payload :file)
|
||||
(getf payload :filename)))
|
||||
(justification (or (getf payload :modularity-justification)
|
||||
(getf payload :MODULARITY-JUSTIFICATION))))
|
||||
|
||||
(when (and target-file
|
||||
(some (lambda (path) (search path target-file))
|
||||
*modularity-protected-paths*)
|
||||
(not justification))
|
||||
|
||||
(return-from policy-check-modularity
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text "POLICY [Modularity]: Modification to protected core path blocked. Provide :modularity-justification explaining why this cannot be a skill."
|
||||
:blocked-path target-file))))
|
||||
|
||||
action)
|
||||
#+end_src
|
||||
|
||||
** 5. Technical Mastery & Mentorship
|
||||
|
||||
*The maxim: "Teaching is the highest form of assistance."*
|
||||
|
||||
The agent's goal is not to "do it for the user," but to "empower the user." Every autonomous action must be explained at a level that increases the user's technical understanding.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
|
||||
(defvar *mentorship-required-actions*
|
||||
'(:create-skill :eval :modify-file :write-file :replace
|
||||
:rename-file :delete-file :shell :create-note)
|
||||
"Actions that trigger the Mentorship invariant.
|
||||
|
||||
These are high-impact actions that should come with explanations
|
||||
not just for the user, but for future debugging and maintenance.")
|
||||
|
||||
(defun policy-check-mentorship (action context)
|
||||
"Blocks high-impact actions that lack a mentorship note.
|
||||
|
||||
MENTORSHIP CHECK:
|
||||
1. If the action is in *mentorship-required-actions*
|
||||
2. Or if the action calls shell/eval/repair-file tools
|
||||
3. Then require :mentorship-note explaining what and why
|
||||
|
||||
The mentorship note should be:
|
||||
- Concise (1-2 sentences)
|
||||
- Educational (explain the principle, not just the action)
|
||||
- Actionable (help the user understand the outcome)"
|
||||
|
||||
(declare (ignore context))
|
||||
|
||||
(let* ((payload (getf action :payload))
|
||||
(act (or (getf payload :action)
|
||||
(getf action :action)))
|
||||
(note (or (getf payload :mentorship-note)
|
||||
(getf payload :MENTORSHIP-NOTE)))
|
||||
(target (or (getf action :target)
|
||||
(getf action :TARGET)))
|
||||
(tool (when (eq target :tool)
|
||||
(getf payload :tool))))
|
||||
|
||||
(when (or (member act *mentorship-required-actions*)
|
||||
(member tool '("shell" "eval" "repair-file")))
|
||||
|
||||
(unless note
|
||||
(return-from policy-check-mentorship
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text "POLICY [Mentorship]: High-impact action missing :mentorship-note. Explain what you are doing and why. Blocked.")))))
|
||||
|
||||
action)
|
||||
#+end_src
|
||||
|
||||
** 6. Long-Term Sustainability
|
||||
|
||||
*The maxim: "Build for the 100-year horizon."*
|
||||
|
||||
The Memex should be functional even when:
|
||||
- Internet is unavailable
|
||||
- Cloud services are discontinued
|
||||
- Hardware platforms change
|
||||
|
||||
This means preferring local, energy-efficient architectures over cloud-dependent ones.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
|
||||
(defvar *cloud-only-backends* '(:openrouter :openai :anthropic :groq :gemini-api)
|
||||
"Backends requiring internet connection and external infrastructure.
|
||||
|
||||
These are acceptable as fallbacks when local inference is unavailable,
|
||||
but should be logged as sustainability debt for tracking purposes.")
|
||||
|
||||
(defun policy-check-sustainability (action context)
|
||||
"Logs sustainability debt when action relies on cloud-only infrastructure.
|
||||
|
||||
Does NOT block—this is informational, not prohibitive.
|
||||
Cloud usage is acceptable tactically (when local models fail),
|
||||
but every cloud usage should be a conscious decision, not a default."
|
||||
|
||||
(let* ((payload (getf context :payload))
|
||||
(backend (getf payload :backend))
|
||||
(provider (getf payload :provider))
|
||||
|
||||
(when (or (member backend *cloud-only-backends*)
|
||||
(member provider *cloud-only-backends*))
|
||||
|
||||
(harness-log "POLICY [Sustainability]: Cloud provider '~a' used. Logged as sustainability debt."
|
||||
(or backend provider))
|
||||
|
||||
(return-from policy-check-sustainability
|
||||
(list :type :LOG
|
||||
:payload (list :level :warn
|
||||
:text (format nil "Sustainability Debt: Reliance on cloud provider '~a'. Consider Ollama or local inference."
|
||||
(or backend provider))))))
|
||||
|
||||
action)
|
||||
#+end_src
|
||||
|
||||
* Policy Explanation Engine
|
||||
|
||||
When the policy gate blocks or modifies an action, it must tell the user *why*. This creates an auditable log of every policy decision.
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
|
||||
(defun policy-explain (invariant-key message &optional original-action)
|
||||
"Formats a policy decision into an auditable explanation plist.
|
||||
|
||||
INVARIANT-KEY is one of:
|
||||
:transparency, :autonomy, :bloat, :modularity, :mentorship, :sustainability
|
||||
|
||||
MESSAGE is a human-readable string explaining the decision.
|
||||
|
||||
ORIGINAL-ACTION is the action that was blocked or modified.
|
||||
|
||||
Returns a REQUEST plist addressed to the original source,
|
||||
containing the explanation and original action for transparency."
|
||||
|
||||
(list :type :REQUEST
|
||||
:target (or (ignore-errors
|
||||
(getf (getf original-action :meta) :source))
|
||||
:cli)
|
||||
:payload (list :action :message
|
||||
:text (format nil "[POLICY ~a] ~a" invariant-key message)
|
||||
:explanation (format nil "Invariant: ~a | Rationale: ~a"
|
||||
invariant-key message)
|
||||
:original-action original-action)))
|
||||
#+end_src
|
||||
|
||||
* 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 ../library/policy.lisp
|
||||
** Running Invariant Checks
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
|
||||
(defun policy-run-invariant-checks (action context)
|
||||
"Runs all invariant checks in priority order.
|
||||
|
||||
Priority order (from *policy-invariant-priorities*):
|
||||
1. Transparency (500) - blocks non-transparent actions
|
||||
2. Autonomy (400) - warns on proprietary dependencies
|
||||
3. Bloat (300) - warns on oversized skills
|
||||
4. Modularity (250) - blocks unprotected core modifications
|
||||
5. Mentorship (200) - blocks unexplained high-impact actions
|
||||
6. Sustainability (100) - warns on cloud dependencies
|
||||
|
||||
Returns:
|
||||
- The final action (possibly modified by checks)
|
||||
- A blocking LOG event (if any check returned :error level)
|
||||
- A warning wrapper (if checks returned :warn level but no blocks)"
|
||||
|
||||
(let ((checks '(policy-check-transparency
|
||||
policy-check-autonomy
|
||||
policy-check-bloat
|
||||
policy-check-modularity
|
||||
policy-check-mentorship
|
||||
policy-check-sustainability)))
|
||||
|
||||
(dolist (check-fn checks action)
|
||||
(let ((result (funcall check-fn action context)))
|
||||
|
||||
;; If the check returned a LOG/EVENT, interpret it
|
||||
(when (and (listp result)
|
||||
(member (getf result :type) '(:LOG :EVENT)))
|
||||
|
||||
(let ((level (getf (getf result :payload) :level)))
|
||||
|
||||
(cond
|
||||
;; Hard block: error level stops processing immediately
|
||||
((eq level :error)
|
||||
(return-from policy-run-invariant-checks result))
|
||||
|
||||
;; Soft warning: log but continue with original action
|
||||
(t
|
||||
(harness-log "~a" (getf (getf result :payload) :text)))))))))
|
||||
|
||||
action)
|
||||
#+end_src
|
||||
|
||||
** Finding Engineering Standards
|
||||
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
|
||||
(defun policy-find-engineering-standards-gate ()
|
||||
"Searches for the Engineering Standards gate across known jailed package names.
|
||||
|
||||
The standards skill may be in opencortex-contrib submodule,
|
||||
so we search multiple possible package names with graceful fallback.
|
||||
|
||||
Returns the function symbol, or NIL if unavailable."
|
||||
|
||||
(dolist (pkg-name '(:opencortex.skills.org-skill-engineering-standards
|
||||
:opencortex.skills.org-skill-engineering
|
||||
:opencortex.skills.engineering-standards)
|
||||
nil)
|
||||
|
||||
(let ((pkg (find-package pkg-name)))
|
||||
(when pkg
|
||||
(let ((sym (find-symbol "ENGINEERING-STANDARDS-GATE" pkg)))
|
||||
(when (and sym (fboundp sym))
|
||||
(return (symbol-function sym))))))))
|
||||
#+end_src
|
||||
|
||||
** Main Policy Gate
|
||||
|
||||
#+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)))
|
||||
(when current-action
|
||||
(let ((eng-pkg (find-package :opencortex.skills.org-skill-engineering-standards)))
|
||||
(when eng-pkg
|
||||
(let ((eng-gate (find-symbol "ENGINEERING-STANDARDS-GATE" eng-pkg)))
|
||||
(when (and eng-gate (fboundp eng-gate))
|
||||
(setf current-action (funcall (symbol-function eng-gate) current-action context)))))))
|
||||
"The main policy gate entry point.
|
||||
|
||||
This function is registered as the deterministic-fn for the policy skill.
|
||||
It runs invariant checks, then delegates to engineering standards if loaded.
|
||||
|
||||
IMPORTANT: Never returns NIL silently. Always returns either:
|
||||
- An action (possibly modified)
|
||||
- A blocking LOG event with explanation
|
||||
- A warning wrapper with explanation"
|
||||
|
||||
;; Step 1: Run invariant checks
|
||||
(let ((current-action (policy-run-invariant-checks action context)))
|
||||
|
||||
;; Step 2: If an invariant blocked the action, stop here
|
||||
(when (and (listp current-action)
|
||||
(member (getf current-action :type) '(:LOG :EVENT))
|
||||
(eq (getf (getf current-action :payload) :level) :error))
|
||||
|
||||
(return-from policy-deterministic-gate current-action))
|
||||
|
||||
;; Step 3: Delegate to Engineering Standards if loaded
|
||||
(let ((eng-gate (policy-find-engineering-standards-gate)))
|
||||
(when eng-gate
|
||||
(setf current-action (funcall eng-gate current-action context))))
|
||||
|
||||
current-action))
|
||||
#+end_src
|
||||
|
||||
* Operational Mandates
|
||||
Every action performed by an agent in this environment must also adhere to the [[file:org-skill-engineering-standards.org][Engineering Standards]].
|
||||
* Skill Registration
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp :tangle ../library/policy.lisp
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-policy.lisp
|
||||
(defskill :skill-policy
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) t)
|
||||
:priority 500
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||
:probabilistic nil
|
||||
:deterministic #'policy-deterministic-gate)
|
||||
#+end_src
|
||||
|
||||
* Quick Reference
|
||||
|
||||
** Invariant Quick Reference
|
||||
|
||||
| Invariant | Blocks? | Trigger |
|
||||
|-----------|---------|---------|
|
||||
| Transparency | Yes | Missing `:explanation` on user-facing actions |
|
||||
| Autonomy | No | Action references proprietary domain |
|
||||
| Bloat | No | Skill file exceeds 50KB |
|
||||
| Modularity | Yes | Modification to `harness/` without justification |
|
||||
| Mentorship | Yes | High-impact action without `:mentorship-note` |
|
||||
| Sustainability | No | Action uses cloud-only provider |
|
||||
|
||||
** Required Fields by Action Type
|
||||
|
||||
| Action | Required Field | Purpose |
|
||||
|--------|---------------|---------|
|
||||
| User message | `:explanation` | Transparency |
|
||||
| Core modification | `:modularity-justification` | Modularity |
|
||||
| Skill creation | `:mentorship-note` | Mentorship |
|
||||
| File write | `:mentorship-note` | Mentorship |
|
||||
|
||||
* See Also
|
||||
- [[file:org-skill-engineering-standards.org][Engineering Standards]] (if loaded in opencortex-contrib)
|
||||
- [[file:../harness/act.org][Act Stage]] - Where Policy and Bouncer gates are invoked
|
||||
- [[file:../harness/manifest.org][Manifest]] - The Thin Harness philosophy
|
||||
@@ -45,7 +45,7 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
|
||||
* Phase D: Build (Implementation)
|
||||
|
||||
** Schema Enforcement
|
||||
#+begin_src lisp :tangle ../library/communication-validator.lisp
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-protocol-validator.lisp
|
||||
(in-package :opencortex)
|
||||
|
||||
(defun validate-communication-protocol-schema (msg)
|
||||
@@ -59,10 +59,15 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
|
||||
|
||||
(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")))
|
||||
;; Allow missing :target if :source is present in :meta, since reason-gate
|
||||
;; will infer :target from :source downstream. This preserves "equality of
|
||||
;; clients" — gateways need not duplicate routing logic.
|
||||
(let ((target (proto-get msg :target))
|
||||
(source (proto-get (proto-get msg :meta) :source)))
|
||||
(unless (or target source)
|
||||
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target and no :source in :meta to infer it"))
|
||||
(unless (proto-get msg :payload)
|
||||
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload"))))
|
||||
|
||||
(:EVENT
|
||||
(let ((payload (proto-get msg :payload)))
|
||||
@@ -79,7 +84,7 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
|
||||
#+end_src
|
||||
|
||||
* Registration
|
||||
#+begin_src lisp :tangle ../library/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)))
|
||||
|
||||
@@ -1,63 +1,78 @@
|
||||
:PROPERTIES:
|
||||
:ID: scribe-skill
|
||||
:CREATED: [2026-04-13 Mon 18:40]
|
||||
:END:
|
||||
#+TITLE: SKILL: Autonomous Scribe (Knowledge Distillation)
|
||||
#+AUTHOR: Amr
|
||||
#+FILETAGS: :scribe:distillation:memex:autonomy:
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :scribe:distillation:memex:autonomy:
|
||||
|
||||
* Overview
|
||||
The *Autonomous Scribe* is the background architect of the Memex. Its primary responsibility is the "Nightly Distillation": a process that scans chronological daily logs, extracts evergreen concepts, and formalizes them into atomic Zettelkasten notes.
|
||||
The *Autonomous Scribe* is the background architect of the Memex. It is responsible for the "Nightly Distillation": a process that scans chronological daily logs, extracts evergreen concepts, and formalizes them into atomic Zettelkasten notes.
|
||||
|
||||
** Architectural Intent: Continuous Distillation
|
||||
The Scribe transforms the "Noise" of daily streams into the "Signal" of permanent knowledge. By operating in the background, it ensures that your knowledge graph grows autonomously, even when you aren't actively organizing it.
|
||||
* Phase A: Demand (PRD)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
It utilizes a "Read-Reason-Write" pattern:
|
||||
1. **Read:** Identifies new thoughts in the ~daily/~ folder.
|
||||
2. **Reason:** Uses the Probabilistic Engine to extract atomic, evergreen concepts.
|
||||
3. **Write:** Commits the distilled notes to the ~notes/~ folder with proper back-links.
|
||||
** 1. Purpose
|
||||
Automate the conversion of ephemeral, time-stamped thoughts into a permanent, structured knowledge graph.
|
||||
|
||||
* Implementation
|
||||
** 2. Success Criteria
|
||||
- [ ] *Capture:* Identify new headlines in the `daily/` directory that haven't been distilled yet.
|
||||
- [ ] *Privacy:* Strictly ignore any node tagged with `@personal`.
|
||||
- [ ] *Extraction:* Use neural reasoning to extract atomic concepts from raw logs.
|
||||
- [ ] *Formalization:* Create new `.org` files in the `notes/` directory with proper Org-ID and back-links to the source.
|
||||
|
||||
** Package Initialization
|
||||
#+begin_src lisp
|
||||
(in-package :cl-user)
|
||||
(defpackage :opencortex.skills.org-skill-scribe
|
||||
(:use :cl :opencortex))
|
||||
(in-package :opencortex.skills.org-skill-scribe)
|
||||
* Phase B: Blueprint (PROTOCOL)
|
||||
:PROPERTIES:
|
||||
:STATUS: SIGNED
|
||||
:END:
|
||||
|
||||
** 1. Architectural Intent
|
||||
The Scribe reacts to the `:heartbeat` sensor. It maintains a state file (`scribe-state.lisp`) to track the last processed timestamp. It performs a "Read-Reason-Write" loop:
|
||||
1. **Read:** Scan `daily/*.org` for nodes updated after the last checkpoint.
|
||||
2. **Reason:** Ask the LLM to "Extract atomic notes from this text".
|
||||
3. **Write:** Commit the resulting nodes to the `notes/` directory.
|
||||
|
||||
** 2. Semantic Interfaces
|
||||
- Trigger: `(:sensor :heartbeat)`
|
||||
- Action: `(:type :REQUEST :target :system :action :create-note :title "..." :content "..." :source-id "...")`
|
||||
|
||||
* Phase D: Build (Implementation)
|
||||
|
||||
** Package Context
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-scribe.lisp
|
||||
(in-package :opencortex)
|
||||
#+end_src
|
||||
|
||||
** State: Checkpoint Management
|
||||
The Scribe must be efficient. It tracks the last processed timestamp to avoid redundant distillation and LLM token waste.
|
||||
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.")
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp
|
||||
(defun scribe-load-state ()
|
||||
"Loads the scribe checkpoint from the state directory."
|
||||
(let ((state-file (merge-pathnames "system/state/scribe-checkpoint.lisp"
|
||||
(asdf:system-source-directory :opencortex))))
|
||||
(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))))
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp
|
||||
(defun scribe-save-state ()
|
||||
"Saves the current universal-time as the new checkpoint."
|
||||
(let ((state-file (merge-pathnames "system/state/scribe-checkpoint.lisp"
|
||||
(asdf:system-source-directory :opencortex))))
|
||||
(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)))))
|
||||
#+end_src
|
||||
|
||||
** Filtration: Privacy and Relevance
|
||||
To protect user privacy, the Scribe strictly ignores any node tagged with ~@personal~.
|
||||
** 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 memory that require distillation."
|
||||
"Returns a list of org-objects from the daily/ folder that require distillation."
|
||||
(let ((results nil))
|
||||
(maphash (lambda (id obj)
|
||||
(declare (ignore id))
|
||||
@@ -73,14 +88,14 @@ To protect user privacy, the Scribe strictly ignores any node tagged with ~@pers
|
||||
results))
|
||||
#+end_src
|
||||
|
||||
** Probabilistic Stage: Concept Extraction
|
||||
This function generates the specific distillation prompt for the LLM. It focuses on atomicity and structured Lisp output.
|
||||
** 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 distillation task."
|
||||
(declare (ignore context))
|
||||
(let ((nodes (scribe-get-distillable-nodes)))
|
||||
"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)
|
||||
@@ -96,20 +111,21 @@ 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. Keep titles descriptive and snake_case.
|
||||
3. The content should be in Org-mode format.
|
||||
4. Keep titles descriptive and snake_case.
|
||||
|
||||
TEXT:
|
||||
~a" text-to-process))
|
||||
nil)))
|
||||
#+end_src
|
||||
|
||||
** Deterministic Stage: Knowledge Committal
|
||||
The final physical step. It takes the LLM's structured proposal and writes it to the local filesystem.
|
||||
** 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 distilled notes to the MemexHardHard Hard drive."
|
||||
(let ((notes-dir (merge-pathnames "notes/" (asdf:system-source-directory :opencortex))))
|
||||
"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))
|
||||
@@ -117,15 +133,16 @@ The final physical step. It takes the LLM's structured proposal and writes it to
|
||||
(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)))
|
||||
(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: Distilled evergreen note ~a" filename)))))
|
||||
#+end_src
|
||||
(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)))))
|
||||
|
||||
#+begin_src lisp
|
||||
(defun verify-skill-scribe (action context)
|
||||
"Main deterministic gate for Scribe distillation."
|
||||
"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))
|
||||
@@ -133,19 +150,23 @@ The final physical step. It takes the LLM's structured proposal and writes it to
|
||||
action)
|
||||
(t nil))))
|
||||
(when data
|
||||
(harness-log "SCRIBE: Committing ~a atomic notes..." (length data))
|
||||
(scribe-commit-notes data)
|
||||
(scribe-save-state)
|
||||
(list :type :LOG :payload (list :text "SCRIBE: Distillation cycle complete.")))) )
|
||||
(harness-log "SCRIBE: Distillation complete.")
|
||||
;; Return a log event to stop the loop
|
||||
(list :type :LOG :payload (list :text "Distillation successful.")))))
|
||||
#+end_src
|
||||
|
||||
** Registration
|
||||
#+begin_src lisp
|
||||
** Skill Registration
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-scribe.lisp
|
||||
(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
|
||||
@@ -153,6 +174,6 @@ The final physical step. It takes the LLM's structured proposal and writes it to
|
||||
#+end_src
|
||||
|
||||
** Initialization
|
||||
#+begin_src lisp
|
||||
#+begin_src lisp :tangle ../library/gen/org-skill-scribe.lisp
|
||||
(scribe-load-state)
|
||||
#+end_src
|
||||
|
||||
@@ -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"))
|
||||
|
||||
|
||||
46
test_cli.py
Normal file
46
test_cli.py
Normal file
@@ -0,0 +1,46 @@
|
||||
import socket
|
||||
import struct
|
||||
|
||||
def frame_message(msg_string):
|
||||
payload = msg_string.encode('utf-8')
|
||||
return f"{len(payload):06x}".encode('ascii') + payload
|
||||
|
||||
def read_framed(sock):
|
||||
header = b''
|
||||
while len(header) < 6:
|
||||
chunk = sock.recv(6 - len(header))
|
||||
if not chunk:
|
||||
return None
|
||||
header += chunk
|
||||
length = int(header, 16)
|
||||
data = b''
|
||||
while len(data) < length:
|
||||
chunk = sock.recv(length - len(data))
|
||||
if not chunk:
|
||||
return None
|
||||
data += chunk
|
||||
return data.decode('utf-8')
|
||||
|
||||
msg = '(:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT "hello") :META (:SOURCE :CLI :SESSION-ID "test1"))'
|
||||
|
||||
sock = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
|
||||
sock.connect(('127.0.0.1', 9105))
|
||||
sock.settimeout(10.0)
|
||||
|
||||
# Read handshake
|
||||
handshake = read_framed(sock)
|
||||
print("HANDSHAKE:", handshake)
|
||||
|
||||
# Read status
|
||||
status = read_framed(sock)
|
||||
print("STATUS:", status)
|
||||
|
||||
# Send message
|
||||
sock.sendall(frame_message(msg))
|
||||
print("SENT:", msg)
|
||||
|
||||
# Read response
|
||||
response = read_framed(sock)
|
||||
print("RESPONSE:", response)
|
||||
|
||||
sock.close()
|
||||
70
tests/lisp-validator-tests.lisp
Normal file
70
tests/lisp-validator-tests.lisp
Normal file
@@ -0,0 +1,70 @@
|
||||
(defpackage :opencortex-lisp-validator-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:lisp-validator-suite))
|
||||
|
||||
(in-package :opencortex-lisp-validator-tests)
|
||||
|
||||
(def-suite lisp-validator-suite
|
||||
:description "Tests for the Lisp Validator structural, syntactic, and semantic gates.")
|
||||
|
||||
(in-suite lisp-validator-suite)
|
||||
|
||||
(test structural-balanced
|
||||
(let ((result (opencortex::lisp-validator-check-structural "(+ 1 2)")))
|
||||
(is (eq result t))))
|
||||
|
||||
(test structural-unbalanced-open
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-structural "(+ 1 2")
|
||||
(is (null ok))
|
||||
(is (search "Unbalanced" reason))
|
||||
(is (= line 1))))
|
||||
|
||||
(test structural-unbalanced-close
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-structural "+ 1 2)")
|
||||
(is (null ok))
|
||||
(is (search "Unexpected" reason)))
|
||||
|
||||
(test structural-mismatched-bracket
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-structural "(let [x 1) x)")
|
||||
(is (null ok))
|
||||
(is (search "Mismatched" reason))))
|
||||
|
||||
(test syntactic-valid
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-syntactic "(+ 1 2) (* 3 4)")
|
||||
(is ok)))
|
||||
|
||||
(test syntactic-invalid-reader
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-syntactic "(1+ 2 #")")
|
||||
(is (null ok))))
|
||||
|
||||
(test semantic-safe
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-semantic "(+ 1 2)")
|
||||
(is ok)))
|
||||
|
||||
(test semantic-blocked-eval
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-semantic "(eval '(+ 1 2))")
|
||||
(is (null ok))))
|
||||
|
||||
(test unified-success
|
||||
(let ((result (opencortex::lisp-validator-validate "(+ 1 2)" :strict t)))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (getf (getf result :checks) :structural))
|
||||
(is (getf (getf result :checks) :syntactic))
|
||||
(is (getf (getf result :checks) :semantic))))
|
||||
|
||||
(test unified-structural-failure
|
||||
(let ((result (opencortex::lisp-validator-validate "(+ 1 2" :strict nil)))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (eq (getf result :failed) :structural))))
|
||||
|
||||
(test unified-semantic-failure-strict
|
||||
(let ((result (opencortex::lisp-validator-validate "(delete-file \"x.txt\")" :strict t)))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (eq (getf result :failed) :semantic))))
|
||||
67
tests/ui_tui_test.py
Normal file
67
tests/ui_tui_test.py
Normal file
@@ -0,0 +1,67 @@
|
||||
import sys
|
||||
import os
|
||||
import time
|
||||
|
||||
# Add scripts directory to path to import ui_driver
|
||||
sys.path.append(os.path.join(os.getcwd(), 'scripts'))
|
||||
from ui_driver import run_test
|
||||
|
||||
|
||||
def wait_for_brain():
|
||||
print("[UI TEST] Waiting for Brain to wake up...")
|
||||
for i in range(60):
|
||||
if os.path.exists('brain.log'):
|
||||
with open('brain.log', 'r') as f:
|
||||
if 'Boot Complete' in f.read():
|
||||
print("[UI TEST] Brain is Green. Waiting for TCP listener...")
|
||||
time.sleep(5)
|
||||
return True
|
||||
time.sleep(2)
|
||||
return False
|
||||
|
||||
def test_tui_boot_and_input():
|
||||
if not wait_for_brain():
|
||||
print("FAIL: Brain failed to boot within timeout.")
|
||||
return
|
||||
|
||||
print("[UI TEST] Launching TUI and sending 'Hi'...")
|
||||
|
||||
# We run the TUI script via bash
|
||||
|
||||
# Direct SBCL launch to bypass shell script noise
|
||||
command = ["sbcl", "--disable-debugger",
|
||||
"--eval", "(load (merge-pathnames \"quicklisp/setup.lisp\" (user-homedir-pathname)))",
|
||||
"--eval", "(push (truename \"\") asdf:*central-registry*)",
|
||||
"--eval", "(ql:quickload :opencortex/tui)",
|
||||
"--eval", "(opencortex.tui:main)"]
|
||||
|
||||
vt = run_test(command, "Hi\r", wait_time=15)
|
||||
|
||||
screen = vt.get_screen()
|
||||
|
||||
# 1. Verify Prompt
|
||||
if "> Hi" in screen:
|
||||
print("PASS: Local Echo found in chat history.")
|
||||
elif ">" in screen:
|
||||
print("PASS: Input prompt found.")
|
||||
else:
|
||||
print("FAIL: No input prompt found.")
|
||||
|
||||
# 2. Verify Status Bar
|
||||
if "[Scribe:" in screen and "Gardener:" in screen:
|
||||
print("PASS: Status bar rendered correctly.")
|
||||
else:
|
||||
print("FAIL: Status bar missing.")
|
||||
|
||||
# 3. Verify Cursor Position (should be at the end of the empty prompt after Enter)
|
||||
# The prompt is line 23 (h-1), col 2 (after "> ")
|
||||
if vt.cursor_y == 23 and vt.cursor_x == 2:
|
||||
print(f"PASS: Cursor is correctly pinned to prompt at ({vt.cursor_y}, {vt.cursor_x}).")
|
||||
else:
|
||||
print(f"WARN: Cursor at unexpected position ({vt.cursor_y}, {vt.cursor_x}).")
|
||||
|
||||
print("\n--- FINAL SCREEN SNAPSHOT ---")
|
||||
print(screen)
|
||||
|
||||
if __name__ == "__main__":
|
||||
test_tui_boot_and_input()
|
||||
Reference in New Issue
Block a user