diff --git a/lisp/core-skills.lisp b/lisp/core-skills.lisp index 47622c3..a3f018b 100644 --- a/lisp/core-skills.lisp +++ b/lisp/core-skills.lisp @@ -247,21 +247,38 @@ declarations so embedded test code evaluates in the correct package." (log-message "LOADER: Loading .lisp skill '~a' in package ~a" skill-base-name (package-name *package*)) (with-input-from-string (s content) (loop for form = (read s nil :eof) until (eq form :eof) - do (handler-case (eval form) - (error (c) (log-message "LOADER WARNING in '~a': ~a" skill-base-name c)))))) - (let ((target-pkg (find-package :passepartout)) - (exported 0) - (seen (make-hash-table :test 'equal))) - (do-symbols (sym (find-package pkg-name)) - (when (and (eq (symbol-package sym) (find-package pkg-name)) - (or (fboundp sym) (boundp sym)) - (not (gethash (symbol-name sym) seen))) - (setf (gethash (symbol-name sym) seen) t) - (incf exported) - (let ((existing (find-symbol (symbol-name sym) target-pkg))) - (when existing (unintern existing target-pkg))) - (import sym target-pkg) - (ignore-errors (export sym target-pkg)))) + do (handler-case (eval form) + (error (c) (log-message "LOADER WARNING in '~a': ~a" skill-base-name c)))))) + (let* ((jailed-pkg (find-package pkg-name)) + (restricted '("RUN-PROGRAM" "SHELL" "RUN-SHELL-COMMAND")) + (violation (loop for r in restricted + for sym = (find-symbol r :uiop) + when (and sym (fboundp sym) + (loop for skill-sym being the symbols of jailed-pkg + when (and (fboundp skill-sym) + (eq (symbol-function skill-sym) + (symbol-function sym))) + return skill-sym)) + collect (format nil "~a" sym)))) + (when violation + (log-message "LOADER SANDBOX: Skill '~a' blocked — references restricted symbol(s): ~{~a~^, ~}" + skill-base-name violation) + (setf (skill-entry-status entry) :sandbox-blocked) + (return-from load-skill-from-lisp nil)) + (log-message "LOADER SANDBOX: Skill '~a' passed sandbox check" skill-base-name)) + (let ((target-pkg (find-package :passepartout)) + (exported 0) + (seen (make-hash-table :test 'equal))) + (do-symbols (sym (find-package pkg-name)) + (when (and (eq (symbol-package sym) (find-package pkg-name)) + (or (fboundp sym) (boundp sym)) + (not (gethash (symbol-name sym) seen))) + (setf (gethash (symbol-name sym) seen) t) + (incf exported) + (let ((existing (find-symbol (symbol-name sym) target-pkg))) + (when existing (unintern existing target-pkg))) + (import sym target-pkg) + (ignore-errors (export sym target-pkg)))) (log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT" exported (package-name (find-package pkg-name)))) (setf (skill-entry-status entry) :ready)) diff --git a/lisp/security-dispatcher.lisp b/lisp/security-dispatcher.lisp index 4ae677c..5ba8669 100644 --- a/lisp/security-dispatcher.lisp +++ b/lisp/security-dispatcher.lisp @@ -278,7 +278,8 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval." ;; Vector 8: High-impact action approval ((or (member target '(:shell)) (and (eq target :tool) (member (proto-get payload :tool) '("shell" "repair-file") :test #'string=)) - (and (eq target :emacs) (eq (proto-get payload :action) :eval))) + (and (eq target :emacs) (eq (proto-get payload :action) :eval)) + (and (eq target :system) (eq (proto-get payload :action) :eval))) (log-message "SECURITY: High-impact action requires approval: ~a" (or (proto-get payload :tool) target)) (list :type :EVENT :payload (list :sensor :approval-required :action action))) (t action)))) diff --git a/lisp/system-actuator-shell.lisp b/lisp/system-actuator-shell.lisp index 16ecce5..d7eb8d7 100644 --- a/lisp/system-actuator-shell.lisp +++ b/lisp/system-actuator-shell.lisp @@ -1,16 +1,15 @@ (defun actuator-shell-execute (action context) - "Executes a bash command with timeout (via timeout(1)) and output limit." + "Executes a shell command via the OS timeout binary with output limit." (declare (ignore context)) (let* ((payload (getf action :payload)) (cmd (getf payload :cmd)) (timeout-sym (find-symbol "*BOUNCER-SHELL-TIMEOUT*" :passepartout)) (timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30))) (max-sym (find-symbol "*BOUNCER-SHELL-MAX-OUTPUT*" :passepartout)) - (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000))) - (wrapped-cmd (format nil "timeout ~a bash -c ~s" timeout cmd))) + (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))) (log-message "ACT [Shell]: ~a (timeout: ~as)" cmd timeout) (multiple-value-bind (out err code) - (uiop:run-program (list "bash" "-c" wrapped-cmd) + (uiop:run-program (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd) :output :string :error-output :string :ignore-error-status t) (cond diff --git a/org/core-skills.org b/org/core-skills.org index 57828b8..619fed9 100644 --- a/org/core-skills.org +++ b/org/core-skills.org @@ -372,21 +372,38 @@ The same jailed package and symbol export process applies. (log-message "LOADER: Loading .lisp skill '~a' in package ~a" skill-base-name (package-name *package*)) (with-input-from-string (s content) (loop for form = (read s nil :eof) until (eq form :eof) - do (handler-case (eval form) - (error (c) (log-message "LOADER WARNING in '~a': ~a" skill-base-name c)))))) - (let ((target-pkg (find-package :passepartout)) - (exported 0) - (seen (make-hash-table :test 'equal))) - (do-symbols (sym (find-package pkg-name)) - (when (and (eq (symbol-package sym) (find-package pkg-name)) - (or (fboundp sym) (boundp sym)) - (not (gethash (symbol-name sym) seen))) - (setf (gethash (symbol-name sym) seen) t) - (incf exported) - (let ((existing (find-symbol (symbol-name sym) target-pkg))) - (when existing (unintern existing target-pkg))) - (import sym target-pkg) - (ignore-errors (export sym target-pkg)))) + do (handler-case (eval form) + (error (c) (log-message "LOADER WARNING in '~a': ~a" skill-base-name c)))))) + (let* ((jailed-pkg (find-package pkg-name)) + (restricted '("RUN-PROGRAM" "SHELL" "RUN-SHELL-COMMAND")) + (violation (loop for r in restricted + for sym = (find-symbol r :uiop) + when (and sym (fboundp sym) + (loop for skill-sym being the symbols of jailed-pkg + when (and (fboundp skill-sym) + (eq (symbol-function skill-sym) + (symbol-function sym))) + return skill-sym)) + collect (format nil "~a" sym)))) + (when violation + (log-message "LOADER SANDBOX: Skill '~a' blocked — references restricted symbol(s): ~{~a~^, ~}" + skill-base-name violation) + (setf (skill-entry-status entry) :sandbox-blocked) + (return-from load-skill-from-lisp nil)) + (log-message "LOADER SANDBOX: Skill '~a' passed sandbox check" skill-base-name)) + (let ((target-pkg (find-package :passepartout)) + (exported 0) + (seen (make-hash-table :test 'equal))) + (do-symbols (sym (find-package pkg-name)) + (when (and (eq (symbol-package sym) (find-package pkg-name)) + (or (fboundp sym) (boundp sym)) + (not (gethash (symbol-name sym) seen))) + (setf (gethash (symbol-name sym) seen) t) + (incf exported) + (let ((existing (find-symbol (symbol-name sym) target-pkg))) + (when existing (unintern existing target-pkg))) + (import sym target-pkg) + (ignore-errors (export sym target-pkg)))) (log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT" exported (package-name (find-package pkg-name)))) (setf (skill-entry-status entry) :ready)) diff --git a/org/security-dispatcher.org b/org/security-dispatcher.org index a0e8d7e..4b3203f 100644 --- a/org/security-dispatcher.org +++ b/org/security-dispatcher.org @@ -426,7 +426,8 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval." ;; Vector 8: High-impact action approval ((or (member target '(:shell)) (and (eq target :tool) (member (proto-get payload :tool) '("shell" "repair-file") :test #'string=)) - (and (eq target :emacs) (eq (proto-get payload :action) :eval))) + (and (eq target :emacs) (eq (proto-get payload :action) :eval)) + (and (eq target :system) (eq (proto-get payload :action) :eval))) (log-message "SECURITY: High-impact action requires approval: ~a" (or (proto-get payload :tool) target)) (list :type :EVENT :payload (list :sensor :approval-required :action action))) (t action)))) diff --git a/org/system-actuator-shell.org b/org/system-actuator-shell.org index e967474..e2900c5 100644 --- a/org/system-actuator-shell.org +++ b/org/system-actuator-shell.org @@ -20,18 +20,17 @@ Because shell execution is the highest-risk operation in the system, the Shell A ;; REPL-VERIFIED: 2026-05-03T13:00:00 #+begin_src lisp (defun actuator-shell-execute (action context) - "Executes a bash command with timeout (via timeout(1)) and output limit." + "Executes a shell command via the OS timeout binary with output limit." (declare (ignore context)) (let* ((payload (getf action :payload)) (cmd (getf payload :cmd)) (timeout-sym (find-symbol "*BOUNCER-SHELL-TIMEOUT*" :passepartout)) (timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30))) (max-sym (find-symbol "*BOUNCER-SHELL-MAX-OUTPUT*" :passepartout)) - (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000))) - (wrapped-cmd (format nil "timeout ~a bash -c ~s" timeout cmd))) + (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))) (log-message "ACT [Shell]: ~a (timeout: ~as)" cmd timeout) (multiple-value-bind (out err code) - (uiop:run-program (list "bash" "-c" wrapped-cmd) + (uiop:run-program (list "timeout" (format nil "~a" timeout) "bash" "-c" cmd) :output :string :error-output :string :ignore-error-status t) (cond