diff --git a/lisp/security-dispatcher.lisp b/lisp/security-dispatcher.lisp index 21fdb0b..e3f4048 100644 --- a/lisp/security-dispatcher.lisp +++ b/lisp/security-dispatcher.lisp @@ -23,7 +23,9 @@ ".kube/config" "kubeconfig" "*.cert" "*.crt" "*.csr" "*password*" "*passwd*") - "Path patterns blocked from file reads.") + "Path patterns blocked from file reads. +Core file protection (core-*.org, core-*.lisp) handled separately by +dispatcher-check-core-path for self-build safety.") (defvar *dispatcher-exposure-patterns* '((:pem-key "-----BEGIN +(RSA|DSA|EC|OPENSSH|PGP) +PRIVATE +KEY *-----") @@ -60,6 +62,12 @@ "\\*" (cl-ppcre:quote-meta-chars pattern) ".*"))) (cl-ppcre:scan regex path))) +(defun dispatcher-check-core-path (filepath) + "Returns T if FILEPATH matches a core-* self-build protected pattern." + (when (and filepath (stringp filepath)) + (or (and (>= (length filepath) 5) (string-equal (subseq filepath 0 5) "core-")) + (cl-ppcre:scan "core-.*\\.(org|lisp)" filepath)))) + (defun dispatcher-check-secret-path (filepath) "Returns the matching pattern if FILEPATH matches a protected path, nil otherwise." (when (and filepath (stringp filepath)) @@ -229,6 +237,15 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval." :payload (list :level :error :text (format nil "Action blocked: Attempted read of protected path '~a'" filepath))))) + ;; Vector 2b: Self-build safety — core file writes require HITL approval + ((and filepath content + (string-equal (uiop:getenv "SELF_BUILD_MODE") "true") + (dispatcher-check-core-path filepath)) + (log-message "SELF-BUILD: Core file write to '~a' requires approval" filepath) + (list :type :EVENT :level :approval-required + :payload (list :sensor :approval-required :action action + :message (format nil "Core file write blocked: '~a' requires HITL approval via Flight Plan." filepath)))) + ;; Vector 3: Content contains secret patterns ((and text (dispatcher-exposure-scan text)) (let ((matched (dispatcher-exposure-scan text))) @@ -429,6 +446,22 @@ Recognized formats: (is (dispatcher-check-secret-path "id_rsa")) (is (not (dispatcher-check-secret-path "README.org")))) +(test test-self-build-core-protection + "Contract v0.4.0: core-* paths are protected; write produces approval-required in SELF_BUILD_MODE." + ;; Core paths are recognized + (is (passepartout::dispatcher-check-core-path "core-loop-reason.org")) + (is (passepartout::dispatcher-check-core-path "core-memory.lisp")) + (is (not (passepartout::dispatcher-check-core-path "gateway-tui-view.org"))) + ;; With SELF_BUILD_MODE=true, core writes produce approval-required + (let ((action '(:type :REQUEST :target :tool :payload (:tool "write-file" :args (:filepath "core-loop-reason.org" :content "x"))))) + (setf (uiop:getenv "SELF_BUILD_MODE") "true") + (let ((result (dispatcher-check action nil))) + (is (eq :approval-required (getf result :level))) + (setf (uiop:getenv "SELF_BUILD_MODE") "false")) + ;; With SELF_BUILD_MODE=false (default), writes pass through + (let ((result (dispatcher-check action nil))) + (is (eq :REQUEST (getf result :type)))))) + (test test-check-shell-safety "Contract 3: dispatcher-check-shell-safety detects dangerous commands." (is (dispatcher-check-shell-safety "rm -rf /")) diff --git a/org/security-dispatcher.org b/org/security-dispatcher.org index 3bf153e..f0d15ec 100644 --- a/org/security-dispatcher.org +++ b/org/security-dispatcher.org @@ -95,7 +95,9 @@ Path patterns (with * wildcards) that are blocked from file reads. Covers SSH ke ".kube/config" "kubeconfig" "*.cert" "*.crt" "*.csr" "*password*" "*passwd*") - "Path patterns blocked from file reads.") + "Path patterns blocked from file reads. +Core file protection (core-*.org, core-*.lisp) handled separately by +dispatcher-check-core-path for self-build safety.") #+end_src ** Content exposure patterns (*dispatcher-exposure-patterns*) @@ -157,6 +159,15 @@ Destructive and injection patterns that are blocked in shell commands. Covers ~r (cl-ppcre:scan regex path))) #+end_src +** dispatcher-check-core-path +;; REPL-VERIFIED: 2026-05-06T18:00:00 +#+begin_src lisp +(defun dispatcher-check-core-path (filepath) + "Returns T if FILEPATH matches a core-* self-build protected pattern." + (when (and filepath (stringp filepath)) + (or (and (>= (length filepath) 5) (string-equal (subseq filepath 0 5) "core-")) + (cl-ppcre:scan "core-.*\\.(org|lisp)" filepath)))) +#+end_src ** dispatcher-check-secret-path ;; REPL-VERIFIED: 2026-05-03T13:00:00 #+begin_src lisp @@ -377,6 +388,15 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval." :payload (list :level :error :text (format nil "Action blocked: Attempted read of protected path '~a'" filepath))))) + ;; Vector 2b: Self-build safety — core file writes require HITL approval + ((and filepath content + (string-equal (uiop:getenv "SELF_BUILD_MODE") "true") + (dispatcher-check-core-path filepath)) + (log-message "SELF-BUILD: Core file write to '~a' requires approval" filepath) + (list :type :EVENT :level :approval-required + :payload (list :sensor :approval-required :action action + :message (format nil "Core file write blocked: '~a' requires HITL approval via Flight Plan." filepath)))) + ;; Vector 3: Content contains secret patterns ((and text (dispatcher-exposure-scan text)) (let ((matched (dispatcher-exposure-scan text))) @@ -646,6 +666,22 @@ Recognized formats: (is (dispatcher-check-secret-path "id_rsa")) (is (not (dispatcher-check-secret-path "README.org")))) +(test test-self-build-core-protection + "Contract v0.4.0: core-* paths are protected; write produces approval-required in SELF_BUILD_MODE." + ;; Core paths are recognized + (is (passepartout::dispatcher-check-core-path "core-loop-reason.org")) + (is (passepartout::dispatcher-check-core-path "core-memory.lisp")) + (is (not (passepartout::dispatcher-check-core-path "gateway-tui-view.org"))) + ;; With SELF_BUILD_MODE=true, core writes produce approval-required + (let ((action '(:type :REQUEST :target :tool :payload (:tool "write-file" :args (:filepath "core-loop-reason.org" :content "x"))))) + (setf (uiop:getenv "SELF_BUILD_MODE") "true") + (let ((result (dispatcher-check action nil))) + (is (eq :approval-required (getf result :level))) + (setf (uiop:getenv "SELF_BUILD_MODE") "false")) + ;; With SELF_BUILD_MODE=false (default), writes pass through + (let ((result (dispatcher-check action nil))) + (is (eq :REQUEST (getf result :type)))))) + (test test-check-shell-safety "Contract 3: dispatcher-check-shell-safety detects dangerous commands." (is (dispatcher-check-shell-safety "rm -rf /"))