v0.3.1: eliminate RCE via *read-eval* nil (Parser RCE Elimination)
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
This commit is contained in:
@@ -59,7 +59,7 @@
|
|||||||
(cmd (getf payload :action)))
|
(cmd (getf payload :action)))
|
||||||
(case cmd
|
(case cmd
|
||||||
(:eval
|
(:eval
|
||||||
(eval (read-from-string (getf payload :code))))
|
(eval (let ((*read-eval* nil)) (read-from-string (getf payload :code)))))
|
||||||
(:message
|
(:message
|
||||||
(log-message "ACT [System]: ~a" (getf payload :text)))
|
(log-message "ACT [System]: ~a" (getf payload :text)))
|
||||||
(t
|
(t
|
||||||
|
|||||||
@@ -99,7 +99,7 @@
|
|||||||
(markdown-strip thought))))
|
(markdown-strip thought))))
|
||||||
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
|
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
|
||||||
(handler-case
|
(handler-case
|
||||||
(let ((parsed (read-from-string cleaned)))
|
(let ((parsed (let ((*read-eval* nil)) (read-from-string cleaned))))
|
||||||
(if (listp parsed)
|
(if (listp parsed)
|
||||||
(let ((normalized (plist-keywords-normalize parsed)))
|
(let ((normalized (plist-keywords-normalize parsed)))
|
||||||
;; Ensure explanation is present in the payload for policy gate
|
;; 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")))
|
(list :status :success :content "mock-response")))
|
||||||
(let ((result (backend-cascade-call "hello" :cascade '(:mock-backend))))
|
(let ((result (backend-cascade-call "hello" :cascade '(:mock-backend))))
|
||||||
(is (string= "mock-response" result)))))
|
(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))))
|
||||||
|
|||||||
@@ -140,7 +140,7 @@
|
|||||||
(when (uiop:file-exists-p path)
|
(when (uiop:file-exists-p path)
|
||||||
(handler-case
|
(handler-case
|
||||||
(with-open-file (stream path :direction :input)
|
(with-open-file (stream path :direction :input)
|
||||||
(let ((data (read stream nil)))
|
(let ((data (let ((*read-eval* nil)) (read stream nil))))
|
||||||
(when data
|
(when data
|
||||||
(let ((memory-alist (getf data :memory)) (history-alist (getf data :history-store)))
|
(let ((memory-alist (getf data :memory)) (history-alist (getf data :history-store)))
|
||||||
(setf *memory-store* (make-hash-table :test 'equal :size (length memory-alist)))
|
(setf *memory-store* (make-hash-table :test 'equal :size (length memory-alist)))
|
||||||
|
|||||||
@@ -135,7 +135,7 @@ Handles internal harness commands: ~:eval~ (execute arbitrary Lisp) and ~:messag
|
|||||||
(cmd (getf payload :action)))
|
(cmd (getf payload :action)))
|
||||||
(case cmd
|
(case cmd
|
||||||
(:eval
|
(:eval
|
||||||
(eval (read-from-string (getf payload :code))))
|
(eval (let ((*read-eval* nil)) (read-from-string (getf payload :code)))))
|
||||||
(:message
|
(:message
|
||||||
(log-message "ACT [System]: ~a" (getf payload :text)))
|
(log-message "ACT [System]: ~a" (getf payload :text)))
|
||||||
(t
|
(t
|
||||||
|
|||||||
@@ -235,7 +235,7 @@ The system prompt assembly order — identity, tools, context, logs, mandates
|
|||||||
(markdown-strip thought))))
|
(markdown-strip thought))))
|
||||||
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
|
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
|
||||||
(handler-case
|
(handler-case
|
||||||
(let ((parsed (read-from-string cleaned)))
|
(let ((parsed (let ((*read-eval* nil)) (read-from-string cleaned))))
|
||||||
(if (listp parsed)
|
(if (listp parsed)
|
||||||
(let ((normalized (plist-keywords-normalize parsed)))
|
(let ((normalized (plist-keywords-normalize parsed)))
|
||||||
;; Ensure explanation is present in the payload for policy gate
|
;; 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")))
|
(list :status :success :content "mock-response")))
|
||||||
(let ((result (backend-cascade-call "hello" :cascade '(:mock-backend))))
|
(let ((result (backend-cascade-call "hello" :cascade '(:mock-backend))))
|
||||||
(is (string= "mock-response" result)))))
|
(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
|
#+end_src
|
||||||
|
|||||||
@@ -349,7 +349,7 @@ Restores memory state from a previously saved snapshot file. Called during boot
|
|||||||
(when (uiop:file-exists-p path)
|
(when (uiop:file-exists-p path)
|
||||||
(handler-case
|
(handler-case
|
||||||
(with-open-file (stream path :direction :input)
|
(with-open-file (stream path :direction :input)
|
||||||
(let ((data (read stream nil)))
|
(let ((data (let ((*read-eval* nil)) (read stream nil))))
|
||||||
(when data
|
(when data
|
||||||
(let ((memory-alist (getf data :memory)) (history-alist (getf data :history-store)))
|
(let ((memory-alist (getf data :memory)) (history-alist (getf data :history-store)))
|
||||||
(setf *memory-store* (make-hash-table :test 'equal :size (length memory-alist)))
|
(setf *memory-store* (make-hash-table :test 'equal :size (length memory-alist)))
|
||||||
|
|||||||
Reference in New Issue
Block a user