amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

v0.3.2: shell safety, :system :eval approval, skill sandbox
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
Details

Browse Source 
1. Shell actuator: remove double bash -c wrapping (format ~s produces
   S-expression-safe strings, not shell-safe). Now passes cmd directly
   to (timeout N bash -c cmd) via run-program arg list.

2. Dispatcher: extend high-impact approval gate to :system :eval.
   Previously only :shell, :tool "shell", and :emacs :eval triggered
   HITL. Now :system :eval also requires Flight Plan approval.

3. Skill sandbox: before promoting a skill from its jailed package to
   :passepartout, scan for restricted symbol references (uiop:run-program,
   uiop:shell, uiop:run-shell-command). Block promotion on violation.
   New skill-entry status :sandbox-blocked for blocked skills.

Test: 91 pass, 0 fail across 13 suites.
This commit is contained in:
Amr Gharbeia
2026-05-06 16:46:49 -04:00
parent a31f19045a
commit 4bed6dd461
6 changed files with 74 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
org/core-skills.org
View File

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