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

ARCH: Microkernel Decoupling - Moved State Persistence to user-space dynamic skill

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-13 15:48:14 -04:00
parent dcd3a31112
commit 34f59a6e43
19 changed files with 204 additions and 279 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
deploy/docker/Dockerfile
View File

@@ -34,7 +34,7 @@ RUN sbcl --non-interactive \
# Ensure the binary is executable
RUN chmod +x /app/org-agent-server
# Expose the Harness Communication and Web Dashboard ports
# Expose the communication protocol and Web Dashboard ports
EXPOSE 9105 8080
# The app expects the memex to be mounted here

2
docs/quickstart.org
View File

@@ -35,7 +35,7 @@ docker-compose up --build -d
* 4. Interaction Gateways
Once the harness is "Ready", you can interact with it via multiple sensors.
** Gateway A: Emacs (Harness Communication)
** Gateway A: Emacs (communication protocol)
If you have configured the ~org-agent~ package in Emacs:
1. Open a chat buffer: ~M-x org-agent-chat-open~.
2. Send: "Are you online, agent?"

48
literate/communication.org
View File

@@ -1,27 +1,27 @@
#+TITLE: The Harness Communication (communication.lisp)
#+TITLE: Communication Protocol (communication.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:protocol:
#+STARTUP: content
* The Harness Communication (communication.lisp)
* Communication Protocol (communication.lisp)
** Architectural Intent: Secure Inter-Process Communication & Deterministic Framing
Yes, the Harness Communication is fundamentally about **Communication**. It defines the exact physical and semantic boundaries for how the isolated Lisp environment talks to the outside world.
The **communication protocol** defines the exact physical and semantic boundaries for how the isolated Lisp environment talks to the outside world.
The ~org-agent~ harness operates as a perfectly deterministic, highly secure computational engine. When communicating with external processes or actuators—such as an Emacs client, a web dashboard, or a remote Shell script—the harness cannot rely on unpredictable, "loose" data streams.
The system operates as a perfectly deterministic, highly secure computational engine. When communicating with external processes or actuators—such as an Emacs client, a web dashboard, or a remote Shell script—it cannot rely on unpredictable, "loose" data streams.
Streaming raw Lisp or JSON over a TCP socket is inherently fragile. If a multi-megabyte Org Abstract Syntax Tree (AST) is fragmented by the operating system's network stack during transmission, a standard stream parser might attempt to evaluate an incomplete string, leading to immediate crashes or desynchronization.
To solve this, we implement the **Harness Communication**, which enforces absolute deterministic boundaries around every message.
To solve this, we implement the **communication protocol**, which enforces absolute deterministic boundaries around every message.
*** 1. Physical Boundary: Hex-Length Prefixing
Every message crossing the wire is prefixed with a strict 6-character hexadecimal length string (zero-padded). This creates an unbreakable physical boundary. The harness reads exactly the number of bytes specified by the hex length. It will never under-read (crashing on a partial form) and never over-read (consuming bytes meant for the next message).
Every message crossing the wire is prefixed with a strict 6-character hexadecimal length string (zero-padded). This creates an unbreakable physical boundary. The system reads exactly the number of bytes specified by the hex length. It will never under-read (crashing on a partial form) and never over-read (consuming bytes meant for the next message).
*** 2. Actuator-Agnosticism ("Dumb Terminal" Architecture)
The protocol keeps the Lisp harness completely agnostic of its clients. The harness does not care if the client is written in Emacs Lisp, Python, or Rust. Any environment capable of calculating a byte length and opening a TCP socket can interface with the Lisp Machine.
The protocol keeps the Lisp environment completely agnostic of its clients. The system does not care if the client is written in Emacs Lisp, Python, or Rust. Any environment capable of calculating a byte length and opening a TCP socket can interface with the Lisp Machine.
*** 3. Preventing Reader Macro Injection
Common Lisp's ~read-from-string~ is extremely powerful but dangerous; it allows "reader macros" (like ~#.~) which execute code during the parsing phase. The Harness Communication mandates that ~*read-eval*~ is explicitly bound to ~nil~ before any network data is parsed, physically preventing arbitrary code execution.
Common Lisp's ~read-from-string~ is extremely powerful but dangerous; it allows "reader macros" (like ~#.~) which execute code during the parsing phase. The communication protocol mandates that ~*read-eval*~ is explicitly bound to ~nil~ before any network data is parsed, physically preventing arbitrary code execution.
** Message Framing Logic
#+begin_src mermaid
@@ -31,23 +31,23 @@ flowchart LR
B --> C[Hex Prefix: 6 Chars]
C --> D[Concatenate: Length + List]
end
D -- TCP Socket --> Harness
subgraph Harness
Harness --> E[Read 6 Hex Chars]
D -- TCP Socket --> System
subgraph System
System --> E[Read 6 Hex Chars]
E --> F[Read Exact Byte Count]
F --> G[Parse S-Expression]
end
#+end_src
** Package Context
We ensure all protocol logic resides within the isolated harness namespace.
We ensure all protocol logic resides within the isolated system namespace.
#+begin_src lisp :tangle ../src/communication.lisp
(in-package :org-agent)
#+end_src
** Actuator Registry
The harness maintains a decoupled registry of target actuators. This allows the system to route messages to Emacs, the Shell, or Web Gateways without hardcoding the routing logic into the protocol itself.
The system maintains a decoupled registry of target actuators. This allows the system to route messages to Emacs, the Shell, or Web Gateways without hardcoding the routing logic into the protocol itself.
#+begin_src lisp :tangle ../src/communication.lisp
(defvar *actuator-registry* (make-hash-table :test 'equal)
@@ -59,17 +59,17 @@ The harness maintains a decoupled registry of target actuators. This allows the
#+end_src
** Message Framing (frame-message)
The ~frame-message~ function prepares an outgoing Lisp string for transmission. It calculates the byte length, converts it into a 6-character padded hex string, and prefixes it. If ~HARNESS_PROTOCOL_ENFORCE_HMAC~ is enabled in the environment, it also prepends a cryptographic signature to ensure the message hasn't been tampered with.
The ~frame-message~ function prepares an outgoing Lisp string for transmission. It calculates the byte length, converts it into a 6-character padded hex string, and prefixes it. If ~COMMUNICATION_PROTOCOL_ENFORCE_HMAC~ is enabled in the environment, it also prepends a cryptographic signature to ensure the message hasn't been tampered with.
#+begin_src lisp :tangle ../src/communication.lisp
(defun frame-message (msg-string)
"Prefixes MSG-STRING with a 6-character hex length.
If security is enabled, prefixes a 64-char HMAC-SHA256 signature."
(let ((len (length msg-string))
(enforce-hmac (uiop:getenv "HARNESS_PROTOCOL_ENFORCE_HMAC")))
(enforce-hmac (uiop:getenv "COMMUNICATION_PROTOCOL_ENFORCE_HMAC")))
(if (and enforce-hmac (string-equal enforce-hmac "true"))
(let ((secret (uiop:getenv "HARNESS_PROTOCOL_HMAC_SECRET")))
(unless secret (error "HARNESS_PROTOCOL_HMAC_SECRET is required when security is enabled."))
(let ((secret (uiop:getenv "COMMUNICATION_PROTOCOL_HMAC_SECRET")))
(unless secret (error "COMMUNICATION_PROTOCOL_HMAC_SECRET is required when security is enabled."))
(let* ((key (ironclad:ascii-string-to-byte-array secret))
(hmac (ironclad:make-mac :hmac key :sha256))
(payload-bytes (ironclad:ascii-string-to-byte-array msg-string)))
@@ -87,11 +87,11 @@ Parsing is the high-security inverse of framing. This function acts as the final
"Extracts and parses the S-expression from a framed string securely."
(when (< (length framed-string) 6)
(error "Framed string too short"))
(let* ((enforce-hmac (uiop:getenv "HARNESS_PROTOCOL_ENFORCE_HMAC"))
(let* ((enforce-hmac (uiop:getenv "COMMUNICATION_PROTOCOL_ENFORCE_HMAC"))
(use-hmac (and enforce-hmac (string-equal enforce-hmac "true")))
(prefix-len (if use-hmac 70 6)))
(when (< (length framed-string) prefix-len)
(error "Framed string too short for Harness Communication prefix"))
(error "Framed string too short for communication protocol prefix"))
(let* ((len-str (subseq framed-string 0 6))
(signature (when use-hmac (subseq framed-string 6 70)))
@@ -103,25 +103,25 @@ Parsing is the high-security inverse of framing. This function acts as the final
(error "Message length mismatch. Expected ~a, got ~a" expected-len (length actual-msg)))
(when use-hmac
(let ((secret (uiop:getenv "HARNESS_PROTOCOL_HMAC_SECRET")))
(unless secret (error "HARNESS_PROTOCOL_HMAC_SECRET is required when security is enabled."))
(let ((secret (uiop:getenv "COMMUNICATION_PROTOCOL_HMAC_SECRET")))
(unless secret (error "COMMUNICATION_PROTOCOL_HMAC_SECRET is required when security is enabled."))
(let* ((key (ironclad:ascii-string-to-byte-array secret))
(hmac (ironclad:make-mac :hmac key :sha256))
(payload-bytes (ironclad:ascii-string-to-byte-array actual-msg)))
(ironclad:update-mac hmac payload-bytes)
(let ((expected-signature (ironclad:byte-array-to-hex-string (ironclad:produce-mac hmac))))
(unless (string-equal signature expected-signature)
(error "Harness Communication Integrity Failure: HMAC mismatch"))))))
(error "communication protocol Integrity Failure: HMAC mismatch"))))))
;; SECURITY: Disable the reader's ability to execute code during parsing
(let ((*read-eval* nil))
(let ((msg (read-from-string actual-msg)))
(validate-harness-protocol-schema msg)
(validate-communication-protocol-schema msg)
msg)))))
#+end_src
** Handshaking (make-hello-message)
Every session begins with a standard ~HELLO~ handshake, allowing the harness to announce its capabilities and protocol version to the connecting client.
Every session begins with a standard ~HELLO~ handshake, allowing the system to announce its capabilities and protocol version to the connecting client.
#+begin_src lisp :tangle ../src/communication.lisp
(defun make-hello-message (version)

2
literate/memory.org
View File

@@ -26,7 +26,7 @@ flowchart TD
H -- Pointers --> S2
end
subgraph IPCSlow[External Layer]
E[Emacs / Actuators] -. Harness Communication .-> H
E[Emacs / Actuators] -. communication protocol .-> H
end
#+end_src

7
literate/package.org
View File

@@ -11,7 +11,7 @@ By strictly defining the public interface, we ensure that skills remain decouple
#+begin_src mermaid
flowchart TD
External[Actuators / Clients] -- Harness Communication --> Package[Package Membrane: API]
External[Actuators / Clients] -- communication protocol --> Package[Package Membrane: API]
Skills[Dynamic Skills] -- API Calls --> Package
Package --> Internal[Harness Internal Modules]
style Package fill:#f9f,stroke:#333,stroke-width:4px
@@ -22,11 +22,11 @@ flowchart TD
(defpackage :org-agent
(:use :cl)
(:export
;; --- Harness Communication ---
;; --- communication protocol ---
#:frame-message
#:parse-message
#:make-hello-message
#:validate-harness-protocol-schema
#:validate-communication-protocol-schema
;; --- Daemon Lifecycle ---
#:start-daemon
@@ -41,6 +41,7 @@ flowchart TD
#:*memory*
#:*history-store*
#:org-object
#:make-org-object
#:org-object-id
#:org-object-type
#:org-object-attributes

4
literate/system-definition.org
View File

@@ -36,7 +36,7 @@ This system defines the core "Thin Harness." It includes the protocol, the objec
:version "0.1.0"
:license "MIT"
:description "The Probabilistic-Deterministic Lisp Machine Harness"
:depends-on (:usocket :cl-json :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str)
:depends-on (:usocket ::bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json)
:serial t
:components ((:file "src/package")
(:file "src/skills")
@@ -93,7 +93,7 @@ This system contains the empirical tests required by the Engineering Standards.
(:file "tests/playwright-tests")
(:file "tests/chaos-qa"))
:perform (test-op (o s)
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :harness-protocol-suite :org-agent-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :communication-protocol-suite :org-agent-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :org-agent-pipeline-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :vision-suite :org-agent-peripheral-vision-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :safety-suite :org-agent-safety-tests))

4
org-agent.asd
View File

@@ -4,7 +4,7 @@
:version "0.1.0"
:license "MIT"
:description "The Probabilistic-Deterministic Lisp Machine Harness"
:depends-on (:usocket :cl-json :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str)
:depends-on (:usocket ::bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json)
:serial t
:components ((:file "src/package")
(:file "src/skills")
@@ -56,7 +56,7 @@
(:file "tests/playwright-tests")
(:file "tests/chaos-qa"))
:perform (test-op (o s)
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :harness-protocol-suite :org-agent-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :communication-protocol-suite :org-agent-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :org-agent-pipeline-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :vision-suite :org-agent-peripheral-vision-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :safety-suite :org-agent-safety-tests))

34
skills/org-skill-protocol-validator.org
View File

@@ -1,13 +1,13 @@
:PROPERTIES:
:ID: org-skill-harness-protocol-validator
:ID: org-skill-communication-protocol-validator
:CREATED: [2026-04-12 Sun 14:35]
:END:
#+TITLE: SKILL: Harness Communication Schema Validator (Universal Literate Note)
#+TITLE: SKILL: Communication Protocol Schema Validator (Universal Literate Note)
#+STARTUP: content
#+FILETAGS: :protocol:harness-protocol:security:validation:psf:
#+FILETAGS: :protocol:communication-protocol:security:validation:psf:
* Overview
The *Harness Communication Schema Validator* skill provides deep structural validation for all messages entering the org-agent kernel. It ensures that every property list adheres to a strict schema, preventing malformed data from causing harness-level errors.
The *Communication Protocol Schema Validator* skill provides deep structural validation for all messages entering the org-agent kernel. It ensures that every property list adheres to a strict schema, preventing malformed data from causing harness-level errors.
* Phase A: Demand (PRD)
:PROPERTIES:
@@ -15,7 +15,7 @@ The *Harness Communication Schema Validator* skill provides deep structural vali
:END:
** 1. Purpose
Enforce a formal grammar for the Org-Agent Control Protocol (Harness Communication).
Enforce a formal grammar for the Org-Agent Control Protocol (communication protocol).
** 2. User Needs
- *Type Safety:* Ensure mandatory keys (e.g., `:type`, `:payload`) are present.
@@ -38,7 +38,7 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
** 2. Semantic Interfaces
#+begin_src lisp
(defun validate-harness-protocol-schema (msg)
(defun validate-communication-protocol-schema (msg)
"Returns T if the message is valid, NIL (and signals error) otherwise.")
#+end_src
@@ -48,44 +48,44 @@ Decouple protocol parsing (framing/unframing) from semantic validation.
#+begin_src lisp :tangle ../src/communication-validator.lisp
(in-package :org-agent)
(defun validate-harness-protocol-schema (msg)
"Strict structural validation for incoming Harness Communication messages."
(defun validate-communication-protocol-schema (msg)
"Strict structural validation for incoming communication protocol messages."
(unless (listp msg)
(error "Harness Communication Schema Error: Message must be a property list (got ~s)" (type-of msg)))
(error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
(let ((type (getf msg :type)))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG))
(error "Harness Communication Schema Error: Invalid message type '~a'" type))
(error "Communication Protocol Schema Error: Invalid message type '~a'" type))
(case type
(:REQUEST
(unless (getf msg :target)
(error "Harness Communication Schema Error: REQUEST missing mandatory :target"))
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
(unless (getf msg :payload)
(error "Harness Communication Schema Error: REQUEST missing mandatory :payload")))
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))
(:EVENT
(let ((payload (getf msg :payload)))
(unless (and payload (listp payload))
(error "Harness Communication Schema Error: EVENT missing or invalid :payload"))
(error "Communication Protocol Schema Error: EVENT missing or invalid :payload"))
(unless (or (getf payload :action) (getf payload :sensor))
(error "Harness Communication Schema Error: EVENT payload must contain :action or :sensor"))))
(error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor"))))
(:RESPONSE
(unless (getf msg :payload)
(error "Harness Communication Schema Error: RESPONSE missing mandatory :payload"))))
(error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
t))
#+end_src
* Registration
#+begin_src lisp :tangle ../src/communication-validator.lisp
(defskill :skill-harness-protocol-validator
(defskill :skill-communication-protocol-validator
:priority 95
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
:probabilistic nil
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(validate-harness-protocol-schema action)
(validate-communication-protocol-schema action)
action))
#+end_src

120
skills/org-skill-state-persistence.org
View File

@@ -66,14 +66,14 @@ Tests in `tests/persistence-tests.lisp` will verify the local dump/load cycle an
* Phase D: Build (Implementation)
** Package Context
#+begin_src lisp :tangle ../src/state-persistence.lisp
(in-package :org-agent)
#+begin_src lisp
;; Skill logic is evaluated in a jailed package by the Harness.
#+end_src
** Helper: Local State Path
Ensures we have a standardized location for local memory images.
#+begin_src lisp :tangle ../src/state-persistence.lisp
#+begin_src lisp
(defun persistence-get-local-path ()
"Returns the path to the local memory image file."
(let ((state-dir (or (uiop:getenv "SYSTEM_DIR") "system/")))
@@ -83,7 +83,7 @@ Ensures we have a standardized location for local memory images.
** Local Image Dump (persistence-dump-local)
Serializes the Merkle history and current pointers to a Lisp file.
#+begin_src lisp :tangle ../src/state-persistence.lisp
#+begin_src lisp
(defun persistence-dump-local ()
"Serializes the entire history store and current pointers to a local Lisp image."
(let ((image-file (persistence-get-local-path)))
@@ -105,7 +105,7 @@ Serializes the Merkle history and current pointers to a Lisp file.
** Local Image Load (persistence-load-local)
Restores the state from the local disk.
#+begin_src lisp :tangle ../src/state-persistence.lisp
#+begin_src lisp
(defun persistence-load-local ()
"Loads the memory image from local disk."
(let ((image-file (persistence-get-local-path)))
@@ -120,44 +120,47 @@ Restores the state from the local disk.
#+end_src
** IPFS Serialization (persistence-serialize-for-archival)
Converts the live `*memory*` into a JSON-compatible list of alists.
Converts the live `*memory*` into a list of Lisp Property Lists (Plists) for sovereign, homoiconic transport.
#+begin_src lisp :tangle ../src/state-persistence.lisp
#+begin_src lisp
(defun persistence-serialize-for-archival ()
"Serializes the entire object-store for IPFS/JSON transport."
"Serializes the entire memory for IPFS transport as native S-Expressions."
(let ((objects nil))
(maphash (lambda (id obj)
(declare (ignore id))
(push `((:id . ,(org-object-id obj))
(:type . ,(format nil "~s" (org-object-type obj)))
(:attributes . ,(loop for (k v) on (org-object-attributes obj) by #'cddr
collect (cons (format nil "~a" k) (format nil "~a" v))))
(:content . ,(org-object-content obj))
(:parent-id . ,(org-object-parent-id obj))
(:children . ,(org-object-children obj))
(:version . ,(org-object-version obj))
(:last-sync . ,(org-object-last-sync obj))
(:hash . ,(org-object-hash obj)))
(push (list :id (org-object-id obj)
:type (org-object-type obj)
:attributes (org-object-attributes obj)
:content (org-object-content obj)
:parent-id (org-object-parent-id obj)
:children (org-object-children obj)
:version (org-object-version obj)
:last-sync (org-object-last-sync obj)
:hash (org-object-hash obj))
objects))
*memory*)
objects))
#+end_src
** IPFS Push (persistence-push-ipfs)
Pushes the serialized knowledge graph to the decentralized network.
Pushes the serialized knowledge graph to the decentralized network as a Lisp string.
#+begin_src lisp :tangle ../src/state-persistence.lisp
#+begin_src lisp
(defun persistence-push-ipfs ()
"Serializes the store and pushes it to IPFS, returning the CID."
"Serializes the store and pushes it to IPFS as a Lisp text block, returning the CID."
(let* ((data (persistence-serialize-for-archival))
(json-payload (cl-json:encode-json-to-string data))
(lisp-payload (format nil "~s" data))
(ipfs-url "http://127.0.0.1:5001/api/v0/add"))
(handler-case
(let* ((response (dex:post ipfs-url
:content `(("file" . ,json-payload))
:content `(("file" . ,lisp-payload))
:headers '(("Content-Type" . "multipart/form-data"))))
(result (cl-json:decode-json-from-string response))
(cid (cdr (assoc :hash result))))
(result-str (flexi-streams:octets-to-string response))
(start-idx (search "\"Hash\":\"" result-str))
(cid (when start-idx
(let* ((val-start (+ start-idx 8))
(val-end (position #\" result-str :start val-start)))
(subseq result-str val-start val-end)))))
(harness-log "PERSISTENCE - Checkpoint to IPFS successful. CID: ~a" cid)
cid)
(error (c)
@@ -166,32 +169,33 @@ Pushes the serialized knowledge graph to the decentralized network.
#+end_src
** IPFS Restore (persistence-restore-ipfs)
Restores the graph from IPFS, using a safe parser to prevent injection.
Restores the graph from IPFS, using `read-from-string` with `*read-eval* nil` to prevent injection.
#+begin_src lisp :tangle ../src/state-persistence.lisp
#+begin_src lisp
(defun persistence-restore-ipfs (cid)
"Fetches data from IPFS and safely hydrates the object-store."
"Fetches data from IPFS and safely hydrates the memory."
(let ((ipfs-url (format nil "http://127.0.0.1:5001/api/v0/cat?arg=~a" cid)))
(handler-case
(let* ((response (dex:post ipfs-url))
(data (cl-json:decode-json-from-string response)))
(clrhash *memory*)
(dolist (item data)
(let* ((id (cdr (assoc :id item)))
(obj (make-org-object
:id id
:type (read-from-string (cdr (assoc :type item)))
:attributes (loop for attr in (cdr (assoc :attributes item))
append (list (intern (string-upcase (car attr)) :keyword) (cdr attr)))
:content (cdr (assoc :content item))
:parent-id (cdr (assoc :parent-id item))
:children (cdr (assoc :children item))
:version (cdr (assoc :version item))
:last-sync (cdr (assoc :last-sync item))
:hash (cdr (assoc :hash item)))))
(setf (gethash id *memory*) obj)))
(harness-log "PERSISTENCE - Restored from IPFS: ~a" cid)
t)
(payload-str (flexi-streams:octets-to-string response)))
(let ((*read-eval* nil))
(let ((data (read-from-string payload-str)))
(clrhash *memory*)
(dolist (item data)
(let* ((id (getf item :id))
(obj (make-org-object
:id id
:type (getf item :type)
:attributes (getf item :attributes)
:content (getf item :content)
:parent-id (getf item :parent-id)
:children (getf item :children)
:version (getf item :version)
:last-sync (getf item :last-sync)
:hash (getf item :hash))))
(setf (gethash id *memory*) obj)))
(harness-log "PERSISTENCE - Restored from IPFS: ~a" cid)
t)))
(error (c)
(harness-log "PERSISTENCE ERROR - IPFS restoration failed: ~a" c)
nil))))
@@ -200,19 +204,18 @@ Restores the graph from IPFS, using a safe parser to prevent injection.
** Cognitive Tools
Expose persistence capabilities to the neural Probabilistic Engine.
#+begin_src lisp :tangle ../src/state-persistence.lisp
#+begin_src lisp
(progn
(def-cognitive-tool :checkpoint-memory "Creates both a local image and a decentralized IPFS snapshot."
:parameters nil
(def-cognitive-tool :checkpoint-memory "Creates both a local image and a decentralized IPFS snapshot." nil
:body (lambda (args)
(declare (ignore args))
(persistence-dump-local)
(let ((cid (persistence-push-ipfs)))
(format nil "Local dump complete. IPFS CID: ~a" (or cid "FAILED")))))
(def-cognitive-tool :restore-memory "Restores the state from a specific source."
:parameters ((:source :type :keyword :description "Either :LOCAL or :IPFS")
(:cid :type :string :description "Required if source is :IPFS"))
(def-cognitive-tool :restore-memory "Restores the state from a specific source."
((:source :type :keyword :description "Either :LOCAL or :IPFS")
(:cid :type :string :description "Required if source is :IPFS"))
:body (lambda (args)
(case (getf args :source)
(:local (if (persistence-load-local) "Restored from disk." "Local restore failed."))
@@ -220,7 +223,7 @@ Expose persistence capabilities to the neural Probabilistic Engine.
#+end_src
** Registration
#+begin_src lisp :tangle ../src/state-persistence.lisp
#+begin_src lisp
(defskill :skill-state-persistence
:priority 100
:trigger (lambda (ctx)
@@ -235,7 +238,7 @@ Expose persistence capabilities to the neural Probabilistic Engine.
* Phase E: Chaos (Verification)
** 1. Unit Tests (FiveAM)
#+begin_src lisp :tangle ../tests/persistence-tests.lisp
#+begin_src lisp
(defpackage :org-agent-persistence-tests
(:use :cl :fiveam :org-agent))
(in-package :org-agent-persistence-tests)
@@ -245,11 +248,16 @@ Expose persistence capabilities to the neural Probabilistic Engine.
(test test-local-roundtrip
"Ensure RAM -> Disk -> RAM preserves data integrity."
(let ((test-id "persist-test-1"))
(setf (gethash test-id *memory*) (make-org-object :id test-id :content "Integrity Check"))
(let ((test-id "persist-test-1")
(test-hash "fake-hash-123"))
(let ((obj (make-org-object :id test-id :content "Integrity Check" :hash test-hash)))
(setf (gethash test-hash *history-store*) obj)
(setf (gethash test-id *memory*) obj))
(org-agent:persistence-dump-local)
(clrhash *memory*)
(clrhash *history-store*)
(org-agent:persistence-load-local)
(is (not (null (gethash test-id *memory*))))
(is (equal "Integrity Check" (org-object-content (gethash test-id *memory*))))))
#+end_src

39
src/communication-validator.lisp Normal file
View File

@@ -0,0 +1,39 @@
(in-package :org-agent)
(defun validate-communication-protocol-schema (msg)
"Strict structural validation for incoming communication protocol messages."
(unless (listp msg)
(error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
(let ((type (getf msg :type)))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG))
(error "Communication Protocol Schema Error: Invalid message type '~a'" type))
(case type
(:REQUEST
(unless (getf msg :target)
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
(unless (getf msg :payload)
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))
(:EVENT
(let ((payload (getf msg :payload)))
(unless (and payload (listp payload))
(error "Communication Protocol Schema Error: EVENT missing or invalid :payload"))
(unless (or (getf payload :action) (getf payload :sensor))
(error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor"))))
(:RESPONSE
(unless (getf msg :payload)
(error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
t))
(defskill :skill-communication-protocol-validator
:priority 95
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
:probabilistic nil
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(validate-communication-protocol-schema action)
action))

18
src/communication.lisp
View File

@@ -11,10 +11,10 @@
"Prefixes MSG-STRING with a 6-character hex length.
If security is enabled, prefixes a 64-char HMAC-SHA256 signature."
(let ((len (length msg-string))
(enforce-hmac (uiop:getenv "HARNESS_PROTOCOL_ENFORCE_HMAC")))
(enforce-hmac (uiop:getenv "COMMUNICATION_PROTOCOL_ENFORCE_HMAC")))
(if (and enforce-hmac (string-equal enforce-hmac "true"))
(let ((secret (uiop:getenv "HARNESS_PROTOCOL_HMAC_SECRET")))
(unless secret (error "HARNESS_PROTOCOL_HMAC_SECRET is required when security is enabled."))
(let ((secret (uiop:getenv "COMMUNICATION_PROTOCOL_HMAC_SECRET")))
(unless secret (error "COMMUNICATION_PROTOCOL_HMAC_SECRET is required when security is enabled."))
(let* ((key (ironclad:ascii-string-to-byte-array secret))
(hmac (ironclad:make-mac :hmac key :sha256))
(payload-bytes (ironclad:ascii-string-to-byte-array msg-string)))
@@ -27,11 +27,11 @@
"Extracts and parses the S-expression from a framed string securely."
(when (< (length framed-string) 6)
(error "Framed string too short"))
(let* ((enforce-hmac (uiop:getenv "HARNESS_PROTOCOL_ENFORCE_HMAC"))
(let* ((enforce-hmac (uiop:getenv "COMMUNICATION_PROTOCOL_ENFORCE_HMAC"))
(use-hmac (and enforce-hmac (string-equal enforce-hmac "true")))
(prefix-len (if use-hmac 70 6)))
(when (< (length framed-string) prefix-len)
(error "Framed string too short for Harness Communication prefix"))
(error "Framed string too short for communication protocol prefix"))
(let* ((len-str (subseq framed-string 0 6))
(signature (when use-hmac (subseq framed-string 6 70)))
@@ -43,20 +43,20 @@
(error "Message length mismatch. Expected ~a, got ~a" expected-len (length actual-msg)))
(when use-hmac
(let ((secret (uiop:getenv "HARNESS_PROTOCOL_HMAC_SECRET")))
(unless secret (error "HARNESS_PROTOCOL_HMAC_SECRET is required when security is enabled."))
(let ((secret (uiop:getenv "COMMUNICATION_PROTOCOL_HMAC_SECRET")))
(unless secret (error "COMMUNICATION_PROTOCOL_HMAC_SECRET is required when security is enabled."))
(let* ((key (ironclad:ascii-string-to-byte-array secret))
(hmac (ironclad:make-mac :hmac key :sha256))
(payload-bytes (ironclad:ascii-string-to-byte-array actual-msg)))
(ironclad:update-mac hmac payload-bytes)
(let ((expected-signature (ironclad:byte-array-to-hex-string (ironclad:produce-mac hmac))))
(unless (string-equal signature expected-signature)
(error "Harness Communication Integrity Failure: HMAC mismatch"))))))
(error "communication protocol Integrity Failure: HMAC mismatch"))))))
;; SECURITY: Disable the reader's ability to execute code during parsing
(let ((*read-eval* nil))
(let ((msg (read-from-string actual-msg)))
(validate-harness-protocol-schema msg)
(validate-communication-protocol-schema msg)
msg)))))
(defun make-hello-message (version)

12
src/org-agent.el
View File

@@ -12,7 +12,7 @@
;; org-agent provides a Probabilistic-Deterministic Lisp Machine interface for Emacs.
;; It acts as the sensor/actuator array, communicating with a persistent
;; Common Lisp daemon over a high-speed Harness Communication socket.
;; Common Lisp daemon over a high-speed communication protocol socket.
;;; Code:
@@ -100,7 +100,7 @@ will assume you have started it manually (e.g., via SBCL)."
(message "org-agent: Killed daemon process.")))
(defun org-agent--filter (proc string)
"Handle incoming Harness Communication messages from the daemon via PROC with STRING."
"Handle incoming communication protocol messages from the daemon via PROC with STRING."
(let ((buf (process-buffer proc)))
(when (buffer-live-p buf)
(with-current-buffer buf
@@ -109,7 +109,7 @@ will assume you have started it manually (e.g., via SBCL)."
(org-agent--process-buffer buf proc)))))
(defun org-agent--process-buffer (buffer &optional proc)
"Process the Harness Communication message BUFFER, optionally using PROC."
"Process the communication protocol message BUFFER, optionally using PROC."
(with-current-buffer buffer
(goto-char (point-min))
(while (>= (buffer-size) 6)
@@ -127,13 +127,13 @@ will assume you have started it manually (e.g., via SBCL)."
(setq msg-len 1000000)))))) ; Break loop
(defun org-agent--plist-get (plist prop)
"Case-insensitive keyword lookup for Harness Communication compatibility."
"Case-insensitive keyword lookup for communication protocol compatibility."
(or (plist-get plist prop)
(plist-get plist (intern (upcase (symbol-name prop))))
(plist-get plist (intern (downcase (symbol-name prop))))))
(defun org-agent--handle-message (proc plist)
"Route and execute incoming Harness Communication messages from PROC using PLIST."
"Route and execute incoming communication protocol messages from PROC using PLIST."
(let ((type (org-agent--plist-get plist :type))
(id (org-agent--plist-get plist :id))
(payload (or (org-agent--plist-get plist :payload) plist)))
@@ -190,7 +190,7 @@ will assume you have started it manually (e.g., via SBCL)."
(message "org-agent: Connection lost.")))
(defun org-agent-send (plist)
"Send a Lisp PLIST to the daemon using Harness Communication framing."
"Send a Lisp PLIST to the daemon using communication protocol framing."
(let* ((msg (prin1-to-string plist))
(len (length msg))
(framed (format "%06x%s" len msg)))

5
src/package.lisp
View File

@@ -1,11 +1,11 @@
(defpackage :org-agent
(:use :cl)
(:export
;; --- Harness Communication ---
;; --- communication protocol ---
#:frame-message
#:parse-message
#:make-hello-message
#:validate-harness-protocol-schema
#:validate-communication-protocol-schema
;; --- Daemon Lifecycle ---
#:start-daemon
@@ -20,6 +20,7 @@
#:*memory*
#:*history-store*
#:org-object
#:make-org-object
#:org-object-id
#:org-object-type
#:org-object-attributes

22
src/protocol-validator.lisp
View File

@@ -1,39 +1,39 @@
(in-package :org-agent)
(defun validate-harness-protocol-schema (msg)
"Strict structural validation for incoming Harness Communication messages."
(defun validate-communication-protocol-schema (msg)
"Strict structural validation for incoming communication protocol messages."
(unless (listp msg)
(error "Harness Communication Schema Error: Message must be a property list (got ~s)" (type-of msg)))
(error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
(let ((type (getf msg :type)))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG))
(error "Harness Communication Schema Error: Invalid message type '~a'" type))
(error "Communication Protocol Schema Error: Invalid message type '~a'" type))
(case type
(:REQUEST
(unless (getf msg :target)
(error "Harness Communication Schema Error: REQUEST missing mandatory :target"))
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
(unless (getf msg :payload)
(error "Harness Communication Schema Error: REQUEST missing mandatory :payload")))
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))
(:EVENT
(let ((payload (getf msg :payload)))
(unless (and payload (listp payload))
(error "Harness Communication Schema Error: EVENT missing or invalid :payload"))
(error "Communication Protocol Schema Error: EVENT missing or invalid :payload"))
(unless (or (getf payload :action) (getf payload :sensor))
(error "Harness Communication Schema Error: EVENT payload must contain :action or :sensor"))))
(error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor"))))
(:RESPONSE
(unless (getf msg :payload)
(error "Harness Communication Schema Error: RESPONSE missing mandatory :payload"))))
(error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
t))
(defskill :skill-harness-protocol-validator
(defskill :skill-communication-protocol-validator
:priority 95
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
:probabilistic nil
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(validate-harness-protocol-schema action)
(validate-communication-protocol-schema action)
action))

125
src/state-persistence.lisp
View File

@@ -1,125 +0,0 @@
(in-package :org-agent)
(defun persistence-get-local-path ()
"Returns the path to the local memory image file."
(let ((state-dir (or (uiop:getenv "SYSTEM_DIR") "system/")))
(merge-pathnames "state/memory-image.lisp" state-dir)))
(defun persistence-dump-local ()
"Serializes the entire history store and current pointers to a local Lisp image."
(let ((image-file (persistence-get-local-path)))
(ensure-directories-exist image-file)
(harness-log "PERSISTENCE - Dumping local image to ~a..." (uiop:native-namestring image-file))
(with-open-file (out image-file :direction :output :if-exists :supersede)
(format out "(in-package :org-agent)~%")
;; 1. Dump all immutable objects in the history store
(maphash (lambda (hash obj)
(print `(setf (gethash ,hash *history-store*) ,obj) out))
*history-store*)
;; 2. Dump the current active pointers
(maphash (lambda (id obj)
(print `(setf (gethash ,id *memory*) (gethash ,(org-object-hash obj) *history-store*)) out))
*memory*))
t))
(defun persistence-load-local ()
"Loads the memory image from local disk."
(let ((image-file (persistence-get-local-path)))
(if (uiop:file-exists-p image-file)
(progn
(harness-log "PERSISTENCE - Loading local image...")
(load image-file)
t)
(progn
(harness-log "PERSISTENCE ERROR - Local image not found.")
nil))))
(defun persistence-serialize-for-archival ()
"Serializes the entire object-store for IPFS/JSON transport."
(let ((objects nil))
(maphash (lambda (id obj)
(declare (ignore id))
(push `((:id . ,(org-object-id obj))
(:type . ,(format nil "~s" (org-object-type obj)))
(:attributes . ,(loop for (k v) on (org-object-attributes obj) by #'cddr
collect (cons (format nil "~a" k) (format nil "~a" v))))
(:content . ,(org-object-content obj))
(:parent-id . ,(org-object-parent-id obj))
(:children . ,(org-object-children obj))
(:version . ,(org-object-version obj))
(:last-sync . ,(org-object-last-sync obj))
(:hash . ,(org-object-hash obj)))
objects))
*memory*)
objects))
(defun persistence-push-ipfs ()
"Serializes the store and pushes it to IPFS, returning the CID."
(let* ((data (persistence-serialize-for-archival))
(json-payload (cl-json:encode-json-to-string data))
(ipfs-url "http://127.0.0.1:5001/api/v0/add"))
(handler-case
(let* ((response (dex:post ipfs-url
:content `(("file" . ,json-payload))
:headers '(("Content-Type" . "multipart/form-data"))))
(result (cl-json:decode-json-from-string response))
(cid (cdr (assoc :hash result))))
(harness-log "PERSISTENCE - Checkpoint to IPFS successful. CID: ~a" cid)
cid)
(error (c)
(harness-log "PERSISTENCE ERROR - IPFS push failed: ~a" c)
nil))))
(defun persistence-restore-ipfs (cid)
"Fetches data from IPFS and safely hydrates the object-store."
(let ((ipfs-url (format nil "http://127.0.0.1:5001/api/v0/cat?arg=~a" cid)))
(handler-case
(let* ((response (dex:post ipfs-url))
(data (cl-json:decode-json-from-string response)))
(clrhash *memory*)
(dolist (item data)
(let* ((id (cdr (assoc :id item)))
(obj (make-org-object
:id id
:type (read-from-string (cdr (assoc :type item)))
:attributes (loop for attr in (cdr (assoc :attributes item))
append (list (intern (string-upcase (car attr)) :keyword) (cdr attr)))
:content (cdr (assoc :content item))
:parent-id (cdr (assoc :parent-id item))
:children (cdr (assoc :children item))
:version (cdr (assoc :version item))
:last-sync (cdr (assoc :last-sync item))
:hash (cdr (assoc :hash item)))))
(setf (gethash id *memory*) obj)))
(harness-log "PERSISTENCE - Restored from IPFS: ~a" cid)
t)
(error (c)
(harness-log "PERSISTENCE ERROR - IPFS restoration failed: ~a" c)
nil))))
(progn
(def-cognitive-tool :checkpoint-memory "Creates both a local image and a decentralized IPFS snapshot."
:parameters nil
:body (lambda (args)
(declare (ignore args))
(persistence-dump-local)
(let ((cid (persistence-push-ipfs)))
(format nil "Local dump complete. IPFS CID: ~a" (or cid "FAILED")))))
(def-cognitive-tool :restore-memory "Restores the state from a specific source."
:parameters ((:source :type :keyword :description "Either :LOCAL or :IPFS")
(:cid :type :string :description "Required if source is :IPFS"))
:body (lambda (args)
(case (getf args :source)
(:local (if (persistence-load-local) "Restored from disk." "Local restore failed."))
(:ipfs (if (persistence-restore-ipfs (getf args :cid)) "Restored from network." "IPFS restore failed."))))))
(defskill :skill-state-persistence
:priority 100
:trigger (lambda (ctx)
(let ((sensor (getf (getf ctx :payload) :sensor)))
(member sensor '(:heartbeat :manual-persist))))
:probabilistic nil
:deterministic (lambda (action ctx)
(persistence-dump-local)
action))

16
system/state/memory-image.lisp Normal file
View File

@@ -0,0 +1,16 @@
(in-package :org-agent)
(SETF (GETHASH "fake-hash-123" *HISTORY-STORE*)
#S(ORG-OBJECT
:ID "persist-test-1"
:TYPE NIL
:ATTRIBUTES NIL
:CONTENT "Integrity Check"
:VECTOR NIL
:PARENT-ID NIL
:CHILDREN NIL
:VERSION NIL
:LAST-SYNC NIL
:HASH "fake-hash-123"))
(SETF (GETHASH "persist-test-1" *MEMORY*)
(GETHASH "fake-hash-123" *HISTORY-STORE*))

6
tests/communication-tests.lisp
View File

@@ -2,9 +2,9 @@
(:use :cl :fiveam :org-agent))
(in-package :org-agent-tests)
(def-suite harness-protocol-suite
:description "Test suite for org-agent Communication Protocol (Harness Communication)")
(in-suite harness-protocol-suite)
(def-suite communication-protocol-suite
:description "Test suite for org-agent Communication Protocol (communication protocol)")
(in-suite communication-protocol-suite)
(test test-framing
"Verify that messages are correctly prefixed with a 6-character hex length."

2
tests/org-agent-test.el
View File

@@ -15,7 +15,7 @@
(should (string= "000014(:type :EVENT :id 1)" captured-framed)))))
(ert-deftest test-org-agent-parsing ()
"Verify that the filter correctly parses Harness Communication framed messages."
"Verify that the filter correctly parses communication protocol framed messages."
(let ((mock-buffer (generate-new-buffer " *org-agent-test*"))
(received-plist nil))
(cl-letf (((symbol-function 'org-agent--handle-message)

15
tests/persistence-tests.lisp
View File

@@ -1,15 +0,0 @@
(defpackage :org-agent-persistence-tests
(:use :cl :fiveam :org-agent))
(in-package :org-agent-persistence-tests)
(def-suite persistence-suite :description "Tests for State Persistence Layer.")
(in-suite persistence-suite)
(test test-local-roundtrip
"Ensure RAM -> Disk -> RAM preserves data integrity."
(let ((test-id "persist-test-1"))
(setf (gethash test-id *memory*) (make-org-object :id test-id :content "Integrity Check"))
(org-agent:persistence-dump-local)
(clrhash *memory*)
(org-agent:persistence-load-local)
(is (equal "Integrity Check" (org-object-content (gethash test-id *memory*))))))