Amr Gharbeia
8fd56dece3
Phase 1 — dedup + hardening (~9 items): - Remove duplicate *skill-registry* defvar from core-skills - Merge *backend-registry* into *probabilistic-backends*, delete backend-register - Remove inject-stimulus alias, standardize on stimulus-inject - Add pre-eval sandbox (skill-source-scan) blocks restricted symbols before eval - Remove dead plist-get function; remove duplicate json-alist-to-plist export - Fix read-framed-message whitespace DoS (4096-iteration max) - Add *read-eval* nil to dispatcher-approvals-process read-from-string (RCE) - Add test-op to ASDF; update .asd version 0.4.3→0.7.2 Phase 2 — prose + contracts + reorder: - Split ROADMAP: 2623→1089 lines (TODO only), CHANGELOG: 260→1528 lines (full DONE history, 14 versions reverse chron) - Add Contracts + Overview to 6 channel files + embedding-native + programming-standards + symbolic-scope - Reorder 28 .org files: Contract → Test Suite → Implementation (TDD order) - Add 7-phase inline prose to think() in core-reason - Expand USER_MANUAL: 183→461 lines (10 new sections) Phase 3 — decomposition + export organization: - Decompose think() into think-assemble-prompt, think-call-llm, think-parse-response orchestrator - Organize 188 exports into 16 grouped sections by module Phase 4 — budget enforcement + error protocol: - Per-session budget enforcement (SESSION_BUDGET_USD env var, budget-exhausted-p, guard in think-call-llm) - Error condition hierarchy (6 conditions: pipeline-error, llm-error, gate-error, budget-error, protocol-error) - Restarts in loop-process: skip-signal, use-fallback, abort-pipeline
96 lines
4.0 KiB
Common Lisp
96 lines
4.0 KiB
Common Lisp
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(ql:quickload :fiveam :silent t))
|
|
|
|
(defpackage :passepartout-shell-actuator-tests
|
|
(:use :cl :fiveam :passepartout)
|
|
(:export #:shell-actuator-suite))
|
|
|
|
(in-package :passepartout-shell-actuator-tests)
|
|
|
|
(def-suite shell-actuator-suite :description "Verification of the Shell Actuator")
|
|
(in-suite shell-actuator-suite)
|
|
|
|
(test test-bwrap-wrap-command
|
|
"Contract 2: bwrap-wrap-command returns properly formatted command list."
|
|
(let ((cmdline (passepartout::bwrap-wrap-command "echo hello" 30 "/home/user/memex")))
|
|
(is (member "bwrap" cmdline :test #'string=))
|
|
(is (member "--unshare-net" cmdline :test #'string=))
|
|
(is (member "--unshare-ipc" cmdline :test #'string=))
|
|
(is (member "echo hello" cmdline :test #'string=))))
|
|
|
|
(test test-bwrap-available-p-returns-boolean
|
|
"Contract 1: bwrap-available-p returns T or NIL."
|
|
(let ((avail (passepartout::bwrap-available-p)))
|
|
(is (typep avail 'boolean))))
|
|
|
|
(test test-actuator-shell-execute-echo
|
|
"Contract 3: actuator-shell-execute runs echo and returns output."
|
|
(let* ((action '(:type :REQUEST :target :shell :payload (:cmd "echo hello")))
|
|
(result (passepartout::actuator-shell-execute action nil)))
|
|
(is (stringp result))
|
|
(is (search "hello" result :test #'char-equal))))
|
|
|
|
(in-package :passepartout)
|
|
|
|
(defvar *bwrap-available* nil
|
|
"Set to T at load time if the bwrap binary is found in PATH.")
|
|
|
|
(defvar *bwrap-base-args*
|
|
'("--ro-bind" "/usr" "/usr"
|
|
"--ro-bind" "/lib" "/lib"
|
|
"--ro-bind" "/bin" "/bin"
|
|
"--ro-bind" "/etc" "/etc"
|
|
"--bind" "/tmp" "/tmp"
|
|
"--unshare-net"
|
|
"--unshare-ipc")
|
|
"Base bwrap arguments for the sandbox. --bind ~/memex ~/memex is added dynamically.")
|
|
|
|
(defun bwrap-available-p ()
|
|
"Returns T if bwrap (bubblewrap) is installed and usable."
|
|
*bwrap-available*)
|
|
|
|
(defun bwrap-wrap-command (cmd timeout memex-dir)
|
|
"Wrap CMD in a bwrap sandbox with network and IPC isolation.
|
|
Returns a list suitable for uiop:run-program."
|
|
`("bwrap"
|
|
,@*bwrap-base-args*
|
|
"--bind" ,memex-dir ,memex-dir
|
|
"timeout" ,(format nil "~a" timeout)
|
|
"bash" "-c" ,cmd))
|
|
|
|
;; Initialize at load time
|
|
(setf *bwrap-available*
|
|
(= 0 (nth-value 2 (uiop:run-program '("which" "bwrap") :output nil :error-output nil :ignore-error-status t))))
|
|
|
|
(defun actuator-shell-execute (action context)
|
|
"Executes a shell command via the OS timeout binary with output limit.
|
|
When bwrap is available, wraps the command in a Linux namespace sandbox."
|
|
(declare (ignore context))
|
|
(let* ((payload (getf action :payload))
|
|
(cmd (getf payload :cmd))
|
|
(timeout-sym (find-symbol "*DISPATCHER-SHELL-TIMEOUT*" :passepartout))
|
|
(timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30)))
|
|
(max-sym (find-symbol "*DISPATCHER-SHELL-MAX-OUTPUT*" :passepartout))
|
|
(max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))
|
|
(memex-dir (or (uiop:getenv "MEMEX_DIR") (namestring (merge-pathnames "memex/" (user-homedir-pathname))))))
|
|
(log-message "ACT [Shell]: ~a (timeout: ~as)~@[ bwrap: enabled~]" cmd timeout (and *bwrap-available* " (bwrap)"))
|
|
(let ((cmdline (if *bwrap-available*
|
|
(bwrap-wrap-command cmd timeout memex-dir)
|
|
(list "timeout" (format nil "~a" timeout) "bash" "-c" cmd))))
|
|
(multiple-value-bind (out err code)
|
|
(uiop:run-program cmdline
|
|
:output :string :error-output :string
|
|
:ignore-error-status t)
|
|
(cond
|
|
((= code 124) (format nil "ERROR: Command timed out after ~a seconds" timeout))
|
|
((> (length out) max-output)
|
|
(format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output))
|
|
((= code 0) out)
|
|
(t (format nil "ERROR [~a]: ~a" code err)))))))
|
|
|
|
(register-actuator :shell #'actuator-shell-execute)
|
|
|
|
(defskill :passepartout-channel-shell
|
|
:priority 50
|
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|