Amr Gharbeia
3e184ad344
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
86 lines
4.1 KiB
Common Lisp
86 lines
4.1 KiB
Common Lisp
(in-package :opencortex)
|
|
|
|
(defvar *actuator-registry* (make-hash-table :test 'equal)
|
|
"Global registry mapping target keywords to their physical actuator functions.")
|
|
|
|
(defun register-actuator (name fn)
|
|
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
|
|
(setf (gethash name *actuator-registry*) fn))
|
|
|
|
(defun frame-message (msg-plist)
|
|
"Frames a Lisp plist with a 6-char hex length and a newline sentinel for stream integrity."
|
|
(let* ((*print-pretty* nil)
|
|
(msg-string (format nil "~s" msg-plist))
|
|
(len (length msg-string)))
|
|
(format nil "~6,'0x~a~%" len msg-string)))
|
|
|
|
(defun parse-message (framed-string)
|
|
"Extracts and parses the S-expression from a framed string securely."
|
|
(when (< (length framed-string) 6)
|
|
(error "Framed string too short"))
|
|
(let* ((enforce-hmac (uiop:getenv "PROTOCOL_ENFORCE_HMAC"))
|
|
(use-hmac (and enforce-hmac (string-equal enforce-hmac "true")))
|
|
(prefix-len (if use-hmac 70 6)))
|
|
(when (< (length framed-string) prefix-len)
|
|
(error "Framed string too short for communication protocol prefix"))
|
|
|
|
(let* ((len-str (subseq framed-string 0 6))
|
|
(signature (when use-hmac (subseq framed-string 6 70)))
|
|
(actual-msg (subseq framed-string prefix-len))
|
|
(expected-len (ignore-errors (parse-integer len-str :radix 16))))
|
|
(unless expected-len
|
|
(error "Invalid hex length prefix: ~a" len-str))
|
|
(unless (= expected-len (length actual-msg))
|
|
(error "Message length mismatch. Expected ~a, got ~a" expected-len (length actual-msg)))
|
|
|
|
(when use-hmac
|
|
(let ((secret (uiop:getenv "PROTOCOL_HMAC_SECRET")))
|
|
(unless secret (error "PROTOCOL_HMAC_SECRET is required when security is enabled."))
|
|
(let* ((key (ironclad:ascii-string-to-byte-array secret))
|
|
(hmac (ironclad:make-mac :hmac key :sha256))
|
|
(payload-bytes (ironclad:ascii-string-to-byte-array actual-msg)))
|
|
(ironclad:update-mac hmac payload-bytes)
|
|
(let ((expected-signature (ironclad:byte-array-to-hex-string (ironclad:produce-mac hmac))))
|
|
(unless (string-equal signature expected-signature)
|
|
(error "communication protocol Integrity Failure: HMAC mismatch"))))))
|
|
|
|
;; SECURITY: Disable the reader's ability to execute code during parsing
|
|
(let ((*read-eval* nil) (*print-pretty* nil))
|
|
(let ((msg (read-from-string actual-msg)))
|
|
(validate-communication-protocol-schema msg)
|
|
msg)))))
|
|
|
|
(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))))
|
|
|
|
(defun read-framed-message (stream)
|
|
"Robustly reads a hex-framed S-expression, skipping leading whitespace and handling desync."
|
|
(let ((length-buffer (make-string 6)))
|
|
(handler-case
|
|
(progn
|
|
;; 1. Skip leading junk until we find a hex digit (the start of a length prefix)
|
|
(loop for char = (peek-char nil stream nil :eof)
|
|
while (and (not (eq char :eof)) (not (digit-char-p char 16)))
|
|
do (read-char stream))
|
|
|
|
(let ((count (read-sequence length-buffer stream)))
|
|
(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 ((*read-eval* nil)
|
|
(*print-pretty* nil))
|
|
(handler-case
|
|
(let ((msg (read-from-string msg-buffer)))
|
|
(validate-communication-protocol-schema msg)
|
|
msg)
|
|
(error (c)
|
|
(harness-log "PROTOCOL PARSE ERROR: ~a in ~s" c msg-buffer)
|
|
:error)))))))))
|
|
(error (c) (harness-log "PROTOCOL READ ERROR: ~a" c) :error))))
|