Files
passepartout/library/communication.lisp
Amr Gharbeia 94a8a0ab0b
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
RELEASE: Finalize Semantic Restructuring v0.1.0
- Folders: literate->harness, src->library, system->environment, scripts->interfaces.
- Synchronized all :tangle paths and system definitions.
- Hardened .gitignore for binary and log artifacts.
- Consolidated all documentation into docs/.
2026-04-21 12:41:50 -04:00

47 lines
1.8 KiB
Common Lisp

(in-package :opencortex)
(defun sanitize-protocol-message (msg)
"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
do (unless (member k '(:reply-stream :socket :stream))
(push k clean)
(push (if (listp v) (sanitize-protocol-message v) v) clean)))
(nreverse clean))
msg))
(defun frame-message (msg)
"Serializes a message plist and prefixes it with a 6-character hex length."
(let* ((sanitized (sanitize-protocol-message msg))
(payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
(len (length payload)))
(format nil "~6,'0x~a" len payload)))
(defun read-framed-message (stream)
"Reads a hex-prefixed message from a stream. Returns the parsed Lisp plist or :EOF."
(handler-case
(let ((len-buf (make-string 6)))
;; 1. Read the length prefix
(let ((count (read-sequence len-buf stream)))
(if (< count 6)
:eof
(let ((len (ignore-errors (parse-integer len-buf :radix 16))))
(if (and len (> len 0))
;; 2. Read exactly 'len' bytes
(let ((payload-buf (make-string len)))
(read-sequence payload-buf stream)
(let ((*read-eval* nil))
(read-from-string payload-buf)))
:error)))))
(error (c)
(harness-log "PROTOCOL ERROR: ~a" c)
:error)))
(defun make-hello-message (version)
"Constructs the standard HELLO handshake message."
(list :TYPE :EVENT
:PAYLOAD (list :ACTION :handshake
:VERSION version
:CAPABILITIES '(:AUTH :SWANK :ORG-AST))))