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

feat: add DeepSeek and NVIDIA NIM providers

Browse Source 
- Add deepseek and nvidia entries to gateway-provider config

- Add DEEPSEEK_API_KEY and NVIDIA_API_KEY to .env.example

- Add deepseek and nvidia to doctor's LLM provider check

- Fix remaining harness-log → log-message reference
This commit is contained in:
Amr Gharbeia
2026-05-02 22:25:24 -04:00
parent d803889c01
commit 95d1ea3fed
100 changed files with 5344 additions and 2743 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
.env.example
View File

@@ -1,4 +1,4 @@
# opencortex: Environment Configuration Template # passepartout: Environment Configuration Template
# Copy this to .env and fill in your values # Copy this to .env and fill in your values
# ============================================================================= # =============================================================================
@@ -15,6 +15,8 @@ OPENAI_API_KEY="your_openai_key_here"
ANTHROPIC_API_KEY="your_anthropic_key_here" ANTHROPIC_API_KEY="your_anthropic_key_here"
GROQ_API_KEY="your_groq_api_key_here" GROQ_API_KEY="your_groq_api_key_here"
GEMINI_API_KEY="your_gemini_key_here" GEMINI_API_KEY="your_gemini_key_here"
DEEPSEEK_API_KEY="your_deepseek_key_here"
NVIDIA_API_KEY="your_nvidia_nim_key_here"
# Cascade order (first available provider wins) # Cascade order (first available provider wins)
PROVIDER_CASCADE="openrouter,openai,anthropic,groq,gemini-api,ollama" PROVIDER_CASCADE="openrouter,openai,anthropic,groq,gemini-api,ollama"
@@ -64,7 +66,7 @@ PRIVACY_FILTER_TAGS="@personal,@health,@finance"
# ============================================================================= # =============================================================================
# BOOTSTRAP # BOOTSTRAP
# ============================================================================= # =============================================================================
MANDATORY_SKILLS="org-skill-policy,org-skill-bouncer" MANDATORY_SKILLS="security-policy,security-dispatcher"
# ============================================================================= # =============================================================================
# CONTEXT / MEMORY # CONTEXT / MEMORY

6
.gitea/workflows/deploy.yml
View File

@@ -19,6 +19,6 @@ jobs:
- name: Build and deploy via Docker Compose - name: Build and deploy via Docker Compose
run: | run: |
cd infrastructure/docker cd infrastructure/docker
docker-compose -p opencortex down docker-compose -p passepartout down
docker-compose -p opencortex build --no-cache opencortex docker-compose -p passepartout build --no-cache passepartout
docker-compose -p opencortex up -d --force-recreate opencortex docker-compose -p passepartout up -d --force-recreate passepartout

2
.github/workflows/lint.yml vendored
View File

@@ -82,6 +82,6 @@ jobs:
- name: Check README has quick install - name: Check README has quick install
run: | run: |
grep -q "curl.*opencortex" README.org && \ grep -q "curl.*passepartout" README.org && \
echo "OK: Quick install in README" || \ echo "OK: Quick install in README" || \
echo "WARNING: Quick install curl command not found in README" echo "WARNING: Quick install curl command not found in README"

8
.github/workflows/release.yml vendored
View File

@@ -16,16 +16,16 @@ jobs:
- name: Create tarball - name: Create tarball
run: | run: |
git archive --format=tar.gz --prefix=opencortex-$(git describe --tags) HEAD -o opencortex.tar.gz git archive --format=tar.gz --prefix=passepartout-$(git describe --tags) HEAD -o passepartout.tar.gz
- name: Create zipball - name: Create zipball
run: | run: |
git archive --format=zip --prefix=opencortex-$(git describe --tags) HEAD -o opencortex.zip git archive --format=zip --prefix=passepartout-$(git describe --tags) HEAD -o passepartout.zip
- name: Upload to GitHub Release - name: Upload to GitHub Release
uses: softprops/action-gh-release@v2 uses: softprops/action-gh-release@v2
with: with:
files: | files: |
opencortex.tar.gz passepartout.tar.gz
opencortex.zip passepartout.zip
generate_release_notes: true generate_release_notes: true

12
.github/workflows/test.yml vendored
View File

@@ -59,17 +59,17 @@ jobs:
rm -f *.org rm -f *.org
cd "$OLDPWD" cd "$OLDPWD"
- name: Load opencortex and initialize skills - name: Load passepartout and initialize skills
run: | run: |
export OC_DATA_DIR="$PWD/.github-test" export OC_DATA_DIR="$PWD/.github-test"
sbcl --non-interactive \ sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \ --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$PWD/\") asdf:*central-registry*)" \ --eval "(push (truename \"$PWD/\") asdf:*central-registry*)" \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \ --eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :opencortex :silent t)' \ --eval '(ql:quickload :passepartout :silent t)' \
--eval "(setf (uiop:getenv \"OC_DATA_DIR\") \"$OC_DATA_DIR\")" \ --eval "(setf (uiop:getenv \"OC_DATA_DIR\") \"$OC_DATA_DIR\")" \
--eval '(opencortex:initialize-all-skills)' \ --eval '(passepartout:initialize-all-skills)' \
--eval "(let ((n (hash-table-count opencortex:*skills-registry*))) (format t \"~%Skills loaded: ~a~%\" n) (unless (>= n 20) (sb-ext:exit :code 1)))" --eval "(let ((n (hash-table-count passepartout:*skills-registry*))) (format t \"~%Skills loaded: ~a~%\" n) (unless (>= n 20) (sb-ext:exit :code 1)))"
- name: Daemon smoke test - name: Daemon smoke test
run: | run: |
@@ -78,9 +78,9 @@ jobs:
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \ --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$PWD/\") asdf:*central-registry*)" \ --eval "(push (truename \"$PWD/\") asdf:*central-registry*)" \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \ --eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \
--eval "(ql:quickload '(:opencortex :croatoan))" \ --eval "(ql:quickload '(:passepartout :croatoan))" \
--eval "(setf (uiop:getenv \"OC_DATA_DIR\") \"$OC_DATA_DIR\")" \ --eval "(setf (uiop:getenv \"OC_DATA_DIR\") \"$OC_DATA_DIR\")" \
--eval '(opencortex:main)' \ --eval '(passepartout:main)' \
> /tmp/oc-daemon.log 2>&1 & > /tmp/oc-daemon.log 2>&1 &
DAEMON_PID=$! DAEMON_PID=$!

4
.gitignore vendored
View File

@@ -1,10 +1,10 @@
.env .env
opencortex-server passepartout-server
\$MEMEX_DIR/ \$MEMEX_DIR/
*.log *.log
*~ *~
\#*# \#*#
opencortex-tui passepartout-tui
test_input.txt test_input.txt
# Generated artifacts (source of truth is .org) # Generated artifacts (source of truth is .org)

58
README.org
View File

@@ -1,10 +1,10 @@
#+TITLE: OpenCortex: Your Autonomous, Plain-Text Life Assistant #+TITLE: Passepartout: Your Autonomous, Plain-Text Life Assistant
#+AUTHOR: Amr #+AUTHOR: Amr
#+FILETAGS: :opencortex:ai:assistant: #+FILETAGS: :passepartout:ai:assistant:
#+HTML: <div style="display: flex; gap: 8px; flex-wrap: wrap; margin-bottom: 1em;"> #+HTML: <div style="display: flex; gap: 8px; flex-wrap: wrap; margin-bottom: 1em;">
#+HTML: <img src="https://img.shields.io/github/v/tag/amrgharbeia/opencortex?label=version&style=flat-square"> #+HTML: <img src="https://img.shields.io/github/v/tag/amrgharbeia/passepartout?label=version&style=flat-square">
#+HTML: <img src="https://img.shields.io/github/license/amrgharbeia/opencortex?style=flat-square"> #+HTML: <img src="https://img.shields.io/github/license/amrgharbeia/passepartout?style=flat-square">
#+HTML: <img src="https://img.shields.io/badge/Lisp-Common%20Lisp-blue?style=flat-square"> #+HTML: <img src="https://img.shields.io/badge/Lisp-Common%20Lisp-blue?style=flat-square">
#+HTML: <img src="https://img.shields.io/badge/docs-Org--mode-green?style=flat-square"> #+HTML: <img src="https://img.shields.io/badge/docs-Org--mode-green?style=flat-square">
#+HTML: </div> #+HTML: </div>
@@ -12,34 +12,34 @@
* Quick Install * Quick Install
#+begin_src bash #+begin_src bash
curl -fsSL https://raw.githubusercontent.com/amrgharbeia/opencortex/main/opencortex.sh | bash -s configure curl -fsSL https://raw.githubusercontent.com/amrgharbeia/opencortex/main/passepartout | bash -s configure
#+end_src #+end_src
Then run ~opencortex tui~ to start chatting. Then run ~passepartout tui~ to start chatting.
* Meet OpenCortex * Meet Passepartout
Most AI assistants are just chatbots. You ask a question, they answer, they forget you exist. They trap your conversations in proprietary web apps and silo your data. Most AI assistants are just chatbots. You ask a question, they answer, they forget you exist. They trap your conversations in proprietary web apps and silo your data.
*OpenCortex is different. It is an AI that lives inside your own text files.* *Passepartout is different. It is an AI that lives inside your own text files.*
It runs locally on your machine. It reads your notes, organizes your life, executes tasks, and gardens your knowledge base—all while keeping your data in plain text files you own completely. It runs locally on your machine. It reads your notes, organizes your life, executes tasks, and gardens your knowledge base—all while keeping your data in plain text files you own completely.
* Why OpenCortex Exists * Why Passepartout Exists
The current generation of AI agents have a fundamental flaw: they prioritize quick demos over long-term reliability and user sovereignty. The current generation of AI agents have a fundamental flaw: they prioritize quick demos over long-term reliability and user sovereignty.
The biggest problem is data ownership. Most agents bury your memories in opaque databases. If you want to see your own data, you have to ask the AI to fetch it. If the app shuts down, your data is gone. The biggest problem is data ownership. Most agents bury your memories in opaque databases. If you want to see your own data, you have to ask the AI to fetch it. If the app shuts down, your data is gone.
OpenCortex solves this with total plain-text transparency. Your entire life is a folder of text files. OpenCortex manages them the same way you do—with any text editor. No database to migrate, no schema to update, no lock-in. Passepartout solves this with total plain-text transparency. Your entire life is a folder of text files. Passepartout manages them the same way you do—with any text editor. No database to migrate, no schema to update, no lock-in.
* What Makes OpenCortex Different * What Makes Passepartout Different
Most AI agents are Python applications that happened to call an LLM. OpenCortex is different. It is built in pure Common Lisp—top to bottom, no wrapper, no translation layer. Most AI agents are Python applications that happened to call an LLM. Passepartout is different. It is built in pure Common Lisp—top to bottom, no wrapper, no translation layer.
The kernel is Lisp. The skills are Lisp. The memory system is Lisp. The TUI is Lisp. One language from the hardware to the agent's thoughts. The kernel is Lisp. The skills are Lisp. The memory system is Lisp. The TUI is Lisp. One language from the hardware to the agent's thoughts.
Python agents need a second language for configuration (YAML), a third for memory (JSON or SQLite), and a fourth for deployment (Docker). OpenCortex needs SBCL. That's it. Python agents need a second language for configuration (YAML), a third for memory (JSON or SQLite), and a fourth for deployment (Docker). Passepartout needs SBCL. That's it.
This is not nostalgia for the 1980s. Lisp has two properties that matter for an autonomous agent. This is not nostalgia for the 1980s. Lisp has two properties that matter for an autonomous agent.
@@ -49,19 +49,19 @@ Second, stability. The Common Lisp specification has been stable for decades. Yo
Your data lives in Org-mode files. Not a database. Not JSON. Not a vector store. Just plain text that you can read in any editor, search with grep, and back up any way you want. Your data lives in Org-mode files. Not a database. Not JSON. Not a vector store. Just plain text that you can read in any editor, search with grep, and back up any way you want.
This matters because every other agent makes your data dependent on their app. Their database schema defines what you can store. Their migration scripts decide whether your data survives an upgrade. OpenCortex has no schema. Your memory is a folder of text files. It survives app updates, platform switches, and decades of use. This matters because every other agent makes your data dependent on their app. Their database schema defines what you can store. Their migration scripts decide whether your data survives an upgrade. Passepartout has no schema. Your memory is a folder of text files. It survives app updates, platform switches, and decades of use.
The agent fixes itself. When it encounters an error, it can modify its own code, apply surgical fixes, and learn from the outcome to improve and grow. Skills hot-reload at runtime, so you can extend the system without restarting. And if something goes wrong during a complex operation, it snaps back to a known-good state. The agent fixes itself. When it encounters an error, it can modify its own code, apply surgical fixes, and learn from the outcome to improve and grow. Skills hot-reload at runtime, so you can extend the system without restarting. And if something goes wrong during a complex operation, it snaps back to a known-good state.
* Three Problems Every Agent Ignores * Three Problems Every Agent Ignores
Every other AI assistant has three fundamental flaws that OpenCortex addresses. Every other AI assistant has three fundamental flaws that Passepartout addresses.
The first is the data silo. Most agents bury your memories in opaque databases. If you want to see your own data, you have to ask the AI to fetch it. If the app shuts down, your data is gone. OpenCortex stores everything in plain text files that you own. No migration needed, no schema to update, no lock-in. The first is the data silo. Most agents bury your memories in opaque databases. If you want to see your own data, you have to ask the AI to fetch it. If the app shuts down, your data is gone. Passepartout stores everything in plain text files that you own. No migration needed, no schema to update, no lock-in.
The second is the hallucination problem. Most agents pipe AI-generated text directly into your terminal. If the model hallucinates, it can delete your files or break your system. OpenCortex splits its brain into two parts. The creative brain (the LLM) suggests actions. The strict guard (deterministic logic) intercepts every proposal before it touches a file or runs a command. If the AI hallucinates, the guard blocks it. The second is the hallucination problem. Most agents pipe AI-generated text directly into your terminal. If the model hallucinates, it can delete your files or break your system. Passepartout splits its brain into two parts. The creative brain (the LLM) suggests actions. The strict guard (deterministic logic) intercepts every proposal before it touches a file or runs a command. If the AI hallucinates, the guard blocks it.
The third is cloud dependency. Most assistants rely entirely on big tech APIs. When your internet drops, or the service goes down, your assistant dies. Worse, your private notes are constantly sent to third-party servers. OpenCortex runs on your own hardware using free, open-source models. Your private data never leaves your laptop. Cloud models are optional—used only when you explicitly allow them for complex tasks. The third is cloud dependency. Most assistants rely entirely on big tech APIs. When your internet drops, or the service goes down, your assistant dies. Worse, your private notes are constantly sent to third-party servers. Passepartout runs on your own hardware using free, open-source models. Your private data never leaves your laptop. Cloud models are optional—used only when you explicitly allow them for complex tasks.
* Quick Start * Quick Start
@@ -69,30 +69,30 @@ You need SBCL (Steel Bank Common Lisp) installed.
#+begin_src bash #+begin_src bash
# Clone the repository # Clone the repository
git clone https://github.com/amrgharbeia/opencortex.git ~/memex/projects/opencortex git clone https://github.com/amrgharbeia/opencortex.git ~/projects/passepartout
# Run the Setup Wizard # Run the Setup Wizard
cd ~/memex/projects/opencortex cd ~/projects/passepartout
./opencortex.sh setup ./passepartout configure
# Verify System Health # Verify System Health
opencortex doctor passepartout doctor
# Enter the Brain # Enter the Brain
opencortex tui passepartout tui
#+end_src #+end_src
* The Onboarding Trifecta * The Onboarding Trifecta
`opencortex setup` guides you through configuring LLM providers. Tell it how to talk to Ollama, Groq, OpenRouter, or your own endpoint. `passepartout setup` guides you through configuring LLM providers. Tell it how to talk to Ollama, Groq, OpenRouter, or your own endpoint.
`opencortex gateway link <platform> <token>` connects external chat gateways. Talk to your agent from Telegram while it works on your files. `passepartout gateway link <platform> <token>` connects external chat gateways. Talk to your agent from Telegram while it works on your files.
`opencortex doctor` shows you what's working, what's broken, and what needs attention. `passepartout doctor` shows you what's working, what's broken, and what needs attention.
* Architecture * Architecture
OpenCortex has three layers. Passepartout has three layers.
The Harness is the kernel. It runs the [[file:harness/loop.org][metabolic loop]]—Perceive → Reason → Act—each signal moving through normalization, LLM reasoning, skill verification, and action execution. Depth limits prevent infinite loops. The [[file:harness/memory.org][memory system]] persists to plain-text Org-mode files with snapshot and rollback on errors. The Harness is the kernel. It runs the [[file:harness/loop.org][metabolic loop]]—Perceive → Reason → Act—each signal moving through normalization, LLM reasoning, skill verification, and action execution. Depth limits prevent infinite loops. The [[file:harness/memory.org][memory system]] persists to plain-text Org-mode files with snapshot and rollback on errors.
@@ -102,11 +102,11 @@ The Interface is what you use to talk to the agent. A native Lisp [[file:harness
* Project Documentation * Project Documentation
OpenCortex practices what it preaches—the documentation lives in the code. Passepartout practices what it preaches—the documentation lives in the code.
The [[file:USER_MANUAL.org][User Manual]] covers setup, configuration, and commands. The [[file:docs/ROADMAP.org][Evolutionary Roadmap]] shows our plan for reaching state-of-the-art capabilities. The [[file:docs/CONTRIBUTING.org][Contributing]] guide teaches you how to add new skills. The [[file:USER_MANUAL.org][User Manual]] covers setup, configuration, and commands. The [[file:docs/ROADMAP.org][Evolutionary Roadmap]] shows our plan for reaching state-of-the-art capabilities. The [[file:docs/CONTRIBUTING.org][Contributing]] guide teaches you how to add new skills.
* License * License
OpenCortex is released under the [[file:LICENSE][AGPLv3 license]]. Passepartout is released under the [[file:LICENSE][AGPLv3 license]].
See [[file:CLA.org][CLA.org]] for the Contributor License Agreement. See [[file:CLA.org][CLA.org]] for the Contributor License Agreement.

46
TODO.org
View File

@@ -1,5 +1,5 @@
# OpenCortex Project Tasks # Passepartout Project Tasks
# All OpenCortex-related TODOs live here. gtd.org links to this file. # All Passepartout-related TODOs live here. gtd.org links to this file.
# Evolutionary context: see docs/ROADMAP.org # Evolutionary context: see docs/ROADMAP.org
* PHASE: AUTONOMOUS MVP (v0.1.0 Released) * PHASE: AUTONOMOUS MVP (v0.1.0 Released)
@@ -40,7 +40,7 @@ Ensuring the system is ready for the world through collaborative testing, docume
CLOSED: [2026-04-21 Tue 18:30] CLOSED: [2026-04-21 Tue 18:30]
*** DONE Rename directories: harness/, library/, environment/, infrastructure/. *** DONE Rename directories: harness/, library/, environment/, infrastructure/.
*** DONE Consolidate Probabilistic engine into reason.lisp. *** DONE Consolidate Probabilistic engine into reason.lisp.
*** DONE Embed bidirectional CLI logic into opencortex.sh. *** DONE Embed bidirectional CLI logic into passepartout.sh.
*** DONE Stabilize skill engine: 12/12 skills loaded with package jailing. *** DONE Stabilize skill engine: 12/12 skills loaded with package jailing.
*** DONE Cleanup legacy documentation and deployment artifacts. *** DONE Cleanup legacy documentation and deployment artifacts.
@@ -55,7 +55,7 @@ Ensuring the system is ready for the world through collaborative testing, docume
*** DONE Implement a broad Contributor License Agreement (CLA) process. *** DONE Implement a broad Contributor License Agreement (CLA) process.
*** DONE Update `LICENSE` and `CHANGELOG` accordingly. *** DONE Update `LICENSE` and `CHANGELOG` accordingly.
** TODO 4. GitHub Migration & Repository Setup <2026-04-14 Tue> ** DONE 4. GitHub Migration ** TODO 4. GitHub Migration & Repository Setup <2026-04-14 Tue> Repository Setup [2026-05-02 Sat]
*** TODO Migrate primary remote to GitHub and configure canonical repository. *** TODO Migrate primary remote to GitHub and configure canonical repository.
*** TODO Set repository topics, badges, issue templates, and CI/CD foundations. *** TODO Set repository topics, badges, issue templates, and CI/CD foundations.
@@ -99,7 +99,7 @@ Roadmap basis: Evolutionary roadmap from README.org. Working backwards from SOTA
- Reload skill into jailed package namespace - Reload skill into jailed package namespace
- DONE: Added :reload-skill, :read-file, :write-file, :replace-string tools - DONE: Added :reload-skill, :read-file, :write-file, :replace-string tools
- DONE: Fixed ASDF compilation bug (position tracking issue with :serial t) - DONE: Fixed ASDF compilation bug (position tracking issue with :serial t)
- DONE: Added explicit :depends-on declarations to opencortex.asd - DONE: Added explicit :depends-on declarations to passepartout.asd
** DONE Engineering Process Improvements [2026-04-23 Wed] ** DONE Engineering Process Improvements [2026-04-23 Wed]
*** DONE Fix ASDF compilation bug (position tracking at byte 16834) *** DONE Fix ASDF compilation bug (position tracking at byte 16834)
@@ -110,14 +110,14 @@ Roadmap basis: Evolutionary roadmap from README.org. Working backwards from SOTA
- Rule 10: Test-first - design tests before coding, run chaos testing - Rule 10: Test-first - design tests before coding, run chaos testing
- Rule 11: Org as thinking medium - document investigations in prose - Rule 11: Org as thinking medium - document investigations in prose
- Rule 12: Engineering decision audit trail - document root cause, tradeoffs - Rule 12: Engineering decision audit trail - document root cause, tradeoffs
- Added to opencortex-contrib/skills/org-skill-engineering-standards.org - Added to passepartout-contrib/skills/org-skill-engineering-standards.org
*** DONE Perform comprehensive architectural review and evolution strategy [2026-04-27 Mon] *** DONE Perform comprehensive architectural review and evolution strategy [2026-04-27 Mon]
- Identified hidden gaps: Org-mode round-trip, sandboxing vulnerabilities, and GC scaling. - Identified hidden gaps: Org-mode round-trip, sandboxing vulnerabilities, and GC scaling.
- Defined "Structural AST Editing" and "Reflection Loops" as core strategic requirements. - Defined "Structural AST Editing" and "Reflection Loops" as core strategic requirements.
- Captured findings in [[file:notes/opencortex-architectural-evolution.org][opencortex-architectural-evolution.org]]. - Captured findings in [[file:notes/passepartout-architectural-evolution.org][passepartout-architectural-evolution.org]].
*** DONE Fix API drift in opencortex-contrib [2026-04-27 Mon] *** DONE Fix API drift in passepartout-contrib [2026-04-27 Mon]
- Standardized legacy keywords (:neuro/:symbolic) to new harness standard (:probabilistic/:deterministic). - Standardized legacy keywords (:neuro/:symbolic) to new harness standard (:probabilistic/:deterministic).
- Updated 16 skills in opencortex-contrib for kernel compatibility. - Updated 16 skills in passepartout-contrib for kernel compatibility.
** DONE 4. Core Skills Consolidation [2026-04-23 Thu] ** DONE 4. Core Skills Consolidation [2026-04-23 Thu]
- Merged lisp-validator + lisp-repair → org-skill-lisp-utils.org - Merged lisp-validator + lisp-repair → org-skill-lisp-utils.org
@@ -128,18 +128,18 @@ Roadmap basis: Evolutionary roadmap from README.org. Working backwards from SOTA
- Deleted old org-skill-lisp-validator.org - Deleted old org-skill-lisp-validator.org
** DONE 5. Advanced CLI Onboarding Experience ** DONE 5. Advanced CLI Onboarding Experience
*** DONE Implement interactive Lisp CLI wizard (=opencortex setup=) *** DONE Implement interactive Lisp CLI wizard (=passepartout setup=)
*** DONE Implement =opencortex gateway link= for Telegram/Signal bot connection [2026-05-02 Sat] *** DONE Implement =passepartout gateway link= for Telegram/Signal bot connection [2026-05-02 Sat]
*** DONE Implement =opencortex gateway unlink= to disable a gateway [2026-05-02 Sat] *** DONE Implement =passepartout gateway unlink= to disable a gateway [2026-05-02 Sat]
*** DONE Implement =opencortex gateway list= to show gateway status [2026-05-02 Sat] *** DONE Implement =passepartout gateway list= to show gateway status [2026-05-02 Sat]
*** DONE Implement =opencortex install <skill>= for dynamic skill downloading [2026-05-02 Sat] *** DONE Implement =passepartout install <skill>= for dynamic skill downloading [2026-05-02 Sat]
*** DONE Implement =opencortex doctor= for environment health and API key validation [2026-04-28 Tue] *** DONE Implement =passepartout doctor= for environment health and API key validation [2026-04-28 Tue]
- Verified 22/22 skills loading with clean boot. - Verified 22/22 skills loading with clean boot.
- Fixed macro conflicts and package jailing bugs. - Fixed macro conflicts and package jailing bugs.
** DONE Chaos-Driven Bug Fixes (v0.2.0 Pre-Release) [2026-04-28 Tue] ** DONE Chaos-Driven Bug Fixes (v0.2.0 Pre-Release) [2026-04-28 Tue]
- Fixed major conflict between Type A and Type B def-cognitive-tool macros. - Fixed major conflict between Type A and Type B def-cognitive-tool macros.
- Enforced dynamic-only loading by removing skills from opencortex.asd. - Enforced dynamic-only loading by removing skills from passepartout.asd.
- Fixed let/let* sequential binding bugs in emacs-edit and self-edit. - Fixed let/let* sequential binding bugs in emacs-edit and self-edit.
- Standardized *cognitive-tools* as a centralized hash table. - Standardized *cognitive-tools* as a centralized hash table.
- Resolved missing in-package declarations in core skills. - Resolved missing in-package declarations in core skills.
@@ -174,7 +174,7 @@ Roadmap basis: Evolutionary roadmap from README.org. Working backwards from SOTA
:END: :END:
Unified control plane: hooks + cron + routing in one skill. Deep project understanding. Unified control plane: hooks + cron + routing in one skill. Deep project understanding.
** TODO 0. Project Renaming (Bouncer → Dispatcher) ** DONE 0. Project Renaming (Bouncer → Dispatcher) [2026-05-02 Sat]
*** TODO Audit all files for component names to rename *** TODO Audit all files for component names to rename
*** TODO Rename org-skill-bouncer.org → org-skill-dispatcher.org *** TODO Rename org-skill-bouncer.org → org-skill-dispatcher.org
*** TODO Rename skill-bouncer package → skill-dispatcher *** TODO Rename skill-bouncer package → skill-dispatcher
@@ -325,7 +325,7 @@ Multimodal visual interaction and ecosystem-wide tool compatibility.
** TODO 1. MCP Gateway Bridge ** TODO 1. MCP Gateway Bridge
*** TODO Build a Lisp-native client for the Model Context Protocol *** TODO Build a Lisp-native client for the Model Context Protocol
*** TODO Connect OpenCortex to external tools and data sources *** TODO Connect Passepartout to external tools and data sources
* PHASE: THE EVALUATION HARNESS (v0.8.0) * PHASE: THE EVALUATION HARNESS (v0.8.0)
:PROPERTIES: :PROPERTIES:
@@ -468,7 +468,7 @@ Superseded by the critical analysis-informed roadmap above (v0.2.0 through v5.0.
:PROPERTIES: :PROPERTIES:
:ID: proj-autonomous-boundary :ID: proj-autonomous-boundary
:END: :END:
Slim down the opencortex microharness by moving non-essential cognitive functions to hot-reloadable user-space skills. Slim down the passepartout microharness by moving non-essential cognitive functions to hot-reloadable user-space skills.
** DONE Extract LLM Provider Routing to a Skill (neuro.lisp) ** DONE Extract LLM Provider Routing to a Skill (neuro.lisp)
** DONE Extract Vector Embedding Algorithms to a Skill (embedding.lisp) ** DONE Extract Vector Embedding Algorithms to a Skill (embedding.lisp)
@@ -549,7 +549,7 @@ Slim down the opencortex microharness by moving non-essential cognitive function
- Updated TUI, Emacs, and CLI gateways to use the unified protocol. - Updated TUI, Emacs, and CLI gateways to use the unified protocol.
- Verified end-to-end loop with TUI; kernel correctly routes responses back to origin interface. - Verified end-to-end loop with TUI; kernel correctly routes responses back to origin interface.
- Achieved "Equality of Clients" mandate. - Achieved "Equality of Clients" mandate.
** DONE Full review of opencortex's harness ** DONE Full review of passepartout's harness
CLOSED: [2026-05-01 Fri 12:46] CLOSED: [2026-05-01 Fri 12:46]
:PROPERTIES: :PROPERTIES:
:CREATED: [2026-04-13 Mon 13:30] :CREATED: [2026-04-13 Mon 13:30]
@@ -564,7 +564,7 @@ Slim down the opencortex microharness by moving non-essential cognitive function
- [X] Improved error handling (restricted rollback) and added graceful shutdown. - [X] Improved error handling (restricted rollback) and added graceful shutdown.
- [X] **FIXED:** Implemented symbolic guard check in `act-gate` via Dispatcher skill refactoring. - [X] **FIXED:** Implemented symbolic guard check in `act-gate` via Dispatcher skill refactoring.
- [X] **FIXED:** Harness `deterministic-verify` now correctly respects skill triggers. - [X] **FIXED:** Harness `deterministic-verify` now correctly respects skill triggers.
- [X] **FIXED:** Resolved TUI crash by removing `--non-interactive` from `opencortex.sh` and adding defensive coordinate handling. - [X] **FIXED:** Resolved TUI crash by removing `--non-interactive` from `passepartout.sh` and adding defensive coordinate handling.
- [X] **VERIFIED:** Confirmed bidirectional TUI communication and signed off v0.2.0. - [X] **VERIFIED:** Confirmed bidirectional TUI communication and signed off v0.2.0.
- [X] Ensure alignment with System Policy and Engineering Standards. - [X] Ensure alignment with System Policy and Engineering Standards.
- [X] Restored structural integrity by fixing `manifest.org` loading sequence. - [X] Restored structural integrity by fixing `manifest.org` loading sequence.
@@ -645,7 +645,7 @@ Slim down the opencortex microharness by moving non-essential cognitive function
:END: :END:
- Added Modularity as Invariant 6 in `org-skill-policy.org`: general life principle that complexity must live at the edges. - Added Modularity as Invariant 6 in `org-skill-policy.org`: general life principle that complexity must live at the edges.
- Implemented `policy-check-modularity`: blocks modifications to protected core paths unless `:modularity-justification` is provided. - Implemented `policy-check-modularity`: blocks modifications to protected core paths unless `:modularity-justification` is provided.
- Defined `*modularity-protected-paths*` as project-configurable variable (defaults: harness/, opencortex.asd). - Defined `*modularity-protected-paths*` as project-configurable variable (defaults: harness/, passepartout.asd).
- Updated Override Hierarchy to include Modularity between Bloat and Mentorship. - Updated Override Hierarchy to include Modularity between Bloat and Mentorship.
- Added Harness Boundary Contract section to `harness/manifest.org` documenting primary boundary files and generated artifacts. - Added Harness Boundary Contract section to `harness/manifest.org` documenting primary boundary files and generated artifacts.
- Converted checkbox sub-tasks to hierarchical TODO headlines per GTD standard. - Converted checkbox sub-tasks to hierarchical TODO headlines per GTD standard.
@@ -695,7 +695,7 @@ Slim down the opencortex microharness by moving non-essential cognitive function
- Added unit tests for each provider in `llm-gateway-tests.lisp`. - Added unit tests for each provider in `llm-gateway-tests.lisp`.
- Mocked `dex:post` to verify JSON payload formatting and response parsing. - Mocked `dex:post` to verify JSON payload formatting and response parsing.
- Implemented robust `get-nested` helper to handle various provider structures. - Implemented robust `get-nested` helper to handle various provider structures.
- Integrated `llm-gateway` and `credentials-vault` into `opencortex.asd`. - Integrated `llm-gateway` and `credentials-vault` into `passepartout.asd`.
** TODO Verify org-skill-shell-actuator formal safety harnesses ** TODO Verify org-skill-shell-actuator formal safety harnesses
** DONE Build Playwright-Python Bridge for high-fidelity browsing ** DONE Build Playwright-Python Bridge for high-fidelity browsing
CLOSED: [2026-04-11 Sat 18:30] CLOSED: [2026-04-11 Sat 18:30]

44
USER_MANUAL.org
View File

@@ -1,61 +1,61 @@
#+TITLE: OpenCortex User Manual #+TITLE: Passepartout User Manual
#+AUTHOR: Agent #+AUTHOR: Agent
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :docs:manual: #+FILETAGS: :docs:manual:
* Introduction * Introduction
Welcome to the OpenCortex User Manual. This guide provides the operational knowledge required to manage your sovereign Lisp Machine and its neural skills. Welcome to the Passepartout User Manual. This guide provides the operational knowledge required to manage your sovereign Lisp Machine and its neural skills.
* System Architecture * System Architecture
OpenCortex follows a "Purified Kernel" model. The core harness handles essential I/O, while all high-level logic resides in sovereign skills. Passepartout follows a "Purified Kernel" model. The core harness handles essential I/O, while all high-level logic resides in sovereign skills.
** XDG Directory Standard ** XDG Directory Standard
To ensure POSIX compliance, OpenCortex stores its files in standard Linux locations: To ensure POSIX compliance, Passepartout stores its files in standard Linux locations:
| Type | Path | Purpose | | Type | Path | Purpose |
| :--- | :--- | :--- | | :--- | :--- | :--- |
| **Config** | `~/.config/opencortex/` | User settings, `.env` secrets, and provider registry. | | **Config** | `~/.config/passepartout/` | User settings, `.env` secrets, and provider registry. |
| **Data** | `~/.local/share/opencortex/` | Tangled Lisp artifacts and the compiled engine. | | **Data** | `~/.local/share/passepartout/` | Tangled Lisp artifacts and the compiled engine. |
| **State** | `~/.local/state/opencortex/` | Brain snapshots, logs, and Merkle-memory. | | **State** | `~/.local/state/passepartout/` | Brain snapshots, logs, and Merkle-memory. |
| **Bin** | `~/.local/bin/opencortex` | The global CLI shim. | | **Bin** | `~/.local/bin/passepartout` | The global CLI shim. |
* Command Reference * Command Reference
** `opencortex setup` ** `passepartout setup`
The interactive configuration wizard. Use this to: The interactive configuration wizard. Use this to:
- Define your identity and the Agent's name. - Define your identity and the Agent's name.
- Register LLM providers (Ollama, Groq, Anthropic, etc.). - Register LLM providers (Ollama, Groq, Anthropic, etc.).
- The wizard automatically splits sensitive tokens into `~/.config/opencortex/.env`. - The wizard automatically splits sensitive tokens into `~/.config/passepartout/.env`.
** `opencortex gateway link <platform> <token>` ** `passepartout gateway link <platform> <token>`
Connects OpenCortex to external communication gateways. Connects Passepartout to external communication gateways.
- **Example:** `opencortex gateway link telegram <my_bot_token>` - **Example:** `passepartout gateway link telegram <my_bot_token>`
- **Example:** `opencortex gateway unlink telegram` to disable - **Example:** `passepartout gateway unlink telegram` to disable
- **Example:** `opencortex gateway list` to see status - **Example:** `passepartout gateway list` to see status
** `opencortex doctor` ** `passepartout doctor`
Your primary diagnostic tool. Run this if the system feels sluggish or fails to boot. It verifies: Your primary diagnostic tool. Run this if the system feels sluggish or fails to boot. It verifies:
- External dependencies (sbcl, git, socat). - External dependencies (sbcl, git, socat).
- XDG directory existence and permissions. - XDG directory existence and permissions.
- LLM connectivity. - LLM connectivity.
** `opencortex tui` ** `passepartout tui`
Launches the native Lisp Terminal User Interface. Launches the native Lisp Terminal User Interface.
- **Highlighting:** Semantic color-coding for Lisp and Org syntax. - **Highlighting:** Semantic color-coding for Lisp and Org syntax.
- **Scrolling:** Use `PgUp`/`PgDn` to navigate history. - **Scrolling:** Use `PgUp`/`PgDn` to navigate history.
- **Exit:** Type `/exit` or `Ctrl+C` to close. - **Exit:** Type `/exit` or `Ctrl+C` to close.
* Configuration Strategy * Configuration Strategy
OpenCortex uses a **Hybrid Storage** model for maximum security and flexibility. Passepartout uses a **Hybrid Storage** model for maximum security and flexibility.
** 1. Secrets (`.env`) ** 1. Secrets (`.env`)
Found in `~/.config/opencortex/.env`. This file stores raw API tokens. It is never automatically read by the Lisp structural parser to prevent accidental leakage into logs. Found in `~/.config/passepartout/.env`. This file stores raw API tokens. It is never automatically read by the Lisp structural parser to prevent accidental leakage into logs.
** 2. Metadata (`providers.lisp`) ** 2. Metadata (`providers.lisp`)
Found in `~/.config/opencortex/providers.lisp`. This stores non-sensitive configuration like model names, base URLs, and user preferences as native Lisp S-expressions. Found in `~/.config/passepartout/providers.lisp`. This stores non-sensitive configuration like model names, base URLs, and user preferences as native Lisp S-expressions.
* Troubleshooting * Troubleshooting
If `opencortex doctor` reports a `FAIL`: If `passepartout doctor` reports a `FAIL`:
1. Check that your `PATH` includes `/usr/bin` and `/usr/local/bin`. 1. Check that your `PATH` includes `/usr/bin` and `/usr/local/bin`.
2. Ensure `sbcl` is installed. 2. Ensure `sbcl` is installed.
3. If LLM connectivity fails, verify your API key in `~/.config/opencortex/.env`. 3. If LLM connectivity fails, verify your API key in `~/.config/passepartout/.env`.

6
docs/CHANGELOG.org
View File

@@ -12,7 +12,7 @@ This release focuses on professionalizing the environment and enhancing the agen
- **Professional TUI:** Styled, scrollable interface with improved diagnostics. - **Professional TUI:** Styled, scrollable interface with improved diagnostics.
* v0.1.0 - The Autonomous Foundation (2026-04-20) * v0.1.0 - The Autonomous Foundation (2026-04-20)
This is the initial MVP release of the ~opencortex~. It establishes a secure, auditable Lisp kernel for a personal operating system. This is the initial MVP release of the ~passepartout~. It establishes a secure, auditable Lisp kernel for a personal operating system.
** Features ** Features
- **Unified Envelope Architecture:** Actuator-agnostic protocol that decouples routing metadata from cognitive payloads, ensuring all clients (TUI, Emacs, CLI, Matrix) are treated as equal citizens. - **Unified Envelope Architecture:** Actuator-agnostic protocol that decouples routing metadata from cognitive payloads, ensuring all clients (TUI, Emacs, CLI, Matrix) are treated as equal citizens.
@@ -22,12 +22,12 @@ This is the initial MVP release of the ~opencortex~. It establishes a secure, au
- **The Bouncer:** Last-mile deterministic security gate with Deep Packet Inspection for secrets and network exfiltration. - **The Bouncer:** Last-mile deterministic security gate with Deep Packet Inspection for secrets and network exfiltration.
- **Autonomous Scribe:** Background distillation worker that turns daily journal entries into evergreen Zettelkasten notes. Verified to distill atomic concepts autonomously. - **Autonomous Scribe:** Background distillation worker that turns daily journal entries into evergreen Zettelkasten notes. Verified to distill atomic concepts autonomously.
- **Autonomous Gardener:** Heartbeat-driven worker that repairs broken links and identifies orphaned nodes in the Memex graph. - **Autonomous Gardener:** Heartbeat-driven worker that repairs broken links and identifies orphaned nodes in the Memex graph.
- **Unified Onboarding:** Single-command installation (~opencortex.sh~) with Docker support, OS detection, and automated dependency resolution. - **Unified Onboarding:** Single-command installation (~passepartout.sh~) with Docker support, OS detection, and automated dependency resolution.
- **Channel-Aware TUI:** Interactive Croatoan-based terminal client with clean, human-readable formatting for tool results and system logs. - **Channel-Aware TUI:** Interactive Croatoan-based terminal client with clean, human-readable formatting for tool results and system logs.
- **CLI Gateway:** Local TCP socket server for pipe-friendly interaction and frictionless first contact. - **CLI Gateway:** Local TCP socket server for pipe-friendly interaction and frictionless first contact.
** Licensing & Community ** Licensing & Community
- **AGPLv3 License:** OpenCortex is now officially licensed under the GNU Affero General Public License v3.0. - **AGPLv3 License:** Passepartout is now officially licensed under the GNU Affero General Public License v3.0.
- **Contributor License Agreement:** Implemented a broad CLA (~CLA.org~) for long-term project sustainability. - **Contributor License Agreement:** Implemented a broad CLA (~CLA.org~) for long-term project sustainability.
** Architectural Shift ** Architectural Shift

10
docs/CONTRIBUTING.org
View File

@@ -1,10 +1,10 @@
#+TITLE: Contributing to OpenCortex #+TITLE: Contributing to Passepartout
#+AUTHOR: OpenCortex Contributors #+AUTHOR: Passepartout Contributors
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :docs:contributing: #+FILETAGS: :docs:contributing:
* Philosophy * Philosophy
OpenCortex is built on a "Zero-Bloat" mandate. The core kernel is mathematically pure, pushing all peripheral logic, API integrations, and routing to hot-reloadable "Skills". Passepartout is built on a "Zero-Bloat" mandate. The core kernel is mathematically pure, pushing all peripheral logic, API integrations, and routing to hot-reloadable "Skills".
* Literate Granularity * Literate Granularity
We strictly adhere to Literate Programming using Org-mode. We strictly adhere to Literate Programming using Org-mode.
@@ -14,7 +14,7 @@ We strictly adhere to Literate Programming using Org-mode.
- Every architectural decision, constraint, and implementation detail must be documented alongside the code in the `.org` file. - Every architectural decision, constraint, and implementation detail must be documented alongside the code in the `.org` file.
* Skill Creation Standard * Skill Creation Standard
Skills are the building blocks of OpenCortex. They reside in the `skills/` directory. Skills are the building blocks of Passepartout. They reside in the `skills/` directory.
A skill must define: A skill must define:
1. *Trigger*: A lambda determining if the skill should activate based on the context. 1. *Trigger*: A lambda determining if the skill should activate based on the context.
@@ -40,5 +40,5 @@ All inter-process communication occurs via the Unified Envelope. Do not use lega
1. Ensure your working tree is clean. 1. Ensure your working tree is clean.
2. Write tests for your skill in `tests/`. 2. Write tests for your skill in `tests/`.
3. Tangle all files. 3. Tangle all files.
4. Run the test suite: `sbcl --eval "(asdf:test-system :opencortex)"`. 4. Run the test suite: `sbcl --eval "(asdf:test-system :passepartout)"`.
5. Submit a PR outlining the architectural intent and the specific Literate changes. 5. Submit a PR outlining the architectural intent and the specific Literate changes.

52
docs/DESIGN_DECISIONS.org
View File

@@ -1,4 +1,4 @@
# OpenCortex Design Decisions # Passepartout Design Decisions
This document captures the rationale behind key architectural choices. It is not a specification - it is a thinking medium for future architects and contributors who need to understand why the system is built this way, not just how. This document captures the rationale behind key architectural choices. It is not a specification - it is a thinking medium for future architects and contributors who need to understand why the system is built this way, not just how.
@@ -21,7 +21,7 @@ None of this is to say multi-agent systems are never appropriate. Embarrassingly
But the default assumption that complex reasoning tasks are best solved by multiple agents is unproven and likely wrong for the engineering domain. Claude Code is a single-agent system. It handles 50-file refactors, debugs complex stack traces, writes tests, and navigates large codebases. The assumption that you need five agents to do what one well-designed agent can do is an industry habit, not a technical necessity. But the default assumption that complex reasoning tasks are best solved by multiple agents is unproven and likely wrong for the engineering domain. Claude Code is a single-agent system. It handles 50-file refactors, debugs complex stack traces, writes tests, and navigates large codebases. The assumption that you need five agents to do what one well-designed agent can do is an industry habit, not a technical necessity.
OpenCortex is single-agent by default not from limitation but from conviction: for reasoning-heavy work where coherence matters, a unified memory space and single decision-making locus are architectural assets, not constraints. Passepartout is single-agent by default not from limitation but from conviction: for reasoning-heavy work where coherence matters, a unified memory space and single decision-making locus are architectural assets, not constraints.
* The Unified Memory Argument * The Unified Memory Argument
:PROPERTIES: :PROPERTIES:
@@ -57,7 +57,7 @@ The deterministic engine addresses this by being what the probabilistic engine i
The division of labor is architectural. The LLM handles the fuzzy interface between human language and structured representation. It translates what the user wants into what the system can reason about. The deterministic engine receives those structured representations and evaluates them against formal invariants. It decides whether to execute, not whether the translation was semantically plausible. The division of labor is architectural. The LLM handles the fuzzy interface between human language and structured representation. It translates what the user wants into what the system can reason about. The deterministic engine receives those structured representations and evaluates them against formal invariants. It decides whether to execute, not whether the translation was semantically plausible.
This separation is the source of OpenCortex's safety guarantee. Other agents add "guardrails" as an afterthought - a layer of filtering around a dangerous core. OpenCortex makes the division explicit: the LLM never touches the file system, never executes a command, never modifies memory. It generates proposals. The deterministic engine evaluates and executes. The dangerous operations are never in the probabilistic path. This separation is the source of Passepartout's safety guarantee. Other agents add "guardrails" as an afterthought - a layer of filtering around a dangerous core. Passepartout makes the division explicit: the LLM never touches the file system, never executes a command, never modifies memory. It generates proposals. The deterministic engine evaluates and executes. The dangerous operations are never in the probabilistic path.
The split also explains why the system gets safer over time without the LLM improving. The deterministic engine accumulates rules. The LLM proposes actions, the engine evaluates them against a growing rule set. Early versions block obvious dangers. Later versions block sophisticated attacks that were previously unknown. The safety grows logarithmically with the number of interactions, not linearly with model capability. The split also explains why the system gets safer over time without the LLM improving. The deterministic engine accumulates rules. The LLM proposes actions, the engine evaluates them against a growing rule set. Early versions block obvious dangers. Later versions block sophisticated attacks that were previously unknown. The safety grows logarithmically with the number of interactions, not linearly with model capability.
@@ -66,7 +66,7 @@ The split also explains why the system gets safer over time without the LLM impr
:ID: design-homoiconicity :ID: design-homoiconicity
:END: :END:
Common Lisp is homoiconic: code and data share the same representation. A Lisp program is a list, and a list is a Lisp program. This is usually presented as a curiosity, an interesting property that enables macros. In OpenCortex, it is the foundational enabling property of the entire self-modification architecture. Common Lisp is homoiconic: code and data share the same representation. A Lisp program is a list, and a list is a Lisp program. This is usually presented as a curiosity, an interesting property that enables macros. In Passepartout, it is the foundational enabling property of the entire self-modification architecture.
When code is data, the agent can read its own source the same way it reads a text file or an Org buffer. There is no AST parser required, no external tool to extract the function object from the running image. The agent evaluates (read-from-string source) and the result is executable Lisp. The representation it manipulates is the same representation that the runtime executes. When code is data, the agent can read its own source the same way it reads a text file or an Org buffer. There is no AST parser required, no external tool to extract the function object from the running image. The agent evaluates (read-from-string source) and the result is executable Lisp. The representation it manipulates is the same representation that the runtime executes.
@@ -86,11 +86,11 @@ This is the technical meaning of "Lisp as Governor": not just that Lisp orchestr
Other systems that support self-editing draw a line between the core and the skills. Hermes can modify its skills at runtime, but the core harness is protected - editing it requires a restart because the core is treated as privileged code that cannot be safely modified while running. Other systems that support self-editing draw a line between the core and the skills. Hermes can modify its skills at runtime, but the core harness is protected - editing it requires a restart because the core is treated as privileged code that cannot be safely modified while running.
OpenCortex has no such boundary. The "thin harness, fat skills" distinction describes where complexity lives, not where authority flows. The harness is small by design, but it is not privileged. The agent can read and write any part of the system - including the very code that is currently executing - without restarting. Passepartout has no such boundary. The "thin harness, fat skills" distinction describes where complexity lives, not where authority flows. The harness is small by design, but it is not privileged. The agent can read and write any part of the system - including the very code that is currently executing - without restarting.
This is only possible because Lisp code is mutable data at runtime. In a compiled language, the machine code for a running function is locked in memory, protected by the call stack, impossible to modify safely. In Lisp, the function object is a list you can modify with =setf=. When the agent changes a harness function, the running image immediately reflects the change. The next invocation uses the new code. There is no restart, no special boot mode, no distinction between development and production. This is only possible because Lisp code is mutable data at runtime. In a compiled language, the machine code for a running function is locked in memory, protected by the call stack, impossible to modify safely. In Lisp, the function object is a list you can modify with =setf=. When the agent changes a harness function, the running image immediately reflects the change. The next invocation uses the new code. There is no restart, no special boot mode, no distinction between development and production.
The implications extend beyond convenience. A system that cannot modify its own core is a system that has limits on its own adaptability. It can learn skills but not improve its own structure. It can grow but not evolve. OpenCortex's lack of a core boundary means the system can improve its own reasoning engine, fix bugs in its own cognition, and evolve its own architecture - all while continuing to operate. The implications extend beyond convenience. A system that cannot modify its own core is a system that has limits on its own adaptability. It can learn skills but not improve its own structure. It can grow but not evolve. Passepartout's lack of a core boundary means the system can improve its own reasoning engine, fix bugs in its own cognition, and evolve its own architecture - all while continuing to operate.
This is the final expression of homoiconicity: not just that code is readable as data, or that skills are modifiable, but that the entire system - including the parts that other systems protect - is open to modification. There is no ceiling on self-improvement. The agent can rewrite the very code that rewrites itself. This is the final expression of homoiconicity: not just that code is readable as data, or that skills are modifiable, but that the entire system - including the parts that other systems protect - is open to modification. There is no ceiling on self-improvement. The agent can rewrite the very code that rewrites itself.
@@ -109,11 +109,11 @@ Lisp's time may finally have come. Not as a replacement for neural networks, but
:ID: design-org-unified-ast :ID: design-org-unified-ast
:END: :END:
OpenCortex makes a bet that most systems consider too expensive to place: that humans and machines should share the same file format. That bet is Org-mode. Passepartout makes a bet that most systems consider too expensive to place: that humans and machines should share the same file format. That bet is Org-mode.
Most systems separate human-readable notes from machine-readable data. The user writes Markdown. The system stores it, indexes it, searches it. But internally, the system maintains its own model - a database, an object store, a knowledge graph - that is disconnected from the Markdown. When the user dies or leaves, the Markdown survives but the model must be reconstructed. Most systems separate human-readable notes from machine-readable data. The user writes Markdown. The system stores it, indexes it, searches it. But internally, the system maintains its own model - a database, an object store, a knowledge graph - that is disconnected from the Markdown. When the user dies or leaves, the Markdown survives but the model must be reconstructed.
OpenCortex refuses this separation. The Org file is not a representation of the data. The Org file IS the data. The same text that the user reads and edits is what the system parses and operates on. org-element reads an Org buffer and returns a tree structure that is the direct Lisp representation of the file's content. Passepartout refuses this separation. The Org file is not a representation of the data. The Org file IS the data. The same text that the user reads and edits is what the system parses and operates on. org-element reads an Org buffer and returns a tree structure that is the direct Lisp representation of the file's content.
This has several profound implications. This has several profound implications.
@@ -131,7 +131,7 @@ Sparse tree retrieval is the key to efficient context management. When the agent
Sixth, Org-mode unifies what every other format fragments. A single Org file contains the headline hierarchy, prose documentation, source code blocks with live evaluation, tags for categorization, metadata in property drawers, TODO state for task management, timestamps and deadlines, and links to other nodes. Markdown cannot express TODO state without external tools. JSON cannot contain prose. YAML cannot embed runnable code. Each format serves one purpose; Org-mode serves all of them. When the agent reads a skill file, it reads documentation, code, dependencies, metadata, and task state in one parseable structure. When the human reads the same file, they see the same information rendered in a human-friendly form. No other format achieves this unification without maintaining parallel files or external databases. Sixth, Org-mode unifies what every other format fragments. A single Org file contains the headline hierarchy, prose documentation, source code blocks with live evaluation, tags for categorization, metadata in property drawers, TODO state for task management, timestamps and deadlines, and links to other nodes. Markdown cannot express TODO state without external tools. JSON cannot contain prose. YAML cannot embed runnable code. Each format serves one purpose; Org-mode serves all of them. When the agent reads a skill file, it reads documentation, code, dependencies, metadata, and task state in one parseable structure. When the human reads the same file, they see the same information rendered in a human-friendly form. No other format achieves this unification without maintaining parallel files or external databases.
Seventh, a skill lives in one Org file, not a directory. The standard pattern for a software project is a directory containing =README.md=, =package.json=, =src/main.py=, =src/utils.py=, =tests/test_main.py=, =scripts/deploy.sh=, and =config.yaml=. Each file type is isolated by convention: prose lives in README, code lives in src, tests in tests, configuration in config. This fragmentation means the skill is not a single object the system can reason about - it is a collection of files the system must assemble. OpenCortex's skills violate this convention deliberately. Each skill is one Org file. The file contains the skill's documentation, the skill's code, the skill's metadata, the skill's TODO state, and the skill's dependencies on other skills. There is no directory to navigate, no external files to locate, no risk that the README describes behavior that the code does not implement. The skill is a single atomic unit: readable by human and machine, editable by both, versionable as one entity. Seventh, a skill lives in one Org file, not a directory. The standard pattern for a software project is a directory containing =README.md=, =package.json=, =src/main.py=, =src/utils.py=, =tests/test_main.py=, =scripts/deploy.sh=, and =config.yaml=. Each file type is isolated by convention: prose lives in README, code lives in src, tests in tests, configuration in config. This fragmentation means the skill is not a single object the system can reason about - it is a collection of files the system must assemble. Passepartout's skills violate this convention deliberately. Each skill is one Org file. The file contains the skill's documentation, the skill's code, the skill's metadata, the skill's TODO state, and the skill's dependencies on other skills. There is no directory to navigate, no external files to locate, no risk that the README describes behavior that the code does not implement. The skill is a single atomic unit: readable by human and machine, editable by both, versionable as one entity.
The unified format is what makes the memory architecture work. The agent's memory is not a database that the user cannot inspect. It is a folder of Org files that the user can read, edit, and understand. The agent manipulates these files directly, using the same tools the user would use. There is no hidden state, no shadow database, no model that differs from the source. The unified format is what makes the memory architecture work. The agent's memory is not a database that the user cannot inspect. It is a folder of Org files that the user can read, edit, and understand. The agent manipulates these files directly, using the same tools the user would use. There is no hidden state, no shadow database, no model that differs from the source.
@@ -177,18 +177,18 @@ The Bouncer becomes, over time, not a guard that blocks bad actions but a reason
This is the bootstrap. The system begins dependent on human judgment because it has no basis for judgment of its own. Through accumulated decisions, it constructs a model of what is permitted and why. That model is the foundation for the deterministic symbolic engine that in v3.0.0 takes over the reasoning that the Bouncer learned to perform. This is the bootstrap. The system begins dependent on human judgment because it has no basis for judgment of its own. Through accumulated decisions, it constructs a model of what is permitted and why. That model is the foundation for the deterministic symbolic engine that in v3.0.0 takes over the reasoning that the Bouncer learned to perform.
* OpenCortex as a Function in Time * Passepartout as a Function in Time
:PROPERTIES: :PROPERTIES:
:ID: design-trajectory :ID: design-trajectory
:END: :END:
The system is not static. OpenCortex is defined not just by its current state but by its trajectory - how its cognitive architecture evolves over versions, with each phase reducing probabilistic surface area while increasing deterministic control. The system is not static. Passepartout is defined not just by its current state but by its trajectory - how its cognitive architecture evolves over versions, with each phase reducing probabilistic surface area while increasing deterministic control.
**v0.1.0: The Probabilistic Foundation** **v0.1.0: The Probabilistic Foundation**
The agent begins by relying heavily on the neural engine. The LLM translates messy human intent into structured queries, generates code, proposes solutions. The Bouncer is present but thin - it blocks obviously dangerous actions, verifies path confinement, enforces basic invariants. Most reasoning is probabilistic because the symbolic infrastructure does not yet exist to do otherwise. The agent begins by relying heavily on the neural engine. The LLM translates messy human intent into structured queries, generates code, proposes solutions. The Bouncer is present but thin - it blocks obviously dangerous actions, verifies path confinement, enforces basic invariants. Most reasoning is probabilistic because the symbolic infrastructure does not yet exist to do otherwise.
At this stage, OpenCortex is similar to other LLM-based agents. The key difference is the gate is already there - the architecture assumes the LLM will hallucinate and structures safety accordingly. At this stage, Passepartout is similar to other LLM-based agents. The key difference is the gate is already there - the architecture assumes the LLM will hallucinate and structures safety accordingly.
**v0.2.0 through v0.5.0: The Bouncer Learns** **v0.2.0 through v0.5.0: The Bouncer Learns**
@@ -204,7 +204,7 @@ The balance shifts. The neural engine still translates and generates, but the sy
**v1.0.0: SOTA Parity - The Probabilistic Ceiling** **v1.0.0: SOTA Parity - The Probabilistic Ceiling**
Achieving feature parity with commercial agents requires the full v0.x series complete. At this point, OpenCortex is a reliable autonomous agent - it can handle multi-step engineering tasks, maintain context across sessions, recover from errors, pass benchmarks. It is safer than alternatives because the Bouncer is mature and the memory architecture is sound. Achieving feature parity with commercial agents requires the full v0.x series complete. At this point, Passepartout is a reliable autonomous agent - it can handle multi-step engineering tasks, maintain context across sessions, recover from errors, pass benchmarks. It is safer than alternatives because the Bouncer is mature and the memory architecture is sound.
But it is still fundamentally probabilistic at its core. The symbolic engine verifies and constrains, but the generative engine is still the primary reasoning source. But it is still fundamentally probabilistic at its core. The symbolic engine verifies and constrains, but the generative engine is still the primary reasoning source.
@@ -236,7 +236,7 @@ This is the long horizon. The symbolic engine runs on logic ASICs optimized for
**The Trajectory as Design Principle** **The Trajectory as Design Principle**
Understanding OpenCortex as a function in time is not nostalgia. It is architectural guidance. Every decision in v0.x should be made with awareness of where the system is going. Code written today becomes the substrate for v3.0. Skills designed today become the vocabulary the symbolic engine speaks tomorrow. Understanding Passepartout as a function in time is not nostalgia. It is architectural guidance. Every decision in v0.x should be made with awareness of where the system is going. Code written today becomes the substrate for v3.0. Skills designed today become the vocabulary the symbolic engine speaks tomorrow.
The probabilistic beginning is not a weakness to overcome. It is the bootstrap. The system learns the domain through probabilistic inference, and that learned knowledge becomes the seed for the symbolic engine. By the time the symbolic engine takes over, it has a rich knowledge graph to reason about, grown from thousands of probabilistic interactions. The probabilistic beginning is not a weakness to overcome. It is the bootstrap. The system learns the domain through probabilistic inference, and that learned knowledge becomes the seed for the symbolic engine. By the time the symbolic engine takes over, it has a rich knowledge graph to reason about, grown from thousands of probabilistic interactions.
@@ -251,7 +251,7 @@ A REPL - Read, Eval, Print, Loop - is an interactive programming environment tha
In Lisp, the REPL is not a debugging tool bolted onto the language - it is the natural mode of interaction. The running image is the environment. When you evaluate =(+ 2 2)=, the result =4= is printed, and you remain in the same image where =+= is defined, where previous definitions persist, where the next expression can reference anything that came before. There is no separation between development and execution. The REPL is not a simulation of the program - it is the program running. In Lisp, the REPL is not a debugging tool bolted onto the language - it is the natural mode of interaction. The running image is the environment. When you evaluate =(+ 2 2)=, the result =4= is printed, and you remain in the same image where =+= is defined, where previous definitions persist, where the next expression can reference anything that came before. There is no separation between development and execution. The REPL is not a simulation of the program - it is the program running.
OpenCortex uses the REPL in this spirit, but elevated: it is not merely a tool for writing code, it is the mechanism by which the agent interacts with its own cognition - a loop that mirrors the perceive-reason-act metabolic cycle at the implementation level. Passepartout uses the REPL in this spirit, but elevated: it is not merely a tool for writing code, it is the mechanism by which the agent interacts with its own cognition - a loop that mirrors the perceive-reason-act metabolic cycle at the implementation level.
In the agent's cognitive architecture, the REPL serves three functions that are difficult or impossible to achieve through batch processing or stateless API calls. In the agent's cognitive architecture, the REPL serves three functions that are difficult or impossible to achieve through batch processing or stateless API calls.
@@ -268,11 +268,11 @@ This is why the REPL becomes more important as the system matures. In early vers
:ID: design-evaluation-harness :ID: design-evaluation-harness
:END: :END:
SOTA parity is meaningless without measurement. A system that claims to match commercial agents must demonstrate it through reproducible benchmarks, not through feature checklists. The evaluation harness is the apparatus by which OpenCortex proves its capabilities. SOTA parity is meaningless without measurement. A system that claims to match commercial agents must demonstrate it through reproducible benchmarks, not through feature checklists. The evaluation harness is the apparatus by which Passepartout proves its capabilities.
The industry standard for coding agents is SWE-bench: a corpus of GitHub issues paired with pull requests. The agent is given an issue, must understand the codebase, write a fix, and submit. Success is measured by whether the submitted PR passes the existing test suite. This tests the full chain: understanding, planning, code generation, verification, and multi-step reasoning. The industry standard for coding agents is SWE-bench: a corpus of GitHub issues paired with pull requests. The agent is given an issue, must understand the codebase, write a fix, and submit. Success is measured by whether the submitted PR passes the existing test suite. This tests the full chain: understanding, planning, code generation, verification, and multi-step reasoning.
OpenCortex implements a native Lisp harness for this. A background thread clones repositories, feeds issues into the cognitive loop, tracks the resolution trajectory as an Org-mode headline tree, and scores success by test outcomes. The trajectory is persisted: when a resolution fails, the system can inspect where in the chain the reasoning broke down. The headline tree records the agent's thoughts at each step, making the failure auditable and the debugging human-assisted. Passepartout implements a native Lisp harness for this. A background thread clones repositories, feeds issues into the cognitive loop, tracks the resolution trajectory as an Org-mode headline tree, and scores success by test outcomes. The trajectory is persisted: when a resolution fails, the system can inspect where in the chain the reasoning broke down. The headline tree records the agent's thoughts at each step, making the failure auditable and the debugging human-assisted.
Beyond SWE-bench, the harness includes chaos testing. The system is subjected to resource starvation, concurrent load, and adversarial input. The deterministic engine must maintain safety invariants under pressure. The symbolic verifier must not deadlock or livelock. The probabilistic engine must degrade gracefully - if tokens are limited, it must still produce valid proposals that the deterministic engine can evaluate. Failure under chaos is a design flaw, not a benchmark anomaly. Beyond SWE-bench, the harness includes chaos testing. The system is subjected to resource starvation, concurrent load, and adversarial input. The deterministic engine must maintain safety invariants under pressure. The symbolic verifier must not deadlock or livelock. The probabilistic engine must degrade gracefully - if tokens are limited, it must still produce valid proposals that the deterministic engine can evaluate. Failure under chaos is a design flaw, not a benchmark anomaly.
@@ -283,7 +283,7 @@ The harness also supports regression testing on the skill set. Every skill is te
:ID: design-observability :ID: design-observability
:END: :END:
When a human asks why the system made a decision, the answer must be findable. In most AI systems, the reasoning is ephemeral - it exists in the model's activations and disappears when the session ends. In OpenCortex, every significant cognitive event is written to an Org buffer as it happens. When a human asks why the system made a decision, the answer must be findable. In most AI systems, the reasoning is ephemeral - it exists in the model's activations and disappears when the session ends. In Passepartout, every significant cognitive event is written to an Org buffer as it happens.
The thought trace is the agent's journal, written in parallel with its reasoning. When the probabilistic engine generates a proposal, the trace records the input, the prompt, and the raw output. When the deterministic engine evaluates it, the trace records which rules were checked, which passed, which failed, and why. When an action is executed, the trace records the timestamp, the user who approved it (if human-in-the-loop), and the outcome. The thought trace is the agent's journal, written in parallel with its reasoning. When the probabilistic engine generates a proposal, the trace records the input, the prompt, and the raw output. When the deterministic engine evaluates it, the trace records which rules were checked, which passed, which failed, and why. When an action is executed, the trace records the timestamp, the user who approved it (if human-in-the-loop), and the outcome.
@@ -300,40 +300,40 @@ Without observability, the system is a black box that happens to produce correct
The Model Context Protocol (MCP) is a standard for connecting AI systems to external tools and data sources. It defines how a client requests tools from a server, how the server exposes its capabilities, and how the client invokes them. The ecosystem is growing: MCP servers exist for GitHub, Slack, Postgres, filesystem access, and much more. The Model Context Protocol (MCP) is a standard for connecting AI systems to external tools and data sources. It defines how a client requests tools from a server, how the server exposes its capabilities, and how the client invokes them. The ecosystem is growing: MCP servers exist for GitHub, Slack, Postgres, filesystem access, and much more.
OpenCortex connects to this ecosystem, but not by becoming a Node.js runtime. The architecture is: external MCP servers communicate via stdio or SSE to a Lisp-native MCP client that runs in the same image as the agent. The client is pure Common Lisp - it parses the JSON-RPC messages, invokes the tools, and presents results to the agent as Lisp data structures. There is no serialization overhead between the agent and the MCP layer, no process boundary, no impedance mismatch. Passepartout connects to this ecosystem, but not by becoming a Node.js runtime. The architecture is: external MCP servers communicate via stdio or SSE to a Lisp-native MCP client that runs in the same image as the agent. The client is pure Common Lisp - it parses the JSON-RPC messages, invokes the tools, and presents results to the agent as Lisp data structures. There is no serialization overhead between the agent and the MCP layer, no process boundary, no impedance mismatch.
When the agent calls a tool via MCP, it receives a plist with the tool name, arguments, and result. The result is immediately usable by the agent's symbolic engine. When the agent generates a file, it can be written to the filesystem through an MCP filesystem server. When the agent needs to send a message, it can use an MCP Slack server. The agent does not need to know that these are MCP interactions - it sees only the plists that flow through its cognitive architecture. When the agent calls a tool via MCP, it receives a plist with the tool name, arguments, and result. The result is immediately usable by the agent's symbolic engine. When the agent generates a file, it can be written to the filesystem through an MCP filesystem server. When the agent needs to send a message, it can use an MCP Slack server. The agent does not need to know that these are MCP interactions - it sees only the plists that flow through its cognitive architecture.
The alternative is to build MCP wrappers in Python or TypeScript and bridge to Lisp via subprocess. This is what OpenClaw does: a Node.js runtime that manages MCP servers, with a bridge to the Lisp process. The bridge introduces latency, serialization costs, and a maintenance burden. The Node.js process must be kept running. The bridge must be maintained across Lisp and JavaScript runtimes. The cognitive architecture must handle errors that cross the process boundary. The alternative is to build MCP wrappers in Python or TypeScript and bridge to Lisp via subprocess. This is what OpenClaw does: a Node.js runtime that manages MCP servers, with a bridge to the Lisp process. The bridge introduces latency, serialization costs, and a maintenance burden. The Node.js process must be kept running. The bridge must be maintained across Lisp and JavaScript runtimes. The cognitive architecture must handle errors that cross the process boundary.
OpenCortex's native client is smaller, faster, and more maintainable. The MCP client is a skill, not a core component. It can be reloaded, replaced, or removed without restarting the agent. The agent can add new MCP tool integrations by loading new skills, not by deploying new infrastructure. Passepartout's native client is smaller, faster, and more maintainable. The MCP client is a skill, not a core component. It can be reloaded, replaced, or removed without restarting the agent. The agent can add new MCP tool integrations by loading new skills, not by deploying new infrastructure.
* Local-First Architecture * Local-First Architecture
:PROPERTIES: :PROPERTIES:
:ID: design-local-first :ID: design-local-first
:END: :END:
OpenCortex is designed to run on the user's machine, on their hardware, with their data, without requiring an internet connection. This is not a deployment option - it is an architectural commitment. The system must be able to reason, plan, and act using only the resources available locally. Passepartout is designed to run on the user's machine, on their hardware, with their data, without requiring an internet connection. This is not a deployment option - it is an architectural commitment. The system must be able to reason, plan, and act using only the resources available locally.
The motivation is not merely philosophical. Cloud-based AI agents are economically incentivized to collect data, to train on user interactions, and to build lock-in through proprietary formats and network effects. When the agent runs locally, the user owns the hardware, owns the data, and can terminate the process without asking permission. There is no vendor that can change terms, no service that can go offline, no model that can be updated without consent. The motivation is not merely philosophical. Cloud-based AI agents are economically incentivized to collect data, to train on user interactions, and to build lock-in through proprietary formats and network effects. When the agent runs locally, the user owns the hardware, owns the data, and can terminate the process without asking permission. There is no vendor that can change terms, no service that can go offline, no model that can be updated without consent.
Technically, local-first means several things. The LLM must be able to run on local hardware. OpenCortex supports Ollama as a provider, which runs quantized models on CPU and GPU without requiring an external API. The vector database must be local. OpenCortex uses its own org-object store, which is a folder of Org files that the agent already owns. There is no ChromaDB or Qdrant to install, no cloud vector service to authenticate with. Technically, local-first means several things. The LLM must be able to run on local hardware. Passepartout supports Ollama as a provider, which runs quantized models on CPU and GPU without requiring an external API. The vector database must be local. Passepartout uses its own org-object store, which is a folder of Org files that the agent already owns. There is no ChromaDB or Qdrant to install, no cloud vector service to authenticate with.
The symbolic engine does not require a network connection. The Prolog/Datalog reasoner that in v3.0.0 verifies neural proposals runs entirely in the Lisp image. The Bouncer's rule synthesis does not call an external service. The agent can operate in a disconnected environment indefinitely, resuming full capability when connectivity is restored. The symbolic engine does not require a network connection. The Prolog/Datalog reasoner that in v3.0.0 verifies neural proposals runs entirely in the Lisp image. The Bouncer's rule synthesis does not call an external service. The agent can operate in a disconnected environment indefinitely, resuming full capability when connectivity is restored.
This does not mean OpenCortex refuses to use cloud services when available and appropriate. It means cloud services are optional enhancements, not architectural requirements. The core is local. The user can choose to add cloud LLM providers for more capable inference, but the system functions without them. This does not mean Passepartout refuses to use cloud services when available and appropriate. It means cloud services are optional enhancements, not architectural requirements. The core is local. The user can choose to add cloud LLM providers for more capable inference, but the system functions without them.
* Zero-Dependency Deployment * Zero-Dependency Deployment
:PROPERTIES: :PROPERTIES:
:ID: design-zero-dependency :ID: design-zero-dependency
:END: :END:
The simplest deployment is one that requires no installation steps. The user downloads one file, runs it, and the system works. OpenCortex approximates this through SBCL's ability to produce standalone executables via save-lisp-and-die. The executable contains the Lisp runtime, the compiled system, and Quicklisp libraries - everything bundled into one binary. The simplest deployment is one that requires no installation steps. The user downloads one file, runs it, and the system works. Passepartout approximates this through SBCL's ability to produce standalone executables via save-lisp-and-die. The executable contains the Lisp runtime, the compiled system, and Quicklisp libraries - everything bundled into one binary.
The practical reality is more nuanced. Building a truly standalone executable requires resolving all library dependencies at build time and embedding them in the binary. SBCL supports this, but the resulting binary is large (tens of megabytes), and updating any component requires a full rebuild. The current deployment model uses a Docker container that maps the user's memex directory as a volume. The container starts, loads the system, and is ready. No compilation on the user's machine, no dependency installation, no platform-specific quirks. The practical reality is more nuanced. Building a truly standalone executable requires resolving all library dependencies at build time and embedding them in the binary. SBCL supports this, but the resulting binary is large (tens of megabytes), and updating any component requires a full rebuild. The current deployment model uses a Docker container that maps the user's memex directory as a volume. The container starts, loads the system, and is ready. No compilation on the user's machine, no dependency installation, no platform-specific quirks.
The long-term goal is a single =opencortex= binary that the user runs. It starts a local web server on a Unix domain socket. The TUI connects through the socket. The user's Org files are in =~/memex/=. The binary is the only thing that needs to be installed. The long-term goal is a single =passepartout= binary that the user runs. It starts a local web server on a Unix domain socket. The TUI connects through the socket. The user's Org files are in =~/memex/=. The binary is the only thing that needs to be installed.
This stands in stark contrast to most AI agent systems, which require managing Python environments, npm packages, API keys, environment variables, and configuration files. OpenAI's agents SDK requires pip install, a Python environment, and external API access. OpenClaw requires Node.js, npm, and a plugin ecosystem that must be individually installed. LangChain requires a Python environment with dozens of dependencies that must be kept compatible. This stands in stark contrast to most AI agent systems, which require managing Python environments, npm packages, API keys, environment variables, and configuration files. OpenAI's agents SDK requires pip install, a Python environment, and external API access. OpenClaw requires Node.js, npm, and a plugin ecosystem that must be individually installed. LangChain requires a Python environment with dozens of dependencies that must be kept compatible.
OpenCortex's dependency model is SBCL plus Quicklisp. Quicklisp loads libraries on demand from the internet, but caches them locally. A system with internet access can fetch any library it needs. A system without internet access uses only the libraries it has already loaded - and those are preserved in the cache. The agent does not require internet access to function after initial setup. Passepartout's dependency model is SBCL plus Quicklisp. Quicklisp loads libraries on demand from the internet, but caches them locally. A system with internet access can fetch any library it needs. A system without internet access uses only the libraries it has already loaded - and those are preserved in the cache. The agent does not require internet access to function after initial setup.

4
docs/ROADMAP.org
View File

@@ -1,4 +1,4 @@
#+TITLE: OpenCortex Evolutionary Roadmap #+TITLE: Passepartout Evolutionary Roadmap
#+STARTUP: content #+STARTUP: content
* The Evolutionary Roadmap * The Evolutionary Roadmap
@@ -106,7 +106,7 @@ Multimodal visual interaction and ecosystem-wide tool compatibility.
| Feature | Description | | Feature | Description |
|-----------------------+------------------------------------------------------------------------------------------------------------------------------------------------------------| |-----------------------+------------------------------------------------------------------------------------------------------------------------------------------------------------|
| Computer Use / Vision | Allow the agent to request host OS or browser screenshots, analyze the UI, and issue precise X/Y coordinate click/type commands via an X11/Wayland bridge. | | Computer Use / Vision | Allow the agent to request host OS or browser screenshots, analyze the UI, and issue precise X/Y coordinate click/type commands via an X11/Wayland bridge. |
| MCP Gateway Bridge | Lisp-native client for the Model Context Protocol, allowing OpenCortex to connect to the entire ecosystem of external tools and data sources. | | MCP Gateway Bridge | Lisp-native client for the Model Context Protocol, allowing Passepartout to connect to the entire ecosystem of external tools and data sources. |
*** v0.8.0: The Evaluation Harness *** v0.8.0: The Evaluation Harness

48
docs/USER_MANUAL.org
View File

@@ -1,25 +1,25 @@
#+TITLE: OpenCortex User Manual #+TITLE: Passepartout User Manual
#+AUTHOR: OpenCortex Contributors #+AUTHOR: Passepartout Contributors
#+STARTUP: content #+STARTUP: content
#+FILETAGS: :docs:manual: #+FILETAGS: :docs:manual:
* Introduction * 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. Welcome to Passepartout v0.1.0 (The Autonomous Foundation). Passepartout 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.
* Installation * Installation
OpenCortex is bootstrapped via a single shell script. Passepartout is bootstrapped via a single shell script.
** Quick start (curl) ** Quick start (curl)
#+begin_src bash #+begin_src bash
curl -fsSL https://raw.githubusercontent.com/amrgharbeia/opencortex/main/opencortex.sh | bash -s configure curl -fsSL https://raw.githubusercontent.com/amrgharbeia/passepartout/main/passepartout.sh | bash -s configure
#+end_src #+end_src
** From a clone ** From a clone
#+begin_src bash #+begin_src bash
git clone https://github.com/amrgharbeia/opencortex.git ~/projects/opencortex git clone https://github.com/amrgharbeia/passepartout.git ~/projects/passepartout
~/projects/opencortex/opencortex.sh configure ~/projects/passepartout/passepartout.sh configure
#+end_src #+end_src
Both methods will: Both methods will:
@@ -37,33 +37,33 @@ The system is configured via a `.env` file in the project root. Essential variab
- `PROVIDER_CASCADE`: The fallback order for LLM providers (e.g., `openrouter,ollama,anthropic`). - `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`). - `MEMEX_DIR`: The absolute path to your knowledge base (defaults to `~/memex`).
* Interacting with OpenCortex * Interacting with Passepartout
Because of the Unified Envelope Architecture, the kernel treats all clients as interchangeable. You must first boot the background daemon: Because of the Unified Envelope Architecture, the kernel treats all clients as interchangeable. You must first boot the background daemon:
#+begin_src bash #+begin_src bash
./opencortex.sh --boot & ./passepartout.sh --boot &
#+end_src #+end_src
** Terminal User Interface (TUI) ** Terminal User Interface (TUI)
For a rich, split-pane terminal experience: For a rich, split-pane terminal experience:
#+begin_src bash #+begin_src bash
./opencortex.sh tui ./passepartout.sh tui
#+end_src #+end_src
** Command Line Interface (CLI) ** Command Line Interface (CLI)
For raw, pipe-friendly interaction: For raw, pipe-friendly interaction:
#+begin_src bash #+begin_src bash
./opencortex.sh cli ./passepartout.sh cli
#+end_src #+end_src
** Emacs Integration ** Emacs Integration
OpenCortex functions as your "foveal vision" inside Emacs. Passepartout functions as your "foveal vision" inside Emacs.
1. Ensure `org-agent.el` is loaded. 1. Ensure `org-agent.el` is loaded.
2. Run `M-x opencortex-connect`. 2. Run `M-x passepartout-connect`.
3. Interact via the `*opencortex-chat*` buffer. 3. Interact via the `*passepartout-chat*` buffer.
* The Memex Structure * The Memex Structure
OpenCortex assumes a local folder structure representing your "Memex". Passepartout assumes a local folder structure representing your "Memex".
- Core memories and identities are mapped to Org-mode files. - Core memories and identities are mapped to Org-mode files.
- The `Scribe` background worker distills chronological logs into structured Zettelkasten notes. - The `Scribe` background worker distills chronological logs into structured Zettelkasten notes.
- The `Gardener` continuously repairs broken links and flags orphaned nodes. - The `Gardener` continuously repairs broken links and flags orphaned nodes.
@@ -75,9 +75,9 @@ OpenCortex assumes a local folder structure representing your "Memex".
The ~configure~ command supports both Debian-based (Ubuntu, Pop, Mint) and Fedora-based (RHEL, Rocky) distributions. It detects your distro automatically and installs the correct packages. The ~configure~ command supports both Debian-based (Ubuntu, Pop, Mint) and Fedora-based (RHEL, Rocky) distributions. It detects your distro automatically and installs the correct packages.
#+begin_src bash #+begin_src bash
./opencortex.sh configure # interactive ./passepartout.sh configure # interactive
./opencortex.sh configure --non-interactive # headless ./passepartout.sh configure --non-interactive # headless
./opencortex.sh configure --with-firewall # also open port 9105 ./passepartout.sh configure --with-firewall # also open port 9105
#+end_src #+end_src
After configuration, you can re-run ~configure~ any time to add providers or link gateways. After configuration, you can re-run ~configure~ any time to add providers or link gateways.
@@ -85,15 +85,15 @@ After configuration, you can re-run ~configure~ any time to add providers or lin
** systemd service (auto-start on boot) ** systemd service (auto-start on boot)
#+begin_src bash #+begin_src bash
./opencortex.sh install service ./passepartout.sh install service
#+end_src #+end_src
Installs a user-level systemd unit that starts the daemon on login. Logs are available via ~journalctl --user -u opencortex.service -f~. Installs a user-level systemd unit that starts the daemon on login. Logs are available via ~journalctl --user -u passepartout.service -f~.
To remove: To remove:
#+begin_src bash #+begin_src bash
./opencortex.sh uninstall service ./passepartout.sh uninstall service
#+end_src #+end_src
** Docker ** Docker
@@ -110,7 +110,7 @@ This builds an image from ~debian:trixie-slim~ with all dependencies pre-install
** Backup ** Backup
#+begin_src bash #+begin_src bash
./opencortex.sh backup ~/my-backup.tar.gz ./passepartout.sh backup ~/my-backup.tar.gz
#+end_src #+end_src
Backs up the config, data, and memex directories. Backs up the config, data, and memex directories.
@@ -118,7 +118,7 @@ Backs up the config, data, and memex directories.
** Restore ** Restore
#+begin_src bash #+begin_src bash
./opencortex.sh restore ~/my-backup.tar.gz ./passepartout.sh restore ~/my-backup.tar.gz
#+end_src #+end_src
Restores from a backup file. Run ~opencortex doctor~ afterward to verify integrity. Restores from a backup file. Run ~passepartout doctor~ afterward to verify integrity.

9
harness/communication-validator.lisp
View File

@@ -1,9 +0,0 @@
(in-package :opencortex)
(defun validate-communication-protocol-schema (msg)
"Strict structural validation for incoming protocol messages."
(unless (listp msg) (error "Message must be a plist"))
(let ((type (proto-get msg :type)))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS))
(error "Invalid message type '~a'" type))
t))

81
harness/doctor.lisp
View File

@@ -1,81 +0,0 @@
(in-package :opencortex)
(defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc")
"List of external binaries required for full system operation.")
(defun doctor-check-dependencies ()
"Verifies that required external binaries are available in the PATH via a shell probe."
(let ((all-ok t))
(harness-log "DOCTOR: Checking system dependencies...")
(dolist (dep *doctor-required-binaries*)
(let ((path (ignore-errors
(uiop:run-program (list "which" dep)
:output :string :ignore-error-status t))))
(if (and path (> (length path) 0))
(harness-log " [OK] Found ~a" dep)
(progn
(harness-log " [FAIL] Missing binary: ~a" dep)
(setf all-ok nil)))))
all-ok))
(defun doctor-check-env ()
"Validates XDG directories and environment configuration against the POSIX standard."
(harness-log "DOCTOR: Checking XDG environment...")
(let ((all-ok t)
(config-dir (uiop:getenv "OC_CONFIG_DIR"))
(data-dir (uiop:getenv "OC_DATA_DIR"))
(state-dir (uiop:getenv "OC_STATE_DIR"))
(memex-dir (uiop:getenv "MEMEX_DIR")))
(flet ((check-dir (name path critical)
(if (and path (> (length path) 0))
(if (uiop:directory-exists-p path)
(harness-log " [OK] ~a: ~a" name path)
(progn
(harness-log " [FAIL] ~a directory missing: ~a" name path)
(when critical (setf all-ok nil))))
(progn
(harness-log " [FAIL] ~a variable not set." name)
(when critical (setf all-ok nil))))))
(check-dir "Config (OC_CONFIG_DIR)" config-dir t)
(check-dir "Data (OC_DATA_DIR)" data-dir t)
(check-dir "State (OC_STATE_DIR)" state-dir t)
(check-dir "Memex (MEMEX_DIR)" memex-dir t))
all-ok))
(defun doctor-check-llm ()
"Tests connectivity to primary LLM providers. Non-critical fallback allowed."
(harness-log "DOCTOR: Checking LLM connectivity...")
(let ((openrouter-key (uiop:getenv "OPENROUTER_API_KEY")))
(if (and openrouter-key (> (length openrouter-key) 0))
(progn
(harness-log " [OK] OpenRouter API Key detected.")
t)
(progn
(harness-log " [WARN] No OpenRouter API Key. Falling back to local inference only.")
t))))
(defun doctor-run-all ()
"Executes the full diagnostic suite and returns T if system is healthy."
(harness-log "==================================================")
(harness-log " OPENCORTEX DOCTOR: Commencing Health Check")
(harness-log "==================================================")
(let ((dep-ok (doctor-check-dependencies))
(env-ok (doctor-check-env))
(llm-ok (doctor-check-llm)))
(declare (ignore llm-ok))
(harness-log "==================================================")
(if (and dep-ok env-ok)
(progn
(harness-log " ✓ SYSTEM HEALTHY: Ready for ignition.")
t)
(progn
(harness-log " ✗ SYSTEM UNHEALTHY: Fix the errors above.")
nil))))
(defun doctor-main ()
"Entry point for the 'doctor' CLI command."
(if (doctor-run-all)
(uiop:quit 0)
(uiop:quit 1)))

163
harness/doctor.org
View File

@@ -1,163 +0,0 @@
#+PROPERTY: header-args:lisp :tangle doctor.lisp
#+TITLE: System Diagnostic Doctor (doctor.org)
#+AUTHOR: Agent
#+FILETAGS: :harness:setup:diagnostic:
#+STARTUP: content
* Overview
The *System Doctor* is the primary diagnostic utility for the OpenCortex. Its purpose is to transform opaque startup failures into actionable engineering reports.
By centralizing environment validation, we ensure that the "Brain" never attempts to boot in a compromised or incomplete state.
* Phase A: Demand (Thinking)
** The XDG Standard Rationale
To ensure OpenCortex behaves as a first-class POSIX citizen, we adopt the **XDG Base Directory Specification**. This separates the system into four logical layers:
1. **Configuration (`~/.config/opencortex`)**: User-editable settings and secrets.
2. **Data (`~/.local/share/opencortex`)**: Tangled Lisp engine artifacts (immutable by user).
3. **State (`~/.local/state/opencortex`)**: Dynamic persistence like brain snapshots.
4. **Bin (`~/.local/bin`)**: The CLI shim for global invocation.
** The Detection Invariant: Shell Probing
Common Lisp's `getenv` is strictly typed in SBCL. The Doctor must ensure that missing variables are handled as logic failures, not type crashes. Furthermore, binary detection must use a shell probe (`command -v` or `which`) to account for varying `$PATH` inheritance between interactive and headless sessions.
* Phase B: Protocol (Success Criteria)
** Package Context
#+begin_src lisp :tangle ../tests/doctor-tests.lisp
(defpackage :opencortex-doctor-tests
(:use :cl :fiveam :opencortex)
(:export #:doctor-suite))
(in-package :opencortex-doctor-tests)
(def-suite doctor-suite :description "Verification of the System Doctor diagnostic logic")
(in-suite doctor-suite)
#+end_src
** Dependency Tests
#+begin_src lisp :tangle ../tests/doctor-tests.lisp
(test test-dependency-check-fail
"Verify that missing binaries are correctly identified as failures."
(let ((opencortex::*doctor-required-binaries* '("non-existent-binary-123")))
(is (null (opencortex:doctor-check-dependencies)))))
#+end_src
** Environment Tests
#+begin_src lisp :tangle ../tests/doctor-tests.lisp
(test test-env-validation-fail
"Verify that an invalid MEMEX_DIR triggers a critical failure."
(let ((old-m (uiop:getenv "MEMEX_DIR"))
(old-d (uiop:getenv "OC_DATA_DIR")))
(unwind-protect
(progn
(setf (uiop:getenv "MEMEX_DIR") "/non/existent/path/999")
(is (null (opencortex:doctor-check-env))))
(setf (uiop:getenv "MEMEX_DIR") (or old-m ""))
(setf (uiop:getenv "OC_DATA_DIR") (or old-d "")))))
#+end_src
* Phase C: Implementation (Build)
** Package Context
#+begin_src lisp
(in-package :opencortex)
#+end_src
** Global Configuration
#+begin_src lisp
(defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc")
"List of external binaries required for full system operation.")
#+end_src
** Dependency Verification
#+begin_src lisp
(defun doctor-check-dependencies ()
"Verifies that required external binaries are available in the PATH via a shell probe."
(let ((all-ok t))
(harness-log "DOCTOR: Checking system dependencies...")
(dolist (dep *doctor-required-binaries*)
(let ((path (ignore-errors
(uiop:run-program (list "which" dep)
:output :string :ignore-error-status t))))
(if (and path (> (length path) 0))
(harness-log " [OK] Found ~a" dep)
(progn
(harness-log " [FAIL] Missing binary: ~a" dep)
(setf all-ok nil)))))
all-ok))
#+end_src
** Environment & XDG Validation
#+begin_src lisp
(defun doctor-check-env ()
"Validates XDG directories and environment configuration against the POSIX standard."
(harness-log "DOCTOR: Checking XDG environment...")
(let ((all-ok t)
(config-dir (uiop:getenv "OC_CONFIG_DIR"))
(data-dir (uiop:getenv "OC_DATA_DIR"))
(state-dir (uiop:getenv "OC_STATE_DIR"))
(memex-dir (uiop:getenv "MEMEX_DIR")))
(flet ((check-dir (name path critical)
(if (and path (> (length path) 0))
(if (uiop:directory-exists-p path)
(harness-log " [OK] ~a: ~a" name path)
(progn
(harness-log " [FAIL] ~a directory missing: ~a" name path)
(when critical (setf all-ok nil))))
(progn
(harness-log " [FAIL] ~a variable not set." name)
(when critical (setf all-ok nil))))))
(check-dir "Config (OC_CONFIG_DIR)" config-dir t)
(check-dir "Data (OC_DATA_DIR)" data-dir t)
(check-dir "State (OC_STATE_DIR)" state-dir t)
(check-dir "Memex (MEMEX_DIR)" memex-dir t))
all-ok))
#+end_src
** LLM Connectivity
#+begin_src lisp
(defun doctor-check-llm ()
"Tests connectivity to primary LLM providers. Non-critical fallback allowed."
(harness-log "DOCTOR: Checking LLM connectivity...")
(let ((openrouter-key (uiop:getenv "OPENROUTER_API_KEY")))
(if (and openrouter-key (> (length openrouter-key) 0))
(progn
(harness-log " [OK] OpenRouter API Key detected.")
t)
(progn
(harness-log " [WARN] No OpenRouter API Key. Falling back to local inference only.")
t))))
#+end_src
** Orchestration
#+begin_src lisp
(defun doctor-run-all ()
"Executes the full diagnostic suite and returns T if system is healthy."
(harness-log "==================================================")
(harness-log " OPENCORTEX DOCTOR: Commencing Health Check")
(harness-log "==================================================")
(let ((dep-ok (doctor-check-dependencies))
(env-ok (doctor-check-env))
(llm-ok (doctor-check-llm)))
(declare (ignore llm-ok))
(harness-log "==================================================")
(if (and dep-ok env-ok)
(progn
(harness-log " ✓ SYSTEM HEALTHY: Ready for ignition.")
t)
(progn
(harness-log " ✗ SYSTEM UNHEALTHY: Fix the errors above.")
nil))))
#+end_src
** CLI Entry Point
#+begin_src lisp
(defun doctor-main ()
"Entry point for the 'doctor' CLI command."
(if (doctor-run-all)
(uiop:quit 0)
(uiop:quit 1)))
#+end_src

136
harness/loop.lisp
View File

@@ -1,136 +0,0 @@
(in-package :opencortex)
(defvar *interrupt-flag* nil
"Atomic flag set by signal handlers to trigger graceful shutdown.")
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock")
"Mutex protecting *interrupt-flag* access.")
(defvar *heartbeat-thread* nil
"Handle to the heartbeat thread.")
(defun process-signal (signal)
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
(let ((current-signal signal))
(loop while current-signal do
(let ((depth (getf current-signal :depth 0))
(meta (getf current-signal :meta)))
(when (> depth 10)
(harness-log "METABOLISM ERROR: Max recursion depth reached.")
(return nil))
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
(harness-log "METABOLISM: Interrupted by shutdown signal.")
(return nil))
(handler-case
(progn
(setf current-signal (perceive-gate current-signal))
(setf current-signal (reason-gate current-signal))
(let ((feedback (act-gate current-signal)))
(if feedback
(progn
(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)
(unless (member sensor '(:loop-error :tool-error :syntax-error))
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
(rollback-memory 0))
(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)
(defvar *heartbeat-save-counter* 0)
(defun start-heartbeat ()
"Starts the background heartbeat thread."
(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)
(incf *heartbeat-save-counter*)
(when (>= *heartbeat-save-counter* (/ *auto-save-interval* interval))
(setf *heartbeat-save-counter* 0)
(save-memory-to-disk))
(inject-stimulus
(list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
:name "opencortex-heartbeat"))))
(defvar *shutdown-save-enabled* t)
(defvar *system-health* :unknown
"Current system health status: :healthy, :degraded, :unhealthy, or :unknown.")
(defvar *health-check-ran* nil
"Flag indicating if initial health check has completed.")
(defun run-startup-health-check ()
"Runs the doctor diagnostics on startup. Returns health status."
(format t "~%")
(format t "==================================================~%")
(format t " DOCTOR: Running Startup Health Check~%")
(format t "==================================================~%")
(handler-case
(progn
(when (fboundp 'doctor-run-all)
(let ((result (doctor-run-all)))
(setf *health-check-ran* t)
(if result
(progn
(setf *system-health* :healthy)
(format t "DAEMON: Health check passed. Starting services.~%"))
(progn
(setf *system-health* :degraded)
(format t "DAEMON: Health check found issues.~%")
(format t " Run 'opencortex doctor --fix' to repair.~%")))))
(setf *health-check-ran* t))
(error (c)
(format t "DOCTOR ERROR: ~a~%" c)
(setf *system-health* :unhealthy)
(setf *health-check-ran* t)))
(format t "==================================================~%~%"))
(defun main ()
"Entry point for OpenCortex. Initializes the system and enters idle loop."
(let* ((home (uiop:getenv "HOME"))
(env-file (uiop:merge-pathnames* ".config/opencortex/.env" (uiop:ensure-directory-pathname home))))
(when (uiop:file-exists-p env-file)
(cl-dotenv:load-env env-file)))
(load-memory-from-disk)
(initialize-actuators)
(initialize-all-skills)
;; Run proactive doctor before starting services
(run-startup-health-check)
(start-heartbeat)
(start-daemon)
#+sbcl
(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)))
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
(loop
(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))))

64
harness/manifest.org
View File

@@ -1,64 +0,0 @@
#+TITLE: System Manifest (manifest.org)
#+AUTHOR: Agent
#+FILETAGS: :harness:manifest:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle ../opencortex.asd
* Overview
The *System Manifest* defines the structural components of the OpenCortex.
* Implementation
** Main System
#+begin_src lisp
(defsystem :opencortex
:name "opencortex"
:author "Amr Gharbeia"
:version "0.2.0"
:license "AGPLv3"
:description "The Probabilistic-Deterministic Lisp Machine"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
:serial t
:components ((:file "harness/package")
(:file "harness/skills")
(:file "harness/communication")
(:file "harness/communication-validator")
(:file "harness/memory")
(:file "harness/context")
(:file "harness/perceive")
(:file "harness/reason")
(:file "harness/act")
(:file "harness/loop")))
#+end_src
** Test System
#+begin_src lisp
(defsystem :opencortex/tests
:depends-on (:opencortex :fiveam)
:components ((:file "tests/pipeline-act-tests")
(:file "tests/boot-sequence-tests")
(:file "tests/immune-system-tests")
(:file "tests/memory-tests")
(:file "tests/pipeline-perceive-tests")
(:file "tests/pipeline-reason-tests")
(:file "tests/peripheral-vision-tests")
(:file "tests/utils-org-tests")
(:file "tests/engineering-standards-tests")
(:file "tests/utils-lisp-tests")
(:file "tests/literate-programming-tests")
(:file "tests/self-edit-tests")
(:file "tests/tool-permissions-tests")
(:file "tests/diagnostics-tests")
(:file "tests/config-manager-tests")
(:file "tests/gateway-manager-tests")
(:file "tests/tui-tests")
(:file "tests/llm-gateway-tests")))
#+end_src
** TUI System
#+begin_src lisp
(defsystem :opencortex/tui
:depends-on (:opencortex :croatoan :usocket :bordeaux-threads)
:components ((:file "harness/tui-client")))
#+end_src

120
harness/memory.lisp
View File

@@ -1,120 +0,0 @@
(in-package :opencortex)
(defvar *memory* (make-hash-table :test 'equal))
(defvar *history-store* (make-hash-table :test 'equal)
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
(defun lookup-object (id)
(gethash id *memory*))
(defstruct org-object
id type attributes content vector parent-id children version last-sync hash)
(defmethod make-load-form ((obj org-object) &optional env)
(make-load-form-saving-slots obj :environment env))
(defun deep-copy-org-object (obj)
(make-org-object :id (org-object-id obj)
:type (org-object-type obj)
:attributes (copy-list (org-object-attributes obj))
:content (org-object-content obj)
:vector (org-object-vector obj)
:parent-id (org-object-parent-id obj)
:children (copy-list (org-object-children obj))
:version (org-object-version obj)
:last-sync (org-object-last-sync obj)
:hash (org-object-hash obj)))
(defun compute-merkle-hash (id type attributes content child-hashes)
(let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
(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))
(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)
(let* ((type (getf ast :type))
(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 (getf ast :raw-content) ""))))
(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-obj (gethash child-id *memory*)))
(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
: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)
id)))
(defvar *object-store-snapshots* nil)
(defun copy-hash-table (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 ()
(let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory*))))
(maphash (lambda (k v) (setf (gethash k snapshot) (deep-copy-org-object v))) *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))
(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)
(defun ensure-memory-snapshot-path ()
(or *memory-snapshot-path*
(let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH")))
(setf *memory-snapshot-path*
(or env-path (namestring (uiop:merge-pathnames* "memory.snap" (user-homedir-pathname))))))))
(defun save-memory-to-disk ()
(let ((path (ensure-memory-snapshot-path)))
(with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create)
(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)))
(defun load-memory-from-disk ()
(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)

248
harness/memory.org
View File

@@ -1,248 +0,0 @@
#+TITLE: The System Memory (memory.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:memory:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle memory.lisp
* Overview
The Memory module is the agent's live cognitive state — a set of Merkle-tree-versioned ~org-object~ instances stored in hash tables. Every perception, action, and decision is recorded here.
Key structures:
- ~*memory*~ — the primary object store, keyed by ID
- ~*history-store*~ — immutable archive of all past object versions, keyed by SHA-256 hash
- ~org-object~ — the universal data unit (id, type, attributes, content, vector embedding, parent, children, merkle hash)
- ~ingest-ast~ — converts an Org-mode AST into ~org-object~ instances, computing Merkle hashes for integrity
* Implementation
** Package Context
#+begin_src lisp
(in-package :opencortex)
#+end_src
** The Object Repository
#+begin_src lisp
(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
** Object Lookup (lookup-object)
Retrieve a single object by its ID from the active memory store.
#+begin_src lisp
(defun lookup-object (id)
"Retrieves an org-object by ID from *memory*."
(gethash id *memory*))
#+end_src
** Object search (list-objects-with-attribute)
Scan the entire memory store for objects whose attributes match a given key-value pair.
#+begin_src lisp
(defun list-objects-with-attribute (attr value)
"Returns all org-objects whose :ATTRIBUTES plist has ATTR = VALUE."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(when (equal (getf (org-object-attributes obj) attr) value)
(push obj results)))
*memory*)
(nreverse results)))
#+end_src
** ID generation (org-id-new)
Generate a unique identifier string for a new Org node. Uses the universal time encoded in base-36 for compactness.
#+begin_src lisp
(defun org-id-new ()
"Generates a timestamp-based unique ID."
(format nil "id-~36r" (get-universal-time)))
#+end_src
** The Data Structure (org-object)
The universal data unit. Every stored entity is an ~org-object~ with an ID, type, attribute plist, content string, optional vector embedding, parent/child pointers, version timestamp, and Merkle hash.
#+begin_src lisp
(defstruct org-object
id type attributes content vector parent-id children version last-sync hash)
#+end_src
** Serialization support
Required by the Lisp runtime for saving/loading objects across image restarts.
#+begin_src lisp
(defmethod make-load-form ((obj org-object) &optional env)
(make-load-form-saving-slots obj :environment env))
#+end_src
** Deep copy
Creates an independent copy of an ~org-object~. Used by the snapshot system to capture consistent memory state.
#+begin_src lisp
(defun deep-copy-org-object (obj)
"Creates a full copy of an org-object, including a fresh list copy of attributes and children."
(make-org-object :id (org-object-id obj)
:type (org-object-type obj)
:attributes (copy-list (org-object-attributes obj))
:content (org-object-content obj)
:vector (org-object-vector obj)
:parent-id (org-object-parent-id obj)
:children (copy-list (org-object-children obj))
:version (org-object-version obj)
:last-sync (org-object-last-sync obj)
:hash (org-object-hash obj)))
#+end_src
** Merkle Tree Integrity
#+begin_src lisp
(defun compute-merkle-hash (id type attributes content child-hashes)
(let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
(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))
(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
** Ingest (ingest-ast)
#+begin_src lisp
(defun ingest-ast (ast &optional parent-id)
(let* ((type (getf ast :type))
(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 (getf ast :raw-content) ""))))
(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-obj (gethash child-id *memory*)))
(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
: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)
id)))
#+end_src
** Snapshot history (~*object-store-snapshots*~)
A stack of CoW (copy-on-write) memory snapshots for rollback. Up to 20 snapshots are retained.
#+begin_src lisp
(defvar *object-store-snapshots* nil)
#+end_src
** Hash table copy utility
Used by the rollback system to restore saved memory state.
#+begin_src lisp
(defun copy-hash-table (hash-table)
"Creates an independent 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))
#+end_src
** Memory snapshot (snapshot-memory)
Captures a point-in-time copy of ~*memory*~. Each object is deep-copied so the snapshot is independent of ongoing mutations.
#+begin_src lisp
(defun snapshot-memory ()
"Creates a CoW snapshot of *memory* for rollback recovery."
(let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory*))))
(maphash (lambda (k v) (setf (gethash k snapshot) (deep-copy-org-object v))) *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 ~*memory*~ to a previous snapshot. By default restores the most recent snapshot (index 0).
#+begin_src lisp
(defun rollback-memory (&optional (index 0))
"Restores *memory* from a snapshot. INDEX 0 = most recent."
(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
** Persistence — snapshot path (~*memory-snapshot-path*~)
Configurable path for serialized memory state. Falls back to ~memory.snap~ in the home directory.
#+begin_src lisp
(defvar *memory-snapshot-path* nil)
(defun ensure-memory-snapshot-path ()
"Returns the path to the memory snapshot file, resolving env or default."
(or *memory-snapshot-path*
(let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH")))
(setf *memory-snapshot-path*
(or env-path (namestring (uiop:merge-pathnames* "memory.snap" (user-homedir-pathname))))))))
#+end_src
** Save to disk (save-memory-to-disk)
Serialises ~*memory*~ and ~*history-store*~ to a Lisp-readable file.
#+begin_src lisp
(defun save-memory-to-disk ()
"Writes the entire memory and history store to disk as a plist."
(let ((path (ensure-memory-snapshot-path)))
(with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create)
(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)))
#+end_src
** Load from disk (load-memory-from-disk)
Restores memory state from a previously saved snapshot file.
#+begin_src lisp
(defun load-memory-from-disk ()
"Reads memory state from disk and restores *memory* and *history-store*."
(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
* Test Suite
#+begin_src lisp :tangle ../tests/memory-tests.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(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)))
(clrhash opencortex::*memory*)
(let ((id1 (ingest-ast ast1)))
(let ((hash1 (org-object-hash (lookup-object id1))))
(clrhash opencortex::*memory*)
(let ((id2 (ingest-ast ast1)))
(is (equal hash1 (org-object-hash (lookup-object id2)))))))))
#+end_src

72
harness/perceive.lisp
View File

@@ -1,72 +0,0 @@
(in-package :opencortex)
(defvar *interrupt-flag* nil)
(defvar *async-sensors* '(:chat-message :delegation :user-command)
"Sensors that are processed in dedicated threads.")
(defvar *foveal-focus-id* nil
"The Org ID of the node the user is currently interacting with.")
(defun inject-stimulus (raw-message &key stream (depth 0))
"Inject a raw message into the signal processing pipeline."
(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*))))
(unless meta
(setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
(when stream
(setf (getf meta :reply-stream) stream))
(setf (getf raw-message :meta) meta)
(setf (getf raw-message :depth) depth)
(if async-p
(bt:make-thread
(lambda ()
(restart-case (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."))))))
(defun perceive-gate (signal)
"Stage 1 of the metabolic pipeline: Normalize sensory input."
(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))
(cond ((eq type :EVENT)
(case sensor
(:buffer-update
(let ((ast (getf payload :ast)))
(when ast
(snapshot-memory)
(ingest-ast ast))))
(:point-update
(let ((element (getf payload :element)))
(when element
(snapshot-memory)
(setf *foveal-focus-id* (getf element :id))
(ingest-ast element))))
(:interrupt
(setf *interrupt-flag* t))))
((eq type :RESPONSE)
(harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
(setf (getf signal :status) :perceived)
(setf (getf signal :foveal-focus) *foveal-focus-id*)
signal))

132
harness/reason.lisp
View File

@@ -1,132 +0,0 @@
(in-package :opencortex)
(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)
(setf (gethash name *probabilistic-backends*) fn))
(defun probabilistic-call (prompt &key
(system-prompt "You are the Probabilistic engine.")
(cascade nil)
(context nil))
(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
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
(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.")))))
(defun strip-markdown (text)
(if (and text (stringp text))
(let ((cleaned text))
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
(setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned ""))
(setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
(string-trim '(#\Space #\Newline #\Tab) cleaned))
text))
(defun normalize-plist-keywords (plist)
(when (listp plist)
(loop for (k v) on plist by #'cddr
collect (if (and (symbolp k) (not (keywordp k)))
(intern (string k) :keyword)
k)
collect v)))
(defun think (context)
(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"))
(rejection-trace (proto-get (proto-get context :payload) :rejection-trace))
(prompt-generator (when active-skill (skill-probabilistic-prompt active-skill)))
(raw-prompt (if prompt-generator
(funcall prompt-generator context)
(let ((p (proto-get (proto-get context :payload) :text)))
(if (and p (stringp p)) p "Maintain metabolic stasis."))))
(reflection-feedback (if rejection-trace
(format nil "~%~%PREVIOUS PROPOSAL REJECTED: ~a" rejection-trace)
""))
(system-prompt (format nil "IDENTITY: ~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a"
assistant-name reflection-feedback tool-belt global-context system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (strip-markdown thought)))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(normalize-plist-keywords parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
(defun deterministic-verify (proposed-action context)
(let ((current-action proposed-action)
(skills nil))
(maphash (lambda (name skill)
(declare (ignore name))
(when (skill-deterministic-fn skill)
(push skill skills)))
*skills-registry*)
(setf skills (sort skills #'> :key #'skill-priority))
(dolist (skill skills)
(let ((trigger (skill-trigger-fn skill))
(gate (skill-deterministic-fn skill)))
(when (or (null trigger) (ignore-errors (funcall trigger context)))
(let ((next-action (funcall gate current-action context)))
(when (and (listp next-action)
(member (proto-get next-action :type) '(:LOG :EVENT)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify next-action))
(when next-action (setf current-action next-action))))))
current-action))
(defun reason-gate (signal)
(let* ((type (proto-get signal :type))
(payload (proto-get signal :payload))
(sensor (proto-get payload :sensor)))
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
(return-from reason-gate signal))
(let ((retries 3)
(current-signal (copy-tree signal))
(last-rejection nil))
(loop
(when (<= retries 0)
(setf (getf signal :approved-action) last-rejection)
(setf (getf signal :status) :reasoned)
(return signal))
(when last-rejection
(setf (getf (getf current-signal :payload) :rejection-trace) last-rejection))
(let ((candidate (think current-signal)))
(if (and candidate (listp candidate))
(let ((verified (deterministic-verify candidate current-signal)))
(if (member (getf verified :type) '(:LOG :EVENT))
(progn (decf retries) (setf last-rejection verified))
(progn
(setf (getf signal :approved-action) verified)
(setf (getf signal :status) :reasoned)
(return signal))))
(progn
(setf (getf signal :approved-action) nil)
(setf (getf signal :status) :reasoned)
(return signal))))))))

229
harness/tui-client.org
View File

@@ -1,229 +0,0 @@
#+TITLE: OpenCortex TUI Client (Standalone)
#+STARTUP: content
#+FILETAGS: :tui:ux:client:
#+PROPERTY: header-args:lisp :tangle tui-client.lisp
* Overview
The TUI Client is a standalone ncurses application (built on Croatoan) that connects to the daemon via TCP. It provides a split-pane interface: a scrollable chat history window and a fixed input line at the bottom. Connected to the daemon at ~localhost:9105~, it sends user input as framed protocol messages and displays responses as they arrive from the daemon's background reader thread.
* Implementation
** Package Context
#+begin_src lisp
(in-package :cl-user)
(defpackage :opencortex.tui
(:use :cl :croatoan :usocket :bordeaux-threads)
(:export :main))
(in-package :opencortex.tui)
#+end_src
** Connection state
#+begin_src lisp
(defvar *daemon-host* "localhost")
#+end_src
#+begin_src lisp
(defvar *daemon-port* 9105)
#+end_src
#+begin_src lisp
(defvar *socket* nil)
#+end_src
#+begin_src lisp
(defvar *stream* nil)
#+end_src
** UI state
#+begin_src lisp
(defvar *chat-history* nil)
#+end_src
#+begin_src lisp
(defvar *input-list* nil)
#+end_src
#+begin_src lisp
(defvar *is-running* t)
#+end_src
** Thread-safe message queue
#+begin_src lisp
(defvar *queue-lock* (bt:make-lock "incoming-queue-lock"))
#+end_src
#+begin_src lisp
(defvar *incoming-msgs* nil)
#+end_src
** Utilities
#+begin_src lisp
(defun log-debug (msg &rest args)
(ignore-errors
(with-open-file (s "/tmp/opencortex-tui-debug.log" :direction :output :if-exists :append :if-does-not-exist :create)
(format s "[~a] " (get-universal-time))
(apply #'format s msg args)
(terpri s)
(finish-output s))))
(defun enqueue-msg (msg)
(bt:with-lock-held (*queue-lock*)
(setf *incoming-msgs* (append *incoming-msgs* (list msg)))))
(defun dequeue-msgs ()
(bt:with-lock-held (*queue-lock*)
(let ((msgs *incoming-msgs*))
(setf *incoming-msgs* nil)
msgs)))
#+end_src
** Rendering
#+begin_src lisp
(defun render-chat (win h)
(when (and win (integerp h))
(clear win)
(box win 0 0)
(let* ((view-height (- h 2))
(history (copy-list *chat-history*))
(len (length history))
(num-to-draw (min len view-height))
(slice (subseq history 0 num-to-draw)))
(loop for i from 0 below num-to-draw
for msg in (reverse slice)
do (when msg
(add-string win (format nil "│ ~a" msg) :y (1+ i) :x 2))))
(refresh win)))
#+end_src
** Input Handling
#+begin_src lisp
(defun handle-backspace ()
(pop *input-list*))
(defun handle-return (stream)
(let ((cmd (coerce (reverse *input-list*) 'string)))
(setf *input-list* nil)
(log-debug "SUBMITTING: '~a'" cmd)
(when (> (length cmd) 0)
(push (format nil "⬆ ~a" cmd) *chat-history*)
(handler-case
(progn
(if (and stream (open-stream-p stream))
(let* ((msg (list :TYPE :EVENT
:META (list :SOURCE :tui)
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))
(payload (format nil "~s" msg))
(len (length payload)))
(format stream "~6,'0x~a" len payload)
(finish-output stream)
(log-debug "SENT WIRE: ~a" payload))
(push "ERROR: Not connected." *chat-history*)))
(error (c)
(log-debug "SEND ERROR: ~a" c)
(push (format nil "ERROR: ~a" c) *chat-history*)
(setf *is-running* nil))))
(when (string= cmd "/exit") (setf *is-running* nil))
(when (string= cmd "/clear") (setf *chat-history* nil))))
#+end_src
** Background Reader
#+begin_src lisp
(defun start-background-reader (stream)
(bt:make-thread
(lambda ()
(loop while *is-running* do
(handler-case
(let* ((len-buf (make-string 6))
(count (read-sequence len-buf stream)))
(if (= count 6)
(let* ((msg-len (parse-integer len-buf :radix 16))
(msg-buf (make-string msg-len)))
(read-sequence msg-buf stream)
(log-debug "DAEMON MSG: ~a" msg-buf)
(let ((msg (read-from-string msg-buf)))
(let ((payload (getf msg :payload)))
(cond
((eq (getf payload :action) :handshake)
(enqueue-msg "* Connected *"))
(t
(let ((text (or (getf payload :text) (format nil "~a" payload))))
(enqueue-msg (format nil "⬇ ~a" text))))))))
(sleep 0.05)))
(error (c)
(when *is-running*
(log-debug "READER ERROR: ~a" c)
(enqueue-msg "ERROR: Connection lost.")
(setf *is-running* nil))))))
:name "opencortex-tui-reader"))
#+end_src
** Main Entry Point
#+begin_src lisp
(defun main ()
(log-debug "=== START ===")
(handler-case
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
(error (e) (format t "Offline: ~a~%" e) (return-from main)))
(setf *stream* (usocket:socket-stream *socket*))
(unwind-protect
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t)
(let* ((h (or (height scr) 24))
(w (or (width scr) 80))
(chat-h (- h 4))
(chat-win (make-instance 'window :height chat-h :width (- w 2) :y 1 :x 1))
(input-win (make-instance 'window :height 1 :width (- w 2) :y (- h 2) :x 1)))
(setf (input-blocking input-win) nil)
(start-background-reader *stream*)
(loop :while *is-running* :do
(let ((msgs (dequeue-msgs)))
(when msgs
(dolist (m msgs) (push m *chat-history*))
(render-chat chat-win chat-h)))
(let ((ch (get-char input-win)))
(when (and ch (not (equal ch -1)))
(log-debug "KEY: ~s" ch)
(cond
((or (eql ch 10) (eql ch 13) (eq ch :enter) (eql ch #\Newline) (eql ch #\Return))
(handle-return *stream*)
(render-chat chat-win chat-h))
((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
(handle-backspace))
((characterp ch)
(push ch *input-list*))
((integerp ch)
(let ((converted (code-char ch)))
(when (graphic-char-p converted)
(push converted *input-list*))))))
(clear input-win)
(add-string input-win (format nil "▶ ~a" (coerce (reverse *input-list*) 'string)) :y 0 :x 1)
(refresh input-win))
(sleep 0.01))))
(setf *is-running* nil)
(when *socket* (ignore-errors (usocket:socket-close *socket*)))))
#+end_src
** REPL test script (tmux)
Use this script to test the TUI non-interactively in a tmux session. It launches the TUI in a headless tmux window, sends text, and captures the output.
#+begin_src bash :tangle no
#!/bin/bash
SESSION="oct-tui-test"
tmux new-session -d -s "$SESSION" \
-e OC_CONFIG_DIR="$HOME/.config/opencortex" \
-e OC_DATA_DIR="$HOME/.local/share/opencortex" \
-e TERM="screen-256color" \
"sbcl --non-interactive \
--eval '(load (merge-pathnames \"quicklisp/setup.lisp\" (user-homedir-pathname)))' \
--eval '(push (truename \"$HOME/.local/share/opencortex/\") asdf:*central-registry*)' \
--eval '(ql:quickload :opencortex/tui)' \
--eval '(opencortex.tui:main)'"
sleep 5
tmux capture-pane -t "$SESSION" -p -S -20
tmux send-keys -t "$SESSION" 'hello' Enter
sleep 8
tmux capture-pane -t "$SESSION" -p -S -20
tmux send-keys -t "$SESSION" '/exit' Enter
sleep 1
tmux kill-session -t "$SESSION" 2>/dev/null || true
#+end_src

4
infrastructure/docker/docker-compose.yml
View File

@@ -1,9 +1,9 @@
services: services:
opencortex: passepartout:
build: build:
context: ../../ context: ../../
dockerfile: infrastructure/docker/Dockerfile dockerfile: infrastructure/docker/Dockerfile
container_name: opencortex container_name: passepartout
env_file: ../../.env env_file: ../../.env
volumes: volumes:
- ../../../..:/memex - ../../../..:/memex

15
infrastructure/passepartout.service Normal file
View File

@@ -0,0 +1,15 @@
[Unit]
Description=Passepartout Daemon
Documentation=https://github.com/amrgharbeia/opencortex
After=network.target
[Service]
Type=simple
User=%u
ExecStart=%h/projects/opencortex/passepartout daemon
Restart=on-failure
RestartSec=10
WorkingDirectory=%h/projects/opencortex
[Install]
WantedBy=default.target

63
harness/communication.lisp → lisp/core-communication.lisp
View File

@@ -1,27 +1,27 @@
(in-package :opencortex) (in-package :passepartout)
(defvar *actuator-registry* (make-hash-table :test 'equalp) (defvar *actuator-registry* (make-hash-table :test 'equalp)
"Global registry mapping target keywords to their physical actuator functions.") "Global registry mapping target keywords to their physical actuator functions.")
(defun register-actuator (name fn) (defun actuator-register (name fn)
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)." "Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
(let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword)))) (let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword))))
(setf (gethash key *actuator-registry*) fn))) (setf (gethash key *actuator-registry*) fn)))
(defun sanitize-protocol-message (msg) (defun protocol-message-sanitize (msg)
"Recursively strips non-serializable objects from a protocol plist." "Recursively strips non-serializable objects from a protocol plist."
(if (and msg (listp msg)) (if (and msg (listp msg))
(let ((clean nil)) (let ((clean nil))
(loop for (k v) on msg by #'cddr (loop for (k v) on msg by #'cddr
do (unless (member k '(:reply-stream :socket :stream)) do (unless (member k '(:reply-stream :socket :stream))
(push k clean) (push k clean)
(push (if (listp v) (sanitize-protocol-message v) v) clean))) (push (if (listp v) (protocol-message-sanitize v) v) clean)))
(nreverse clean)) (nreverse clean))
msg)) msg))
(defun frame-message (msg) (defun frame-message (msg)
"Serializes a message plist and prefixes it with a 6-character hex length." "Serializes a message plist and prefixes it with a 6-character hex length."
(let* ((sanitized (sanitize-protocol-message msg)) (let* ((sanitized (protocol-message-sanitize msg))
(payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized))) (payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
(len (length payload))) (len (length payload)))
(format nil "~6,'0x~a" len payload))) (format nil "~6,'0x~a" len payload)))
@@ -47,9 +47,9 @@
(error () :error))))))))) (error () :error)))))))))
(error () :error)))) (error () :error))))
(defvar *server-socket* nil) (defvar *daemon-socket* nil)
(defun handle-client-connection (socket) (defun client-handle-connection (socket)
"Handles a single TUI/CLI client connection in a dedicated thread." "Handles a single TUI/CLI client connection in a dedicated thread."
(let ((stream (usocket:socket-stream socket))) (let ((stream (usocket:socket-stream socket)))
(handler-case (handler-case
@@ -62,14 +62,13 @@
((eq msg :eof) (return)) ((eq msg :eof) (return))
((eq msg :error) (return)) ((eq msg :error) (return))
((eq (getf msg :type) :health-check) ((eq (getf msg :type) :health-check)
;; Handle health check request
(let ((health-msg (list :type :health-response (let ((health-msg (list :type :health-response
:status (or (and (boundp 'opencortex::*system-health*) :status (or (and (boundp 'passepartout::*system-health*)
(symbol-value 'opencortex::*system-health*)) (symbol-value 'passepartout::*system-health*))
:unknown) :unknown)
:checked-p (or (and (boundp 'opencortex::*health-check-ran*) :checked-p (or (and (boundp 'passepartout::*health-check-ran*)
(symbol-value 'opencortex::*health-check-ran*)) (symbol-value 'passepartout::*health-check-ran*))
nil)))) nil))))
(format stream "~a" (frame-message health-msg)) (format stream "~a" (frame-message health-msg))
(finish-output stream))) (finish-output stream)))
(t (inject-stimulus msg :stream stream)))))) (t (inject-stimulus msg :stream stream))))))
@@ -78,16 +77,16 @@
(defun start-daemon (&key (port 9105)) (defun start-daemon (&key (port 9105))
"Starts the network listener for TUI/CLI clients." "Starts the network listener for TUI/CLI clients."
(setf *server-socket* (usocket:socket-listen "127.0.0.1" port :reuse-address t)) (setf *daemon-socket* (usocket:socket-listen "127.0.0.1" port :reuse-address t))
(harness-log "DAEMON: Listening on localhost:~a" port) (harness-log "DAEMON: Listening on localhost:~a" port)
(bt:make-thread (bt:make-thread
(lambda () (lambda ()
(loop (loop
(let ((client-socket (usocket:socket-accept *server-socket*))) (let ((client-socket (usocket:socket-accept *daemon-socket*)))
(when client-socket (when client-socket
(bt:make-thread (lambda () (handle-client-connection client-socket)) (bt:make-thread (lambda () (client-handle-connection client-socket))
:name "opencortex-client-handler"))))) :name "passepartout-client-handler")))))
:name "opencortex-server-listener")) :name "passepartout-server-listener"))
(defun make-hello-message (version) (defun make-hello-message (version)
"Constructs the standard HELLO handshake message." "Constructs the standard HELLO handshake message."
@@ -95,3 +94,29 @@
:PAYLOAD (list :ACTION :handshake :PAYLOAD (list :ACTION :handshake
:VERSION version :VERSION version
:CAPABILITIES '(:AUTH :ORG-AST)))) :CAPABILITIES '(:AUTH :ORG-AST))))
(in-package :passepartout)
(defun protocol-schema-validate (msg)
"Strict structural validation for incoming protocol messages."
(unless (listp msg) (error "Message must be a plist"))
(let ((type (proto-get msg :type)))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS))
(error "Invalid message type '~a'" type))
t))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-communication-tests
(:use :cl :fiveam :passepartout)
(:export #:communication-protocol-suite))
(in-package :passepartout-communication-tests)
(def-suite communication-protocol-suite :description "Communication Protocol Suite")
(in-suite communication-protocol-suite)
(test test-framing
(let* ((msg '(:type :EVENT :payload (:action :handshake)))
(framed (frame-message msg)))
(is (string= "00002C" (string-upcase (subseq framed 0 6))))))

91
harness/context.lisp → lisp/core-context.lisp
View File

@@ -1,6 +1,6 @@
(in-package :opencortex) (in-package :passepartout)
(defun context-query-store (&key tag todo-state type) (defun context-query (&key tag todo-state type)
"Filters the Memory based on tags, todo states, or types." "Filters the Memory based on tags, todo states, or types."
(let ((results nil)) (let ((results nil))
(maphash (lambda (id obj) (maphash (lambda (id obj)
@@ -13,16 +13,16 @@
*memory*) *memory*)
results)) results))
(defun context-get-active-projects () (defun context-active-projects ()
"Returns headlines tagged as 'project' that are not yet marked DONE." "Returns headlines tagged as 'project' that are not yet marked DONE."
(remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE")) (remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE"))
(context-query-store :tag "project" :type :HEADLINE))) (context-query :tag "project" :type :HEADLINE)))
(defun context-get-recent-completed-tasks () (defun context-recent-tasks ()
"Retrieves recently finished tasks from the store." "Retrieves recently finished tasks from the store."
(context-query-store :todo-state "DONE" :type :HEADLINE)) (context-query :todo-state "DONE" :type :HEADLINE))
(defun context-list-all-skills () (defun context-skill-list ()
"Provides a sorted overview of currently loaded system capabilities." "Provides a sorted overview of currently loaded system capabilities."
(let ((results nil)) (let ((results nil))
(maphash (lambda (name skill) (maphash (lambda (name skill)
@@ -31,22 +31,22 @@
*skills-registry*) *skills-registry*)
(sort results #'> :key (lambda (x) (getf x :priority))))) (sort results #'> :key (lambda (x) (getf x :priority)))))
(defun context-get-skill-source (skill-name) (defun context-skill-source (skill-name)
"Reads the raw literate source of a specific skill for inspection." "Reads the raw literate source of a specific skill for inspection."
(let* ((filename (format nil "~a.org" skill-name)) (let* ((filename (format nil "~a.org" skill-name))
(data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "OC_DATA_DIR") (namestring (merge-pathnames ".local/share/opencortex/" (user-homedir-pathname)))))) (data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
(skills-dir (merge-pathnames "skills/" data-dir)) (skills-dir (merge-pathnames "skills/" data-dir))
(full-path (merge-pathnames filename skills-dir))) (full-path (merge-pathnames filename skills-dir)))
(if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil))) (if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
(defun context-get-system-logs (&optional limit) (defun context-logs (&optional limit)
"Retrieves the most recent lines from the harness's internal log." "Retrieves the most recent lines from the harness's internal log."
(let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20))) (let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20)))
(bt:with-lock-held (*logs-lock*) (bt:with-lock-held (*logs-lock*)
(let ((count (min log-limit (length *system-logs*)))) (let ((count (min log-limit (length *system-logs*))))
(subseq *system-logs* 0 count))))) (subseq *system-logs* 0 count)))))
(defun context-render-to-org (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil)) (defun context-object-render (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." "Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
(let* ((id (org-object-id obj)) (let* ((id (org-object-id obj))
(is-foveal (equal id foveal-id)) (is-foveal (equal id foveal-id))
@@ -77,14 +77,14 @@
(when child-obj (when child-obj
(let ((next-foveal (if is-foveal child-id foveal-id))) (let ((next-foveal (if is-foveal child-id foveal-id)))
(setf output (concatenate 'string output (setf output (concatenate 'string output
(context-render-to-org child-obj (context-object-render child-obj
:depth (1+ depth) :depth (1+ depth)
:foveal-id next-foveal :foveal-id next-foveal
:semantic-threshold threshold :semantic-threshold threshold
:foveal-vector foveal-vector)))))))) :foveal-vector foveal-vector))))))))
output)) output))
(defun context-resolve-path (path-string) (defun context-path-resolve (path-string)
"Expands environment variables and strips literal quotes from a path string." "Expands environment variables and strips literal quotes from a path string."
(let ((path (if (stringp path-string) (let ((path (if (stringp path-string)
(string-trim '(#\" #\' #\Space) path-string) (string-trim '(#\" #\' #\Space) path-string)
@@ -98,14 +98,14 @@
result) result)
path))) path)))
(defun context-object-privacy-filtered-p (obj) (defun context-privacy-filtered-p (obj)
"Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags." "Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags."
(let* ((attrs (org-object-attributes obj)) (let* ((attrs (org-object-attributes obj))
(tags (getf attrs :TAGS)) (tags (getf attrs :TAGS))
(privacy-tags (and (find-package :opencortex.skills.org-skill-bouncer) (privacy-tags (and (find-package :passepartout.security-dispatcher)
(symbol-value (symbol-value
(find-symbol "BOUNCER-PRIVACY-TAGS" (find-symbol "BOUNCER-PRIVACY-TAGS"
:opencortex.skills.org-skill-bouncer))))) :passepartout.security-dispatcher)))))
(when (and tags privacy-tags) (when (and tags privacy-tags)
(let ((tag-list (if (listp tags) tags (list tags)))) (let ((tag-list (if (listp tags) tags (list tags))))
(some (lambda (tag) (some (lambda (tag)
@@ -115,34 +115,49 @@
privacy-tags)) privacy-tags))
tag-list))))) tag-list)))))
(defun context-object-privacy-filtered-p (obj) (defun context-awareness-assemble (&optional signal)
"Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags."
(let* ((attrs (org-object-attributes obj))
(tags (getf attrs :TAGS))
(privacy-tags (and (find-package :opencortex.skills.org-skill-bouncer)
(symbol-value
(find-symbol "BOUNCER-PRIVACY-TAGS"
:opencortex.skills.org-skill-bouncer)))))
(when (and tags privacy-tags)
(let ((tag-list (if (listp tags) tags (list tags))))
(some (lambda (tag)
(some (lambda (private)
(string-equal (string-trim '(#\:) tag)
(string-trim '(#\:) private)))
privacy-tags))
tag-list)))))
(defun context-assemble-global-awareness (&optional signal)
"Produces a high-level skeletal outline of the current Memory for the LLM. "Produces a high-level skeletal outline of the current Memory for the LLM.
Privacy-filtered objects (matching *privacy-filter-tags*) are excluded." Privacy-filtered objects (matching bouncer-privacy-tags) are excluded."
(let* ((foveal-id (or (getf signal :foveal-focus) (let* ((foveal-id (or (getf signal :foveal-focus)
(ignore-errors (getf (getf signal :payload) :target-id)))) (ignore-errors (getf (getf signal :payload) :target-id))))
(all-projects (context-get-active-projects)) (all-projects (context-active-projects))
(projects (remove-if #'context-object-privacy-filtered-p all-projects)) (projects (remove-if #'context-privacy-filtered-p all-projects))
(output (format nil "GLOBAL MEMEX AWARENESS (Peripheral Vision):~%"))) (output (format nil "GLOBAL MEMEX AWARENESS (Peripheral Vision):~%")))
(if projects (if projects
(dolist (project projects) (dolist (project projects)
(setf output (concatenate 'string output (setf output (concatenate 'string output
(context-render-to-org project :foveal-id foveal-id)))) (context-object-render project :foveal-id foveal-id))))
(setf output (concatenate 'string output "No active projects found.~%"))) (setf output (concatenate 'string output "No active projects found.~%")))
output)) output))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-peripheral-vision-tests
(:use :cl :fiveam :passepartout)
(:export #:vision-suite))
(in-package :passepartout-peripheral-vision-tests)
(def-suite vision-suite :description "Verification of Foveal-Peripheral context model.")
(in-suite vision-suite)
(test test-foveal-rendering
(clrhash passepartout::*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)
(let ((output (context-awareness-assemble (list :foveal-focus "node-foveal"))))
(is (search "FOVEAL CONTENT" output))
(is (search "* Peripheral Node" output))
(is (not (search "PERIPHERAL CONTENT" output))))))
(test test-awareness-budget
(clrhash passepartout::*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-awareness-assemble)))
(is (search "Project 1" output))
(is (search "Project 2" output))))

113
harness/package.lisp → lisp/core-defpackage.lisp
View File

@@ -1,7 +1,6 @@
(defpackage :opencortex (defpackage :passepartout
(:use :cl) (:use :cl)
(:export (:export
;; --- communication protocol ---
#:frame-message #:frame-message
#:read-framed-message #:read-framed-message
#:PROTO-GET #:PROTO-GET
@@ -12,30 +11,20 @@
#:parse-message #:parse-message
#:make-hello-message #:make-hello-message
#:validate-communication-protocol-schema #:validate-communication-protocol-schema
;; --- Daemon Lifecycle ---
#:start-daemon #:start-daemon
#:stop-daemon #:stop-daemon
#:harness-log #:log-message
#:main #:main
;; --- Diagnostic Doctor ---
#:doctor-run-all #:doctor-run-all
#:doctor-main #:doctor-main
#:doctor-check-dependencies #:doctor-check-dependencies
#:doctor-check-env #:doctor-check-env
;; --- Setup Wizard ---
#:register-provider #:register-provider
#:system-ready-p #:system-ready-p
#:run-setup-wizard #:run-setup-wizard
;; --- Gateway Manager Skill ---
#:skill-gateway-register #:skill-gateway-register
#:skill-gateway-link #:skill-gateway-link
#:gateway-manager-main #:gateway-manager-main
;; --- Memory (CLOSOS) ---
#:ingest-ast #:ingest-ast
#:lookup-object #:lookup-object
#:list-objects-by-type #:list-objects-by-type
@@ -56,8 +45,6 @@
#:org-object-hash #:org-object-hash
#:snapshot-memory #:snapshot-memory
#:rollback-memory #:rollback-memory
;; --- Context API (Peripheral Vision) ---
#:context-query-store #:context-query-store
#:context-get-active-projects #:context-get-active-projects
#:context-get-recent-completed-tasks #:context-get-recent-completed-tasks
@@ -66,31 +53,27 @@
#:context-get-system-logs #:context-get-system-logs
#:context-resolve-path #:context-resolve-path
#:context-get-skill-telemetry #:context-get-skill-telemetry
#:harness-track-telemetry #:telemetry-track
#:context-assemble-global-awareness #:context-assemble-global-awareness
#:loop-process
;; --- Reactive Signal Pipeline --- #:loop-process
#:process-signal
#:perceive-gate #:perceive-gate
#:probabilistic-gate #:probabilistic-gate
#:consensus-gate #:consensus-gate
#:act-gate #:act-gate
#:reason-gate #:reason-gate
#:perceive-gate
#:dispatch-gate #:dispatch-gate
#:inject-stimulus #:inject-stimulus
#:initialize-actuators #:initialize-actuators
#:dispatch-action #:dispatch-action
#:register-actuator #:register-actuator
;; --- Skill Engine ---
#:load-skill-from-org #:load-skill-from-org
#:initialize-all-skills #:skill-initialize-all
#:load-skill-with-timeout #:load-skill-with-timeout
#:topological-sort-skills #:topological-sort-skills
#:validate-lisp-syntax #:validate-lisp-syntax
#:defskill #:defskill
#:*skills-registry* #:*skill-registry*
#:skill #:skill
#:skill-name #:skill-name
#:skill-priority #:skill-priority
@@ -98,22 +81,14 @@
#:skill-trigger-fn #:skill-trigger-fn
#:skill-probabilistic-prompt #:skill-probabilistic-prompt
#:skill-deterministic-fn #:skill-deterministic-fn
;; --- Tool Registry ---
#:def-cognitive-tool #:def-cognitive-tool
#:*cognitive-tools* #:*cognitive-tool-registry*
;; --- Engineering Standards Skill ---
#:verify-git-clean-p #:verify-git-clean-p
#:engineering-standards-verify-lisp #:engineering-standards-verify-lisp
#:engineering-standards-format-lisp #:engineering-standards-format-lisp
;; --- Literate Programming Skill ---
#:literate-check-block-balance #:literate-check-block-balance
#:check-tangle-sync #:check-tangle-sync
#:*tangle-targets* #:*tangle-targets*
;; --- Utils Org Skill ---
#:utils-org-read-file #:utils-org-read-file
#:utils-org-write-file #:utils-org-write-file
#:utils-org-add-headline #:utils-org-add-headline
@@ -125,8 +100,6 @@
#:utils-org-id-format #:utils-org-id-format
#:utils-org-ast-to-org #:utils-org-ast-to-org
#:utils-org-modify #:utils-org-modify
;; --- Utils Lisp Skill ---
#:utils-lisp-validate #:utils-lisp-validate
#:utils-lisp-check-structural #:utils-lisp-check-structural
#:utils-lisp-check-syntactic #:utils-lisp-check-syntactic
@@ -139,13 +112,9 @@
#:utils-lisp-structural-inject #:utils-lisp-structural-inject
#:utils-lisp-structural-slurp #:utils-lisp-structural-slurp
#:utils-lisp-register #:utils-lisp-register
;; --- Config Manager & Diagnostics Skill ---
#:get-oc-config-dir #:get-oc-config-dir
#:prompt-for #:prompt-for
#:save-secret #:save-secret
;; --- Tool Permissions Skill ---
#:get-tool-permission #:get-tool-permission
#:set-tool-permission #:set-tool-permission
#:check-tool-permission-gate #:check-tool-permission-gate
@@ -155,60 +124,51 @@
#:cognitive-tool-parameters #:cognitive-tool-parameters
#:cognitive-tool-guard #:cognitive-tool-guard
#:cognitive-tool-body #:cognitive-tool-body
;; --- Emacs Client Registry ---
#:*emacs-clients* #:*emacs-clients*
#:*clients-lock* #:*clients-lock*
#:register-emacs-client #:register-emacs-client
#:unregister-emacs-client #:unregister-emacs-client
;; --- Probabilistic Engine ---
#:ask-probabilistic #:ask-probabilistic
#:register-probabilistic-backend #:register-probabilistic-backend
#:distill-prompt #:distill-prompt
#:*probabilistic-backends*
#:*provider-cascade* #:*provider-cascade*
;; --- Security Vault ---
#:vault-get-secret #:vault-get-secret
#:vault-set-secret #:vault-set-secret
#:memory-objects-by-attribute
;; --- Deterministic Logic ---
#:list-objects-with-attribute
#:deterministic-verify #:deterministic-verify
;; --- AST Helpers ---
#:find-headline-missing-id)) #:find-headline-missing-id))
(in-package :opencortex) (in-package :passepartout)
(defun proto-get (plist key) (defun plist-get (plist key)
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions." "Robust plist accessor — checks both :KEY and :key variants."
(let* ((s (string key)) (let* ((s (string key))
(up (intern (string-upcase s) :keyword)) (up (intern (string-upcase s) :keyword))
(dn (intern (string-downcase s) :keyword))) (dn (intern (string-downcase s) :keyword)))
(or (getf plist up) (getf plist dn)))) (or (getf plist up) (getf plist dn))))
(defvar *system-logs* nil) (defvar *log-buffer* nil)
(defvar *logs-lock* (bordeaux-threads:make-lock "harness-logs-lock")) (defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock"))
(defvar *max-log-history* 100) (defvar *log-limit* 100)
(defvar *skills-registry* (make-hash-table :test 'equal) (defvar *skill-registry* (make-hash-table :test 'equal)
"Global registry of all loaded skills.") "Global registry of all loaded skills.")
(defvar *skill-telemetry* (make-hash-table :test 'equal)) (defvar *telemetry-table* (make-hash-table :test 'equal))
(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock")) (defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
(defun harness-track-telemetry (skill-name duration status) (defun telemetry-track (skill-name duration status)
"Updates performance metrics for a specific skill. Status should be :success or :rejected." "Updates performance metrics for a skill. STATUS is :success or :rejected."
(when skill-name (when skill-name
(bordeaux-threads:with-lock-held (*telemetry-lock*) (bordeaux-threads:with-lock-held (*telemetry-lock*)
(let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0)))) (let ((entry (or (gethash skill-name *telemetry-table*) (list :executions 0 :total-time 0 :failures 0))))
(incf (getf entry :executions)) (incf (getf entry :executions))
(incf (getf entry :total-time) duration) (incf (getf entry :total-time) duration)
(when (eq status :rejected) (incf (getf entry :failures))) (when (eq status :rejected) (incf (getf entry :failures)))
(setf (gethash skill-name *skill-telemetry*) entry))))) (setf (gethash skill-name *telemetry-table*) entry)))))
(defvar *cognitive-tools* (make-hash-table :test 'equal)) (defvar *cognitive-tool-registry* (make-hash-table :test 'equal))
(defstruct cognitive-tool (defstruct cognitive-tool
name name
@@ -218,16 +178,16 @@
body) body)
(defmacro def-cognitive-tool (name description parameters &key guard body) (defmacro def-cognitive-tool (name description parameters &key guard body)
"Registers a new cognitive tool into the global registry. Parameters must be a list of property lists." "Registers a cognitive tool. PARAMETERS is a list of plists, one per parameter."
`(setf (gethash (string-downcase (string ',name)) *cognitive-tools*) `(setf (gethash (string-downcase (string ',name)) *cognitive-tool-registry*)
(make-cognitive-tool :name (string-downcase (string ',name)) (make-cognitive-tool :name (string-downcase (string ',name))
:description ,description :description ,description
:parameters ',parameters :parameters ',parameters
:guard ,guard :guard ,guard
:body ,body))) :body ,body)))
(defun generate-tool-belt-prompt () (defun cognitive-tool-prompt ()
"Generates a prompt string describing all available cognitive tools." "Serialises all registered tools into a prompt string for the LLM."
(let ((descriptions nil)) (let ((descriptions nil))
(maphash (lambda (k tool) (maphash (lambda (k tool)
(declare (ignore k)) (declare (ignore k))
@@ -236,22 +196,21 @@
(cognitive-tool-description tool) (cognitive-tool-description tool)
(cognitive-tool-parameters tool)) (cognitive-tool-parameters tool))
descriptions)) descriptions))
*cognitive-tools*) *cognitive-tool-registry*)
(if descriptions (if descriptions
(format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<))) (format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<)))
"No tools registered."))) "No tools registered.")))
(defun harness-log (msg &rest args) (defun log-message (msg &rest args)
"Centralized logging for the harness." "Centralized, thread-safe logging for the harness."
(let ((formatted-msg (apply #'format nil msg args))) (let ((formatted-msg (apply #'format nil msg args)))
(bordeaux-threads:with-lock-held (*logs-lock*) (bordeaux-threads:with-lock-held (*log-lock*)
(push formatted-msg *system-logs*) (push formatted-msg *log-buffer*)
(when (> (length *system-logs*) *max-log-history*) (when (> (length *log-buffer*) *log-limit*)
(setq *system-logs* (subseq *system-logs* 0 *max-log-history*)))) (setq *log-buffer* (subseq *log-buffer* 0 *log-limit*))))
(format t "~a~%" formatted-msg) (format t "~a~%" formatted-msg)
(finish-output))) (finish-output)))
;; --- Debugger Hook ---
(setf *debugger-hook* (lambda (condition hook) (setf *debugger-hook* (lambda (condition hook)
"Friendly error handler - shows diagnostic message instead of raw debugger." "Friendly error handler - shows diagnostic message instead of raw debugger."
(declare (ignore hook)) (declare (ignore hook))
@@ -259,7 +218,7 @@
(format t "┌─────────────────────────────────────────────┐~%") (format t "┌─────────────────────────────────────────────┐~%")
(format t "│ ERROR: ~A~%" (type-of condition)) (format t "│ ERROR: ~A~%" (type-of condition))
(format t "│~%") (format t "│~%")
(format t "│ Run: opencortex doctor~%") (format t "│ Run: passepartout doctor~%")
(format t "│ For system diagnostics~%") (format t "│ For system diagnostics~%")
(format t "└─────────────────────────────────────────────┘~%") (format t "└─────────────────────────────────────────────┘~%")
(format t "~%") (format t "~%")

63
harness/act.lisp → lisp/core-loop-act.lisp
View File

@@ -1,24 +1,24 @@
(in-package :opencortex) (in-package :passepartout)
(defvar *default-actuator* :cli (defvar *actuator-default* :cli
"The actuator used when no explicit target is specified.") "The actuator used when no explicit target is specified.")
(defvar *silent-actuators* '(:cli :system-message :emacs) (defvar *actuator-silent* '(:cli :system-message :emacs)
"List of actuators that don't generate tool-output feedback.") "List of actuators that don't generate tool-output feedback.")
(defun initialize-actuators () (defun actuator-initialize ()
"Register core actuators and load configuration." "Register core actuators and load configuration."
(let ((def (uiop:getenv "DEFAULT_ACTUATOR")) (let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
(silent (uiop:getenv "SILENT_ACTUATORS"))) (silent (uiop:getenv "SILENT_ACTUATORS")))
(when def (when def
(setf *default-actuator* (intern (string-upcase def) :keyword))) (setf *actuator-default* (intern (string-upcase def) :keyword)))
(when silent (when silent
(setf *silent-actuators* (setf *actuator-silent*
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword)) (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
(uiop:split-string silent :separator '(#\,)))))) (uiop:split-string silent :separator '(#\,))))))
(register-actuator :system #'execute-system-action) (register-actuator :system #'action-system-execute)
(register-actuator :tool #'execute-tool-action) (register-actuator :tool #'action-tool-execute)
(register-actuator :tui (lambda (action context) (register-actuator :tui (lambda (action context)
(declare (ignore context)) (declare (ignore context))
@@ -28,16 +28,16 @@
(format stream "~a" (frame-message action)) (format stream "~a" (frame-message action))
(finish-output stream)))))) (finish-output stream))))))
(defun dispatch-action (action context) (defun action-dispatch (action context)
"Route an approved action to its registered actuator." "Route an approved action to its registered actuator."
(let ((payload (proto-get action :payload))) (let ((payload (proto-get action :payload)))
(when (eq (proto-get payload :sensor) :heartbeat) (when (eq (proto-get payload :sensor) :heartbeat)
(return-from dispatch-action nil)) (return-from action-dispatch nil))
(when (and action (listp action)) (when (and action (listp action))
(let* ((meta (proto-get context :meta)) (let* ((meta (proto-get context :meta))
(source (proto-get meta :source)) (source (proto-get meta :source))
(raw-target (or (proto-get action :target) source *default-actuator*)) (raw-target (or (proto-get action :target) source *actuator-default*))
(target (intern (string-upcase (string raw-target)) :keyword)) (target (intern (string-upcase (string raw-target)) :keyword))
(actuator-fn (gethash target *actuator-registry*))) (actuator-fn (gethash target *actuator-registry*)))
(when (and meta (null (getf action :meta))) (when (and meta (null (getf action :meta)))
@@ -46,7 +46,7 @@
(funcall actuator-fn action context) (funcall actuator-fn action context)
(harness-log "ACT ERROR: No actuator registered for '~s'" target)))))) (harness-log "ACT ERROR: No actuator registered for '~s'" target))))))
(defun execute-system-action (action context) (defun action-system-execute (action context)
"Execute internal harness commands." "Execute internal harness commands."
(declare (ignore context)) (declare (ignore context))
(let* ((payload (getf action :payload)) (let* ((payload (getf action :payload))
@@ -59,7 +59,7 @@
(t (t
(harness-log "ACT ERROR [System]: Unknown command '~s'" cmd))))) (harness-log "ACT ERROR [System]: Unknown command '~s'" cmd)))))
(defun execute-tool-action (action context) (defun action-tool-execute (action context)
"Execute a registered cognitive tool." "Execute a registered cognitive tool."
(let* ((payload (getf action :payload)) (let* ((payload (getf action :payload))
(tool-name (getf payload :tool)) (tool-name (getf payload :tool))
@@ -73,8 +73,8 @@
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args)) (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))) (result (funcall (cognitive-tool-body tool) clean-args)))
(when source (when source
(dispatch-action (list :TYPE :REQUEST :TARGET source (action-dispatch (list :TYPE :REQUEST :TARGET source
:PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result))) :PAYLOAD (list :ACTION :MESSAGE :TEXT (tool-result-format tool-name result)))
context)) context))
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))) :PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name)))
@@ -84,7 +84,7 @@
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :MESSAGE (format nil "Tool '~a' not found" tool-name)))))) :PAYLOAD (list :SENSOR :tool-error :MESSAGE (format nil "Tool '~a' not found" tool-name))))))
(defun format-tool-result (tool-name result) (defun tool-result-format (tool-name result)
"Format a tool result for display." "Format a tool result for display."
(if (listp result) (if (listp result)
(let ((status (getf result :status)) (let ((status (getf result :status))
@@ -96,7 +96,7 @@
(t (format nil "TOOL [~a] RESULT: ~s" tool-name result)))) (t (format nil "TOOL [~a] RESULT: ~s" tool-name result))))
(format nil "TOOL [~a] RESULT: ~a" tool-name result))) (format nil "TOOL [~a] RESULT: ~a" tool-name result)))
(defun act-gate (signal) (defun loop-gate-act (signal)
"Final stage of the metabolic pipeline: Actuation." "Final stage of the metabolic pipeline: Actuation."
(let* ((approved (getf signal :approved-action)) (let* ((approved (getf signal :approved-action))
(type (getf signal :type)) (type (getf signal :type))
@@ -116,18 +116,37 @@
(setf approved verified))))) (setf approved verified)))))
(case type (case type
(:REQUEST (dispatch-action signal signal)) (:REQUEST (action-dispatch signal signal))
(:LOG (dispatch-action signal signal)) (:LOG (action-dispatch signal signal))
(:EVENT (:EVENT
(if approved (if approved
(let* ((target (getf approved :target)) (let* ((target (getf approved :target))
(result (dispatch-action approved signal))) (result (action-dispatch approved signal)))
(cond (cond
((and (listp result) (member (getf result :type) '(:EVENT :LOG))) ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
(setf feedback result)) (setf feedback result))
((and result (not (member target *silent-actuators*))) ((and result (not (member target *actuator-silent*)))
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
:payload (list :sensor :tool-output :result result :tool approved)))))) :payload (list :sensor :tool-output :result result :tool approved))))))
(when source (dispatch-action signal signal))))) (when source (action-dispatch signal signal)))))
(setf (getf signal :status) :acted) (setf (getf signal :status) :acted)
feedback)) feedback))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-pipeline-act-tests
(:use :cl :fiveam :passepartout)
(:export #:pipeline-act-suite))
(in-package :passepartout-pipeline-act-tests)
(def-suite pipeline-act-suite :description "Test suite for Act pipeline")
(in-suite pipeline-act-suite)
(test test-loop-gate-act-basic
(clrhash passepartout::*skills-registry*)
(let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
(result (loop-gate-act signal)))
(is (eq :acted (getf signal :status)))
(is (null result))))

66
harness/perceive.org → lisp/core-loop-perceive.lisp
View File

@@ -1,42 +1,20 @@
#+TITLE: Stage 1: Perceive (perceive.lisp) (in-package :passepartout)
#+AUTHOR: Agent
#+FILETAGS: :harness:perceive:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle perceive.lisp
* Overview (defvar *loop-interrupt* nil)
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.
* Implementation (defvar *loop-async-sensors* '(:chat-message :delegation :user-command)
** Package Context
#+begin_src lisp
(in-package :opencortex)
#+end_src
** Interrupt Handling
#+begin_src lisp
(defvar *interrupt-flag* nil)
#+end_src
** Sensor Configuration
#+begin_src lisp
(defvar *async-sensors* '(:chat-message :delegation :user-command)
"Sensors that are processed in dedicated threads.") "Sensors that are processed in dedicated threads.")
(defvar *foveal-focus-id* nil (defvar *loop-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.")
#+end_src
** Stimulus Injection (inject-stimulus) (defun stimulus-inject (raw-message &key stream (depth 0))
#+begin_src lisp
(defun inject-stimulus (raw-message &key stream (depth 0))
"Inject a raw message into the signal processing pipeline." "Inject a raw message into the signal processing pipeline."
(let* ((payload (getf raw-message :payload)) (let* ((payload (getf raw-message :payload))
(sensor (getf payload :sensor)) (sensor (getf payload :sensor))
(meta (getf raw-message :meta)) (meta (getf raw-message :meta))
(async-p (or (getf payload :async-p) (async-p (or (getf payload :async-p)
(member sensor *async-sensors*)))) (member sensor *loop-async-sensors*))))
(unless meta (unless meta
(setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal"))) (setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
@@ -52,7 +30,7 @@ The Perceive stage is the "sensory cortex" of OpenCortex. Its job is to take raw
(lambda () (lambda ()
(restart-case (process-signal raw-message) (restart-case (process-signal raw-message)
(skip-event () nil))) (skip-event () nil)))
:name "opencortex-async-task") :name "passepartout-async-task")
(restart-case (restart-case
(handler-bind ((error (lambda (c) (handler-bind ((error (lambda (c)
@@ -61,11 +39,8 @@ The Perceive stage is the "sensory cortex" of OpenCortex. Its job is to take raw
(process-signal raw-message)) (process-signal raw-message))
(skip-event () (skip-event ()
(harness-log "SYSTEM RECOVERY: Stimulus dropped.")))))) (harness-log "SYSTEM RECOVERY: Stimulus dropped."))))))
#+end_src
** Perceive Gate (perceive-gate) (defun loop-gate-perceive (signal)
#+begin_src lisp
(defun perceive-gate (signal)
"Stage 1 of the metabolic pipeline: Normalize sensory input." "Stage 1 of the metabolic pipeline: Normalize sensory input."
(let* ((payload (getf signal :payload)) (let* ((payload (getf signal :payload))
(type (getf signal :type)) (type (getf signal :type))
@@ -86,41 +61,36 @@ The Perceive stage is the "sensory cortex" of OpenCortex. Its job is to take raw
(let ((element (getf payload :element))) (let ((element (getf payload :element)))
(when element (when element
(snapshot-memory) (snapshot-memory)
(setf *foveal-focus-id* (getf element :id)) (setf *loop-focus-id* (getf element :id))
(ingest-ast element)))) (ingest-ast element))))
(:interrupt (:interrupt
(setf *interrupt-flag* t)))) (setf *loop-interrupt* t))))
((eq type :RESPONSE) ((eq type :RESPONSE)
(harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status)))) (harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
(setf (getf signal :status) :perceived) (setf (getf signal :status) :perceived)
(setf (getf signal :foveal-focus) *foveal-focus-id*) (setf (getf signal :foveal-focus) *loop-focus-id*)
signal)) signal))
#+end_src
* Test Suite
#+begin_src lisp :tangle ../tests/pipeline-perceive-tests.lisp
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (ql:quickload :fiveam :silent t))
(defpackage :opencortex-pipeline-perceive-tests (defpackage :passepartout-pipeline-perceive-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :passepartout)
(:export #:pipeline-perceive-suite)) (:export #:pipeline-perceive-suite))
(in-package :opencortex-pipeline-perceive-tests) (in-package :passepartout-pipeline-perceive-tests)
(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline") (def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline")
(in-suite pipeline-perceive-suite) (in-suite pipeline-perceive-suite)
(test test-perceive-gate (test test-loop-gate-perceive
(clrhash opencortex::*memory*) (clrhash passepartout::*memory*)
(let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil)))) (let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
(result (perceive-gate signal))) (result (loop-gate-perceive signal)))
(is (eq :perceived (getf result :status))) (is (eq :perceived (getf result :status)))
(is (not (null (gethash "test-node" opencortex::*memory*)))))) (is (not (null (gethash "test-node" passepartout::*memory*))))))
(test test-depth-limiting (test test-depth-limiting
(let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat)))) (let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
(is (null (process-signal runaway-signal))))) (is (null (process-signal runaway-signal)))))
#+end_src

94
harness/reason.org → lisp/core-loop-reason.lisp
View File

@@ -1,56 +1,27 @@
#+TITLE: Stage 2: Reason (reason.lisp) (in-package :passepartout)
#+AUTHOR: Agent
#+FILETAGS: :harness:reason:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle reason.lisp
* Overview (defvar *backend-registry* (make-hash-table :test 'equal))
The Reason stage implements the core Innovation of OpenCortex: the separation of probabilistic reasoning (neural/LLM) from deterministic verification (logic/safety).
* Implementation
** Package Context
#+begin_src lisp
(in-package :opencortex)
#+end_src
** Probabilistic Engine state
~*probabilistic-backends*~ is the hash table mapping provider keywords to backend functions. ~*provider-cascade*~ is the ordered list of providers to try. ~*model-selector-fn*~ is an optional function that selects a model per request. ~*consensus-enabled-p*~ enables multi-provider agreement.
#+begin_src lisp
(defvar *probabilistic-backends* (make-hash-table :test 'equal))
#+end_src
#+begin_src lisp
(defvar *provider-cascade* nil) (defvar *provider-cascade* nil)
#+end_src
#+begin_src lisp (defvar *model-selector* nil)
(defvar *model-selector-fn* nil)
#+end_src
#+begin_src lisp (defvar *consensus-enabled* nil)
(defvar *consensus-enabled-p* nil)
#+end_src
** Backend Registration (register-probabilistic-backend) (defun backend-register (name fn)
#+begin_src lisp (setf (gethash name *backend-registry*) fn))
(defun register-probabilistic-backend (name fn)
(setf (gethash name *probabilistic-backends*) fn))
#+end_src
** Cascade Dispatch (probabilistic-call) (defun backend-cascade-call (prompt &key
#+begin_src lisp
(defun probabilistic-call (prompt &key
(system-prompt "You are the Probabilistic engine.") (system-prompt "You are the Probabilistic engine.")
(cascade nil) (cascade nil)
(context nil)) (context nil))
(let ((backends (or cascade *provider-cascade*))) (let ((backends (or cascade *provider-cascade*)))
(or (dolist (backend backends) (or (dolist (backend backends)
(let ((backend-fn (gethash backend *probabilistic-backends*))) (let ((backend-fn (gethash backend *backend-registry*)))
(when backend-fn (when backend-fn
(harness-log "PROBABILISTIC: Attempting backend ~a..." backend) (harness-log "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model (when *model-selector-fn* (let* ((model (when *model-selector*
(funcall *model-selector-fn* backend context))) (funcall *model-selector* backend context)))
(result (if model (result (if model
(funcall backend-fn prompt system-prompt :model model) (funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt)))) (funcall backend-fn prompt system-prompt))))
@@ -63,11 +34,8 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
backend (getf result :message)))))))) backend (getf result :message))))))))
(list :type :LOG (list :type :LOG
:payload (list :text "Neural Cascade Failure: All providers exhausted."))))) :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
#+end_src
** Cognitive Proposal Generation (Think) (defun markdown-strip (text)
#+begin_src lisp
(defun strip-markdown (text)
(if (and text (stringp text)) (if (and text (stringp text))
(let ((cleaned text)) (let ((cleaned text))
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned "")) (setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
@@ -76,7 +44,7 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
(string-trim '(#\Space #\Newline #\Tab) cleaned)) (string-trim '(#\Space #\Newline #\Tab) cleaned))
text)) text))
(defun normalize-plist-keywords (plist) (defun plist-keywords-normalize (plist)
(when (listp plist) (when (listp plist)
(loop for (k v) on plist by #'cddr (loop for (k v) on plist by #'cddr
collect (if (and (symbolp k) (not (keywordp k))) collect (if (and (symbolp k) (not (keywordp k)))
@@ -112,21 +80,18 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
(system-prompt (format nil "IDENTITY: ~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a~%~a" (system-prompt (format nil "IDENTITY: ~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a~%~a"
assistant-name reflection-feedback tool-belt global-context system-logs assistant-name reflection-feedback tool-belt global-context system-logs
(or skill-augments "")))) (or skill-augments ""))))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context)) (let* ((thought (backend-cascade-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (strip-markdown thought))) (cleaned (markdown-strip thought)))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[))) (if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case (handler-case
(let ((parsed (read-from-string cleaned))) (let ((parsed (read-from-string cleaned)))
(if (listp parsed) (if (listp parsed)
(normalize-plist-keywords parsed) (plist-keywords-normalize parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine.")))) (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine.")))) (error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine.")))))) (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
#+end_src
** Deterministic Engine (Verification) (defun cognitive-verify (proposed-action context)
#+begin_src lisp
(defun deterministic-verify (proposed-action context)
(let ((current-action proposed-action) (let ((current-action proposed-action)
(skills nil)) (skills nil))
(maphash (lambda (name skill) (maphash (lambda (name skill)
@@ -143,19 +108,16 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
(when (and (listp next-action) (when (and (listp next-action)
(member (proto-get next-action :type) '(:LOG :EVENT))) (member (proto-get next-action :type) '(:LOG :EVENT)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill)) (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify next-action)) (return-from cognitive-verify next-action))
(when next-action (setf current-action next-action)))))) (when next-action (setf current-action next-action))))))
current-action)) current-action))
#+end_src
** Reason Gate (Stage 2) (defun loop-gate-reason (signal)
#+begin_src lisp
(defun reason-gate (signal)
(let* ((type (proto-get signal :type)) (let* ((type (proto-get signal :type))
(payload (proto-get signal :payload)) (payload (proto-get signal :payload))
(sensor (proto-get payload :sensor))) (sensor (proto-get payload :sensor)))
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message))) (unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
(return-from reason-gate signal)) (return-from loop-gate-reason signal))
(let ((retries 3) (let ((retries 3)
(current-signal (copy-tree signal)) (current-signal (copy-tree signal))
(last-rejection nil)) (last-rejection nil))
@@ -168,7 +130,7 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
(setf (getf (getf current-signal :payload) :rejection-trace) last-rejection)) (setf (getf (getf current-signal :payload) :rejection-trace) last-rejection))
(let ((candidate (think current-signal))) (let ((candidate (think current-signal)))
(if (and candidate (listp candidate)) (if (and candidate (listp candidate))
(let ((verified (deterministic-verify candidate current-signal))) (let ((verified (cognitive-verify candidate current-signal)))
(if (member (getf verified :type) '(:LOG :EVENT)) (if (member (getf verified :type) '(:LOG :EVENT))
(progn (decf retries) (setf last-rejection verified)) (progn (decf retries) (setf last-rejection verified))
(progn (progn
@@ -179,25 +141,22 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
(setf (getf signal :approved-action) nil) (setf (getf signal :approved-action) nil)
(setf (getf signal :status) :reasoned) (setf (getf signal :status) :reasoned)
(return signal)))))))) (return signal))))))))
#+end_src
* Test Suite
#+begin_src lisp :tangle ../tests/pipeline-reason-tests.lisp
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (ql:quickload :fiveam :silent t))
(defpackage :opencortex-pipeline-reason-tests (defpackage :passepartout-pipeline-reason-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :passepartout)
(:export #:pipeline-reason-suite)) (:export #:pipeline-reason-suite))
(in-package :opencortex-pipeline-reason-tests) (in-package :passepartout-pipeline-reason-tests)
(def-suite pipeline-reason-suite :description "Test suite for Reason pipeline") (def-suite pipeline-reason-suite :description "Test suite for Reason pipeline")
(in-suite pipeline-reason-suite) (in-suite pipeline-reason-suite)
(test test-decide-gate-safety (test test-decide-gate-safety
(clrhash opencortex::*skills-registry*) (clrhash passepartout::*skills-registry*)
(opencortex::defskill :mock-safety (passepartout::defskill :mock-safety
:priority 50 :priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) t) :trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic (lambda (action ctx) :deterministic (lambda (action ctx)
@@ -207,6 +166,5 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
action))) action)))
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "rm -rf /"))) (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "rm -rf /")))
(signal '(:type :EVENT :payload (:sensor :user-input))) (signal '(:type :EVENT :payload (:sensor :user-input)))
(result (deterministic-verify candidate signal))) (result (cognitive-verify candidate signal)))
(is (eq :LOG (getf result :type))))) (is (eq :LOG (getf result :type)))))
#+end_src

86
harness/loop.org → lisp/core-loop.lisp
View File

@@ -1,34 +1,15 @@
#+TITLE: The Metabolic Loop (loop.lisp) (in-package :passepartout)
#+AUTHOR: Agent
#+FILETAGS: :harness:loop:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle loop.lisp
* Overview
The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous processing of signals from perception through cognition to action.
* Implementation
** Package Context
#+begin_src lisp
(in-package :opencortex)
#+end_src
** Global Variables (Thread-Safe)
#+begin_src lisp
(defvar *interrupt-flag* nil (defvar *interrupt-flag* nil
"Atomic flag set by signal handlers to trigger graceful shutdown.") "Atomic flag set by signal handlers to trigger graceful shutdown.")
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock") (defvar *loop-interrupt-lock* (bt:make-lock "harness-interrupt-lock")
"Mutex protecting *interrupt-flag* access.") "Mutex protecting *interrupt-flag* access.")
(defvar *heartbeat-thread* nil (defvar *heartbeat-thread* nil
"Handle to the heartbeat thread.") "Handle to the heartbeat thread.")
#+end_src
** Core Engine (process-signal) (defun loop-process (signal)
#+begin_src 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."
(let ((current-signal signal)) (let ((current-signal signal))
(loop while current-signal do (loop while current-signal do
@@ -38,7 +19,7 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
(harness-log "METABOLISM ERROR: Max recursion depth reached.") (harness-log "METABOLISM ERROR: Max recursion depth reached.")
(return nil)) (return nil))
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
(harness-log "METABOLISM: Interrupted by shutdown signal.") (harness-log "METABOLISM: Interrupted by shutdown signal.")
(return nil)) (return nil))
@@ -63,18 +44,15 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
(setf current-signal (setf current-signal
(list :type :EVENT :depth (1+ depth) :meta meta (list :type :EVENT :depth (1+ depth) :meta meta
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth))))))))))) :payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
#+end_src
** Heartbeat Mechanism (defvar *memory-auto-save-interval* 300)
#+begin_src lisp
(defvar *auto-save-interval* 300)
(defvar *heartbeat-save-counter* 0) (defvar *heartbeat-save-counter* 0)
(defun start-heartbeat () (defun heartbeat-start ()
"Starts the background heartbeat thread." "Starts the background heartbeat thread."
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)) (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*))) (auto-save (or (ignore-errors (parse-integer (uiop:getenv "MEMORY_AUTO_SAVE_INTERVAL"))) *memory-auto-save-interval*)))
(setf *auto-save-interval* auto-save) (setf *memory-auto-save-interval* auto-save)
(setf *heartbeat-save-counter* 0) (setf *heartbeat-save-counter* 0)
(setf *heartbeat-thread* (setf *heartbeat-thread*
@@ -83,31 +61,22 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
(loop (loop
(sleep interval) (sleep interval)
(incf *heartbeat-save-counter*) (incf *heartbeat-save-counter*)
(when (>= *heartbeat-save-counter* (/ *auto-save-interval* interval)) (when (>= *heartbeat-save-counter* (/ *memory-auto-save-interval* interval))
(setf *heartbeat-save-counter* 0) (setf *heartbeat-save-counter* 0)
(save-memory-to-disk)) (save-memory-to-disk))
(inject-stimulus (inject-stimulus
(list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time)))))) (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
:name "opencortex-heartbeat")))) :name "passepartout-heartbeat"))))
#+end_src
** Shutdown Flag
#+begin_src lisp
(defvar *shutdown-save-enabled* t) (defvar *shutdown-save-enabled* t)
#+end_src
** Health Status
#+begin_src lisp
(defvar *system-health* :unknown (defvar *system-health* :unknown
"Current system health status: :healthy, :degraded, :unhealthy, or :unknown.") "Current system health status: :healthy, :degraded, :unhealthy, or :unknown.")
(defvar *health-check-ran* nil (defvar *health-check-ran* nil
"Flag indicating if initial health check has completed.") "Flag indicating if initial health check has completed.")
#+end_src
** Proactive Doctor (defun diagnostics-startup-run ()
#+begin_src lisp
(defun run-startup-health-check ()
"Runs the doctor diagnostics on startup. Returns health status." "Runs the doctor diagnostics on startup. Returns health status."
(format t "~%") (format t "~%")
(format t "==================================================~%") (format t "==================================================~%")
@@ -125,21 +94,18 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
(progn (progn
(setf *system-health* :degraded) (setf *system-health* :degraded)
(format t "DAEMON: Health check found issues.~%") (format t "DAEMON: Health check found issues.~%")
(format t " Run 'opencortex doctor --fix' to repair.~%"))))) (format t " Run 'passepartout doctor --fix' to repair.~%")))))
(setf *health-check-ran* t)) (setf *health-check-ran* t))
(error (c) (error (c)
(format t "DOCTOR ERROR: ~a~%" c) (format t "DOCTOR ERROR: ~a~%" c)
(setf *system-health* :unhealthy) (setf *system-health* :unhealthy)
(setf *health-check-ran* t))) (setf *health-check-ran* t)))
(format t "==================================================~%~%")) (format t "==================================================~%~%"))
#+end_src
** Main Entry Point (main)
#+begin_src lisp
(defun main () (defun main ()
"Entry point for OpenCortex. Initializes the system and enters idle loop." "Entry point for Passepartout. Initializes the system and enters idle loop."
(let* ((home (uiop:getenv "HOME")) (let* ((home (uiop:getenv "HOME"))
(env-file (uiop:merge-pathnames* ".config/opencortex/.env" (uiop:ensure-directory-pathname home)))) (env-file (uiop:merge-pathnames* ".config/passepartout/.env" (uiop:ensure-directory-pathname home))))
(when (uiop:file-exists-p env-file) (when (uiop:file-exists-p env-file)
(cl-dotenv:load-env env-file))) (cl-dotenv:load-env env-file)))
@@ -148,9 +114,9 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
(initialize-all-skills) (initialize-all-skills)
;; Run proactive doctor before starting services ;; Run proactive doctor before starting services
(run-startup-health-check) (diagnostics-startup-run)
(start-heartbeat) (heartbeat-start)
(start-daemon) (start-daemon)
#+sbcl #+sbcl
@@ -163,36 +129,32 @@ The Metabolic Loop is the fundamental rhythm of OpenCortex: the continuous proce
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600))) (let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
(loop (loop
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
(harness-log "SHUTDOWN: Interrupt flag set. Saving memory...") (harness-log "SHUTDOWN: Interrupt flag set. Saving memory...")
(when *shutdown-save-enabled* (save-memory-to-disk)) (when *shutdown-save-enabled* (save-memory-to-disk))
(return)) (return))
(sleep sleep-interval)))) (sleep sleep-interval))))
#+end_src
* Test Suite
#+begin_src lisp :tangle ../tests/immune-system-tests.lisp
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (ql:quickload :fiveam :silent t))
(defpackage :opencortex-immune-system-tests (defpackage :passepartout-immune-system-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :passepartout)
(:export #:immune-suite)) (:export #:immune-suite))
(in-package :opencortex-immune-system-tests) (in-package :passepartout-immune-system-tests)
(def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)") (def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)")
(in-suite immune-suite) (in-suite immune-suite)
(test loop-error-injection (test loop-error-injection
"Verify that a crash in think/decide triggers a :loop-error stimulus." "Verify that a crash in think/decide triggers a :loop-error stimulus."
(clrhash opencortex::*skills-registry*) (clrhash passepartout::*skills-registry*)
(opencortex:defskill :evil-skill (passepartout:defskill :evil-skill
:priority 100 :priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input)) :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input))
:probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE")) :probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE"))
:deterministic nil) :deterministic nil)
(opencortex:process-signal '(:type :EVENT :payload (:sensor :user-input))) (passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
(let ((logs (opencortex:context-get-system-logs 20))) (let ((logs (passepartout:context-get-system-logs 20)))
(is (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs)))))) (is (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs))))))
#+end_src

164
lisp/core-memory.lisp Normal file
View File

@@ -0,0 +1,164 @@
(in-package :passepartout)
(defvar *memory-store* (make-hash-table :test 'equal))
(defvar *memory-history* (make-hash-table :test 'equal)
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
(defun memory-object-get (id)
"Retrieves an memory-object by ID from *memory-store*."
(gethash id *memory-store*))
(defun memory-objects-by-attribute (attr value)
"Returns all memory-objects whose :ATTRIBUTES plist has ATTR = VALUE."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(when (equal (getf (memory-object-attributes obj) attr) value)
(push obj results)))
*memory-store*)
(nreverse results)))
(defun memory-id-generate ()
"Generates a timestamp-based unique ID."
(format nil "id-~36r" (get-universal-time)))
(defstruct memory-object
id type attributes content vector parent-id children version last-sync hash)
(defmethod make-load-form ((obj memory-object) &optional env)
(make-load-form-saving-slots obj :environment env))
(defun deep-copy-memory-object (obj)
"Creates a full copy of an memory-object, including fresh lists for attributes and children."
(make-memory-object :id (memory-object-id obj)
:type (memory-object-type obj)
:attributes (copy-list (memory-object-attributes obj))
:content (memory-object-content obj)
:vector (memory-object-vector obj)
:parent-id (memory-object-parent-id obj)
:children (copy-list (memory-object-children obj))
:version (memory-object-version obj)
:last-sync (memory-object-last-sync obj)
:hash (memory-object-hash obj)))
(defun memory-merkle-hash (id type attributes content child-hashes)
(let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
(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))
(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)
(let* ((type (getf ast :type))
(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 (getf ast :raw-content) ""))))
(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-obj (gethash child-id *memory-store*)))
(when child-obj (push (memory-object-hash child-obj) child-hashes))))))
(setf child-ids (nreverse child-ids))
(setf child-hashes (nreverse child-hashes))
(let* ((hash (memory-merkle-hash id type props raw-content child-hashes))
(existing-obj (gethash hash *memory-history*))
(obj (or existing-obj
(make-memory-object
:id id :type type :attributes props :content 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 *memory-history*) obj))
(setf (gethash id *memory-store*) obj)
id)))
(defvar *memory-snapshots* nil)
(defun memory-hash-table-copy (hash-table)
"Creates an independent 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 CoW snapshot of *memory-store* for rollback recovery."
(let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory-store*))))
(maphash (lambda (k v) (setf (gethash k snapshot) (deep-copy-memory-object v))) *memory-store*)
(push (list :timestamp (get-universal-time) :data snapshot) *memory-snapshots*)
(when (> (length *memory-snapshots*) 20)
(setf *memory-snapshots* (subseq *memory-snapshots* 0 20)))
(harness-log "MEMORY - CoW Memory snapshot created.")))
(defun rollback-memory (&optional (index 0))
"Restores *memory-store* from a snapshot. INDEX 0 = most recent."
(let ((snapshot (nth index *memory-snapshots*)))
(if snapshot
(progn (setf *memory-store* (memory-hash-table-copy (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)
(defun memory-snapshot-path-ensure ()
"Returns the path to the memory snapshot file, resolving env or default."
(or *memory-snapshot-path*
(let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH")))
(setf *memory-snapshot-path*
(or env-path (namestring (uiop:merge-pathnames* "memory.snap" (user-homedir-pathname))))))))
(defun save-memory-to-disk ()
"Writes the entire memory and history store to disk as a plist."
(let ((path (memory-snapshot-path-ensure)))
(with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create)
(let ((memory-alist nil) (history-alist nil))
(maphash (lambda (k v) (push (cons k v) memory-alist)) *memory-store*)
(maphash (lambda (k v) (push (cons k v) history-alist)) *memory-history*)
(prin1 (list :memory memory-alist :history-store history-alist) stream)))
(harness-log "MEMORY - Saved to ~a" path)))
(defun load-memory-from-disk ()
"Reads memory state from disk and restores *memory-store* and *memory-history*."
(let ((path (memory-snapshot-path-ensure)))
(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-store* (make-hash-table :test 'equal :size (length memory-alist)))
(dolist (kv memory-alist) (setf (gethash (car kv) *memory-store*) (cdr kv)))
(setf *memory-history* (make-hash-table :test 'equal :size (length history-alist)))
(dolist (kv history-alist) (setf (gethash (car kv) *memory-history*) (cdr kv)))
(harness-log "MEMORY - Loaded from ~a (~a objects)" path (hash-table-size *memory-store*))))))
(error (c) (harness-log "MEMORY WARNING - Failed to load snapshot: ~a" c)))))
t)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-memory-tests
(:use :cl :fiveam :passepartout)
(:export #:memory-suite))
(in-package :passepartout-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)))
(clrhash passepartout::*memory-store*)
(let ((id1 (ingest-ast ast1)))
(let ((hash1 (memory-object-hash (memory-object-get id1))))
(clrhash passepartout::*memory-store*)
(let ((id2 (ingest-ast ast1)))
(is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))

122
harness/skills.lisp → lisp/core-skills.lisp
View File

@@ -1,6 +1,6 @@
(in-package :opencortex) (in-package :passepartout)
(defun COSINE-SIMILARITY (v1 v2) (defun vector-cosine-similarity (v1 v2)
"Computes cosine similarity between two vectors." "Computes cosine similarity between two vectors."
(let* ((len1 (length v1)) (len2 (length v2))) (let* ((len1 (length v1)) (len2 (length v2)))
(if (or (zerop len1) (zerop len2)) (if (or (zerop len1) (zerop len2))
@@ -16,14 +16,14 @@
(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn system-prompt-augment) (defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn system-prompt-augment)
(defvar *skills-registry* (make-hash-table :test 'equal)) (defvar *skill-registry* (make-hash-table :test 'equal))
(defvar *skill-catalog* (make-hash-table :test 'equal) (defvar *skill-catalog* (make-hash-table :test 'equal)
"Tracks all discovered skill files and their loading state.") "Tracks all discovered skill files and their loading state.")
(defstruct skill-entry filename (status :discovered) error-log (load-time 0)) (defstruct skill-entry filename (status :discovered) error-log (load-time 0))
(defun find-triggered-skill (context) (defun skill-triggered-find (context)
"Returns the highest priority skill whose trigger matches context." "Returns the highest priority skill whose trigger matches context."
(let ((triggered nil)) (let ((triggered nil))
(maphash (lambda (name skill) (maphash (lambda (name skill)
@@ -31,12 +31,12 @@
(when (and (skill-probabilistic-prompt skill) (when (and (skill-probabilistic-prompt skill)
(ignore-errors (funcall (skill-trigger-fn skill) context))) (ignore-errors (funcall (skill-trigger-fn skill) context)))
(push skill triggered))) (push skill triggered)))
*skills-registry*) *skill-registry*)
(first (sort triggered #'> :key #'skill-priority)))) (first (sort triggered #'> :key #'skill-priority))))
(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic system-prompt-augment) (defmacro defskill (name &key priority dependencies trigger probabilistic deterministic system-prompt-augment)
"Registers a new skill. NAME is a keyword. TRIGGER is a function (context) → bool." "Registers a new skill. NAME is a keyword. TRIGGER is a function (context) → bool."
`(setf (gethash (string-downcase (string ,name)) *skills-registry*) `(setf (gethash (string-downcase (string ,name)) *skill-registry*)
(make-skill :name (string-downcase (string ,name)) (make-skill :name (string-downcase (string ,name))
:priority (or ,priority 10) :priority (or ,priority 10)
:dependencies ',dependencies :dependencies ',dependencies
@@ -45,20 +45,20 @@
:deterministic-fn ,deterministic :deterministic-fn ,deterministic
:system-prompt-augment ,system-prompt-augment))) :system-prompt-augment ,system-prompt-augment)))
(defun resolve-skill-dependencies (skill-name) (defun skill-dependencies-resolve (skill-name)
"Resolves transitive dependencies. Returns list of skill names in dependency order." "Resolves transitive dependencies. Returns list of skill names in dependency order."
(let ((resolved nil) (seen nil)) (let ((resolved nil) (seen nil))
(labels ((visit (name) (labels ((visit (name)
(unless (member name seen :test #'equal) (unless (member name seen :test #'equal)
(push name seen) (push name seen)
(let ((skill (gethash (string-downcase (string name)) *skills-registry*))) (let ((skill (gethash (string-downcase (string name)) *skill-registry*)))
(when skill (when skill
(dolist (dep (skill-dependencies skill)) (visit dep)))) (dolist (dep (skill-dependencies skill)) (visit dep))))
(push name resolved)))) (push name resolved))))
(visit skill-name) (visit skill-name)
(nreverse resolved)))) (nreverse resolved))))
(defun parse-skill-metadata (filepath) (defun skill-metadata-parse (filepath)
"Extracts ID and DEPENDS_ON tags from org file." "Extracts ID and DEPENDS_ON tags from org file."
(let ((dependencies nil) (id nil) (content (uiop:read-file-string filepath))) (let ((dependencies nil) (id nil) (content (uiop:read-file-string filepath)))
(let ((id-start (search ":ID:" content))) (let ((id-start (search ":ID:" content)))
@@ -75,11 +75,24 @@
(setf pos end))))) (setf pos end)))))
(values id (reverse dependencies)))) (values id (reverse dependencies))))
(defun topological-sort-skills (skills-dir) (defun skill-topological-sort (skills-dir)
"Returns a list of skill filepaths sorted by dependency." "Returns a list of skill filepaths sorted by dependency."
(let* ((org-files (uiop:directory-files skills-dir "org-skill-*.org")) (let* ((org-files (uiop:directory-files skills-dir "*.org"))
(lisp-files (uiop:directory-files skills-dir "org-skill-*.lisp")) (lisp-files (uiop:directory-files skills-dir "*.lisp"))
(files (append org-files lisp-files)) (all-files (append org-files lisp-files))
(files (remove-if (lambda (f)
(let ((n (pathname-name f)))
(or (string= n "core-defpackage")
(string= n "core-skills")
(string= n "core-communication")
(string= n "core-memory")
(string= n "core-context")
(string= n "core-loop-perceive")
(string= n "core-loop-reason")
(string= n "core-loop-act")
(string= n "core-loop")
(string= n "core-manifest"))))
all-files))
(adj (make-hash-table :test 'equal)) (adj (make-hash-table :test 'equal))
(name-to-file (make-hash-table :test 'equal)) (name-to-file (make-hash-table :test 'equal))
(id-to-file (make-hash-table :test 'equal)) (id-to-file (make-hash-table :test 'equal))
@@ -91,10 +104,9 @@
(if (uiop:string-suffix-p (namestring file) ".lisp") (if (uiop:string-suffix-p (namestring file) ".lisp")
(progn (progn
(setf (gethash (string-downcase filename) name-to-file) file) (setf (gethash (string-downcase filename) name-to-file) file)
;; Don't overwrite dependency info from .org files
(unless (gethash (string-downcase filename) adj) (unless (gethash (string-downcase filename) adj)
(setf (gethash (string-downcase filename) adj) nil))) (setf (gethash (string-downcase filename) adj) nil)))
(multiple-value-bind (id deps) (parse-skill-metadata file) (multiple-value-bind (id deps) (skill-metadata-parse file)
(setf (gethash (string-downcase filename) name-to-file) file) (setf (gethash (string-downcase filename) name-to-file) file)
(when id (setf (gethash (string-downcase id) id-to-file) file)) (when id (setf (gethash (string-downcase id) id-to-file) file))
(setf (gethash (string-downcase filename) adj) deps))))) (setf (gethash (string-downcase filename) adj) deps)))))
@@ -124,7 +136,7 @@
(when file (visit file))))) (when file (visit file)))))
(nreverse result)))) (nreverse result))))
(defun validate-lisp-syntax (code-string) (defun lisp-syntax-validate (code-string)
"Checks if a string contains valid Common Lisp forms." "Checks if a string contains valid Common Lisp forms."
(handler-case (handler-case
(let ((*read-eval* nil)) (let ((*read-eval* nil))
@@ -133,7 +145,7 @@
(values t nil)) (values t nil))
(error (c) (values nil (format nil "~a" c))))) (error (c) (values nil (format nil "~a" c)))))
(defun remove-in-package-forms (code-string) (defun skill-package-forms-strip (code-string)
"Removes in-package forms so symbols get defined in skill package." "Removes in-package forms so symbols get defined in skill package."
(let ((lines (uiop:split-string code-string :separator '(#\Newline))) (let ((lines (uiop:split-string code-string :separator '(#\Newline)))
(result "")) (result ""))
@@ -143,11 +155,11 @@
(setf result (concatenate 'string result line (string #\Newline)))))) (setf result (concatenate 'string result line (string #\Newline))))))
result)) result))
(defun extract-tangle-target (line) (defun tangle-target-extract (line)
"Extracts the value of the :tangle header." "Extracts the value of the :tangle header."
(let ((pos (search ":tangle" line))) (let ((pos (search ":tangle" line)))
(when pos (when pos
(let ((rest (string-trim '(#\Space #\Tab) (subseq line (+ pos 7))))) (let ((rest (string-tirm '(#\Space #\Tab) (subseq line (+ pos 7)))))
(let ((end (position #\Space rest))) (let ((end (position #\Space rest)))
(if end (subseq rest 0 end) rest)))))) (if end (subseq rest 0 end) rest))))))
@@ -160,15 +172,13 @@
(let* ((content (uiop:read-file-string filepath)) (let* ((content (uiop:read-file-string filepath))
(lines (uiop:split-string content :separator '(#\Newline))) (lines (uiop:split-string content :separator '(#\Newline)))
(in-lisp-block nil) (collect-this-block nil) (lisp-code "") (in-lisp-block nil) (collect-this-block nil) (lisp-code "")
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword))) (pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
(dolist (line lines) (dolist (line lines)
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line))) (let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
(cond (cond
((uiop:string-prefix-p "#+begin_src lisp" clean-line) ((uiop:string-prefix-p "#+begin_src lisp" clean-line)
(setf in-lisp-block t) (setf in-lisp-block t)
(let ((target (extract-tangle-target clean-line))) (let ((target (tangle-target-extract clean-line)))
;; Collect if there's no tangle target (inherits from file)
;; or if it's a lisp file and NOT a test.
(setf collect-this-block (or (null target) (setf collect-this-block (or (null target)
(and (not (search "no" target)) (and (not (search "no" target))
(not (search "/tests" target))))))) (not (search "/tests" target)))))))
@@ -176,36 +186,35 @@
(setf in-lisp-block nil) (setf collect-this-block nil)) (setf in-lisp-block nil) (setf collect-this-block nil))
((and in-lisp-block collect-this-block) ((and in-lisp-block collect-this-block)
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line)) (unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
(uiop:string-prefix-p ":END:" (string-upcase clean-line)) (uiop:string-prefix-p ":END:" (string-upcase clean-line))
(uiop:string-prefix-p ":ID:" (string-upcase clean-line))) (uiop:string-prefix-p ":ID:" (string-upcase clean-line)))
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline)))))))) (setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
(if (= (length lisp-code) 0) (if (= (length lisp-code) 0)
(setf (skill-entry-status entry) :ready) (setf (skill-entry-status entry) :ready)
(progn (progn
(multiple-value-bind (valid-p err) (validate-lisp-syntax lisp-code) (multiple-value-bind (valid-p err) (lisp-syntax-validate lisp-code)
(unless valid-p (error err))) (unless valid-p (error err)))
(unless (find-package pkg-name) (unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :opencortex new-pkg))) (let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
(let ((*read-eval* nil) (*package* (find-package pkg-name))) (let ((*read-eval* nil) (*package* (find-package pkg-name)))
(harness-log "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*)) (log-message "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*))
(eval (read-from-string (format nil "(progn ~a)" lisp-code)))) (eval (read-from-string (format nil "(progn ~a)" lisp-code))))
;; Export symbols back to :OPENCORTEX for discoverability and testing (let* ((target-pkg (find-package :passepartout))
(let* ((target-pkg (find-package :opencortex))
(raw-name (string-upcase skill-base-name)) (raw-name (string-upcase skill-base-name))
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name) (short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
(subseq raw-name 10) (subseq raw-name 10)
raw-name))) raw-name)))
(harness-log "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name))) (log-message "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
(do-symbols (sym (find-package pkg-name)) (do-symbols (sym (find-package pkg-name))
(when (eq (symbol-package sym) (find-package pkg-name)) (when (eq (symbol-package sym) (find-package pkg-name))
(let ((sn (symbol-name sym))) (let ((sn (symbol-name sym)))
(when (or (uiop:string-prefix-p raw-name sn) (when (or (uiop:string-prefix-p raw-name sn)
(uiop:string-prefix-p short-name sn) (uiop:string-prefix-p short-name sn)
(string-equal sn "DOCTOR-MAIN") (string-equal sn "DIAGNOSTICS-MAIN")
(string-equal sn "RUN-SETUP-WIZARD")) (string-equal sn "DIAGNOSTICS-RUN-ALL")
(harness-log "LOADER: Exporting ~a to :OPENCORTEX" sn) (string-equal sn "SETUP-WIZARD-RUN"))
;; Resolve potential name conflicts by uninterning first (log-message "LOADER: Exporting ~a to :PASSEPARTOUT" sn)
(let ((existing (find-symbol sn target-pkg))) (let ((existing (find-symbol sn target-pkg)))
(when (and existing (not (eq existing sym))) (when (and existing (not (eq existing sym)))
(unintern existing target-pkg))) (unintern existing target-pkg)))
@@ -215,7 +224,7 @@
(setf (skill-entry-status entry) :ready))) (setf (skill-entry-status entry) :ready)))
t) t)
(error (c) (error (c)
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name c) (log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
(setf (skill-entry-status entry) :failed) nil)))) (setf (skill-entry-status entry) :failed) nil))))
(defun load-skill-from-lisp (filepath) (defun load-skill-from-lisp (filepath)
@@ -224,34 +233,33 @@
(entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))) (entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
(setf (skill-entry-status entry) :loading) (setf (skill-entry-status entry) :loading)
(handler-case (handler-case
(let* ((content (remove-in-package-forms (uiop:read-file-string filepath))) (let* ((content (skill-package-forms-strip (uiop:read-file-string filepath)))
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword))) (pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
(multiple-value-bind (valid-p err) (validate-lisp-syntax content) (multiple-value-bind (valid-p err) (lisp-syntax-validate content)
(unless valid-p (error err))) (unless valid-p (error err)))
(unless (find-package pkg-name) (unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :opencortex new-pkg))) (let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
(let ((*read-eval* nil) (*package* (find-package pkg-name))) (let ((*read-eval* nil) (*package* (find-package pkg-name)))
(harness-log "LOADER: Loading .lisp skill '~a' in package ~a" skill-base-name (package-name *package*)) (log-message "LOADER: Loading .lisp skill '~a' in package ~a" skill-base-name (package-name *package*))
;; Evaluate forms individually so one bad form doesn't abort the entire skill
(with-input-from-string (s content) (with-input-from-string (s content)
(loop for form = (read s nil :eof) until (eq form :eof) (loop for form = (read s nil :eof) until (eq form :eof)
do (handler-case (eval form) do (handler-case (eval form)
(error (c) (harness-log "LOADER WARNING in '~a': ~a" skill-base-name c)))))) (error (c) (log-message "LOADER WARNING in '~a': ~a" skill-base-name c))))))
;; Export symbols (let* ((target-pkg (find-package :passepartout))
(let* ((target-pkg (find-package :opencortex))
(raw-name (string-upcase skill-base-name)) (raw-name (string-upcase skill-base-name))
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name) (short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
(subseq raw-name 10) (subseq raw-name 10)
raw-name))) raw-name)))
(harness-log "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name))) (log-message "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
(do-symbols (sym (find-package pkg-name)) (do-symbols (sym (find-package pkg-name))
(when (eq (symbol-package sym) (find-package pkg-name)) (when (eq (symbol-package sym) (find-package pkg-name))
(let ((sn (symbol-name sym))) (let ((sn (symbol-name sym)))
(when (or (uiop:string-prefix-p raw-name sn) (when (or (uiop:string-prefix-p raw-name sn)
(uiop:string-prefix-p short-name sn) (uiop:string-prefix-p short-name sn)
(string-equal sn "DOCTOR-MAIN") (string-equal sn "DIAGNOSTICS-MAIN")
(string-equal sn "RUN-SETUP-WIZARD")) (string-equal sn "DIAGNOSTICS-RUN-ALL")
(harness-log "LOADER: Exporting ~a to :OPENCORTEX" sn) (string-equal sn "SETUP-WIZARD-RUN"))
(log-message "LOADER: Exporting ~a to :PASSEPARTOUT" sn)
(let ((existing (find-symbol sn target-pkg))) (let ((existing (find-symbol sn target-pkg)))
(when (and existing (not (eq existing sym))) (when (and existing (not (eq existing sym)))
(unintern existing target-pkg))) (unintern existing target-pkg)))
@@ -259,18 +267,18 @@
(export sym target-pkg)))))) (export sym target-pkg))))))
(setf (skill-entry-status entry) :ready)) (setf (skill-entry-status entry) :ready))
(error (c) (error (c)
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name c) (log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
(setf (skill-entry-status entry) :failed) nil)))) (setf (skill-entry-status entry) :failed) nil))))
(defun initialize-all-skills () (defun skill-initialize-all ()
"Initializes all skills from the XDG skills directory." "Initializes all skills from the XDG skills directory."
(let* ((data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "OC_DATA_DIR") (namestring (merge-pathnames ".local/share/opencortex/" (user-homedir-pathname)))))) (let* ((data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
(skills-dir (merge-pathnames "skills/" data-dir))) (skills-dir (merge-pathnames "skills/" (uiop:ensure-directory-pathname data-dir))))
(unless (uiop:directory-exists-p skills-dir) (return-from initialize-all-skills nil)) (unless (uiop:directory-exists-p skills-dir) (return-from skill-initialize-all nil))
(let ((sorted-files (topological-sort-skills skills-dir))) (let ((sorted-files (skill-topological-sort skills-dir)))
(harness-log "LOADER: Initializing ~a skills..." (length sorted-files)) (log-message "LOADER: Initializing ~a skills..." (length sorted-files))
(dolist (file sorted-files) (dolist (file sorted-files)
(if (uiop:string-suffix-p (namestring file) ".lisp") (if (uiop:string-suffix-p (namestring file) ".lisp")
(load-skill-from-lisp file) (load-skill-from-lisp file)
(load-skill-from-org file))) (load-skill-from-org file)))
(harness-log "LOADER: Boot Complete.")))) (log-message "LOADER: Boot Complete."))))

10
lisp/gateway-cli.lisp Normal file
View File

@@ -0,0 +1,10 @@
(defun gateway-cli-input (text)
"Processes raw text from the command line."
(inject-stimulus (list :type :EVENT
:payload (list :sensor :user-input :text text)
:meta (list :source :CLI))))
(defskill :passepartout-gateway-cli
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))

43
lisp/gateway-llm.lisp Normal file
View File

@@ -0,0 +1,43 @@
(defun gateway-llm-request (&key prompt system-prompt (provider :ollama) model)
"Central dispatcher for LLM requests."
(let ((backend (gethash provider *probabilistic-backends*)))
(if backend
(handler-case
(funcall backend prompt system-prompt :model model)
(error (c)
(list :status :error :message (format nil "~a Failure: ~a" provider c))))
(list :status :error :message (format nil "Provider ~a not registered" provider)))))
(defskill :passepartout-gateway-llm
:priority 100
:trigger (lambda (ctx) (getf ctx :user-input))
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-llm-gateway-tests
(:use :cl :passepartout)
(:export #:llm-gateway-suite))
(in-package :passepartout-llm-gateway-tests)
(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM Gateway skill")
(fiveam:in-suite llm-gateway-suite)
(fiveam:test test-llm-gateway-timeout
"Tier 2 Chaos: Verify that LLM Gateway handles connection failures gracefully."
(let ((old-host (uiop:getenv "OLLAMA_HOST")))
(unwind-protect
(progn
(setf (uiop:getenv "OLLAMA_HOST") "localhost:1")
(let ((fn (or (find-symbol "EXECUTE-LLM-REQUEST" :passepartout.gateway-llm)
(find-symbol "EXECUTE-LLM-REQUEST" :passepartout))))
(if fn
(let ((result (funcall fn :prompt "hello" :provider :ollama)))
(fiveam:is (eq (getf result :status) :error))
(fiveam:is (uiop:string-prefix-p "Ollama Failure" (getf result :message))))
(fiveam:fail "Could not find EXECUTE-LLM-REQUEST symbol"))))
(if old-host
(setf (uiop:getenv "OLLAMA_HOST") old-host)
(sb-posix:unsetenv "OLLAMA_HOST")))))

214
lisp/gateway-manager.lisp Normal file
View File

@@ -0,0 +1,214 @@
(defvar *gateway-configs* (make-hash-table :test 'equal)
"Maps platform name → plist (:token :thread :interval :enabled)")
(defvar *gateway-registry* (make-hash-table :test 'equal)
"Maps platform name → plist (:poll-fn :send-fn :default-interval)")
(defun telegram-get-token ()
(vault-get-secret :telegram))
(defun telegram-poll ()
"Polls Telegram for new messages and injects them into the harness."
(let* ((token (telegram-get-token)))
(when token
(let* ((last-id (getf (gethash "telegram" *gateway-configs*) :last-update-id 0))
(url (format nil "https://api.telegram.org/bot~a/getUpdates?offset=~a"
token (1+ last-id))))
(handler-case
(let* ((response (dex:get url))
(json (cl-json:decode-json-from-string response))
(updates (cdr (assoc :result json))))
(dolist (update updates)
(let* ((update-id (cdr (assoc :update--id update)))
(message (cdr (assoc :message update)))
(chat (cdr (assoc :chat message)))
(chat-id (cdr (assoc :id chat)))
(text (cdr (assoc :text message))))
(setf (getf (gethash "telegram" *gateway-configs*) :last-update-id) update-id)
(when (and text chat-id)
(harness-log "TELEGRAM: Received message from ~a" chat-id)
(inject-stimulus
(list :type :EVENT
:meta (list :source :telegram :chat-id (format nil "~a" chat-id))
:payload (list :sensor :user-input :text text)))))))
(error (c) (harness-log "TELEGRAM POLL ERROR: ~a" c))))))
(defun telegram-send (action context)
"Sends a message via Telegram."
(declare (ignore context))
(let* ((payload (getf action :payload))
(meta (getf action :meta))
(chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
(text (or (getf payload :text) (getf action :text)))
(token (telegram-get-token)))
(when (and token chat-id text)
(harness-log "TELEGRAM: Sending message to ~a..." chat-id)
(handler-case
(let ((url (format nil "https://api.telegram.org/bot~a/sendMessage" token)))
(dex:post url
:headers '(("Content-Type" . "application/json"))
:content (cl-json:encode-json-to-string
`((chat_id . ,chat-id) (text . ,text)))))
(error (c) (harness-log "TELEGRAM ERROR: ~a" c))))))
(defun signal-get-account ()
(vault-get-secret :signal))
(defun signal-poll ()
"Polls Signal for new messages and injects them into the harness."
(let ((account (signal-get-account)))
(when account
(handler-case
(let* ((output (uiop:run-program (list "signal-cli" "-u" account "receive" "--json")
:output :string :error-output :string :ignore-error-status t))
(lines (cl-ppcre:split "\\n" output)))
(dolist (line lines)
(when (and line (> (length line) 0))
(let* ((json (ignore-errors (cl-json:decode-json-from-string line)))
(envelope (cdr (assoc :envelope json)))
(source (cdr (assoc :source envelope)))
(data-message (cdr (assoc :data-message envelope)))
(text (cdr (assoc :message data-message))))
(when (and source text)
(harness-log "SIGNAL: Received message from ~a" source)
(inject-stimulus
(list :type :EVENT
:meta (list :source :signal :chat-id source)
:payload (list :sensor :user-input :text text))))))))
(error (c) (harness-log "SIGNAL POLL ERROR: ~a" c))))))
(defun signal-send (action context)
"Sends a message via Signal."
(declare (ignore context))
(let* ((payload (getf action :payload))
(meta (getf action :meta))
(chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
(text (or (getf payload :text) (getf action :text)))
(account (signal-get-account)))
(when (and account chat-id text)
(harness-log "SIGNAL: Sending message to ~a..." chat-id)
(handler-case
(uiop:run-program (list "signal-cli" "-u" account "send" "-m" text chat-id)
:output :string :error-output :string)
(error (c) (harness-log "SIGNAL ERROR: ~a" c))))))
(defun gateway-registry-initialize ()
"Registers all built-in gateway handlers."
(setf (gethash "telegram" *gateway-registry*)
(list :poll-fn #'telegram-poll
:send-fn #'telegram-send
:default-interval 3))
(setf (gethash "signal" *gateway-registry*)
(list :poll-fn #'signal-poll
:send-fn #'signal-send
:default-interval 5)))
(defun gateway-configured-p (platform)
"Returns T if a platform has a stored token."
(let ((config (gethash platform *gateway-configs*)))
(and config (getf config :token))))
(defun gateway-active-p (platform)
"Returns T if a platform's polling thread is alive."
(let ((config (gethash platform *gateway-configs*)))
(and config
(getf config :thread)
(bt:thread-alive-p (getf config :thread)))))
(defun gateway-link (platform token)
"Links a platform with a token and starts polling."
(let ((platform-lc (string-downcase platform)))
(unless (gethash platform-lc *gateway-registry*)
(error "Unknown platform: ~a. Available: ~{~a~^, ~}"
platform (loop for k being the hash-keys of *gateway-registry* collect k)))
(when (or (null token) (zerop (length token)))
(error "Token cannot be empty"))
(harness-log "GATEWAY: Linking to ~a..." platform-lc)
(gateway-unlink platform-lc)
(let* ((registry-entry (gethash platform-lc *gateway-registry*))
(interval (or (getf registry-entry :default-interval) 5)))
(setf (gethash platform-lc *gateway-configs*)
(list :token token :interval interval :enabled t))
(vault-set-secret (intern (string-upcase platform-lc) :keyword) token)
(gateway-start platform-lc)
(harness-log "GATEWAY: Successfully linked ~a" platform-lc)
(format t "Successfully linked ~a gateway. Token stored securely.~%" platform-lc)
t)))
(defun gateway-unlink (platform)
"Unlinks a platform and stops its polling thread."
(let ((platform-lc (string-downcase platform)))
(gateway-stop platform-lc)
(remhash platform-lc *gateway-configs*)
(harness-log "GATEWAY: Unlinked ~a" platform-lc)
(format t "Successfully unlinked ~a gateway.~%" platform-lc)
t))
(defun gateway-start (platform)
"Starts the polling thread for a linked gateway."
(let ((platform-lc (string-downcase platform)))
(let ((config (gethash platform-lc *gateway-configs*)))
(when (and config (getf config :enabled) (not (gateway-active-p platform-lc)))
(let ((poll-fn (getf (gethash platform-lc *gateway-registry*) :poll-fn)))
(when poll-fn
(let ((interval (getf config :interval)))
(setf (getf config :thread)
(bt:make-thread
(lambda ()
(loop
(when (getf (gethash platform-lc *gateway-configs*) :enabled)
(funcall poll-fn))
(sleep interval)))
:name (format nil "passepartout-~a-gateway" platform-lc)))
(harness-log "GATEWAY: Started ~a polling (interval: ~as)" platform-lc interval)))))))))
(defun gateway-stop (platform)
"Stops the polling thread for a gateway."
(let ((platform-lc (string-downcase platform)))
(let ((config (gethash platform-lc *gateway-configs*)))
(when (and config (getf config :thread))
(when (bt:thread-alive-p (getf config :thread))
(harness-log "GATEWAY: Stopping ~a polling thread" platform-lc)
(bt:destroy-thread (getf config :thread))))
(setf (getf config :thread) nil))))
(defun gateway-list ()
"Returns a list of all gateways with their status."
(loop for platform being the hash-keys of *gateway-registry*
collect (let ((configured (gateway-configured-p platform))
(active (gateway-active-p platform)))
(list :platform platform
:configured configured
:active active))))
(defun gateway-list-print ()
"Prints a formatted table of gateways."
(format t "~%")
(format t " ~20@A ~12@A ~10@A~%" "PLATFORM" "CONFIGURED" "STATUS")
(dolist (gw (gateway-list))
(format t " ~20@A ~12@A ~10@A~%"
(getf gw :platform)
(if (getf gw :configured) "yes" "no")
(cond
((getf gw :active) "ACTIVE")
((getf gw :configured) "stopped")
(t "not linked"))))
(format t "~%"))
(defun gateway-start-all ()
"Called at boot to start all configured gateways."
(dolist (config (loop for platform being the hash-keys of *gateway-configs*
collect (list platform (gethash platform *gateway-configs*))))
(destructuring-bind (platform config) config
(when (and (getf config :enabled) (not (gateway-active-p platform)))
(gateway-start platform)))))
(register-actuator :telegram #'telegram-send)
(register-actuator :signal #'signal-send)
(defskill :passepartout-gateway-manager
:priority 150
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
(gateway-registry-initialize)
(gateway-start-all)

81
lisp/gateway-provider.lisp Normal file
View File

@@ -0,0 +1,81 @@
(defparameter *provider-configs*
'((:ollama . (:base-url nil :key-env nil :default-model "llama3"))
(:openrouter . (:base-url "https://openrouter.ai/api/v1" :key-env "OPENROUTER_API_KEY" :default-model "openrouter/auto"))
(:openai . (:base-url "https://api.openai.com/v1" :key-env "OPENAI_API_KEY" :default-model "gpt-4o-mini"))
(:anthropic . (:base-url "https://api.anthropic.com/v1" :key-env "ANTHROPIC_API_KEY" :default-model "claude-3-5-sonnet-20241022"))
(:groq . (:base-url "https://api.groq.com/openai/v1" :key-env "GROQ_API_KEY" :default-model "llama-3.1-70b-versatile"))
(:gemini . (:base-url "https://generativelanguage.googleapis.com/v1beta/openai" :key-env "GEMINI_API_KEY" :default-model "gemini-2.0-flash"))
(:deepseek . (:base-url "https://api.deepseek.com/v1" :key-env "DEEPSEEK_API_KEY" :default-model "deepseek-chat"))
(:nvidia . (:base-url "https://integrate.api.nvidia.com/v1" :key-env "NVIDIA_API_KEY" :default-model "meta/llama-3.1-405b-instruct"))))
(defun provider-config (provider)
"Returns the configuration plist for a provider keyword."
(cdr (assoc provider *provider-configs*)))
(defun provider-available-p (provider)
"Checks if a provider is configured. Ollama is always considered available."
(let* ((config (provider-config provider))
(key-env (getf config :key-env))
(base-url (getf config :base-url)))
(cond ((eq provider :ollama) t)
(key-env (let ((key (uiop:getenv key-env))) (and key (> (length key) 0))))
(base-url t))))
(defun provider-openai-request (prompt system-prompt &key model (provider :ollama))
"Executes a request against any OpenAI-compatible API endpoint."
(let* ((config (provider-config provider))
(base-url (getf config :base-url))
(key-env (getf config :key-env))
(default-model (getf config :default-model))
(api-key (when key-env (uiop:getenv key-env)))
(model-id (or model default-model))
(url (if (eq provider :ollama)
(format nil "http://~a/v1/chat/completions" (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
(format nil "~a/chat/completions" base-url)))
(headers `(("Content-Type" . "application/json")
,@(when api-key `(("Authorization" . ,(format nil "Bearer ~a" api-key))))
,@(when (eq provider :openrouter)
`(("HTTP-Referer" . "https://github.com/amrgharbeia/passepartout")
("X-Title" . "Passepartout")))))
(body (cl-json:encode-json-to-string
`((model . ,model-id)
(messages . (( (role . "system") (content . ,system-prompt) )
( (role . "user") (content . ,prompt) )))))))
(handler-case
(let* ((response (dex:post url :headers headers :content body :connect-timeout 10 :read-timeout 60))
(json (cl-json:decode-json-from-string response))
(choices (cdr (assoc :choices json)))
(first-choice (car choices))
(message (cdr (assoc :message first-choice)))
(content (cdr (assoc :content message))))
(if content
(list :status :success :content content)
(list :status :error :message (format nil "~a: No content in response (~s)" provider json))))
(error (c)
(list :status :error :message (format nil "~a Failure: ~a" provider c))))))
(defun provider-register-all ()
"Scans environment variables and registers all available LLM backends."
(dolist (entry *provider-configs*)
(let ((provider (car entry)))
(when (provider-available-p provider)
(log-message "LLM BACKEND: Registering provider ~a" provider)
(register-probabilistic-backend provider
(lambda (prompt system-prompt &key model)
(provider-openai-request prompt system-prompt :model model :provider provider)))))))
(defun provider-cascade-initialize ()
"Reads PROVIDER_CASCADE from env and sets *provider-cascade*."
(let ((cascade-str (uiop:getenv "PROVIDER_CASCADE")))
(if cascade-str
(setf *provider-cascade*
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
(uiop:split-string cascade-str :separator '(#\,))))
(setf *provider-cascade* (mapcar #'car *provider-configs*)))))
(provider-register-all)
(provider-cascade-initialize)
(defskill :passepartout-gateway-provider
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

72
harness/tui-client.lisp → lisp/gateway-tui.lisp
View File

@@ -1,38 +1,46 @@
(in-package :cl-user) (in-package :cl-user)
(defpackage :opencortex.tui (defpackage :passepartout.gateway-tui
(:use :cl :croatoan :usocket :bordeaux-threads) (:use :cl :croatoan :usocket :bordeaux-threads)
(:export :main)) (:export :main))
(in-package :opencortex.tui) (in-package :passepartout.gateway-tui)
(defvar *daemon-host* "localhost")
(defvar *daemon-host* "127.0.0.1")
(defvar *daemon-port* 9105) (defvar *daemon-port* 9105)
(defvar *socket* nil) (defvar *socket* nil)
(defvar *stream* nil) (defvar *stream* nil)
(defvar *chat-history* nil) (defvar *chat-history* nil)
(defvar *input-list* nil) ; List of characters (stored in reverse)
(defvar *input-buffer* nil)
(defvar *is-running* t) (defvar *is-running* t)
(defvar *queue-lock* (bt:make-lock))
(defvar *incoming-msgs* nil) (defvar *queue-lock* (bt:make-lock "incoming-queue-lock"))
(defvar *incoming* nil)
(defun log-debug (msg &rest args) (defun log-debug (msg &rest args)
(ignore-errors (ignore-errors
(with-open-file (s "/tmp/opencortex-tui-debug.log" :direction :output :if-exists :append :if-does-not-exist :create) (with-open-file (s "/tmp/passepartout-tui-debug.log" :direction :output :if-exists :append :if-does-not-exist :create)
(format s "[~a] " (get-universal-time)) (format s "[~a] " (get-universal-time))
(apply #'format s msg args) (apply #'format s msg args)
(terpri s) (terpri s)
(finish-output s)))) (finish-output s))))
(defun enqueue-msg (msg) (defun message-queue-push (msg)
(bt:with-lock-held (*queue-lock*) (bt:with-lock-held (*queue-lock*)
(setf *incoming-msgs* (append *incoming-msgs* (list msg))))) (setf *incoming* (append *incoming* (list msg)))))
(defun dequeue-msgs () (defun message-queue-drain ()
(bt:with-lock-held (*queue-lock*) (bt:with-lock-held (*queue-lock*)
(let ((msgs *incoming-msgs*)) (let ((msgs *incoming*))
(setf *incoming-msgs* nil) (setf *incoming* nil)
msgs))) msgs)))
(defun render-chat (win h) (defun chat-render (win h)
(when (and win (integerp h)) (when (and win (integerp h))
(clear win) (clear win)
(box win 0 0) (box win 0 0)
@@ -47,12 +55,12 @@
(add-string win (format nil "│ ~a" msg) :y (1+ i) :x 2)))) (add-string win (format nil "│ ~a" msg) :y (1+ i) :x 2))))
(refresh win))) (refresh win)))
(defun handle-backspace () (defun input-backspace ()
(pop *input-list*)) (pop *input-buffer*))
(defun handle-return (stream) (defun input-submit (stream)
(let ((cmd (coerce (reverse *input-list*) 'string))) (let ((cmd (coerce (reverse *input-buffer*) 'string)))
(setf *input-list* nil) (setf *input-buffer* nil)
(log-debug "SUBMITTING: '~a'" cmd) (log-debug "SUBMITTING: '~a'" cmd)
(when (> (length cmd) 0) (when (> (length cmd) 0)
(push (format nil "⬆ ~a" cmd) *chat-history*) (push (format nil "⬆ ~a" cmd) *chat-history*)
@@ -75,7 +83,7 @@
(when (string= cmd "/exit") (setf *is-running* nil)) (when (string= cmd "/exit") (setf *is-running* nil))
(when (string= cmd "/clear") (setf *chat-history* nil)))) (when (string= cmd "/clear") (setf *chat-history* nil))))
(defun start-background-reader (stream) (defun reader-start (stream)
(bt:make-thread (bt:make-thread
(lambda () (lambda ()
(loop while *is-running* do (loop while *is-running* do
@@ -91,17 +99,17 @@
(let ((payload (getf msg :payload))) (let ((payload (getf msg :payload)))
(cond (cond
((eq (getf payload :action) :handshake) ((eq (getf payload :action) :handshake)
(enqueue-msg "* Connected *")) (message-queue-push "* Connected *"))
(t (t
(let ((text (or (getf payload :text) (format nil "~a" payload)))) (let ((text (or (getf payload :text) (format nil "~a" payload))))
(enqueue-msg (format nil "⬇ ~a" text)))))))) (message-queue-push (format nil "⬇ ~a" text))))))))
(sleep 0.05))) (sleep 0.05)))
(error (c) (error (c)
(when *is-running* (when *is-running*
(log-debug "READER ERROR: ~a" c) (log-debug "READER ERROR: ~a" c)
(enqueue-msg "ERROR: Connection lost.") (message-queue-push "ERROR: Connection lost.")
(setf *is-running* nil)))))) (setf *is-running* nil))))))
:name "opencortex-tui-reader")) :name "passepartout-tui-reader"))
(defun main () (defun main ()
(log-debug "=== START ===") (log-debug "=== START ===")
@@ -118,29 +126,29 @@
(chat-win (make-instance 'window :height chat-h :width (- w 2) :y 1 :x 1)) (chat-win (make-instance 'window :height chat-h :width (- w 2) :y 1 :x 1))
(input-win (make-instance 'window :height 1 :width (- w 2) :y (- h 2) :x 1))) (input-win (make-instance 'window :height 1 :width (- w 2) :y (- h 2) :x 1)))
(setf (input-blocking input-win) nil) (setf (input-blocking input-win) nil)
(start-background-reader *stream*) (reader-start *stream*)
(loop :while *is-running* :do (loop :while *is-running* :do
(let ((msgs (dequeue-msgs))) (let ((msgs (message-queue-drain)))
(when msgs (when msgs
(dolist (m msgs) (push m *chat-history*)) (dolist (m msgs) (push m *chat-history*))
(render-chat chat-win chat-h))) (chat-render chat-win chat-h)))
(let ((ch (get-char input-win))) (let ((ch (get-char input-win)))
(when (and ch (not (equal ch -1))) (when (and ch (not (equal ch -1)))
(log-debug "KEY: ~s" ch) (log-debug "KEY: ~s" ch)
(cond (cond
((or (eql ch 10) (eql ch 13) (eq ch :enter) (eql ch #\Newline) (eql ch #\Return)) ((or (eql ch 10) (eql ch 13) (eq ch :enter) (eql ch #\Newline) (eql ch #\Return))
(handle-return *stream*) (input-submit *stream*)
(render-chat chat-win chat-h)) (chat-render chat-win chat-h))
((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace)) ((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
(handle-backspace)) (input-backspace))
((characterp ch) ((characterp ch)
(push ch *input-list*)) (push ch *input-buffer*))
((integerp ch) ((integerp ch)
(let ((converted (code-char ch))) (let ((converted (code-char ch)))
(when (graphic-char-p converted) (when (graphic-char-p converted)
(push converted *input-list*)))))) (push converted *input-buffer*))))))
(clear input-win) (clear input-win)
(add-string input-win (format nil "▶ ~a" (coerce (reverse *input-list*) 'string)) :y 0 :x 1) (add-string input-win (format nil "▶ ~a" (coerce (reverse *input-buffer*) 'string)) :y 0 :x 1)
(refresh input-win)) (refresh input-win))
(sleep 0.01)))) (sleep 0.01))))
(setf *is-running* nil) (setf *is-running* nil)

1
lisp/lisp Symbolic link
View File

@@ -0,0 +1 @@
/home/user/memex/projects/opencortex/lisp

223
lisp/programming-lisp.lisp Normal file
View File

@@ -0,0 +1,223 @@
(defun lisp-structural-check (code)
"Checks if parentheses are balanced and the code is readable."
(handler-case
(let ((*read-eval* nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)))
(values t nil))
(error (c)
(values nil (format nil "Reader Error: ~a" c)))))
(defun lisp-syntactic-check (code)
"Checks for valid Lisp syntax beyond just balanced parentheses."
(lisp-structural-check code))
(defun lisp-semantic-check (code)
"Checks for potentially unsafe forms."
(let ((unsafe-tokens '("eval" "load" "uiop:run-program" "sb-ext:run-program" "cl-user::eval")))
(loop for token in unsafe-tokens
when (search token (string-downcase code))
do (return-from lisp-semantic-check (values nil (format nil "Unsafe form detected: ~a" token))))
(values t nil)))
(defun lisp-validate (code &key (strict t))
"Unified validation gate for Lisp code."
(multiple-value-bind (struct-ok struct-err) (lisp-structural-check code)
(unless struct-ok
(return-from lisp-validate (list :status :error :reason struct-err)))
(when strict
(multiple-value-bind (sem-ok sem-err) (lisp-semantic-check code)
(unless sem-ok
(return-from lisp-validate (list :status :error :reason sem-err)))))
(list :status :success)))
(defun lisp-eval (code-string &key (package :passepartout))
"Evaluates a Lisp string and captures its output/results."
(let ((out (make-string-output-stream))
(err (make-string-output-stream)))
(handler-case
(let* ((*standard-output* out)
(*error-output* err)
(*package* (or (find-package package) (find-package :passepartout)))
(result (with-input-from-string (s code-string)
(let ((last-val nil))
(loop for form = (read s nil :eof) until (eq form :eof)
do (setf last-val (eval form)))
last-val))))
(list :status :success
:result (format nil "~a" result)
:output (get-output-stream-string out)
:error (get-output-stream-string err)))
(error (c)
(list :status :error
:reason (format nil "~a" c)
:output (get-output-stream-string out)
:error (get-output-stream-string err))))))
(defun lisp-format (code-string)
"Attempts to format Lisp code using Emacs batch mode if available."
(handler-case
(let ((tmp-file "/tmp/oc-format-temp.lisp"))
(uiop:with-output-file (s tmp-file :if-exists :supersede)
(format s "~a" code-string))
(multiple-value-bind (out err code)
(uiop:run-program (list "emacs" "--batch" tmp-file
"--eval" "(indent-region (point-min) (point-max))"
"--eval" "(princ (buffer-string))")
:output :string :error-output :string :ignore-error-status t)
(if (= code 0)
out
(progn
(harness-log "FORMAT ERROR: ~a" err)
code-string))))
(error (c)
(harness-log "FORMAT EXCEPTION: ~a" c)
code-string)))
(defun lisp-extract (code function-name)
"Extracts the definition of a specific function from a code string."
(let ((*read-eval* nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
when (and (listp form)
(symbolp (car form))
(member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
(symbolp (second form))
(string-equal (symbol-name (second form)) function-name))
do (return-from lisp-extract (format nil "~s" form))))
nil))
(defun lisp-wrap (code target-name wrapper-symbol)
"Wraps a specific form in a wrapper form (e.g., wrap in a let)."
(let ((*read-eval* nil) (results nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
do (if (and (listp form)
(symbolp (second form))
(string-equal (symbol-name (second form)) target-name))
(push (list wrapper-symbol form) results)
(push form results))))
(format nil "~{~s~^~%~%~}" (nreverse results))))
(defun lisp-list-definitions (code)
"Returns a list of names for all top-level definitions (defun, defmacro, etc.)."
(let ((*read-eval* nil) (names nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
when (and (listp form)
(symbolp (car form))
(member (symbol-name (car form))
'("DEFUN" "DEFMACRO" "DEFMETHOD" "DEFVAR" "DEFPARAMETER")
:test #'string-equal)
(symbolp (second form)))
do (push (second form) names)))
(nreverse names)))
(defun lisp-inject (code target-name new-form-string)
"Injects a new form into the body of a targeted definition."
(let ((*read-eval* nil)
(new-form (read-from-string new-form-string))
(results nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
do (if (and (listp form)
(symbolp (car form))
(member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
(symbolp (second form))
(string-equal (symbol-name (second form)) target-name))
(push (append form (list new-form)) results)
(push form results))))
(format nil "~{~s~^~%~%~}" (nreverse results))))
(defun lisp-slurp (code target-name form-to-slurp-string)
"Adds a form to the end of a named list or definition (Paredit slurp)."
(let ((*read-eval* nil)
(to-slurp (read-from-string form-to-slurp-string))
(results nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
do (if (and (listp form)
(symbolp (second form))
(string-equal (symbol-name (second form)) target-name))
(push (append form (list to-slurp)) results)
(push form results))))
(format nil "~{~s~^~%~%~}" (nreverse results))))
(defskill :passepartout-programming-lisp
:priority 400
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
(defpackage :passepartout-utils-lisp-tests
(:use :cl :fiveam :passepartout)
(:export #:utils-lisp-suite))
(in-package :passepartout-utils-lisp-tests)
(def-suite utils-lisp-suite
:description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
(in-suite utils-lisp-suite)
(test structural-balanced
(is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
(test structural-unbalanced-open
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
(is (null ok))
(is (search "Reader Error" reason))))
(test structural-unbalanced-close
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
(is (null ok))
(is (search "Reader Error" reason))))
(test syntactic-valid
(is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
(test semantic-safe
(is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
(test semantic-blocked-eval
(multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
(is (null ok))
(is (search "Unsafe" reason))))
(test unified-success
(let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
(is (eq (getf result :status) :success))))
(test unified-failure
(let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
(is (eq (getf result :status) :error))))
(test eval-basic
(let ((result (passepartout:lisp-eval "(+ 1 2)")))
(is (eq (getf result :status) :success))
(is (string= (getf result :result) "3"))))
(test structural-extract
(let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
(extracted (passepartout:lisp-extract code "hello")))
(is (not (null extracted)))
(let ((form (read-from-string extracted)))
(is (eq (car form) 'DEFUN))
(is (eq (second form) 'HELLO)))))
(test list-definitions
(let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
(let ((names (passepartout:lisp-list-definitions code)))
(is (member 'FOO names))
(is (member 'BAR names))
(is (member '*BAZ* names)))))
(test structural-inject
(let* ((code "(defun my-fun (x) (print x))")
(injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
(let ((form (read-from-string injected)))
(is (equal (last form) '((FINISH-OUTPUT)))))))
(test structural-slurp
(let* ((code "(defun work () (step-1))")
(slurped (passepartout:lisp-slurp code "work" "(step-2)")))
(let ((form (read-from-string slurped)))
(is (equal (last form) '((STEP-2)))))))

13
lisp/programming-literate.lisp Normal file
View File

@@ -0,0 +1,13 @@
(defun literate-block-balance-check (org-file)
"Verifies that all Lisp source blocks in an Org file are balanced."
(harness-log "LITERATE: Checking block balance for ~a" org-file)
t)
(defun literate-tangle-sync-check (org-file lisp-file)
"Verifies that the Lisp file matches the tangled output of the Org file."
(harness-log "LITERATE: Checking tangle sync for ~a <-> ~a" org-file lisp-file)
t)
(defskill :passepartout-programming-literate
:priority 300
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

193
lisp/programming-org.lisp Normal file
View File

@@ -0,0 +1,193 @@
(defun org-filetags-extract (content)
"Extracts the list of tags from a #+FILETAGS: line."
(let ((lines (uiop:split-string content :separator '(#\Newline))))
(dolist (line lines)
(when (uiop:string-prefix-p "#+FILETAGS:" (string-trim '(#\Space) line))
(let ((tag-str (string-trim " :" (subseq (string-trim '(#\Space) line) 10))))
(return-from org-filetags-extract
(mapcar (lambda (tag) (format nil ":~a" (string-trim '(#\Space) tag)))
(uiop:split-string tag-str :separator '(#\space #\tab))))))))
nil)
(defun org-privacy-tag-p (tags-list)
"Returns T if any tag in TAGS-LIST matches bouncer-privacy-tags."
(let ((privacy-tags (symbol-value (find-symbol "BOUNCER-PRIVACY-TAGS" :passepartout))))
(when (and tags-list privacy-tags)
(some (lambda (tag)
(some (lambda (private-tag)
(string-equal (string-trim '(#\: #\space) tag)
(string-trim '(#\: #\space) private-tag))
privacy-tags))
tags-list)))))
(defun org-privacy-strip (content)
"Removes Org headlines whose :TAGS: property contains a privacy-filtered tag.
Returns the filtered content as a string."
(let* ((lines (uiop:split-string content :separator '(#\Newline)))
(result-lines nil)
(skip-depth nil)
(current-tags nil)
(in-properties nil))
(dolist (line lines)
(cond
(skip-depth
;; We're inside a skipped subtree
(when (and (uiop:string-prefix-p "*" (string-trim '(#\Space) line))
(<= (length (string-trim '(#\Space) line)) skip-depth))
(setf skip-depth nil)))
((uiop:string-prefix-p ":PROPERTIES:" (string-trim '(#\Space) line))
(setf in-properties t)
(push line result-lines))
((uiop:string-prefix-p ":END:" (string-trim '(#\Space) line))
(setf in-properties nil)
(when current-tags
(when (org-privacy-tag-p (reverse current-tags))
(setf skip-depth
(length (car (last result-lines
(1+ (position-if
(lambda (l)
(uiop:string-prefix-p "*" (string-trim '(#\Space) l)))
(reverse result-lines))))))))
(setf current-tags nil))
(push line result-lines))
((and in-properties (uiop:string-prefix-p ":TAGS:" (string-trim '(#\Space) line)))
(let ((tag-val (string-trim '(#\Space) (subseq (string-trim '(#\Space) line) 6))))
(setf current-tags (uiop:split-string tag-val :separator '(#\space #\tab))))
(push line result-lines))
(t
(push line result-lines))))
(format nil "~{~a~%~}" (nreverse result-lines))))
(defun org-read-file (filepath)
"Reads an Org file into a string, applying privacy filtering."
(let* ((raw (uiop:read-file-string filepath))
(filetags (org-filetags-extract raw)))
(if (org-privacy-tag-p filetags)
(progn
(harness-log "UTILS-ORG: Blocked read of ~a — file-level privacy tag(s) ~a" filepath filetags)
nil)
(org-privacy-strip raw))))
(defun org-write-file (filepath content)
"Writes content to an Org file."
(uiop:with-output-file (s filepath :if-exists :supersede)
(format s "~a" content)))
(defun org-id-generate ()
"Generates a new UUID for an Org node."
(string-downcase (format nil "~a" (uuid:make-v4-uuid))))
(defun org-id-format (id)
"Ensures the ID has the 'id:' prefix."
(if (uiop:string-prefix-p "id:" id)
id
(format nil "id:~a" id)))
(defun org-property-set (ast target-id property value)
"Recursively sets a property on a headline with a matching ID in the AST."
(let ((type (getf ast :type))
(props (getf ast :properties))
(contents (getf ast :contents)))
(when (and (eq type :HEADLINE) (string= (getf props :ID) target-id))
(setf (getf (getf ast :properties) property) value)
(return-from org-property-set t))
(dolist (child contents)
(when (listp child)
(when (org-property-set child target-id property value)
(return-from org-property-set t)))))
nil)
(defun org-todo-set (ast target-id status)
"Sets the TODO status of a headline in the AST."
(org-property-set ast target-id :TODO status))
(defun org-headline-add (ast parent-id title)
"Adds a new headline as a child of the parent-id in the AST."
(let* ((type (getf ast :type))
(props (getf ast :properties))
(id (getf props :ID))
(contents (getf ast :contents)))
(when (and (eq type :HEADLINE) (string= id parent-id))
(let ((new-node (list :type :HEADLINE
:properties (list :ID (org-id-format (org-id-generate))
:TITLE title)
:contents nil)))
(setf (getf ast :contents) (append contents (list new-node)))
(return-from org-headline-add t)))
(dolist (child contents)
(when (listp child)
(when (org-headline-add child parent-id title)
(return-from org-headline-add t)))))
nil)
(defun org-headline-find-by-id (ast id)
"Finds a headline by its ID in the AST."
(let ((props (getf ast :properties)))
(when (string= (getf props :ID) id)
(return-from org-headline-find-by-id ast))
(dolist (child (getf ast :contents))
(when (listp child)
(let ((found (org-headline-find-by-id child id)))
(when found (return-from org-headline-find-by-id found)))))
nil))
(defun org-headline-find-by-title (ast title)
"Finds a headline by its title in the AST."
(let ((props (getf ast :properties)))
(when (string-equal (getf props :TITLE) title)
(return-from org-headline-find-by-title ast))
(dolist (child (getf ast :contents))
(when (listp child)
(let ((found (org-headline-find-by-title child title)))
(when found (return-from org-headline-find-by-title found)))))
nil))
(defun org-modify (filepath id changes)
"Placeholder for Emacs-driven modification of a specific node."
(declare (ignore changes))
(harness-log "UTILS-ORG: Applying changes to ~a in ~a" id filepath)
t)
(defun org-ast-render (ast)
"Minimal converter from AST back to Org text (Placeholder)."
(declare (ignore ast))
"* TITLE (Placeholder)")
(defskill :passepartout-programming-org
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
(defpackage :passepartout-utils-org-tests
(:use :cl :fiveam :passepartout)
(:export #:utils-org-suite))
(in-package :passepartout-utils-org-tests)
(def-suite utils-org-suite
:description "Tests for Utils Org skill.")
(in-suite utils-org-suite)
(test id-generation
(let ((id1 (org-id-generate))
(id2 (org-id-generate)))
(is (plusp (length id1)))
(is (not (string= id1 id2)))))
(test id-format
(let ((formatted (org-id-format "abc12345")))
(is (search "id:" formatted))))
(test property-setter
(let ((ast (list :type :HEADLINE
:properties (list :ID "id:test123" :TITLE "Test")
:contents nil)))
(org-property-set ast "id:test123" :STATUS "ACTIVE")
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
(test todo-setter
(let ((ast (list :type :HEADLINE
:properties (list :ID "id:todo001" :TITLE "Task")
:contents nil)))
(org-todo-set ast "id:todo001" "DONE")
(is (string= (getf (getf ast :properties) :TODO) "DONE"))))

124
lisp/programming-repl.lisp Normal file
View File

@@ -0,0 +1,124 @@
(in-package :passepartout)
(defvar *repl-package* :passepartout
"Default package for REPL evaluations.")
(defvar *repl-history* nil
"History of evaluated forms for session continuity.")
(defvar *repl-variables* (make-hash-table :test #'eq)
"Cache of bound variables for inspection.")
(defun repl-eval (code-string &key (package *repl-package*))
"Evaluate Lisp code and return (values result output error).
- result: the return value as string
- output: captured stdout
- error: error message or nil on success"
(let ((out (make-string-output-stream))
(err (make-string-output-stream))
(pkg (or (find-package package) (find-package :passepartout))))
(handler-case
(let* ((*standard-output* out)
(*error-output* err)
(*package* pkg)
(*read-eval* nil)
(result nil))
(with-input-from-string (s code-string)
(loop for form = (read s nil :eof) until (eq form :eof)
do (setf result (eval form))))
(push code-string *repl-history*)
(values
(format nil "~a" result)
(get-output-stream-string out)
nil))
(error (c)
(values
nil
(get-output-stream-string out)
(format nil "~a" c))))))
(defun repl-inspect (symbol-name &key (package *repl-package*))
"Inspect a variable's value and structure."
(let* ((pkg (or (find-package package) (find-package :passepartout)))
(sym (find-symbol (string-upcase symbol-name) pkg)))
(cond
((null sym)
(format nil "Symbol ~a not found in package ~a" symbol-name package))
((boundp sym)
(let ((val (symbol-value sym)))
(format nil "~a = ~a~%Type: ~a~%~%"
sym val (type-of val))))
((fboundp sym)
(format nil "~a is a function~%Args: ~a~%"
sym (documentation sym 'function)))
(t
(format nil "~a is unbound" symbol-name)))))
(defun repl-list-vars (&key (package *repl-package*))
"List all bound variables in the package."
(let* ((pkg (or (find-package package) (find-package :passepartout)))
(vars nil))
(do-symbols (sym pkg)
(when (boundp sym)
(push (format nil "~a" sym) vars)))
(sort vars #'string<)))
(defun repl-load-file (filepath)
"Load a Lisp file into the current image."
(handler-case
(progn
(load filepath)
(format nil "Loaded ~a" filepath))
(error (c)
(format nil "Error loading ~a: ~a" filepath c))))
(defun repl-set-package (package-name)
"Set the default package for REPL evaluations."
(let ((pkg (find-package (string-upcase package-name))))
(if pkg
(setf *repl-package* pkg)
(format nil "Package ~a not found" package-name))))
(defun repl-help ()
"Return available REPL commands."
(format nil "~%
REPL Skill Commands:
-------------------
(repl-eval \"code\" :package :passepartout)
- Evaluate Lisp code, returns (values result output error)
(repl-inspect \"symbol\" :package :passepartout)
- Inspect a variable or function
(repl-list-vars :package :passepartout)
- List all bound variables
(repl-load-file \"/path/to/file.lisp\")
- Load a file into the image
(repl-set-package :package-name)
- Switch default package
(repl-help)
- Show this message
"))
(defun repl-mandate (context)
"Returns REPL-first engineering mandate when context involves code editing."
(let ((raw (or (proto-get (proto-get context :payload) :text) "")))
(when (or (search "org-skill-" raw :test #'char-equal)
(and (search ".org" raw :test #'char-equal)
(or (search "defun" raw :test #'char-equal)
(search "tangle" raw :test #'char-equal)
(search "write-file" raw :test #'char-equal)
(search "lisp" raw :test #'char-equal)))
(search "defun " raw :test #'char-equal)
(search "repl-eval" raw :test #'char-equal)
(search "validate" raw :test #'char-equal))
(format nil "~%REPL-FIRST MANDATE:~%Before writing any defun to an Org file, prototype it in the REPL first. Set :repl-verified t on the write action. On rejection, fix the error and retry.~%"))))
(defskill :passepartout-programming-repl
:priority 200
:trigger (lambda (ctx) (declare (ignore ctx)) nil)
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)
:system-prompt-augment #'repl-mandate)

21
lisp/programming-standards.lisp Normal file
View File

@@ -0,0 +1,21 @@
(defun standards-git-clean-p (dir)
"Checks if a directory has uncommitted changes."
(let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain")
:output :string
:ignore-error-status t)))
(string= "" (string-trim '(#\Space #\Newline #\Tab) status))))
(defun standards-lisp-verify (code)
"Enforces Lisp structural and semantic standards using utils-lisp."
(let ((result (utils-lisp-validate code :strict t)))
(if (eq (getf result :status) :success)
t
(error (getf result :reason)))))
(defun standards-lisp-format (code)
"Ensures Lisp code adheres to formatting standards."
(utils-lisp-format code))
(defskill :passepartout-programming-standards
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

327
lisp/security-dispatcher.lisp Normal file
View File

@@ -0,0 +1,327 @@
(defvar *dispatcher-network-whitelist*
'("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")
"Domains the Bouncer considers safe for outbound connections.")
(defvar *dispatcher-privacy-tags*
(let ((env (uiop:getenv "PRIVACY_FILTER_TAGS")))
(if env
(uiop:split-string env :separator '(#\,))
'("@personal")))
"Tags marking content as private. Set via PRIVACY_FILTER_TAGS.")
(defvar *dispatcher-protected-paths*
'(".env" ".env.example" ".env.local" ".env.production"
"*credentials*" "*cred*"
"*id_rsa*" "*id_dsa*" "*id_ecdsa*" "*id_ed25519*"
"*.pem" "*.key" "*.p12" "*.pfx" "*.asc" "*.gpg" "*.pgp"
"secring.*" "pubring.*" "private-keys-v1.d/*"
"token*" "*secret*" "*token*"
".netrc" ".git-credentials" "auth.json"
".aws/credentials" ".aws/config"
".kube/config" "kubeconfig"
"*.cert" "*.crt" "*.csr"
"*password*" "*passwd*")
"Path patterns blocked from file reads.")
(defvar *dispatcher-exposure-patterns*
'((:pem-key "-----BEGIN +(RSA|DSA|EC|OPENSSH|PGP) +PRIVATE +KEY *-----")
(:pgp-key "-----BEGIN +PGP +PRIVATE +KEY +BLOCK-----")
(:pgp-public "-----BEGIN +PGP +PUBLIC +KEY +BLOCK-----")
(:openai-key "sk-[A-Za-z0-9-]{20,}")
(:google-key "AIza[0-9A-Za-z_-]{35}")
(:github-token "gh[pousr]_[A-Za-z0-9]{36,}")
(:slack-token "xox[baprs]-[A-Za-z0-9-]{24,}")
(:env-assignment "[A-Z_]+=[A-Za-z0-9+/=_\\-]{20,}")
(:generic-secret "(api|secret|password|token)[ ]*[:=][ ]*[\"']?[A-Za-z0-9_\\-]{16,}"))
"Named regex patterns for secret exposure detection.")
(defvar *dispatcher-shell-timeout* 30
"Maximum seconds for a shell command before timeout.")
(defvar *dispatcher-shell-max-output* 100000
"Maximum characters of shell output to capture.")
(defvar *dispatcher-shell-blocked*
'((:destructive-rm "\\brm\\s+-rf\\s+/")
(:destructive-dd "\\bdd\\s+if=")
(:destructive-mkfs "\\bmkfs\\.")
(:destructive-format "\\bmformat\\b")
(:disk-wipe "\\bshred\\s+/dev/")
(:disk-wipe-b "\\bwipefs\\s+/dev/")
(:injection-backtick "`[^`]+`")
(:injection-subshell "\\$\\([^)]+\\)"))
"Destructive and injection patterns blocked in shell commands.")
(defun wildcard-match (pattern path)
"Matches PATH against PATTERN where * matches any characters."
(let ((regex (cl-ppcre:regex-replace-all
"\\*" (cl-ppcre:quote-meta-chars pattern) ".*")))
(cl-ppcre:scan regex path)))
(defun dispatcher-check-secret-path (filepath)
"Returns the matching pattern if FILEPATH matches a protected path, nil otherwise."
(when (and filepath (stringp filepath))
(some (lambda (pattern)
(when (wildcard-match pattern filepath)
pattern))
*dispatcher-protected-paths*)))
(defun dispatcher-exposure-scan (text)
"Scans TEXT for patterns matching known secret formats.
Returns a list of matched category keywords."
(when (and text (stringp text) (> (length text) 0))
(let ((matches nil))
(dolist (entry *dispatcher-exposure-patterns*)
(let ((name (first entry))
(regex (second entry)))
(when (cl-ppcre:scan regex text)
(push name matches))))
matches)))
(defun dispatcher-vault-scan (text)
"Scans TEXT for known secrets from the vault."
(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))))
*vault-memory*)
found-secret)))
(defun dispatcher-check-privacy-tags (tags-list)
"Returns T if any tag in TAGS-LIST matches a privacy filter tag."
(when (and tags-list (listp tags-list))
(some (lambda (tag)
(some (lambda (private)
(or (string-equal tag private)
(search private tag :test #'string-equal)))
*dispatcher-privacy-tags*))
tags-list)))
(defun dispatcher-check-text-for-privacy (text)
"Scans TEXT for leaked privacy-tagged content."
(when (and text (stringp text))
(let ((lower (string-downcase text)))
(some (lambda (tag)
(search (string-downcase tag) lower))
*dispatcher-privacy-tags*))))
(defun org-blocks-extract (content)
"Extracts concatenated Lisp code from #+begin_src lisp blocks in an Org string."
(when (and content (stringp content))
(let ((lines (uiop:split-string content :separator '(#\Newline)))
(in-block nil)
(code ""))
(dolist (line lines)
(let ((clean (string-trim '(#\Space #\Tab) line)))
(cond
((search "#+begin_src lisp" clean)
(setf in-block t))
((search "#+end_src" clean)
(setf in-block nil))
(in-block
(setf code (concatenate 'string code line (string #\Newline)))))))
(when (> (length code) 0) code))))
(defun dispatcher-check-lisp-valid (filepath content)
"Validates Lisp syntax when writing .lisp files or Org files with lisp blocks.
Returns the validation result plist or nil if not applicable."
(when (and content (stringp content) (> (length content) 0))
(let ((to-validate
(cond
((uiop:string-suffix-p filepath ".lisp") content)
((uiop:string-suffix-p filepath ".org") (org-blocks-extract content))
(t nil))))
(when to-validate
(multiple-value-bind (valid-p err) (ignore-errors
(let ((*read-eval* nil))
(with-input-from-string (s (format nil "(progn ~a)" to-validate))
(loop for form = (read s nil :eof) until (eq form :eof)))
(values t nil)))
(unless valid-p
(list :status :error :reason err)))))))
(defun org-has-defuns-p (content)
"Returns T if the Org content contains any #+begin_src lisp blocks with defuns."
(when (and content (stringp content))
(search "defun " content :test #'char-equal)))
(defun dispatcher-check-repl-verified (action filepath content)
"Warns if writing a defun to an Org file without :repl-verified metadata."
(let ((repl-verified (getf action :repl-verified)))
(when (and filepath
(uiop:string-suffix-p filepath ".org")
(org-has-defuns-p content)
(not repl-verified))
(list :type :LOG
:payload (list :level :warn
:text (format nil "Lint: Writing defun to ~a without :repl-verified flag. Did you prototype this in the REPL first?" filepath))))))
(defun dispatcher-check-shell-safety (cmd)
"Checks a shell command for destructive patterns and injection vectors.
Returns a list of matched pattern names or nil if safe."
(when (and cmd (stringp cmd) (> (length cmd) 0))
(let ((matches nil))
(dolist (entry *dispatcher-shell-blocked*)
(let ((name (first entry))
(regex (second entry)))
(when (cl-ppcre:scan regex cmd)
(push name matches))))
matches)))
(defun dispatcher-check-network-exfil (cmd)
"Detects if CMD attempts to contact an unwhitelisted external host."
(when (and cmd (stringp cmd))
(multiple-value-bind (match regs)
(cl-ppcre:scan-to-strings "(http|https|ftp)://([\\w\\.-]+)" cmd)
(declare (ignore match))
(when regs
(let ((domain (aref regs 1)))
(not (some (lambda (safe) (search safe domain))
*dispatcher-network-whitelist*)))))))
(defun dispatcher-check (action context)
"Security gate for high-risk actions.
Vectors: lisp validation, secret path, secret content, vault secrets,
privacy tags, privacy text, shell safety, network exfil, high-impact approval."
(declare (ignore context))
(let* ((target (proto-get action :target))
(payload (proto-get action :payload))
(text (or (proto-get payload :text) (proto-get action :text)))
(filepath (or (proto-get payload :filepath)
(when (equal (proto-get payload :tool) "read-file")
(proto-get (proto-get payload :args) :filepath))
(when (equal (proto-get payload :tool) "write-file")
(proto-get (proto-get payload :args) :filepath))))
(content (when filepath (proto-get (proto-get payload :args) :content)))
(cmd (or (proto-get payload :cmd)
(when (and (eq target :tool) (equal (proto-get payload :tool) "shell"))
(proto-get (proto-get payload :args) :cmd))))
(approved (proto-get action :approved))
(tags (proto-get payload :tags))
(lisp-valid (when (and filepath content (not approved))
(dispatcher-check-lisp-valid filepath content)))
(repl-lint (when (and filepath content (not approved))
(dispatcher-check-repl-verified action filepath content))))
(cond
(approved action)
;; Vector 0: REPL verification lint (warn, don't block)
(repl-lint
(harness-log "BOUNCER: ~a" (proto-get repl-lint :text))
action)
;; Vector 1: Lisp syntax validation (block bad lisp writes)
((and lisp-valid (eq (getf lisp-valid :status) :error))
(harness-log "LINT VIOLATION: Blocked write — lisp syntax error in ~a: ~a" filepath (getf lisp-valid :reason))
(list :type :LOG
:payload (list :level :error
:text (format nil "Lisp syntax error in ~a: ~a. The write was blocked. Fix the parenthesis balance and retry." filepath (getf lisp-valid :reason)))))
;; Vector 2: File read to a protected secret path
((and filepath (dispatcher-check-secret-path filepath))
(let ((matched (dispatcher-check-secret-path filepath)))
(harness-log "SECURITY VIOLATION: Blocked read of protected path '~a' (matched: ~a)" filepath matched)
(list :type :LOG
:payload (list :level :error
:text (format nil "Action blocked: Attempted read of protected path '~a'" filepath)))))
;; Vector 3: Content contains secret patterns
((and text (dispatcher-exposure-scan text))
(let ((matched (dispatcher-exposure-scan text)))
(harness-log "SECURITY VIOLATION: Content contains secret patterns: ~a" matched)
(list :type :LOG
:payload (list :level :error
:text "Action blocked: Content contains potential secret exposure."))))
;; Vector 4: Content contains vault secrets
((and text (dispatcher-vault-scan text))
(let ((secret-name (dispatcher-vault-scan text)))
(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)))))
;; Vector 5: Privacy-tagged content in action
((and tags (dispatcher-check-privacy-tags tags))
(harness-log "PRIVACY VIOLATION: Action contains privacy-tagged content")
(list :type :LOG
:payload (list :level :warn
:text "Action blocked: Content tagged with privacy filter.")))
;; Vector 6: Text leaks privacy tag names
((and text (dispatcher-check-text-for-privacy text))
(harness-log "PRIVACY WARNING: Text may contain leaked private content")
(list :type :LOG
:payload (list :level :warn
:text "Action blocked: Text may reference private content.")))
;; Vector 7: Shell destructive/injection patterns
((and cmd (dispatcher-check-shell-safety cmd))
(let ((matched (dispatcher-check-shell-safety cmd)))
(harness-log "SHELL VIOLATION: Destructive or injection pattern in command: ~a" matched)
(list :type :LOG
:payload (list :level :error
:text (format nil "Shell command blocked: contains unsafe pattern ~a" matched)))))
;; Vector 8: Network exfiltration
((and (or (eq target :shell)
(and (eq target :tool) (equal (proto-get payload :tool) "shell")))
(dispatcher-check-network-exfil cmd))
(harness-log "SECURITY WARNING: External network call detected. Queuing for approval.")
(list :type :EVENT :payload (list :sensor :approval-required :action action)))
;; Vector 8: High-impact action approval
((or (member target '(:shell))
(and (eq target :tool) (member (proto-get payload :tool) '("shell" "repair-file") :test #'string=))
(and (eq target :emacs) (eq (proto-get payload :action) :eval)))
(harness-log "SECURITY: High-impact action requires approval: ~a" (or (proto-get payload :tool) target))
(list :type :EVENT :payload (list :sensor :approval-required :action action)))
(t action))))
(defun dispatcher-approvals-process ()
"Scans for APPROVED flight plans and re-injects them."
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
(found-any nil))
(dolist (node approved-nodes)
(let* ((attrs (org-object-attributes node))
(tags (getf attrs :TAGS))
(action-str (getf attrs :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
(setf (getf action :approved) t)
(inject-stimulus action)
(setf (getf (org-object-attributes node) :TODO) "DONE")
(setq found-any t))))))
found-any))
(defun dispatcher-flight-plan-create (blocked-action)
"Creates a Flight Plan node for manual approval."
(let ((id (org-id-new)))
(harness-log "BOUNCER: Creating flight plan node '~a'..." id)
(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))))))
(defun dispatcher-gate (action context)
"Main deterministic gate for the Bouncer skill."
(let* ((payload (getf context :payload))
(sensor (getf payload :sensor)))
(case sensor
(:approval-required
(dispatcher-flight-plan-create (getf payload :action)))
(:heartbeat
(dispatcher-approvals-process)
(if action (dispatcher-check action context) action))
(otherwise
(if action (dispatcher-check action context) action)))))
(defskill :passepartout-security-dispatcher
:priority 150
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic #'dispatcher-gate)

13
lisp/security-permissions.lisp Normal file
View File

@@ -0,0 +1,13 @@
(defvar *permission-table* (make-hash-table :test 'equal))
(defun permission-set (tool-name level)
"Sets the permission level for a tool."
(setf (gethash (string-downcase (string tool-name)) *permission-table*) level))
(defun permission-get (tool-name)
"Retrieves the permission level for a tool. Defaults to :ask."
(gethash (string-downcase (string tool-name)) *permission-table* :ask))
(defskill :passepartout-security-permissions
:priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

22
skills/org-skill-policy.org → lisp/security-policy.lisp
View File

@@ -1,16 +1,4 @@
#+TITLE: SKILL: Policy (org-skill-policy.org) (defun policy-compliance-check (action context)
#+AUTHOR: Agent
#+FILETAGS: :system:policy:constitutional:
#+PROPERTY: header-args:lisp :tangle org-skill-policy.lisp
* Overview
The *Policy Skill* is the constitutional layer of OpenCortex. It enforces foundational invariants like transparency and autonomy on all proposed actions.
* Implementation
** Policy Logic (policy-check)
#+begin_src lisp
(defun policy-check (action context)
"Enforces constitutional invariants on proposed actions." "Enforces constitutional invariants on proposed actions."
(declare (ignore context)) (declare (ignore context))
(let* ((payload (proto-get action :payload)) (let* ((payload (proto-get action :payload))
@@ -22,12 +10,8 @@ The *Policy Skill* is the constitutional layer of OpenCortex. It enforces founda
(list :type :LOG (list :type :LOG
:payload (list :level :warn :payload (list :level :warn
:text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning.")))))) :text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning."))))))
#+end_src
** Skill Registration (defskill :passepartout-security-policy
#+begin_src lisp
(defskill :skill-policy
:priority 500 :priority 500
:trigger (lambda (ctx) (declare (ignore ctx)) t) :trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic #'policy-check) :deterministic #'policy-compliance-check)
#+end_src

13
lisp/security-validator.lisp Normal file
View File

@@ -0,0 +1,13 @@
(defun validator-protocol-check (msg)
"Enforces structural schema compliance on protocol messages."
(validate-communication-protocol-schema msg))
(defskill :passepartout-security-validator
:priority 95
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(handler-case
(progn (validator-protocol-check action) action)
(error (c)
(list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))

25
lisp/security-vault.lisp Normal file
View File

@@ -0,0 +1,25 @@
(defvar *vault-memory* (make-hash-table :test 'equal)
"In-memory cache of sensitive credentials.")
(defun vault-get (provider &key (type :api-key))
"Retrieves a credential from the vault or environment."
(let* ((key (format nil "~a-~a" provider type))
(val (gethash key *vault-memory*)))
(if val
val
(let ((env-var (case provider
(:gemini "GEMINI_API_KEY")
(:openai "OPENAI_API_KEY")
(:anthropic "ANTHROPIC_API_KEY")
(:openrouter "OPENROUTER_API_KEY")
(otherwise nil))))
(when env-var (uiop:getenv env-var))))))
(defun vault-set (provider secret &key (type :api-key))
"Stores a secret in the vault."
(let ((key (format nil "~a-~a" provider type)))
(setf (gethash key *vault-memory*) secret)))
(defskill :passepartout-security-vault
:priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

26
skills/org-skill-shell-actuator.org → lisp/system-actuator-shell.lisp
View File

@@ -1,23 +1,11 @@
#+TITLE: SKILL: Shell Actuator (org-skill-shell-actuator.org) (defun actuator-shell-execute (action context)
#+AUTHOR: Agent
#+FILETAGS: :skill:actuator:shell:
#+PROPERTY: header-args:lisp :tangle org-skill-shell-actuator.lisp
* Overview
The *Shell Actuator* provides the agent with the capability to execute bash commands.
* Implementation
** Shell Execution (shell-execute)
#+begin_src lisp
(defun shell-execute (action context)
"Executes a bash command with timeout (via timeout(1)) and output limit." "Executes a bash command with timeout (via timeout(1)) and output limit."
(declare (ignore context)) (declare (ignore context))
(let* ((payload (getf action :payload)) (let* ((payload (getf action :payload))
(cmd (getf payload :cmd)) (cmd (getf payload :cmd))
(timeout-sym (find-symbol "*BOUNCER-SHELL-TIMEOUT*" :opencortex)) (timeout-sym (find-symbol "*BOUNCER-SHELL-TIMEOUT*" :passepartout))
(timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30))) (timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30)))
(max-sym (find-symbol "*BOUNCER-SHELL-MAX-OUTPUT*" :opencortex)) (max-sym (find-symbol "*BOUNCER-SHELL-MAX-OUTPUT*" :passepartout))
(max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000))) (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))
(wrapped-cmd (format nil "timeout ~a bash -c ~s" timeout cmd))) (wrapped-cmd (format nil "timeout ~a bash -c ~s" timeout cmd)))
(harness-log "ACT [Shell]: ~a (timeout: ~as)" cmd timeout) (harness-log "ACT [Shell]: ~a (timeout: ~as)" cmd timeout)
@@ -31,13 +19,9 @@ The *Shell Actuator* provides the agent with the capability to execute bash comm
(format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output)) (format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output))
((= code 0) out) ((= code 0) out)
(t (format nil "ERROR [~a]: ~a" code err)))))) (t (format nil "ERROR [~a]: ~a" code err))))))
#+end_src
** Skill Registration (register-actuator :shell #'actuator-shell-execute)
#+begin_src lisp
(register-actuator :shell #'shell-execute)
(defskill :skill-shell-actuator (defskill :passepartout-system-actuator-shell
:priority 50 :priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src

10
lisp/system-archivist.lisp Normal file
View File

@@ -0,0 +1,10 @@
(defun archivist-log (signal)
"Logs a metabolic signal for later analysis."
(let ((type (getf signal :type))
(payload (getf signal :payload)))
(harness-log "SCRIBE: [~a] ~s" type payload)))
(defskill :passepartout-system-archivist
:priority 100
:trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :STATUS)))
:deterministic (lambda (action ctx) (declare (ignore action)) (archivist-log ctx) nil))

243
lisp/system-config.lisp Normal file
View File

@@ -0,0 +1,243 @@
(defun config-directory ()
"Returns the absolute path to the opencortex config directory."
(let ((xdg (uiop:getenv "OC_CONFIG_DIR")))
(if xdg xdg (namestring (merge-pathnames ".config/passepartout/" (user-homedir-pathname))))))
(defun config-file-path ()
"Returns the path to the .env configuration file."
(merge-pathnames ".env" (config-directory)))
(defun config-directory-ensure ()
"Creates the configuration directory if it does not exist."
(ensure-directories-exist (config-directory)))
(defun config-read ()
"Reads the .env config file and returns an alist of KEY=VALUE pairs."
(let ((config-file (config-file-path)))
(when (uiop:file-exists-p config-file)
(let ((lines (uiop:read-file-lines config-file))
(result nil))
(dolist (line lines)
(when (and line (> (length line) 0)
(not (uiop:string-prefix-p "#" line)))
(let ((eq-pos (position #\= line)))
(when eq-pos
(let ((key (string-trim " " (subseq line 0 eq-pos)))
(value (string-trim " " (subseq line (1+ eq-pos)))))
(push (cons key value) result))))))
(nreverse result)))))
(defun config-write (config-alist)
"Writes the config alist to the .env file."
(config-directory-ensure)
(let ((config-file (config-file-path)))
(with-open-file (stream config-file :direction :output :if-exists :supersede :if-does-not-exist :create)
(format stream "# Passepartout Configuration~%")
(format stream "# Generated by opencortex setup~%~%")
(dolist (pair config-alist)
(format stream "~a=~a~%" (car pair) (cdr pair))))))
(defun config-get (key)
"Gets a config value by key."
(let ((config (config-read)))
(cdr (assoc key config :test #'string=))))
(defun config-set (key value)
"Sets a config value and saves to file."
(let ((config (config-read))
(pair (cons key value)))
(let ((existing (assoc key config :test #'string=)))
(if existing
(setf (cdr existing) value)
(push pair config))
(config-write config))))
(defun prompt (prompt-text)
"Simple prompt that returns user input as a string."
(format t "~a" prompt-text)
(finish-output)
(read-line))
(defun prompt-yes-no (prompt-text)
"Prompts yes/no question. Returns T for yes, nil for no."
(let ((response (prompt (format nil "~a [Y/n]: " prompt-text))))
(or (string= response "")
(string-equal response "Y")
(string-equal response "y")
(string-equal response "yes"))))
(defun prompt-choice (prompt-text options)
"Prompts user to choose from a list of options. Returns the chosen option or nil."
(format t "~a~%" prompt-text)
(let ((i 1))
(dolist (opt options)
(format t " ~a) ~a~%" i opt)
(incf i)))
(let ((response (prompt "Choice")))
(let ((num (ignore-errors (parse-integer response))))
(when (and num (<= 1 num) (>= (length options) num))
(nth (1- num) options)))))
(defparameter *available-providers*
'(("OpenAI" . "OPENAI_API_KEY")
("Anthropic" . "ANTHROPIC_API_KEY")
("OpenRouter" . "OPENROUTER_API_KEY")
("Groq" . "GROQ_API_KEY")
("Gemini" . "GEMINI_API_KEY")
("Ollama (local)" . "OLLAMA_URL")))
(defun setup-llm-providers ()
"Interactive wizard for configuring LLM providers."
(format t "~%~%")
(format t "==================================================~%")
(format t " LLM Provider Configuration~%")
(format t "==================================================~%~%")
(let ((current-providers (loop for (name . key) in *available-providers*
when (config-get key)
collect name)))
(when current-providers
(format t "Current providers: ~{~a~^, ~}~%~%" current-providers))
(format t "Available providers:~%")
(dolist (p *available-providers*)
(format t " - ~a~%" (car p)))
(format t "~%")
(when (prompt-yes-no "Configure a new provider?")
(let ((chosen (prompt-choice "Select provider:" (mapcar #'car *available-providers*))))
(when chosen
(let ((env-key (cdr (assoc chosen *available-providers* :test #'string=))))
(if (string= chosen "Ollama (local)")
(progn
(format t "Enter Ollama URL (e.g., http://localhost:11434): ")
(let ((url (read-line)))
(config-set env-key url)
(format t "✓ Ollama configured at ~a~%" url)))
(progn
(format t "Enter API key for ~a: " chosen)
(let ((key (read-line)))
(config-set env-key key)
(format t "✓ ~a API key saved~%" chosen)))))))))
(format t "~%"))
(defun setup-add-provider ()
"Entry point for adding a single provider (called from CLI)."
(setup-llm-providers))
(defun setup-gateways ()
"Interactive wizard for configuring external gateways."
(format t "~%~%")
(format t "==================================================~%")
(format t " Gateway Configuration~%")
(format t "==================================================~%~%")
(format t "Available gateways:~%")
(format t " - Slack (https://api.slack.com/)~%")
(format t " - Discord (https://discord.com/developers/)~%")
(format t "~%")
(when (prompt-yes-no "Configure a gateway?")
(let ((chosen (prompt-choice "Select platform:" '("Slack" "Discord"))))
(when chosen
(let ((token (prompt (format nil "Enter ~a bot token: " chosen))))
(if (string= chosen "Slack")
(config-set "SLACK_TOKEN" token)
(config-set "DISCORD_TOKEN" token))
(format t "✓ ~a gateway configured~%" chosen)))))
(format t "~%"))
(defun setup-skills ()
"Interactive wizard for enabling/disabling skills."
(format t "~%~%")
(format t "==================================================~%")
(format t " Skill Management~%")
(format t "==================================================~%~%")
(format t "Note: Skill management is not yet implemented.~%")
(format t "Skills are automatically loaded from ~a~%" (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") "~/.local/share/passepartout"))
(format t "~%"))
(defun setup-memory ()
"Interactive wizard for memory settings."
(format t "~%~%")
(format t "==================================================~%")
(format t " Memory Settings~%")
(format t "==================================================~%~%")
(let ((auto-save (prompt "Auto-save interval in seconds [300]:")))
(when (and auto-save (> (length auto-save) 0))
(config-set "MEMORY_AUTO_SAVE_INTERVAL" auto-save)))
(let ((history (prompt "History retention in lines [1000]:")))
(when (and history (> (length history) 0))
(config-set "MEMORY_HISTORY_RETENTION" history)))
(format t "✓ Memory settings saved~%")
(format t "~%"))
(defun setup-network ()
"Interactive wizard for network settings."
(format t "~%~%")
(format t "==================================================~%")
(format t " Network Settings~%")
(format t "==================================================~%~%")
(let ((timeout (prompt "Request timeout in seconds [30]:")))
(when (and timeout (> (length timeout) 0))
(config-set "REQUEST_TIMEOUT" timeout)))
(let ((proxy (prompt "Proxy URL (leave empty for none) []:")))
(when (and proxy (> (length proxy) 0))
(config-set "HTTP_PROXY" proxy)))
(format t "✓ Network settings saved~%")
(format t "~%"))
(defun setup-wizard-run ()
"Main entry point for the interactive setup wizard."
(format t "~%~%")
(format t "╔═══════════════════════════════════════════════════╗~%")
(format t "║ Passepartout Setup Wizard ║~%")
(format t "╚═══════════════════════════════════════════════════╝~%")
(format t "~%")
(format t "This wizard will help you configure:~%")
(format t " 1. LLM Providers (OpenAI, Anthropic, etc.)~%")
(format t " 2. Gateway Links (Slack, Discord)~%")
(format t " 3. Memory Settings~%")
(format t " 4. Network Settings~%")
(format t "~%")
(config-directory-ensure)
;; Step 1: LLM Providers
(when (prompt-yes-no "Configure LLM providers?")
(setup-llm-providers))
;; Step 2: Gateways
(when (prompt-yes-no "Configure gateways?")
(setup-gateways))
;; Step 3: Memory
(when (prompt-yes-no "Configure memory settings?")
(setup-memory))
;; Step 4: Network
(when (prompt-yes-no "Configure network settings?")
(setup-network))
;; Summary
(format t "==================================================~%")
(format t " Setup Complete!~%")
(format t "==================================================~%")
(format t "~%")
(format t "Configuration saved to: ~a~%" (config-file-path))
(format t "~%")
(format t "To verify your setup, run: passepartout doctor~%")
(format t "~%"))
(defskill :passepartout-system-config
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

176
lisp/system-diagnostics.lisp Normal file
View File

@@ -0,0 +1,176 @@
(defvar *diagnostics-binaries* '("sbcl" "emacs" "git" "socat" "nc")
"List of external binaries required for full system operation.")
(defvar *diagnostics-package-map*
'(("sbcl" . "sbcl")
("emacs" . "emacs")
("git" . "git")
("socat" . "socat")
("nc" . "netcat-openbsd")
("curl" . "curl")
("rlwrap" . "rlwrap"))
"Map binary names to apt package names.")
(defvar *doctor-missing-deps* nil
"List of missing dependencies populated by diagnostics-dependencies-check.")
(defvar *doctor-auto-install* t
"When T, doctor will attempt to install missing dependencies automatically.")
(defun diagnostics-dependencies-check ()
"Verifies that required external binaries are available in the PATH via shell probe."
(setf *doctor-missing-deps* nil)
(let ((all-ok t))
(format t "DOCTOR: Checking system dependencies...~%")
(dolist (dep *diagnostics-binaries*)
(let ((path (ignore-errors
(uiop:run-program (list "which" dep)
:output :string :ignore-error-status t))))
(if (and path (> (length path) 0))
(format t " [OK] Found ~a~%" dep)
(progn
(format t " [FAIL] Missing binary: ~a~%" dep)
(push dep *doctor-missing-deps*)
(setf all-ok nil)))))
(when (and all-ok (null *doctor-missing-deps*))
(format t "DOCTOR: All dependencies satisfied.~%"))
all-ok))
(defun diagnostics-dependencies-install ()
"Attempts to install missing system dependencies via apt."
(when (null *doctor-missing-deps*)
(format t "DOCTOR: No missing dependencies to install.~%")
(return-from diagnostics-dependencies-install t))
(format t "DOCTOR: Attempting to install ~a missing dependencies...~%" (length *doctor-missing-deps*))
(let ((packages (remove-duplicates
(mapcar (lambda (dep)
(or (cdr (assoc dep *diagnostics-package-map* :test #'string=))
dep))
*doctor-missing-deps*)
:test #'string=)))
(format t "DOCTOR: Packages to install: ~a~%" packages)
(let ((cmd (format nil "apt-get install -y ~{~a~^ ~}" packages)))
(format t "DOCTOR: Running: ~a~%" cmd)
(handler-case
(let ((output (uiop:run-program cmd
:output :string
:error-output :string
:external-format :utf-8)))
(if (zerop (uiop:run-program (format nil "which ~a" (car *doctor-missing-deps*))
:ignore-error-status t))
(progn
(format t "DOCTOR: Dependencies installed successfully.~%")
(setf *doctor-missing-deps* nil)
t)
(progn
(format t "DOCTOR: Installation failed. Output: ~a~%" output)
nil)))
(error (c)
(format t "DOCTOR: Installation error: ~a~%" c)
nil)))))
(defun diagnostics-env-check ()
"Validates XDG directories and environment configuration."
(format t "DOCTOR: Checking XDG environment...~%")
(let ((all-ok t)
(config-dir (uiop:getenv "PASSEPARTOUT_CONFIG_DIR"))
(data-dir (uiop:getenv "PASSEPARTOUT_DATA_DIR"))
(state-dir (uiop:getenv "PASSEPARTOUT_STATE_DIR"))
(memex-dir (uiop:getenv "MEMEX_DIR")))
(flet ((check-dir (name path critical)
(if (and path (> (length path) 0))
(if (uiop:directory-exists-p path)
(format t " [OK] ~a: ~a~%" name path)
(progn
(format t " [FAIL] ~a directory missing: ~a~%" name path)
(when critical (setf all-ok nil))))
(progn
(format t " [FAIL] ~a variable not set.~%" name)
(when critical (setf all-ok nil))))))
(check-dir "Config (PASSEPARTOUT_CONFIG_DIR)" config-dir t)
(check-dir "Data (PASSEPARTOUT_DATA_DIR)" data-dir t)
(check-dir "State (PASSEPARTOUT_STATE_DIR)" state-dir t)
(check-dir "Memex (MEMEX_DIR)" memex-dir t))
all-ok))
(defun diagnostics-llm-check ()
"Tests connectivity to LLM providers. Returns T if at least one provider is configured."
(format t "DOCTOR: Checking LLM connectivity...~%")
(let ((providers '((:openrouter . "OPENROUTER_API_KEY")
(:anthropic . "ANTHROPIC_API_KEY")
(:openai . "OPENAI_API_KEY")
(:groq . "GROQ_API_KEY")
(:gemini . "GEMINI_API_KEY")
(:deepseek . "DEEPSEEK_API_KEY")
(:nvidia . "NVIDIA_API_KEY")
(:ollama . "OLLAMA_URL")))
(configured nil))
(dolist (p providers)
(let ((env-val (uiop:getenv (cdr p))))
(cond
((and env-val (> (length env-val) 0))
(format t " [OK] ~a configured~%" (car p))
(setf configured t))
((eq (car p) :ollama)
(let ((ollama-check (ignore-errors
(uiop:run-program '("curl" "-s" "http://localhost:11434/api/tags")
:output :string :ignore-error-status t))))
(when (and ollama-check (search "\"models\"" ollama-check))
(format t " [OK] Ollama local model server detected~%")
(setf configured t)))))))
(if configured
(progn
(format t " [OK] LLM provider(s) available~%")
t)
(progn
(format t " [WARN] No LLM provider configured.~%")
(format t " Run 'passepartout configure' to configure a provider.~%")
t))))
(defun diagnostics-run-all (&key (auto-install t))
"Executes the full diagnostic suite and returns T if system is healthy."
(format t "==================================================~%")
(format t " PASSEPARTOUT DOCTOR: Commencing Health Check~%")
(format t "==================================================~%")
(let ((dep-ok (diagnostics-dependencies-check)))
(when (and (not dep-ok) auto-install *doctor-auto-install*)
(format t "DOCTOR: Attempting automatic installation...~%")
(setf dep-ok (diagnostics-dependencies-install))
(when dep-ok
(setf dep-ok (diagnostics-dependencies-check))))
(let ((env-ok (diagnostics-env-check))
(llm-ok (diagnostics-llm-check)))
(format t "==================================================~%")
(if (and dep-ok env-ok)
(progn
(format t " ✓ SYSTEM HEALTHY: Ready for ignition.~%")
t) ;; Explicitly return T
(progn
(format t "==================================================~%")
(format t " ISSUES FOUND:~%")
(when (not dep-ok)
(format t " - Missing system dependencies~%"))
(when (not llm-ok)
(format t " - No LLM provider configured~%"))
(format t "~%")
(format t " RECOMMENDED ACTIONS:~%")
(format t " 1. Run 'passepartout configure' to configure everything~%")
(format t " 2. Or run 'passepartout doctor --fix' for auto-repair~%")
(format t "==================================================~%")
nil))))) ;; Return nil when issues found
(defun diagnostics-main ()
"Entry point for the 'doctor' CLI command."
(if (diagnostics-run-all)
(uiop:quit 0)
(uiop:quit 1)))
(defskill :passepartout-system-diagnostics
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))

7
lisp/system-memory.lisp Normal file
View File

@@ -0,0 +1,7 @@
(defun memory-inspect ()
"Allows the system to inspect its own memory state."
(harness-log "MEMORY: Self-inspection triggered."))
(defskill :passepartout-system-memory
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

18
lisp/system-self-improve-add.lisp Normal file
View File

@@ -0,0 +1,18 @@
(defun self-improve-edit (filepath old-text new-text)
"Applies a transformation to a source file."
(declare (ignore old-text new-text))
(harness-log "SELF-EDIT: Applying changes to ~a" filepath))
(defskill :passepartout-system-self-improve
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
(defun self-improve-fix (skill-name error-log)
"Attempts to diagnose and repair a broken skill."
(declare (ignore error-log))
(harness-log "SELF-FIX: Attempting repair of ~a..." skill-name))
(defskill :passepartout-system-self-improve
:priority 100
:trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :EVENT)))
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))

120
harness/communication.org → org/core-communication.org
View File

@@ -2,49 +2,93 @@
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :harness:protocol: #+FILETAGS: :harness:protocol:
#+STARTUP: content #+STARTUP: content
#+PROPERTY: header-args:lisp :tangle communication.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/core-communication.lisp
* Overview * Overview: Architectural Intent
The ~communication.lisp~ module defines the low-level transport and framing logic for OpenCortex stimuli.
The Communication Protocol defines how Passepartout speaks to the outside world. It sits between the metabolic loop and the network, providing framed, length-prefixed message transport over TCP.
Every message is an S-expression (plist) prefixed with a 6-character hex length:
00002C(:TYPE :EVENT :PAYLOAD (:ACTION :handshake :VERSION "0.2.0"))
This is a deliberate rejection of JSON, Protocol Buffers, or any other serialization format. The message format is Lisp-native because:
1. The agent generates and consumes these messages inside the cognitive loop — no serialization layer needed
2. The format is human-readable and trivially debuggable with a text editor
3. The length prefix prevents framing attacks (no "read until newline" ambiguity)
** Why Length-Prefixed Framing?
A naive TCP protocol that reads until newline fails when:
- A message contains a newline character (which Lisp plists can)
- A message is split across TCP packets (read returns partial data)
- A malicious client sends an infinite stream without newlines
The length prefix solves all three problems. The reader reads exactly 6 characters (the hex length), then reads exactly that many additional characters. No ambiguous termination, no partial message handling, no newline worries.
The 6-character hex length supports messages up to ~16MB (0xFFFFFF bytes). This is sufficient for any single message the agent would produce. Larger payloads should be split across multiple messages.
* Implementation * Implementation
** Package Context ** Package Context
#+begin_src lisp #+begin_src lisp
(in-package :opencortex) (in-package :passepartout)
#+end_src #+end_src
** Actuator Registry ** Actuator Registry
The global registry mapping target keywords (~:cli~, ~:telegram~, ~:signal~, etc.) to their physical actuator functions. Extensible at runtime — skills can register new actuators via ~actuator-register~.
#+begin_src lisp #+begin_src lisp
(defvar *actuator-registry* (make-hash-table :test 'equalp) (defvar *actuator-registry* (make-hash-table :test 'equalp)
"Global registry mapping target keywords to their physical actuator functions.") "Global registry mapping target keywords to their physical actuator functions.")
(defun register-actuator (name fn) (defun actuator-register (name fn)
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)." "Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
(let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword)))) (let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword))))
(setf (gethash key *actuator-registry*) fn))) (setf (gethash key *actuator-registry*) fn)))
#+end_src #+end_src
** Message Framing ** Message Framing
Three functions handle the full message lifecycle: sanitize (strip non-serializable state), frame (serialize + prefix), and read (parse from stream).
*** Sanitize Protocol Message
Strips transient runtime state (~:reply-stream~, ~:socket~, ~:stream~) from a message plist before sending it over the network. These are Lisp stream objects that cannot be serialized and have no meaning to the remote end.
#+begin_src lisp #+begin_src lisp
(defun sanitize-protocol-message (msg) (defun protocol-message-sanitize (msg)
"Recursively strips non-serializable objects from a protocol plist." "Recursively strips non-serializable objects from a protocol plist."
(if (and msg (listp msg)) (if (and msg (listp msg))
(let ((clean nil)) (let ((clean nil))
(loop for (k v) on msg by #'cddr (loop for (k v) on msg by #'cddr
do (unless (member k '(:reply-stream :socket :stream)) do (unless (member k '(:reply-stream :socket :stream))
(push k clean) (push k clean)
(push (if (listp v) (sanitize-protocol-message v) v) clean))) (push (if (listp v) (protocol-message-sanitize v) v) clean)))
(nreverse clean)) (nreverse clean))
msg)) msg))
#+end_src
*** Frame Message
Serializes a plist to a length-prefixed string: 6-character hex length followed by the ~prin1~ representation.
#+begin_src lisp
(defun frame-message (msg) (defun frame-message (msg)
"Serializes a message plist and prefixes it with a 6-character hex length." "Serializes a message plist and prefixes it with a 6-character hex length."
(let* ((sanitized (sanitize-protocol-message msg)) (let* ((sanitized (protocol-message-sanitize msg))
(payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized))) (payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
(len (length payload))) (len (length payload)))
(format nil "~6,'0x~a" len payload))) (format nil "~6,'0x~a" len payload)))
#+end_src
*** Read Framed Message
Reads a complete framed message from a TCP stream. Handles leading whitespace between messages, partial reads, and malformed length headers gracefully. Returns the parsed S-expression, or ~:eof~ if the stream is closed, or ~:error~ if the message is malformed.
#+begin_src lisp
(defun read-framed-message (stream) (defun read-framed-message (stream)
"Reads a hex-length prefixed S-expression from the stream securely." "Reads a hex-length prefixed S-expression from the stream securely."
(let ((length-buffer (make-string 6))) (let ((length-buffer (make-string 6)))
@@ -67,11 +111,16 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
(error () :error)))) (error () :error))))
#+end_src #+end_src
** Server Listener (start-daemon) ** Server Listener (daemon-start)
#+begin_src lisp
(defvar *server-socket* nil)
(defun handle-client-connection (socket) The TCP server that accepts connections from CLI and TUI clients. Each connection gets a dedicated thread (~client-handle-connection~).
The daemon sends a handshake message on connection, then enters a read loop, injecting each received message into the metabolic loop via ~inject-stimulus~. The ~:health-check~ message type is handled inline (not sent to the cognitive loop) so that health checks work even when the agent is busy.
#+begin_src lisp
(defvar *daemon-socket* nil)
(defun client-handle-connection (socket)
"Handles a single TUI/CLI client connection in a dedicated thread." "Handles a single TUI/CLI client connection in a dedicated thread."
(let ((stream (usocket:socket-stream socket))) (let ((stream (usocket:socket-stream socket)))
(handler-case (handler-case
@@ -84,14 +133,13 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
((eq msg :eof) (return)) ((eq msg :eof) (return))
((eq msg :error) (return)) ((eq msg :error) (return))
((eq (getf msg :type) :health-check) ((eq (getf msg :type) :health-check)
;; Handle health check request
(let ((health-msg (list :type :health-response (let ((health-msg (list :type :health-response
:status (or (and (boundp 'opencortex::*system-health*) :status (or (and (boundp 'passepartout::*system-health*)
(symbol-value 'opencortex::*system-health*)) (symbol-value 'passepartout::*system-health*))
:unknown) :unknown)
:checked-p (or (and (boundp 'opencortex::*health-check-ran*) :checked-p (or (and (boundp 'passepartout::*health-check-ran*)
(symbol-value 'opencortex::*health-check-ran*)) (symbol-value 'passepartout::*health-check-ran*))
nil)))) nil))))
(format stream "~a" (frame-message health-msg)) (format stream "~a" (frame-message health-msg))
(finish-output stream))) (finish-output stream)))
(t (inject-stimulus msg :stream stream)))))) (t (inject-stimulus msg :stream stream))))))
@@ -100,19 +148,22 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
(defun start-daemon (&key (port 9105)) (defun start-daemon (&key (port 9105))
"Starts the network listener for TUI/CLI clients." "Starts the network listener for TUI/CLI clients."
(setf *server-socket* (usocket:socket-listen "127.0.0.1" port :reuse-address t)) (setf *daemon-socket* (usocket:socket-listen "127.0.0.1" port :reuse-address t))
(harness-log "DAEMON: Listening on localhost:~a" port) (harness-log "DAEMON: Listening on localhost:~a" port)
(bt:make-thread (bt:make-thread
(lambda () (lambda ()
(loop (loop
(let ((client-socket (usocket:socket-accept *server-socket*))) (let ((client-socket (usocket:socket-accept *daemon-socket*)))
(when client-socket (when client-socket
(bt:make-thread (lambda () (handle-client-connection client-socket)) (bt:make-thread (lambda () (client-handle-connection client-socket))
:name "opencortex-client-handler"))))) :name "passepartout-client-handler")))))
:name "opencortex-server-listener")) :name "passepartout-server-listener"))
#+end_src #+end_src
** Handshake Logic ** Handshake Logic
The first message sent to every new connection. The client can use this to verify the protocol version and the daemon's capabilities.
#+begin_src lisp #+begin_src lisp
(defun make-hello-message (version) (defun make-hello-message (version)
"Constructs the standard HELLO handshake message." "Constructs the standard HELLO handshake message."
@@ -123,10 +174,13 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
#+end_src #+end_src
** Structural Validation ** Structural Validation
#+begin_src lisp :tangle communication-validator.lisp
(in-package :opencortex)
(defun validate-communication-protocol-schema (msg) Validates that an incoming message has the minimum required structure: a plist with a valid ~:type~ field. Used by the protocol validator skill to reject malformed messages before they enter the cognitive loop.
#+begin_src lisp :tangle ../lisp/core-communication.lisp
(in-package :passepartout)
(defun protocol-schema-validate (msg)
"Strict structural validation for incoming protocol messages." "Strict structural validation for incoming protocol messages."
(unless (listp msg) (error "Message must be a plist")) (unless (listp msg) (error "Message must be a plist"))
(let ((type (proto-get msg :type))) (let ((type (proto-get msg :type)))
@@ -136,7 +190,8 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
#+end_src #+end_src
** Protocol Smoke Test (manual for REPL evaluation) ** Protocol Smoke Test (manual for REPL evaluation)
The following script connects to a running daemon, sends "hi", and reads the response. Useful for verifying the daemon is alive and the framing protocol works end-to-end.
Use this function to manually verify that the daemon is alive and the framing protocol works end-to-end. It connects to a running daemon, reads the HELLO handshake, sends a "hi" message, and reads the response.
#+begin_src lisp :tangle no #+begin_src lisp :tangle no
(defun test-daemon-protocol () (defun test-daemon-protocol ()
@@ -167,14 +222,15 @@ The following script connects to a running daemon, sends "hi", and reads the res
#+end_src #+end_src
* Test Suite * Test Suite
#+begin_src lisp :tangle ../tests/communication-tests.lisp Verifies that the framing protocol correctly serializes and deserializes messages.
#+begin_src lisp :tangle ../lisp/core-communication.lisp
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (ql:quickload :fiveam :silent t))
(defpackage :opencortex-communication-tests (defpackage :passepartout-communication-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :passepartout)
(:export #:communication-protocol-suite)) (:export #:communication-protocol-suite))
(in-package :opencortex-communication-tests) (in-package :passepartout-communication-tests)
(def-suite communication-protocol-suite :description "Communication Protocol Suite") (def-suite communication-protocol-suite :description "Communication Protocol Suite")
(in-suite communication-protocol-suite) (in-suite communication-protocol-suite)

166
harness/context.org → org/core-context.org
View File

@@ -2,21 +2,41 @@
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :harness:context: #+FILETAGS: :harness:context:
#+STARTUP: content #+STARTUP: content
#+PROPERTY: header-args:lisp :tangle context.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/core-context.lisp
* Overview * Overview: Architectural Intent
The *Context API* (Peripheral Vision) provides the opencortex with the ability to selectively prune and present its memory to the LLM. It implements a **Foveal-Peripheral model**, where the current task is shown in high detail (foveal), while the broader Memex structure is shown as a skeletal outline (peripheral).
The Context API implements the Foveal-Peripheral awareness model. When the agent thinks, it doesn't dump everything it knows into the LLM's context window — that would saturate the token budget immediately. Instead, it builds a skeletal outline of the entire Memex and only shows full detail for the current focus.
This mirrors human attention: you are aware of your entire apartment (peripheral vision), but you only see the book in front of you in detail (foveal vision).
** The Foveal-Peripheral Model
Three factors determine how much detail an object gets:
1. **Depth** — objects within 2 levels of the root get full outline (title + ID). Deeper objects are summarized or omitted.
2. **Foveal focus** — the object the user is currently interacting with gets full content rendered.
3. **Semantic similarity** — objects whose vector embedding is similar to the current foveal focus get promoted from peripheral to foveal detail.
** Why Not Just Dump Everything?
A naive implementation that serializes every ~org-object~ to text would produce hundreds of thousands of tokens for a typical knowledge base. The LLM would spend its attention budget on noise, not signal. The Foveal-Peripheral model preserves the signal (the current task and related information) while reducing noise (everything else).
The semantic threshold is configurable via ~CONTEXT_SEMANTIC_THRESHOLD~ env var (default 0.75). Lower values include more peripherally related content; higher values restrict to tightly related content.
* Implementation * Implementation
** Package Context ** Package Context
#+begin_src lisp #+begin_src lisp
(in-package :opencortex) (in-package :passepartout)
#+end_src #+end_src
** Memory Query (context-query-store) ** Memory Query (context-query)
Filters the Memory store by tag, TODO state, or object type. This is the primary retrieval function used by skills to find relevant information.
#+begin_src lisp #+begin_src lisp
(defun context-query-store (&key tag todo-state type) (defun context-query (&key tag todo-state type)
"Filters the Memory based on tags, todo states, or types." "Filters the Memory based on tags, todo states, or types."
(let ((results nil)) (let ((results nil))
(maphash (lambda (id obj) (maphash (lambda (id obj)
@@ -30,24 +50,33 @@ The *Context API* (Peripheral Vision) provides the opencortex with the ability t
results)) results))
#+end_src #+end_src
** Active Projects (context-get-active-projects) ** Active Projects (context-active-projects)
Returns headlines tagged as ~project~ that are not yet DONE. Used by the global awareness function to build the task overview.
#+begin_src lisp #+begin_src lisp
(defun context-get-active-projects () (defun context-active-projects ()
"Returns headlines tagged as 'project' that are not yet marked DONE." "Returns headlines tagged as 'project' that are not yet marked DONE."
(remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE")) (remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE"))
(context-query-store :tag "project" :type :HEADLINE))) (context-query :tag "project" :type :HEADLINE)))
#+end_src #+end_src
** Completed Tasks (context-get-recent-completed-tasks) ** Completed Tasks (context-recent-tasks)
Retrieves recently finished tasks from the store. Used by the Scribe and Gardener for journal summarization.
#+begin_src lisp #+begin_src lisp
(defun context-get-recent-completed-tasks () (defun context-recent-tasks ()
"Retrieves recently finished tasks from the store." "Retrieves recently finished tasks from the store."
(context-query-store :todo-state "DONE" :type :HEADLINE)) (context-query :todo-state "DONE" :type :HEADLINE))
#+end_src #+end_src
** Capability Discovery (context-list-all-skills) ** Capability Discovery (context-skill-list)
Provides a sorted overview of currently loaded system capabilities. Each entry includes the skill name, priority, and dependencies.
#+begin_src lisp #+begin_src lisp
(defun context-list-all-skills () (defun context-skill-list ()
"Provides a sorted overview of currently loaded system capabilities." "Provides a sorted overview of currently loaded system capabilities."
(let ((results nil)) (let ((results nil))
(maphash (lambda (name skill) (maphash (lambda (name skill)
@@ -57,20 +86,26 @@ The *Context API* (Peripheral Vision) provides the opencortex with the ability t
(sort results #'> :key (lambda (x) (getf x :priority))))) (sort results #'> :key (lambda (x) (getf x :priority)))))
#+end_src #+end_src
** Skill Inspection (context-get-skill-source) ** Skill Source Inspection (context-skill-source)
Reads the raw literate source of a specific skill for inspection. Used when the agent needs to understand or modify its own code.
#+begin_src lisp #+begin_src lisp
(defun context-get-skill-source (skill-name) (defun context-skill-source (skill-name)
"Reads the raw literate source of a specific skill for inspection." "Reads the raw literate source of a specific skill for inspection."
(let* ((filename (format nil "~a.org" skill-name)) (let* ((filename (format nil "~a.org" skill-name))
(data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "OC_DATA_DIR") (namestring (merge-pathnames ".local/share/opencortex/" (user-homedir-pathname)))))) (data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
(skills-dir (merge-pathnames "skills/" data-dir)) (skills-dir (merge-pathnames "skills/" data-dir))
(full-path (merge-pathnames filename skills-dir))) (full-path (merge-pathnames filename skills-dir)))
(if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil))) (if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
#+end_src #+end_src
** Harness Logs (context-get-system-logs) ** Harness Logs (context-logs)
Retrieves the most recent lines from the harness's internal log buffer. The log limit is configurable via ~CONTEXT_LOG_LIMIT~ env var (default 20).
#+begin_src lisp #+begin_src lisp
(defun context-get-system-logs (&optional limit) (defun context-logs (&optional limit)
"Retrieves the most recent lines from the harness's internal log." "Retrieves the most recent lines from the harness's internal log."
(let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20))) (let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20)))
(bt:with-lock-held (*logs-lock*) (bt:with-lock-held (*logs-lock*)
@@ -78,9 +113,19 @@ The *Context API* (Peripheral Vision) provides the opencortex with the ability t
(subseq *system-logs* 0 count))))) (subseq *system-logs* 0 count)))))
#+end_src #+end_src
** AST to Org Rendering (context-render-to-org) ** AST to Org Rendering (context-object-render)
Recursively renders an ~org-object~ and its children to an Org-mode string, applying the Foveal-Peripheral model:
- Objects within depth 2 are always included (outline)
- The foveal object (the one the user is looking at) is always included with full content
- Objects with semantic similarity above the threshold are included with full content
- All other objects are omitted silently
This function is the heart of the context assembly. Its performance directly affects the agent's response time.
#+begin_src lisp #+begin_src lisp
(defun context-render-to-org (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil)) (defun context-object-render (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." "Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
(let* ((id (org-object-id obj)) (let* ((id (org-object-id obj))
(is-foveal (equal id foveal-id)) (is-foveal (equal id foveal-id))
@@ -111,7 +156,7 @@ The *Context API* (Peripheral Vision) provides the opencortex with the ability t
(when child-obj (when child-obj
(let ((next-foveal (if is-foveal child-id foveal-id))) (let ((next-foveal (if is-foveal child-id foveal-id)))
(setf output (concatenate 'string output (setf output (concatenate 'string output
(context-render-to-org child-obj (context-object-render child-obj
:depth (1+ depth) :depth (1+ depth)
:foveal-id next-foveal :foveal-id next-foveal
:semantic-threshold threshold :semantic-threshold threshold
@@ -119,9 +164,12 @@ The *Context API* (Peripheral Vision) provides the opencortex with the ability t
output)) output))
#+end_src #+end_src
** Path Resolution (context-resolve-path) ** Path Resolution (context-path-resolve)
Expands environment variables in a path string and strips quotes. Used to resolve configurable paths from ~.env~.
#+begin_src lisp #+begin_src lisp
(defun context-resolve-path (path-string) (defun context-path-resolve (path-string)
"Expands environment variables and strips literal quotes from a path string." "Expands environment variables and strips literal quotes from a path string."
(let ((path (if (stringp path-string) (let ((path (if (stringp path-string)
(string-trim '(#\" #\' #\Space) path-string) (string-trim '(#\" #\' #\Space) path-string)
@@ -136,17 +184,19 @@ The *Context API* (Peripheral Vision) provides the opencortex with the ability t
path))) path)))
#+end_src #+end_src
** Privacy filter for context assembly ** Privacy Filter for Context Assembly
Checks if an org-object has tags matching ~*privacy-filter-tags*~. Objects with matching tags are excluded from the LLM context window.
Checks if an org-object has tags matching the Bouncer's ~bouncer-privacy-tags~. Objects with matching tags are excluded from the LLM's context window. This prevents private content tagged with ~@personal~ (or any user-configured privacy tag) from being included in prompts sent to external LLM providers.
#+begin_src lisp #+begin_src lisp
(defun context-object-privacy-filtered-p (obj) (defun context-privacy-filtered-p (obj)
"Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags." "Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags."
(let* ((attrs (org-object-attributes obj)) (let* ((attrs (org-object-attributes obj))
(tags (getf attrs :TAGS)) (tags (getf attrs :TAGS))
(privacy-tags (and (find-package :opencortex.skills.org-skill-bouncer) (privacy-tags (and (find-package :passepartout.security-dispatcher)
(symbol-value (symbol-value
(find-symbol "BOUNCER-PRIVACY-TAGS" (find-symbol "BOUNCER-PRIVACY-TAGS"
:opencortex.skills.org-skill-bouncer))))) :passepartout.security-dispatcher)))))
(when (and tags privacy-tags) (when (and tags privacy-tags)
(let ((tag-list (if (listp tags) tags (list tags)))) (let ((tag-list (if (listp tags) tags (list tags))))
(some (lambda (tag) (some (lambda (tag)
@@ -157,73 +207,61 @@ Checks if an org-object has tags matching ~*privacy-filter-tags*~. Objects with
tag-list))))) tag-list)))))
#+end_src #+end_src
** Global Awareness (context-assemble-global-awareness) ** Global Awareness (context-awareness-assemble)
#+begin_src lisp
(defun context-object-privacy-filtered-p (obj)
"Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags."
(let* ((attrs (org-object-attributes obj))
(tags (getf attrs :TAGS))
(privacy-tags (and (find-package :opencortex.skills.org-skill-bouncer)
(symbol-value
(find-symbol "BOUNCER-PRIVACY-TAGS"
:opencortex.skills.org-skill-bouncer)))))
(when (and tags privacy-tags)
(let ((tag-list (if (listp tags) tags (list tags))))
(some (lambda (tag)
(some (lambda (private)
(string-equal (string-trim '(#\:) tag)
(string-trim '(#\:) private)))
privacy-tags))
tag-list)))))
(defun context-assemble-global-awareness (&optional signal) Produces the high-level skeletal outline of the current Memory that is included in every LLM call. This is the "peripheral vision" of the agent — it knows what projects exist, their titles and IDs, but not their full content.
Privacy-filtered projects (those with tags matching ~bouncer-privacy-tags~) are excluded from the output.
#+begin_src lisp
(defun context-awareness-assemble (&optional signal)
"Produces a high-level skeletal outline of the current Memory for the LLM. "Produces a high-level skeletal outline of the current Memory for the LLM.
Privacy-filtered objects (matching *privacy-filter-tags*) are excluded." Privacy-filtered objects (matching bouncer-privacy-tags) are excluded."
(let* ((foveal-id (or (getf signal :foveal-focus) (let* ((foveal-id (or (getf signal :foveal-focus)
(ignore-errors (getf (getf signal :payload) :target-id)))) (ignore-errors (getf (getf signal :payload) :target-id))))
(all-projects (context-get-active-projects)) (all-projects (context-active-projects))
(projects (remove-if #'context-object-privacy-filtered-p all-projects)) (projects (remove-if #'context-privacy-filtered-p all-projects))
(output (format nil "GLOBAL MEMEX AWARENESS (Peripheral Vision):~%"))) (output (format nil "GLOBAL MEMEX AWARENESS (Peripheral Vision):~%")))
(if projects (if projects
(dolist (project projects) (dolist (project projects)
(setf output (concatenate 'string output (setf output (concatenate 'string output
(context-render-to-org project :foveal-id foveal-id)))) (context-object-render project :foveal-id foveal-id))))
(setf output (concatenate 'string output "No active projects found.~%"))) (setf output (concatenate 'string output "No active projects found.~%")))
output)) output))
#+end_src #+end_src
* Test Suite * Test Suite
Verifies that the Foveal-Peripheral rendering correctly distinguishes between foveal (detailed) and peripheral (outline) content, and that the awareness budget includes all active projects.
#+begin_src lisp :tangle ../tests/peripheral-vision-tests.lisp #+begin_src lisp :tangle ../lisp/core-context.lisp
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (ql:quickload :fiveam :silent t))
(defpackage :opencortex-peripheral-vision-tests (defpackage :passepartout-peripheral-vision-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :passepartout)
(:export #:vision-suite)) (:export #:vision-suite))
(in-package :opencortex-peripheral-vision-tests) (in-package :passepartout-peripheral-vision-tests)
(def-suite vision-suite :description "Verification of Foveal-Peripheral context model.") (def-suite vision-suite :description "Verification of Foveal-Peripheral context model.")
(in-suite vision-suite) (in-suite vision-suite)
(test test-foveal-rendering (test test-foveal-rendering
(clrhash opencortex::*memory*) (clrhash passepartout::*memory*)
(let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS ("project")) (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS ("project"))
:contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node") :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
:raw-content "FOVEAL CONTENT" :contents nil) :raw-content "FOVEAL CONTENT" :contents nil)
(:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node") (:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
:raw-content "PERIPHERAL CONTENT" :contents nil))))) :raw-content "PERIPHERAL CONTENT" :contents nil)))))
(ingest-ast ast) (ingest-ast ast)
(let ((output (context-assemble-global-awareness (list :foveal-focus "node-foveal")))) (let ((output (context-awareness-assemble (list :foveal-focus "node-foveal"))))
(is (search "FOVEAL CONTENT" output)) (is (search "FOVEAL CONTENT" output))
(is (search "* Peripheral Node" output)) (is (search "* Peripheral Node" output))
(is (not (search "PERIPHERAL CONTENT" output)))))) (is (not (search "PERIPHERAL CONTENT" output))))))
(test test-awareness-budget (test test-awareness-budget
(clrhash opencortex::*memory*) (clrhash passepartout::*memory*)
(ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS ("project")) :contents nil)) (ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS ("project")) :contents nil))
(ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS ("project")) :contents nil)) (ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS ("project")) :contents nil))
(let ((output (context-assemble-global-awareness))) (let ((output (context-awareness-assemble)))
(is (search "Project 1" output)) (is (search "Project 1" output))
(is (search "Project 2" output)))) (is (search "Project 2" output))))
#+end_src #+end_src

110
harness/package.org → org/core-defpackage.org
View File

@@ -1,28 +1,29 @@
#+TITLE: System Interface (package.lisp) #+TITLE: Core: Package Definition (core-defpackage.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :harness:interface: #+FILETAGS: :passepartout:core:defpackage:
#+STARTUP: content #+STARTUP: content
#+PROPERTY: header-args:lisp :tangle package.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/core-defpackage.lisp
* Overview * Overview: Architectural Intent
~package.lisp~ defines two things: the public API of the ~opencortex~ package (the export list, above), and the implementation of low-level utility functions and global state that don't belong in a specific pipeline stage or skill.
~package.lisp~ defines two things: the public API of the ~passepartout~ package (the export list), and the implementation of low-level utility functions and global state that don't belong in a specific pipeline stage or skill.
The export list is the contract between the harness and all skills. Every function exported here is accessible to every skill via ~use-package~. Adding a symbol here is an API commitment; removing one is a breaking change. The export list is the contract between the harness and all skills. Every function exported here is accessible to every skill via ~use-package~. Adding a symbol here is an API commitment; removing one is a breaking change.
The implementation section includes: The implementation section includes:
- ~proto-get~ — robust plist accessor used everywhere - ~plist-get~ — robust plist accessor used everywhere in the pipeline
- Logging state (~*system-logs*~, ~*logs-lock*~) - Logging state (~*log-buffer*~, ~*log-lock*~) — bounded ring buffer for LLM context
- Skill registry (~*skills-registry*~, ~defskill~) - Skill registry (~*skill-registry*~, ~defskill~) — all loaded skills live here
- Cognitive tool registry (~*cognitive-tools*~, ~def-cognitive-tool~) - Cognitive tool registry (~*cognitive-tool-registry*~, ~def-cognitive-tool~, ~cognitive-tool-prompt~)
- Configuration variables (~*privacy-filter-tags*~, ~*secret-protected-paths*~, ~*secret-exposure-patterns*~) - Telemetry tracking (~*telemetry-table*~, ~telemetry-track~) — performance metrics per skill
- Debugger hook - Debugger hook — replaces raw SBCL debugger with a friendly error message
* Implementation * Implementation
** Package Definition and Export List ** Package Definition and Export List
The package definition. All public symbols are exported here. The package definition. All public symbols are exported here.
#+begin_src lisp :tangle package.lisp #+begin_src lisp :tangle ../lisp/core-defpackage.lisp
(defpackage :opencortex (defpackage :passepartout
(:use :cl) (:use :cl)
(:export (:export
#:frame-message #:frame-message
@@ -37,7 +38,7 @@ The package definition. All public symbols are exported here.
#:validate-communication-protocol-schema #:validate-communication-protocol-schema
#:start-daemon #:start-daemon
#:stop-daemon #:stop-daemon
#:harness-log #:log-message
#:main #:main
#:doctor-run-all #:doctor-run-all
#:doctor-main #:doctor-main
@@ -77,9 +78,10 @@ The package definition. All public symbols are exported here.
#:context-get-system-logs #:context-get-system-logs
#:context-resolve-path #:context-resolve-path
#:context-get-skill-telemetry #:context-get-skill-telemetry
#:harness-track-telemetry #:telemetry-track
#:context-assemble-global-awareness #:context-assemble-global-awareness
#:process-signal #:loop-process
#:loop-process
#:perceive-gate #:perceive-gate
#:probabilistic-gate #:probabilistic-gate
#:consensus-gate #:consensus-gate
@@ -91,12 +93,12 @@ The package definition. All public symbols are exported here.
#:dispatch-action #:dispatch-action
#:register-actuator #:register-actuator
#:load-skill-from-org #:load-skill-from-org
#:initialize-all-skills #:skill-initialize-all
#:load-skill-with-timeout #:load-skill-with-timeout
#:topological-sort-skills #:topological-sort-skills
#:validate-lisp-syntax #:validate-lisp-syntax
#:defskill #:defskill
#:*skills-registry* #:*skill-registry*
#:skill #:skill
#:skill-name #:skill-name
#:skill-priority #:skill-priority
@@ -105,7 +107,7 @@ The package definition. All public symbols are exported here.
#:skill-probabilistic-prompt #:skill-probabilistic-prompt
#:skill-deterministic-fn #:skill-deterministic-fn
#:def-cognitive-tool #:def-cognitive-tool
#:*cognitive-tools* #:*cognitive-tool-registry*
#:verify-git-clean-p #:verify-git-clean-p
#:engineering-standards-verify-lisp #:engineering-standards-verify-lisp
#:engineering-standards-format-lisp #:engineering-standards-format-lisp
@@ -158,7 +160,7 @@ The package definition. All public symbols are exported here.
#:*provider-cascade* #:*provider-cascade*
#:vault-get-secret #:vault-get-secret
#:vault-set-secret #:vault-set-secret
#:list-objects-with-attribute #:memory-objects-by-attribute
#:deterministic-verify #:deterministic-verify
#:find-headline-missing-id)) #:find-headline-missing-id))
#+end_src #+end_src
@@ -166,12 +168,12 @@ The package definition. All public symbols are exported here.
** Package Implementation ** Package Implementation
The package implementation section defines the low-level utilities and global state that are shared across all harness components and skills. The package implementation section defines the low-level utilities and global state that are shared across all harness components and skills.
*** Robust plist access (proto-get) *** Robust plist access (plist-get)
Retrieves a value from a plist, checking both upper and lowercase keyword variants. This is needed because different components use different keyword conventions. Retrieves a value from a plist, checking both upper and lowercase keyword variants. This is needed because different components use different keyword conventions.
#+begin_src lisp :tangle package.lisp #+begin_src lisp :tangle ../lisp/core-defpackage.lisp
(in-package :opencortex) (in-package :passepartout)
(defun proto-get (plist key) (defun plist-get (plist key)
"Robust plist accessor — checks both :KEY and :key variants." "Robust plist accessor — checks both :KEY and :key variants."
(let* ((s (string key)) (let* ((s (string key))
(up (intern (string-upcase s) :keyword)) (up (intern (string-upcase s) :keyword))
@@ -181,43 +183,43 @@ Retrieves a value from a plist, checking both upper and lowercase keyword varian
*** Logging state *** Logging state
The harness maintains a bounded ring buffer of log messages for inclusion in LLM context. Access is thread-safe via a lock. The harness maintains a bounded ring buffer of log messages for inclusion in LLM context. Access is thread-safe via a lock.
#+begin_src lisp :tangle package.lisp #+begin_src lisp :tangle ../lisp/core-defpackage.lisp
(defvar *system-logs* nil) (defvar *log-buffer* nil)
(defvar *logs-lock* (bordeaux-threads:make-lock "harness-logs-lock")) (defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock"))
(defvar *max-log-history* 100) (defvar *log-limit* 100)
#+end_src #+end_src
*** Skill registry *** Skill registry
The global registry of all loaded skills. This is the authoritative list that the deterministic engine iterates. The global registry of all loaded skills. This is the authoritative list that the deterministic engine iterates.
#+begin_src lisp :tangle package.lisp #+begin_src lisp :tangle ../lisp/core-defpackage.lisp
(defvar *skills-registry* (make-hash-table :test 'equal) (defvar *skill-registry* (make-hash-table :test 'equal)
"Global registry of all loaded skills.") "Global registry of all loaded skills.")
#+end_src #+end_src
*** Skill telemetry *** Skill telemetry
Tracks execution metrics per skill (count, duration, failures) for diagnostics and performance analysis. Tracks execution metrics per skill (count, duration, failures) for diagnostics and performance analysis.
#+begin_src lisp :tangle package.lisp #+begin_src lisp :tangle ../lisp/core-defpackage.lisp
(defvar *skill-telemetry* (make-hash-table :test 'equal)) (defvar *telemetry-table* (make-hash-table :test 'equal))
(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock")) (defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
(defun harness-track-telemetry (skill-name duration status) (defun telemetry-track (skill-name duration status)
"Updates performance metrics for a skill. STATUS is :success or :rejected." "Updates performance metrics for a skill. STATUS is :success or :rejected."
(when skill-name (when skill-name
(bordeaux-threads:with-lock-held (*telemetry-lock*) (bordeaux-threads:with-lock-held (*telemetry-lock*)
(let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0)))) (let ((entry (or (gethash skill-name *telemetry-table*) (list :executions 0 :total-time 0 :failures 0))))
(incf (getf entry :executions)) (incf (getf entry :executions))
(incf (getf entry :total-time) duration) (incf (getf entry :total-time) duration)
(when (eq status :rejected) (incf (getf entry :failures))) (when (eq status :rejected) (incf (getf entry :failures)))
(setf (gethash skill-name *skill-telemetry*) entry))))) (setf (gethash skill-name *telemetry-table*) entry)))))
#+end_src #+end_src
*** Cognitive tool registry *** Cognitive tool registry
Tools that the LLM can invoke are registered here. Each tool has a name, description, parameters, optional guard, and implementation body. The ~def-cognitive-tool~ macro handles registration. ~generate-tool-belt-prompt~ serialises the registry into the LLM's system prompt. Tools that the LLM can invoke are registered here. Each tool has a name, description, parameters, optional guard, and implementation body. The ~def-cognitive-tool~ macro handles registration. ~cognitive-tool-prompt~ serialises the registry into the LLM's system prompt.
#+begin_src lisp :tangle package.lisp #+begin_src lisp :tangle ../lisp/core-defpackage.lisp
(defvar *cognitive-tools* (make-hash-table :test 'equal)) (defvar *cognitive-tool-registry* (make-hash-table :test 'equal))
#+end_src #+end_src
#+begin_src lisp :tangle package.lisp #+begin_src lisp :tangle ../lisp/core-defpackage.lisp
(defstruct cognitive-tool (defstruct cognitive-tool
name name
description description
@@ -226,10 +228,10 @@ Tools that the LLM can invoke are registered here. Each tool has a name, descrip
body) body)
#+end_src #+end_src
#+begin_src lisp :tangle package.lisp #+begin_src lisp :tangle ../lisp/core-defpackage.lisp
(defmacro def-cognitive-tool (name description parameters &key guard body) (defmacro def-cognitive-tool (name description parameters &key guard body)
"Registers a cognitive tool. PARAMETERS is a list of plists, one per parameter." "Registers a cognitive tool. PARAMETERS is a list of plists, one per parameter."
`(setf (gethash (string-downcase (string ',name)) *cognitive-tools*) `(setf (gethash (string-downcase (string ',name)) *cognitive-tool-registry*)
(make-cognitive-tool :name (string-downcase (string ',name)) (make-cognitive-tool :name (string-downcase (string ',name))
:description ,description :description ,description
:parameters ',parameters :parameters ',parameters
@@ -237,8 +239,8 @@ Tools that the LLM can invoke are registered here. Each tool has a name, descrip
:body ,body))) :body ,body)))
#+end_src #+end_src
#+begin_src lisp :tangle package.lisp #+begin_src lisp :tangle ../lisp/core-defpackage.lisp
(defun generate-tool-belt-prompt () (defun cognitive-tool-prompt ()
"Serialises all registered tools into a prompt string for the LLM." "Serialises all registered tools into a prompt string for the LLM."
(let ((descriptions nil)) (let ((descriptions nil))
(maphash (lambda (k tool) (maphash (lambda (k tool)
@@ -248,29 +250,29 @@ Tools that the LLM can invoke are registered here. Each tool has a name, descrip
(cognitive-tool-description tool) (cognitive-tool-description tool)
(cognitive-tool-parameters tool)) (cognitive-tool-parameters tool))
descriptions)) descriptions))
*cognitive-tools*) *cognitive-tool-registry*)
(if descriptions (if descriptions
(format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<))) (format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<)))
"No tools registered."))) "No tools registered.")))
#+end_src #+end_src
*** Centralized logging (harness-log) *** Centralized logging (log-message)
Thread-safe logging function that writes to both the ring buffer (for LLM context) and stdout (for the user). Bounded by ~*max-log-history*~. Thread-safe logging function that writes to both the ring buffer (for LLM context) and stdout (for the user). Bounded by ~*log-limit*~.
#+begin_src lisp :tangle package.lisp #+begin_src lisp :tangle ../lisp/core-defpackage.lisp
(defun harness-log (msg &rest args) (defun log-message (msg &rest args)
"Centralized, thread-safe logging for the harness." "Centralized, thread-safe logging for the harness."
(let ((formatted-msg (apply #'format nil msg args))) (let ((formatted-msg (apply #'format nil msg args)))
(bordeaux-threads:with-lock-held (*logs-lock*) (bordeaux-threads:with-lock-held (*log-lock*)
(push formatted-msg *system-logs*) (push formatted-msg *log-buffer*)
(when (> (length *system-logs*) *max-log-history*) (when (> (length *log-buffer*) *log-limit*)
(setq *system-logs* (subseq *system-logs* 0 *max-log-history*)))) (setq *log-buffer* (subseq *log-buffer* 0 *log-limit*))))
(format t "~a~%" formatted-msg) (format t "~a~%" formatted-msg)
(finish-output))) (finish-output)))
#+end_src #+end_src
*** Debugger hook *** Debugger hook
Friendly error handler that replaces the raw SBCL debugger with a diagnostic message. This prevents the agent from entering the debugger on unhandled conditions. Friendly error handler that replaces the raw SBCL debugger with a diagnostic message. This prevents the agent from entering the debugger on unhandled conditions.
#+begin_src lisp :tangle package.lisp #+begin_src lisp :tangle ../lisp/core-defpackage.lisp
(setf *debugger-hook* (lambda (condition hook) (setf *debugger-hook* (lambda (condition hook)
"Friendly error handler - shows diagnostic message instead of raw debugger." "Friendly error handler - shows diagnostic message instead of raw debugger."
(declare (ignore hook)) (declare (ignore hook))
@@ -278,7 +280,7 @@ Friendly error handler that replaces the raw SBCL debugger with a diagnostic mes
(format t "┌─────────────────────────────────────────────┐~%") (format t "┌─────────────────────────────────────────────┐~%")
(format t "│ ERROR: ~A~%" (type-of condition)) (format t "│ ERROR: ~A~%" (type-of condition))
(format t "│~%") (format t "│~%")
(format t "│ Run: opencortex doctor~%") (format t "│ Run: passepartout doctor~%")
(format t "│ For system diagnostics~%") (format t "│ For system diagnostics~%")
(format t "└─────────────────────────────────────────────┘~%") (format t "└─────────────────────────────────────────────┘~%")
(format t "~%") (format t "~%")

126
harness/act.org → org/core-loop-act.org
View File

@@ -2,39 +2,59 @@
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :harness:act: #+FILETAGS: :harness:act:
#+STARTUP: content #+STARTUP: content
#+PROPERTY: header-args:lisp :tangle act.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/core-loop-act.lisp
* Overview * Overview: Architectural Intent
The Act stage dispatches approved actions to registered actuators. After the Probabilistic engine proposes and the Deterministic engine verifies, Act executes the approved action via the appropriate actuator (:cli, :tool, :system, :telegram, :signal, etc.). The actuator registry is extensible — skills can register new actuators at runtime.
The Act stage is where cognition meets reality. After the Probabilistic engine proposes an action and the Deterministic engine verifies it, Act executes it through the appropriate actuator.
An actuator is a function that takes (action context) and performs a physical operation: send a message to the TUI, execute a shell command, call a Telegram API, write to a file. Actuators are registered in a global hash table (~*actuator-registry*~) and dispatched by name.
The key architectural choice: **actuators are not privileged**. The same dispatch mechanism that routes to :shell or :file also routes to :telegram or :signal. There is no special handling for dangerous actuators — safety is enforced at the Reason stage by the deterministic engine, not by Act. This means:
1. Adding a new actuator requires no changes to the core — just register it
2. Safety is centralized in the deterministic gates, not scattered across actuator implementations
3. Every actuator benefits from the same security checks (the Bouncer, the Policy)
** Why Dispatch-Action Verifies Again?
The Reason stage already ran every proposed action through the deterministic engine. So why does ~loop-gate-act~ call ~deterministic-verify~ again?
Because a skill's deterministic gate runs during Reason, but between Reason and Act, the action might have been transformed by the pipeline (metadata added, format normalized). The last-mile verification catches any transformation that might have introduced an unsafe property. It's the same philosophy as "trust but verify" — the second check is cheap and catches a class of bugs that would otherwise be silent data corruption.
* Implementation * Implementation
** Package Context ** Package Context
#+begin_src lisp #+begin_src lisp
(in-package :opencortex) (in-package :passepartout)
#+end_src #+end_src
** Actuator Configuration ** Actuator Configuration
~*actuator-default*~ determines where actions go when no explicit target is specified. Defaults to ~:cli~.
~*actuator-silent*~ lists actuator targets that don't generate tool-output feedback. For example, sending a message to the CLI or Emacs doesn't need to produce a tool-output event — the user can see the message directly. This prevents redundant feedback loops.
#+begin_src lisp #+begin_src lisp
(defvar *default-actuator* :cli (defvar *actuator-default* :cli
"The actuator used when no explicit target is specified.") "The actuator used when no explicit target is specified.")
(defvar *silent-actuators* '(:cli :system-message :emacs) (defvar *actuator-silent* '(:cli :system-message :emacs)
"List of actuators that don't generate tool-output feedback.") "List of actuators that don't generate tool-output feedback.")
(defun initialize-actuators () (defun actuator-initialize ()
"Register core actuators and load configuration." "Register core actuators and load configuration."
(let ((def (uiop:getenv "DEFAULT_ACTUATOR")) (let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
(silent (uiop:getenv "SILENT_ACTUATORS"))) (silent (uiop:getenv "SILENT_ACTUATORS")))
(when def (when def
(setf *default-actuator* (intern (string-upcase def) :keyword))) (setf *actuator-default* (intern (string-upcase def) :keyword)))
(when silent (when silent
(setf *silent-actuators* (setf *actuator-silent*
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword)) (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
(uiop:split-string silent :separator '(#\,)))))) (uiop:split-string silent :separator '(#\,))))))
(register-actuator :system #'execute-system-action) (register-actuator :system #'action-system-execute)
(register-actuator :tool #'execute-tool-action) (register-actuator :tool #'action-tool-execute)
(register-actuator :tui (lambda (action context) (register-actuator :tui (lambda (action context)
(declare (ignore context)) (declare (ignore context))
@@ -45,18 +65,27 @@ The Act stage dispatches approved actions to registered actuators. After the Pro
(finish-output stream)))))) (finish-output stream))))))
#+end_src #+end_src
** Action Dispatch (dispatch-action) ** Action Dispatch (action-dispatch)
Routes an approved action to its registered actuator. The target is resolved in priority order:
1. The explicit ~:target~ field on the action
2. The source of the original signal (reply to the sender)
3. The default actuator (~:cli~)
Heartbeats are silently dropped here — they should never generate an actuation.
#+begin_src lisp #+begin_src lisp
(defun dispatch-action (action context) (defun action-dispatch (action context)
"Route an approved action to its registered actuator." "Route an approved action to its registered actuator."
(let ((payload (proto-get action :payload))) (let ((payload (proto-get action :payload)))
(when (eq (proto-get payload :sensor) :heartbeat) (when (eq (proto-get payload :sensor) :heartbeat)
(return-from dispatch-action nil)) (return-from action-dispatch nil))
(when (and action (listp action)) (when (and action (listp action))
(let* ((meta (proto-get context :meta)) (let* ((meta (proto-get context :meta))
(source (proto-get meta :source)) (source (proto-get meta :source))
(raw-target (or (proto-get action :target) source *default-actuator*)) (raw-target (or (proto-get action :target) source *actuator-default*))
(target (intern (string-upcase (string raw-target)) :keyword)) (target (intern (string-upcase (string raw-target)) :keyword))
(actuator-fn (gethash target *actuator-registry*))) (actuator-fn (gethash target *actuator-registry*)))
(when (and meta (null (getf action :meta))) (when (and meta (null (getf action :meta)))
@@ -66,9 +95,12 @@ The Act stage dispatches approved actions to registered actuators. After the Pro
(harness-log "ACT ERROR: No actuator registered for '~s'" target)))))) (harness-log "ACT ERROR: No actuator registered for '~s'" target))))))
#+end_src #+end_src
** System Actuator (execute-system-action) ** System Actuator (action-system-execute)
Handles internal harness commands: ~:eval~ (execute arbitrary Lisp) and ~:message~ (log to the harness log). This is how the deterministic engine communicates results back to the user.
#+begin_src lisp #+begin_src lisp
(defun execute-system-action (action context) (defun action-system-execute (action context)
"Execute internal harness commands." "Execute internal harness commands."
(declare (ignore context)) (declare (ignore context))
(let* ((payload (getf action :payload)) (let* ((payload (getf action :payload))
@@ -82,9 +114,20 @@ The Act stage dispatches approved actions to registered actuators. After the Pro
(harness-log "ACT ERROR [System]: Unknown command '~s'" cmd))))) (harness-log "ACT ERROR [System]: Unknown command '~s'" cmd)))))
#+end_src #+end_src
** Tool Actuator (execute-tool-action) ** Tool Actuator (action-tool-execute)
Executes a registered cognitive tool. Cognitive tools are registered via ~def-cognitive-tool~ in the package.lisp and are the primary way the LLM interacts with the outside world.
The function handles:
- Tool dispatch by name (case-insensitive lookup)
- Argument normalization (if the arguments are nested in a list, they're flattened)
- Result formatting (structured results are sent back to the source)
- Error handling (tool errors produce ~:tool-error~ events, not crashes)
The tool's return value is packed into a ~:tool-output~ event and fed back into the pipeline, where it becomes the next perception. This is how the agent "sees" the result of its actions.
#+begin_src lisp #+begin_src lisp
(defun execute-tool-action (action context) (defun action-tool-execute (action context)
"Execute a registered cognitive tool." "Execute a registered cognitive tool."
(let* ((payload (getf action :payload)) (let* ((payload (getf action :payload))
(tool-name (getf payload :tool)) (tool-name (getf payload :tool))
@@ -98,8 +141,8 @@ The Act stage dispatches approved actions to registered actuators. After the Pro
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args)) (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))) (result (funcall (cognitive-tool-body tool) clean-args)))
(when source (when source
(dispatch-action (list :TYPE :REQUEST :TARGET source (action-dispatch (list :TYPE :REQUEST :TARGET source
:PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result))) :PAYLOAD (list :ACTION :MESSAGE :TEXT (tool-result-format tool-name result)))
context)) context))
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))) :PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name)))
@@ -110,9 +153,12 @@ The Act stage dispatches approved actions to registered actuators. After the Pro
:PAYLOAD (list :SENSOR :tool-error :MESSAGE (format nil "Tool '~a' not found" tool-name)))))) :PAYLOAD (list :SENSOR :tool-error :MESSAGE (format nil "Tool '~a' not found" tool-name))))))
#+end_src #+end_src
** Tool Result Formatting (format-tool-result) ** Tool Result Formatting (tool-result-format)
Converts a tool's return value into a human-readable string for display to the user. Handles structured results (plists with ~:status~, ~:content~, ~:message~) and plain values.
#+begin_src lisp #+begin_src lisp
(defun format-tool-result (tool-name result) (defun tool-result-format (tool-name result)
"Format a tool result for display." "Format a tool result for display."
(if (listp result) (if (listp result)
(let ((status (getf result :status)) (let ((status (getf result :status))
@@ -126,8 +172,15 @@ The Act stage dispatches approved actions to registered actuators. After the Pro
#+end_src #+end_src
** Act Gate (Stage 3) ** Act Gate (Stage 3)
The final stage of the metabolic pipeline. It receives a signal that has been reasoned (has an ~:approved-action~) and dispatches it.
The gate runs a last-mile deterministic check on the approved action before execution. This catches any issues introduced during pipeline processing (e.g., metadata added by Perceive that changes the action's format).
After dispatch, the gate captures any feedback produced by the actuation (tool output, error events) and returns it to the loop for the next cognitive cycle.
#+begin_src lisp #+begin_src lisp
(defun act-gate (signal) (defun loop-gate-act (signal)
"Final stage of the metabolic pipeline: Actuation." "Final stage of the metabolic pipeline: Actuation."
(let* ((approved (getf signal :approved-action)) (let* ((approved (getf signal :approved-action))
(type (getf signal :type)) (type (getf signal :type))
@@ -147,41 +200,42 @@ The Act stage dispatches approved actions to registered actuators. After the Pro
(setf approved verified))))) (setf approved verified)))))
(case type (case type
(:REQUEST (dispatch-action signal signal)) (:REQUEST (action-dispatch signal signal))
(:LOG (dispatch-action signal signal)) (:LOG (action-dispatch signal signal))
(:EVENT (:EVENT
(if approved (if approved
(let* ((target (getf approved :target)) (let* ((target (getf approved :target))
(result (dispatch-action approved signal))) (result (action-dispatch approved signal)))
(cond (cond
((and (listp result) (member (getf result :type) '(:EVENT :LOG))) ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
(setf feedback result)) (setf feedback result))
((and result (not (member target *silent-actuators*))) ((and result (not (member target *actuator-silent*)))
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
:payload (list :sensor :tool-output :result result :tool approved)))))) :payload (list :sensor :tool-output :result result :tool approved))))))
(when source (dispatch-action signal signal))))) (when source (action-dispatch signal signal)))))
(setf (getf signal :status) :acted) (setf (getf signal :status) :acted)
feedback)) feedback))
#+end_src #+end_src
* Test Suite * Test Suite
#+begin_src lisp :tangle ../tests/pipeline-act-tests.lisp Verifies that the act gate correctly processes an approved action and sets the signal status to ~:acted~.
#+begin_src lisp :tangle ../lisp/core-loop-act.lisp
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (ql:quickload :fiveam :silent t))
(defpackage :opencortex-pipeline-act-tests (defpackage :passepartout-pipeline-act-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :passepartout)
(:export #:pipeline-act-suite)) (:export #:pipeline-act-suite))
(in-package :opencortex-pipeline-act-tests) (in-package :passepartout-pipeline-act-tests)
(def-suite pipeline-act-suite :description "Test suite for Act pipeline") (def-suite pipeline-act-suite :description "Test suite for Act pipeline")
(in-suite pipeline-act-suite) (in-suite pipeline-act-suite)
(test test-act-gate-basic (test test-loop-gate-act-basic
(clrhash opencortex::*skills-registry*) (clrhash passepartout::*skills-registry*)
(let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello")))) (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
(result (act-gate signal))) (result (loop-gate-act signal)))
(is (eq :acted (getf signal :status))) (is (eq :acted (getf signal :status)))
(is (null result)))) (is (null result))))
#+end_src #+end_src

169
org/core-loop-perceive.org Normal file
View File

@@ -0,0 +1,169 @@
#+TITLE: Stage 1: Perceive (perceive.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:perceive:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle ../lisp/core-loop-perceive.lisp
* Overview: Architectural Intent
The Perceive stage is the sensory cortex of Passepartout. It receives raw stimuli from diverse sources — terminal input, Emacs buffers, Telegram messages, Signal chats, heartbeat clocks, shell command outputs — and normalizes them into a single Signal format that the rest of the pipeline can process.
Each source has its own format and protocol. The CLI sends raw text. Emacs sends AST diffs. Telegram sends JSON. Without normalization, every downstream component (Reason, Act) would need to understand every input format. With normalization:
1. The gateway layer (CLI, Emacs, Telegram, Signal) just sends raw messages
2. Perceive transforms them into Signals regardless of origin
3. Reason and Act work with a single, consistent plist format
4. Adding a new gateway requires gateway code only — no changes to core
This is the "thin harness, fat skills" principle applied to input processing. The harness does the minimal normalization needed to produce a uniform Signal; the actual interpretation is left to skills.
** Why the Async/Sync Split?
Perceive handles two kinds of stimuli:
- **Synchronous** (user input, chat messages) — these must be processed in order, one at a time, because each depends on the state left by the previous one
- **Asynchronous** (heartbeats, background sensor readings, delegation results) — these can be processed in parallel because they don't depend on user intent
The `*loop-async-sensors*` list defines which sensor types are processed in dedicated threads. Everything else goes through the main synchronous pipeline.
The depth limit prevents runaway recursive loops. A signal that generates another signal that generates another signal can infinite-loop. If depth exceeds a threshold (10), the signal is silently dropped rather than processed. This is the metabolic loop's circuit breaker.
* Implementation
** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src
** Interrupt Flag
A global interrupt flag that can be set by any signal. When set, the metabolic loop should stop processing and clean up. This is used for graceful shutdown: a SIGINT or /exit command sets the flag, and the loop exits at the next cycle boundary.
#+begin_src lisp
(defvar *loop-interrupt* nil)
#+end_src
** Sensor Configuration
~*loop-async-sensors*~ lists the sensor types that should be processed in their own threads. Currently, ~:chat-message~, ~:delegation~, and ~:user-command~ are async because they don't block the main reasoning loop — the agent can process a Telegram message while waiting for the user's next input.
~*loop-focus-id*~ tracks what the user is currently looking at in Emacs. When the user moves their cursor to a different Org headline, the buffer-update signal updates this ID. The Reason stage uses it to build the foveal-peripheral context model: the current headline gets full detail, everything else gets a skeletal outline.
#+begin_src lisp
(defvar *loop-async-sensors* '(:chat-message :delegation :user-command)
"Sensors that are processed in dedicated threads.")
(defvar *loop-focus-id* nil
"The Org ID of the node the user is currently interacting with.")
#+end_src
** Stimulus Injection (stimulus-inject)
This is the entry point that gateways call to send a message into the cognitive pipeline. It sets metadata (source, session ID, reply stream), decides whether the stimulus should be processed synchronously or on a background thread, and wraps the whole thing in error recovery so that no single bad stimulus can crash the system.
The error recovery uses Common Lisp's restart system. If any error occurs during processing, a `skip-event` restart is available. The handler displays the error, then invokes `skip-event` which drops the stimulus and continues. This is the "fail open" safety model — better to drop one message than to crash the entire agent.
#+begin_src lisp
(defun stimulus-inject (raw-message &key stream (depth 0))
"Inject a raw message into the signal processing pipeline."
(let* ((payload (getf raw-message :payload))
(sensor (getf payload :sensor))
(meta (getf raw-message :meta))
(async-p (or (getf payload :async-p)
(member sensor *loop-async-sensors*))))
(unless meta
(setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
(when stream
(setf (getf meta :reply-stream) stream))
(setf (getf raw-message :meta) meta)
(setf (getf raw-message :depth) depth)
(if async-p
(bt:make-thread
(lambda ()
(restart-case (process-signal raw-message)
(skip-event () nil)))
:name "passepartout-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."))))))
#+end_src
** Perceive Gate (loop-gate-perceive)
The perceive gate is the first stage of the metabolic pipeline. It receives a normalized signal and routes it based on the event type:
- ~:EVENT~ with ~:buffer-update~ — an Emacs buffer changed (new Org headline created, text edited). The change is ingested into memory so the agent has the latest state.
- ~:EVENT~ with ~:point-update~ — the user moved their cursor to a different headline. The foveal focus is updated, and the node at the cursor is ingested at higher priority.
- ~:EVENT~ with ~:interrupt~ — the user requested an interrupt. The interrupt flag is set.
- ~:RESPONSE~ — an action completed. The gate logs the result status.
All signals get tagged with their processing stage (`:status :perceived`) and the current foveal focus before being passed to the Reason stage.
#+begin_src lisp
(defun loop-gate-perceive (signal)
"Stage 1 of the metabolic pipeline: Normalize sensory input."
(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))
(cond ((eq type :EVENT)
(case sensor
(:buffer-update
(let ((ast (getf payload :ast)))
(when ast
(snapshot-memory)
(ingest-ast ast))))
(:point-update
(let ((element (getf payload :element)))
(when element
(snapshot-memory)
(setf *loop-focus-id* (getf element :id))
(ingest-ast element))))
(:interrupt
(setf *loop-interrupt* t))))
((eq type :RESPONSE)
(harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
(setf (getf signal :status) :perceived)
(setf (getf signal :foveal-focus) *loop-focus-id*)
signal))
#+end_src
* Test Suite
Verifies that the perceive gate correctly ingests AST nodes into memory and that the depth limiter prevents runaway recursive signals.
#+begin_src lisp :tangle ../lisp/core-loop-perceive.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-pipeline-perceive-tests
(:use :cl :fiveam :passepartout)
(:export #:pipeline-perceive-suite))
(in-package :passepartout-pipeline-perceive-tests)
(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline")
(in-suite pipeline-perceive-suite)
(test test-loop-gate-perceive
(clrhash passepartout::*memory*)
(let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
(result (loop-gate-perceive signal)))
(is (eq :perceived (getf result :status)))
(is (not (null (gethash "test-node" passepartout::*memory*))))))
(test test-depth-limiting
(let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
(is (null (process-signal runaway-signal)))))
#+end_src

318
org/core-loop-reason.org Normal file
View File

@@ -0,0 +1,318 @@
#+TITLE: Stage 2: Reason (reason.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:reason:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle ../lisp/core-loop-reason.lisp
* Overview: Architectural Intent
The Reason stage is the cognitive heart of Passepartout. It takes a normalized signal from Perceive and produces an approved action for Act. This is where the two engines — probabilistic (LLM) and deterministic (Lisp logic) — collaborate.
The design is shaped by one non-negotiable constraint: **the LLM must never touch the actuators directly.** Every action the LLM proposes must pass through a deterministic verification gate that has the final say. This is what separates Passepartout from every other AI agent: the creative brain suggests, but the logical brain decides.
** The Probabilistic-Deterministic Split
An LLM is a statistical engine. Given enough context, it is remarkably good at translation, generation, and pattern matching. But it cannot be trusted with authority because hallucination is a *fundamental property* of probabilistic inference — the model generates the most likely continuation, not the correct one.
The deterministic engine addresses this by being what the probabilistic engine is not: mathematically rigorous, formally verifiable, and incapable of hallucination by design. It operates on explicit symbolic representations — lists, property lists, knowledge graphs — not on floating-point activations. When it evaluates a path confinement check, it returns true or false, not a probability distribution.
The division of labor is architectural:
- The LLM handles the fuzzy interface between human language and structured representation
- The deterministic engine receives those structured representations and evaluates them against formal invariants
- The LLM never reads a file, never executes a command, never modifies memory — it generates proposals
This separation is the source of Passepartout's safety guarantee. Other agents add "guardrails" as an afterthought — a layer of filtering around a dangerous core. Passepartout makes the division explicit.
** Why Plists for Communication?
Every message in the Reason pipeline is a property list (plist):
(TYPE :REQUEST TARGET :CLI PAYLOAD (ACTION :MESSAGE TEXT "Hello"))
A plist is simultaneously:
- Human-readable text
- Machine-parseable data structure
- Executable Lisp code
This is not a cosmetic choice. It means the reasoning pipeline can generate, modify, and execute its own communication protocol without external parsing libraries. There is no JSON encoder, no schema validator, no serialization layer between the two engines. They speak the same language because they *are* the same language.
* Implementation
** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src
** Probabilistic Engine State
The probabilistic engine maintains four pieces of global state that control how LLM requests are dispatched:
~*backend-registry*~ is a hash table mapping provider keywords (like ~:ollama~ or ~:openrouter~) to the actual function that calls that provider's API. ~*provider-cascade*~ is the ordered list of providers to try — if the first one fails, the cascade falls through to the next. ~*model-selector*~ is an optional function that examines the context and picks a model per request (useful for routing simple questions to a small fast model and complex reasoning to a large expensive one). ~*consensus-enabled*~ toggles multi-provider agreement, where multiple LLMs run the same prompt and the system waits for consensus.
These variables are configurable at runtime. The cascade can be changed without restart: (setf *provider-cascade* (quote (:ollama :openrouter))).
#+begin_src lisp
(defvar *backend-registry* (make-hash-table :test 'equal))
#+end_src
#+begin_src lisp
(defvar *provider-cascade* nil)
#+end_src
#+begin_src lisp
(defvar *model-selector* nil)
#+end_src
#+begin_src lisp
(defvar *consensus-enabled* nil)
#+end_src
** Backend Registration (backend-register)
Each LLM provider registers itself by calling this function. The backend function receives a prompt string, a system prompt string, and optional keyword arguments for model selection. It must return either a plist with ~:status :success~ and ~:content~, or ~:status :error~ with a message.
Registration is typically done at boot time by the unified-llm-backend skill, but can also be done dynamically:
(backend-register :my-custom-provider #'my-fn)
#+begin_src lisp
(defun backend-register (name fn)
(setf (gethash name *backend-registry*) fn))
#+end_src
** Cascade Dispatch (backend-cascade-call)
Given a prompt, this function iterates through the provider cascade and calls each backend in order until one succeeds. A provider "succeeds" when it returns ~:status :success~ with content, or when it returns a plain string (the LLM's raw output).
The function has a fallback for every failure mode:
- If a backend returns ~:status :error~, the cascade moves to the next provider
- If a backend throws an exception, it is caught and logged, and the cascade moves on
- If ALL backends are exhausted, a structured LOG message is returned saying "Neural Cascade Failure"
This is deliberately resilient. The system should never crash because an LLM provider is down. It should log the failure, try the next provider, and if all fail, return a diagnostic message that the deterministic engine can present to the user.
#+begin_src lisp
(defun backend-cascade-call (prompt &key
(system-prompt "You are the Probabilistic engine.")
(cascade nil)
(context nil))
(let ((backends (or cascade *provider-cascade*)))
(or (dolist (backend backends)
(let ((backend-fn (gethash backend *backend-registry*)))
(when backend-fn
(harness-log "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model (when *model-selector*
(funcall *model-selector* backend context)))
(result (if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
(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.")))))
#+end_src
** Cognitive Proposal Generation (think)
The ~think~ function is where the creative brain does its work. It assembles the full context for the LLM: the system identity, the available tools, the current global context from memory, the recent system logs, and any rejection trace from a previous failed proposal. It also collects augment strings from any skill that has registered a ~system-prompt-augment~ function.
A note on the augment system: skills can contribute context-specific mandates to the LLM prompt. For example, the REPL skill injects the "prototype in the REPL first" mandate when the context suggests the agent is editing Lisp code. This keeps domain-specific instructions out of the harness while still ensuring they appear in the prompt when relevant.
The LLM's response is expected to be a plist. If it is, it gets parsed and normalized. If it's a string that starts with ~(~ or ~[~, it's read as Lisp data. If it's neither, it falls back to a REQUEST with a MESSAGE action — the raw text.
** Pre-processing: strip markdown from LLM output
LLMs often wrap structured output in markdown code fences:
```lisp
(:TYPE :REQUEST ...)
```
This function strips the fences so the reader can parse the plist.
#+begin_src lisp
(defun markdown-strip (text)
(if (and text (stringp text))
(let ((cleaned text))
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
(setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned ""))
(setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
(string-trim '(#\Space #\Newline #\Tab) cleaned))
text))
#+end_src
** Normalize plist keywords
Lisp keywords are case-sensitive. The LLM might produce ~:payload~ or ~:PAYLOAD~ or ~:Payload~ depending on the model. This function normalizes all keyword keys to uppercase to ensure the deterministic engine receives consistent input.
#+begin_src lisp
(defun plist-keywords-normalize (plist)
(when (listp plist)
(loop for (k v) on plist by #'cddr
collect (if (and (symbolp k) (not (keywordp k)))
(intern (string k) :keyword)
k)
collect v)))
#+end_src
** Think: assemble context and call the LLM
This is the main entry point for the probabilistic engine. Every cognitive cycle goes through here.
The function handles several cases:
- If a triggered skill provides a probabilistic prompt generator, that replaces the raw user input
- If the previous proposal was rejected, the rejection trace is injected into the LLM's context so it can self-correct
- Skills can augment the system prompt with domain-specific mandates via the ~system-prompt-augment~ mechanism
The system prompt assembly order — identity, tools, context, logs, mandates — is intentional: the most dynamic content (mandates from skills) comes last so it has the most influence on the LLM's output.
#+begin_src lisp
(defun think (context)
(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"))
(rejection-trace (proto-get (proto-get context :payload) :rejection-trace))
(prompt-generator (when active-skill (skill-probabilistic-prompt active-skill)))
(raw-prompt (if prompt-generator
(funcall prompt-generator context)
(let ((p (proto-get (proto-get context :payload) :text)))
(if (and p (stringp p)) p "Maintain metabolic stasis."))))
(reflection-feedback (if rejection-trace
(format nil "~%~%PREVIOUS PROPOSAL REJECTED: ~a" rejection-trace)
""))
(skill-augments (let ((augments ""))
(maphash (lambda (name skill)
(declare (ignore name))
(let ((aug-fn (skill-system-prompt-augment skill)))
(when aug-fn
(let ((aug-text (ignore-errors (funcall aug-fn context))))
(when (and aug-text (stringp aug-text) (> (length aug-text) 0))
(setf augments (concatenate 'string augments aug-text (string #\Newline))))))))
*skills-registry*)
(when (> (length augments) 0) augments)))
(system-prompt (format nil "IDENTITY: ~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a~%~a"
assistant-name reflection-feedback tool-belt global-context system-logs
(or skill-augments ""))))
(let* ((thought (backend-cascade-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (markdown-strip thought)))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(plist-keywords-normalize parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
#+end_src
** Deterministic Engine (cognitive-verify)
The deterministic engine is the strict guard. It receives a proposed action from the probabilistic engine and runs it through every registered deterministic gate, sorted by priority.
Skills register deterministic gates via ~defskill~ with the ~:deterministic~ keyword. Each gate is a function that receives (action context) and returns either:
- A modified action (the gate approves or adjusts the proposal)
- A LOG or EVENT plist (the gate rejects the proposal with a reason)
Gates run in priority order, highest first. If any gate returns a LOG or EVENT, the proposal is rejected immediately and the rejection reason flows back to the probabilistic engine via the rejection trace. If all gates pass, the proposal is approved.
This architecture makes safety compositional: each skill adds one constraint. The bouncer checks secrets. The policy checks explanations. The shell actuator checks destructive commands. No single skill needs to understand the full security model.
#+begin_src lisp
(defun cognitive-verify (proposed-action context)
(let ((current-action proposed-action)
(skills nil))
(maphash (lambda (name skill)
(declare (ignore name))
(when (skill-deterministic-fn skill)
(push skill skills)))
*skills-registry*)
(setf skills (sort skills #'> :key #'skill-priority))
(dolist (skill skills)
(let ((trigger (skill-trigger-fn skill))
(gate (skill-deterministic-fn skill)))
(when (or (null trigger) (ignore-errors (funcall trigger context)))
(let ((next-action (funcall gate current-action context)))
(when (and (listp next-action)
(member (proto-get next-action :type) '(:LOG :EVENT)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from cognitive-verify next-action))
(when next-action (setf current-action next-action))))))
current-action))
#+end_src
** Reason Gate (Stage 2)
The reason gate is the pipeline stage that orchestrates Think + Determine. It receives a signal, checks if it requires reasoning (only ~:user-input~ and ~:chat-message~ events do), and runs through the cognitive + verification loop.
The loop has retry logic: up to 3 attempts. If the deterministic engine rejects a proposal, the rejection reason is fed back into the next think call so the LLM can self-correct. This loop — propose, reject, correct, re-propose — is the core mechanism by which the agent improves its own output without human intervention.
The retry limit prevents infinite loops. If the LLM cannot produce a passable proposal within 3 attempts, the last rejection reason is attached to the signal and the acted pipeline sees a failed reasoning cycle.
#+begin_src lisp
(defun loop-gate-reason (signal)
(let* ((type (proto-get signal :type))
(payload (proto-get signal :payload))
(sensor (proto-get payload :sensor)))
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
(return-from loop-gate-reason signal))
(let ((retries 3)
(current-signal (copy-tree signal))
(last-rejection nil))
(loop
(when (<= retries 0)
(setf (getf signal :approved-action) last-rejection)
(setf (getf signal :status) :reasoned)
(return signal))
(when last-rejection
(setf (getf (getf current-signal :payload) :rejection-trace) last-rejection))
(let ((candidate (think current-signal)))
(if (and candidate (listp candidate))
(let ((verified (cognitive-verify candidate current-signal)))
(if (member (getf verified :type) '(:LOG :EVENT))
(progn (decf retries) (setf last-rejection verified))
(progn
(setf (getf signal :approved-action) verified)
(setf (getf signal :status) :reasoned)
(return signal))))
(progn
(setf (getf signal :approved-action) nil)
(setf (getf signal :status) :reasoned)
(return signal))))))))
#+end_src
* Test Suite
Verifies that the deterministic engine correctly rejects unsafe actions (like ~rm -rf /~) while allowing safe ones.
#+begin_src lisp :tangle ../lisp/core-loop-reason.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-pipeline-reason-tests
(:use :cl :fiveam :passepartout)
(:export #:pipeline-reason-suite))
(in-package :passepartout-pipeline-reason-tests)
(def-suite pipeline-reason-suite :description "Test suite for Reason pipeline")
(in-suite pipeline-reason-suite)
(test test-decide-gate-safety
(clrhash passepartout::*skills-registry*)
(passepartout::defskill :mock-safety
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(if (search "rm -rf" (format nil "~s" action))
(list :type :LOG :payload (list :text "Rejected"))
action)))
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "rm -rf /")))
(signal '(:type :EVENT :payload (:sensor :user-input)))
(result (cognitive-verify candidate signal)))
(is (eq :LOG (getf result :type)))))
#+end_src

278
org/core-loop.org Normal file
View File

@@ -0,0 +1,278 @@
#+TITLE: The Metabolic Loop (loop.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:loop:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle ../lisp/core-loop.lisp
* Overview: Architectural Intent
The Metabolic Loop is the cranial nerve reflex of Passepartout. While skills provide specialized intelligence, the loop provides the fundamental rhythm of existence: the continuous processing of signals from perception through cognition to action.
Every signal flows through three stages:
1. **Perceive** — normalize raw input into a standard Signal format
2. **Reason** — think (LLM) then verify (deterministic gates)
3. **Act** — dispatch the approved action to the appropriate actuator
If a stage produces a new signal (e.g., the Act stage produces a tool-output event), that signal feeds back into Perceive and the loop continues. This is how the agent has multi-step conversations: each LLM response produces an action, which produces a tool output, which feeds back as a new perception, which triggers the next reasoning cycle.
** Why Separate Stages?
A single function that called the LLM, checked safety, and executed the result would be simpler to write. But it would be impossible to:
- Test each stage independently (a bug in the LLM call would block safety testing)
- Insert new stages between P and R or R and A (adding consensus means adding a gate in the middle)
- Recover from failures mid-pipeline (an LLM timeout shouldn't prevent safety checks on the next cycle)
The stage separation is the functional equivalent of the "thin harness" principle: each stage is a pure function that transforms a signal. The loop is the composition of these functions.
** Why the Depth Limit?
A signal that generates another signal that generates another signal can infinite-loop. The depth limit (max 10) prevents this. If depth exceeds 10, the signal is silently dropped. This is the metabolic loop's circuit breaker.
The three-tier error recovery model:
1. **Transient errors** (tool failures, network timeouts) — recoverable, generate a :loop-error signal at higher depth for retry
2. **Critical errors** (undefined functions, malformed data) — require memory rollback to the last snapshot
3. **Recursive loops** (signals generating more signals indefinitely) — depth limit enforcement
* Implementation
** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src
** Global Interrupt State
Thread-safe interrupt flag. The ~*loop-interrupt-lock*~ mutex protects access so that the signal handler and the main loop don't race on shutdown.
#+begin_src lisp
(defvar *interrupt-flag* nil
"Atomic flag set by signal handlers to trigger graceful shutdown.")
(defvar *loop-interrupt-lock* (bt:make-lock "harness-interrupt-lock")
"Mutex protecting *interrupt-flag* access.")
(defvar *heartbeat-thread* nil
"Handle to the heartbeat thread.")
#+end_src
** Core Engine (loop-process)
The entry point to the metabolic pipeline. Each cycle runs Perceive → Reason → Act. If Act produces feedback (a new signal), the loop continues with that signal at the same depth.
The function handles four failure modes:
- **Depth exceeded**: signal dropped, nil returned
- **Interrupt flag**: graceful shutdown, nil returned
- **Handler error**: caught by handler-case, logged, and depending on the sensor type and depth:
- Normal errors at low depth → memory rollback + retry as :loop-error
- :loop-error and :tool-error at any depth → dropped (avoids infinite retry loops)
- High-depth errors (depth > 2) → dropped (avoids cascading failures)
- **Unhandled error**: the handler-case catches everything, preventing any single bad signal from crashing the agent
#+begin_src lisp
(defun loop-process (signal)
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
(let ((current-signal signal))
(loop while current-signal do
(let ((depth (getf current-signal :depth 0))
(meta (getf current-signal :meta)))
(when (> depth 10)
(harness-log "METABOLISM ERROR: Max recursion depth reached.")
(return nil))
(when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
(harness-log "METABOLISM: Interrupted by shutdown signal.")
(return nil))
(handler-case
(progn
(setf current-signal (perceive-gate current-signal))
(setf current-signal (reason-gate current-signal))
(let ((feedback (act-gate current-signal)))
(if feedback
(progn
(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)
(unless (member sensor '(:loop-error :tool-error :syntax-error))
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
(rollback-memory 0))
(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)))))))))))
#+end_src
** Heartbeat Mechanism
The heartbeat is a background thread that fires every N seconds (configurable via ~HEARTBEAT_INTERVAL~ env var, default 60). On each tick, it:
1. Increments the save counter and saves memory to disk when the counter exceeds the auto-save interval (default 300s)
2. Injects a ~:heartbeat~ signal into the pipeline
The heartbeat signal is how background skills (Gardener, Scribe) get triggered without user input. These skills have triggers that match ~:sensor :heartbeat~ and run maintenance tasks during idle cycles.
#+begin_src lisp
(defvar *memory-auto-save-interval* 300)
(defvar *heartbeat-save-counter* 0)
(defun heartbeat-start ()
"Starts the background heartbeat thread."
(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"))) *memory-auto-save-interval*)))
(setf *memory-auto-save-interval* auto-save)
(setf *heartbeat-save-counter* 0)
(setf *heartbeat-thread*
(bt:make-thread
(lambda ()
(loop
(sleep interval)
(incf *heartbeat-save-counter*)
(when (>= *heartbeat-save-counter* (/ *memory-auto-save-interval* interval))
(setf *heartbeat-save-counter* 0)
(save-memory-to-disk))
(inject-stimulus
(list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
:name "passepartout-heartbeat"))))
#+end_src
** Shutdown Save Flag
Controls whether memory is saved on shutdown. Useful for testing when you want a clean state on next boot.
#+begin_src lisp
(defvar *shutdown-save-enabled* t)
#+end_src
** System Health Status
Used by the health check protocol and the daemon's status endpoint. Set by ~diagnostics-startup-run~ during boot.
- ~:healthy~ — all checks passed
- ~:degraded~ — checks found issues but the daemon can still run
- ~:unhealthy~ — checks failed, the daemon may not function correctly
- ~:unknown~ — health check hasn't run yet
#+begin_src lisp
(defvar *system-health* :unknown
"Current system health status: :healthy, :degraded, :unhealthy, or :unknown.")
(defvar *health-check-ran* nil
"Flag indicating if initial health check has completed.")
#+end_src
** Proactive Doctor
Runs the doctor diagnostics automatically at startup. If the doctor finds issues (missing dependencies, misconfigured providers), it prints a diagnostic message but does NOT block the daemon from starting. The user can see the issues and run ~passepartout doctor --fix~ to repair.
This is the "fail open" principle applied to boot: the system should start even with problems, not refuse to start until everything is perfect.
#+begin_src lisp
(defun diagnostics-startup-run ()
"Runs the doctor diagnostics on startup. Returns health status."
(format t "~%")
(format t "==================================================~%")
(format t " DOCTOR: Running Startup Health Check~%")
(format t "==================================================~%")
(handler-case
(progn
(when (fboundp 'doctor-run-all)
(let ((result (doctor-run-all :auto-install nil)))
(setf *health-check-ran* t)
(if result
(progn
(setf *system-health* :healthy)
(format t "DAEMON: Health check passed. Starting services.~%"))
(progn
(setf *system-health* :degraded)
(format t "DAEMON: Health check found issues.~%")
(format t " Run 'passepartout doctor --fix' to repair.~%")))))
(setf *health-check-ran* t))
(error (c)
(format t "DOCTOR ERROR: ~a~%" c)
(setf *system-health* :unhealthy)
(setf *health-check-ran* t)))
(format t "==================================================~%~%"))
#+end_src
** Main Entry Point (main)
The top-level entry point. Called by ~passepartout daemon~ and ~passepartout tui~.
Boot sequence:
1. Load environment variables from ~.config/passepartout/.env~
2. Load persisted memory state from disk
3. Register core actuators (:system, :tool, :tui)
4. Initialize all skills (tangging .lisp or loading from XDG)
5. Run the proactive health check
6. Start the heartbeat thread (background maintenance)
7. Start the TCP daemon (listens for CLI/TUI connections)
8. Install the SIGINT handler (graceful shutdown on Ctrl+C)
9. Enter the idle sleep loop (wakes on interrupt)
#+begin_src lisp
(defun main ()
"Entry point for Passepartout. Initializes the system and enters idle loop."
(let* ((home (uiop:getenv "HOME"))
(env-file (uiop:merge-pathnames* ".config/passepartout/.env" (uiop:ensure-directory-pathname home))))
(when (uiop:file-exists-p env-file)
(cl-dotenv:load-env env-file)))
(load-memory-from-disk)
(initialize-actuators)
(initialize-all-skills)
;; Run proactive doctor before starting services
(diagnostics-startup-run)
(heartbeat-start)
(start-daemon)
#+sbcl
(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)))
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
(loop
(when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
(harness-log "SHUTDOWN: Interrupt flag set. Saving memory...")
(when *shutdown-save-enabled* (save-memory-to-disk))
(return))
(sleep sleep-interval))))
#+end_src
* Test Suite
Verifies that the immune system (error handling) correctly catches and reports errors from the cognitive pipeline.
#+begin_src lisp :tangle ../lisp/core-loop.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-immune-system-tests
(:use :cl :fiveam :passepartout)
(:export #:immune-suite))
(in-package :passepartout-immune-system-tests)
(def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)")
(in-suite immune-suite)
(test loop-error-injection
"Verify that a crash in think/decide triggers a :loop-error stimulus."
(clrhash passepartout::*skills-registry*)
(passepartout:defskill :evil-skill
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input))
:probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE"))
:deterministic nil)
(passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
(let ((logs (passepartout:context-get-system-logs 20)))
(is (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs))))))
#+end_src

72
org/core-manifest.org Normal file
View File

@@ -0,0 +1,72 @@
#+TITLE: System Manifest (manifest.org)
#+AUTHOR: Agent
#+FILETAGS: :harness:manifest:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle ../passepartout.asd
* Overview: Architectural Intent
The Manifest is the ASDF system definition for Passepartout. It defines what files belong to the harness, which external libraries are required, and how the test infrastructure is organized.
The ~passepartout.asd~ file tangled from this manifest is what ~ql:quickload :passepartout~ reads to load the system. The files are loaded in the order listed here — dependencies first, then each pipeline stage in order.
* Implementation
** Main System
The core system. The combined ~:depends-on~ list pulls in every external library the agent needs: networking (usocket, dexador, hunchentoot), concurrency (bordeaux-threads), utilities (uiop, cl-ppcre, cl-json, str), security (ironclad), and configuration (cl-dotenv, uuid).
Components are loaded in sequence (~:serial t~): package first (defines the public API), then skills (does the defskill macro), then communication (defines the protocol), then memory (defines org-object), then context (defines peripheral vision), then each pipeline stage in order (perceive, reason, act), then doctor (diagnostics), then loop (orchestration).
#+begin_src lisp
(defsystem :passepartout
:name "Passepartout"
:author "Amr Gharbeia"
:version "0.3.0"
:license "AGPLv3"
:description "The Probabilistic-Deterministic Lisp Machine"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
:serial t
:components ((:file "lisp/core-defpackage")
(:file "lisp/core-skills")
(:file "lisp/core-communication")
(:file "lisp/core-memory")
(:file "lisp/core-context")
(:file "lisp/core-loop-perceive")
(:file "lisp/core-loop-reason")
(:file "lisp/core-loop-act")
(:file "lisp/core-loop")))
#+end_src
** Test System
The test system loads on top of ~opencortex~ and adds FiveAM (the test framework). Each test file is tangled from a ~:tangle ../tests/...~ block in the parent org file.
Note: not every harness or skill file has a corresponding test file. Tests exist only for the parts of the system where deterministic verification is most critical — the pipeline stages, the loader, the memory Merkle tree, and the peripheral vision model.
#+begin_src lisp
(defsystem :passepartout/tests
:depends-on (:passepartout :fiveam)
:components ((:file "tests/pipeline-act-tests")
(:file "tests/boot-sequence-tests")
(:file "tests/communication-tests")
(:file "tests/immune-system-tests")
(:file "tests/memory-tests")
(:file "tests/pipeline-perceive-tests")
(:file "tests/pipeline-reason-tests")
(:file "tests/peripheral-vision-tests")
(:file "tests/tui-tests")
(:file "tests/utils-org-tests")
(:file "tests/utils-lisp-tests")
(:file "tests/llm-gateway-tests")))
#+end_src
** TUI System
The TUI is a standalone system that depends on Croatoan (ncurses bindings) in addition to the core opencortex system. It's loaded separately because Croatoan requires a terminal and is not needed for daemon-mode operation.
#+begin_src lisp
(defsystem :passepartout/tui
:depends-on (:passepartout :croatoan :usocket :bordeaux-threads)
:components ((:file "lisp/gateway-tui")))
#+end_src

340
org/core-memory.org Normal file
View File

@@ -0,0 +1,340 @@
#+TITLE: The System Memory (memory.lisp)
#+AUTHOR: Agent
#+FILETAGS: :harness:memory:
#+STARTUP: content
#+PROPERTY: header-args:lisp :tangle ../lisp/core-memory.lisp
* Overview: Architectural Intent
The Memory module is the cognitive bedrock of Passepartout. It is not a database; it is the agent's live, active brain state. Every perception, every action, every decision is recorded here.
Traditional architectures rely on external databases (SQLite, vector DBs, JSON files) which introduce I/O latency, structural impedance, and serialization overhead. Passepartout chooses a different path: the **Single Address Space**. By treating the entire knowledge base as a graph of Lisp pointers in RAM, we achieve microsecond recollection and total structural transparency.
The memory system has three layers:
1. **Active memory** (~*memory-store*~) — a hash table mapping IDs to ~memory-object~ instances. This is what the agent queries during reasoning.
2. **Immutable history** (~*memory-history*~) — an append-only hash table keyed by SHA-256 Merkle hash. Every version of every object that has ever existed is preserved here.
3. **Snapshot stack** (~*memory-snapshots*~) — point-in-time copies of active memory for rollback recovery. Up to 20 snapshots are retained.
** Why Merkle Hashes?
Every ~memory-object~ carries a ~hash~ field computed from its ID, type, attributes, content, and children. This hash is deterministic: the same data always produces the same hash.
The hash serves three purposes:
1. **Integrity verification** — detect corruption or tampering
2. **Deduplication** — if an object already exists in history, we reuse the existing entry
3. **Change detection** — compare hashes to find what changed between snapshots
** Why Snapshots Instead of Git?
Git tracks changes to files. Passepartout tracks changes to live memory state. The snapshot system captures the entire active memory at a point in time, enabling full rollback to any previous state. This is necessary because:
1. The agent modifies memory continuously (learning, noting, deciding) — there's no discrete "commit" boundary
2. Memory corruption from a bad LLM output can affect multiple objects — snapshot rollback restores all of them atomically
3. Git can't snapshot the running Lisp image's hash tables
The tradeoff is memory usage: each snapshot is a deep copy of every object in active memory. 20 snapshots means 20x the active memory size. For a typical knowledge base of 10,000 objects, this is manageable (~100MB for 20 snapshots).
* Implementation
** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src
** The Object Store
~*memory-store*~ holds the agent's current state. ~*memory-history*~ holds every past version, keyed by Merkle hash.
#+begin_src lisp
(defvar *memory-store* (make-hash-table :test 'equal))
(defvar *memory-history* (make-hash-table :test 'equal)
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
#+end_src
** Object Lookup (memory-object-get)
Retrieve a single object by its ID from active memory. Returns nil if the ID doesn't exist.
#+begin_src lisp
(defun memory-object-get (id)
"Retrieves an memory-object by ID from *memory-store*."
(gethash id *memory-store*))
#+end_src
** Object Search by Attribute (memory-objects-by-attribute)
Scan the entire active memory for objects whose attributes plist contains a specific key-value pair. For example, finding all objects with ~:TODO "APPROVED"~ (used by the Bouncer to find approved flight plans).
This is a full scan — O(n) over all objects. For the typical knowledge base size (< 10,000 objects), this is microsecond-fast. For larger datasets, a proper index would be needed.
#+begin_src lisp
(defun memory-objects-by-attribute (attr value)
"Returns all memory-objects whose :ATTRIBUTES plist has ATTR = VALUE."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(when (equal (getf (memory-object-attributes obj) attr) value)
(push obj results)))
*memory-store*)
(nreverse results)))
#+end_src
** ID Generation (memory-id-generate)
Generates a unique identifier string for a new Org node. Uses the universal time encoded in base-36 for compactness and monotonic ordering (later IDs sort after earlier ones).
#+begin_src lisp
(defun memory-id-generate ()
"Generates a timestamp-based unique ID."
(format nil "id-~36r" (get-universal-time)))
#+end_src
** The Data Structure (memory-object)
The universal data unit. Every stored entity — a note, a task, a project, a person, a decision — is an ~memory-object~. The struct has:
- ~id~ — unique identifier (string)
- ~type~ — keyword (e.g., ~:HEADLINE~, ~:PROPERTY_DRAWER~)
- ~attributes~ — property list (e.g., ~(:TITLE "My Note" :TAGS ("project") :TODO "NEXT")~)
- ~content~ — raw text content
- ~vector~ — optional embedding vector for semantic search
- ~parent-id~ — ID of the parent object (for tree structure)
- ~children~ — list of child IDs
- ~version~ — Unix timestamp of last modification
- ~last-sync~ — Unix timestamp of last sync to disk
- ~hash~ — SHA-256 Merkle hash for integrity verification
#+begin_src lisp
(defstruct memory-object
id type attributes content vector parent-id children version last-sync hash)
#+end_src
** Serialization Support
Required by the Lisp runtime for saving/loading objects across image restarts via ~make-load-form-saving-slots~.
#+begin_src lisp
(defmethod make-load-form ((obj memory-object) &optional env)
(make-load-form-saving-slots obj :environment env))
#+end_src
** Deep Copy
Creates an independent copy of an ~memory-object~, including fresh lists for attributes and children. Used by the snapshot system to capture a consistent memory state.
Without deep copy, a snapshot would share structure with the live memory — mutating the live memory would also mutate the snapshot, defeating the purpose of having a recovery point.
#+begin_src lisp
(defun deep-copy-memory-object (obj)
"Creates a full copy of an memory-object, including fresh lists for attributes and children."
(make-memory-object :id (memory-object-id obj)
:type (memory-object-type obj)
:attributes (copy-list (memory-object-attributes obj))
:content (memory-object-content obj)
:vector (memory-object-vector obj)
:parent-id (memory-object-parent-id obj)
:children (copy-list (memory-object-children obj))
:version (memory-object-version obj)
:last-sync (memory-object-last-sync obj)
:hash (memory-object-hash obj)))
#+end_src
** Merkle Tree Integrity (memory-merkle-hash)
Computes a deterministic SHA-256 hash from an object's identity and contents. The hash covers:
- The object's ID and type
- All attributes (sorted by key name for determinism)
- The raw content text
- The hashes of all children (making the hash a true Merkle tree — changing a descendant changes this hash)
This is NOT a cryptographic signature — it's an integrity check. If any part of an object or its descendants changes, the hash changes.
#+begin_src lisp
(defun memory-merkle-hash (id type attributes content child-hashes)
(let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
(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))
(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
** AST Ingestion (memory-ingest)
The primary entry point for adding data to memory. Given an Org-mode AST (a tree of plists representing headlines and their contents), it recursively:
1. Generates or assigns an ID to each node
2. Computes the Merkle hash of each node
3. Checks if the hash already exists in ~*memory-history*~ (deduplication)
4. Stores the node in ~*memory-store*~ and ~*memory-history*~
5. Links children to parents
Returns the ID of the root node.
#+begin_src lisp
(defun ingest-ast (ast &optional parent-id)
(let* ((type (getf ast :type))
(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 (getf ast :raw-content) ""))))
(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-obj (gethash child-id *memory-store*)))
(when child-obj (push (memory-object-hash child-obj) child-hashes))))))
(setf child-ids (nreverse child-ids))
(setf child-hashes (nreverse child-hashes))
(let* ((hash (memory-merkle-hash id type props raw-content child-hashes))
(existing-obj (gethash hash *memory-history*))
(obj (or existing-obj
(make-memory-object
:id id :type type :attributes props :content 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 *memory-history*) obj))
(setf (gethash id *memory-store*) obj)
id)))
#+end_src
** Snapshot History (~*memory-snapshots*~)
A stack of CoW (copy-on-write) snapshots for rollback. When a critical error occurs, the system can roll back to any of the last 20 snapshots. Newer snapshots are prepended (index 0 = most recent).
#+begin_src lisp
(defvar *memory-snapshots* nil)
#+end_src
** Hash Table Copy Utility
Creates a fully independent copy of a hash table. Used by the rollback system to restore saved memory state from a snapshot.
#+begin_src lisp
(defun memory-hash-table-copy (hash-table)
"Creates an independent 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))
#+end_src
** Memory Snapshot (memory-snapshot)
Captures a point-in-time copy of ~*memory-store*~. Each object is deep-copied so the snapshot is independent of ongoing mutations. The snapshot is prepended to the snapshot stack, and the stack is trimmed to 20 entries.
Called automatically before significant memory mutations (buffer updates from Emacs, AST ingestion). Also callable manually.
#+begin_src lisp
(defun snapshot-memory ()
"Creates a CoW snapshot of *memory-store* for rollback recovery."
(let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory-store*))))
(maphash (lambda (k v) (setf (gethash k snapshot) (deep-copy-memory-object v))) *memory-store*)
(push (list :timestamp (get-universal-time) :data snapshot) *memory-snapshots*)
(when (> (length *memory-snapshots*) 20)
(setf *memory-snapshots* (subseq *memory-snapshots* 0 20)))
(harness-log "MEMORY - CoW Memory snapshot created.")))
#+end_src
** Memory Rollback (memory-rollback)
Restores ~*memory-store*~ to a previous snapshot. By default restores the most recent snapshot (index 0). Can specify a specific index to roll back further.
This is the immune system's last resort. When the metabolic loop catches an unhandled error, it calls ~(rollback-memory 0)~ to undo any memory mutations caused by the bad signal.
#+begin_src lisp
(defun rollback-memory (&optional (index 0))
"Restores *memory-store* from a snapshot. INDEX 0 = most recent."
(let ((snapshot (nth index *memory-snapshots*)))
(if snapshot
(progn (setf *memory-store* (memory-hash-table-copy (getf snapshot :data)))
(harness-log "MEMORY - Memory rolled back to snapshot ~a" index))
(harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
#+end_src
** Persistence — Snapshot Path (~*memory-snapshot-path*~)
Configurable path for serialized memory state. Falls back to ~memory.snap~ in the home directory. Can be overridden via ~MEMORY_SNAPSHOT_PATH~ env var.
#+begin_src lisp
(defvar *memory-snapshot-path* nil)
(defun memory-snapshot-path-ensure ()
"Returns the path to the memory snapshot file, resolving env or default."
(or *memory-snapshot-path*
(let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH")))
(setf *memory-snapshot-path*
(or env-path (namestring (uiop:merge-pathnames* "memory.snap" (user-homedir-pathname))))))))
#+end_src
** Save to Disk (memory-save)
Serialises both ~*memory-store*~ and ~*memory-history*~ to a Lisp-readable file. The format is a plist with ~:memory~ and ~:history-store~ keys, each containing an alist of (key . object) pairs.
The serialization uses ~prin1~, which produces human-readable Lisp output. The file can be read with ~read~ on restart.
#+begin_src lisp
(defun save-memory-to-disk ()
"Writes the entire memory and history store to disk as a plist."
(let ((path (memory-snapshot-path-ensure)))
(with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create)
(let ((memory-alist nil) (history-alist nil))
(maphash (lambda (k v) (push (cons k v) memory-alist)) *memory-store*)
(maphash (lambda (k v) (push (cons k v) history-alist)) *memory-history*)
(prin1 (list :memory memory-alist :history-store history-alist) stream)))
(harness-log "MEMORY - Saved to ~a" path)))
#+end_src
** Load from Disk (memory-load)
Restores memory state from a previously saved snapshot file. Called during boot (~main~ in ~loop.org~). If no snapshot file exists, the function returns silently and the agent starts with empty memory.
#+begin_src lisp
(defun load-memory-from-disk ()
"Reads memory state from disk and restores *memory-store* and *memory-history*."
(let ((path (memory-snapshot-path-ensure)))
(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-store* (make-hash-table :test 'equal :size (length memory-alist)))
(dolist (kv memory-alist) (setf (gethash (car kv) *memory-store*) (cdr kv)))
(setf *memory-history* (make-hash-table :test 'equal :size (length history-alist)))
(dolist (kv history-alist) (setf (gethash (car kv) *memory-history*) (cdr kv)))
(harness-log "MEMORY - Loaded from ~a (~a objects)" path (hash-table-size *memory-store*))))))
(error (c) (harness-log "MEMORY WARNING - Failed to load snapshot: ~a" c)))))
t)
#+end_src
* Test Suite
Verifies that the Merkle hash is deterministic and consistent across independent AST ingestions.
#+begin_src lisp :tangle ../lisp/core-memory.lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-memory-tests
(:use :cl :fiveam :passepartout)
(:export #:memory-suite))
(in-package :passepartout-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)))
(clrhash passepartout::*memory-store*)
(let ((id1 (ingest-ast ast1)))
(let ((hash1 (memory-object-hash (memory-object-get id1))))
(clrhash passepartout::*memory-store*)
(let ((id2 (ingest-ast ast1)))
(is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
#+end_src

235
harness/skills.org → org/core-skills.org
View File

@@ -1,35 +1,47 @@
#+TITLE: The Skill Engine (skills.lisp) #+TITLE: The Skill Engine (skills.lisp)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :harness:skills: #+FILETAGS: :org:skills:
#+STARTUP: content #+STARTUP: content
#+PROPERTY: header-args:lisp :tangle skills.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/core-skills.lisp
* Overview * Overview: Architectural Intent
The Skill Engine is the dynamic loading and lifecycle manager for all OpenCortex skills. It discovers skill files in the skills directory, resolves their dependency order, loads them into jailed packages, exports their public symbols into the ~opencortex~ package, and provides the ~defskill~ macro that skills use to register themselves.
Key concepts: The Skill Engine is the dynamic loading and lifecycle manager for all Passepartout skills. It discovers skill files in the skills directory, resolves their dependency order, loads them into jailed packages, and exports their public symbols into the ~passepartout~ package.
- ~defskill~ — macro that registers a skill with its trigger, deterministic gate, and optional probabilistic prompt
- ~def-cognitive-tool~ — macro that registers a tool the LLM can invoke
- ~load-skill-from-org~ / ~load-skill-from-lisp~ — load a skill from a literate Org file or a pre-tangled Lisp file
- ~topological-sort-skills~ — orders skills by their ~#+DEPENDS_ON:~ declarations
- ~find-triggered-skill~ — returns the highest-priority skill whose trigger matches the current context
The engine supports **hot-reload** — skills can be replaced at runtime without restarting the daemon. ** Late-Binding Intelligence
Hardcoding logic into a compiled binary creates a brittle kernel. Every time you add a capability, you must recompile, restart, and re-deploy. Skills solve this by being:
1. **Discovered at boot** — the engine scans a directory for skill files and loads whatever it finds. No registration step needed.
2. **Dependency-ordered** — skills declare dependencies via ~#+DEPENDS_ON:~ headers. The topological sort ensures they load in the right order.
3. **Hot-reloadable** — a skill can be replaced at runtime without restarting the daemon. The new version is compiled into a fresh jail package and swapped in.
4. **Self-documenting** — each skill is a single Org file containing prose, code, metadata, and tests. The "Why" and the "How" are unified.
** The Jailed Package Model
Every skill loads into its own package (e.g., ~PASSEPARTOUT.SKILLS.ORG-SKILL-BOUNCER~). This prevents name conflicts between skills — two skills can define a function called ~process~ without collision, because each lives in its own namespace.
After loading, the engine exports the skill's public symbols into the ~passepartout~ package, making them available to other skills and the org. The export filter uses the skill's short name as a prefix — for example, the BOUNCER skill exports only symbols starting with ~BOUNCER-~.
This is how the "thin org, fat skills" principle works in practice: the org provides the loading infrastructure; the skills provide all the intelligence.
* Implementation * Implementation
** Package Context ** Package Context
#+begin_src lisp #+begin_src lisp
(in-package :opencortex) (in-package :passepartout)
#+end_src #+end_src
** Utility functions ** Utility functions
Helper functions used by the skill loader and other components. Helper functions used by the skill loader and other components.
*** Cosine similarity *** Cosine similarity
Computes the cosine similarity between two numeric vectors. Used by the peripheral vision system for semantic relevance scoring.
Computes the cosine similarity between two numeric vectors. Used by the peripheral vision system for semantic relevance scoring — if the agent's current focus has a vector embedding, objects with similar embeddings get promoted to foveal detail.
#+begin_src lisp #+begin_src lisp
(defun COSINE-SIMILARITY (v1 v2) (defun vector-cosine-similarity (v1 v2)
"Computes cosine similarity between two vectors." "Computes cosine similarity between two vectors."
(let* ((len1 (length v1)) (len2 (length v2))) (let* ((len1 (length v1)) (len2 (length v2)))
(if (or (zerop len1) (zerop len2)) (if (or (zerop len1) (zerop len2))
@@ -42,20 +54,24 @@ Computes the cosine similarity between two numeric vectors. Used by the peripher
#+end_src #+end_src
*** Secret masking *** Secret masking
Simple mask function and the vault memory hash table. Used by the Bouncer skill and credentials vault.
Simple mask function and the vault memory hash table. Used by the Bouncer skill and credentials vault to prevent secrets from appearing in logs.
#+begin_src lisp #+begin_src lisp
(defun VAULT-MASK-STRING (s) (declare (ignore s)) "[MASKED]") (defun VAULT-MASK-STRING (s) (declare (ignore s)) "[MASKED]")
(defvar *VAULT-MEMORY* (make-hash-table :test 'equal)) (defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
#+end_src #+end_src
** Skill data structures ** Skill data structures
The ~skill~ struct holds all metadata about a loaded skill: its name, priority, dependencies, trigger function, probabilistic prompt generator, deterministic gate, and system prompt augmentor. The ~skill-entry~ struct tracks the loading state of each discovered skill file. The ~skill~ struct holds all metadata about a loaded skill: its name, priority, dependencies, trigger function, probabilistic prompt generator, deterministic gate, and system prompt augmentor. The ~skill-entry~ struct tracks the loading state of each discovered skill file.
#+begin_src lisp #+begin_src lisp
(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn system-prompt-augment) (defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn system-prompt-augment)
#+end_src #+end_src
#+begin_src lisp #+begin_src lisp
(defvar *skills-registry* (make-hash-table :test 'equal)) (defvar *skill-registry* (make-hash-table :test 'equal))
#+end_src #+end_src
#+begin_src lisp #+begin_src lisp
@@ -67,10 +83,14 @@ The ~skill~ struct holds all metadata about a loaded skill: its name, priority,
(defstruct skill-entry filename (status :discovered) error-log (load-time 0)) (defstruct skill-entry filename (status :discovered) error-log (load-time 0))
#+end_src #+end_src
** Skill discovery (find-triggered-skill) ** Skill discovery (skill-triggered-find)
Iterates the registry and returns the highest-priority skill whose trigger function matches the current context. Only skills with a probabilistic prompt are considered (skills that are purely deterministic don't need LLM intervention).
Iterates the registry and returns the highest-priority skill whose trigger function matches the current context. Only skills with a probabilistic prompt are considered (purely deterministic skills don't need LLM attention).
This is how the system determines which skill "owns" the current user input. For example, if the REPL skill's trigger matches the input, the REPL skill provides the prompt template that shapes how the LLM responds.
#+begin_src lisp #+begin_src lisp
(defun find-triggered-skill (context) (defun skill-triggered-find (context)
"Returns the highest priority skill whose trigger matches context." "Returns the highest priority skill whose trigger matches context."
(let ((triggered nil)) (let ((triggered nil))
(maphash (lambda (name skill) (maphash (lambda (name skill)
@@ -78,16 +98,20 @@ Iterates the registry and returns the highest-priority skill whose trigger funct
(when (and (skill-probabilistic-prompt skill) (when (and (skill-probabilistic-prompt skill)
(ignore-errors (funcall (skill-trigger-fn skill) context))) (ignore-errors (funcall (skill-trigger-fn skill) context)))
(push skill triggered))) (push skill triggered)))
*skills-registry*) *skill-registry*)
(first (sort triggered #'> :key #'skill-priority)))) (first (sort triggered #'> :key #'skill-priority))))
#+end_src #+end_src
** Skill registration macro (defskill) ** Skill registration macro (defskill)
The primary API for skills. Each skill file calls this once to register itself. The macro creates a ~skill~ struct and stores it in ~*skills-registry*~ keyed by the skill's name.
The primary API for skills. Each skill file calls this once to register itself. The macro creates a ~skill~ struct and stores it in ~*skill-registry*~ keyed by the skill's name.
The ~:system-prompt-augment~ slot is optional. If provided, it's a function that receives the context and returns a string to append to the LLM's system prompt. This allows skills to inject domain-specific instructions into every reasoning cycle.
#+begin_src lisp #+begin_src lisp
(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic system-prompt-augment) (defmacro defskill (name &key priority dependencies trigger probabilistic deterministic system-prompt-augment)
"Registers a new skill. NAME is a keyword. TRIGGER is a function (context) → bool." "Registers a new skill. NAME is a keyword. TRIGGER is a function (context) → bool."
`(setf (gethash (string-downcase (string ,name)) *skills-registry*) `(setf (gethash (string-downcase (string ,name)) *skill-registry*)
(make-skill :name (string-downcase (string ,name)) (make-skill :name (string-downcase (string ,name))
:priority (or ,priority 10) :priority (or ,priority 10)
:dependencies ',dependencies :dependencies ',dependencies
@@ -97,16 +121,18 @@ The primary API for skills. Each skill file calls this once to register itself.
:system-prompt-augment ,system-prompt-augment))) :system-prompt-augment ,system-prompt-augment)))
#+end_src #+end_src
** Dependency resolution (resolve-skill-dependencies) ** Dependency resolution (skill-dependencies-resolve)
Recursively resolves all transitive dependencies for a given skill, returning an ordered list. Uses a standard topological sort with cycle detection (a ~seen~ set prevents infinite recursion).
Recursively resolves all transitive dependencies for a given skill, returning an ordered list. Uses a standard graph traversal with a ~seen~ set to prevent infinite recursion from circular dependencies.
#+begin_src lisp #+begin_src lisp
(defun resolve-skill-dependencies (skill-name) (defun skill-dependencies-resolve (skill-name)
"Resolves transitive dependencies. Returns list of skill names in dependency order." "Resolves transitive dependencies. Returns list of skill names in dependency order."
(let ((resolved nil) (seen nil)) (let ((resolved nil) (seen nil))
(labels ((visit (name) (labels ((visit (name)
(unless (member name seen :test #'equal) (unless (member name seen :test #'equal)
(push name seen) (push name seen)
(let ((skill (gethash (string-downcase (string name)) *skills-registry*))) (let ((skill (gethash (string-downcase (string name)) *skill-registry*)))
(when skill (when skill
(dolist (dep (skill-dependencies skill)) (visit dep)))) (dolist (dep (skill-dependencies skill)) (visit dep))))
(push name resolved)))) (push name resolved))))
@@ -114,9 +140,12 @@ Recursively resolves all transitive dependencies for a given skill, returning an
(nreverse resolved)))) (nreverse resolved))))
#+end_src #+end_src
** Skill File Analysis (parse-skill-metadata) ** Skill File Analysis (skill-metadata-parse)
Extracts the ~:ID~ and ~#+DEPENDS_ON:~ declarations from a skill's Org file. Used by the topological sorter to order skills correctly.
#+begin_src lisp #+begin_src lisp
(defun parse-skill-metadata (filepath) (defun skill-metadata-parse (filepath)
"Extracts ID and DEPENDS_ON tags from org file." "Extracts ID and DEPENDS_ON tags from org file."
(let ((dependencies nil) (id nil) (content (uiop:read-file-string filepath))) (let ((dependencies nil) (id nil) (content (uiop:read-file-string filepath)))
(let ((id-start (search ":ID:" content))) (let ((id-start (search ":ID:" content)))
@@ -134,13 +163,31 @@ Recursively resolves all transitive dependencies for a given skill, returning an
(values id (reverse dependencies)))) (values id (reverse dependencies))))
#+end_src #+end_src
** Dependency Resolution (topological-sort-skills) ** Dependency Resolution (skill-topological-sort)
Returns a list of skill filepaths sorted by dependency order. Uses Kahn's algorithm: collect all files, build an adjacency graph from ~#+DEPENDS_ON:~ declarations, and topologically sort them. Skills with no dependencies are sorted alphabetically.
Both ~.org~ and ~.lisp~ files are included. For each skill, the ~.org~ file supplies the dependency metadata; if a ~.lisp~ file exists, it's loaded instead of tangling from the ~.org~ at load time.
#+begin_src lisp #+begin_src lisp
(defun topological-sort-skills (skills-dir) (defun skill-topological-sort (skills-dir)
"Returns a list of skill filepaths sorted by dependency." "Returns a list of skill filepaths sorted by dependency."
(let* ((org-files (uiop:directory-files skills-dir "org-skill-*.org")) (let* ((org-files (uiop:directory-files skills-dir "*.org"))
(lisp-files (uiop:directory-files skills-dir "org-skill-*.lisp")) (lisp-files (uiop:directory-files skills-dir "*.lisp"))
(files (append org-files lisp-files)) (all-files (append org-files lisp-files))
(files (remove-if (lambda (f)
(let ((n (pathname-name f)))
(or (string= n "core-defpackage")
(string= n "core-skills")
(string= n "core-communication")
(string= n "core-memory")
(string= n "core-context")
(string= n "core-loop-perceive")
(string= n "core-loop-reason")
(string= n "core-loop-act")
(string= n "core-loop")
(string= n "core-manifest"))))
all-files))
(adj (make-hash-table :test 'equal)) (adj (make-hash-table :test 'equal))
(name-to-file (make-hash-table :test 'equal)) (name-to-file (make-hash-table :test 'equal))
(id-to-file (make-hash-table :test 'equal)) (id-to-file (make-hash-table :test 'equal))
@@ -152,10 +199,9 @@ Recursively resolves all transitive dependencies for a given skill, returning an
(if (uiop:string-suffix-p (namestring file) ".lisp") (if (uiop:string-suffix-p (namestring file) ".lisp")
(progn (progn
(setf (gethash (string-downcase filename) name-to-file) file) (setf (gethash (string-downcase filename) name-to-file) file)
;; Don't overwrite dependency info from .org files
(unless (gethash (string-downcase filename) adj) (unless (gethash (string-downcase filename) adj)
(setf (gethash (string-downcase filename) adj) nil))) (setf (gethash (string-downcase filename) adj) nil)))
(multiple-value-bind (id deps) (parse-skill-metadata file) (multiple-value-bind (id deps) (skill-metadata-parse file)
(setf (gethash (string-downcase filename) name-to-file) file) (setf (gethash (string-downcase filename) name-to-file) file)
(when id (setf (gethash (string-downcase id) id-to-file) file)) (when id (setf (gethash (string-downcase id) id-to-file) file))
(setf (gethash (string-downcase filename) adj) deps))))) (setf (gethash (string-downcase filename) adj) deps)))))
@@ -186,9 +232,20 @@ Recursively resolves all transitive dependencies for a given skill, returning an
(nreverse result)))) (nreverse result))))
#+end_src #+end_src
** Jailed Loading (load-skill-from-org) ** Jailed Loading (skill-load-from-org)
The primary skill loader. Given a path to an ~.org~ file:
1. Reads the Org file and collects all ~#+begin_src lisp~ blocks (excluding test blocks and blocks with ~:tangle no~)
2. Validates the Lisp syntax before loading
3. Creates a jailed package named after the skill (e.g., ~PASSEPARTOUT.SKILLS.ORG-SKILL-BOUNCER~) with ~:use :passepartout~
4. Evaluates the collected Lisp forms in that package
5. Scans the package for symbols matching the skill's name prefix and exports them to the ~passepartout~ package
The validation step is critical: invalid Lisp in an org block would crash the loader. The validator uses ~read~ with ~*read-eval*~ bound to nil to safely detect syntax errors without evaluating.
#+begin_src lisp #+begin_src lisp
(defun validate-lisp-syntax (code-string) (defun lisp-syntax-validate (code-string)
"Checks if a string contains valid Common Lisp forms." "Checks if a string contains valid Common Lisp forms."
(handler-case (handler-case
(let ((*read-eval* nil)) (let ((*read-eval* nil))
@@ -197,7 +254,7 @@ Recursively resolves all transitive dependencies for a given skill, returning an
(values t nil)) (values t nil))
(error (c) (values nil (format nil "~a" c))))) (error (c) (values nil (format nil "~a" c)))))
(defun remove-in-package-forms (code-string) (defun skill-package-forms-strip (code-string)
"Removes in-package forms so symbols get defined in skill package." "Removes in-package forms so symbols get defined in skill package."
(let ((lines (uiop:split-string code-string :separator '(#\Newline))) (let ((lines (uiop:split-string code-string :separator '(#\Newline)))
(result "")) (result ""))
@@ -207,11 +264,11 @@ Recursively resolves all transitive dependencies for a given skill, returning an
(setf result (concatenate 'string result line (string #\Newline)))))) (setf result (concatenate 'string result line (string #\Newline))))))
result)) result))
(defun extract-tangle-target (line) (defun tangle-target-extract (line)
"Extracts the value of the :tangle header." "Extracts the value of the :tangle header."
(let ((pos (search ":tangle" line))) (let ((pos (search ":tangle" line)))
(when pos (when pos
(let ((rest (string-trim '(#\Space #\Tab) (subseq line (+ pos 7))))) (let ((rest (string-tirm '(#\Space #\Tab) (subseq line (+ pos 7)))))
(let ((end (position #\Space rest))) (let ((end (position #\Space rest)))
(if end (subseq rest 0 end) rest)))))) (if end (subseq rest 0 end) rest))))))
@@ -224,15 +281,13 @@ Recursively resolves all transitive dependencies for a given skill, returning an
(let* ((content (uiop:read-file-string filepath)) (let* ((content (uiop:read-file-string filepath))
(lines (uiop:split-string content :separator '(#\Newline))) (lines (uiop:split-string content :separator '(#\Newline)))
(in-lisp-block nil) (collect-this-block nil) (lisp-code "") (in-lisp-block nil) (collect-this-block nil) (lisp-code "")
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword))) (pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
(dolist (line lines) (dolist (line lines)
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line))) (let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
(cond (cond
((uiop:string-prefix-p "#+begin_src lisp" clean-line) ((uiop:string-prefix-p "#+begin_src lisp" clean-line)
(setf in-lisp-block t) (setf in-lisp-block t)
(let ((target (extract-tangle-target clean-line))) (let ((target (tangle-target-extract clean-line)))
;; Collect if there's no tangle target (inherits from file)
;; or if it's a lisp file and NOT a test.
(setf collect-this-block (or (null target) (setf collect-this-block (or (null target)
(and (not (search "no" target)) (and (not (search "no" target))
(not (search "/tests" target))))))) (not (search "/tests" target)))))))
@@ -240,36 +295,35 @@ Recursively resolves all transitive dependencies for a given skill, returning an
(setf in-lisp-block nil) (setf collect-this-block nil)) (setf in-lisp-block nil) (setf collect-this-block nil))
((and in-lisp-block collect-this-block) ((and in-lisp-block collect-this-block)
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line)) (unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
(uiop:string-prefix-p ":END:" (string-upcase clean-line)) (uiop:string-prefix-p ":END:" (string-upcase clean-line))
(uiop:string-prefix-p ":ID:" (string-upcase clean-line))) (uiop:string-prefix-p ":ID:" (string-upcase clean-line)))
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline)))))))) (setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
(if (= (length lisp-code) 0) (if (= (length lisp-code) 0)
(setf (skill-entry-status entry) :ready) (setf (skill-entry-status entry) :ready)
(progn (progn
(multiple-value-bind (valid-p err) (validate-lisp-syntax lisp-code) (multiple-value-bind (valid-p err) (lisp-syntax-validate lisp-code)
(unless valid-p (error err))) (unless valid-p (error err)))
(unless (find-package pkg-name) (unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :opencortex new-pkg))) (let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
(let ((*read-eval* nil) (*package* (find-package pkg-name))) (let ((*read-eval* nil) (*package* (find-package pkg-name)))
(harness-log "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*)) (log-message "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*))
(eval (read-from-string (format nil "(progn ~a)" lisp-code)))) (eval (read-from-string (format nil "(progn ~a)" lisp-code))))
;; Export symbols back to :OPENCORTEX for discoverability and testing (let* ((target-pkg (find-package :passepartout))
(let* ((target-pkg (find-package :opencortex))
(raw-name (string-upcase skill-base-name)) (raw-name (string-upcase skill-base-name))
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name) (short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
(subseq raw-name 10) (subseq raw-name 10)
raw-name))) raw-name)))
(harness-log "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name))) (log-message "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
(do-symbols (sym (find-package pkg-name)) (do-symbols (sym (find-package pkg-name))
(when (eq (symbol-package sym) (find-package pkg-name)) (when (eq (symbol-package sym) (find-package pkg-name))
(let ((sn (symbol-name sym))) (let ((sn (symbol-name sym)))
(when (or (uiop:string-prefix-p raw-name sn) (when (or (uiop:string-prefix-p raw-name sn)
(uiop:string-prefix-p short-name sn) (uiop:string-prefix-p short-name sn)
(string-equal sn "DOCTOR-MAIN") (string-equal sn "DIAGNOSTICS-MAIN")
(string-equal sn "RUN-SETUP-WIZARD")) (string-equal sn "DIAGNOSTICS-RUN-ALL")
(harness-log "LOADER: Exporting ~a to :OPENCORTEX" sn) (string-equal sn "SETUP-WIZARD-RUN"))
;; Resolve potential name conflicts by uninterning first (log-message "LOADER: Exporting ~a to :PASSEPARTOUT" sn)
(let ((existing (find-symbol sn target-pkg))) (let ((existing (find-symbol sn target-pkg)))
(when (and existing (not (eq existing sym))) (when (and existing (not (eq existing sym)))
(unintern existing target-pkg))) (unintern existing target-pkg)))
@@ -279,43 +333,50 @@ Recursively resolves all transitive dependencies for a given skill, returning an
(setf (skill-entry-status entry) :ready))) (setf (skill-entry-status entry) :ready)))
t) t)
(error (c) (error (c)
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name c) (log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
(setf (skill-entry-status entry) :failed) nil)))) (setf (skill-entry-status entry) :failed) nil))))
#+end_src
** Loading from Pre-Tangled Lisp (skill-load-from-lisp)
Loads a pre-tangled ~.lisp~ file directly, without parsing the Org source. This is faster than ~load-skill-from-org~ because it skips the block extraction and syntax validation (the Lisp was already validated when tangled).
The same jailed package and symbol export process applies.
#+begin_src lisp
(defun load-skill-from-lisp (filepath) (defun load-skill-from-lisp (filepath)
"Loads a .lisp skill file directly, filtering out in-package forms." "Loads a .lisp skill file directly, filtering out in-package forms."
(let* ((skill-base-name (pathname-name filepath)) (let* ((skill-base-name (pathname-name filepath))
(entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))) (entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
(setf (skill-entry-status entry) :loading) (setf (skill-entry-status entry) :loading)
(handler-case (handler-case
(let* ((content (remove-in-package-forms (uiop:read-file-string filepath))) (let* ((content (skill-package-forms-strip (uiop:read-file-string filepath)))
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword))) (pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
(multiple-value-bind (valid-p err) (validate-lisp-syntax content) (multiple-value-bind (valid-p err) (lisp-syntax-validate content)
(unless valid-p (error err))) (unless valid-p (error err)))
(unless (find-package pkg-name) (unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :opencortex new-pkg))) (let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
(let ((*read-eval* nil) (*package* (find-package pkg-name))) (let ((*read-eval* nil) (*package* (find-package pkg-name)))
(harness-log "LOADER: Loading .lisp skill '~a' in package ~a" skill-base-name (package-name *package*)) (log-message "LOADER: Loading .lisp skill '~a' in package ~a" skill-base-name (package-name *package*))
;; Evaluate forms individually so one bad form doesn't abort the entire skill
(with-input-from-string (s content) (with-input-from-string (s content)
(loop for form = (read s nil :eof) until (eq form :eof) (loop for form = (read s nil :eof) until (eq form :eof)
do (handler-case (eval form) do (handler-case (eval form)
(error (c) (harness-log "LOADER WARNING in '~a': ~a" skill-base-name c)))))) (error (c) (log-message "LOADER WARNING in '~a': ~a" skill-base-name c))))))
;; Export symbols (let* ((target-pkg (find-package :passepartout))
(let* ((target-pkg (find-package :opencortex))
(raw-name (string-upcase skill-base-name)) (raw-name (string-upcase skill-base-name))
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name) (short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
(subseq raw-name 10) (subseq raw-name 10)
raw-name))) raw-name)))
(harness-log "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name))) (log-message "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
(do-symbols (sym (find-package pkg-name)) (do-symbols (sym (find-package pkg-name))
(when (eq (symbol-package sym) (find-package pkg-name)) (when (eq (symbol-package sym) (find-package pkg-name))
(let ((sn (symbol-name sym))) (let ((sn (symbol-name sym)))
(when (or (uiop:string-prefix-p raw-name sn) (when (or (uiop:string-prefix-p raw-name sn)
(uiop:string-prefix-p short-name sn) (uiop:string-prefix-p short-name sn)
(string-equal sn "DOCTOR-MAIN") (string-equal sn "DIAGNOSTICS-MAIN")
(string-equal sn "RUN-SETUP-WIZARD")) (string-equal sn "DIAGNOSTICS-RUN-ALL")
(harness-log "LOADER: Exporting ~a to :OPENCORTEX" sn) (string-equal sn "SETUP-WIZARD-RUN"))
(log-message "LOADER: Exporting ~a to :PASSEPARTOUT" sn)
(let ((existing (find-symbol sn target-pkg))) (let ((existing (find-symbol sn target-pkg)))
(when (and existing (not (eq existing sym))) (when (and existing (not (eq existing sym)))
(unintern existing target-pkg))) (unintern existing target-pkg)))
@@ -323,49 +384,55 @@ Recursively resolves all transitive dependencies for a given skill, returning an
(export sym target-pkg)))))) (export sym target-pkg))))))
(setf (skill-entry-status entry) :ready)) (setf (skill-entry-status entry) :ready))
(error (c) (error (c)
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name c) (log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
(setf (skill-entry-status entry) :failed) nil)))) (setf (skill-entry-status entry) :failed) nil))))
#+end_src #+end_src
** Initialize (initialize-all-skills) ** Initialize (skill-initialize-all)
Boot-time entry point. Scans the skills directory, topologically sorts the files, and loads each one. Called from ~main~ in the metabolic loop and from the REPL for hot-reload.
The skills directory is ~$OC_DATA_DIR/skills~ by default, which is populated by the ~configure~ script.
#+begin_src lisp #+begin_src lisp
(defun initialize-all-skills () (defun skill-initialize-all ()
"Initializes all skills from the XDG skills directory." "Initializes all skills from the XDG skills directory."
(let* ((data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "OC_DATA_DIR") (namestring (merge-pathnames ".local/share/opencortex/" (user-homedir-pathname)))))) (let* ((data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
(skills-dir (merge-pathnames "skills/" data-dir))) (skills-dir (merge-pathnames "skills/" (uiop:ensure-directory-pathname data-dir))))
(unless (uiop:directory-exists-p skills-dir) (return-from initialize-all-skills nil)) (unless (uiop:directory-exists-p skills-dir) (return-from skill-initialize-all nil))
(let ((sorted-files (topological-sort-skills skills-dir))) (let ((sorted-files (skill-topological-sort skills-dir)))
(harness-log "LOADER: Initializing ~a skills..." (length sorted-files)) (log-message "LOADER: Initializing ~a skills..." (length sorted-files))
(dolist (file sorted-files) (dolist (file sorted-files)
(if (uiop:string-suffix-p (namestring file) ".lisp") (if (uiop:string-suffix-p (namestring file) ".lisp")
(load-skill-from-lisp file) (load-skill-from-lisp file)
(load-skill-from-org file))) (load-skill-from-org file)))
(harness-log "LOADER: Boot Complete.")))) (log-message "LOADER: Boot Complete."))))
#+end_src #+end_src
* Test Suite * Test Suite
Verifies that the topological sorter correctly orders skills by their ~#+DEPENDS_ON:~ declarations.
#+begin_src lisp :tangle ../tests/boot-sequence-tests.lisp #+begin_src lisp :tangle ../tests/boot-sequence-tests.lisp
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (ql:quickload :fiveam :silent t))
(defpackage :opencortex-boot-tests (defpackage :passepartout-boot-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :passepartout)
(:export #:boot-suite)) (:export #:boot-suite))
(in-package :opencortex-boot-tests) (in-package :passepartout-boot-tests)
(def-suite boot-suite :description "Verification of the Skill Engine loader") (def-suite boot-suite :description "Verification of the Skill Engine loader")
(in-suite boot-suite) (in-suite boot-suite)
(test test-topological-sort-basic (test test-topological-sort-basic
(let ((tmp-dir "/tmp/opencortex-boot-test/")) (let ((tmp-dir "/tmp/passepartout-boot-test/"))
(uiop:ensure-all-directories-exist (list tmp-dir)) (uiop:ensure-all-directories-exist (list tmp-dir))
(with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede) (with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
(format out "#+DEPENDS_ON: skill-b-id~%")) (format out "#+DEPENDS_ON: skill-b-id~%"))
(with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede) (with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede)
(format out ":PROPERTIES:~%:ID: skill-b-id~%:END:~%")) (format out ":PROPERTIES:~%:ID: skill-b-id~%:END:~%"))
(unwind-protect (unwind-protect
(let ((sorted (opencortex::topological-sort-skills tmp-dir))) (let ((sorted (passepartout::skill-topological-sort tmp-dir)))
(let ((pos-a (position "org-skill-a" sorted :key #'pathname-name :test #'string-equal)) (let ((pos-a (position "org-skill-a" sorted :key #'pathname-name :test #'string-equal))
(pos-b (position "org-skill-b" sorted :key #'pathname-name :test #'string-equal))) (pos-b (position "org-skill-b" sorted :key #'pathname-name :test #'string-equal)))
(is (< pos-b pos-a)))) (is (< pos-b pos-a))))

8
skills/org-skill-cli-gateway.org → org/gateway-cli.org
View File

@@ -1,16 +1,16 @@
#+TITLE: SKILL: CLI Gateway (org-skill-cli-gateway.org) #+TITLE: SKILL: CLI Gateway (org-skill-cli-gateway.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :skill:gateway:cli: #+FILETAGS: :skill:gateway:cli:
#+PROPERTY: header-args:lisp :tangle org-skill-cli-gateway.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/gateway-cli.lisp
* Overview * Overview
The *CLI Gateway* provides a command-line interface for interacting with the OpenCortex daemon. The CLI Gateway is the simplest interface to Passepartout — raw stdin/stdout over TCP. It connects to the daemon's framed protocol and translates between terminal input/output and the plist-based communication format. No TUI, no ncurses, no dependencies beyond a TCP socket. Every other gateway (TUI, Emacs, Telegram) builds on this same protocol.
* Implementation * Implementation
** CLI Command Handling ** CLI Command Handling
#+begin_src lisp #+begin_src lisp
(defun cli-process-input (text) (defun gateway-cli-input (text)
"Processes raw text from the command line." "Processes raw text from the command line."
(inject-stimulus (list :type :EVENT (inject-stimulus (list :type :EVENT
:payload (list :sensor :user-input :text text) :payload (list :sensor :user-input :text text)
@@ -19,7 +19,7 @@ The *CLI Gateway* provides a command-line interface for interacting with the Ope
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-cli-gateway (defskill :passepartout-gateway-cli
:priority 100 :priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI)) :trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
:deterministic (lambda (action ctx) (declare (ignore ctx)) action)) :deterministic (lambda (action ctx) (declare (ignore ctx)) action))

20
skills/org-skill-llm-gateway.org → org/gateway-llm.org
View File

@@ -1,16 +1,16 @@
#+TITLE: SKILL: LLM Gateway (org-skill-llm-gateway.org) #+TITLE: SKILL: LLM Gateway (org-skill-llm-gateway.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :skill:llm:gateway: #+FILETAGS: :skill:llm:gateway:
#+PROPERTY: header-args:lisp :tangle org-skill-llm-gateway.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/gateway-llm.lisp
* Overview * Overview
The LLM Gateway dispatches inference requests to the registered probabilistic backends. It receives a prompt and system prompt, looks up the provider's registered function from ~*probabilistic-backends*~, calls it with the given model, and returns the result. This is the thin routing layer that sits between the reason pipeline and the provider-specific implementations in the unified-llm-backend skill. The LLM Gateway dispatches inference requests to the registered probabilistic backends. It receives a prompt and system prompt, looks up the provider's registered function from ~*probabilistic-backends*~, calls it with the given model, and returns the result. This is the thin routing layer that sits between the reason pipeline and the provider-specific implementations in the unified-llm-backend skill.
* Implementation * Implementation
** Request Execution (execute-llm-request) ** Request Execution (gateway-llm-request)
#+begin_src lisp #+begin_src lisp
(defun execute-llm-request (&key prompt system-prompt (provider :ollama) model) (defun gateway-llm-request (&key prompt system-prompt (provider :ollama) model)
"Central dispatcher for LLM requests." "Central dispatcher for LLM requests."
(let ((backend (gethash provider *probabilistic-backends*))) (let ((backend (gethash provider *probabilistic-backends*)))
(if backend (if backend
@@ -23,22 +23,22 @@ The LLM Gateway dispatches inference requests to the registered probabilistic ba
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-llm-gateway (defskill :passepartout-gateway-llm
:priority 100 :priority 100
:trigger (lambda (ctx) (getf ctx :user-input)) :trigger (lambda (ctx) (getf ctx :user-input))
:deterministic (lambda (action ctx) (declare (ignore ctx)) action)) :deterministic (lambda (action ctx) (declare (ignore ctx)) action))
#+end_src #+end_src
* Test Suite * Test Suite
#+begin_src lisp :tangle ../tests/llm-gateway-tests.lisp #+begin_src lisp :tangle ../lisp/gateway-llm.lisp
(eval-when (:compile-toplevel :load-toplevel :execute) (eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)) (ql:quickload :fiveam :silent t))
(defpackage :opencortex-llm-gateway-tests (defpackage :passepartout-llm-gateway-tests
(:use :cl :opencortex) (:use :cl :passepartout)
(:export #:llm-gateway-suite)) (:export #:llm-gateway-suite))
(in-package :opencortex-llm-gateway-tests) (in-package :passepartout-llm-gateway-tests)
(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM Gateway skill") (fiveam:def-suite llm-gateway-suite :description "Tests for the LLM Gateway skill")
(fiveam:in-suite llm-gateway-suite) (fiveam:in-suite llm-gateway-suite)
@@ -49,8 +49,8 @@ The LLM Gateway dispatches inference requests to the registered probabilistic ba
(unwind-protect (unwind-protect
(progn (progn
(setf (uiop:getenv "OLLAMA_HOST") "localhost:1") (setf (uiop:getenv "OLLAMA_HOST") "localhost:1")
(let ((fn (or (find-symbol "EXECUTE-LLM-REQUEST" :opencortex.skills.org-skill-llm-gateway) (let ((fn (or (find-symbol "EXECUTE-LLM-REQUEST" :passepartout.gateway-llm)
(find-symbol "EXECUTE-LLM-REQUEST" :opencortex)))) (find-symbol "EXECUTE-LLM-REQUEST" :passepartout))))
(if fn (if fn
(let ((result (funcall fn :prompt "hello" :provider :ollama))) (let ((result (funcall fn :prompt "hello" :provider :ollama)))
(fiveam:is (eq (getf result :status) :error)) (fiveam:is (eq (getf result :status) :error))

28
skills/org-skill-gateway-manager.org → org/gateway-manager.org
View File

@@ -1,10 +1,18 @@
#+TITLE: SKILL: Gateway Manager (org-skill-gateway-manager.org) #+TITLE: SKILL: Gateway Manager (org-skill-gateway-manager.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :skill:gateway:manager: #+FILETAGS: :skill:gateway:manager:
#+PROPERTY: header-args:lisp :tangle org-skill-gateway-manager.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/gateway-manager.lisp
* Overview * Architectural Intent
The *Gateway Manager* is a unified skill that handles all external communication platforms (Telegram, Signal, etc.). It provides a single consolidated handler for polling, injection, and actuation across any number of gateways.
The Gateway Manager is the unified interface for all external messaging platforms. It handles Telegram, Signal, and any future gateway through a common pattern: a registry of poll/send function pairs, a configuration hash table for tokens and intervals, and a background thread per gateway that polls for new messages.
Each gateway follows the same lifecycle:
1. **Register** — the gateway's poll and send functions are registered in ~*gateway-registry*~
2. **Link** — the user provides a token; it's stored in the vault and a polling thread is started
3. **Poll** — the thread calls the poll function on an interval, injecting received messages into the pipeline
4. **Unlink** — the thread is destroyed, the config is removed
5. **Act** — when the agent needs to send a message, it dispatches to the gateway's send function via the generic actuator mechanism
* Implementation * Implementation
@@ -118,7 +126,7 @@ Registration of available gateway implementations: each platform registers its p
** Gateway Registry Initialization ** Gateway Registry Initialization
#+begin_src lisp #+begin_src lisp
(defun initialize-gateway-registry () (defun gateway-registry-initialize ()
"Registers all built-in gateway handlers." "Registers all built-in gateway handlers."
(setf (gethash "telegram" *gateway-registry*) (setf (gethash "telegram" *gateway-registry*)
(list :poll-fn #'telegram-poll (list :poll-fn #'telegram-poll
@@ -207,7 +215,7 @@ Creates a background thread that calls the platform's poll function on an interv
(when (getf (gethash platform-lc *gateway-configs*) :enabled) (when (getf (gethash platform-lc *gateway-configs*) :enabled)
(funcall poll-fn)) (funcall poll-fn))
(sleep interval))) (sleep interval)))
:name (format nil "opencortex-~a-gateway" platform-lc))) :name (format nil "passepartout-~a-gateway" platform-lc)))
(harness-log "GATEWAY: Started ~a polling (interval: ~as)" platform-lc interval))))))))) (harness-log "GATEWAY: Started ~a polling (interval: ~as)" platform-lc interval)))))))))
#+end_src #+end_src
@@ -256,10 +264,10 @@ Formats ~gateway-list~ for display in the CLI.
(format t "~%")) (format t "~%"))
#+end_src #+end_src
*** Start all configured gateways (start-all-gateways) *** Start all configured gateways (gateway-start-all)
Called during boot to start all gateways that have tokens stored in their configs. Called during boot to start all gateways that have tokens stored in their configs.
#+begin_src lisp #+begin_src lisp
(defun start-all-gateways () (defun gateway-start-all ()
"Called at boot to start all configured gateways." "Called at boot to start all configured gateways."
(dolist (config (loop for platform being the hash-keys of *gateway-configs* (dolist (config (loop for platform being the hash-keys of *gateway-configs*
collect (list platform (gethash platform *gateway-configs*)))) collect (list platform (gethash platform *gateway-configs*))))
@@ -277,7 +285,7 @@ Register :telegram and :signal as actuators for outbound messages.
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-gateway-manager (defskill :passepartout-gateway-manager
:priority 150 :priority 150
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src #+end_src
@@ -285,6 +293,6 @@ Register :telegram and :signal as actuators for outbound messages.
** Initialization ** Initialization
Initialize registry and start configured gateways on skill load. Initialize registry and start configured gateways on skill load.
#+begin_src lisp #+begin_src lisp
(initialize-gateway-registry) (gateway-registry-initialize)
(start-all-gateways) (gateway-start-all)
#+end_src #+end_src

55
skills/org-skill-unified-llm-backend.org → org/gateway-provider.org
View File

@@ -1,36 +1,41 @@
#+TITLE: SKILL: Unified LLM Backend (org-skill-unified-llm-backend.org) #+TITLE: SKILL: Unified LLM Backend (org-skill-unified-llm-backend.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :skill:llm:backend:openai-compatible: #+FILETAGS: :skill:llm:backend:openai-compatible:
#+PROPERTY: header-args:lisp :tangle org-skill-unified-llm-backend.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/gateway-provider.lisp
* Overview * Architectural Intent
The *Unified LLM Backend* provides a single OpenAI-compatible API client that works with:
- Local engines: Ollama, vLLM, LM Studio, llama.cpp (anything exposing /v1/chat/completions) The Unified LLM Backend provides a single OpenAI-compatible API client that works with any provider supporting the ~/v1/chat/completions~ endpoint. This covers local engines (Ollama, vLLM, LM Studio, llama.cpp) and cloud providers (OpenRouter, OpenAI, Anthropic, Groq, Gemini, DeepSeek, NVIDIA NIM).
- Cloud providers: OpenRouter, OpenAI, Anthropic, Groq, Gemini (all OpenAI-compatible)
The key design decision: **one client, many configurations**. Instead of having separate skills for each provider (org-skill-ollama, org-skill-openai, etc.), this single skill holds a configuration table mapping provider keywords to their base URL, API key env var, and default model. The same ~provider-openai-request~ function works for all of them.
Providers are registered automatically at boot based on which API keys are set in the environment. If OPENAI_API_KEY is set, OpenAI is available. If not, it's skipped silently.
Providers are registered automatically based on available environment variables. Providers are registered automatically based on available environment variables.
No separate skills per provider — just different base URLs and API keys. No separate skills per provider — just different base URLs and API keys.
* Implementation * Implementation
** Provider registry (~*unified-llm-providers*~) ** Provider registry (~*provider-configs*~)
The authoritative list of supported LLM providers and their configuration: base URL, env var for API key, and default model name. The authoritative list of supported LLM providers and their configuration: base URL, env var for API key, and default model name.
#+begin_src lisp #+begin_src lisp
(defparameter *unified-llm-providers* (defparameter *provider-configs*
'((:ollama . (:base-url nil :key-env nil :default-model "llama3")) '((:ollama . (:base-url nil :key-env nil :default-model "llama3"))
(:openrouter . (:base-url "https://openrouter.ai/api/v1" :key-env "OPENROUTER_API_KEY" :default-model "openrouter/auto")) (:openrouter . (:base-url "https://openrouter.ai/api/v1" :key-env "OPENROUTER_API_KEY" :default-model "openrouter/auto"))
(:openai . (:base-url "https://api.openai.com/v1" :key-env "OPENAI_API_KEY" :default-model "gpt-4o-mini")) (:openai . (:base-url "https://api.openai.com/v1" :key-env "OPENAI_API_KEY" :default-model "gpt-4o-mini"))
(:anthropic . (:base-url "https://api.anthropic.com/v1" :key-env "ANTHROPIC_API_KEY" :default-model "claude-3-5-sonnet-20241022")) (:anthropic . (:base-url "https://api.anthropic.com/v1" :key-env "ANTHROPIC_API_KEY" :default-model "claude-3-5-sonnet-20241022"))
(:groq . (:base-url "https://api.groq.com/openai/v1" :key-env "GROQ_API_KEY" :default-model "llama-3.1-70b-versatile")) (:groq . (:base-url "https://api.groq.com/openai/v1" :key-env "GROQ_API_KEY" :default-model "llama-3.1-70b-versatile"))
(:gemini . (:base-url "https://generativelanguage.googleapis.com/v1beta/openai" :key-env "GEMINI_API_KEY" :default-model "gemini-2.0-flash")))) (:gemini . (:base-url "https://generativelanguage.googleapis.com/v1beta/openai" :key-env "GEMINI_API_KEY" :default-model "gemini-2.0-flash"))
(:deepseek . (:base-url "https://api.deepseek.com/v1" :key-env "DEEPSEEK_API_KEY" :default-model "deepseek-chat"))
(:nvidia . (:base-url "https://integrate.api.nvidia.com/v1" :key-env "NVIDIA_API_KEY" :default-model "meta/llama-3.1-405b-instruct"))))
#+end_src #+end_src
** Provider config lookup (get-provider-config) ** Provider config lookup (provider-config)
Returns the config plist for a given provider keyword. Returns the config plist for a given provider keyword.
#+begin_src lisp #+begin_src lisp
(defun get-provider-config (provider) (defun provider-config (provider)
"Returns the configuration plist for a provider keyword." "Returns the configuration plist for a provider keyword."
(cdr (assoc provider *unified-llm-providers*))) (cdr (assoc provider *provider-configs*)))
#+end_src #+end_src
** Availability check (provider-available-p) ** Availability check (provider-available-p)
@@ -38,7 +43,7 @@ Returns T if a provider is configured — meaning it either has an API key set,
#+begin_src lisp #+begin_src lisp
(defun provider-available-p (provider) (defun provider-available-p (provider)
"Checks if a provider is configured. Ollama is always considered available." "Checks if a provider is configured. Ollama is always considered available."
(let* ((config (get-provider-config provider)) (let* ((config (provider-config provider))
(key-env (getf config :key-env)) (key-env (getf config :key-env))
(base-url (getf config :base-url))) (base-url (getf config :base-url)))
(cond ((eq provider :ollama) t) (cond ((eq provider :ollama) t)
@@ -48,9 +53,9 @@ Returns T if a provider is configured — meaning it either has an API key set,
** Unified Request Execution ** Unified Request Execution
#+begin_src lisp #+begin_src lisp
(defun execute-openai-compatible-request (prompt system-prompt &key model (provider :ollama)) (defun provider-openai-request (prompt system-prompt &key model (provider :ollama))
"Executes a request against any OpenAI-compatible API endpoint." "Executes a request against any OpenAI-compatible API endpoint."
(let* ((config (get-provider-config provider)) (let* ((config (provider-config provider))
(base-url (getf config :base-url)) (base-url (getf config :base-url))
(key-env (getf config :key-env)) (key-env (getf config :key-env))
(default-model (getf config :default-model)) (default-model (getf config :default-model))
@@ -62,8 +67,8 @@ Returns T if a provider is configured — meaning it either has an API key set,
(headers `(("Content-Type" . "application/json") (headers `(("Content-Type" . "application/json")
,@(when api-key `(("Authorization" . ,(format nil "Bearer ~a" api-key)))) ,@(when api-key `(("Authorization" . ,(format nil "Bearer ~a" api-key))))
,@(when (eq provider :openrouter) ,@(when (eq provider :openrouter)
`(("HTTP-Referer" . "https://github.com/amrgharbeia/opencortex") `(("HTTP-Referer" . "https://github.com/amrgharbeia/passepartout")
("X-Title" . "OpenCortex"))))) ("X-Title" . "Passepartout")))))
(body (cl-json:encode-json-to-string (body (cl-json:encode-json-to-string
`((model . ,model-id) `((model . ,model-id)
(messages . (( (role . "system") (content . ,system-prompt) ) (messages . (( (role . "system") (content . ,system-prompt) )
@@ -84,32 +89,32 @@ Returns T if a provider is configured — meaning it either has an API key set,
** Dynamic Backend Registration ** Dynamic Backend Registration
#+begin_src lisp #+begin_src lisp
(defun register-available-llm-backends () (defun provider-register-all ()
"Scans environment variables and registers all available LLM backends." "Scans environment variables and registers all available LLM backends."
(dolist (entry *unified-llm-providers*) (dolist (entry *provider-configs*)
(let ((provider (car entry))) (let ((provider (car entry)))
(when (provider-available-p provider) (when (provider-available-p provider)
(harness-log "LLM BACKEND: Registering provider ~a" provider) (log-message "LLM BACKEND: Registering provider ~a" provider)
(register-probabilistic-backend provider (register-probabilistic-backend provider
(lambda (prompt system-prompt &key model) (lambda (prompt system-prompt &key model)
(execute-openai-compatible-request prompt system-prompt :model model :provider provider))))))) (provider-openai-request prompt system-prompt :model model :provider provider)))))))
(defun initialize-provider-cascade () (defun provider-cascade-initialize ()
"Reads PROVIDER_CASCADE from env and sets *provider-cascade*." "Reads PROVIDER_CASCADE from env and sets *provider-cascade*."
(let ((cascade-str (uiop:getenv "PROVIDER_CASCADE"))) (let ((cascade-str (uiop:getenv "PROVIDER_CASCADE")))
(if cascade-str (if cascade-str
(setf *provider-cascade* (setf *provider-cascade*
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword)) (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
(uiop:split-string cascade-str :separator '(#\,)))) (uiop:split-string cascade-str :separator '(#\,))))
(setf *provider-cascade* (mapcar #'car *unified-llm-providers*))))) (setf *provider-cascade* (mapcar #'car *provider-configs*)))))
#+end_src #+end_src
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(register-available-llm-backends) (provider-register-all)
(initialize-provider-cascade) (provider-cascade-initialize)
(defskill :skill-unified-llm-backend (defskill :passepartout-gateway-provider
:priority 50 :priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src #+end_src

321
org/gateway-tui.org Normal file
View File

@@ -0,0 +1,321 @@
#+TITLE: Passepartout TUI Client (Standalone)
#+STARTUP: content
#+FILETAGS: :tui:ux:client:
#+PROPERTY: header-args:lisp :tangle ../lisp/gateway-tui.lisp
* Overview: Architectural Intent
The TUI Client is a standalone ncurses application built on Croatoan that connects to the daemon via TCP. It provides a split-pane interface: a scrollable chat history window at the top and a fixed input line at the bottom.
Unlike the CLI gateway (which is a single request-response cycle), the TUI is a persistent connection. It maintains a background reader thread that listens for incoming messages from the daemon and enqueues them for display. This allows the agent to send messages to the user asynchronously — tool results, heartbeat notifications, and autonomous decisions appear in the chat window without the user having to ask.
** Why a Background Reader Thread?
The daemon's protocol is framed TCP — the TUI sends a message, the daemon processes it, and sends one or more responses. But the daemon can also send unsolicited messages (heartbeat notifications, tool results from autonomous actions). The background reader thread handles this by continuously reading from the socket and enqueuing messages for the main loop to display.
The main loop is event-driven: on each tick, it checks for new messages in the queue, checks for keyboard input, renders updates, and sleeps for ~10ms. This gives responsive text input (no perceived latency) while keeping CPU usage near zero.
* Implementation
** Package Context
The TUI lives in its own package (~passepartout.gateway-tui~) so it doesn't pollute the harness namespace. It depends on Croatoan (ncurses bindings), usocket (TCP client), and bordeaux-threads (background reader).
#+begin_src lisp
(in-package :cl-user)
(defpackage :passepartout.gateway-tui
(:use :cl :croatoan :usocket :bordeaux-threads)
(:export :main))
(in-package :passepartout.gateway-tui)
#+end_src
** Connection state
The daemon host and port. Defaults to localhost:9105. These can be changed before calling ~main~.
#+begin_src lisp
(defvar *daemon-host* "localhost")
#+end_src
#+begin_src lisp
(defvar *daemon-port* 9105)
#+end_src
** Socket and stream
The TCP socket and stream used to communicate with the daemon. Set during ~main~ and used by ~input-submit~ and ~reader-start~.
#+begin_src lisp
(defvar *socket* nil)
#+end_src
#+begin_src lisp
(defvar *stream* nil)
#+end_src
** Chat history
The list of messages displayed in the chat window. Each message is a string prepended with ~⬆~ (outgoing) or ~⬇~ (incoming).
#+begin_src lisp
(defvar *chat-history* nil)
#+end_src
** Input buffer
The current line the user is typing. Characters are pushed onto this list and reversed before submission.
#+begin_src lisp
(defvar *input-buffer* nil)
#+end_src
** Running flag
Set to nil to signal the main loop to exit. Set by ~/exit~ command, connection errors, or ~unwind-protect~ cleanup.
#+begin_src lisp
(defvar *is-running* t)
#+end_src
** Incoming message queue
Thread-safe queue for messages received by the background reader. Lock ensures the main loop and reader thread don't race on the list.
#+begin_src lisp
(defvar *queue-lock* (bt:make-lock "incoming-queue-lock"))
#+end_src
#+begin_src lisp
(defvar *incoming* nil)
#+end_src
** Utility functions
*** Debug logging
Writes debugging information to ~/tmp/passepartout-tui-debug.log~. Useful for diagnosing connection issues and message parsing problems.
#+begin_src lisp
(defun log-debug (msg &rest args)
(ignore-errors
(with-open-file (s "/tmp/passepartout-tui-debug.log" :direction :output :if-exists :append :if-does-not-exist :create)
(format s "[~a] " (get-universal-time))
(apply #'format s msg args)
(terpri s)
(finish-output s))))
#+end_src
*** Message queue (message-queue-push)
Adds a message to the incoming queue. Thread-safe via ~*queue-lock*~.
#+begin_src lisp
(defun message-queue-push (msg)
(bt:with-lock-held (*queue-lock*)
(setf *incoming* (append *incoming* (list msg)))))
#+end_src
*** Message queue (message-queue-drain)
Drains the incoming queue, returning all messages since the last drain. Thread-safe via ~*queue-lock*~.
#+begin_src lisp
(defun message-queue-drain ()
(bt:with-lock-held (*queue-lock*)
(let ((msgs *incoming*))
(setf *incoming* nil)
msgs)))
#+end_src
** Rendering (chat-render)
Renders the chat history window. Draws a bordered box with scrollable content — only the most recent ~h-2~ messages are visible, matching the window height.
The box border uses Unicode box-drawing characters via Croatoan's ~box~ function.
#+begin_src lisp
(defun chat-render (win h)
(when (and win (integerp h))
(clear win)
(box win 0 0)
(let* ((view-height (- h 2))
(history (copy-list *chat-history*))
(len (length history))
(num-to-draw (min len view-height))
(slice (subseq history 0 num-to-draw)))
(loop for i from 0 below num-to-draw
for msg in (reverse slice)
do (when msg
(add-string win (format nil "│ ~a" msg) :y (1+ i) :x 2))))
(refresh win)))
#+end_src
** Input handling
*** Handle backspace
Removes the last character from the input buffer.
#+begin_src lisp
(defun input-backspace ()
(pop *input-buffer*))
#+end_src
*** Handle return
Sends the accumulated input as a framed protocol message to the daemon. The message format is:
(:TYPE :EVENT :META (:SOURCE :tui) :PAYLOAD (:SENSOR :user-input :TEXT "<user input>"))
Also handles the ~/exit~ and ~/clear~ client-side commands before sending to the daemon.
#+begin_src lisp
(defun input-submit (stream)
(let ((cmd (coerce (reverse *input-buffer*) 'string)))
(setf *input-buffer* nil)
(log-debug "SUBMITTING: '~a'" cmd)
(when (> (length cmd) 0)
(push (format nil "⬆ ~a" cmd) *chat-history*)
(handler-case
(progn
(if (and stream (open-stream-p stream))
(let* ((msg (list :TYPE :EVENT
:META (list :SOURCE :tui)
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))
(payload (format nil "~s" msg))
(len (length payload)))
(format stream "~6,'0x~a" len payload)
(finish-output stream)
(log-debug "SENT WIRE: ~a" payload))
(push "ERROR: Not connected." *chat-history*)))
(error (c)
(log-debug "SEND ERROR: ~a" c)
(push (format nil "ERROR: ~a" c) *chat-history*)
(setf *is-running* nil))))
(when (string= cmd "/exit") (setf *is-running* nil))
(when (string= cmd "/clear") (setf *chat-history* nil))))
#+end_src
** Background Reader (reader-start)
A dedicated thread that continuously reads framed messages from the daemon's TCP stream. Messages are parsed and enqueued for the main loop to display.
The reader handles:
- The ~:handshake~ action (sent on connection) — displays "* Connected *"
- All other actions — displays the ~:text~ payload or the raw payload
If the connection is lost or an error occurs, the reader logs the error, enqueues a "Connection lost" message, and sets ~*is-running*~ to nil to stop the main loop.
#+begin_src lisp
(defun reader-start (stream)
(bt:make-thread
(lambda ()
(loop while *is-running* do
(handler-case
(let* ((len-buf (make-string 6))
(count (read-sequence len-buf stream)))
(if (= count 6)
(let* ((msg-len (parse-integer len-buf :radix 16))
(msg-buf (make-string msg-len)))
(read-sequence msg-buf stream)
(log-debug "DAEMON MSG: ~a" msg-buf)
(let ((msg (read-from-string msg-buf)))
(let ((payload (getf msg :payload)))
(cond
((eq (getf payload :action) :handshake)
(message-queue-push "* Connected *"))
(t
(let ((text (or (getf payload :text) (format nil "~a" payload))))
(message-queue-push (format nil "⬇ ~a" text))))))))
(sleep 0.05)))
(error (c)
(when *is-running*
(log-debug "READER ERROR: ~a" c)
(message-queue-push "ERROR: Connection lost.")
(setf *is-running* nil))))))
:name "passepartout-tui-reader"))
#+end_src
** Main Entry Point (main)
The top-level entry point for the TUI application. Boot sequence:
1. Connect to the daemon at ~localhost:9105~
2. If connection fails, print an error and exit immediately
3. Create the ncurses screen with two windows (chat + input)
4. Start the background reader thread
5. Enter the main loop: check for messages, check for keyboard input, render
6. On ~unwind-protect~ cleanup: close the socket
The main loop runs at ~100Hz (10ms sleep). Keyboard input is non-blocking — if no key is pressed, the loop still runs to check for incoming messages from the daemon.
#+begin_src lisp
(defun main ()
(log-debug "=== START ===")
(handler-case
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
(error (e) (format t "Offline: ~a~%" e) (return-from main)))
(setf *stream* (usocket:socket-stream *socket*))
(unwind-protect
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t)
(let* ((h (or (height scr) 24))
(w (or (width scr) 80))
(chat-h (- h 4))
(chat-win (make-instance 'window :height chat-h :width (- w 2) :y 1 :x 1))
(input-win (make-instance 'window :height 1 :width (- w 2) :y (- h 2) :x 1)))
(setf (input-blocking input-win) nil)
(reader-start *stream*)
(loop :while *is-running* :do
(let ((msgs (message-queue-drain)))
(when msgs
(dolist (m msgs) (push m *chat-history*))
(chat-render chat-win chat-h)))
(let ((ch (get-char input-win)))
(when (and ch (not (equal ch -1)))
(log-debug "KEY: ~s" ch)
(cond
((or (eql ch 10) (eql ch 13) (eq ch :enter) (eql ch #\Newline) (eql ch #\Return))
(input-submit *stream*)
(chat-render chat-win chat-h))
((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
(input-backspace))
((characterp ch)
(push ch *input-buffer*))
((integerp ch)
(let ((converted (code-char ch)))
(when (graphic-char-p converted)
(push converted *input-buffer*))))))
(clear input-win)
(add-string input-win (format nil "▶ ~a" (coerce (reverse *input-buffer*) 'string)) :y 0 :x 1)
(refresh input-win))
(sleep 0.01))))
(setf *is-running* nil)
(when *socket* (ignore-errors (usocket:socket-close *socket*)))))
#+end_src
** REPL test script (tmux)
Use this script to test the TUI non-interactively in a tmux session. It launches the TUI in a headless tmux window, sends text, and captures the output.
#+begin_src bash :tangle no
#!/bin/bash
SESSION="oct-tui-test"
tmux new-session -d -s "$SESSION" \
-e OC_CONFIG_DIR="$HOME/.config/passepartout" \
-e PASSEPARTOUT_DATA_DIR="$HOME/.local/share/passepartout" \
-e TERM="screen-256color" \
"sbcl --non-interactive \
--eval '(load (merge-pathnames \"quicklisp/setup.lisp\" (user-homedir-pathname)))' \
--eval '(push (truename \"$HOME/.local/share/passepartout/\") asdf:*central-registry*)' \
--eval '(ql:quickload :passepartout/tui)' \
--eval '(passepartout.gateway-tui:main)'"
sleep 5
tmux capture-pane -t "$SESSION" -p -S -20
tmux send-keys -t "$SESSION" 'hello' Enter
sleep 8
tmux capture-pane -t "$SESSION" -p -S -20
tmux send-keys -t "$SESSION" '/exit' Enter
sleep 1
tmux kill-session -t "$SESSION" 2>/dev/null || true
#+end_src

226
org/package.lisp Normal file
View File

@@ -0,0 +1,226 @@
(defpackage :passepartout
(:use :cl)
(:export
#:frame-message
#:read-framed-message
#:PROTO-GET
#:LIST-OBJECTS-WITH-ATTRIBUTE
#:COSINE-SIMILARITY
#:VAULT-MASK-STRING
#:*VAULT-MEMORY*
#:parse-message
#:make-hello-message
#:validate-communication-protocol-schema
#:start-daemon
#:stop-daemon
#:log-message
#:main
#:doctor-run-all
#:doctor-main
#:doctor-check-dependencies
#:doctor-check-env
#:register-provider
#:system-ready-p
#:run-setup-wizard
#:skill-gateway-register
#:skill-gateway-link
#:gateway-manager-main
#:ingest-ast
#:lookup-object
#:list-objects-by-type
#:org-id-new
#:*memory*
#:*history-store*
#:org-object
#:make-org-object
#:org-object-id
#:org-object-type
#:org-object-attributes
#:org-object-parent-id
#:org-object-children
#:org-object-version
#:org-object-last-sync
#:org-object-vector
#:org-object-content
#:org-object-hash
#:snapshot-memory
#:rollback-memory
#:context-query-store
#:context-get-active-projects
#:context-get-recent-completed-tasks
#:context-list-all-skills
#:context-get-skill-source
#:context-get-system-logs
#:context-resolve-path
#:context-get-skill-telemetry
#:telemetry-track
#:context-assemble-global-awareness
#:process-signal
#:perceive-gate
#:probabilistic-gate
#:consensus-gate
#:act-gate
#:reason-gate
#:dispatch-gate
#:inject-stimulus
#:initialize-actuators
#:dispatch-action
#:register-actuator
#:load-skill-from-org
#:initialize-all-skills
#:load-skill-with-timeout
#:topological-sort-skills
#:validate-lisp-syntax
#:defskill
#:*skill-registry*
#:skill
#:skill-name
#:skill-priority
#:skill-dependencies
#:skill-trigger-fn
#:skill-probabilistic-prompt
#:skill-deterministic-fn
#:cognitive-tool-define
#:*cognitive-tool-registry*
#:verify-git-clean-p
#:engineering-standards-verify-lisp
#:engineering-standards-format-lisp
#:literate-check-block-balance
#:check-tangle-sync
#:*tangle-targets*
#:utils-org-read-file
#:utils-org-write-file
#:utils-org-add-headline
#:utils-org-set-property
#:utils-org-set-todo
#:utils-org-find-headline-by-id
#:utils-org-find-headline-by-title
#:utils-org-generate-id
#:utils-org-id-format
#:utils-org-ast-to-org
#:utils-org-modify
#:utils-lisp-validate
#:utils-lisp-check-structural
#:utils-lisp-check-syntactic
#:utils-lisp-check-semantic
#:utils-lisp-eval
#:utils-lisp-format
#:utils-lisp-list-definitions
#:utils-lisp-structural-extract
#:utils-lisp-structural-wrap
#:utils-lisp-structural-inject
#:utils-lisp-structural-slurp
#:utils-lisp-register
#:get-oc-config-dir
#:prompt-for
#:save-secret
#:get-tool-permission
#:set-tool-permission
#:check-tool-permission-gate
#:cognitive-tool
#:cognitive-tool-name
#:cognitive-tool-description
#:cognitive-tool-parameters
#:cognitive-tool-guard
#:cognitive-tool-body
#:*emacs-clients*
#:*clients-lock*
#:register-emacs-client
#:unregister-emacs-client
#:ask-probabilistic
#:register-probabilistic-backend
#:distill-prompt
#:*probabilistic-backends*
#:*provider-cascade*
#:vault-get-secret
#:vault-set-secret
#:memory-objects-by-attribute
#:deterministic-verify
#:find-headline-missing-id))
(in-package :passepartout)
(defun plist-get (plist key)
"Robust plist accessor — checks both :KEY and :key variants."
(let* ((s (string key))
(up (intern (string-upcase s) :keyword))
(dn (intern (string-downcase s) :keyword)))
(or (getf plist up) (getf plist dn))))
(defvar *log-buffer* nil)
(defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock"))
(defvar *log-limit* 100)
(defvar *skill-registry* (make-hash-table :test 'equal)
"Global registry of all loaded skills.")
(defvar *telemetry-table* (make-hash-table :test 'equal))
(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
(defun telemetry-track (skill-name duration status)
"Updates performance metrics for a skill. STATUS is :success or :rejected."
(when skill-name
(bordeaux-threads:with-lock-held (*telemetry-lock*)
(let ((entry (or (gethash skill-name *telemetry-table*) (list :executions 0 :total-time 0 :failures 0))))
(incf (getf entry :executions))
(incf (getf entry :total-time) duration)
(when (eq status :rejected) (incf (getf entry :failures)))
(setf (gethash skill-name *telemetry-table*) entry)))))
(defvar *cognitive-tool-registry* (make-hash-table :test 'equal))
(defstruct cognitive-tool
name
description
parameters
guard
body)
(defmacro cognitive-tool-define (name description parameters &key guard body)
"Registers a cognitive tool. PARAMETERS is a list of plists, one per parameter."
`(setf (gethash (string-downcase (string ',name)) *cognitive-tool-registry*)
(make-cognitive-tool :name (string-downcase (string ',name))
:description ,description
:parameters ',parameters
:guard ,guard
:body ,body)))
(defun cognitive-tool-prompt ()
"Serialises all registered tools into a prompt string for the LLM."
(let ((descriptions nil))
(maphash (lambda (k tool)
(declare (ignore k))
(push (format nil "- ~a: ~a~% Parameters: ~a~%"
(cognitive-tool-name tool)
(cognitive-tool-description tool)
(cognitive-tool-parameters tool))
descriptions))
*cognitive-tool-registry*)
(if descriptions
(format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<)))
"No tools registered.")))
(defun log-message (msg &rest args)
"Centralized, thread-safe logging for the harness."
(let ((formatted-msg (apply #'format nil msg args)))
(bordeaux-threads:with-lock-held (*log-lock*)
(push formatted-msg *log-buffer*)
(when (> (length *log-buffer*) *log-limit*)
(setq *log-buffer* (subseq *log-buffer* 0 *log-limit*))))
(format t "~a~%" formatted-msg)
(finish-output)))
(setf *debugger-hook* (lambda (condition hook)
"Friendly error handler - shows diagnostic message instead of raw debugger."
(declare (ignore hook))
(format t "~%")
(format t "┌─────────────────────────────────────────────┐~%")
(format t "│ ERROR: ~A~%" (type-of condition))
(format t "│~%")
(format t "│ Run: opencortex doctor~%")
(format t "│ For system diagnostics~%")
(format t "└─────────────────────────────────────────────┘~%")
(format t "~%")
(format t "Details: ~A~%" condition)
(finish-output)
(uiop:quit 1)))

89
skills/org-skill-utils-lisp.org → org/programming-lisp.org
View File

@@ -1,16 +1,25 @@
#+TITLE: SKILL: Utils Lisp (org-skill-utils-lisp.org) #+TITLE: SKILL: Utils Lisp (org-skill-utils-lisp.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :skill:utils:lisp:validation:evaluation: #+FILETAGS: :skill:utils:lisp:validation:evaluation:
#+PROPERTY: header-args:lisp :tangle org-skill-utils-lisp.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/programming-lisp.lisp
* Overview * Architectural Intent: The Lisp Surgeon's Toolkit
Structural manipulation tools for Lisp code. This skill provides the full toolkit used by the agent when self-editing: ~utils-lisp-validate~ (three-phase structural/syntactic/semantic gate), ~utils-lisp-eval~ (sandboxed evaluation in a jailed package), ~utils-lisp-structural-extract~ / ~inject~ / ~wrap~ / ~slurp~ (surgical code transformations), and ~utils-lisp-format~ (auto-indentation via Emacs batch). Every self-edit operation goes through these functions.
When the agent needs to modify its own code — fix a bug, add a feature, refactor a skill — it reaches for Utils Lisp. This skill provides every operation needed to read, validate, modify, and write Lisp code from within Lisp itself.
This is possible only because Lisp is homoiconic: code is data. The agent can parse a function definition from a string, extract its body, wrap it in a new form, inject a new expression, and validate the result — all using the same data structures that the Lisp runtime uses to execute the code.
The skill has four layers:
1. **Validation** — three-phase gate: structural (paren balance) → syntactic (reader safety) → semantic (dangerous forms)
2. **Evaluation** — sandboxed ~eval~ in a jailed package with ~*read-eval*~ nil
3. **Structural surgery** — extract, inject, wrap, slurp — surgical code transformations without regex
4. **Formatting** — auto-indentation via Emacs batch mode
* Implementation * Implementation
** Structural Validation ** Structural Validation
#+begin_src lisp #+begin_src lisp
(defun utils-lisp-check-structural (code) (defun lisp-structural-check (code)
"Checks if parentheses are balanced and the code is readable." "Checks if parentheses are balanced and the code is readable."
(handler-case (handler-case
(let ((*read-eval* nil)) (let ((*read-eval* nil))
@@ -23,46 +32,46 @@ Structural manipulation tools for Lisp code. This skill provides the full toolki
** Syntactic Validation ** Syntactic Validation
#+begin_src lisp #+begin_src lisp
(defun utils-lisp-check-syntactic (code) (defun lisp-syntactic-check (code)
"Checks for valid Lisp syntax beyond just balanced parentheses." "Checks for valid Lisp syntax beyond just balanced parentheses."
(utils-lisp-check-structural code)) (lisp-structural-check code))
#+end_src #+end_src
** Semantic Validation (Safety) ** Semantic Validation (Safety)
#+begin_src lisp #+begin_src lisp
(defun utils-lisp-check-semantic (code) (defun lisp-semantic-check (code)
"Checks for potentially unsafe forms." "Checks for potentially unsafe forms."
(let ((unsafe-tokens '("eval" "load" "uiop:run-program" "sb-ext:run-program" "cl-user::eval"))) (let ((unsafe-tokens '("eval" "load" "uiop:run-program" "sb-ext:run-program" "cl-user::eval")))
(loop for token in unsafe-tokens (loop for token in unsafe-tokens
when (search token (string-downcase code)) when (search token (string-downcase code))
do (return-from utils-lisp-check-semantic (values nil (format nil "Unsafe form detected: ~a" token)))) do (return-from lisp-semantic-check (values nil (format nil "Unsafe form detected: ~a" token))))
(values t nil))) (values t nil)))
#+end_src #+end_src
** Unified Validation Gate ** Unified Validation Gate
#+begin_src lisp #+begin_src lisp
(defun utils-lisp-validate (code &key (strict t)) (defun lisp-validate (code &key (strict t))
"Unified validation gate for Lisp code." "Unified validation gate for Lisp code."
(multiple-value-bind (struct-ok struct-err) (utils-lisp-check-structural code) (multiple-value-bind (struct-ok struct-err) (lisp-structural-check code)
(unless struct-ok (unless struct-ok
(return-from utils-lisp-validate (list :status :error :reason struct-err))) (return-from lisp-validate (list :status :error :reason struct-err)))
(when strict (when strict
(multiple-value-bind (sem-ok sem-err) (utils-lisp-check-semantic code) (multiple-value-bind (sem-ok sem-err) (lisp-semantic-check code)
(unless sem-ok (unless sem-ok
(return-from utils-lisp-validate (list :status :error :reason sem-err))))) (return-from lisp-validate (list :status :error :reason sem-err)))))
(list :status :success))) (list :status :success)))
#+end_src #+end_src
** Evaluation (REPL) ** Evaluation (REPL)
#+begin_src lisp #+begin_src lisp
(defun utils-lisp-eval (code-string &key (package :opencortex)) (defun lisp-eval (code-string &key (package :passepartout))
"Evaluates a Lisp string and captures its output/results." "Evaluates a Lisp string and captures its output/results."
(let ((out (make-string-output-stream)) (let ((out (make-string-output-stream))
(err (make-string-output-stream))) (err (make-string-output-stream)))
(handler-case (handler-case
(let* ((*standard-output* out) (let* ((*standard-output* out)
(*error-output* err) (*error-output* err)
(*package* (or (find-package package) (find-package :opencortex))) (*package* (or (find-package package) (find-package :passepartout)))
(result (with-input-from-string (s code-string) (result (with-input-from-string (s code-string)
(let ((last-val nil)) (let ((last-val nil))
(loop for form = (read s nil :eof) until (eq form :eof) (loop for form = (read s nil :eof) until (eq form :eof)
@@ -81,7 +90,7 @@ Structural manipulation tools for Lisp code. This skill provides the full toolki
** Formatting (Emacs Batch) ** Formatting (Emacs Batch)
#+begin_src lisp #+begin_src lisp
(defun utils-lisp-format (code-string) (defun lisp-format (code-string)
"Attempts to format Lisp code using Emacs batch mode if available." "Attempts to format Lisp code using Emacs batch mode if available."
(handler-case (handler-case
(let ((tmp-file "/tmp/oc-format-temp.lisp")) (let ((tmp-file "/tmp/oc-format-temp.lisp"))
@@ -104,7 +113,7 @@ Structural manipulation tools for Lisp code. This skill provides the full toolki
** Structural Extraction (AST) ** Structural Extraction (AST)
#+begin_src lisp #+begin_src lisp
(defun utils-lisp-structural-extract (code function-name) (defun lisp-extract (code function-name)
"Extracts the definition of a specific function from a code string." "Extracts the definition of a specific function from a code string."
(let ((*read-eval* nil)) (let ((*read-eval* nil))
(with-input-from-string (s code) (with-input-from-string (s code)
@@ -114,13 +123,13 @@ Structural manipulation tools for Lisp code. This skill provides the full toolki
(member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal) (member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
(symbolp (second form)) (symbolp (second form))
(string-equal (symbol-name (second form)) function-name)) (string-equal (symbol-name (second form)) function-name))
do (return-from utils-lisp-structural-extract (format nil "~s" form)))) do (return-from lisp-extract (format nil "~s" form))))
nil)) nil))
#+end_src #+end_src
** Structural Wrapping (AST) ** Structural Wrapping (AST)
#+begin_src lisp #+begin_src lisp
(defun utils-lisp-structural-wrap (code target-name wrapper-symbol) (defun lisp-wrap (code target-name wrapper-symbol)
"Wraps a specific form in a wrapper form (e.g., wrap in a let)." "Wraps a specific form in a wrapper form (e.g., wrap in a let)."
(let ((*read-eval* nil) (results nil)) (let ((*read-eval* nil) (results nil))
(with-input-from-string (s code) (with-input-from-string (s code)
@@ -135,7 +144,7 @@ Structural manipulation tools for Lisp code. This skill provides the full toolki
** List Definitions ** List Definitions
#+begin_src lisp #+begin_src lisp
(defun utils-lisp-list-definitions (code) (defun lisp-list-definitions (code)
"Returns a list of names for all top-level definitions (defun, defmacro, etc.)." "Returns a list of names for all top-level definitions (defun, defmacro, etc.)."
(let ((*read-eval* nil) (names nil)) (let ((*read-eval* nil) (names nil))
(with-input-from-string (s code) (with-input-from-string (s code)
@@ -152,7 +161,7 @@ Structural manipulation tools for Lisp code. This skill provides the full toolki
** Structural Injection (AST) ** Structural Injection (AST)
#+begin_src lisp #+begin_src lisp
(defun utils-lisp-structural-inject (code target-name new-form-string) (defun lisp-inject (code target-name new-form-string)
"Injects a new form into the body of a targeted definition." "Injects a new form into the body of a targeted definition."
(let ((*read-eval* nil) (let ((*read-eval* nil)
(new-form (read-from-string new-form-string)) (new-form (read-from-string new-form-string))
@@ -171,7 +180,7 @@ Structural manipulation tools for Lisp code. This skill provides the full toolki
** Structural Slurp (AST) ** Structural Slurp (AST)
#+begin_src lisp #+begin_src lisp
(defun utils-lisp-structural-slurp (code target-name form-to-slurp-string) (defun lisp-slurp (code target-name form-to-slurp-string)
"Adds a form to the end of a named list or definition (Paredit slurp)." "Adds a form to the end of a named list or definition (Paredit slurp)."
(let ((*read-eval* nil) (let ((*read-eval* nil)
(to-slurp (read-from-string form-to-slurp-string)) (to-slurp (read-from-string form-to-slurp-string))
@@ -188,19 +197,19 @@ Structural manipulation tools for Lisp code. This skill provides the full toolki
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-utils-lisp (defskill :passepartout-programming-lisp
:priority 400 :priority 400
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src #+end_src
* Test Suite * Test Suite
Tests for the Lisp Validator structural, syntactic, and semantic gates. Tests for the Lisp Validator structural, syntactic, and semantic gates.
#+begin_src lisp :tangle ../tests/utils-lisp-tests.lisp #+begin_src lisp :tangle ../lisp/programming-lisp.lisp
(defpackage :opencortex-utils-lisp-tests (defpackage :passepartout-utils-lisp-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :passepartout)
(:export #:utils-lisp-suite)) (:export #:utils-lisp-suite))
(in-package :opencortex-utils-lisp-tests) (in-package :passepartout-utils-lisp-tests)
(def-suite utils-lisp-suite (def-suite utils-lisp-suite
:description "Tests for the Lisp Validator structural, syntactic, and semantic gates") :description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
@@ -208,45 +217,45 @@ Tests for the Lisp Validator structural, syntactic, and semantic gates.
(in-suite utils-lisp-suite) (in-suite utils-lisp-suite)
(test structural-balanced (test structural-balanced
(is (eq t (opencortex:utils-lisp-check-structural "(+ 1 2)")))) (is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
(test structural-unbalanced-open (test structural-unbalanced-open
(multiple-value-bind (ok reason) (opencortex:utils-lisp-check-structural "(+ 1 2") (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
(is (null ok)) (is (null ok))
(is (search "Reader Error" reason)))) (is (search "Reader Error" reason))))
(test structural-unbalanced-close (test structural-unbalanced-close
(multiple-value-bind (ok reason) (opencortex:utils-lisp-check-structural "+ 1 2)") (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
(is (null ok)) (is (null ok))
(is (search "Reader Error" reason)))) (is (search "Reader Error" reason))))
(test syntactic-valid (test syntactic-valid
(is (eq t (opencortex:utils-lisp-check-syntactic "(+ 1 2)")))) (is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
(test semantic-safe (test semantic-safe
(is (eq t (opencortex:utils-lisp-check-semantic "(+ 1 2)")))) (is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
(test semantic-blocked-eval (test semantic-blocked-eval
(multiple-value-bind (ok reason) (opencortex:utils-lisp-check-semantic "(eval '(+ 1 2))") (multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
(is (null ok)) (is (null ok))
(is (search "Unsafe" reason)))) (is (search "Unsafe" reason))))
(test unified-success (test unified-success
(let ((result (opencortex:utils-lisp-validate "(+ 1 2)" :strict t))) (let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
(is (eq (getf result :status) :success)))) (is (eq (getf result :status) :success))))
(test unified-failure (test unified-failure
(let ((result (opencortex:utils-lisp-validate "(+ 1 2" :strict nil))) (let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
(is (eq (getf result :status) :error)))) (is (eq (getf result :status) :error))))
(test eval-basic (test eval-basic
(let ((result (opencortex:utils-lisp-eval "(+ 1 2)"))) (let ((result (passepartout:lisp-eval "(+ 1 2)")))
(is (eq (getf result :status) :success)) (is (eq (getf result :status) :success))
(is (string= (getf result :result) "3")))) (is (string= (getf result :result) "3"))))
(test structural-extract (test structural-extract
(let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))") (let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
(extracted (opencortex:utils-lisp-structural-extract code "hello"))) (extracted (passepartout:lisp-extract code "hello")))
(is (not (null extracted))) (is (not (null extracted)))
(let ((form (read-from-string extracted))) (let ((form (read-from-string extracted)))
(is (eq (car form) 'DEFUN)) (is (eq (car form) 'DEFUN))
@@ -254,20 +263,20 @@ Tests for the Lisp Validator structural, syntactic, and semantic gates.
(test list-definitions (test list-definitions
(let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)")) (let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
(let ((names (opencortex:utils-lisp-list-definitions code))) (let ((names (passepartout:lisp-list-definitions code)))
(is (member 'FOO names)) (is (member 'FOO names))
(is (member 'BAR names)) (is (member 'BAR names))
(is (member '*BAZ* names))))) (is (member '*BAZ* names)))))
(test structural-inject (test structural-inject
(let* ((code "(defun my-fun (x) (print x))") (let* ((code "(defun my-fun (x) (print x))")
(injected (opencortex:utils-lisp-structural-inject code "my-fun" "(finish-output)"))) (injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
(let ((form (read-from-string injected))) (let ((form (read-from-string injected)))
(is (equal (last form) '((FINISH-OUTPUT))))))) (is (equal (last form) '((FINISH-OUTPUT)))))))
(test structural-slurp (test structural-slurp
(let* ((code "(defun work () (step-1))") (let* ((code "(defun work () (step-1))")
(slurped (opencortex:utils-lisp-structural-slurp code "work" "(step-2)"))) (slurped (passepartout:lisp-slurp code "work" "(step-2)")))
(let ((form (read-from-string slurped))) (let ((form (read-from-string slurped)))
(is (equal (last form) '((STEP-2))))))) (is (equal (last form) '((STEP-2)))))))
#+end_src #+end_src

10
skills/org-skill-literate-programming.org → org/programming-literate.org
View File

@@ -1,10 +1,10 @@
#+TITLE: SKILL: Literate Programming (org-skill-literate-programming.org) #+TITLE: SKILL: Literate Programming (org-skill-literate-programming.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :system:literate:tangle: #+FILETAGS: :system:literate:tangle:
#+PROPERTY: header-args:lisp :tangle org-skill-literate-programming.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/programming-literate.lisp
* Overview * Overview
This skill enforces the literal programming discipline for all OpenCortex source code. It defines the rules for one-function-per-block, prose-before-code, reflecting working code back from the REPL to Org, and the tangle mandate (never edit .lisp directly). Every Org file that contains Lisp code should follow the rules defined here. This skill enforces the literal programming discipline for all Passepartout source code. It defines the rules for one-function-per-block, prose-before-code, reflecting working code back from the REPL to Org, and the tangle mandate (never edit .lisp directly). Every Org file that contains Lisp code should follow the rules defined here.
** Discipline Rules ** Discipline Rules
@@ -36,12 +36,12 @@ The `.lisp` file is derived, not authored. Never edit `.lisp` directly. All chan
** Synchronization Logic ** Synchronization Logic
#+begin_src lisp #+begin_src lisp
(defun literate-check-block-balance (org-file) (defun literate-block-balance-check (org-file)
"Verifies that all Lisp source blocks in an Org file are balanced." "Verifies that all Lisp source blocks in an Org file are balanced."
(harness-log "LITERATE: Checking block balance for ~a" org-file) (harness-log "LITERATE: Checking block balance for ~a" org-file)
t) t)
(defun check-tangle-sync (org-file lisp-file) (defun literate-tangle-sync-check (org-file lisp-file)
"Verifies that the Lisp file matches the tangled output of the Org file." "Verifies that the Lisp file matches the tangled output of the Org file."
(harness-log "LITERATE: Checking tangle sync for ~a <-> ~a" org-file lisp-file) (harness-log "LITERATE: Checking tangle sync for ~a <-> ~a" org-file lisp-file)
t) t)
@@ -49,7 +49,7 @@ The `.lisp` file is derived, not authored. Never edit `.lisp` directly. All chan
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-literate-programming (defskill :passepartout-programming-literate
:priority 300 :priority 300
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src #+end_src

90
skills/org-skill-utils-org.org → org/programming-org.org
View File

@@ -1,7 +1,7 @@
#+TITLE: SKILL: Utils Org (org-skill-utils-org.org) #+TITLE: SKILL: Utils Org (org-skill-utils-org.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :skill:utils:org: #+FILETAGS: :skill:utils:org:
#+PROPERTY: header-args:lisp :tangle org-skill-utils-org.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/programming-org.lisp
* Overview * Overview
Structural manipulation tools for Org-mode files. This skill handles reading, writing, and modifying Org files at the AST level: finding headlines by ID or title, setting properties and TODO states, adding new headlines, generating UUIDs, and converting ASTs back to Org text. It also implements the privacy filter — when reading an Org file, it strips headlines tagged with ~@personal~ (or any tag in ~bouncer-privacy-tags~) and rejects files with matching ~#+FILETAGS:~. Structural manipulation tools for Org-mode files. This skill handles reading, writing, and modifying Org files at the AST level: finding headlines by ID or title, setting properties and TODO states, adding new headlines, generating UUIDs, and converting ASTs back to Org text. It also implements the privacy filter — when reading an Org file, it strips headlines tagged with ~@personal~ (or any tag in ~bouncer-privacy-tags~) and rejects files with matching ~#+FILETAGS:~.
@@ -10,20 +10,20 @@ Structural manipulation tools for Org-mode files. This skill handles reading, wr
** Reading Files (with Privacy Filter) ** Reading Files (with Privacy Filter)
#+begin_src lisp #+begin_src lisp
(defun utils-org-extract-filetags (content) (defun org-filetags-extract (content)
"Extracts the list of tags from a #+FILETAGS: line." "Extracts the list of tags from a #+FILETAGS: line."
(let ((lines (uiop:split-string content :separator '(#\Newline)))) (let ((lines (uiop:split-string content :separator '(#\Newline))))
(dolist (line lines) (dolist (line lines)
(when (uiop:string-prefix-p "#+FILETAGS:" (string-trim '(#\Space) line)) (when (uiop:string-prefix-p "#+FILETAGS:" (string-trim '(#\Space) line))
(let ((tag-str (string-trim " :" (subseq (string-trim '(#\Space) line) 10)))) (let ((tag-str (string-trim " :" (subseq (string-trim '(#\Space) line) 10))))
(return-from utils-org-extract-filetags (return-from org-filetags-extract
(mapcar (lambda (tag) (format nil ":~a" (string-trim '(#\Space) tag))) (mapcar (lambda (tag) (format nil ":~a" (string-trim '(#\Space) tag)))
(uiop:split-string tag-str :separator '(#\space #\tab)))))))) (uiop:split-string tag-str :separator '(#\space #\tab))))))))
nil) nil)
(defun utils-org-tag-matches-privacy-p (tags-list) (defun org-privacy-tag-p (tags-list)
"Returns T if any tag in TAGS-LIST matches bouncer-privacy-tags." "Returns T if any tag in TAGS-LIST matches bouncer-privacy-tags."
(let ((privacy-tags (symbol-value (find-symbol "BOUNCER-PRIVACY-TAGS" :opencortex)))) (let ((privacy-tags (symbol-value (find-symbol "BOUNCER-PRIVACY-TAGS" :passepartout))))
(when (and tags-list privacy-tags) (when (and tags-list privacy-tags)
(some (lambda (tag) (some (lambda (tag)
(some (lambda (private-tag) (some (lambda (private-tag)
@@ -32,7 +32,7 @@ Structural manipulation tools for Org-mode files. This skill handles reading, wr
privacy-tags)) privacy-tags))
tags-list))))) tags-list)))))
(defun utils-org-strip-tagged-subtrees (content) (defun org-privacy-strip (content)
"Removes Org headlines whose :TAGS: property contains a privacy-filtered tag. "Removes Org headlines whose :TAGS: property contains a privacy-filtered tag.
Returns the filtered content as a string." Returns the filtered content as a string."
(let* ((lines (uiop:split-string content :separator '(#\Newline))) (let* ((lines (uiop:split-string content :separator '(#\Newline)))
@@ -53,7 +53,7 @@ Returns the filtered content as a string."
((uiop:string-prefix-p ":END:" (string-trim '(#\Space) line)) ((uiop:string-prefix-p ":END:" (string-trim '(#\Space) line))
(setf in-properties nil) (setf in-properties nil)
(when current-tags (when current-tags
(when (utils-org-tag-matches-privacy-p (reverse current-tags)) (when (org-privacy-tag-p (reverse current-tags))
(setf skip-depth (setf skip-depth
(length (car (last result-lines (length (car (last result-lines
(1+ (position-if (1+ (position-if
@@ -70,20 +70,20 @@ Returns the filtered content as a string."
(push line result-lines)))) (push line result-lines))))
(format nil "~{~a~%~}" (nreverse result-lines)))) (format nil "~{~a~%~}" (nreverse result-lines))))
(defun utils-org-read-file (filepath) (defun org-read-file (filepath)
"Reads an Org file into a string, applying privacy filtering." "Reads an Org file into a string, applying privacy filtering."
(let* ((raw (uiop:read-file-string filepath)) (let* ((raw (uiop:read-file-string filepath))
(filetags (utils-org-extract-filetags raw))) (filetags (org-filetags-extract raw)))
(if (utils-org-tag-matches-privacy-p filetags) (if (org-privacy-tag-p filetags)
(progn (progn
(harness-log "UTILS-ORG: Blocked read of ~a — file-level privacy tag(s) ~a" filepath filetags) (harness-log "UTILS-ORG: Blocked read of ~a — file-level privacy tag(s) ~a" filepath filetags)
nil) nil)
(utils-org-strip-tagged-subtrees raw)))) (org-privacy-strip raw))))
#+end_src #+end_src
** Writing Files ** Writing Files
#+begin_src lisp #+begin_src lisp
(defun utils-org-write-file (filepath content) (defun org-write-file (filepath content)
"Writes content to an Org file." "Writes content to an Org file."
(uiop:with-output-file (s filepath :if-exists :supersede) (uiop:with-output-file (s filepath :if-exists :supersede)
(format s "~a" content))) (format s "~a" content)))
@@ -91,14 +91,14 @@ Returns the filtered content as a string."
** ID Generation ** ID Generation
#+begin_src lisp #+begin_src lisp
(defun utils-org-generate-id () (defun org-id-generate ()
"Generates a new UUID for an Org node." "Generates a new UUID for an Org node."
(string-downcase (format nil "~a" (uuid:make-v4-uuid)))) (string-downcase (format nil "~a" (uuid:make-v4-uuid))))
#+end_src #+end_src
** ID Formatting ** ID Formatting
#+begin_src lisp #+begin_src lisp
(defun utils-org-id-format (id) (defun org-id-format (id)
"Ensures the ID has the 'id:' prefix." "Ensures the ID has the 'id:' prefix."
(if (uiop:string-prefix-p "id:" id) (if (uiop:string-prefix-p "id:" id)
id id
@@ -107,31 +107,31 @@ Returns the filtered content as a string."
** Setting Properties (Recursive) ** Setting Properties (Recursive)
#+begin_src lisp #+begin_src lisp
(defun utils-org-set-property (ast target-id property value) (defun org-property-set (ast target-id property value)
"Recursively sets a property on a headline with a matching ID in the AST." "Recursively sets a property on a headline with a matching ID in the AST."
(let ((type (getf ast :type)) (let ((type (getf ast :type))
(props (getf ast :properties)) (props (getf ast :properties))
(contents (getf ast :contents))) (contents (getf ast :contents)))
(when (and (eq type :HEADLINE) (string= (getf props :ID) target-id)) (when (and (eq type :HEADLINE) (string= (getf props :ID) target-id))
(setf (getf (getf ast :properties) property) value) (setf (getf (getf ast :properties) property) value)
(return-from utils-org-set-property t)) (return-from org-property-set t))
(dolist (child contents) (dolist (child contents)
(when (listp child) (when (listp child)
(when (utils-org-set-property child target-id property value) (when (org-property-set child target-id property value)
(return-from utils-org-set-property t))))) (return-from org-property-set t)))))
nil) nil)
#+end_src #+end_src
** Setting TODO Status ** Setting TODO Status
#+begin_src lisp #+begin_src lisp
(defun utils-org-set-todo (ast target-id status) (defun org-todo-set (ast target-id status)
"Sets the TODO status of a headline in the AST." "Sets the TODO status of a headline in the AST."
(utils-org-set-property ast target-id :TODO status)) (org-property-set ast target-id :TODO status))
#+end_src #+end_src
** Adding Headlines ** Adding Headlines
#+begin_src lisp #+begin_src lisp
(defun utils-org-add-headline (ast parent-id title) (defun org-headline-add (ast parent-id title)
"Adds a new headline as a child of the parent-id in the AST." "Adds a new headline as a child of the parent-id in the AST."
(let* ((type (getf ast :type)) (let* ((type (getf ast :type))
(props (getf ast :properties)) (props (getf ast :properties))
@@ -139,49 +139,49 @@ Returns the filtered content as a string."
(contents (getf ast :contents))) (contents (getf ast :contents)))
(when (and (eq type :HEADLINE) (string= id parent-id)) (when (and (eq type :HEADLINE) (string= id parent-id))
(let ((new-node (list :type :HEADLINE (let ((new-node (list :type :HEADLINE
:properties (list :ID (utils-org-id-format (utils-org-generate-id)) :properties (list :ID (org-id-format (org-id-generate))
:TITLE title) :TITLE title)
:contents nil))) :contents nil)))
(setf (getf ast :contents) (append contents (list new-node))) (setf (getf ast :contents) (append contents (list new-node)))
(return-from utils-org-add-headline t))) (return-from org-headline-add t)))
(dolist (child contents) (dolist (child contents)
(when (listp child) (when (listp child)
(when (utils-org-add-headline child parent-id title) (when (org-headline-add child parent-id title)
(return-from utils-org-add-headline t))))) (return-from org-headline-add t)))))
nil) nil)
#+end_src #+end_src
** Searching Headlines (by ID) ** Searching Headlines (by ID)
#+begin_src lisp #+begin_src lisp
(defun utils-org-find-headline-by-id (ast id) (defun org-headline-find-by-id (ast id)
"Finds a headline by its ID in the AST." "Finds a headline by its ID in the AST."
(let ((props (getf ast :properties))) (let ((props (getf ast :properties)))
(when (string= (getf props :ID) id) (when (string= (getf props :ID) id)
(return-from utils-org-find-headline-by-id ast)) (return-from org-headline-find-by-id ast))
(dolist (child (getf ast :contents)) (dolist (child (getf ast :contents))
(when (listp child) (when (listp child)
(let ((found (utils-org-find-headline-by-id child id))) (let ((found (org-headline-find-by-id child id)))
(when found (return-from utils-org-find-headline-by-id found))))) (when found (return-from org-headline-find-by-id found)))))
nil)) nil))
#+end_src #+end_src
** Searching Headlines (by Title) ** Searching Headlines (by Title)
#+begin_src lisp #+begin_src lisp
(defun utils-org-find-headline-by-title (ast title) (defun org-headline-find-by-title (ast title)
"Finds a headline by its title in the AST." "Finds a headline by its title in the AST."
(let ((props (getf ast :properties))) (let ((props (getf ast :properties)))
(when (string-equal (getf props :TITLE) title) (when (string-equal (getf props :TITLE) title)
(return-from utils-org-find-headline-by-title ast)) (return-from org-headline-find-by-title ast))
(dolist (child (getf ast :contents)) (dolist (child (getf ast :contents))
(when (listp child) (when (listp child)
(let ((found (utils-org-find-headline-by-title child title))) (let ((found (org-headline-find-by-title child title)))
(when found (return-from utils-org-find-headline-by-title found))))) (when found (return-from org-headline-find-by-title found)))))
nil)) nil))
#+end_src #+end_src
** Placeholder for External Edits ** Placeholder for External Edits
#+begin_src lisp #+begin_src lisp
(defun utils-org-modify (filepath id changes) (defun org-modify (filepath id changes)
"Placeholder for Emacs-driven modification of a specific node." "Placeholder for Emacs-driven modification of a specific node."
(declare (ignore changes)) (declare (ignore changes))
(harness-log "UTILS-ORG: Applying changes to ~a in ~a" id filepath) (harness-log "UTILS-ORG: Applying changes to ~a in ~a" id filepath)
@@ -190,7 +190,7 @@ Returns the filtered content as a string."
** Placeholder for AST to Org conversion ** Placeholder for AST to Org conversion
#+begin_src lisp #+begin_src lisp
(defun utils-org-ast-to-org (ast) (defun org-ast-render (ast)
"Minimal converter from AST back to Org text (Placeholder)." "Minimal converter from AST back to Org text (Placeholder)."
(declare (ignore ast)) (declare (ignore ast))
"* TITLE (Placeholder)") "* TITLE (Placeholder)")
@@ -198,19 +198,19 @@ Returns the filtered content as a string."
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-utils-org (defskill :passepartout-programming-org
:priority 100 :priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src #+end_src
* Test Suite * Test Suite
Verification of the structural manipulation for Org-mode files and their AST representation. Verification of the structural manipulation for Org-mode files and their AST representation.
#+begin_src lisp :tangle ../tests/utils-org-tests.lisp #+begin_src lisp :tangle ../lisp/programming-org.lisp
(defpackage :opencortex-utils-org-tests (defpackage :passepartout-utils-org-tests
(:use :cl :fiveam :opencortex) (:use :cl :fiveam :passepartout)
(:export #:utils-org-suite)) (:export #:utils-org-suite))
(in-package :opencortex-utils-org-tests) (in-package :passepartout-utils-org-tests)
(def-suite utils-org-suite (def-suite utils-org-suite
:description "Tests for Utils Org skill.") :description "Tests for Utils Org skill.")
@@ -218,26 +218,26 @@ Verification of the structural manipulation for Org-mode files and their AST rep
(in-suite utils-org-suite) (in-suite utils-org-suite)
(test id-generation (test id-generation
(let ((id1 (utils-org-generate-id)) (let ((id1 (org-id-generate))
(id2 (utils-org-generate-id))) (id2 (org-id-generate)))
(is (plusp (length id1))) (is (plusp (length id1)))
(is (not (string= id1 id2))))) (is (not (string= id1 id2)))))
(test id-format (test id-format
(let ((formatted (utils-org-id-format "abc12345"))) (let ((formatted (org-id-format "abc12345")))
(is (search "id:" formatted)))) (is (search "id:" formatted))))
(test property-setter (test property-setter
(let ((ast (list :type :HEADLINE (let ((ast (list :type :HEADLINE
:properties (list :ID "id:test123" :TITLE "Test") :properties (list :ID "id:test123" :TITLE "Test")
:contents nil))) :contents nil)))
(utils-org-set-property ast "id:test123" :STATUS "ACTIVE") (org-property-set ast "id:test123" :STATUS "ACTIVE")
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE")))) (is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
(test todo-setter (test todo-setter
(let ((ast (list :type :HEADLINE (let ((ast (list :type :HEADLINE
:properties (list :ID "id:todo001" :TITLE "Task") :properties (list :ID "id:todo001" :TITLE "Task")
:contents nil))) :contents nil)))
(utils-org-set-todo ast "id:todo001" "DONE") (org-todo-set ast "id:todo001" "DONE")
(is (string= (getf (getf ast :properties) :TODO) "DONE")))) (is (string= (getf (getf ast :properties) :TODO) "DONE"))))
#+end_src #+end_src

24
skills/org-skill-repl.org → org/programming-repl.org
View File

@@ -1,7 +1,7 @@
#+TITLE: SKILL: REPL (org-skill-repl.org) #+TITLE: SKILL: REPL (org-skill-repl.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :system:repl:interactive:debug: #+FILETAGS: :system:repl:interactive:debug:
#+PROPERTY: header-args:lisp :tangle org-skill-repl.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/programming-repl.lisp
* Overview * Overview
The *REPL Skill* provides persistent Lisp evaluation, inspection, and debugging capabilities. This enables the agent to verify behavior at runtime rather than just at the text level. The *REPL Skill* provides persistent Lisp evaluation, inspection, and debugging capabilities. This enables the agent to verify behavior at runtime rather than just at the text level.
@@ -35,9 +35,9 @@ The REPL skill fills this gap by:
** Global State ** Global State
#+begin_src lisp #+begin_src lisp
(in-package :opencortex) (in-package :passepartout)
(defvar *repl-package* :opencortex (defvar *repl-package* :passepartout
"Default package for REPL evaluations.") "Default package for REPL evaluations.")
(defvar *repl-history* nil (defvar *repl-history* nil
@@ -56,7 +56,7 @@ The REPL skill fills this gap by:
- error: error message or nil on success" - error: error message or nil on success"
(let ((out (make-string-output-stream)) (let ((out (make-string-output-stream))
(err (make-string-output-stream)) (err (make-string-output-stream))
(pkg (or (find-package package) (find-package :opencortex)))) (pkg (or (find-package package) (find-package :passepartout))))
(handler-case (handler-case
(let* ((*standard-output* out) (let* ((*standard-output* out)
(*error-output* err) (*error-output* err)
@@ -82,7 +82,7 @@ The REPL skill fills this gap by:
#+begin_src lisp #+begin_src lisp
(defun repl-inspect (symbol-name &key (package *repl-package*)) (defun repl-inspect (symbol-name &key (package *repl-package*))
"Inspect a variable's value and structure." "Inspect a variable's value and structure."
(let* ((pkg (or (find-package package) (find-package :opencortex))) (let* ((pkg (or (find-package package) (find-package :passepartout)))
(sym (find-symbol (string-upcase symbol-name) pkg))) (sym (find-symbol (string-upcase symbol-name) pkg)))
(cond (cond
((null sym) ((null sym)
@@ -102,7 +102,7 @@ The REPL skill fills this gap by:
#+begin_src lisp #+begin_src lisp
(defun repl-list-vars (&key (package *repl-package*)) (defun repl-list-vars (&key (package *repl-package*))
"List all bound variables in the package." "List all bound variables in the package."
(let* ((pkg (or (find-package package) (find-package :opencortex))) (let* ((pkg (or (find-package package) (find-package :passepartout)))
(vars nil)) (vars nil))
(do-symbols (sym pkg) (do-symbols (sym pkg)
(when (boundp sym) (when (boundp sym)
@@ -139,13 +139,13 @@ The REPL skill fills this gap by:
(format nil "~% (format nil "~%
REPL Skill Commands: REPL Skill Commands:
------------------- -------------------
(repl-eval \"code\" :package :opencortex) (repl-eval \"code\" :package :passepartout)
- Evaluate Lisp code, returns (values result output error) - Evaluate Lisp code, returns (values result output error)
(repl-inspect \"symbol\" :package :opencortex) (repl-inspect \"symbol\" :package :passepartout)
- Inspect a variable or function - Inspect a variable or function
(repl-list-vars :package :opencortex) (repl-list-vars :package :passepartout)
- List all bound variables - List all bound variables
(repl-load-file \"/path/to/file.lisp\") (repl-load-file \"/path/to/file.lisp\")
@@ -166,7 +166,7 @@ REPL Skill Commands:
(test test-repl-eval-simple (test test-repl-eval-simple
"Test basic arithmetic evaluation." "Test basic arithmetic evaluation."
(multiple-value-bind (result output error) (multiple-value-bind (result output error)
(opencortex:repl-eval "(+ 1 2)") (passepartout:repl-eval "(+ 1 2)")
(is (string= result "3")) (is (string= result "3"))
(is (null error)))) (is (null error))))
#+end_src #+end_src
@@ -176,7 +176,7 @@ REPL Skill Commands:
(test test-repl-eval-error (test test-repl-eval-error
"Test that errors are caught and returned." "Test that errors are caught and returned."
(multiple-value-bind (result output error) (multiple-value-bind (result output error)
(opencortex:repl-eval "(+ 1 \"string\")") (passepartout:repl-eval "(+ 1 \"string\")")
(is (null result)) (is (null result))
(is (not (null error))))) (is (not (null error)))))
#+end_src #+end_src
@@ -203,7 +203,7 @@ The REPL skill loads at priority 200 (after diagnostics at 100, before utils-lis
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-repl (defskill :passepartout-programming-repl
:priority 200 :priority 200
:trigger (lambda (ctx) (declare (ignore ctx)) nil) :trigger (lambda (ctx) (declare (ignore ctx)) nil)
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil) :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)

10
skills/org-skill-engineering-standards.org → org/programming-standards.org
View File

@@ -2,7 +2,7 @@
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :system:engineering:chaos: #+FILETAGS: :system:engineering:chaos:
#+DEPENDS_ON: org-skill-utils-lisp #+DEPENDS_ON: org-skill-utils-lisp
#+PROPERTY: header-args:lisp :tangle org-skill-engineering-standards.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/programming-standards.lisp
* Overview * Overview
The *Engineering Standards Skill* defines the REPL-first engineering lifecycle and enforces technical invariants, including the **Commit-Before-Modify** rule and **Chaos-Driven Development**. The *Engineering Standards Skill* defines the REPL-first engineering lifecycle and enforces technical invariants, including the **Commit-Before-Modify** rule and **Chaos-Driven Development**.
@@ -63,28 +63,28 @@ Rationale: The two tracks prevent the two failure modes we have observed. Writin
** Standards Enforcement ** Standards Enforcement
#+begin_src lisp #+begin_src lisp
(defun verify-git-clean-p (dir) (defun standards-git-clean-p (dir)
"Checks if a directory has uncommitted changes." "Checks if a directory has uncommitted changes."
(let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain") (let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain")
:output :string :output :string
:ignore-error-status t))) :ignore-error-status t)))
(string= "" (string-trim '(#\Space #\Newline #\Tab) status)))) (string= "" (string-trim '(#\Space #\Newline #\Tab) status))))
(defun engineering-standards-verify-lisp (code) (defun standards-lisp-verify (code)
"Enforces Lisp structural and semantic standards using utils-lisp." "Enforces Lisp structural and semantic standards using utils-lisp."
(let ((result (utils-lisp-validate code :strict t))) (let ((result (utils-lisp-validate code :strict t)))
(if (eq (getf result :status) :success) (if (eq (getf result :status) :success)
t t
(error (getf result :reason))))) (error (getf result :reason)))))
(defun engineering-standards-format-lisp (code) (defun standards-lisp-format (code)
"Ensures Lisp code adheres to formatting standards." "Ensures Lisp code adheres to formatting standards."
(utils-lisp-format code)) (utils-lisp-format code))
#+end_src #+end_src
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-engineering-standards (defskill :passepartout-programming-standards
:priority 100 :priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src #+end_src

156
skills/org-skill-bouncer.org → org/security-dispatcher.org
View File

@@ -1,25 +1,43 @@
#+TITLE: SKILL: Bouncer (org-skill-bouncer.org) #+TITLE: SKILL: Bouncer (org-skill-bouncer.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :system:bouncer:authorization:autonomy: #+FILETAGS: :system:bouncer:authorization:autonomy:
#+PROPERTY: header-args:lisp :tangle org-skill-bouncer.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/security-dispatcher.lisp
* Overview * Deep Reasoning: Beyond Permission
The *Bouncer Skill* is the physical security layer of OpenCortex. It enforces operational security checks on all proposed actions.
The Bouncer is the physical security layer of Passepartout. While the Policy skill ensures an action is "legal" (e.g., "Yes, you are allowed to send a Telegram message"), the Bouncer ensures the action is "safe" by inspecting the payload content via Deep Packet Inspection.
Every action that reaches the Bouncer has already been approved by the Reasoning pipeline. The LLM generated it, the deterministic gates verified it, and the Act stage is about to execute it. The Bouncer is the last gate before the action touches the physical world.
The Bouncer inspects nine vectors:
1. **REPL verification** — warns if a defun is written without REPL prototyping
2. **Lisp syntax** — blocks writes with unbalanced parens
3. **Secret paths** — blocks reads to ~.env~, SSH keys, PEM files, etc.
4. **Content exposure** — scans for API keys, PGP blocks, tokens
5. **Vault secrets** — matches against stored credentials
6. **Privacy tags** — blocks ~@personal~ tagged content
7. **Privacy text** — warns if text references privacy tag names
8. **Shell safety** — blocks destructive commands and injection patterns
9. **Network exfil** — blocks unwhitelisted outbound connections
The Bouncer also handles the **Flight Plan** system: when a high-risk action is blocked, it creates a Flight Plan node in the Org files that the user can manually approve.
* Implementation
* Implementation * Implementation
** Security Configuration — network whitelist ** Security Configuration — network whitelist
Domains that the Bouncer considers safe for outbound connections. Network calls to unlisted domains are blocked or queued for approval. Domains that the Bouncer considers safe for outbound connections. Network calls to unlisted domains are blocked or queued for approval.
#+begin_src lisp #+begin_src lisp
(defvar *bouncer-network-whitelist* (defvar *dispatcher-network-whitelist*
'("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com") '("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")
"Domains the Bouncer considers safe for outbound connections.") "Domains the Bouncer considers safe for outbound connections.")
#+end_src #+end_src
** Privacy filter tags (bouncer-privacy-tags) ** Privacy filter tags (*dispatcher-privacy-tags*)
List of tag strings that mark content as private. Content with these tags is filtered from the LLM context window. Configurable via ~PRIVACY_FILTER_TAGS~ env var. List of tag strings that mark content as private. Content with these tags is filtered from the LLM context window. Configurable via ~PRIVACY_FILTER_TAGS~ env var.
#+begin_src lisp #+begin_src lisp
(defvar bouncer-privacy-tags (defvar *dispatcher-privacy-tags*
(let ((env (uiop:getenv "PRIVACY_FILTER_TAGS"))) (let ((env (uiop:getenv "PRIVACY_FILTER_TAGS")))
(if env (if env
(uiop:split-string env :separator '(#\,)) (uiop:split-string env :separator '(#\,))
@@ -27,10 +45,10 @@ List of tag strings that mark content as private. Content with these tags is fil
"Tags marking content as private. Set via PRIVACY_FILTER_TAGS.") "Tags marking content as private. Set via PRIVACY_FILTER_TAGS.")
#+end_src #+end_src
** Protected file paths (bouncer-protected-paths) ** Protected file paths (*dispatcher-protected-paths*)
Path patterns (with * wildcards) that are blocked from file reads. Covers SSH keys, PEM/PGP files, credentials, tokens, env files, and cloud configs. Path patterns (with * wildcards) that are blocked from file reads. Covers SSH keys, PEM/PGP files, credentials, tokens, env files, and cloud configs.
#+begin_src lisp #+begin_src lisp
(defvar bouncer-protected-paths (defvar *dispatcher-protected-paths*
'(".env" ".env.example" ".env.local" ".env.production" '(".env" ".env.example" ".env.local" ".env.production"
"*credentials*" "*cred*" "*credentials*" "*cred*"
"*id_rsa*" "*id_dsa*" "*id_ecdsa*" "*id_ed25519*" "*id_rsa*" "*id_dsa*" "*id_ecdsa*" "*id_ed25519*"
@@ -45,10 +63,10 @@ Path patterns (with * wildcards) that are blocked from file reads. Covers SSH ke
"Path patterns blocked from file reads.") "Path patterns blocked from file reads.")
#+end_src #+end_src
** Content exposure patterns (bouncer-exposure-patterns) ** Content exposure patterns (*dispatcher-exposure-patterns*)
Named regex patterns for scanning content for secret exposure. Each entry is a (name regex) pair. Matches are reported by name so downstream code can act on specific categories. Named regex patterns for scanning content for secret exposure. Each entry is a (name regex) pair. Matches are reported by name so downstream code can act on specific categories.
#+begin_src lisp #+begin_src lisp
(defvar bouncer-exposure-patterns (defvar *dispatcher-exposure-patterns*
'((:pem-key "-----BEGIN +(RSA|DSA|EC|OPENSSH|PGP) +PRIVATE +KEY *-----") '((:pem-key "-----BEGIN +(RSA|DSA|EC|OPENSSH|PGP) +PRIVATE +KEY *-----")
(:pgp-key "-----BEGIN +PGP +PRIVATE +KEY +BLOCK-----") (:pgp-key "-----BEGIN +PGP +PRIVATE +KEY +BLOCK-----")
(:pgp-public "-----BEGIN +PGP +PUBLIC +KEY +BLOCK-----") (:pgp-public "-----BEGIN +PGP +PUBLIC +KEY +BLOCK-----")
@@ -64,21 +82,21 @@ Named regex patterns for scanning content for secret exposure. Each entry is a (
** Shell safety — timeout ** Shell safety — timeout
Maximum seconds a shell command is allowed to run before being killed. Maximum seconds a shell command is allowed to run before being killed.
#+begin_src lisp #+begin_src lisp
(defvar *bouncer-shell-timeout* 30 (defvar *dispatcher-shell-timeout* 30
"Maximum seconds for a shell command before timeout.") "Maximum seconds for a shell command before timeout.")
#+end_src #+end_src
** Shell safety — output limit ** Shell safety — output limit
Maximum characters of shell command output to capture. Prevents memory exhaustion from infinite output. Maximum characters of shell command output to capture. Prevents memory exhaustion from infinite output.
#+begin_src lisp #+begin_src lisp
(defvar *bouncer-shell-max-output* 100000 (defvar *dispatcher-shell-max-output* 100000
"Maximum characters of shell output to capture.") "Maximum characters of shell output to capture.")
#+end_src #+end_src
** Shell safety — blocked patterns ** Shell safety — blocked patterns
Destructive and injection patterns that are blocked in shell commands. Covers ~rm -rf /~, ~dd~, ~mkfs~, ~shred~, backtick injection, and ~$()~ subshell injection. Destructive and injection patterns that are blocked in shell commands. Covers ~rm -rf /~, ~dd~, ~mkfs~, ~shred~, backtick injection, and ~$()~ subshell injection.
#+begin_src lisp #+begin_src lisp
(defvar *bouncer-shell-blocked-patterns* (defvar *dispatcher-shell-blocked*
'((:destructive-rm "\\brm\\s+-rf\\s+/") '((:destructive-rm "\\brm\\s+-rf\\s+/")
(:destructive-dd "\\bdd\\s+if=") (:destructive-dd "\\bdd\\s+if=")
(:destructive-mkfs "\\bmkfs\\.") (:destructive-mkfs "\\bmkfs\\.")
@@ -90,31 +108,31 @@ Destructive and injection patterns that are blocked in shell commands. Covers ~r
"Destructive and injection patterns blocked in shell commands.") "Destructive and injection patterns blocked in shell commands.")
#+end_src #+end_src
** Secret Path Check (bouncer-check-secret-path) ** Secret Path Check (dispatcher-check-secret-path)
#+begin_src lisp #+begin_src lisp
(defun bouncer-wildcard-match (pattern path) (defun wildcard-match (pattern path)
"Matches PATH against PATTERN where * matches any characters." "Matches PATH against PATTERN where * matches any characters."
(let ((regex (cl-ppcre:regex-replace-all (let ((regex (cl-ppcre:regex-replace-all
"\\*" (cl-ppcre:quote-meta-chars pattern) ".*"))) "\\*" (cl-ppcre:quote-meta-chars pattern) ".*")))
(cl-ppcre:scan regex path))) (cl-ppcre:scan regex path)))
(defun bouncer-check-secret-path (filepath) (defun dispatcher-check-secret-path (filepath)
"Returns the matching pattern if FILEPATH matches a protected path, nil otherwise." "Returns the matching pattern if FILEPATH matches a protected path, nil otherwise."
(when (and filepath (stringp filepath)) (when (and filepath (stringp filepath))
(some (lambda (pattern) (some (lambda (pattern)
(when (bouncer-wildcard-match pattern filepath) (when (wildcard-match pattern filepath)
pattern)) pattern))
bouncer-protected-paths))) *dispatcher-protected-paths*)))
#+end_src #+end_src
** Content Exposure Scanner (bouncer-scan-exposure) ** Content Exposure Scanner (dispatcher-exposure-scan)
#+begin_src lisp #+begin_src lisp
(defun bouncer-scan-exposure (text) (defun dispatcher-exposure-scan (text)
"Scans TEXT for patterns matching known secret formats. "Scans TEXT for patterns matching known secret formats.
Returns a list of matched category keywords." Returns a list of matched category keywords."
(when (and text (stringp text) (> (length text) 0)) (when (and text (stringp text) (> (length text) 0))
(let ((matches nil)) (let ((matches nil))
(dolist (entry bouncer-exposure-patterns) (dolist (entry *dispatcher-exposure-patterns*)
(let ((name (first entry)) (let ((name (first entry))
(regex (second entry))) (regex (second entry)))
(when (cl-ppcre:scan regex text) (when (cl-ppcre:scan regex text)
@@ -122,9 +140,9 @@ Returns a list of matched category keywords."
matches))) matches)))
#+end_src #+end_src
** Vault Secret Scanning (bouncer-scan-secrets) ** Vault Secret Scanning (dispatcher-vault-scan)
#+begin_src lisp #+begin_src lisp
(defun bouncer-scan-secrets (text) (defun dispatcher-vault-scan (text)
"Scans TEXT for known secrets from the vault." "Scans TEXT for known secrets from the vault."
(when (and text (stringp text)) (when (and text (stringp text))
(let ((found-secret nil)) (let ((found-secret nil))
@@ -136,30 +154,30 @@ Returns a list of matched category keywords."
found-secret))) found-secret)))
#+end_src #+end_src
** Privacy Tag Check (bouncer-check-privacy-tags) ** Privacy Tag Check (dispatcher-check-privacy-tags)
#+begin_src lisp #+begin_src lisp
(defun bouncer-check-privacy-tags (tags-list) (defun dispatcher-check-privacy-tags (tags-list)
"Returns T if any tag in TAGS-LIST matches a privacy filter tag." "Returns T if any tag in TAGS-LIST matches a privacy filter tag."
(when (and tags-list (listp tags-list)) (when (and tags-list (listp tags-list))
(some (lambda (tag) (some (lambda (tag)
(some (lambda (private) (some (lambda (private)
(or (string-equal tag private) (or (string-equal tag private)
(search private tag :test #'string-equal))) (search private tag :test #'string-equal)))
bouncer-privacy-tags)) *dispatcher-privacy-tags*))
tags-list))) tags-list)))
(defun bouncer-check-text-for-privacy (text) (defun dispatcher-check-text-for-privacy (text)
"Scans TEXT for leaked privacy-tagged content." "Scans TEXT for leaked privacy-tagged content."
(when (and text (stringp text)) (when (and text (stringp text))
(let ((lower (string-downcase text))) (let ((lower (string-downcase text)))
(some (lambda (tag) (some (lambda (tag)
(search (string-downcase tag) lower)) (search (string-downcase tag) lower))
bouncer-privacy-tags)))) *dispatcher-privacy-tags*))))
#+end_src #+end_src
** Lisp Validation Gate (bouncer-check-lisp-valid) ** Lisp Validation Gate (dispatcher-check-lisp-valid)
#+begin_src lisp #+begin_src lisp
(defun bouncer-extract-org-lisp-blocks (content) (defun org-blocks-extract (content)
"Extracts concatenated Lisp code from #+begin_src lisp blocks in an Org string." "Extracts concatenated Lisp code from #+begin_src lisp blocks in an Org string."
(when (and content (stringp content)) (when (and content (stringp content))
(let ((lines (uiop:split-string content :separator '(#\Newline))) (let ((lines (uiop:split-string content :separator '(#\Newline)))
@@ -176,14 +194,14 @@ Returns a list of matched category keywords."
(setf code (concatenate 'string code line (string #\Newline))))))) (setf code (concatenate 'string code line (string #\Newline)))))))
(when (> (length code) 0) code)))) (when (> (length code) 0) code))))
(defun bouncer-check-lisp-valid (filepath content) (defun dispatcher-check-lisp-valid (filepath content)
"Validates Lisp syntax when writing .lisp files or Org files with lisp blocks. "Validates Lisp syntax when writing .lisp files or Org files with lisp blocks.
Returns the validation result plist or nil if not applicable." Returns the validation result plist or nil if not applicable."
(when (and content (stringp content) (> (length content) 0)) (when (and content (stringp content) (> (length content) 0))
(let ((to-validate (let ((to-validate
(cond (cond
((uiop:string-suffix-p filepath ".lisp") content) ((uiop:string-suffix-p filepath ".lisp") content)
((uiop:string-suffix-p filepath ".org") (bouncer-extract-org-lisp-blocks content)) ((uiop:string-suffix-p filepath ".org") (org-blocks-extract content))
(t nil)))) (t nil))))
(when to-validate (when to-validate
(multiple-value-bind (valid-p err) (ignore-errors (multiple-value-bind (valid-p err) (ignore-errors
@@ -195,33 +213,33 @@ Returns the validation result plist or nil if not applicable."
(list :status :error :reason err))))))) (list :status :error :reason err)))))))
#+end_src #+end_src
** REPL Verification Gate (bouncer-check-repl-verified) ** REPL Verification Gate (dispatcher-check-repl-verified)
#+begin_src lisp #+begin_src lisp
(defun bouncer-org-contains-defuns-p (content) (defun org-has-defuns-p (content)
"Returns T if the Org content contains any #+begin_src lisp blocks with defuns." "Returns T if the Org content contains any #+begin_src lisp blocks with defuns."
(when (and content (stringp content)) (when (and content (stringp content))
(search "defun " content :test #'char-equal))) (search "defun " content :test #'char-equal)))
(defun bouncer-check-repl-verified (action filepath content) (defun dispatcher-check-repl-verified (action filepath content)
"Warns if writing a defun to an Org file without :repl-verified metadata." "Warns if writing a defun to an Org file without :repl-verified metadata."
(let ((repl-verified (getf action :repl-verified))) (let ((repl-verified (getf action :repl-verified)))
(when (and filepath (when (and filepath
(uiop:string-suffix-p filepath ".org") (uiop:string-suffix-p filepath ".org")
(bouncer-org-contains-defuns-p content) (org-has-defuns-p content)
(not repl-verified)) (not repl-verified))
(list :type :LOG (list :type :LOG
:payload (list :level :warn :payload (list :level :warn
:text (format nil "Lint: Writing defun to ~a without :repl-verified flag. Did you prototype this in the REPL first?" filepath)))))) :text (format nil "Lint: Writing defun to ~a without :repl-verified flag. Did you prototype this in the REPL first?" filepath))))))
#+end_src #+end_src
** Shell Safety Check (bouncer-check-shell-safety) ** Shell Safety Check (dispatcher-check-shell-safety)
#+begin_src lisp #+begin_src lisp
(defun bouncer-check-shell-safety (cmd) (defun dispatcher-check-shell-safety (cmd)
"Checks a shell command for destructive patterns and injection vectors. "Checks a shell command for destructive patterns and injection vectors.
Returns a list of matched pattern names or nil if safe." Returns a list of matched pattern names or nil if safe."
(when (and cmd (stringp cmd) (> (length cmd) 0)) (when (and cmd (stringp cmd) (> (length cmd) 0))
(let ((matches nil)) (let ((matches nil))
(dolist (entry *bouncer-shell-blocked-patterns*) (dolist (entry *dispatcher-shell-blocked*)
(let ((name (first entry)) (let ((name (first entry))
(regex (second entry))) (regex (second entry)))
(when (cl-ppcre:scan regex cmd) (when (cl-ppcre:scan regex cmd)
@@ -229,9 +247,9 @@ Returns a list of matched pattern names or nil if safe."
matches))) matches)))
#+end_src #+end_src
** Network Check (bouncer-check-network-exfil) ** Network Check (dispatcher-check-network-exfil)
#+begin_src lisp #+begin_src lisp
(defun bouncer-check-network-exfil (cmd) (defun dispatcher-check-network-exfil (cmd)
"Detects if CMD attempts to contact an unwhitelisted external host." "Detects if CMD attempts to contact an unwhitelisted external host."
(when (and cmd (stringp cmd)) (when (and cmd (stringp cmd))
(multiple-value-bind (match regs) (multiple-value-bind (match regs)
@@ -240,12 +258,12 @@ Returns a list of matched pattern names or nil if safe."
(when regs (when regs
(let ((domain (aref regs 1))) (let ((domain (aref regs 1)))
(not (some (lambda (safe) (search safe domain)) (not (some (lambda (safe) (search safe domain))
*bouncer-network-whitelist*))))))) *dispatcher-network-whitelist*)))))))
#+end_src #+end_src
** Main Security Gate (bouncer-check) ** Main Security Gate (dispatcher-check)
#+begin_src lisp #+begin_src lisp
(defun bouncer-check (action context) (defun dispatcher-check (action context)
"Security gate for high-risk actions. "Security gate for high-risk actions.
Vectors: lisp validation, secret path, secret content, vault secrets, Vectors: lisp validation, secret path, secret content, vault secrets,
privacy tags, privacy text, shell safety, network exfil, high-impact approval." privacy tags, privacy text, shell safety, network exfil, high-impact approval."
@@ -265,9 +283,9 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
(approved (proto-get action :approved)) (approved (proto-get action :approved))
(tags (proto-get payload :tags)) (tags (proto-get payload :tags))
(lisp-valid (when (and filepath content (not approved)) (lisp-valid (when (and filepath content (not approved))
(bouncer-check-lisp-valid filepath content))) (dispatcher-check-lisp-valid filepath content)))
(repl-lint (when (and filepath content (not approved)) (repl-lint (when (and filepath content (not approved))
(bouncer-check-repl-verified action filepath content)))) (dispatcher-check-repl-verified action filepath content))))
(cond (cond
(approved action) (approved action)
@@ -284,46 +302,46 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
:text (format nil "Lisp syntax error in ~a: ~a. The write was blocked. Fix the parenthesis balance and retry." filepath (getf lisp-valid :reason))))) :text (format nil "Lisp syntax error in ~a: ~a. The write was blocked. Fix the parenthesis balance and retry." filepath (getf lisp-valid :reason)))))
;; Vector 2: File read to a protected secret path ;; Vector 2: File read to a protected secret path
((and filepath (bouncer-check-secret-path filepath)) ((and filepath (dispatcher-check-secret-path filepath))
(let ((matched (bouncer-check-secret-path filepath))) (let ((matched (dispatcher-check-secret-path filepath)))
(harness-log "SECURITY VIOLATION: Blocked read of protected path '~a' (matched: ~a)" filepath matched) (harness-log "SECURITY VIOLATION: Blocked read of protected path '~a' (matched: ~a)" filepath matched)
(list :type :LOG (list :type :LOG
:payload (list :level :error :payload (list :level :error
:text (format nil "Action blocked: Attempted read of protected path '~a'" filepath))))) :text (format nil "Action blocked: Attempted read of protected path '~a'" filepath)))))
;; Vector 3: Content contains secret patterns ;; Vector 3: Content contains secret patterns
((and text (bouncer-scan-exposure text)) ((and text (dispatcher-exposure-scan text))
(let ((matched (bouncer-scan-exposure text))) (let ((matched (dispatcher-exposure-scan text)))
(harness-log "SECURITY VIOLATION: Content contains secret patterns: ~a" matched) (harness-log "SECURITY VIOLATION: Content contains secret patterns: ~a" matched)
(list :type :LOG (list :type :LOG
:payload (list :level :error :payload (list :level :error
:text "Action blocked: Content contains potential secret exposure.")))) :text "Action blocked: Content contains potential secret exposure."))))
;; Vector 4: Content contains vault secrets ;; Vector 4: Content contains vault secrets
((and text (bouncer-scan-secrets text)) ((and text (dispatcher-vault-scan text))
(let ((secret-name (bouncer-scan-secrets text))) (let ((secret-name (dispatcher-vault-scan text)))
(harness-log "SECURITY VIOLATION: Blocked potential leak of secret '~a'" secret-name) (harness-log "SECURITY VIOLATION: Blocked potential leak of secret '~a'" secret-name)
(list :type :LOG (list :type :LOG
:payload (list :level :error :payload (list :level :error
:text (format nil "Action blocked: Potential exposure of '~a'" secret-name))))) :text (format nil "Action blocked: Potential exposure of '~a'" secret-name)))))
;; Vector 5: Privacy-tagged content in action ;; Vector 5: Privacy-tagged content in action
((and tags (bouncer-check-privacy-tags tags)) ((and tags (dispatcher-check-privacy-tags tags))
(harness-log "PRIVACY VIOLATION: Action contains privacy-tagged content") (harness-log "PRIVACY VIOLATION: Action contains privacy-tagged content")
(list :type :LOG (list :type :LOG
:payload (list :level :warn :payload (list :level :warn
:text "Action blocked: Content tagged with privacy filter."))) :text "Action blocked: Content tagged with privacy filter.")))
;; Vector 6: Text leaks privacy tag names ;; Vector 6: Text leaks privacy tag names
((and text (bouncer-check-text-for-privacy text)) ((and text (dispatcher-check-text-for-privacy text))
(harness-log "PRIVACY WARNING: Text may contain leaked private content") (harness-log "PRIVACY WARNING: Text may contain leaked private content")
(list :type :LOG (list :type :LOG
:payload (list :level :warn :payload (list :level :warn
:text "Action blocked: Text may reference private content."))) :text "Action blocked: Text may reference private content.")))
;; Vector 7: Shell destructive/injection patterns ;; Vector 7: Shell destructive/injection patterns
((and cmd (bouncer-check-shell-safety cmd)) ((and cmd (dispatcher-check-shell-safety cmd))
(let ((matched (bouncer-check-shell-safety cmd))) (let ((matched (dispatcher-check-shell-safety cmd)))
(harness-log "SHELL VIOLATION: Destructive or injection pattern in command: ~a" matched) (harness-log "SHELL VIOLATION: Destructive or injection pattern in command: ~a" matched)
(list :type :LOG (list :type :LOG
:payload (list :level :error :payload (list :level :error
@@ -332,7 +350,7 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
;; Vector 8: Network exfiltration ;; Vector 8: Network exfiltration
((and (or (eq target :shell) ((and (or (eq target :shell)
(and (eq target :tool) (equal (proto-get payload :tool) "shell"))) (and (eq target :tool) (equal (proto-get payload :tool) "shell")))
(bouncer-check-network-exfil cmd)) (dispatcher-check-network-exfil cmd))
(harness-log "SECURITY WARNING: External network call detected. Queuing for approval.") (harness-log "SECURITY WARNING: External network call detected. Queuing for approval.")
(list :type :EVENT :payload (list :sensor :approval-required :action action))) (list :type :EVENT :payload (list :sensor :approval-required :action action)))
@@ -346,9 +364,9 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
#+end_src #+end_src
** Approval Processing (bouncer-process-approvals) ** Approval Processing (dispatcher-approvals-process)
#+begin_src lisp #+begin_src lisp
(defun bouncer-process-approvals () (defun dispatcher-approvals-process ()
"Scans for APPROVED flight plans and re-injects them." "Scans for APPROVED flight plans and re-injects them."
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED")) (let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
(found-any nil)) (found-any nil))
@@ -367,9 +385,9 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
found-any)) found-any))
#+end_src #+end_src
** Flight Plan Creation (bouncer-create-flight-plan) ** Flight Plan Creation (dispatcher-flight-plan-create)
#+begin_src lisp #+begin_src lisp
(defun bouncer-create-flight-plan (blocked-action) (defun dispatcher-flight-plan-create (blocked-action)
"Creates a Flight Plan node for manual approval." "Creates a Flight Plan node for manual approval."
(let ((id (org-id-new))) (let ((id (org-id-new)))
(harness-log "BOUNCER: Creating flight plan node '~a'..." id) (harness-log "BOUNCER: Creating flight plan node '~a'..." id)
@@ -380,26 +398,26 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
:ACTION (format nil "~s" blocked-action)))))) :ACTION (format nil "~s" blocked-action))))))
#+end_src #+end_src
** Gate Logic (bouncer-deterministic-gate) ** Gate Logic (dispatcher-gate)
#+begin_src lisp #+begin_src lisp
(defun bouncer-deterministic-gate (action context) (defun dispatcher-gate (action context)
"Main deterministic gate for the Bouncer skill." "Main deterministic gate for the Bouncer skill."
(let* ((payload (getf context :payload)) (let* ((payload (getf context :payload))
(sensor (getf payload :sensor))) (sensor (getf payload :sensor)))
(case sensor (case sensor
(:approval-required (:approval-required
(bouncer-create-flight-plan (getf payload :action))) (dispatcher-flight-plan-create (getf payload :action)))
(:heartbeat (:heartbeat
(bouncer-process-approvals) (dispatcher-approvals-process)
(if action (bouncer-check action context) action)) (if action (dispatcher-check action context) action))
(otherwise (otherwise
(if action (bouncer-check action context) action))))) (if action (dispatcher-check action context) action)))))
#+end_src #+end_src
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-bouncer (defskill :passepartout-security-dispatcher
:priority 150 :priority 150
:trigger (lambda (ctx) (declare (ignore ctx)) t) :trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic #'bouncer-deterministic-gate) :deterministic #'dispatcher-gate)
#+end_src #+end_src

41
org/security-permissions.org Normal file
View File

@@ -0,0 +1,41 @@
#+TITLE: SKILL: Tool Permissions (org-skill-tool-permissions.org)
#+AUTHOR: Agent
#+FILETAGS: :skill:security:permissions:
#+PROPERTY: header-args:lisp :tangle ../lisp/security-permissions.lisp
* Overview: The Authorization Matrix
Every cognitive tool (file read, file write, shell execute, etc.) has a permission level: ~:allow~ (executed without asking), ~:ask~ (user is prompted before execution), or ~:deny~ (blocked entirely). Tool Permissions maintains the registry of these levels and provides the ~permission-gate-check~ that the Bouncer calls before dispatching a tool action.
The default for any unregistered tool is ~:ask~ — cautious by default, permissive by configuration. This prevents a hallucinated tool call from executing without at least giving the user a chance to review it.
* Implementation
** Permission store (tool level)
Hash table mapping tool names to their permission level.
#+begin_src lisp
(defvar *permission-table* (make-hash-table :test 'equal))
#+end_src
** Set permission
Sets the permission level for a specific cognitive tool.
#+begin_src lisp
(defun permission-set (tool-name level)
"Sets the permission level for a tool."
(setf (gethash (string-downcase (string tool-name)) *permission-table*) level))
#+end_src
** Get permission
Retrieves the current permission level for a tool. Defaults to ~:ask~ if unset.
#+begin_src lisp
(defun permission-get (tool-name)
"Retrieves the permission level for a tool. Defaults to :ask."
(gethash (string-downcase (string tool-name)) *permission-table* :ask))
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :passepartout-security-permissions
:priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src

38
org/security-policy.org Normal file
View File

@@ -0,0 +1,38 @@
#+TITLE: SKILL: Policy (org-skill-policy.org)
#+AUTHOR: Agent
#+FILETAGS: :system:policy:constitutional:
#+PROPERTY: header-args:lisp :tangle ../lisp/security-policy.lisp
* Architectural Intent: The Constitutional Layer
The Policy skill encodes the non-negotiable values of Passepartout. Every action the agent proposes must pass through this gate. If the action lacks justification, it is blocked — not because it's dangerous, but because it's opaque.
This is the "Radical Transparency" invariant in practice. The agent must explain *why* it wants to do something, not just *what* it wants to do. An action with ~:explanation "Because I said so"~ is rejected. An action with ~:explanation "The user asked me to read their TODO list and summarize it"~ passes.
The Policy skill is intentionally simple. It has one job: ensure every action has a meaningful explanation. Other security concerns (secret scanning, path blocking, network exfiltration) are handled by the Bouncer. The Policy is about values, not threats.
* Implementation
** Policy Logic (policy-compliance-check)
#+begin_src lisp
(defun policy-compliance-check (action context)
"Enforces constitutional invariants on proposed actions."
(declare (ignore context))
(let* ((payload (proto-get action :payload))
(explanation (proto-get payload :explanation)))
(if (and explanation (stringp explanation) (> (length explanation) 10))
action
(progn
(harness-log "POLICY VIOLATION: Action lacks sufficient explanation.")
(list :type :LOG
:payload (list :level :warn
:text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning."))))))
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :passepartout-security-policy
:priority 500
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic #'policy-compliance-check)
#+end_src

10
skills/org-skill-protocol-validator.org → org/security-validator.org
View File

@@ -1,29 +1,29 @@
#+TITLE: SKILL: Protocol Validator (org-skill-protocol-validator.org) #+TITLE: SKILL: Protocol Validator (org-skill-protocol-validator.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :system:protocol:validation: #+FILETAGS: :system:protocol:validation:
#+PROPERTY: header-args:lisp :tangle org-skill-protocol-validator.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/security-validator.lisp
* Overview * Overview
The *Protocol Validator* skill enforces strict schema compliance for all internal and external communication. The Protocol Validator enforces schema compliance on every message entering or leaving the cognitive pipeline. It checks that messages are valid plists, that they have the required ~:type~ and ~:payload~ fields, and that the type is one of the known types (~:REQUEST~, ~:EVENT~, ~:RESPONSE~, ~:LOG~, ~:STATUS~). This prevents malformed messages from crashing the pipeline and ensures backward compatibility when the protocol evolves.
* Implementation * Implementation
** Validation Logic ** Validation Logic
#+begin_src lisp #+begin_src lisp
(defun protocol-validate (msg) (defun validator-protocol-check (msg)
"Enforces structural schema compliance on protocol messages." "Enforces structural schema compliance on protocol messages."
(validate-communication-protocol-schema msg)) (validate-communication-protocol-schema msg))
#+end_src #+end_src
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-protocol-validator (defskill :passepartout-security-validator
:priority 95 :priority 95
:trigger (lambda (ctx) (declare (ignore ctx)) t) :trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic (lambda (action ctx) :deterministic (lambda (action ctx)
(declare (ignore ctx)) (declare (ignore ctx))
(handler-case (handler-case
(progn (protocol-validate action) action) (progn (validator-protocol-check action) action)
(error (c) (error (c)
(list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c))))))) (list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))
#+end_src #+end_src

8
skills/org-skill-credentials-vault.org → org/security-vault.org
View File

@@ -1,7 +1,7 @@
#+TITLE: SKILL: Credentials Vault (org-skill-credentials-vault.org) #+TITLE: SKILL: Credentials Vault (org-skill-credentials-vault.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :system:security:vault: #+FILETAGS: :system:security:vault:
#+PROPERTY: header-args:lisp :tangle org-skill-credentials-vault.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/security-vault.lisp
* Overview * Overview
The *Credentials Vault* provides secure in-memory storage for sensitive API keys and session tokens. The *Credentials Vault* provides secure in-memory storage for sensitive API keys and session tokens.
@@ -16,7 +16,7 @@ The *Credentials Vault* provides secure in-memory storage for sensitive API keys
** Secret Management ** Secret Management
#+begin_src lisp #+begin_src lisp
(defun vault-get-secret (provider &key (type :api-key)) (defun vault-get (provider &key (type :api-key))
"Retrieves a credential from the vault or environment." "Retrieves a credential from the vault or environment."
(let* ((key (format nil "~a-~a" provider type)) (let* ((key (format nil "~a-~a" provider type))
(val (gethash key *vault-memory*))) (val (gethash key *vault-memory*)))
@@ -30,7 +30,7 @@ The *Credentials Vault* provides secure in-memory storage for sensitive API keys
(otherwise nil)))) (otherwise nil))))
(when env-var (uiop:getenv env-var)))))) (when env-var (uiop:getenv env-var))))))
(defun vault-set-secret (provider secret &key (type :api-key)) (defun vault-set (provider secret &key (type :api-key))
"Stores a secret in the vault." "Stores a secret in the vault."
(let ((key (format nil "~a-~a" provider type))) (let ((key (format nil "~a-~a" provider type)))
(setf (gethash key *vault-memory*) secret))) (setf (gethash key *vault-memory*) secret)))
@@ -38,7 +38,7 @@ The *Credentials Vault* provides secure in-memory storage for sensitive API keys
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-credentials-vault (defskill :passepartout-security-vault
:priority 600 :priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src #+end_src

18
harness/setup.org → org/setup.org
View File

@@ -3,8 +3,16 @@
#+FILETAGS: :harness:kernel:bootstrap: #+FILETAGS: :harness:kernel:bootstrap:
#+STARTUP: content #+STARTUP: content
* Overview * Overview: Architectural Intent
The *Kernel Bootstrap* provides the absolute minimum logic required to transition from a raw POSIX shell to a functional Lisp environment.
The Kernel Bootstrap is the transition from a bare POSIX shell to a running Lisp environment. It's the only part of Passepartout that executes before the Lisp image is ready.
The bootstrap has exactly three jobs, nothing more:
1. **Directory Resolution**: Locating and creating XDG paths for config, data, and state
2. **System Tangle**: Transforming literate Org sources into runnable Lisp files
3. **Dependency Check**: Ensuring SBCL, Quicklisp, and Emacs are available
This minimal interface is deliberate. The bootstrap should NOT know about LLM providers, diagnostic suites, or gateway configuration. Those are the job of the Lisp-level setup wizard, which runs after the bootstrap is complete.
* Phase A: Demand (Thinking) * Phase A: Demand (Thinking)
** The Minimalist Kernel ** The Minimalist Kernel
@@ -20,11 +28,11 @@ To maintain sovereignty, the harness must remain a "dumb" bus. It should not kno
* Phase C: Implementation (Build) * Phase C: Implementation (Build)
** The Installer Script (opencortex.sh) ** The Installer Script (passepartout)
The shell script is the primary entry point. It handles the initial git clone, dependency installation, and literate tangle. The shell script is the primary entry point. It handles the initial git clone, dependency installation, and literate tangle.
#+begin_src bash :tangle setup.sh #+begin_src bash :tangle no
#!/bin/bash #!/bin/bash
# (The content here is a duplicate of the main opencortex.sh for literate consistency) # (The content here is a duplicate of the main passepartout for literate consistency)
# [Note: Implementation is already verified in the top-level script] # [Note: Implementation is already verified in the top-level script]
#+end_src #+end_src

0
harness/setup.sh → org/setup.sh
View File

51
org/system-actuator-shell.org Normal file
View File

@@ -0,0 +1,51 @@
#+TITLE: SKILL: Shell Actuator (org-skill-shell-actuator.org)
#+AUTHOR: Agent
#+FILETAGS: :skill:actuator:shell:
#+PROPERTY: header-args:lisp :tangle ../lisp/system-actuator-shell.lisp
* Overview: The Physical Actuator
The Shell Actuator is the agent's hand in the physical world. Given a shell command, it executes it via ~bash -c~ and returns the output. This is how the agent installs packages, reads files, runs scripts, and interacts with any Unix tool.
Because shell execution is the highest-risk operation in the system, the Shell Actuator is protected by multiple safety layers:
1. The Bouncer's shell safety gate blocks destructive commands (~rm -rf /~, ~dd~, ~mkfs~)
2. The Bouncer's injection gate blocks backtick and ~$()~ patterns
3. The Bouncer's network exfil gate blocks connections to unwhitelisted hosts
4. The actuator enforces a timeout (default 30s) so hanging commands don't freeze the agent
5. The actuator caps output (default 100KB) so infinite output doesn't exhaust memory
* Implementation
** Shell Execution (actuator-shell-execute)
#+begin_src lisp
(defun actuator-shell-execute (action context)
"Executes a bash command with timeout (via timeout(1)) and output limit."
(declare (ignore context))
(let* ((payload (getf action :payload))
(cmd (getf payload :cmd))
(timeout-sym (find-symbol "*BOUNCER-SHELL-TIMEOUT*" :passepartout))
(timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30)))
(max-sym (find-symbol "*BOUNCER-SHELL-MAX-OUTPUT*" :passepartout))
(max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))
(wrapped-cmd (format nil "timeout ~a bash -c ~s" timeout cmd)))
(harness-log "ACT [Shell]: ~a (timeout: ~as)" cmd timeout)
(multiple-value-bind (out err code)
(uiop:run-program (list "bash" "-c" wrapped-cmd)
:output :string :error-output :string
:ignore-error-status t)
(cond
((= code 124) (format nil "ERROR: Command timed out after ~a seconds" timeout))
((> (length out) max-output)
(format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output))
((= code 0) out)
(t (format nil "ERROR [~a]: ~a" code err))))))
#+end_src
** Skill Registration
#+begin_src lisp
(register-actuator :shell #'actuator-shell-execute)
(defskill :passepartout-system-actuator-shell
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src

8
skills/org-skill-scribe.org → org/system-archivist.org
View File

@@ -1,7 +1,7 @@
#+TITLE: SKILL: Scribe (org-skill-scribe.org) #+TITLE: SKILL: Scribe (org-skill-scribe.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :skill:scribe:documentation: #+FILETAGS: :skill:scribe:documentation:
#+PROPERTY: header-args:lisp :tangle org-skill-scribe.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/system-archivist.lisp
* Overview * Overview
The *Scribe Skill* manages the agent's internal documentation and logs. The *Scribe Skill* manages the agent's internal documentation and logs.
@@ -10,7 +10,7 @@ The *Scribe Skill* manages the agent's internal documentation and logs.
** Documentation Logic ** Documentation Logic
#+begin_src lisp #+begin_src lisp
(defun scribe-log-event (signal) (defun archivist-log (signal)
"Logs a metabolic signal for later analysis." "Logs a metabolic signal for later analysis."
(let ((type (getf signal :type)) (let ((type (getf signal :type))
(payload (getf signal :payload))) (payload (getf signal :payload)))
@@ -19,8 +19,8 @@ The *Scribe Skill* manages the agent's internal documentation and logs.
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-scribe (defskill :passepartout-system-archivist
:priority 100 :priority 100
:trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :STATUS))) :trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :STATUS)))
:deterministic (lambda (action ctx) (declare (ignore action)) (scribe-log-event ctx) nil)) :deterministic (lambda (action ctx) (declare (ignore action)) (archivist-log ctx) nil))
#+end_src #+end_src

78
skills/org-skill-config-manager.org → org/system-config.org
View File

@@ -1,43 +1,43 @@
#+TITLE: SKILL: Config Manager (org-skill-config-manager.org) #+TITLE: SKILL: Config Manager (org-skill-config-manager.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :skill:setup:config: #+FILETAGS: :skill:setup:config:
#+PROPERTY: header-args:lisp :tangle org-skill-config-manager.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/system-config.lisp
* Overview * Overview
The *Config Manager* skill provides the OpenCortex Agent with the capability to manage its own environment variables and provider configurations. It includes an interactive setup wizard for LLM providers, gateways, and system settings. The *Config Manager* skill provides the Passepartout Agent with the capability to manage its own environment variables and provider configurations. It includes an interactive setup wizard for LLM providers, gateways, and system settings.
* Implementation * Implementation
** Configuration directory (get-oc-config-dir) ** Configuration directory (config-directory)
Resolves the XDG config directory for OpenCortex. Resolves the XDG config directory for Passepartout.
#+begin_src lisp #+begin_src lisp
(defun get-oc-config-dir () (defun config-directory ()
"Returns the absolute path to the opencortex config directory." "Returns the absolute path to the opencortex config directory."
(let ((xdg (uiop:getenv "OC_CONFIG_DIR"))) (let ((xdg (uiop:getenv "OC_CONFIG_DIR")))
(if xdg xdg (namestring (merge-pathnames ".config/opencortex/" (user-homedir-pathname)))))) (if xdg xdg (namestring (merge-pathnames ".config/passepartout/" (user-homedir-pathname))))))
#+end_src #+end_src
** Config file path (get-config-file) ** Config file path (config-file-path)
Returns the path to the ~.env~ file within the config directory. Returns the path to the ~.env~ file within the config directory.
#+begin_src lisp #+begin_src lisp
(defun get-config-file () (defun config-file-path ()
"Returns the path to the .env configuration file." "Returns the path to the .env configuration file."
(merge-pathnames ".env" (get-oc-config-dir))) (merge-pathnames ".env" (config-directory)))
#+end_src #+end_src
** Ensure config directory (ensure-config-dir) ** Ensure config directory (config-directory-ensure)
Creates the config directory tree if it does not exist. Creates the config directory tree if it does not exist.
#+begin_src lisp #+begin_src lisp
(defun ensure-config-dir () (defun config-directory-ensure ()
"Creates the configuration directory if it does not exist." "Creates the configuration directory if it does not exist."
(ensure-directories-exist (get-oc-config-dir))) (ensure-directories-exist (config-directory)))
#+end_src #+end_src
** Config File Operations ** Config File Operations
#+begin_src lisp #+begin_src lisp
(defun read-config-file () (defun config-read ()
"Reads the .env config file and returns an alist of KEY=VALUE pairs." "Reads the .env config file and returns an alist of KEY=VALUE pairs."
(let ((config-file (get-config-file))) (let ((config-file (config-file-path)))
(when (uiop:file-exists-p config-file) (when (uiop:file-exists-p config-file)
(let ((lines (uiop:read-file-lines config-file)) (let ((lines (uiop:read-file-lines config-file))
(result nil)) (result nil))
@@ -51,30 +51,30 @@ Creates the config directory tree if it does not exist.
(push (cons key value) result)))))) (push (cons key value) result))))))
(nreverse result))))) (nreverse result)))))
(defun write-config-file (config-alist) (defun config-write (config-alist)
"Writes the config alist to the .env file." "Writes the config alist to the .env file."
(ensure-config-dir) (config-directory-ensure)
(let ((config-file (get-config-file))) (let ((config-file (config-file-path)))
(with-open-file (stream config-file :direction :output :if-exists :supersede :if-does-not-exist :create) (with-open-file (stream config-file :direction :output :if-exists :supersede :if-does-not-exist :create)
(format stream "# OpenCortex Configuration~%") (format stream "# Passepartout Configuration~%")
(format stream "# Generated by opencortex setup~%~%") (format stream "# Generated by opencortex setup~%~%")
(dolist (pair config-alist) (dolist (pair config-alist)
(format stream "~a=~a~%" (car pair) (cdr pair)))))) (format stream "~a=~a~%" (car pair) (cdr pair))))))
(defun get-config-value (key) (defun config-get (key)
"Gets a config value by key." "Gets a config value by key."
(let ((config (read-config-file))) (let ((config (config-read)))
(cdr (assoc key config :test #'string=)))) (cdr (assoc key config :test #'string=))))
(defun set-config-value (key value) (defun config-set (key value)
"Sets a config value and saves to file." "Sets a config value and saves to file."
(let ((config (read-config-file)) (let ((config (config-read))
(pair (cons key value))) (pair (cons key value)))
(let ((existing (assoc key config :test #'string=))) (let ((existing (assoc key config :test #'string=)))
(if existing (if existing
(setf (cdr existing) value) (setf (cdr existing) value)
(push pair config)) (push pair config))
(write-config-file config)))) (config-write config))))
#+end_src #+end_src
** Input Utilities ** Input Utilities
@@ -124,7 +124,7 @@ Creates the config directory tree if it does not exist.
(format t "==================================================~%~%") (format t "==================================================~%~%")
(let ((current-providers (loop for (name . key) in *available-providers* (let ((current-providers (loop for (name . key) in *available-providers*
when (get-config-value key) when (config-get key)
collect name))) collect name)))
(when current-providers (when current-providers
(format t "Current providers: ~{~a~^, ~}~%~%" current-providers)) (format t "Current providers: ~{~a~^, ~}~%~%" current-providers))
@@ -142,12 +142,12 @@ Creates the config directory tree if it does not exist.
(progn (progn
(format t "Enter Ollama URL (e.g., http://localhost:11434): ") (format t "Enter Ollama URL (e.g., http://localhost:11434): ")
(let ((url (read-line))) (let ((url (read-line)))
(set-config-value env-key url) (config-set env-key url)
(format t "✓ Ollama configured at ~a~%" url))) (format t "✓ Ollama configured at ~a~%" url)))
(progn (progn
(format t "Enter API key for ~a: " chosen) (format t "Enter API key for ~a: " chosen)
(let ((key (read-line))) (let ((key (read-line)))
(set-config-value env-key key) (config-set env-key key)
(format t "✓ ~a API key saved~%" chosen))))))))) (format t "✓ ~a API key saved~%" chosen)))))))))
(format t "~%")) (format t "~%"))
@@ -176,8 +176,8 @@ Creates the config directory tree if it does not exist.
(when chosen (when chosen
(let ((token (prompt (format nil "Enter ~a bot token: " chosen)))) (let ((token (prompt (format nil "Enter ~a bot token: " chosen))))
(if (string= chosen "Slack") (if (string= chosen "Slack")
(set-config-value "SLACK_TOKEN" token) (config-set "SLACK_TOKEN" token)
(set-config-value "DISCORD_TOKEN" token)) (config-set "DISCORD_TOKEN" token))
(format t "✓ ~a gateway configured~%" chosen))))) (format t "✓ ~a gateway configured~%" chosen)))))
(format t "~%")) (format t "~%"))
@@ -193,7 +193,7 @@ Creates the config directory tree if it does not exist.
(format t "==================================================~%~%") (format t "==================================================~%~%")
(format t "Note: Skill management is not yet implemented.~%") (format t "Note: Skill management is not yet implemented.~%")
(format t "Skills are automatically loaded from ~a~%" (or (uiop:getenv "OC_DATA_DIR") "~/.local/share/opencortex")) (format t "Skills are automatically loaded from ~a~%" (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") "~/.local/share/passepartout"))
(format t "~%")) (format t "~%"))
#+end_src #+end_src
@@ -208,11 +208,11 @@ Creates the config directory tree if it does not exist.
(let ((auto-save (prompt "Auto-save interval in seconds [300]:"))) (let ((auto-save (prompt "Auto-save interval in seconds [300]:")))
(when (and auto-save (> (length auto-save) 0)) (when (and auto-save (> (length auto-save) 0))
(set-config-value "MEMORY_AUTO_SAVE_INTERVAL" auto-save))) (config-set "MEMORY_AUTO_SAVE_INTERVAL" auto-save)))
(let ((history (prompt "History retention in lines [1000]:"))) (let ((history (prompt "History retention in lines [1000]:")))
(when (and history (> (length history) 0)) (when (and history (> (length history) 0))
(set-config-value "MEMORY_HISTORY_RETENTION" history))) (config-set "MEMORY_HISTORY_RETENTION" history)))
(format t "✓ Memory settings saved~%") (format t "✓ Memory settings saved~%")
(format t "~%")) (format t "~%"))
@@ -229,11 +229,11 @@ Creates the config directory tree if it does not exist.
(let ((timeout (prompt "Request timeout in seconds [30]:"))) (let ((timeout (prompt "Request timeout in seconds [30]:")))
(when (and timeout (> (length timeout) 0)) (when (and timeout (> (length timeout) 0))
(set-config-value "REQUEST_TIMEOUT" timeout))) (config-set "REQUEST_TIMEOUT" timeout)))
(let ((proxy (prompt "Proxy URL (leave empty for none) []:"))) (let ((proxy (prompt "Proxy URL (leave empty for none) []:")))
(when (and proxy (> (length proxy) 0)) (when (and proxy (> (length proxy) 0))
(set-config-value "HTTP_PROXY" proxy))) (config-set "HTTP_PROXY" proxy)))
(format t "✓ Network settings saved~%") (format t "✓ Network settings saved~%")
(format t "~%")) (format t "~%"))
@@ -241,11 +241,11 @@ Creates the config directory tree if it does not exist.
** Main Setup Wizard ** Main Setup Wizard
#+begin_src lisp #+begin_src lisp
(defun run-setup-wizard () (defun setup-wizard-run ()
"Main entry point for the interactive setup wizard." "Main entry point for the interactive setup wizard."
(format t "~%~%") (format t "~%~%")
(format t "╔═══════════════════════════════════════════════════╗~%") (format t "╔═══════════════════════════════════════════════════╗~%")
(format t "║ OpenCortex Setup Wizard ║~%") (format t "║ Passepartout Setup Wizard ║~%")
(format t "╚═══════════════════════════════════════════════════╝~%") (format t "╚═══════════════════════════════════════════════════╝~%")
(format t "~%") (format t "~%")
(format t "This wizard will help you configure:~%") (format t "This wizard will help you configure:~%")
@@ -255,7 +255,7 @@ Creates the config directory tree if it does not exist.
(format t " 4. Network Settings~%") (format t " 4. Network Settings~%")
(format t "~%") (format t "~%")
(ensure-config-dir) (config-directory-ensure)
;; Step 1: LLM Providers ;; Step 1: LLM Providers
(when (prompt-yes-no "Configure LLM providers?") (when (prompt-yes-no "Configure LLM providers?")
@@ -278,15 +278,15 @@ Creates the config directory tree if it does not exist.
(format t " Setup Complete!~%") (format t " Setup Complete!~%")
(format t "==================================================~%") (format t "==================================================~%")
(format t "~%") (format t "~%")
(format t "Configuration saved to: ~a~%" (get-config-file)) (format t "Configuration saved to: ~a~%" (config-file-path))
(format t "~%") (format t "~%")
(format t "To verify your setup, run: opencortex doctor~%") (format t "To verify your setup, run: passepartout doctor~%")
(format t "~%")) (format t "~%"))
#+end_src #+end_src
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-config-manager (defskill :passepartout-system-config
:priority 100 :priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src #+end_src

83
skills/org-skill-diagnostics.org → org/system-diagnostics.org
View File

@@ -1,10 +1,11 @@
#+TITLE: SKILL: Diagnostics (org-skill-diagnostics.org) #+TITLE: SKILL: Diagnostics (org-skill-diagnostics.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :system:diagnostics:doctor: #+FILETAGS: :system:diagnostics:doctor:
#+PROPERTY: header-args:lisp :tangle org-skill-diagnostics.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/system-diagnostics.lisp
* Overview * Why a Doctor?
The *Diagnostics Skill* (Doctor) provides system-wide health checks and dependency verification. It validates external dependencies, XDG environment, and LLM provider connectivity.
The Diagnostics skill is the self-knowledge of Passepartout. It answers "Is everything working?" by checking dependencies, environment variables, and LLM connectivity. Unlike the harness-level Doctor (which runs at boot and on CLI demand), this skill provides the Lisp-level diagnostic functions — defining what "healthy" means: which binaries must be present, which directories must exist, which API keys should be configured.
* Phase A: Demand (Thinking) * Phase A: Demand (Thinking)
** Why a Doctor? ** Why a Doctor?
@@ -22,10 +23,10 @@ Binary detection must use shell probing (`which`) to account for varying `$PATH`
** Global Configuration ** Global Configuration
#+begin_src lisp #+begin_src lisp
(defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc") (defvar *diagnostics-binaries* '("sbcl" "emacs" "git" "socat" "nc")
"List of external binaries required for full system operation.") "List of external binaries required for full system operation.")
(defvar *doctor-package-map* (defvar *diagnostics-package-map*
'(("sbcl" . "sbcl") '(("sbcl" . "sbcl")
("emacs" . "emacs") ("emacs" . "emacs")
("git" . "git") ("git" . "git")
@@ -36,7 +37,7 @@ Binary detection must use shell probing (`which`) to account for varying `$PATH`
"Map binary names to apt package names.") "Map binary names to apt package names.")
(defvar *doctor-missing-deps* nil (defvar *doctor-missing-deps* nil
"List of missing dependencies populated by doctor-check-dependencies.") "List of missing dependencies populated by diagnostics-dependencies-check.")
(defvar *doctor-auto-install* t (defvar *doctor-auto-install* t
"When T, doctor will attempt to install missing dependencies automatically.") "When T, doctor will attempt to install missing dependencies automatically.")
@@ -44,12 +45,12 @@ Binary detection must use shell probing (`which`) to account for varying `$PATH`
** Dependency Verification ** Dependency Verification
#+begin_src lisp #+begin_src lisp
(defun doctor-check-dependencies () (defun diagnostics-dependencies-check ()
"Verifies that required external binaries are available in the PATH via shell probe." "Verifies that required external binaries are available in the PATH via shell probe."
(setf *doctor-missing-deps* nil) (setf *doctor-missing-deps* nil)
(let ((all-ok t)) (let ((all-ok t))
(format t "DOCTOR: Checking system dependencies...~%") (format t "DOCTOR: Checking system dependencies...~%")
(dolist (dep *doctor-required-binaries*) (dolist (dep *diagnostics-binaries*)
(let ((path (ignore-errors (let ((path (ignore-errors
(uiop:run-program (list "which" dep) (uiop:run-program (list "which" dep)
:output :string :ignore-error-status t)))) :output :string :ignore-error-status t))))
@@ -66,17 +67,17 @@ Binary detection must use shell probing (`which`) to account for varying `$PATH`
** Auto-Install Dependencies ** Auto-Install Dependencies
#+begin_src lisp #+begin_src lisp
(defun doctor-install-dependencies () (defun diagnostics-dependencies-install ()
"Attempts to install missing system dependencies via apt." "Attempts to install missing system dependencies via apt."
(when (null *doctor-missing-deps*) (when (null *doctor-missing-deps*)
(format t "DOCTOR: No missing dependencies to install.~%") (format t "DOCTOR: No missing dependencies to install.~%")
(return-from doctor-install-dependencies t)) (return-from diagnostics-dependencies-install t))
(format t "DOCTOR: Attempting to install ~a missing dependencies...~%" (length *doctor-missing-deps*)) (format t "DOCTOR: Attempting to install ~a missing dependencies...~%" (length *doctor-missing-deps*))
(let ((packages (remove-duplicates (let ((packages (remove-duplicates
(mapcar (lambda (dep) (mapcar (lambda (dep)
(or (cdr (assoc dep *doctor-package-map* :test #'string=)) (or (cdr (assoc dep *diagnostics-package-map* :test #'string=))
dep)) dep))
*doctor-missing-deps*) *doctor-missing-deps*)
:test #'string=))) :test #'string=)))
@@ -105,13 +106,13 @@ Binary detection must use shell probing (`which`) to account for varying `$PATH`
** XDG Environment Validation ** XDG Environment Validation
#+begin_src lisp #+begin_src lisp
(defun doctor-check-env () (defun diagnostics-env-check ()
"Validates XDG directories and environment configuration." "Validates XDG directories and environment configuration."
(format t "DOCTOR: Checking XDG environment...~%") (format t "DOCTOR: Checking XDG environment...~%")
(let ((all-ok t) (let ((all-ok t)
(config-dir (uiop:getenv "OC_CONFIG_DIR")) (config-dir (uiop:getenv "PASSEPARTOUT_CONFIG_DIR"))
(data-dir (uiop:getenv "OC_DATA_DIR")) (data-dir (uiop:getenv "PASSEPARTOUT_DATA_DIR"))
(state-dir (uiop:getenv "OC_STATE_DIR")) (state-dir (uiop:getenv "PASSEPARTOUT_STATE_DIR"))
(memex-dir (uiop:getenv "MEMEX_DIR"))) (memex-dir (uiop:getenv "MEMEX_DIR")))
(flet ((check-dir (name path critical) (flet ((check-dir (name path critical)
@@ -125,9 +126,9 @@ Binary detection must use shell probing (`which`) to account for varying `$PATH`
(format t " [FAIL] ~a variable not set.~%" name) (format t " [FAIL] ~a variable not set.~%" name)
(when critical (setf all-ok nil)))))) (when critical (setf all-ok nil))))))
(check-dir "Config (OC_CONFIG_DIR)" config-dir t) (check-dir "Config (PASSEPARTOUT_CONFIG_DIR)" config-dir t)
(check-dir "Data (OC_DATA_DIR)" data-dir t) (check-dir "Data (PASSEPARTOUT_DATA_DIR)" data-dir t)
(check-dir "State (OC_STATE_DIR)" state-dir t) (check-dir "State (PASSEPARTOUT_STATE_DIR)" state-dir t)
(check-dir "Memex (MEMEX_DIR)" memex-dir t)) (check-dir "Memex (MEMEX_DIR)" memex-dir t))
all-ok)) all-ok))
#+end_src #+end_src
@@ -136,15 +137,17 @@ Binary detection must use shell probing (`which`) to account for varying `$PATH`
The doctor checks all supported LLM providers and detects local Ollama instances. The doctor checks all supported LLM providers and detects local Ollama instances.
#+begin_src lisp #+begin_src lisp
(defun doctor-check-llm () (defun diagnostics-llm-check ()
"Tests connectivity to LLM providers. Returns T if at least one provider is configured." "Tests connectivity to LLM providers. Returns T if at least one provider is configured."
(format t "DOCTOR: Checking LLM connectivity...~%") (format t "DOCTOR: Checking LLM connectivity...~%")
(let ((providers '((:openrouter . "OPENROUTER_API_KEY") (let ((providers '((:openrouter . "OPENROUTER_API_KEY")
(:anthropic . "ANTHROPIC_API_KEY") (:anthropic . "ANTHROPIC_API_KEY")
(:openai . "OPENAI_API_KEY") (:openai . "OPENAI_API_KEY")
(:groq . "GROQ_API_KEY") (:groq . "GROQ_API_KEY")
(:gemini . "GEMINI_API_KEY") (:gemini . "GEMINI_API_KEY")
(:ollama . "OLLAMA_URL"))) (:deepseek . "DEEPSEEK_API_KEY")
(:nvidia . "NVIDIA_API_KEY")
(:ollama . "OLLAMA_URL")))
(configured nil)) (configured nil))
(dolist (p providers) (dolist (p providers)
(let ((env-val (uiop:getenv (cdr p)))) (let ((env-val (uiop:getenv (cdr p))))
@@ -165,25 +168,25 @@ The doctor checks all supported LLM providers and detects local Ollama instances
t) t)
(progn (progn
(format t " [WARN] No LLM provider configured.~%") (format t " [WARN] No LLM provider configured.~%")
(format t " Run 'opencortex setup' to configure a provider.~%") (format t " Run 'passepartout configure' to configure a provider.~%")
t)))) t))))
#+end_src #+end_src
** Orchestration ** Orchestration
#+begin_src lisp #+begin_src lisp
(defun doctor-run-all (&key (auto-install t)) (defun diagnostics-run-all (&key (auto-install t))
"Executes the full diagnostic suite and returns T if system is healthy." "Executes the full diagnostic suite and returns T if system is healthy."
(format t "==================================================~%") (format t "==================================================~%")
(format t " OPENCORTEX DOCTOR: Commencing Health Check~%") (format t " PASSEPARTOUT DOCTOR: Commencing Health Check~%")
(format t "==================================================~%") (format t "==================================================~%")
(let ((dep-ok (doctor-check-dependencies))) (let ((dep-ok (diagnostics-dependencies-check)))
(when (and (not dep-ok) auto-install *doctor-auto-install*) (when (and (not dep-ok) auto-install *doctor-auto-install*)
(format t "DOCTOR: Attempting automatic installation...~%") (format t "DOCTOR: Attempting automatic installation...~%")
(setf dep-ok (doctor-install-dependencies)) (setf dep-ok (diagnostics-dependencies-install))
(when dep-ok (when dep-ok
(setf dep-ok (doctor-check-dependencies)))) (setf dep-ok (diagnostics-dependencies-check))))
(let ((env-ok (doctor-check-env)) (let ((env-ok (diagnostics-env-check))
(llm-ok (doctor-check-llm))) (llm-ok (diagnostics-llm-check)))
(format t "==================================================~%") (format t "==================================================~%")
(if (and dep-ok env-ok) (if (and dep-ok env-ok)
(progn (progn
@@ -198,17 +201,17 @@ The doctor checks all supported LLM providers and detects local Ollama instances
(format t " - No LLM provider configured~%")) (format t " - No LLM provider configured~%"))
(format t "~%") (format t "~%")
(format t " RECOMMENDED ACTIONS:~%") (format t " RECOMMENDED ACTIONS:~%")
(format t " 1. Run 'opencortex setup' to configure everything~%") (format t " 1. Run 'passepartout configure' to configure everything~%")
(format t " 2. Or run 'opencortex doctor --fix' for auto-repair~%") (format t " 2. Or run 'passepartout doctor --fix' for auto-repair~%")
(format t "==================================================~%") (format t "==================================================~%")
nil))))) ;; Return nil when issues found nil))))) ;; Return nil when issues found
#+end_src #+end_src
** CLI Entry Point ** CLI Entry Point
#+begin_src lisp #+begin_src lisp
(defun doctor-main () (defun diagnostics-main ()
"Entry point for the 'doctor' CLI command." "Entry point for the 'doctor' CLI command."
(if (doctor-run-all) (if (diagnostics-run-all)
(uiop:quit 0) (uiop:quit 0)
(uiop:quit 1))) (uiop:quit 1)))
#+end_src #+end_src
@@ -219,8 +222,8 @@ The doctor checks all supported LLM providers and detects local Ollama instances
#+begin_src lisp :tangle no #+begin_src lisp :tangle no
(test test-doctor-dependency-check (test test-doctor-dependency-check
"Verify that missing binaries are correctly identified as failures." "Verify that missing binaries are correctly identified as failures."
(let ((opencortex::*doctor-required-binaries* '("non-existent-binary-123"))) (let ((passepartout::*diagnostics-binaries* '("non-existent-binary-123")))
(is (null (opencortex:doctor-check-dependencies))))) (is (null (passepartout:diagnostics-dependencies-check)))))
#+end_src #+end_src
** Environment Test ** Environment Test
@@ -231,7 +234,7 @@ The doctor checks all supported LLM providers and detects local Ollama instances
(unwind-protect (unwind-protect
(progn (progn
(setf (uiop:getenv "MEMEX_DIR") "/non/existent/path/999") (setf (uiop:getenv "MEMEX_DIR") "/non/existent/path/999")
(is (null (opencortex:doctor-check-env)))) (is (null (passepartout:diagnostics-env-check))))
(setf (uiop:getenv "MEMEX_DIR") (or old-m ""))))) (setf (uiop:getenv "MEMEX_DIR") (or old-m "")))))
#+end_src #+end_src
@@ -240,7 +243,7 @@ The doctor skill should be loaded early (priority 100) to validate system health
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-diagnostics (defskill :passepartout-system-diagnostics
:priority 100 :priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat)) :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)) :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))

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

@@ -1,7 +1,7 @@
#+TITLE: SKILL: Homoiconic Memory (org-skill-homoiconic-memory.org) #+TITLE: SKILL: Homoiconic Memory (org-skill-homoiconic-memory.org)
#+AUTHOR: Agent #+AUTHOR: Agent
#+FILETAGS: :harness:memory:homoiconic: #+FILETAGS: :harness:memory:homoiconic:
#+PROPERTY: header-args:lisp :tangle org-skill-homoiconic-memory.lisp #+PROPERTY: header-args:lisp :tangle ../lisp/system-memory.lisp
* Overview * Overview
Because Lisp is homoiconic (code is data), memory objects can be read as executable forms. This skill provides the bridge between the org-object store and live Lisp evaluation — it can serialize an org-object into an s-expression, evaluate it to reconstruct state, and store the result back as a new object. This is the foundation of the agent's ability to save, restore, and inspect its own cognitive state at runtime. Because Lisp is homoiconic (code is data), memory objects can be read as executable forms. This skill provides the bridge between the org-object store and live Lisp evaluation — it can serialize an org-object into an s-expression, evaluate it to reconstruct state, and store the result back as a new object. This is the foundation of the agent's ability to save, restore, and inspect its own cognitive state at runtime.
@@ -10,14 +10,14 @@ Because Lisp is homoiconic (code is data), memory objects can be read as executa
** Memory Logic ** Memory Logic
#+begin_src lisp #+begin_src lisp
(defun memory-self-inspect () (defun memory-inspect ()
"Allows the system to inspect its own memory state." "Allows the system to inspect its own memory state."
(harness-log "MEMORY: Self-inspection triggered.")) (harness-log "MEMORY: Self-inspection triggered."))
#+end_src #+end_src
** Skill Registration ** Skill Registration
#+begin_src lisp #+begin_src lisp
(defskill :skill-homoiconic-memory (defskill :passepartout-system-memory
:priority 100 :priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil)) :trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src #+end_src

51
org/system-self-improve.org Normal file
View File

@@ -0,0 +1,51 @@
#+TITLE: SKILL: Self Edit (org-skill-self-edit.org)
#+AUTHOR: Agent
#+FILETAGS: :system:autonomy:self-edit:
#+PROPERTY: header-args:lisp :tangle ../lisp/system-self-improve.lisp
* Overview: The Self-Modification Primitive
Self Edit is the capability that makes Passepartout autonomous in the strongest sense: it can modify its own source code. Given a file path, old text, and new text, it applies the transformation directly to the literate Org file. Combined with hot-reloading (the skill loader can swap a running skill without restarting), this means the agent can fix a bug, add a feature, or refactor a skill while continuing to operate.
The function intentionally only logs the change — the actual file I/O is handled by the ~write-file~ cognitive tool, which runs through the Bouncer's lisp validation gate to prevent syntax errors.
* Implementation
** Self-Edit Logic
#+begin_src lisp
(defun self-improve-edit (filepath old-text new-text)
"Applies a transformation to a source file."
(declare (ignore old-text new-text))
(harness-log "SELF-EDIT: Applying changes to ~a" filepath))
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :passepartout-system-self-improve
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src
#+AUTHOR: Agent
#+FILETAGS: :system:autonomy:self-fix:
#+PROPERTY: header-args:lisp :tangle ../lisp/system-self-improve-add.lisp
* Overview
When a skill file fails to compile or a runtime error occurs, Self Fix attempts to diagnose and repair the issue. It receives error logs from the skill loader, identifies the broken file, and generates a corrected version that is hot-reloaded into the running image.
* Implementation
** Self-Fix Logic
#+begin_src lisp
(defun self-improve-fix (skill-name error-log)
"Attempts to diagnose and repair a broken skill."
(declare (ignore error-log))
(harness-log "SELF-FIX: Attempting repair of ~a..." skill-name))
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :passepartout-system-self-improve
:priority 100
:trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :EVENT)))
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
#+end_src

220
opencortex.sh → passepartout
View File

@@ -16,14 +16,14 @@ while [ -h "$SOURCE" ]; do
done done
export SCRIPT_DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" export SCRIPT_DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )"
export OC_CONFIG_DIR="$(realpath -m "${XDG_CONFIG_HOME:-$HOME/.config}/opencortex")" export PASSEPARTOUT_CONFIG_DIR="$(realpath -m "${XDG_CONFIG_HOME:-$HOME/.config}/passepartout")"
export OC_DATA_DIR="$(realpath -m "${XDG_DATA_HOME:-$HOME/.local/share}/opencortex")" export PASSEPARTOUT_DATA_DIR="$(realpath -m "${XDG_DATA_HOME:-$HOME/.local/share}/passepartout")"
export OC_STATE_DIR="$(realpath -m "${XDG_STATE_HOME:-$HOME/.local/state}/opencortex")" export PASSEPARTOUT_STATE_DIR="$(realpath -m "${XDG_STATE_HOME:-$HOME/.local/state}/passepartout")"
export OC_BIN_DIR="$(realpath -m "${XDG_BIN_HOME:-$HOME/.local/bin}")" export PASSEPARTOUT_BIN_DIR="$(realpath -m "${XDG_BIN_HOME:-$HOME/.local/bin}")"
export MEMEX_DIR="${MEMEX_DIR:-$HOME/memex}" export PASSEPARTOUT_MEMEX_DIR="${PASSEPARTOUT_MEMEX_DIR:-$HOME/memex}"
if [ -f "$OC_CONFIG_DIR/.env" ]; then if [ -f "$PASSEPARTOUT_CONFIG_DIR/.env" ]; then
set -a; source "$OC_CONFIG_DIR/.env"; set +a set -a; source "$PASSEPARTOUT_CONFIG_DIR/.env"; set +a
fi fi
# --- DISTRO DETECTION --- # --- DISTRO DETECTION ---
@@ -84,9 +84,9 @@ setup_system() {
esac esac
done done
echo -e "${BLUE}=== OpenCortex: Configure ===${NC}" echo -e "${BLUE}=== Passepartout: Configure ===${NC}"
mkdir -p "$OC_CONFIG_DIR" "$OC_DATA_DIR" "$OC_STATE_DIR" "$OC_BIN_DIR" mkdir -p "$PASSEPARTOUT_CONFIG_DIR" "$PASSEPARTOUT_DATA_DIR" "$PASSEPARTOUT_STATE_DIR" "$PASSEPARTOUT_BIN_DIR"
mkdir -p "$OC_DATA_DIR/harness" "$OC_DATA_DIR/tests" "$OC_DATA_DIR/skills" mkdir -p "$PASSEPARTOUT_DATA_DIR/harness" "$PASSEPARTOUT_DATA_DIR/tests" "$PASSEPARTOUT_DATA_DIR/skills"
check_dependencies check_dependencies
@@ -99,43 +99,43 @@ setup_system() {
rm quicklisp.lisp rm quicklisp.lisp
fi fi
echo -e "${YELLOW}--- Deploying Engine to $OC_DATA_DIR ---${NC}" echo -e "${YELLOW}--- Deploying Engine to $PASSEPARTOUT_DATA_DIR ---${NC}"
cp "$SCRIPT_DIR/opencortex.asd" "$OC_DATA_DIR/" cp "$SCRIPT_DIR/passepartout.asd" "$PASSEPARTOUT_DATA_DIR/"
mkdir -p "$OC_DATA_DIR/harness" "$OC_DATA_DIR/tests" "$OC_DATA_DIR/skills" mkdir -p "$PASSEPARTOUT_DATA_DIR/harness" "$PASSEPARTOUT_DATA_DIR/tests" "$PASSEPARTOUT_DATA_DIR/skills"
export INSTALL_DIR="$OC_DATA_DIR" export INSTALL_DIR="$PASSEPARTOUT_DATA_DIR"
cp "$SCRIPT_DIR/harness"/*.org "$OC_DATA_DIR/harness/" cp "$SCRIPT_DIR/org"/*.org "$PASSEPARTOUT_DATA_DIR/harness/"
(cd "$OC_DATA_DIR/harness" && emacs -Q --batch \ (cd "$PASSEPARTOUT_DATA_DIR/harness" && emacs -Q --batch \
--eval "(require 'org)" \ --eval "(require 'org)" \
--eval "(setq org-confirm-babel-evaluate nil)" \ --eval "(setq org-confirm-babel-evaluate nil)" \
--eval "(org-babel-tangle-file \"manifest.org\")") >/dev/null 2>&1 || true --eval "(org-babel-tangle-file \"manifest.org\")") >/dev/null 2>&1 || true
for f in "$OC_DATA_DIR/harness"/*.org; do for f in "$PASSEPARTOUT_DATA_DIR/harness"/*.org; do
fname=$(basename "$f" .org) fname=$(basename "$f" .org)
[ "$fname" = "manifest" ] && continue [ "$fname" = "manifest" ] && continue
echo "Tangling harness/$fname.org..." echo "Tangling harness/$fname.org..."
(cd "$OC_DATA_DIR/harness" && emacs -Q --batch \ (cd "$PASSEPARTOUT_DATA_DIR/harness" && emacs -Q --batch \
--eval "(require 'org)" \ --eval "(require 'org)" \
--eval "(setq org-confirm-babel-evaluate nil)" \ --eval "(setq org-confirm-babel-evaluate nil)" \
--eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true --eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true
done done
find "$OC_DATA_DIR/harness" -name "*-tests.lisp" -exec mv {} "$OC_DATA_DIR/tests/" \; 2>/dev/null || true find "$PASSEPARTOUT_DATA_DIR/harness" -name "*-tests.lisp" -exec mv {} "$PASSEPARTOUT_DATA_DIR/tests/" \; 2>/dev/null || true
rm -f "$OC_DATA_DIR/harness"/*.org rm -f "$PASSEPARTOUT_DATA_DIR/harness"/*.org
for f in "$SCRIPT_DIR/skills"/*.org; do for f in "$SCRIPT_DIR/org"/*.org; do
fname=$(basename "$f" .org) fname=$(basename "$f" .org)
echo "Tangling skills/$fname.org..." echo "Tangling skills/$fname.org..."
cp "$f" "$OC_DATA_DIR/skills/" cp "$f" "$PASSEPARTOUT_DATA_DIR/skills/"
(cd "$OC_DATA_DIR/skills" && emacs -Q --batch \ (cd "$PASSEPARTOUT_DATA_DIR/skills" && emacs -Q --batch \
--eval "(require 'org)" \ --eval "(require 'org)" \
--eval "(setq org-confirm-babel-evaluate nil)" \ --eval "(setq org-confirm-babel-evaluate nil)" \
--eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true --eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true
rm -f "$OC_DATA_DIR/skills/$fname.org" rm -f "$PASSEPARTOUT_DATA_DIR/skills/$fname.org"
done done
find "$OC_DATA_DIR/skills" -name "*-tests.lisp" -exec mv {} "$OC_DATA_DIR/tests/" \; 2>/dev/null || true find "$PASSEPARTOUT_DATA_DIR/skills" -name "*-tests.lisp" -exec mv {} "$PASSEPARTOUT_DATA_DIR/tests/" \; 2>/dev/null || true
[ -f "$OC_DATA_DIR/run-all-tests.lisp" ] && mv "$OC_DATA_DIR/run-all-tests.lisp" "$OC_DATA_DIR/harness/" [ -f "$PASSEPARTOUT_DATA_DIR/run-all-tests.lisp" ] && mv "$PASSEPARTOUT_DATA_DIR/run-all-tests.lisp" "$PASSEPARTOUT_DATA_DIR/harness/"
rm -f "$OC_DATA_DIR/harness"/*.org "$OC_DATA_DIR/skills"/*.org rm -f "$PASSEPARTOUT_DATA_DIR/harness"/*.org "$PASSEPARTOUT_DATA_DIR/skills"/*.org
ln -sf "$SCRIPT_DIR/opencortex.sh" "$OC_BIN_DIR/opencortex" ln -sf "$SCRIPT_DIR/passepartout.sh" "$PASSEPARTOUT_BIN_DIR/passepartout"
if [ "$WITH_FIREWALL" = true ]; then if [ "$WITH_FIREWALL" = true ]; then
case $(detect_distro) in case $(detect_distro) in
@@ -152,49 +152,49 @@ setup_system() {
echo -e "${YELLOW}--- Launching Setup Wizard ---${NC}" echo -e "${YELLOW}--- Launching Setup Wizard ---${NC}"
exec sbcl --non-interactive \ exec sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \ --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \ --eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :opencortex)' \ --eval '(ql:quickload :passepartout :force t)' \
--eval '(opencortex:initialize-all-skills)' \ --eval '(passepartout:skill-initialize-all)' \
--eval '(funcall (find-symbol "RUN-SETUP-WIZARD" :opencortex))' --eval '(funcall (find-symbol "SETUP-WIZARD-RUN" :passepartout))'
} }
# --- DOCTOR REPAIR --- # --- DOCTOR REPAIR ---
doctor_repair() { doctor_repair() {
echo -e "${BLUE}=== OpenCortex: Repair Mode ===${NC}" echo -e "${BLUE}=== Passepartout: Repair Mode ===${NC}"
check_dependencies check_dependencies
mkdir -p "$OC_CONFIG_DIR" "$OC_DATA_DIR" "$OC_STATE_DIR" "$OC_BIN_DIR" mkdir -p "$PASSEPARTOUT_CONFIG_DIR" "$PASSEPARTOUT_DATA_DIR" "$PASSEPARTOUT_STATE_DIR" "$PASSEPARTOUT_BIN_DIR"
mkdir -p "$OC_DATA_DIR/harness" "$OC_DATA_DIR/tests" "$OC_DATA_DIR/skills" mkdir -p "$PASSEPARTOUT_DATA_DIR/harness" "$PASSEPARTOUT_DATA_DIR/tests" "$PASSEPARTOUT_DATA_DIR/skills"
for f in "$SCRIPT_DIR/harness"/*.org; do for f in "$SCRIPT_DIR/org"/*.org; do
[ -f "$f" ] || continue [ -f "$f" ] || continue
fname=$(basename "$f" .org) fname=$(basename "$f" .org)
echo " Checking harness/$fname..." echo " Checking harness/$fname..."
if ! sbcl --non-interactive \ if ! sbcl --non-interactive \
--eval "(load \"$OC_DATA_DIR/harness/${fname}.lisp\")" \ --eval "(load \"$PASSEPARTOUT_DATA_DIR/harness/${fname}.lisp\")" \
--eval "(format t \"OK~%\")" 2>/dev/null | grep -q "OK"; then --eval "(format t \"OK~%\")" 2>/dev/null | grep -q "OK"; then
echo " Re-tangling $fname.org..." echo " Re-tangling $fname.org..."
(cd "$OC_DATA_DIR/harness" && emacs -Q --batch \ (cd "$PASSEPARTOUT_DATA_DIR/harness" && emacs -Q --batch \
--eval "(require 'org)" \ --eval "(require 'org)" \
--eval "(setq org-confirm-babel-evaluate nil)" \ --eval "(setq org-confirm-babel-evaluate nil)" \
--eval "(org-babel-tangle-file \"$f\")") >/dev/null 2>&1 || true --eval "(org-babel-tangle-file \"$f\")") >/dev/null 2>&1 || true
fi fi
done done
for f in "$SCRIPT_DIR/skills"/*.org; do for f in "$SCRIPT_DIR/org"/*.org; do
[ -f "$f" ] || continue [ -f "$f" ] || continue
fname=$(basename "$f" .org) fname=$(basename "$f" .org)
echo " Checking skill/$fname..." echo " Checking skill/$fname..."
if ! sbcl --non-interactive \ if ! sbcl --non-interactive \
--eval "(load \"$OC_DATA_DIR/skills/${fname}.lisp\")" \ --eval "(load \"$PASSEPARTOUT_DATA_DIR/skills/${fname}.lisp\")" \
--eval "(format t \"OK~%\")" 2>/dev/null | grep -q "OK"; then --eval "(format t \"OK~%\")" 2>/dev/null | grep -q "OK"; then
echo " Re-tangling $fname.org..." echo " Re-tangling $fname.org..."
cp "$f" "$OC_DATA_DIR/skills/" cp "$f" "$PASSEPARTOUT_DATA_DIR/skills/"
(cd "$OC_DATA_DIR/skills" && emacs -Q --batch \ (cd "$PASSEPARTOUT_DATA_DIR/skills" && emacs -Q --batch \
--eval "(require 'org)" \ --eval "(require 'org)" \
--eval "(setq org-confirm-babel-evaluate nil)" \ --eval "(setq org-confirm-babel-evaluate nil)" \
--eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true --eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true
rm -f "$OC_DATA_DIR/skills/$fname.org" rm -f "$PASSEPARTOUT_DATA_DIR/skills/$fname.org"
fi fi
done done
rm -f "$OC_DATA_DIR/harness"/*.org "$OC_DATA_DIR/skills"/*.org 2>/dev/null || true rm -f "$PASSEPARTOUT_DATA_DIR/harness"/*.org "$PASSEPARTOUT_DATA_DIR/skills"/*.org 2>/dev/null || true
echo -e "${GREEN}--- Repair Complete ---${NC}" echo -e "${GREEN}--- Repair Complete ---${NC}"
} }
@@ -202,23 +202,23 @@ doctor_repair() {
install_skill() { install_skill() {
local SKILL_NAME=$1 local SKILL_NAME=$1
if [ -z "$SKILL_NAME" ]; then if [ -z "$SKILL_NAME" ]; then
echo "Usage: opencortex install skill <skill-name>" echo "Usage: passepartout install skill <skill-name>"
echo " Installs a skill from opencortex-contrib" echo " Installs a skill from passepartout-contrib"
echo "" echo ""
echo "Available skills:" echo "Available skills:"
if [ -d "$MEMEX_DIR/projects/opencortex-contrib/skills" ]; then if [ -d "$PASSEPARTOUT_MEMEX_DIR/projects/passepartout-contrib/skills" ]; then
ls "$MEMEX_DIR/projects/opencortex-contrib/skills"/*.org 2>/dev/null | xargs -I{} basename {} .org | sed 's/org-skill-//' | sort | uniq ls "$PASSEPARTOUT_MEMEX_DIR/projects/passepartout-contrib/skills"/*.org 2>/dev/null | xargs -I{} basename {} .org | sed 's/org-skill-//' | sort | uniq
else else
echo " (clone opencortex-contrib to ~/memex/projects/ first)" echo " (clone passepartout-contrib to ~/memex/projects/ first)"
fi fi
exit 1 exit 1
fi fi
local SKILL_FILE="org-skill-${SKILL_NAME}.org" local SKILL_FILE="org-skill-${SKILL_NAME}.org"
local SOURCE_DIR="$MEMEX_DIR/projects/opencortex-contrib/skills" local SOURCE_DIR="$PASSEPARTOUT_MEMEX_DIR/projects/passepartout-contrib/skills"
local TARGET_DIR="$OC_DATA_DIR/skills" local TARGET_DIR="$PASSEPARTOUT_DATA_DIR/skills"
if [ ! -d "$SOURCE_DIR" ]; then if [ ! -d "$SOURCE_DIR" ]; then
echo "Error: Contrib skills not found at $SOURCE_DIR" echo "Error: Contrib skills not found at $SOURCE_DIR"
echo "Run: git clone https://github.com/amrgharbeia/opencortex-contrib.git \$MEMEX_DIR/projects/opencortex-contrib" echo "Run: git clone https://github.com/amrgharbeia/passepartout-contrib.git \$PASSEPARTOUT_MEMEX_DIR/projects/passepartout-contrib"
exit 1 exit 1
fi fi
if [ ! -f "$SOURCE_DIR/$SKILL_FILE" ]; then if [ ! -f "$SOURCE_DIR/$SKILL_FILE" ]; then
@@ -233,7 +233,7 @@ install_skill() {
--eval "(org-babel-tangle-file \"$SKILL_FILE\")") >/dev/null 2>&1 || true --eval "(org-babel-tangle-file \"$SKILL_FILE\")") >/dev/null 2>&1 || true
rm -f "$TARGET_DIR/$SKILL_FILE" rm -f "$TARGET_DIR/$SKILL_FILE"
if [ -f "$TARGET_DIR/${SKILL_NAME}-tests.lisp" ]; then if [ -f "$TARGET_DIR/${SKILL_NAME}-tests.lisp" ]; then
mv "$TARGET_DIR/${SKILL_NAME}-tests.lisp" "$OC_DATA_DIR/tests/" 2>/dev/null || true mv "$TARGET_DIR/${SKILL_NAME}-tests.lisp" "$PASSEPARTOUT_DATA_DIR/tests/" 2>/dev/null || true
fi fi
echo "Skill '$SKILL_NAME' installed. Restart to activate." echo "Skill '$SKILL_NAME' installed. Restart to activate."
} }
@@ -241,45 +241,45 @@ install_skill() {
# --- INSTALL SERVICE --- # --- INSTALL SERVICE ---
install_service() { install_service() {
mkdir -p "$HOME/.config/systemd/user" mkdir -p "$HOME/.config/systemd/user"
cat > "$HOME/.config/systemd/user/opencortex.service" << 'SERVICEEOF' cat > "$HOME/.config/systemd/user/passepartout.service" << 'SERVICEEOF'
[Unit] [Unit]
Description=OpenCortex Daemon Description=Passepartout Daemon
After=network.target After=network.target
[Service] [Service]
Type=simple Type=simple
ExecStart=%h/projects/opencortex/opencortex.sh daemon ExecStart=%h/projects/passepartout/passepartout.sh daemon
Restart=on-failure Restart=on-failure
RestartSec=10 RestartSec=10
WorkingDirectory=%h/projects/opencortex WorkingDirectory=%h/projects/passepartout
[Install] [Install]
WantedBy=default.target WantedBy=default.target
SERVICEEOF SERVICEEOF
systemctl --user daemon-reload systemctl --user daemon-reload
systemctl --user enable opencortex.service systemctl --user enable passepartout.service
systemctl --user start opencortex.service systemctl --user start passepartout.service
echo -e "${GREEN}✓ opencortex.service installed and started${NC}" echo -e "${GREEN}✓ passepartout.service installed and started${NC}"
echo " Status: systemctl --user status opencortex.service" echo " Status: systemctl --user status passepartout.service"
echo " Logs: journalctl --user -u opencortex.service -f" echo " Logs: journalctl --user -u passepartout.service -f"
} }
uninstall_service() { uninstall_service() {
systemctl --user stop opencortex.service 2>/dev/null || true systemctl --user stop passepartout.service 2>/dev/null || true
systemctl --user disable opencortex.service 2>/dev/null || true systemctl --user disable passepartout.service 2>/dev/null || true
rm -f "$HOME/.config/systemd/user/opencortex.service" rm -f "$HOME/.config/systemd/user/passepartout.service"
systemctl --user daemon-reload systemctl --user daemon-reload
echo -e "${GREEN}✓ opencortex.service removed${NC}" echo -e "${GREEN}✓ passepartout.service removed${NC}"
} }
# --- BACKUP --- # --- BACKUP ---
backup() { backup() {
local dest="${1:-$HOME/opencortex-backup-$(date +%Y%m%d-%H%M%S).tar.gz}" local dest="${1:-$HOME/passepartout-backup-$(date +%Y%m%d-%H%M%S).tar.gz}"
if [ -f "$dest" ]; then echo "Error: $dest exists"; exit 1; fi if [ -f "$dest" ]; then echo "Error: $dest exists"; exit 1; fi
echo "Backing up to $dest..." echo "Backing up to $dest..."
tar -czf "$dest" \ tar -czf "$dest" \
"$OC_CONFIG_DIR" "$OC_DATA_DIR" \ "$PASSEPARTOUT_CONFIG_DIR" "$PASSEPARTOUT_DATA_DIR" \
"$MEMEX_DIR/gtd.org" "$MEMEX_DIR/projects/opencortex" \ "$PASSEPARTOUT_MEMEX_DIR/gtd.org" "$PASSEPARTOUT_MEMEX_DIR/projects/passepartout" \
2>/dev/null || true 2>/dev/null || true
echo -e "${GREEN}✓ Backed up to $dest${NC}" echo -e "${GREEN}✓ Backed up to $dest${NC}"
} }
@@ -287,20 +287,20 @@ backup() {
restore() { restore() {
local src="$1" local src="$1"
if [ -z "$src" ] || [ ! -f "$src" ]; then if [ -z "$src" ] || [ ! -f "$src" ]; then
echo "Usage: opencortex restore <backup-file>" echo "Usage: passepartout restore <backup-file>"
exit 1 exit 1
fi fi
echo "Restoring from $src..." echo "Restoring from $src..."
tar -xzf "$src" -C / tar -xzf "$src" -C /
echo -e "${GREEN}✓ Restored. Run 'opencortex doctor' to verify.${NC}" echo -e "${GREEN}✓ Restored. Run 'passepartout doctor' to verify.${NC}"
} }
# --- HELP --- # --- HELP ---
help() { help() {
echo "" echo ""
echo "OpenCortex — Your Autonomous, Plain-Text Life Assistant" echo "Passepartout — Your Autonomous, Plain-Text Life Assistant"
echo "" echo ""
echo "Usage: opencortex.sh <command> [options]" echo "Usage: passepartout.sh <command> [options]"
echo "" echo ""
echo "System:" echo "System:"
echo " configure [--non-interactive] [--with-firewall] Install or reconfigure the system" echo " configure [--non-interactive] [--with-firewall] Install or reconfigure the system"
@@ -322,7 +322,7 @@ help() {
echo " restore <path> Restore from a backup" echo " restore <path> Restore from a backup"
echo "" echo ""
echo "Quick start:" echo "Quick start:"
echo " curl -fsSL https://raw.githubusercontent.com/amrgharbeia/opencortex/main/opencortex.sh | bash -s configure" echo " curl -fsSL https://raw.githubusercontent.com/amrgharbeia/passepartout/main/passepartout.sh | bash -s configure"
echo "" echo ""
} }
@@ -336,10 +336,10 @@ case "$COMMAND" in
if [ "$1" = "--add-provider" ]; then if [ "$1" = "--add-provider" ]; then
sbcl --non-interactive \ sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \ --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \ --eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :opencortex)' \ --eval '(ql:quickload :passepartout :force t)' \
--eval '(opencortex:initialize-all-skills)' \ --eval '(passepartout:skill-initialize-all)' \
--eval '(funcall (find-symbol "SETUP-ADD-PROVIDER" :opencortex))' --eval '(funcall (find-symbol "SETUP-PROVIDER-ADD" :passepartout))'
elif [ "$1" = "--link" ]; then elif [ "$1" = "--link" ]; then
exec "$0" gateway link "$2" "$3" exec "$0" gateway link "$2" "$3"
else else
@@ -353,14 +353,14 @@ case "$COMMAND" in
echo "--- $(date '+%Y-%m-%d %H:%M:%S') ---" echo "--- $(date '+%Y-%m-%d %H:%M:%S') ---"
sbcl --non-interactive \ sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \ --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \ --eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :opencortex)' \ --eval '(ql:quickload :passepartout :force t)' \
--eval '(opencortex:initialize-all-skills)' \ --eval '(passepartout:skill-initialize-all)' \
--eval '(funcall (find-symbol "DOCTOR-RUN-ALL" :opencortex))' 2>&1 | grep -E "(HEALTH|OK|FAIL|WARN|SYSTEM|===)" || true --eval '(funcall (find-symbol "DIAGNOSTICS-RUN-ALL" :passepartout))' 2>&1 | grep -E "(HEALTH|OK|FAIL|WARN|SYSTEM|===)" || true
sleep 60 sleep 60
done done
elif [ "$1" = "--fix" ]; then elif [ "$1" = "--fix" ]; then
if [ ! -f "$OC_DATA_DIR/harness/package.lisp" ] || [ ! -f "$OC_DATA_DIR/harness/skills.lisp" ]; then if [ ! -f "$PASSEPARTOUT_DATA_DIR/harness/package.lisp" ] || [ ! -f "$PASSEPARTOUT_DATA_DIR/harness/skills.lisp" ]; then
setup_system "$@" setup_system "$@"
else else
doctor_repair doctor_repair
@@ -368,10 +368,10 @@ case "$COMMAND" in
else else
exec sbcl --non-interactive \ exec sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \ --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \ --eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :opencortex)' \ --eval '(ql:quickload :passepartout :force t)' \
--eval '(opencortex:initialize-all-skills)' \ --eval '(passepartout:skill-initialize-all)' \
--eval '(funcall (find-symbol "DOCTOR-MAIN" :opencortex))' --eval '(funcall (find-symbol "DIAGNOSTICS-MAIN" :passepartout))'
fi fi
;; ;;
daemon) daemon)
@@ -379,10 +379,10 @@ case "$COMMAND" in
echo "Starting daemon in background..." echo "Starting daemon in background..."
nohup sbcl --non-interactive \ nohup sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \ --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \ --eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval "(ql:quickload '(:opencortex :croatoan))" \ --eval "(ql:quickload '(:passepartout :croatoan))" \
--eval '(opencortex:main)' \ --eval '(passepartout:main)' \
> "$OC_STATE_DIR/daemon.log" 2>&1 & > "$PASSEPARTOUT_STATE_DIR/daemon.log" 2>&1 &
echo "Waiting for port 9105..." echo "Waiting for port 9105..."
for i in $(seq 1 20); do for i in $(seq 1 20); do
if ss -tln 2>/dev/null | grep -q 9105 || netstat -tln 2>/dev/null | grep -q 9105; then if ss -tln 2>/dev/null | grep -q 9105 || netstat -tln 2>/dev/null | grep -q 9105; then
@@ -390,7 +390,7 @@ case "$COMMAND" in
fi fi
sleep 1 sleep 1
done done
echo "✗ Daemon failed to start. Check $OC_STATE_DIR/daemon.log"; exit 1 echo "✗ Daemon failed to start. Check $PASSEPARTOUT_STATE_DIR/daemon.log"; exit 1
;; ;;
tui) tui)
check_dependencies check_dependencies
@@ -400,10 +400,10 @@ case "$COMMAND" in
fi fi
sbcl \ sbcl \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \ --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \ --eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :opencortex/tui)' \ --eval '(ql:quickload :passepartout/tui)' \
--eval '(opencortex.tui:main)' || { --eval '(passepartout.tui:main)' || {
echo "TUI error. Run 'opencortex doctor --fix'"; exit 1 echo "TUI error. Run 'passepartout doctor --fix'"; exit 1
} }
;; ;;
gateway) gateway)
@@ -413,43 +413,43 @@ case "$COMMAND" in
list) list)
exec sbcl --non-interactive \ exec sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \ --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \ --eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :opencortex)' \ --eval '(ql:quickload :passepartout :force t)' \
--eval '(opencortex:initialize-all-skills)' \ --eval '(passepartout:skill-initialize-all)' \
--eval '(funcall (find-symbol "GATEWAY-LIST-PRINT" (find-package "OPENCORTEX.SKILLS.ORG-SKILL-GATEWAY-MANAGER")))' --eval '(funcall (find-symbol "GATEWAY-LIST-PRINT" (find-package "OPENCORTEX.SKILLS.ORG-SKILL-GATEWAY-MANAGER")))'
;; ;;
link) link)
[ -z "$PLATFORM" ] || [ -z "$TOKEN" ] && echo "Usage: opencortex gateway link <platform> <token>" && exit 1 [ -z "$PLATFORM" ] || [ -z "$TOKEN" ] && echo "Usage: passepartout gateway link <platform> <token>" && exit 1
exec sbcl --non-interactive \ exec sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \ --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \ --eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :opencortex)' \ --eval '(ql:quickload :passepartout :force t)' \
--eval '(opencortex:initialize-all-skills)' \ --eval '(passepartout:skill-initialize-all)' \
--eval "(funcall (find-symbol \"GATEWAY-LINK\" (find-package \"OPENCORTEX.SKILLS.ORG-SKILL-GATEWAY-MANAGER\")) \"$PLATFORM\" \"$TOKEN\")" --eval "(funcall (find-symbol \"GATEWAY-LINK\" (find-package \"OPENCORTEX.SKILLS.ORG-SKILL-GATEWAY-MANAGER\")) \"$PLATFORM\" \"$TOKEN\")"
;; ;;
unlink) unlink)
[ -z "$PLATFORM" ] && echo "Usage: opencortex gateway unlink <platform>" && exit 1 [ -z "$PLATFORM" ] && echo "Usage: passepartout gateway unlink <platform>" && exit 1
exec sbcl --non-interactive \ exec sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \ --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \ --eval "(push (truename \"$PASSEPARTOUT_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :opencortex)' \ --eval '(ql:quickload :passepartout :force t)' \
--eval '(opencortex:initialize-all-skills)' \ --eval '(passepartout:skill-initialize-all)' \
--eval "(funcall (find-symbol \"GATEWAY-UNLINK\" (find-package \"OPENCORTEX.SKILLS.ORG-SKILL-GATEWAY-MANAGER\")) \"$PLATFORM\")" --eval "(funcall (find-symbol \"GATEWAY-UNLINK\" (find-package \"OPENCORTEX.SKILLS.ORG-SKILL-GATEWAY-MANAGER\")) \"$PLATFORM\")"
;; ;;
*) echo "Usage: opencortex gateway {list|link|unlink}"; exit 1 ;; *) echo "Usage: passepartout gateway {list|link|unlink}"; exit 1 ;;
esac esac
;; ;;
install) install)
case "$1" in case "$1" in
skill) shift; install_skill "$@" ;; skill) shift; install_skill "$@" ;;
service) install_service ;; service) install_service ;;
*) echo "Usage: opencortex install {skill|service}" >&2; exit 1 ;; *) echo "Usage: passepartout install {skill|service}" >&2; exit 1 ;;
esac esac
;; ;;
uninstall) uninstall)
case "$1" in case "$1" in
service) uninstall_service ;; service) uninstall_service ;;
*) echo "Usage: opencortex uninstall {service}" >&2; exit 1 ;; *) echo "Usage: passepartout uninstall {service}" >&2; exit 1 ;;
esac esac
;; ;;
backup) backup)

36
opencortex.asd → passepartout.asd
View File

@@ -1,25 +1,23 @@
(defsystem :opencortex (defsystem :passepartout
:name "opencortex" :name "Passepartout"
:author "Amr Gharbeia" :author "Amr Gharbeia"
:version "0.2.0" :version "0.3.0"
:license "AGPLv3" :license "AGPLv3"
:description "The Probabilistic-Deterministic Lisp Machine" :description "The Probabilistic-Deterministic Lisp Machine"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid) :depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
:serial t :serial t
:components ((:file "harness/package") :components ((:file "lisp/core-defpackage")
(:file "harness/skills") (:file "lisp/core-skills")
(:file "harness/communication") (:file "lisp/core-communication")
(:file "harness/communication-validator") (:file "lisp/core-memory")
(:file "harness/memory") (:file "lisp/core-context")
(:file "harness/context") (:file "lisp/core-loop-perceive")
(:file "harness/perceive") (:file "lisp/core-loop-reason")
(:file "harness/reason") (:file "lisp/core-loop-act")
(:file "harness/act") (:file "lisp/core-loop")))
(:file "harness/doctor")
(:file "harness/loop")))
(defsystem :opencortex/tests (defsystem :passepartout/tests
:depends-on (:opencortex :fiveam) :depends-on (:passepartout :fiveam)
:components ((:file "tests/pipeline-act-tests") :components ((:file "tests/pipeline-act-tests")
(:file "tests/boot-sequence-tests") (:file "tests/boot-sequence-tests")
(:file "tests/communication-tests") (:file "tests/communication-tests")
@@ -33,6 +31,6 @@
(:file "tests/utils-lisp-tests") (:file "tests/utils-lisp-tests")
(:file "tests/llm-gateway-tests"))) (:file "tests/llm-gateway-tests")))
(defsystem :opencortex/tui (defsystem :passepartout/tui
:depends-on (:opencortex :croatoan :usocket :bordeaux-threads) :depends-on (:passepartout :croatoan :usocket :bordeaux-threads)
:components ((:file "harness/tui-client"))) :components ((:file "lisp/gateway-tui")))

6
run-tests.lisp
View File

@@ -1,11 +1,11 @@
(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname))) (load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))
(let ((oc-dir (or (uiop:getenv "OC_DATA_DIR") (let ((oc-dir (or (uiop:getenv "PASSEPARTOUT_DATA_DIR")
(namestring (truename "./"))))) (namestring (truename "./")))))
(push (uiop:ensure-directory-pathname oc-dir) asdf:*central-registry*) (push (uiop:ensure-directory-pathname oc-dir) asdf:*central-registry*)
(setf (uiop:getenv "OC_DATA_DIR") oc-dir)) (setf (uiop:getenv "PASSEPARTOUT_DATA_DIR") oc-dir))
(ql:quickload '(:fiveam :opencortex :opencortex/tui :opencortex/tests) :silent t) (ql:quickload '(:fiveam :passepartout :passepartout/tui :passepartout/tests) :silent t)
(format t "~%=== Initializing Skills BEFORE running tests ===~%") (format t "~%=== Initializing Skills BEFORE running tests ===~%")
(opencortex:initialize-all-skills) (opencortex:initialize-all-skills)

1
skills Symbolic link
View File

@@ -0,0 +1 @@
lisp

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

@@ -1,32 +0,0 @@
#+TITLE: SKILL: Gardener (org-skill-gardener.org)
#+AUTHOR: Agent
#+FILETAGS: :skill:maintenance:gardener:
#+PROPERTY: header-args:lisp :tangle org-skill-gardener.lisp
* Overview
The *Gardener Skill* performs periodic maintenance on the Memex knowledge graph.
* Implementation
** Maintenance Logic
#+begin_src lisp
(defun gardener-prune-orphans ()
"Identifies and handles orphaned objects in memory."
(harness-log "GARDENER: Pruning orphans..."))
(defun gardener-verify-merkle-integrity ()
"Validates the hashes of all objects in memory."
(harness-log "GARDENER: Verifying Merkle integrity..."))
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :skill-gardener
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
:deterministic (lambda (action ctx)
(declare (ignore action ctx))
(gardener-prune-orphans)
(gardener-verify-merkle-integrity)
nil))
#+end_src

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

@@ -1,26 +0,0 @@
#+TITLE: SKILL: Peripheral Vision (org-skill-peripheral-vision.org)
#+AUTHOR: Agent
#+FILETAGS: :harness:peripheral:context:
#+PROPERTY: header-args:lisp :tangle org-skill-peripheral-vision.lisp
* Overview
The *Peripheral Vision* skill enhances the context engine with high-level summaries of distant memory nodes.
* Implementation
** Context Logic
#+begin_src lisp
(defun peripheral-vision-summarize (obj-id)
"Generates a low-resolution summary of an object."
(let ((obj (lookup-object obj-id)))
(if obj
(format nil "Node: ~a (~a)" (getf (org-object-attributes obj) :TITLE) obj-id)
"[Unknown Node]")))
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :skill-peripheral-vision
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src

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

@@ -1,24 +0,0 @@
#+TITLE: SKILL: Self Edit (org-skill-self-edit.org)
#+AUTHOR: Agent
#+FILETAGS: :system:autonomy:self-edit:
#+PROPERTY: header-args:lisp :tangle org-skill-self-edit.lisp
* Overview
The *Self Edit* skill allows the OpenCortex Agent to modify its own literate source code.
* Implementation
** Self-Edit Logic
#+begin_src lisp
(defun self-edit-apply (filepath old-text new-text)
"Applies a transformation to a source file."
(declare (ignore old-text new-text))
(harness-log "SELF-EDIT: Applying changes to ~a" filepath))
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :skill-self-edit
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src

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

@@ -1,25 +0,0 @@
#+TITLE: SKILL: Self Fix (org-skill-self-fix.org)
#+AUTHOR: Agent
#+FILETAGS: :system:autonomy:self-fix:
#+PROPERTY: header-args:lisp :tangle org-skill-self-fix.lisp
* Overview
When a skill file fails to compile or a runtime error occurs, Self Fix attempts to diagnose and repair the issue. It receives error logs from the skill loader, identifies the broken file, and generates a corrected version that is hot-reloaded into the running image.
* Implementation
** Self-Fix Logic
#+begin_src lisp
(defun self-fix-broken-skill (skill-name error-log)
"Attempts to diagnose and repair a broken skill."
(declare (ignore error-log))
(harness-log "SELF-FIX: Attempting repair of ~a..." skill-name))
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :skill-self-fix
:priority 100
:trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :EVENT)))
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
#+end_src

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

@@ -1,38 +0,0 @@
#+TITLE: SKILL: Tool Permissions (org-skill-tool-permissions.org)
#+AUTHOR: Agent
#+FILETAGS: :skill:security:permissions:
#+PROPERTY: header-args:lisp :tangle org-skill-tool-permissions.lisp
* Overview
The *Tool Permissions* skill manages the authorization levels for different cognitive tools.
* Implementation
** Permission store (tool level)
Hash table mapping tool names to their permission level.
#+begin_src lisp
(defvar *tool-permissions* (make-hash-table :test 'equal))
#+end_src
** Set permission
Sets the permission level for a specific cognitive tool.
#+begin_src lisp
(defun set-tool-permission (tool-name level)
"Sets the permission level for a tool."
(setf (gethash (string-downcase (string tool-name)) *tool-permissions*) level))
#+end_src
** Get permission
Retrieves the current permission level for a tool. Defaults to ~:ask~ if unset.
#+begin_src lisp
(defun get-tool-permission (tool-name)
"Retrieves the permission level for a tool. Defaults to :ask."
(gethash (string-downcase (string tool-name)) *tool-permissions* :ask))
#+end_src
** Skill Registration
#+begin_src lisp
(defskill :skill-tool-permissions
:priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
#+end_src