feat(protocol): Implement high-integrity framed message reader
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s

This commit is contained in:
2026-04-17 19:48:44 -04:00
parent d90cfd5bfe
commit 7430ae24e0
2 changed files with 50 additions and 0 deletions

View File

@@ -131,3 +131,31 @@ Every session begins with a standard ~HELLO~ handshake, allowing the system to a
:version version
:capabilities '(:auth :swank :org-ast))))
#+end_src
** Protocol Reading (read-framed-message)
A robust utility to read a framed message from a stream. It enforces the deterministic hex-length boundary.
#+begin_src lisp :tangle ../src/communication.lisp
(defun read-framed-message (stream)
"Reads a hex-length prefixed message from the stream securely."
(let ((length-buffer (make-string 6)))
(handler-case
(progn
;; 1. Read the 6-char hex length
(let ((count (read-sequence length-buffer stream)))
(when (< count 6) (return-from read-framed-message :eof))
(let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
(unless len (error "Invalid protocol header: ~a" length-buffer))
;; 2. Read exactly LEN bytes
(let ((msg-buffer (make-string len)))
(read-sequence msg-buffer stream)
(let ((*read-eval* nil))
(let ((msg (read-from-string msg-buffer)))
(validate-communication-protocol-schema msg)
msg))))))
(error (c)
(harness-log "PROTOCOL READ ERROR: ~a" c)
:error))))
#+end_src

View File

@@ -65,3 +65,25 @@
:payload (list :action :handshake
:version version
:capabilities '(:auth :swank :org-ast))))
(defun read-framed-message (stream)
"Reads a hex-length prefixed message from the stream securely."
(let ((length-buffer (make-string 6)))
(handler-case
(progn
;; 1. Read the 6-char hex length
(let ((count (read-sequence length-buffer stream)))
(when (< count 6) (return-from read-framed-message :eof))
(let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
(unless len (error "Invalid protocol header: ~a" length-buffer))
;; 2. Read exactly LEN bytes
(let ((msg-buffer (make-string len)))
(read-sequence msg-buffer stream)
(let ((*read-eval* nil))
(let ((msg (read-from-string msg-buffer)))
(validate-communication-protocol-schema msg)
msg))))))
(error (c)
(harness-log "PROTOCOL READ ERROR: ~a" c)
:error))))