fix(protocol): Disable pretty-print during IO and handle NIL chat text
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
This commit is contained in:
@@ -65,7 +65,7 @@ The ~frame-message~ function prepares an outgoing Lisp string for transmission.
|
|||||||
(defun frame-message (msg-string)
|
(defun frame-message (msg-string)
|
||||||
"Prefixes MSG-STRING with a 6-character hex length.
|
"Prefixes MSG-STRING with a 6-character hex length.
|
||||||
If security is enabled, prefixes a 64-char HMAC-SHA256 signature."
|
If security is enabled, prefixes a 64-char HMAC-SHA256 signature."
|
||||||
(let ((len (length msg-string))
|
(let ((*print-pretty* nil) (len (length msg-string))
|
||||||
(enforce-hmac (uiop:getenv "PROTOCOL_ENFORCE_HMAC")))
|
(enforce-hmac (uiop:getenv "PROTOCOL_ENFORCE_HMAC")))
|
||||||
(if (and enforce-hmac (string-equal enforce-hmac "true"))
|
(if (and enforce-hmac (string-equal enforce-hmac "true"))
|
||||||
(let ((secret (uiop:getenv "PROTOCOL_HMAC_SECRET")))
|
(let ((secret (uiop:getenv "PROTOCOL_HMAC_SECRET")))
|
||||||
@@ -114,7 +114,7 @@ Parsing is the high-security inverse of framing. This function acts as the final
|
|||||||
(error "communication protocol Integrity Failure: HMAC mismatch"))))))
|
(error "communication protocol Integrity Failure: HMAC mismatch"))))))
|
||||||
|
|
||||||
;; SECURITY: Disable the reader's ability to execute code during parsing
|
;; SECURITY: Disable the reader's ability to execute code during parsing
|
||||||
(let ((*read-eval* nil))
|
(let ((*read-eval* nil) (*print-pretty* nil))
|
||||||
(let ((msg (read-from-string actual-msg)))
|
(let ((msg (read-from-string actual-msg)))
|
||||||
(validate-communication-protocol-schema msg)
|
(validate-communication-protocol-schema msg)
|
||||||
msg)))))
|
msg)))))
|
||||||
@@ -156,7 +156,7 @@ A robust utility to read a framed message from a stream. It enforces the determi
|
|||||||
;; 2. Read exactly LEN bytes
|
;; 2. Read exactly LEN bytes
|
||||||
(let ((msg-buffer (make-string len)))
|
(let ((msg-buffer (make-string len)))
|
||||||
(read-sequence msg-buffer stream)
|
(read-sequence msg-buffer stream)
|
||||||
(let ((*read-eval* nil))
|
(let ((*read-eval* nil) (*print-pretty* nil))
|
||||||
(let ((msg (read-from-string msg-buffer)))
|
(let ((msg (read-from-string msg-buffer)))
|
||||||
(validate-communication-protocol-schema msg)
|
(validate-communication-protocol-schema msg)
|
||||||
msg))))))
|
msg))))))
|
||||||
|
|||||||
@@ -66,7 +66,7 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
|
|||||||
(or (getf msg :SCRIBE) (getf msg :scribe))
|
(or (getf msg :SCRIBE) (getf msg :scribe))
|
||||||
(or (getf msg :GARDENER) (getf msg :gardener)))))
|
(or (getf msg :GARDENER) (getf msg :gardener)))))
|
||||||
((and (listp msg) (eq type :CHAT))
|
((and (listp msg) (eq type :CHAT))
|
||||||
(enqueue-msg (or (getf msg :TEXT) (getf msg :text))))
|
(let ((text (or (getf msg :TEXT) (getf msg :text)))) (when text (enqueue-msg text))))
|
||||||
(t (harness-log "TUI: Ignored unknown type ~a" type)))))
|
(t (harness-log "TUI: Ignored unknown type ~a" type)))))
|
||||||
(when (eq raw-msg :eof) (setf *is-running* nil))
|
(when (eq raw-msg :eof) (setf *is-running* nil))
|
||||||
(when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
|
(when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
|
||||||
|
|||||||
@@ -10,7 +10,7 @@
|
|||||||
(defun frame-message (msg-string)
|
(defun frame-message (msg-string)
|
||||||
"Prefixes MSG-STRING with a 6-character hex length.
|
"Prefixes MSG-STRING with a 6-character hex length.
|
||||||
If security is enabled, prefixes a 64-char HMAC-SHA256 signature."
|
If security is enabled, prefixes a 64-char HMAC-SHA256 signature."
|
||||||
(let ((len (length msg-string))
|
(let ((*print-pretty* nil) (len (length msg-string))
|
||||||
(enforce-hmac (uiop:getenv "PROTOCOL_ENFORCE_HMAC")))
|
(enforce-hmac (uiop:getenv "PROTOCOL_ENFORCE_HMAC")))
|
||||||
(if (and enforce-hmac (string-equal enforce-hmac "true"))
|
(if (and enforce-hmac (string-equal enforce-hmac "true"))
|
||||||
(let ((secret (uiop:getenv "PROTOCOL_HMAC_SECRET")))
|
(let ((secret (uiop:getenv "PROTOCOL_HMAC_SECRET")))
|
||||||
@@ -54,7 +54,7 @@
|
|||||||
(error "communication protocol Integrity Failure: HMAC mismatch"))))))
|
(error "communication protocol Integrity Failure: HMAC mismatch"))))))
|
||||||
|
|
||||||
;; SECURITY: Disable the reader's ability to execute code during parsing
|
;; SECURITY: Disable the reader's ability to execute code during parsing
|
||||||
(let ((*read-eval* nil))
|
(let ((*read-eval* nil) (*print-pretty* nil))
|
||||||
(let ((msg (read-from-string actual-msg)))
|
(let ((msg (read-from-string actual-msg)))
|
||||||
(validate-communication-protocol-schema msg)
|
(validate-communication-protocol-schema msg)
|
||||||
msg)))))
|
msg)))))
|
||||||
@@ -85,7 +85,7 @@
|
|||||||
;; 2. Read exactly LEN bytes
|
;; 2. Read exactly LEN bytes
|
||||||
(let ((msg-buffer (make-string len)))
|
(let ((msg-buffer (make-string len)))
|
||||||
(read-sequence msg-buffer stream)
|
(read-sequence msg-buffer stream)
|
||||||
(let ((*read-eval* nil))
|
(let ((*read-eval* nil) (*print-pretty* nil))
|
||||||
(let ((msg (read-from-string msg-buffer)))
|
(let ((msg (read-from-string msg-buffer)))
|
||||||
(validate-communication-protocol-schema msg)
|
(validate-communication-protocol-schema msg)
|
||||||
msg))))))
|
msg))))))
|
||||||
|
|||||||
@@ -53,7 +53,7 @@
|
|||||||
(or (getf msg :SCRIBE) (getf msg :scribe))
|
(or (getf msg :SCRIBE) (getf msg :scribe))
|
||||||
(or (getf msg :GARDENER) (getf msg :gardener)))))
|
(or (getf msg :GARDENER) (getf msg :gardener)))))
|
||||||
((and (listp msg) (eq type :CHAT))
|
((and (listp msg) (eq type :CHAT))
|
||||||
(enqueue-msg (or (getf msg :TEXT) (getf msg :text))))
|
(let ((text (or (getf msg :TEXT) (getf msg :text)))) (when text (enqueue-msg text))))
|
||||||
(t (harness-log "TUI: Ignored unknown type ~a" type)))))
|
(t (harness-log "TUI: Ignored unknown type ~a" type)))))
|
||||||
(when (eq raw-msg :eof) (setf *is-running* nil))
|
(when (eq raw-msg :eof) (setf *is-running* nil))
|
||||||
(when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
|
(when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
|
||||||
|
|||||||
Reference in New Issue
Block a user