fix(protocol): Skip leading whitespace in read-framed-message to prevent desync
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:
26
src/act.lisp
26
src/act.lisp
@@ -84,18 +84,22 @@
|
||||
;; 2. Actuation Logic
|
||||
(case type
|
||||
(:REQUEST (dispatch-action signal signal))
|
||||
(:LOG (dispatch-action signal signal))
|
||||
(:EVENT
|
||||
(when approved
|
||||
(let* ((target (getf approved :target))
|
||||
(result (dispatch-action approved signal)))
|
||||
;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
|
||||
;; Otherwise, generate tool-output feedback for non-silent actuators.
|
||||
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
|
||||
(setf feedback result))
|
||||
((and result (not (member target *silent-actuators*)))
|
||||
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0))
|
||||
:reply-stream (getf signal :reply-stream)
|
||||
:payload (list :sensor :tool-output :result result :tool approved)))))))))
|
||||
(if approved
|
||||
(let* ((target (getf approved :target))
|
||||
(result (dispatch-action approved signal)))
|
||||
;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
|
||||
;; Otherwise, generate tool-output feedback for non-silent actuators.
|
||||
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
|
||||
(setf feedback result))
|
||||
((and result (not (member target *silent-actuators*)))
|
||||
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0))
|
||||
:reply-stream (getf signal :reply-stream)
|
||||
:payload (list :sensor :tool-output :result result :tool approved))))))
|
||||
;; If no approved action but we have a reply-stream, this might be a raw event/log stimulus.
|
||||
(when (getf signal :reply-stream)
|
||||
(dispatch-action signal signal)))))
|
||||
|
||||
(setf (getf signal :status) :acted)
|
||||
feedback))
|
||||
|
||||
@@ -67,10 +67,15 @@
|
||||
:capabilities '(:auth :swank :org-ast))))
|
||||
|
||||
(defun read-framed-message (stream)
|
||||
"Reads a hex-length prefixed message from the stream securely."
|
||||
"Reads a hex-length prefixed message from the stream securely. Skips leading whitespace."
|
||||
(let ((length-buffer (make-string 6)))
|
||||
(handler-case
|
||||
(progn
|
||||
;; 0. Skip leading whitespace (newlines, spaces, etc.)
|
||||
(loop for char = (peek-char nil stream nil :eof)
|
||||
while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
|
||||
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))
|
||||
|
||||
@@ -15,10 +15,16 @@
|
||||
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
|
||||
(return nil))
|
||||
(handler-case
|
||||
(progn
|
||||
(let ((parent-metadata (list :reply-stream (getf current-signal :reply-stream)
|
||||
:foveal-focus (getf current-signal :foveal-focus))))
|
||||
(setf current-signal (perceive-gate current-signal))
|
||||
(setf current-signal (reason-gate current-signal))
|
||||
(setf current-signal (act-gate current-signal)))
|
||||
(setf current-signal (act-gate current-signal))
|
||||
;; Inherit metadata for the next metabolic cycle if feedback was generated.
|
||||
(when (and current-signal (not (getf current-signal :reply-stream)))
|
||||
(setf (getf current-signal :reply-stream) (getf parent-metadata :reply-stream)))
|
||||
(when (and current-signal (not (getf current-signal :foveal-focus)))
|
||||
(setf (getf current-signal :foveal-focus) (getf parent-metadata :foveal-focus))))
|
||||
(error (c)
|
||||
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
||||
(harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
|
||||
|
||||
@@ -20,10 +20,12 @@
|
||||
(result (if model
|
||||
(funcall backend-fn prompt system-prompt :model model)
|
||||
(funcall backend-fn prompt system-prompt))))
|
||||
;; If the result is valid and doesn't contain a failure log, return it.
|
||||
(unless (or (null result)
|
||||
(and (stringp result) (search ":LOG" result)))
|
||||
(return result))))))
|
||||
;; If the result is valid, return it.
|
||||
;; If it is an error plist from the gateway, continue the cascade but log it.
|
||||
(cond ((and (listp result) (eq (getf result :status) :success))
|
||||
(return (getf result :content)))
|
||||
((stringp result) (return result))
|
||||
(t (harness-log "PROBABILISTIC: Backend ~a failed: ~a" backend (getf result :message))))))))
|
||||
;; Final fallback if all backends in the cascade fail.
|
||||
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
|
||||
|
||||
@@ -64,11 +66,16 @@
|
||||
(let ((trigger (skill-trigger-fn skill))
|
||||
(gate (skill-deterministic-fn skill)))
|
||||
(when (or (null trigger) (ignore-errors (funcall trigger context)))
|
||||
(setf current-action (funcall gate current-action context))
|
||||
;; If any gate returns a LOG or EVENT, it has intercepted the action.
|
||||
(when (and (listp current-action) (member (getf current-action :type) '(:LOG :EVENT :log :event)))
|
||||
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
|
||||
(return-from deterministic-verify current-action)))))
|
||||
(let ((next-action (funcall gate current-action context)))
|
||||
;; Interception occurs if the gate returns a signal (LOG/EVENT) AND either:
|
||||
;; 1. The original action was NOT a signal (e.g. it was a REQUEST).
|
||||
;; 2. The gate returned a DIFFERENT signal than it was given.
|
||||
(when (and (listp next-action)
|
||||
(member (getf next-action :type) '(:LOG :EVENT :log :event))
|
||||
(not (eq next-action current-action)))
|
||||
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
|
||||
(return-from deterministic-verify next-action))
|
||||
(setf current-action next-action)))))
|
||||
current-action))
|
||||
|
||||
(defun reason-gate (signal)
|
||||
|
||||
Reference in New Issue
Block a user