DOCS: Systematic overhaul of Literate source (Granularity & Technical Reasoning)
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
This commit is contained in:
@@ -4,134 +4,32 @@
|
||||
#+STARTUP: content
|
||||
|
||||
* Communication Protocol (communication.lisp)
|
||||
** Architectural Intent: Secure Inter-Process Communication & Deterministic Framing
|
||||
|
||||
The ~communication.lisp~ module defines the low-level transport and framing logic for OpenCortex stimuli.
|
||||
** Architectural Intent: Secure Inter-Process Communication
|
||||
The Communication Protocol is the bridge between the OpenCortex microharness and the outside world. To maintain the "Zero-Bloat" mandate, the protocol must be:
|
||||
1. **Lightweight:** Minimal overhead for low-latency terminal interaction.
|
||||
2. **Deterministic:** Strict S-expression framing to prevent injection attacks.
|
||||
3. **Transport-Agnostic:** Capable of running over TCP, Unix Sockets, or Standard I/O.
|
||||
|
||||
* Implementation (communication.lisp)
|
||||
|
||||
#+begin_src lisp :tangle ../src/package.lisp
|
||||
(in-package :opencortex)
|
||||
|
||||
(defun proto-get (plist key)
|
||||
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
|
||||
(let* ((s (string key))
|
||||
(up (intern (string-upcase s) :keyword))
|
||||
(dn (intern (string-downcase s) :keyword)))
|
||||
(or (getf plist up) (getf plist dn))))
|
||||
#+end_src
|
||||
By utilizing a length-prefixed S-expression format (the "Unified Envelope"), we ensure that both human-readable text and complex Lisp data structures can be transmitted securely without the fragility of JSON or the overhead of Protobuf.
|
||||
|
||||
** Pipeline Initialization
|
||||
#+begin_src lisp :tangle ../src/communication.lisp
|
||||
(in-package :opencortex)
|
||||
|
||||
(defvar *actuator-registry* (make-hash-table :test 'equalp)
|
||||
"Global registry mapping target keywords to their physical actuator functions.")
|
||||
|
||||
(defun register-actuator (name fn)
|
||||
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
|
||||
(let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword))))
|
||||
(setf (gethash key *actuator-registry*) fn)))
|
||||
|
||||
(defun frame-message (msg-plist)
|
||||
"Frames a Lisp plist with a 6-character hex length and a newline for stream integrity."
|
||||
(let* ((*print-pretty* nil)
|
||||
(*print-circle* nil)
|
||||
(msg-string (format nil "~s" msg-plist))
|
||||
(len (length msg-string)))
|
||||
(format nil "~6,'0x~a~%" len msg-string)))
|
||||
|
||||
(defun read-framed-message (stream)
|
||||
"Reads a hex-length prefixed S-expression from the stream securely. Skips leading whitespace."
|
||||
(let ((length-buffer (make-string 6)))
|
||||
(handler-case
|
||||
(progn
|
||||
;; 1. Skip leading whitespace (newlines, spaces, etc.)
|
||||
(loop for char = (peek-char nil stream nil :eof)
|
||||
while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
|
||||
do (read-char stream))
|
||||
|
||||
;; 2. Read the 6-char hex length
|
||||
(let ((count (read-sequence length-buffer stream)))
|
||||
(cond ((< count 6) :eof)
|
||||
(t (let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
|
||||
(if (not len)
|
||||
(progn
|
||||
(harness-log "PROTOCOL ERROR: Invalid header ~s. Attempting resync..." length-buffer)
|
||||
:error)
|
||||
(let ((msg-buffer (make-string len)))
|
||||
(read-sequence msg-buffer stream)
|
||||
(let ((*read-eval* nil)
|
||||
(*print-pretty* nil))
|
||||
(handler-case
|
||||
(let ((msg (read-from-string msg-buffer)))
|
||||
(validate-communication-protocol-schema msg)
|
||||
msg)
|
||||
(error (c)
|
||||
(harness-log "PROTOCOL PARSE ERROR: ~a in ~s" c msg-buffer)
|
||||
:error))))))))))
|
||||
(error (c)
|
||||
(harness-log "PROTOCOL READ ERROR: ~a" c)
|
||||
:error))))
|
||||
|
||||
(defun make-hello-message (version)
|
||||
"Constructs the standard HELLO handshake message."
|
||||
(list :TYPE :EVENT
|
||||
:PAYLOAD (list :ACTION :handshake
|
||||
:VERSION version
|
||||
:CAPABILITIES '(:AUTH :SWANK :ORG-AST))))
|
||||
#+end_src
|
||||
|
||||
** Structural Validation (communication-validator.lisp)
|
||||
The validator ensures that incoming messages adhere to the strict property list schema of the communication protocol.
|
||||
* Message Framing
|
||||
|
||||
#+begin_src lisp :tangle ../src/communication-validator.lisp
|
||||
(in-package :opencortex)
|
||||
** Frame Serialization (frame-message)
|
||||
Every message leaving the harness must be "framed." This involves two steps:
|
||||
1. *Sanitization:* Stripping raw Lisp objects (like streams or sockets) that cannot be serialized.
|
||||
2. *Prefixed Framing:* Calculating the length of the S-expression and prepending it as a 6-character hexadecimal string.
|
||||
|
||||
(defun validate-communication-protocol-schema (msg)
|
||||
"Strict structural validation for incoming communication protocol messages."
|
||||
(unless (listp msg)
|
||||
(error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
|
||||
|
||||
(let ((type (let ((raw (proto-get msg :type))) (if (keywordp raw) (intern (string-upcase (string raw)) :keyword) raw))))
|
||||
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS))
|
||||
(progn (harness-log "REJECTED MSG: ~s" msg) (error "Communication Protocol Schema Error: Invalid message type '~a'" type)))
|
||||
|
||||
(case type
|
||||
(:REQUEST
|
||||
(unless (proto-get msg :target)
|
||||
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
|
||||
(unless (proto-get msg :payload)
|
||||
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))
|
||||
|
||||
(:EVENT
|
||||
(let ((payload (proto-get msg :payload)))
|
||||
(unless (and payload (listp payload))
|
||||
(error "Communication Protocol Schema Error: EVENT missing or invalid :payload"))
|
||||
(unless (or (proto-get payload :action) (proto-get payload :sensor))
|
||||
(error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor"))))
|
||||
|
||||
(:RESPONSE
|
||||
(unless (proto-get msg :payload)
|
||||
(error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
|
||||
|
||||
t))
|
||||
|
||||
(defskill :skill-communication-protocol-validator
|
||||
:priority 95
|
||||
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
|
||||
:probabilistic nil
|
||||
:deterministic (lambda (action ctx)
|
||||
(declare (ignore ctx))
|
||||
(validate-communication-protocol-schema action)
|
||||
action))
|
||||
#+end_src
|
||||
|
||||
** Message Framing (communication.lisp)
|
||||
Frames a message with a hex length prefix and ensures all data is serializable.
|
||||
Example Frame: ~00001c(:TYPE :STATUS :SCRIBE :IDLE)~
|
||||
|
||||
#+begin_src lisp :tangle ../src/communication.lisp
|
||||
(defun sanitize-protocol-message (msg)
|
||||
"Recursively strips non-serializable objects from a protocol plist."
|
||||
"Recursively strips non-serializable objects (streams, sockets) from a protocol plist."
|
||||
(if (and msg (listp msg))
|
||||
(let ((clean nil))
|
||||
(loop for (k v) on msg by #'cddr
|
||||
@@ -140,7 +38,9 @@ Frames a message with a hex length prefix and ensures all data is serializable.
|
||||
(push (if (listp v) (sanitize-protocol-message v) v) clean)))
|
||||
(nreverse clean))
|
||||
msg))
|
||||
#+end_src
|
||||
|
||||
#+begin_src lisp :tangle ../src/communication.lisp
|
||||
(defun frame-message (msg)
|
||||
"Serializes a message plist and prefixes it with a 6-character hex length."
|
||||
(let* ((sanitized (sanitize-protocol-message msg))
|
||||
@@ -148,3 +48,44 @@ Frames a message with a hex length prefix and ensures all data is serializable.
|
||||
(len (length payload)))
|
||||
(format nil "~6,'0x~a" len payload)))
|
||||
#+end_src
|
||||
|
||||
* Message Ingestion
|
||||
|
||||
** Framed Message Reader (read-framed-message)
|
||||
The inverse of framing. This function reads exactly the number of bytes specified by the hex-length prefix. This "byte-counted" reading is a critical security measure—it prevents buffer overflow attacks and "slowloris" type hung connections.
|
||||
|
||||
#+begin_src lisp :tangle ../src/communication.lisp
|
||||
(defun read-framed-message (stream)
|
||||
"Reads a hex-prefixed message from a stream. Returns the parsed Lisp plist or :EOF."
|
||||
(handler-case
|
||||
(let ((len-buf (make-string 6)))
|
||||
;; 1. Read the length prefix
|
||||
(let ((count (read-sequence len-buf stream)))
|
||||
(if (< count 6)
|
||||
:eof
|
||||
(let ((len (ignore-errors (parse-integer len-buf :radix 16))))
|
||||
(if (and len (> len 0))
|
||||
;; 2. Read exactly 'len' bytes
|
||||
(let ((payload-buf (make-string len)))
|
||||
(read-sequence payload-buf stream)
|
||||
(let ((*read-eval* nil))
|
||||
(read-from-string payload-buf)))
|
||||
:error)))))
|
||||
(error (c)
|
||||
(harness-log "PROTOCOL ERROR: ~a" c)
|
||||
:error)))
|
||||
#+end_src
|
||||
|
||||
* Semantic Handshakes
|
||||
|
||||
** Hello Message (make-hello-message)
|
||||
The first message sent by the daemon upon client connection. It advertises the protocol version and the agent's current capabilities.
|
||||
|
||||
#+begin_src lisp :tangle ../src/communication.lisp
|
||||
(defun make-hello-message (version)
|
||||
"Constructs the standard HELLO handshake message."
|
||||
(list :TYPE :EVENT
|
||||
:PAYLOAD (list :ACTION :handshake
|
||||
:VERSION version
|
||||
:CAPABILITIES '(:AUTH :SWANK :ORG-AST))))
|
||||
#+end_src
|
||||
|
||||
Reference in New Issue
Block a user