From 499ef377e61b977a1040b91d6b4d92c525688b76 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Sun, 19 Apr 2026 20:23:27 -0400 Subject: [PATCH] fix(protocol): Migrate to JSON framing with newline delimiters (resolves desync) --- literate/communication.org | 38 ++++++++++++++++---------------- skills/org-skill-cli-gateway.org | 10 ++++----- src/communication.lisp | 38 ++++++++++++++++---------------- 3 files changed, 43 insertions(+), 43 deletions(-) diff --git a/literate/communication.org b/literate/communication.org index b2f0db7..22c52f2 100644 --- a/literate/communication.org +++ b/literate/communication.org @@ -138,29 +138,29 @@ A robust utility to read a framed message from a stream. It enforces the determi #+begin_src lisp :tangle ../src/communication.lisp (defun read-framed-message (stream) - "Reads a hex-length prefixed message from the stream securely. Skips leading whitespace." + "Reads a hex-length prefixed JSON message from the stream." (let ((length-buffer (make-string 6))) (handler-case (progn - ;; 0. Skip leading whitespace (newlines, spaces, etc.) + ;; Skip leading junk (newlines, etc.) (loop for char = (peek-char nil stream nil :eof) - while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return))) + while (and (not (eq char :eof)) (not (digit-char-p char 16))) do (read-char stream)) - - ;; 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) (*print-pretty* nil)) - (let ((msg (read-from-string msg-buffer))) - (validate-communication-protocol-schema msg) - msg)))))) - (error (c) - (harness-log "PROTOCOL READ ERROR: ~a" c) - :error)))) + (if (< count 6) :eof + (let ((len (ignore-errors (parse-integer length-buffer :radix 16)))) + (if (not len) :error + (let ((msg-buffer (make-string len))) + (read-sequence msg-buffer stream) + (let ((msg (cl-json:decode-json-from-string msg-buffer))) + ;; Convert JSON alist back to plist for kernel compatibility + (let ((plist nil)) + (dolist (pair msg) + (push (intern (string-upcase (string (car pair))) :keyword) plist) + (push (cdr pair) plist)) + (let ((final (nreverse plist))) + (validate-communication-protocol-schema final) + final))))))))) + (error (c) (harness-log "PROTOCOL ERROR: ~a" c) :error)))) #+end_src diff --git a/skills/org-skill-cli-gateway.org b/skills/org-skill-cli-gateway.org index c243580..e0baf13 100644 --- a/skills/org-skill-cli-gateway.org +++ b/skills/org-skill-cli-gateway.org @@ -61,9 +61,9 @@ The CLI actuator writes the agent's response back to the client's network stream (handler-case (if (and stream (open-stream-p stream)) (progn - (format stream "~a" (frame-message (format nil "~s" (list :TYPE :CHAT :TEXT text)))) + (format stream "~a" (frame-message (list :TYPE :CHAT :TEXT text))) (finish-output stream) - (format stream "~a" (frame-message (format nil "~s" '(:TYPE :STATUS :SCRIBE :idle :GARDENER :sleeping)))) + (format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING))) (finish-output stream)) (harness-log "CLI ERROR: No active or open reply stream for signal.")) (error (c) (harness-log "CLI ACTUATOR ERROR: ~a" c))))) @@ -77,7 +77,7 @@ Handles an individual TCP connection. It reads lines until the connection is clo "Handles TUI slash commands by returning structured Lisp s-expressions." (cond ((string= cmd "/status") - (format stream "~a" (frame-message (format nil "~s" '(:TYPE :STATUS :SCRIBE :idle :GARDENER :sleeping)))) + (format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING))) (finish-output stream)) ((string= cmd "/exit") (prin1 '(:TYPE :info :TEXT "Goodbye!") stream) @@ -93,9 +93,9 @@ Handles an individual TCP connection. It reads lines until the connection is clo (handler-case (progn ;; 1. Send Handshake - (format stream "~a" (frame-message (format nil "~s" (make-hello-message "0.1.0")))) + (format stream "~a" (frame-message (make-hello-message "0.1.0"))) (finish-output stream) - (format stream "~a" (frame-message (format nil "~s" '(:TYPE :STATUS :SCRIBE :idle :GARDENER :sleeping)))) + (format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING))) (finish-output stream) ;; 2. Communication Loop diff --git a/src/communication.lisp b/src/communication.lisp index 9366d13..abc19b5 100644 --- a/src/communication.lisp +++ b/src/communication.lisp @@ -67,28 +67,28 @@ :capabilities '(:auth :swank :org-ast)))) (defun read-framed-message (stream) - "Reads a hex-length prefixed message from the stream securely. Skips leading whitespace." + "Reads a hex-length prefixed JSON message from the stream." (let ((length-buffer (make-string 6))) (handler-case (progn - ;; 0. Skip leading whitespace (newlines, spaces, etc.) + ;; Skip leading junk (newlines, etc.) (loop for char = (peek-char nil stream nil :eof) - while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return))) + while (and (not (eq char :eof)) (not (digit-char-p char 16))) do (read-char stream)) - - ;; 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) (*print-pretty* nil)) - (let ((msg (read-from-string msg-buffer))) - (validate-communication-protocol-schema msg) - msg)))))) - (error (c) - (harness-log "PROTOCOL READ ERROR: ~a" c) - :error)))) + (if (< count 6) :eof + (let ((len (ignore-errors (parse-integer length-buffer :radix 16)))) + (if (not len) :error + (let ((msg-buffer (make-string len))) + (read-sequence msg-buffer stream) + (let ((msg (cl-json:decode-json-from-string msg-buffer))) + ;; Convert JSON alist back to plist for kernel compatibility + (let ((plist nil)) + (dolist (pair msg) + (push (intern (string-upcase (string (car pair))) :keyword) plist) + (push (cdr pair) plist)) + (let ((final (nreverse plist))) + (validate-communication-protocol-schema final) + final))))))))) + (error (c) (harness-log "PROTOCOL ERROR: ~a" c) :error))))