(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)) (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))))