fix: HITL functions now properly loaded, define missing proto-get
Some checks failed
Deploy (Gitea) / deploy (push) Has been cancelled

Root cause chain:
1. proto-get was used throughout the pipeline but never defined — added
   to core-communication.org as a keyword-normalizing getf wrapper.
2. security-dispatcher.lisp was loaded by skill-initialize-all into a
   separate package, making HITL functions invisible to :passepartout.
   Fixed by adding to ASDF component list and excluding from skill loader.
3. org-id-generate was referenced from hitl-create but lives in an
   unexported skill package — replaced with uuid:make-v4-uuid.
4. uiop:string-prefix-p was called with :test keyword argument it does
   not accept — replaced with string-downcase normalization on both sides.

Also:
- Export hitl-create, hitl-approve, hitl-deny, hitl-handle-message,
  stimulus-inject from :passepartout for REPL accessibility.
This commit is contained in:
2026-05-03 14:21:08 -04:00
parent a16f973b50
commit ce90fd3e72
10 changed files with 74 additions and 39 deletions

View File

@@ -24,7 +24,11 @@ The Bouncer also handles the **Flight Plan** system: when a high-risk action is
* Implementation
* Implementation
** Package Context
#+begin_src lisp
(in-package :passepartout)
#+end_src
** Security Configuration — network whitelist
Domains that the Bouncer considers safe for outbound connections. Network calls to unlisted domains are blocked or queued for approval.
@@ -432,7 +436,7 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
#+begin_src lisp
(defun dispatcher-flight-plan-create (blocked-action)
"Creates a Flight Plan node for manual approval in Emacs."
(let ((id (org-id-generate)))
(let ((id (remove #\- (princ-to-string (uuid:make-v4-uuid)))))
(log-message "BOUNCER: Creating flight plan node '~a'..." id)
(list :type :REQUEST :target :emacs
:payload (list :action :insert-node :id id
@@ -465,7 +469,7 @@ the blocked action is stored for later retrieval by ~hitl-approve~ or
(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 (org-id-generate) 3 11))))
(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
@@ -542,15 +546,15 @@ Recognized formats:
approve HITL-abc123
deny HITL-abc123"
(let ((text (string-trim '(#\Space) (or text ""))))
(when (or (uiop:string-prefix-p "/approve" text :test #'char-equal)
(uiop:string-prefix-p "approve" text :test #'char-equal))
(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 "/deny" text :test #'char-equal)
(uiop:string-prefix-p "deny " text :test #'char-equal))
(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))