From a31f19045aa9c69089f04ce300043b0be26f0fdd Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Wed, 6 May 2026 16:38:59 -0400 Subject: [PATCH] v0.3.1: eliminate RCE via *read-eval* nil (Parser RCE Elimination) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Wrap read-from-string/read with (let ((*read-eval* nil)) ...) at three untrusted-input code paths: 1. think() in core-loop-reason — LLM output parsing. LLM output is untrusted by definition; #.(shell ...) in a response must not execute. 2. action-system-execute in core-loop-act — :system :eval path processes untrusted payload code from the signal pipeline. 3. load-memory-from-disk in core-memory — memory.snap file could be corrupted or planted in ~/, must not execute #. reader macros. Adds test-read-eval-rce-blocked to pipeline-reason-suite: mocks a backend returning malicious output containing #.(setf ...), verifies no side effects occur and safe fallback is returned. RED proof recorded: *read-eval* T + #.(setf ...) → :PWNED (RCE active) GREEN proof: *read-eval* NIL → reader-error caught (RCE blocked) Test: reason 12/0, full suite 88/0 --- lisp/core-loop-act.lisp | 2 +- lisp/core-loop-reason.lisp | 18 +++++++++++++++++- lisp/core-memory.lisp | 2 +- org/core-loop-act.org | 2 +- org/core-loop-reason.org | 18 +++++++++++++++++- org/core-memory.org | 2 +- 6 files changed, 38 insertions(+), 6 deletions(-) diff --git a/lisp/core-loop-act.lisp b/lisp/core-loop-act.lisp index 3678d19..3ba6531 100644 --- a/lisp/core-loop-act.lisp +++ b/lisp/core-loop-act.lisp @@ -59,7 +59,7 @@ (cmd (getf payload :action))) (case cmd (:eval - (eval (read-from-string (getf payload :code)))) + (eval (let ((*read-eval* nil)) (read-from-string (getf payload :code))))) (:message (log-message "ACT [System]: ~a" (getf payload :text))) (t diff --git a/lisp/core-loop-reason.lisp b/lisp/core-loop-reason.lisp index 7c6b2c6..2762ccb 100644 --- a/lisp/core-loop-reason.lisp +++ b/lisp/core-loop-reason.lisp @@ -99,7 +99,7 @@ (markdown-strip thought)))) (if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[))) (handler-case - (let ((parsed (read-from-string cleaned))) + (let ((parsed (let ((*read-eval* nil)) (read-from-string cleaned)))) (if (listp parsed) (let ((normalized (plist-keywords-normalize parsed))) ;; Ensure explanation is present in the payload for policy gate @@ -283,3 +283,19 @@ sorted by priority (highest first). Returns a rejection plist or the action." (list :status :success :content "mock-response"))) (let ((result (backend-cascade-call "hello" :cascade '(:mock-backend)))) (is (string= "mock-response" result))))) + +(test test-read-eval-rce-blocked + "Contract 1/v0.3.1: #. reader macro in LLM output must not execute arbitrary code." + (let ((passepartout::*backend-registry* (make-hash-table :test 'equal)) + (passepartout::*provider-cascade* '(:mock-evil))) + (setf (gethash :mock-evil passepartout::*backend-registry*) + (lambda (prompt sp &key model) + (declare (ignore prompt sp model)) + (list :status :success :content "(#.(setf passepartout::*v031-rce-test* :PWNED))"))) + (setf passepartout::*v031-rce-test* nil) + (setf *read-eval* t) + (let* ((ctx (list :type :EVENT :payload (list :sensor :user-input :text "test") :depth 0)) + (result (passepartout::think ctx))) + (is (not (eq passepartout::*v031-rce-test* :PWNED))) + (is (eq :REQUEST (getf result :TYPE))) + (setf *read-eval* nil)))) diff --git a/lisp/core-memory.lisp b/lisp/core-memory.lisp index 42d7dc1..0a77f51 100644 --- a/lisp/core-memory.lisp +++ b/lisp/core-memory.lisp @@ -140,7 +140,7 @@ (when (uiop:file-exists-p path) (handler-case (with-open-file (stream path :direction :input) - (let ((data (read stream nil))) + (let ((data (let ((*read-eval* nil)) (read stream nil)))) (when data (let ((memory-alist (getf data :memory)) (history-alist (getf data :history-store))) (setf *memory-store* (make-hash-table :test 'equal :size (length memory-alist))) diff --git a/org/core-loop-act.org b/org/core-loop-act.org index 73d59c0..ea757e2 100644 --- a/org/core-loop-act.org +++ b/org/core-loop-act.org @@ -135,7 +135,7 @@ Handles internal harness commands: ~:eval~ (execute arbitrary Lisp) and ~:messag (cmd (getf payload :action))) (case cmd (:eval - (eval (read-from-string (getf payload :code)))) + (eval (let ((*read-eval* nil)) (read-from-string (getf payload :code))))) (:message (log-message "ACT [System]: ~a" (getf payload :text))) (t diff --git a/org/core-loop-reason.org b/org/core-loop-reason.org index 9baa9db..ed9d15d 100644 --- a/org/core-loop-reason.org +++ b/org/core-loop-reason.org @@ -235,7 +235,7 @@ The system prompt assembly order — identity, tools, context, logs, mandates (markdown-strip thought)))) (if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[))) (handler-case - (let ((parsed (read-from-string cleaned))) + (let ((parsed (let ((*read-eval* nil)) (read-from-string cleaned)))) (if (listp parsed) (let ((normalized (plist-keywords-normalize parsed))) ;; Ensure explanation is present in the payload for policy gate @@ -460,4 +460,20 @@ Verifies that the deterministic engine correctly rejects unsafe actions (like ~r (list :status :success :content "mock-response"))) (let ((result (backend-cascade-call "hello" :cascade '(:mock-backend)))) (is (string= "mock-response" result))))) + +(test test-read-eval-rce-blocked + "Contract 1/v0.3.1: #. reader macro in LLM output must not execute arbitrary code." + (let ((passepartout::*backend-registry* (make-hash-table :test 'equal)) + (passepartout::*provider-cascade* '(:mock-evil))) + (setf (gethash :mock-evil passepartout::*backend-registry*) + (lambda (prompt sp &key model) + (declare (ignore prompt sp model)) + (list :status :success :content "(#.(setf passepartout::*v031-rce-test* :PWNED))"))) + (setf passepartout::*v031-rce-test* nil) + (setf *read-eval* t) + (let* ((ctx (list :type :EVENT :payload (list :sensor :user-input :text "test") :depth 0)) + (result (passepartout::think ctx))) + (is (not (eq passepartout::*v031-rce-test* :PWNED))) + (is (eq :REQUEST (getf result :TYPE))) + (setf *read-eval* nil)))) #+end_src diff --git a/org/core-memory.org b/org/core-memory.org index 5341f3b..b92c4e1 100644 --- a/org/core-memory.org +++ b/org/core-memory.org @@ -349,7 +349,7 @@ Restores memory state from a previously saved snapshot file. Called during boot (when (uiop:file-exists-p path) (handler-case (with-open-file (stream path :direction :input) - (let ((data (read stream nil))) + (let ((data (let ((*read-eval* nil)) (read stream nil)))) (when data (let ((memory-alist (getf data :memory)) (history-alist (getf data :history-store))) (setf *memory-store* (make-hash-table :test 'equal :size (length memory-alist)))