diff --git a/literate/communication.org b/literate/communication.org index 1d5607f..0185921 100644 --- a/literate/communication.org +++ b/literate/communication.org @@ -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 diff --git a/src/communication.lisp b/src/communication.lisp index e5b02aa..f99c69b 100644 --- a/src/communication.lisp +++ b/src/communication.lisp @@ -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))))