Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
- 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/.
47 lines
1.8 KiB
Common Lisp
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))))
|