feat: add DeepSeek and NVIDIA NIM providers

- Add deepseek and nvidia entries to gateway-provider config

- Add DEEPSEEK_API_KEY and NVIDIA_API_KEY to .env.example

- Add deepseek and nvidia to doctor's LLM provider check

- Fix remaining harness-log → log-message reference

lisp/core-communication.lisp

@@ -0,0 +1,122 @@
+(in-package :passepartout)
+
+(defvar *actuator-registry* (make-hash-table :test 'equalp)
+  "Global registry mapping target keywords to their physical actuator functions.")
+
+(defun actuator-register (name fn) 
+  "Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
+  (let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword))))
+    (setf (gethash key *actuator-registry*) fn)))
+
+(defun protocol-message-sanitize (msg)
+  "Recursively strips non-serializable objects from a protocol plist."
+  (if (and msg (listp msg))
+      (let ((clean nil))
+        (loop for (k v) on msg by #'cddr
+              do (unless (member k '(:reply-stream :socket :stream))
+                   (push k clean)
+                   (push (if (listp v) (protocol-message-sanitize v) v) clean)))
+        (nreverse clean))
+      msg))
+
+(defun frame-message (msg)
+  "Serializes a message plist and prefixes it with a 6-character hex length."
+  (let* ((sanitized (protocol-message-sanitize msg))
+         (payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
+         (len (length payload)))
+    (format nil "~6,'0x~a" len payload)))
+
+(defun read-framed-message (stream)
+  "Reads a hex-length prefixed S-expression from the stream securely."
+  (let ((length-buffer (make-string 6)))
+    (handler-case
+        (progn
+          (loop for char = (peek-char nil stream nil :eof)
+                while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
+                do (read-char stream))
+          (let ((count (read-sequence length-buffer stream)))
+            (if (< count 6)
+                :eof
+                (let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
+                  (if (not len)
+                      :error
+                      (let ((msg-buffer (make-string len)))
+                        (read-sequence msg-buffer stream)
+                        (let ((*read-eval* nil))
+                          (handler-case (read-from-string msg-buffer)
+                            (error () :error)))))))))
+      (error () :error))))
+
+(defvar *daemon-socket* nil)
+
+(defun client-handle-connection (socket)
+  "Handles a single TUI/CLI client connection in a dedicated thread."
+  (let ((stream (usocket:socket-stream socket)))
+    (handler-case
+        (progn
+          (format stream "~a" (frame-message (make-hello-message "0.2.0")))
+          (finish-output stream)
+          (loop
+            (let ((msg (read-framed-message stream)))
+              (cond
+                ((eq msg :eof) (return))
+                ((eq msg :error) (return))
+                ((eq (getf msg :type) :health-check)
+                 (let ((health-msg (list :type :health-response 
+                                         :status (or (and (boundp 'passepartout::*system-health*) 
+                                                         (symbol-value 'passepartout::*system-health*))
+                                                     :unknown)
+                                         :checked-p (or (and (boundp 'passepartout::*health-check-ran*)
+                                                             (symbol-value 'passepartout::*health-check-ran*))
+                                                     nil))))
+                   (format stream "~a" (frame-message health-msg))
+                   (finish-output stream)))
+                (t (inject-stimulus msg :stream stream))))))
+      (error (c) (harness-log "CLIENT ERROR: ~a" c)))
+    (ignore-errors (usocket:socket-close socket))))
+
+(defun start-daemon (&key (port 9105))
+  "Starts the network listener for TUI/CLI clients."
+  (setf *daemon-socket* (usocket:socket-listen "127.0.0.1" port :reuse-address t))
+  (harness-log "DAEMON: Listening on localhost:~a" port)
+  (bt:make-thread
+   (lambda ()
+     (loop
+       (let ((client-socket (usocket:socket-accept *daemon-socket*)))
+         (when client-socket
+           (bt:make-thread (lambda () (client-handle-connection client-socket))
+                          :name "passepartout-client-handler")))))
+   :name "passepartout-server-listener"))
+
+(defun make-hello-message (version)
+  "Constructs the standard HELLO handshake message."
+  (list :TYPE :EVENT 
+        :PAYLOAD (list :ACTION :handshake 
+                       :VERSION version 
+                       :CAPABILITIES '(:AUTH :ORG-AST))))
+
+(in-package :passepartout)
+
+(defun protocol-schema-validate (msg)
+  "Strict structural validation for incoming protocol messages."
+  (unless (listp msg) (error "Message must be a plist"))
+  (let ((type (proto-get msg :type)))
+    (unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS))
+      (error "Invalid message type '~a'" type))
+    t))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-communication-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:communication-protocol-suite))
+(in-package :passepartout-communication-tests)
+
+(def-suite communication-protocol-suite :description "Communication Protocol Suite")
+(in-suite communication-protocol-suite)
+
+(test test-framing
+  (let* ((msg '(:type :EVENT :payload (:action :handshake)))
+         (framed (frame-message msg)))
+    (is (string= "00002C" (string-upcase (subseq framed 0 6))))))

lisp/core-context.lisp

@@ -0,0 +1,163 @@
+(in-package :passepartout)
+
+(defun context-query (&key tag todo-state type)
+  "Filters the Memory based on tags, todo states, or types."
+  (let ((results nil))
+    (maphash (lambda (id obj)
+               (declare (ignore id))
+               (let* ((attrs (org-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
+                 (when (and type (not (eq (org-object-type obj) type))) (setf match nil))
+                 (when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
+                 (when (and todo-state (not (equal state todo-state))) (setf match nil))
+                 (when match (push obj results))))
+             *memory*)
+    results))
+
+(defun context-active-projects ()
+  "Returns headlines tagged as 'project' that are not yet marked DONE."
+  (remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE"))
+             (context-query :tag "project" :type :HEADLINE)))
+
+(defun context-recent-tasks () 
+  "Retrieves recently finished tasks from the store."
+  (context-query :todo-state "DONE" :type :HEADLINE))
+
+(defun context-skill-list ()
+  "Provides a sorted overview of currently loaded system capabilities."
+  (let ((results nil))
+    (maphash (lambda (name skill)
+               (declare (ignore name))
+               (push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
+             *skills-registry*)
+    (sort results #'> :key (lambda (x) (getf x :priority)))))
+
+(defun context-skill-source (skill-name)
+  "Reads the raw literate source of a specific skill for inspection."
+  (let* ((filename (format nil "~a.org" skill-name))
+         (data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
+         (skills-dir (merge-pathnames "skills/" data-dir))
+         (full-path (merge-pathnames filename skills-dir)))
+    (if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
+
+(defun context-logs (&optional limit)
+  "Retrieves the most recent lines from the harness's internal log."
+  (let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20)))
+    (bt:with-lock-held (*logs-lock*)
+      (let ((count (min log-limit (length *system-logs*)))) 
+        (subseq *system-logs* 0 count)))))
+
+(defun context-object-render (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil))
+  "Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
+  (let* ((id (org-object-id obj))
+         (is-foveal (equal id foveal-id))
+         (title (or (getf (org-object-attributes obj) :TITLE) "Untitled"))
+         (content (org-object-content obj))
+         (children (org-object-children obj))
+         (stars (make-string depth :initial-element #\*))
+         (obj-vector (org-object-vector obj))
+         (threshold (or semantic-threshold (ignore-errors (read-from-string (uiop:getenv "CONTEXT_SEMANTIC_THRESHOLD"))) 0.75))
+         (similarity (if (and foveal-vector obj-vector (not is-foveal))
+                         (cosine-similarity foveal-vector obj-vector)
+                         0.0))
+         (is-semantically-relevant (>= similarity threshold))
+         (should-render (or (<= depth 2) is-foveal is-semantically-relevant))
+         (output ""))
+    
+    (when should-render
+      (setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id))
+      (when is-semantically-relevant
+        (setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity))))
+      (setf output (concatenate 'string output (format nil ":END:~%")))
+      
+      (when (and content (or is-foveal is-semantically-relevant))
+        (setf output (concatenate 'string output content (string #\Newline))))
+      
+      (dolist (child-id children)
+        (let ((child-obj (lookup-object child-id)))
+          (when child-obj
+            (let ((next-foveal (if is-foveal child-id foveal-id)))
+              (setf output (concatenate 'string output 
+                                        (context-object-render child-obj 
+                                                               :depth (1+ depth) 
+                                                               :foveal-id next-foveal
+                                                               :semantic-threshold threshold
+                                                               :foveal-vector foveal-vector))))))))
+    output))
+
+(defun context-path-resolve (path-string)
+  "Expands environment variables and strips literal quotes from a path string."
+  (let ((path (if (stringp path-string) 
+                  (string-trim '(#\" #\' #\Space) path-string)
+                  path-string)))
+    (if (and (stringp path) (search "$" path))
+        (let ((result path))
+          (ppcre:do-register-groups (var-name) ("\\$([A-Za-z0-9_]+)" path)
+            (let ((var-val (uiop:getenv var-name)))
+              (when var-val
+                (setf result (ppcre:regex-replace (format nil "\\$~a" var-name) result var-val)))))
+          result)
+        path)))
+
+(defun context-privacy-filtered-p (obj)
+  "Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags."
+  (let* ((attrs (org-object-attributes obj))
+         (tags (getf attrs :TAGS))
+         (privacy-tags (and (find-package :passepartout.security-dispatcher)
+                            (symbol-value
+                             (find-symbol "BOUNCER-PRIVACY-TAGS"
+                                          :passepartout.security-dispatcher)))))
+    (when (and tags privacy-tags)
+      (let ((tag-list (if (listp tags) tags (list tags))))
+        (some (lambda (tag)
+                (some (lambda (private)
+                        (string-equal (string-trim '(#\:) tag)
+                                      (string-trim '(#\:) private)))
+                      privacy-tags))
+              tag-list)))))
+
+(defun context-awareness-assemble (&optional signal)
+  "Produces a high-level skeletal outline of the current Memory for the LLM.
+Privacy-filtered objects (matching bouncer-privacy-tags) are excluded."
+  (let* ((foveal-id (or (getf signal :foveal-focus) 
+                        (ignore-errors (getf (getf signal :payload) :target-id))))
+         (all-projects (context-active-projects))
+         (projects (remove-if #'context-privacy-filtered-p all-projects))
+         (output (format nil "GLOBAL MEMEX AWARENESS (Peripheral Vision):~%")))
+    (if projects
+        (dolist (project projects)
+          (setf output (concatenate 'string output
+                                    (context-object-render project :foveal-id foveal-id))))
+        (setf output (concatenate 'string output "No active projects found.~%")))
+    output))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-peripheral-vision-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:vision-suite))
+(in-package :passepartout-peripheral-vision-tests)
+
+(def-suite vision-suite :description "Verification of Foveal-Peripheral context model.")
+(in-suite vision-suite)
+
+(test test-foveal-rendering
+  (clrhash passepartout::*memory*)
+  (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS ("project"))
+                :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
+                             :raw-content "FOVEAL CONTENT" :contents nil)
+                            (:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
+                             :raw-content "PERIPHERAL CONTENT" :contents nil)))))
+    (ingest-ast ast)
+    (let ((output (context-awareness-assemble (list :foveal-focus "node-foveal"))))
+      (is (search "FOVEAL CONTENT" output))
+      (is (search "* Peripheral Node" output))
+      (is (not (search "PERIPHERAL CONTENT" output))))))
+
+(test test-awareness-budget
+  (clrhash passepartout::*memory*)
+  (ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS ("project")) :contents nil))
+  (ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS ("project")) :contents nil))
+  (let ((output (context-awareness-assemble)))
+    (is (search "Project 1" output))
+    (is (search "Project 2" output))))

lisp/core-defpackage.lisp

@@ -0,0 +1,227 @@
+(defpackage :passepartout
+  (:use :cl)
+  (:export
+   #:frame-message
+   #:read-framed-message
+   #:PROTO-GET
+   #:LIST-OBJECTS-WITH-ATTRIBUTE
+   #:COSINE-SIMILARITY
+   #:VAULT-MASK-STRING
+   #:*VAULT-MEMORY*
+   #:parse-message
+   #:make-hello-message
+   #:validate-communication-protocol-schema
+   #:start-daemon
+   #:stop-daemon
+   #:log-message
+   #:main
+   #:doctor-run-all
+   #:doctor-main
+   #:doctor-check-dependencies
+   #:doctor-check-env
+   #:register-provider
+   #:system-ready-p
+   #:run-setup-wizard
+   #:skill-gateway-register
+   #:skill-gateway-link
+   #:gateway-manager-main
+   #:ingest-ast
+   #:lookup-object
+   #:list-objects-by-type
+   #:org-id-new
+   #:*memory*
+   #:*history-store*
+   #:org-object
+   #:make-org-object
+   #:org-object-id
+   #:org-object-type
+   #:org-object-attributes
+   #:org-object-parent-id
+   #:org-object-children
+   #:org-object-version
+   #:org-object-last-sync
+   #:org-object-vector
+   #:org-object-content
+   #:org-object-hash
+   #:snapshot-memory
+   #:rollback-memory
+   #:context-query-store
+   #:context-get-active-projects
+   #:context-get-recent-completed-tasks
+   #:context-list-all-skills
+   #:context-get-skill-source
+   #:context-get-system-logs
+   #:context-resolve-path
+   #:context-get-skill-telemetry
+   #:telemetry-track
+   #:context-assemble-global-awareness
+   #:loop-process
+   #:loop-process
+   #:perceive-gate
+   #:probabilistic-gate
+   #:consensus-gate
+   #:act-gate
+   #:reason-gate
+   #:dispatch-gate
+   #:inject-stimulus
+   #:initialize-actuators
+   #:dispatch-action
+   #:register-actuator
+   #:load-skill-from-org
+   #:skill-initialize-all
+   #:load-skill-with-timeout
+   #:topological-sort-skills
+   #:validate-lisp-syntax
+   #:defskill
+   #:*skill-registry*
+   #:skill
+   #:skill-name
+   #:skill-priority
+   #:skill-dependencies
+   #:skill-trigger-fn
+   #:skill-probabilistic-prompt
+   #:skill-deterministic-fn
+   #:def-cognitive-tool
+   #:*cognitive-tool-registry*
+   #:verify-git-clean-p
+   #:engineering-standards-verify-lisp
+   #:engineering-standards-format-lisp
+   #:literate-check-block-balance
+   #:check-tangle-sync
+   #:*tangle-targets*
+   #:utils-org-read-file
+   #:utils-org-write-file
+   #:utils-org-add-headline
+   #:utils-org-set-property
+   #:utils-org-set-todo
+   #:utils-org-find-headline-by-id
+   #:utils-org-find-headline-by-title
+   #:utils-org-generate-id
+   #:utils-org-id-format
+   #:utils-org-ast-to-org
+   #:utils-org-modify
+   #:utils-lisp-validate
+   #:utils-lisp-check-structural
+   #:utils-lisp-check-syntactic
+   #:utils-lisp-check-semantic
+   #:utils-lisp-eval
+   #:utils-lisp-format
+   #:utils-lisp-list-definitions
+   #:utils-lisp-structural-extract
+   #:utils-lisp-structural-wrap
+   #:utils-lisp-structural-inject
+   #:utils-lisp-structural-slurp
+   #:utils-lisp-register
+   #:get-oc-config-dir
+   #:prompt-for
+   #:save-secret
+   #:get-tool-permission
+   #:set-tool-permission
+   #:check-tool-permission-gate
+   #:cognitive-tool
+   #:cognitive-tool-name
+   #:cognitive-tool-description
+   #:cognitive-tool-parameters
+   #:cognitive-tool-guard
+   #:cognitive-tool-body
+   #:*emacs-clients*
+   #:*clients-lock*
+   #:register-emacs-client
+   #:unregister-emacs-client
+   #:ask-probabilistic
+   #:register-probabilistic-backend
+   #:distill-prompt
+   #:*probabilistic-backends*
+   #:*provider-cascade*
+   #:vault-get-secret
+   #:vault-set-secret
+   #:memory-objects-by-attribute
+   #:deterministic-verify
+   #:find-headline-missing-id))
+
+(in-package :passepartout)
+
+(defun plist-get (plist key)
+  "Robust plist accessor — checks both :KEY and :key variants."
+  (let* ((s (string key))
+         (up (intern (string-upcase s) :keyword))
+         (dn (intern (string-downcase s) :keyword)))
+    (or (getf plist up) (getf plist dn))))
+
+(defvar *log-buffer* nil)
+(defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock"))
+(defvar *log-limit* 100)
+
+(defvar *skill-registry* (make-hash-table :test 'equal)
+  "Global registry of all loaded skills.")
+
+(defvar *telemetry-table* (make-hash-table :test 'equal))
+(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
+
+(defun telemetry-track (skill-name duration status)
+  "Updates performance metrics for a skill. STATUS is :success or :rejected."
+  (when skill-name
+    (bordeaux-threads:with-lock-held (*telemetry-lock*)
+      (let ((entry (or (gethash skill-name *telemetry-table*) (list :executions 0 :total-time 0 :failures 0))))
+        (incf (getf entry :executions))
+        (incf (getf entry :total-time) duration)
+        (when (eq status :rejected) (incf (getf entry :failures)))
+        (setf (gethash skill-name *telemetry-table*) entry)))))
+
+(defvar *cognitive-tool-registry* (make-hash-table :test 'equal))
+
+(defstruct cognitive-tool
+  name
+  description
+  parameters
+  guard
+  body)
+
+(defmacro def-cognitive-tool (name description parameters &key guard body)
+  "Registers a cognitive tool. PARAMETERS is a list of plists, one per parameter."
+  `(setf (gethash (string-downcase (string ',name)) *cognitive-tool-registry*)
+         (make-cognitive-tool :name (string-downcase (string ',name))
+                              :description ,description
+                              :parameters ',parameters
+                              :guard ,guard
+                              :body ,body)))
+
+(defun cognitive-tool-prompt ()
+  "Serialises all registered tools into a prompt string for the LLM."
+  (let ((descriptions nil))
+    (maphash (lambda (k tool)
+               (declare (ignore k))
+               (push (format nil "- ~a: ~a~%  Parameters: ~a~%"
+                             (cognitive-tool-name tool)
+                             (cognitive-tool-description tool)
+                             (cognitive-tool-parameters tool))
+                     descriptions))
+              *cognitive-tool-registry*)
+    (if descriptions
+        (format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<)))
+        "No tools registered.")))
+
+(defun log-message (msg &rest args)
+  "Centralized, thread-safe logging for the harness."
+  (let ((formatted-msg (apply #'format nil msg args)))
+    (bordeaux-threads:with-lock-held (*log-lock*)
+      (push formatted-msg *log-buffer*)
+      (when (> (length *log-buffer*) *log-limit*)
+        (setq *log-buffer* (subseq *log-buffer* 0 *log-limit*))))
+    (format t "~a~%" formatted-msg)
+    (finish-output)))
+
+(setf *debugger-hook* (lambda (condition hook)
+  "Friendly error handler - shows diagnostic message instead of raw debugger."
+  (declare (ignore hook))
+  (format t "~%")
+  (format t "┌─────────────────────────────────────────────┐~%")
+  (format t "│  ERROR: ~A~%" (type-of condition))
+  (format t "│~%")
+  (format t "│  Run: passepartout doctor~%")
+  (format t "│  For system diagnostics~%")
+  (format t "└─────────────────────────────────────────────┘~%")
+  (format t "~%")
+  (format t "Details: ~A~%" condition)
+  (finish-output)
+  (uiop:quit 1)))

lisp/core-loop-act.lisp

@@ -0,0 +1,152 @@
+(in-package :passepartout)
+
+(defvar *actuator-default* :cli
+  "The actuator used when no explicit target is specified.")
+
+(defvar *actuator-silent* '(:cli :system-message :emacs)
+  "List of actuators that don't generate tool-output feedback.")
+
+(defun actuator-initialize ()
+  "Register core actuators and load configuration."
+  (let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
+        (silent (uiop:getenv "SILENT_ACTUATORS")))
+    (when def
+      (setf *actuator-default* (intern (string-upcase def) :keyword)))
+    (when silent
+      (setf *actuator-silent*
+            (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
+                    (uiop:split-string silent :separator '(#\,))))))
+
+  (register-actuator :system #'action-system-execute)
+  (register-actuator :tool #'action-tool-execute)
+
+  (register-actuator :tui (lambda (action context)
+                            (declare (ignore context))
+                            (let* ((meta (getf action :meta))
+                                   (stream (getf meta :reply-stream)))
+                              (when (and stream (open-stream-p stream))
+                                (format stream "~a" (frame-message action))
+                                (finish-output stream))))))
+
+(defun action-dispatch (action context)
+  "Route an approved action to its registered actuator."
+  (let ((payload (proto-get action :payload)))
+    (when (eq (proto-get payload :sensor) :heartbeat)
+      (return-from action-dispatch nil))
+
+    (when (and action (listp action))
+      (let* ((meta (proto-get context :meta))
+             (source (proto-get meta :source))
+             (raw-target (or (proto-get action :target) source *actuator-default*))
+             (target (intern (string-upcase (string raw-target)) :keyword))
+             (actuator-fn (gethash target *actuator-registry*)))
+        (when (and meta (null (getf action :meta)))
+          (setf (getf action :meta) meta))
+        (if actuator-fn
+            (funcall actuator-fn action context)
+            (harness-log "ACT ERROR: No actuator registered for '~s'" target))))))
+
+(defun action-system-execute (action context)
+  "Execute internal harness commands."
+  (declare (ignore context))
+  (let* ((payload (getf action :payload))
+         (cmd (getf payload :action)))
+    (case cmd
+      (:eval
+       (eval (read-from-string (getf payload :code))))
+      (:message
+       (harness-log "ACT [System]: ~a" (getf payload :text)))
+      (t
+       (harness-log "ACT ERROR [System]: Unknown command '~s'" cmd)))))
+
+(defun action-tool-execute (action context)
+  "Execute a registered cognitive tool."
+  (let* ((payload (getf action :payload))
+         (tool-name (getf payload :tool))
+         (tool-args (getf payload :args))
+         (depth (getf context :depth 0))
+         (meta (getf context :meta))
+         (source (getf meta :source))
+         (tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
+    (if tool
+        (handler-case
+            (let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
+                   (result (funcall (cognitive-tool-body tool) clean-args)))
+              (when source
+                (action-dispatch (list :TYPE :REQUEST :TARGET source 
+                                       :PAYLOAD (list :ACTION :MESSAGE :TEXT (tool-result-format tool-name result)))
+                                context))
+              (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
+                    :PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name)))
+          (error (c)
+            (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
+                  :PAYLOAD (list :SENSOR :tool-error :TOOL tool-name :MESSAGE (format nil "~a" c)))))
+        (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
+              :PAYLOAD (list :SENSOR :tool-error :MESSAGE (format nil "Tool '~a' not found" tool-name))))))
+
+(defun tool-result-format (tool-name result)
+  "Format a tool result for display."
+  (if (listp result)
+      (let ((status (getf result :status))
+            (content (getf result :content))
+            (msg (getf result :message)))
+        (cond
+          ((and (eq status :success) content) (format nil "~a" content))
+          ((and (eq status :error) msg) (format nil "ERROR [~a]: ~a" tool-name msg))
+          (t (format nil "TOOL [~a] RESULT: ~s" tool-name result))))
+      (format nil "TOOL [~a] RESULT: ~a" tool-name result)))
+
+(defun loop-gate-act (signal)
+  "Final stage of the metabolic pipeline: Actuation."
+  (let* ((approved (getf signal :approved-action))
+         (type (getf signal :type))
+         (meta (getf signal :meta))
+         (source (getf meta :source))
+         (feedback nil))
+    (when approved
+      (let* ((original-type (getf approved :type))
+             (verified (deterministic-verify approved signal)))
+        (if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT)) (not (member original-type '(:LOG :EVENT))))
+            (progn
+              (harness-log "ACT BLOCKED: Action failed last-mile deterministic check.")
+              (setf (getf signal :approved-action) nil)
+              (setf feedback verified))
+            (progn
+              (setf (getf signal :approved-action) verified)
+              (setf approved verified)))))
+
+    (case type
+      (:REQUEST (action-dispatch signal signal))
+      (:LOG (action-dispatch signal signal))
+      (:EVENT
+       (if approved
+           (let* ((target (getf approved :target))
+                  (result (action-dispatch approved signal)))
+             (cond
+               ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
+                (setf feedback result))
+               ((and result (not (member target *actuator-silent*)))
+                (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
+                                    :payload (list :sensor :tool-output :result result :tool approved))))))
+           (when source (action-dispatch signal signal)))))
+    (setf (getf signal :status) :acted)
+    feedback))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-pipeline-act-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:pipeline-act-suite))
+
+(in-package :passepartout-pipeline-act-tests)
+
+(def-suite pipeline-act-suite :description "Test suite for Act pipeline")
+(in-suite pipeline-act-suite)
+
+(test test-loop-gate-act-basic
+  (clrhash passepartout::*skills-registry*)
+  (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
+         (result (loop-gate-act signal)))
+    (is (eq :acted (getf signal :status)))
+    (is (null result))))

lisp/core-loop-perceive.lisp

@@ -0,0 +1,96 @@
+(in-package :passepartout)
+
+(defvar *loop-interrupt* nil)
+
+(defvar *loop-async-sensors* '(:chat-message :delegation :user-command)
+  "Sensors that are processed in dedicated threads.")
+
+(defvar *loop-focus-id* nil
+  "The Org ID of the node the user is currently interacting with.")
+
+(defun stimulus-inject (raw-message &key stream (depth 0))
+  "Inject a raw message into the signal processing pipeline."
+  (let* ((payload (getf raw-message :payload))
+         (sensor (getf payload :sensor))
+         (meta (getf raw-message :meta))
+         (async-p (or (getf payload :async-p)
+                     (member sensor *loop-async-sensors*))))
+
+    (unless meta
+      (setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
+
+    (when stream
+      (setf (getf meta :reply-stream) stream))
+
+    (setf (getf raw-message :meta) meta)
+    (setf (getf raw-message :depth) depth)
+
+    (if async-p
+        (bt:make-thread
+         (lambda ()
+           (restart-case (process-signal raw-message)
+             (skip-event () nil)))
+         :name "passepartout-async-task")
+        
+        (restart-case
+            (handler-bind ((error (lambda (c)
+                                    (harness-log "SYSTEM ERROR: ~a" c)
+                                    (invoke-restart 'skip-event))))
+              (process-signal raw-message))
+          (skip-event ()
+            (harness-log "SYSTEM RECOVERY: Stimulus dropped."))))))
+
+(defun loop-gate-perceive (signal)
+  "Stage 1 of the metabolic pipeline: Normalize sensory input."
+  (let* ((payload (getf signal :payload))
+         (type (getf signal :type))
+         (meta (getf signal :meta))
+         (sensor (getf payload :sensor)))
+
+    (harness-log "GATE [Perceive]: ~a (~a) [Source: ~s]"
+                 type (or sensor "no-sensor") (getf meta :source))
+
+    (cond ((eq type :EVENT)
+           (case sensor
+             (:buffer-update
+              (let ((ast (getf payload :ast)))
+                (when ast
+                  (snapshot-memory)
+                  (ingest-ast ast))))
+             (:point-update
+              (let ((element (getf payload :element)))
+                (when element
+                  (snapshot-memory)
+                  (setf *loop-focus-id* (getf element :id))
+                  (ingest-ast element))))
+             (:interrupt
+              (setf *loop-interrupt* t))))
+          ((eq type :RESPONSE)
+           (harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
+
+    (setf (getf signal :status) :perceived)
+    (setf (getf signal :foveal-focus) *loop-focus-id*)
+    signal))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-pipeline-perceive-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:pipeline-perceive-suite))
+
+(in-package :passepartout-pipeline-perceive-tests)
+
+(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline")
+(in-suite pipeline-perceive-suite)
+
+(test test-loop-gate-perceive
+  (clrhash passepartout::*memory*)
+  (let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
+         (result (loop-gate-perceive signal)))
+    (is (eq :perceived (getf result :status)))
+    (is (not (null (gethash "test-node" passepartout::*memory*))))))
+
+(test test-depth-limiting
+  (let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
+    (is (null (process-signal runaway-signal)))))

lisp/core-loop-reason.lisp

@@ -0,0 +1,170 @@
+(in-package :passepartout)
+
+(defvar *backend-registry* (make-hash-table :test 'equal))
+
+(defvar *provider-cascade* nil)
+
+(defvar *model-selector* nil)
+
+(defvar *consensus-enabled* nil)
+
+(defun backend-register (name fn)
+  (setf (gethash name *backend-registry*) fn))
+
+(defun backend-cascade-call (prompt &key
+                                (system-prompt "You are the Probabilistic engine.")
+                                (cascade nil)
+                                (context nil))
+  (let ((backends (or cascade *provider-cascade*)))
+    (or (dolist (backend backends)
+          (let ((backend-fn (gethash backend *backend-registry*)))
+            (when backend-fn
+              (harness-log "PROBABILISTIC: Attempting backend ~a..." backend)
+              (let* ((model (when *model-selector*
+                              (funcall *model-selector* backend context)))
+                     (result (if model
+                                 (funcall backend-fn prompt system-prompt :model model)
+                                 (funcall backend-fn prompt system-prompt))))
+                (cond ((and (listp result) (eq (getf result :status) :success))
+                       (return (getf result :content)))
+                      ((stringp result)
+                       (return result))
+                      (t
+                       (harness-log "PROBABILISTIC: Backend ~a failed: ~a"
+                                   backend (getf result :message))))))))
+        (list :type :LOG
+              :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
+
+(defun markdown-strip (text)
+  (if (and text (stringp text))
+      (let ((cleaned text))
+        (setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
+        (setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned ""))
+        (setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
+        (string-trim '(#\Space #\Newline #\Tab) cleaned))
+      text))
+
+(defun plist-keywords-normalize (plist)
+  (when (listp plist)
+    (loop for (k v) on plist by #'cddr
+          collect (if (and (symbolp k) (not (keywordp k)))
+                       (intern (string k) :keyword)
+                       k)
+          collect v)))
+
+(defun think (context)
+  (let* ((active-skill (find-triggered-skill context))
+         (tool-belt (generate-tool-belt-prompt))
+         (global-context (context-assemble-global-awareness))
+         (system-logs (context-get-system-logs))
+         (assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent"))
+         (rejection-trace (proto-get (proto-get context :payload) :rejection-trace))
+         (prompt-generator (when active-skill (skill-probabilistic-prompt active-skill)))
+         (raw-prompt (if prompt-generator
+                         (funcall prompt-generator context)
+                         (let ((p (proto-get (proto-get context :payload) :text)))
+                           (if (and p (stringp p)) p "Maintain metabolic stasis."))))
+         (reflection-feedback (if rejection-trace
+                                  (format nil "~%~%PREVIOUS PROPOSAL REJECTED: ~a" rejection-trace)
+                                  ""))
+         (skill-augments (let ((augments ""))
+                           (maphash (lambda (name skill)
+                                      (declare (ignore name))
+                                      (let ((aug-fn (skill-system-prompt-augment skill)))
+                                        (when aug-fn
+                                          (let ((aug-text (ignore-errors (funcall aug-fn context))))
+                                            (when (and aug-text (stringp aug-text) (> (length aug-text) 0))
+                                              (setf augments (concatenate 'string augments aug-text (string #\Newline))))))))
+                                    *skills-registry*)
+                           (when (> (length augments) 0) augments)))
+         (system-prompt (format nil "IDENTITY: ~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a~%~a" 
+                                assistant-name reflection-feedback tool-belt global-context system-logs
+                                (or skill-augments ""))))
+    (let* ((thought (backend-cascade-call raw-prompt :system-prompt system-prompt :context context))
+           (cleaned (markdown-strip thought)))
+       (if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
+           (handler-case
+               (let ((parsed (read-from-string cleaned)))
+                 (if (listp parsed)
+                     (plist-keywords-normalize parsed)
+                     (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
+             (error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
+            (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
+
+(defun cognitive-verify (proposed-action context)
+  (let ((current-action proposed-action)
+        (skills nil))
+    (maphash (lambda (name skill)
+               (declare (ignore name))
+               (when (skill-deterministic-fn skill)
+                 (push skill skills)))
+             *skills-registry*)
+    (setf skills (sort skills #'> :key #'skill-priority))
+    (dolist (skill skills)
+      (let ((trigger (skill-trigger-fn skill))
+            (gate (skill-deterministic-fn skill)))
+        (when (or (null trigger) (ignore-errors (funcall trigger context)))
+          (let ((next-action (funcall gate current-action context)))
+            (when (and (listp next-action)
+                       (member (proto-get next-action :type) '(:LOG :EVENT)))
+              (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
+              (return-from cognitive-verify next-action))
+             (when next-action (setf current-action next-action))))))
+    current-action))
+
+(defun loop-gate-reason (signal)
+  (let* ((type (proto-get signal :type))
+         (payload (proto-get signal :payload))
+         (sensor (proto-get payload :sensor)))
+    (unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
+      (return-from loop-gate-reason signal))
+    (let ((retries 3)
+          (current-signal (copy-tree signal))
+          (last-rejection nil))
+      (loop
+        (when (<= retries 0)
+          (setf (getf signal :approved-action) last-rejection)
+          (setf (getf signal :status) :reasoned)
+          (return signal))
+        (when last-rejection
+          (setf (getf (getf current-signal :payload) :rejection-trace) last-rejection))
+        (let ((candidate (think current-signal)))
+          (if (and candidate (listp candidate))
+              (let ((verified (cognitive-verify candidate current-signal)))
+                (if (member (getf verified :type) '(:LOG :EVENT))
+                    (progn (decf retries) (setf last-rejection verified))
+                    (progn
+                      (setf (getf signal :approved-action) verified)
+                      (setf (getf signal :status) :reasoned)
+                      (return signal))))
+              (progn
+                (setf (getf signal :approved-action) nil)
+                (setf (getf signal :status) :reasoned)
+                (return signal))))))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-pipeline-reason-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:pipeline-reason-suite))
+
+(in-package :passepartout-pipeline-reason-tests)
+
+(def-suite pipeline-reason-suite :description "Test suite for Reason pipeline")
+(in-suite pipeline-reason-suite)
+
+(test test-decide-gate-safety
+  (clrhash passepartout::*skills-registry*)
+  (passepartout::defskill :mock-safety
+    :priority 50
+    :trigger (lambda (ctx) (declare (ignore ctx)) t)
+    :deterministic (lambda (action ctx)
+                    (declare (ignore ctx))
+                    (if (search "rm -rf" (format nil "~s" action))
+                        (list :type :LOG :payload (list :text "Rejected"))
+                        action)))
+  (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "rm -rf /")))
+         (signal '(:type :EVENT :payload (:sensor :user-input)))
+         (result (cognitive-verify candidate signal)))
+    (is (eq :LOG (getf result :type)))))

lisp/core-loop.lisp

@@ -0,0 +1,160 @@
+(in-package :passepartout)
+
+(defvar *interrupt-flag* nil
+  "Atomic flag set by signal handlers to trigger graceful shutdown.")
+
+(defvar *loop-interrupt-lock* (bt:make-lock "harness-interrupt-lock")
+  "Mutex protecting *interrupt-flag* access.")
+
+(defvar *heartbeat-thread* nil
+  "Handle to the heartbeat thread.")
+
+(defun loop-process (signal)
+  "The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
+  (let ((current-signal signal))
+    (loop while current-signal do
+      (let ((depth (getf current-signal :depth 0))
+            (meta (getf current-signal :meta)))
+        (when (> depth 10)
+          (harness-log "METABOLISM ERROR: Max recursion depth reached.")
+          (return nil))
+
+        (when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
+          (harness-log "METABOLISM: Interrupted by shutdown signal.")
+          (return nil))
+
+        (handler-case
+            (progn
+              (setf current-signal (perceive-gate current-signal))
+              (setf current-signal (reason-gate current-signal))
+              (let ((feedback (act-gate current-signal)))
+                (if feedback
+                    (progn
+                      (unless (getf feedback :meta) (setf (getf feedback :meta) meta))
+                      (setf current-signal feedback))
+                    (setf current-signal nil))))
+          (error (c)
+            (let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
+              (harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
+              (unless (member sensor '(:loop-error :tool-error :syntax-error))
+                (harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
+                (rollback-memory 0))
+              (if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
+                  (setf current-signal nil)
+                  (setf current-signal
+                        (list :type :EVENT :depth (1+ depth) :meta meta
+                              :payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
+
+(defvar *memory-auto-save-interval* 300)
+(defvar *heartbeat-save-counter* 0)
+
+(defun heartbeat-start ()
+  "Starts the background heartbeat thread."
+  (let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60))
+        (auto-save (or (ignore-errors (parse-integer (uiop:getenv "MEMORY_AUTO_SAVE_INTERVAL"))) *memory-auto-save-interval*)))
+    (setf *memory-auto-save-interval* auto-save)
+    (setf *heartbeat-save-counter* 0)
+
+    (setf *heartbeat-thread*
+          (bt:make-thread
+           (lambda ()
+             (loop
+               (sleep interval)
+               (incf *heartbeat-save-counter*)
+               (when (>= *heartbeat-save-counter* (/ *memory-auto-save-interval* interval))
+                 (setf *heartbeat-save-counter* 0)
+                 (save-memory-to-disk))
+               (inject-stimulus
+                 (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
+           :name "passepartout-heartbeat"))))
+
+(defvar *shutdown-save-enabled* t)
+
+(defvar *system-health* :unknown
+  "Current system health status: :healthy, :degraded, :unhealthy, or :unknown.")
+
+(defvar *health-check-ran* nil
+  "Flag indicating if initial health check has completed.")
+
+(defun diagnostics-startup-run ()
+  "Runs the doctor diagnostics on startup. Returns health status."
+  (format t "~%")
+  (format t "==================================================~%")
+  (format t " DOCTOR: Running Startup Health Check~%")
+  (format t "==================================================~%")
+  (handler-case
+      (progn
+        (when (fboundp 'doctor-run-all)
+          (let ((result (doctor-run-all :auto-install nil)))
+            (setf *health-check-ran* t)
+            (if result
+                (progn
+                  (setf *system-health* :healthy)
+                  (format t "DAEMON: Health check passed. Starting services.~%"))
+                (progn
+                  (setf *system-health* :degraded)
+                  (format t "DAEMON: Health check found issues.~%")
+                  (format t "         Run 'passepartout doctor --fix' to repair.~%")))))
+        (setf *health-check-ran* t))
+    (error (c)
+      (format t "DOCTOR ERROR: ~a~%" c)
+      (setf *system-health* :unhealthy)
+      (setf *health-check-ran* t)))
+  (format t "==================================================~%~%"))
+
+(defun main ()
+  "Entry point for Passepartout. Initializes the system and enters idle loop."
+  (let* ((home (uiop:getenv "HOME"))
+         (env-file (uiop:merge-pathnames* ".config/passepartout/.env" (uiop:ensure-directory-pathname home))))
+    (when (uiop:file-exists-p env-file)
+      (cl-dotenv:load-env env-file)))
+
+  (load-memory-from-disk)
+  (initialize-actuators)
+  (initialize-all-skills)
+  
+  ;; Run proactive doctor before starting services
+  (diagnostics-startup-run)
+  
+  (heartbeat-start)
+  (start-daemon)
+
+  #+sbcl
+  (sb-sys:enable-interrupt sb-unix:sigint
+                            (lambda (sig code scp)
+                              (declare (ignore sig code scp))
+                              (harness-log "SHUTDOWN: SIGINT received. Saving memory...")
+                              (when *shutdown-save-enabled* (save-memory-to-disk))
+                              (uiop:quit 0)))
+
+  (let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
+    (loop
+      (when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
+        (harness-log "SHUTDOWN: Interrupt flag set. Saving memory...")
+        (when *shutdown-save-enabled* (save-memory-to-disk))
+        (return))
+      (sleep sleep-interval))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-immune-system-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:immune-suite))
+
+(in-package :passepartout-immune-system-tests)
+
+(def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)")
+(in-suite immune-suite)
+
+(test loop-error-injection
+  "Verify that a crash in think/decide triggers a :loop-error stimulus."
+  (clrhash passepartout::*skills-registry*)
+  (passepartout:defskill :evil-skill
+    :priority 100
+    :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input))
+    :probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE"))
+    :deterministic nil)
+  (passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
+  (let ((logs (passepartout:context-get-system-logs 20)))
+    (is (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs))))))

lisp/core-memory.lisp

@@ -0,0 +1,164 @@
+(in-package :passepartout)
+
+(defvar *memory-store* (make-hash-table :test 'equal))
+(defvar *memory-history* (make-hash-table :test 'equal)
+  "Immutable Merkle-Tree versioning store mapping hashes to objects.")
+
+(defun memory-object-get (id)
+  "Retrieves an memory-object by ID from *memory-store*."
+  (gethash id *memory-store*))
+
+(defun memory-objects-by-attribute (attr value)
+  "Returns all memory-objects whose :ATTRIBUTES plist has ATTR = VALUE."
+  (let ((results nil))
+    (maphash (lambda (id obj)
+               (declare (ignore id))
+               (when (equal (getf (memory-object-attributes obj) attr) value)
+                 (push obj results)))
+             *memory-store*)
+    (nreverse results)))
+
+(defun memory-id-generate ()
+  "Generates a timestamp-based unique ID."
+  (format nil "id-~36r" (get-universal-time)))
+
+(defstruct memory-object
+  id type attributes content vector parent-id children version last-sync hash)
+
+(defmethod make-load-form ((obj memory-object) &optional env)
+  (make-load-form-saving-slots obj :environment env))
+
+(defun deep-copy-memory-object (obj)
+  "Creates a full copy of an memory-object, including fresh lists for attributes and children."
+  (make-memory-object :id (memory-object-id obj)
+                  :type (memory-object-type obj)
+                  :attributes (copy-list (memory-object-attributes obj))
+                  :content (memory-object-content obj)
+                  :vector (memory-object-vector obj)
+                  :parent-id (memory-object-parent-id obj)
+                  :children (copy-list (memory-object-children obj))
+                  :version (memory-object-version obj)
+                  :last-sync (memory-object-last-sync obj)
+                  :hash (memory-object-hash obj)))
+
+(defun memory-merkle-hash (id type attributes content child-hashes)
+  (let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
+         (sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
+         (attr-string (format nil "~s" sorted-alist))
+         (children-string (format nil "~{~a~}" child-hashes))
+         (data-string (format nil "ID:~a|TYPE:~s|ATTRS:~a|CONTENT:~a|CHILDREN:~a"
+                               id type attr-string (or content "") children-string))
+         (digester (ironclad:make-digest :sha256)))
+    (ironclad:update-digest digester (ironclad:ascii-string-to-byte-array data-string))
+    (ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))
+
+(defun ingest-ast (ast &optional parent-id)
+  (let* ((type (getf ast :type))
+         (props (getf ast :properties))
+         (id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
+         (contents (getf ast :contents))
+         (raw-content (when (eq type :HEADLINE)
+                        (format nil "~a~%~a" (getf props :TITLE) (or (getf ast :raw-content) ""))))
+         (child-ids nil) (child-hashes nil))
+    (dolist (child contents)
+      (when (listp child)
+        (let ((child-id (ingest-ast child id)))
+          (push child-id child-ids)
+          (let ((child-obj (gethash child-id *memory-store*)))
+            (when child-obj (push (memory-object-hash child-obj) child-hashes))))))
+    (setf child-ids (nreverse child-ids))
+    (setf child-hashes (nreverse child-hashes))
+    (let* ((hash (memory-merkle-hash id type props raw-content child-hashes))
+           (existing-obj (gethash hash *memory-history*))
+           (obj (or existing-obj
+                    (make-memory-object 
+                     :id id :type type :attributes props :content raw-content
+                     :parent-id parent-id :children child-ids
+                     :version (get-universal-time) :last-sync (get-universal-time)
+                     :hash hash))))
+      (unless existing-obj (setf (gethash hash *memory-history*) obj))
+      (setf (gethash id *memory-store*) obj)
+      id)))
+
+(defvar *memory-snapshots* nil)
+
+(defun memory-hash-table-copy (hash-table)
+  "Creates an independent copy of a hash table."
+  (let ((new-table (make-hash-table :test (hash-table-test hash-table) 
+                                     :size (hash-table-size hash-table))))
+    (maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table)
+    new-table))
+
+(defun snapshot-memory ()
+  "Creates a CoW snapshot of *memory-store* for rollback recovery."
+  (let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory-store*))))
+    (maphash (lambda (k v) (setf (gethash k snapshot) (deep-copy-memory-object v))) *memory-store*)
+    (push (list :timestamp (get-universal-time) :data snapshot) *memory-snapshots*)
+    (when (> (length *memory-snapshots*) 20)
+      (setf *memory-snapshots* (subseq *memory-snapshots* 0 20)))
+    (harness-log "MEMORY - CoW Memory snapshot created.")))
+
+(defun rollback-memory (&optional (index 0))
+  "Restores *memory-store* from a snapshot. INDEX 0 = most recent."
+  (let ((snapshot (nth index *memory-snapshots*)))
+    (if snapshot
+        (progn (setf *memory-store* (memory-hash-table-copy (getf snapshot :data)))
+               (harness-log "MEMORY - Memory rolled back to snapshot ~a" index))
+        (harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
+
+(defvar *memory-snapshot-path* nil)
+
+(defun memory-snapshot-path-ensure ()
+  "Returns the path to the memory snapshot file, resolving env or default."
+  (or *memory-snapshot-path*
+      (let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH")))
+        (setf *memory-snapshot-path*
+              (or env-path (namestring (uiop:merge-pathnames* "memory.snap" (user-homedir-pathname))))))))
+
+(defun save-memory-to-disk ()
+  "Writes the entire memory and history store to disk as a plist."
+  (let ((path (memory-snapshot-path-ensure)))
+    (with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create)
+      (let ((memory-alist nil) (history-alist nil))
+        (maphash (lambda (k v) (push (cons k v) memory-alist)) *memory-store*)
+        (maphash (lambda (k v) (push (cons k v) history-alist)) *memory-history*)
+        (prin1 (list :memory memory-alist :history-store history-alist) stream)))
+    (harness-log "MEMORY - Saved to ~a" path)))
+
+(defun load-memory-from-disk ()
+  "Reads memory state from disk and restores *memory-store* and *memory-history*."
+  (let ((path (memory-snapshot-path-ensure)))
+    (when (uiop:file-exists-p path)
+      (handler-case
+          (with-open-file (stream path :direction :input)
+            (let ((data (read stream nil)))
+              (when data
+                (let ((memory-alist (getf data :memory)) (history-alist (getf data :history-store)))
+                  (setf *memory-store* (make-hash-table :test 'equal :size (length memory-alist)))
+                  (dolist (kv memory-alist) (setf (gethash (car kv) *memory-store*) (cdr kv)))
+                  (setf *memory-history* (make-hash-table :test 'equal :size (length history-alist)))
+                  (dolist (kv history-alist) (setf (gethash (car kv) *memory-history*) (cdr kv)))
+                  (harness-log "MEMORY - Loaded from ~a (~a objects)" path (hash-table-size *memory-store*))))))
+          (error (c) (harness-log "MEMORY WARNING - Failed to load snapshot: ~a" c)))))
+  t)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-memory-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:memory-suite))
+
+(in-package :passepartout-memory-tests)
+
+(def-suite memory-suite :description "Tests for the Merkle-Tree Memory")
+(in-suite memory-suite)
+
+(test merkle-hash-consistency
+  (let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
+    (clrhash passepartout::*memory-store*)
+    (let ((id1 (ingest-ast ast1)))
+      (let ((hash1 (memory-object-hash (memory-object-get id1))))
+        (clrhash passepartout::*memory-store*)
+        (let ((id2 (ingest-ast ast1)))
+          (is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))

lisp/core-skills.lisp

@@ -0,0 +1,284 @@
+(in-package :passepartout)
+
+(defun vector-cosine-similarity (v1 v2)
+  "Computes cosine similarity between two vectors."
+  (let* ((len1 (length v1)) (len2 (length v2)))
+    (if (or (zerop len1) (zerop len2))
+        0.0
+        (let* ((dot 0.0d0) (n1 0.0d0) (n2 0.0d0))
+          (dotimes (i (min len1 len2))
+            (let* ((x (coerce (elt v1 i) 'double-float)) (y (coerce (elt v2 i) 'double-float)))
+              (incf dot (* x y)) (incf n1 (* x x)) (incf n2 (* y y))))
+          (if (or (zerop n1) (zerop n2)) 0.0 (/ dot (sqrt (* n1 n2))))))))
+
+(defun VAULT-MASK-STRING (s) (declare (ignore s)) "[MASKED]")
+(defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
+
+(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn system-prompt-augment)
+
+(defvar *skill-registry* (make-hash-table :test 'equal))
+
+(defvar *skill-catalog* (make-hash-table :test 'equal)
+  "Tracks all discovered skill files and their loading state.")
+
+(defstruct skill-entry filename (status :discovered) error-log (load-time 0))
+
+(defun skill-triggered-find (context)
+  "Returns the highest priority skill whose trigger matches context."
+  (let ((triggered nil))
+    (maphash (lambda (name skill) 
+               (declare (ignore name)) 
+               (when (and (skill-probabilistic-prompt skill)
+                          (ignore-errors (funcall (skill-trigger-fn skill) context)))
+                 (push skill triggered))) 
+              *skill-registry*)
+    (first (sort triggered #'> :key #'skill-priority))))
+
+(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic system-prompt-augment)
+  "Registers a new skill. NAME is a keyword. TRIGGER is a function (context) → bool."
+  `(setf (gethash (string-downcase (string ,name)) *skill-registry*)
+         (make-skill :name (string-downcase (string ,name)) 
+                    :priority (or ,priority 10) 
+                    :dependencies ',dependencies
+                    :trigger-fn ,trigger 
+                    :probabilistic-prompt ,probabilistic 
+                    :deterministic-fn ,deterministic
+                    :system-prompt-augment ,system-prompt-augment)))
+
+(defun skill-dependencies-resolve (skill-name)
+  "Resolves transitive dependencies. Returns list of skill names in dependency order."
+  (let ((resolved nil) (seen nil))
+    (labels ((visit (name) 
+               (unless (member name seen :test #'equal) 
+                 (push name seen)
+                 (let ((skill (gethash (string-downcase (string name)) *skill-registry*)))
+                   (when skill 
+                     (dolist (dep (skill-dependencies skill)) (visit dep))))
+                 (push name resolved))))
+      (visit skill-name) 
+      (nreverse resolved))))
+
+(defun skill-metadata-parse (filepath)
+  "Extracts ID and DEPENDS_ON tags from org file."
+  (let ((dependencies nil) (id nil) (content (uiop:read-file-string filepath)))
+    (let ((id-start (search ":ID:" content)))
+      (when id-start
+        (let ((id-end (position #\Newline content :start id-start)))
+          (when id-end (setf id (string-trim " " (subseq content (+ id-start 4) id-end)))))))
+    (let ((pos 0))
+      (loop while (setf pos (search "#+DEPENDS_ON:" content :start2 pos))
+            do (let ((end (position #\Newline content :start pos)))
+              (when end
+                (let ((line (string-trim " " (subseq content (+ pos 13) end))))
+                  (dolist (d (uiop:split-string line :separator '(#\Space #\Tab)))
+                    (unless (string= d "") (push d dependencies))))
+                (setf pos end)))))
+    (values id (reverse dependencies))))
+
+(defun skill-topological-sort (skills-dir)
+  "Returns a list of skill filepaths sorted by dependency."
+  (let* ((org-files (uiop:directory-files skills-dir "*.org"))
+         (lisp-files (uiop:directory-files skills-dir "*.lisp"))
+         (all-files (append org-files lisp-files))
+         (files (remove-if (lambda (f)
+                             (let ((n (pathname-name f)))
+                               (or (string= n "core-defpackage")
+                                   (string= n "core-skills")
+                                   (string= n "core-communication")
+                                   (string= n "core-memory")
+                                   (string= n "core-context")
+                                   (string= n "core-loop-perceive")
+                                   (string= n "core-loop-reason")
+                                   (string= n "core-loop-act")
+                                   (string= n "core-loop")
+                                   (string= n "core-manifest"))))
+                           all-files))
+        (adj (make-hash-table :test 'equal))
+        (name-to-file (make-hash-table :test 'equal))
+        (id-to-file (make-hash-table :test 'equal))
+        (result nil)
+        (visited (make-hash-table :test 'equal))
+        (stack (make-hash-table :test 'equal)))
+    (dolist (file files)
+      (let ((filename (pathname-name file)))
+        (if (uiop:string-suffix-p (namestring file) ".lisp")
+            (progn
+              (setf (gethash (string-downcase filename) name-to-file) file)
+              (unless (gethash (string-downcase filename) adj)
+                (setf (gethash (string-downcase filename) adj) nil)))
+            (multiple-value-bind (id deps) (skill-metadata-parse file)
+              (setf (gethash (string-downcase filename) name-to-file) file)
+              (when id (setf (gethash (string-downcase id) id-to-file) file))
+              (setf (gethash (string-downcase filename) adj) deps)))))
+    (labels ((visit (file)
+               (let* ((filename (pathname-name file))
+                      (node-key (string-downcase filename)))
+                 (unless (gethash node-key visited)
+                   (setf (gethash node-key stack) t)
+                   (dolist (dep (gethash node-key adj))
+                     (let* ((is-id-p (uiop:string-prefix-p "id:" (string-downcase dep)))
+                            (dep-key (string-downcase (if is-id-p (subseq dep 3) dep)))
+                            (dep-file (if is-id-p 
+                                          (gethash dep-key id-to-file)
+                                          (or (gethash dep-key id-to-file)
+                                              (gethash dep-key name-to-file)))))
+                       (when dep-file
+                         (let ((dep-filename (pathname-name dep-file)))
+                           (if (gethash (string-downcase dep-filename) stack)
+                               (error "Circular dependency detected")
+                               (visit dep-file))))))
+                   (setf (gethash node-key stack) nil)
+                   (setf (gethash node-key visited) t)
+                   (push file result)))))
+      (let ((filenames (sort (mapcar #'pathname-name files) #'string<)))
+        (dolist (name filenames)
+          (let ((file (gethash (string-downcase name) name-to-file)))
+            (when file (visit file)))))
+      (nreverse result))))
+
+(defun lisp-syntax-validate (code-string)
+  "Checks if a string contains valid Common Lisp forms."
+  (handler-case
+      (let ((*read-eval* nil))
+        (with-input-from-string (s (format nil "(progn ~a)" code-string))
+          (loop for form = (read s nil :eof) until (eq form :eof)))
+        (values t nil))
+    (error (c) (values nil (format nil "~a" c)))))
+
+(defun skill-package-forms-strip (code-string)
+  "Removes in-package forms so symbols get defined in skill package."
+  (let ((lines (uiop:split-string code-string :separator '(#\Newline)))
+        (result ""))
+    (dolist (line lines)
+      (let ((trimmed (string-trim '(#\Space #\Tab) line)))
+        (unless (uiop:string-prefix-p "(in-package" trimmed)
+          (setf result (concatenate 'string result line (string #\Newline))))))
+    result))
+
+(defun tangle-target-extract (line)
+  "Extracts the value of the :tangle header."
+  (let ((pos (search ":tangle" line)))
+    (when pos
+      (let ((rest (string-tirm '(#\Space #\Tab) (subseq line (+ pos 7)))))
+        (let ((end (position #\Space rest)))
+          (if end (subseq rest 0 end) rest))))))
+
+(defun load-skill-from-org (filepath)
+  "Parses and evaluates Lisp blocks from an Org file."
+  (let* ((skill-base-name (pathname-name filepath))
+         (entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
+    (setf (skill-entry-status entry) :loading)
+    (handler-case
+        (let* ((content (uiop:read-file-string filepath))
+               (lines (uiop:split-string content :separator '(#\Newline)))
+               (in-lisp-block nil) (collect-this-block nil) (lisp-code "")
+               (pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
+          (dolist (line lines)
+            (let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
+              (cond
+                ((uiop:string-prefix-p "#+begin_src lisp" clean-line)
+                 (setf in-lisp-block t)
+                 (let ((target (tangle-target-extract clean-line)))
+                   (setf collect-this-block (or (null target)
+                                                (and (not (search "no" target))
+                                                     (not (search "/tests" target)))))))
+                ((uiop:string-prefix-p "#+end_src" clean-line)
+                 (setf in-lisp-block nil) (setf collect-this-block nil))
+                ((and in-lisp-block collect-this-block)
+                 (unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
+                              (uiop:string-prefix-p ":END:" (string-upcase clean-line))
+                              (uiop:string-prefix-p ":ID:" (string-upcase clean-line)))
+                   (setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
+          (if (= (length lisp-code) 0)
+              (setf (skill-entry-status entry) :ready)
+              (progn
+                (multiple-value-bind (valid-p err) (lisp-syntax-validate lisp-code)
+                  (unless valid-p (error err)))
+                (unless (find-package pkg-name)
+                  (let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
+                (let ((*read-eval* nil) (*package* (find-package pkg-name)))
+                  (log-message "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*))
+                  (eval (read-from-string (format nil "(progn ~a)" lisp-code))))
+
+                (let* ((target-pkg (find-package :passepartout))
+                       (raw-name (string-upcase skill-base-name))
+                       (short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
+                                       (subseq raw-name 10)
+                                       raw-name)))
+                  (log-message "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
+                  (do-symbols (sym (find-package pkg-name))
+                    (when (eq (symbol-package sym) (find-package pkg-name))
+                      (let ((sn (symbol-name sym)))
+                        (when (or (uiop:string-prefix-p raw-name sn)
+                                  (uiop:string-prefix-p short-name sn)
+                                  (string-equal sn "DIAGNOSTICS-MAIN")
+                                  (string-equal sn "DIAGNOSTICS-RUN-ALL")
+                                  (string-equal sn "SETUP-WIZARD-RUN"))
+                          (log-message "LOADER: Exporting ~a to :PASSEPARTOUT" sn)
+                          (let ((existing (find-symbol sn target-pkg)))
+                            (when (and existing (not (eq existing sym)))
+                              (unintern existing target-pkg)))
+                          (import sym target-pkg)
+                          (export sym target-pkg))))))
+
+                (setf (skill-entry-status entry) :ready)))
+          t)
+      (error (c)
+        (log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
+        (setf (skill-entry-status entry) :failed) nil))))
+
+(defun load-skill-from-lisp (filepath)
+  "Loads a .lisp skill file directly, filtering out in-package forms."
+  (let* ((skill-base-name (pathname-name filepath))
+         (entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
+    (setf (skill-entry-status entry) :loading)
+    (handler-case
+        (let* ((content (skill-package-forms-strip (uiop:read-file-string filepath)))
+               (pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
+          (multiple-value-bind (valid-p err) (lisp-syntax-validate content)
+            (unless valid-p (error err)))
+          (unless (find-package pkg-name)
+            (let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
+          (let ((*read-eval* nil) (*package* (find-package pkg-name)))
+            (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))
+                 (raw-name (string-upcase skill-base-name))
+                 (short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
+                                 (subseq raw-name 10)
+                                 raw-name)))
+            (log-message "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
+            (do-symbols (sym (find-package pkg-name))
+              (when (eq (symbol-package sym) (find-package pkg-name))
+                (let ((sn (symbol-name sym)))
+                  (when (or (uiop:string-prefix-p raw-name sn)
+                            (uiop:string-prefix-p short-name sn)
+                            (string-equal sn "DIAGNOSTICS-MAIN")
+                                  (string-equal sn "DIAGNOSTICS-RUN-ALL")
+                            (string-equal sn "SETUP-WIZARD-RUN"))
+                    (log-message "LOADER: Exporting ~a to :PASSEPARTOUT" sn)
+                    (let ((existing (find-symbol sn target-pkg)))
+                      (when (and existing (not (eq existing sym)))
+                        (unintern existing target-pkg)))
+                    (import sym target-pkg)
+                    (export sym target-pkg))))))
+          (setf (skill-entry-status entry) :ready))
+      (error (c)
+        (log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
+        (setf (skill-entry-status entry) :failed) nil))))
+
+(defun skill-initialize-all ()
+  "Initializes all skills from the XDG skills directory."
+  (let* ((data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
+         (skills-dir (merge-pathnames "skills/" (uiop:ensure-directory-pathname data-dir))))
+    (unless (uiop:directory-exists-p skills-dir) (return-from skill-initialize-all nil))
+    (let ((sorted-files (skill-topological-sort skills-dir)))
+      (log-message "LOADER: Initializing ~a skills..." (length sorted-files))
+      (dolist (file sorted-files)
+        (if (uiop:string-suffix-p (namestring file) ".lisp")
+            (load-skill-from-lisp file)
+            (load-skill-from-org file)))
+      (log-message "LOADER: Boot Complete."))))

lisp/gateway-cli.lisp

@@ -0,0 +1,10 @@
+(defun gateway-cli-input (text)
+  "Processes raw text from the command line."
+  (inject-stimulus (list :type :EVENT 
+                         :payload (list :sensor :user-input :text text) 
+                         :meta (list :source :CLI))))
+
+(defskill :passepartout-gateway-cli
+  :priority 100
+  :trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
+  :deterministic (lambda (action ctx) (declare (ignore ctx)) action))

lisp/gateway-llm.lisp

@@ -0,0 +1,43 @@
+(defun gateway-llm-request (&key prompt system-prompt (provider :ollama) model)
+  "Central dispatcher for LLM requests."
+  (let ((backend (gethash provider *probabilistic-backends*)))
+    (if backend
+        (handler-case
+            (funcall backend prompt system-prompt :model model)
+          (error (c)
+            (list :status :error :message (format nil "~a Failure: ~a" provider c))))
+        (list :status :error :message (format nil "Provider ~a not registered" provider)))))
+
+(defskill :passepartout-gateway-llm
+  :priority 100
+  :trigger (lambda (ctx) (getf ctx :user-input))
+  :deterministic (lambda (action ctx) (declare (ignore ctx)) action))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-llm-gateway-tests
+  (:use :cl :passepartout)
+  (:export #:llm-gateway-suite))
+
+(in-package :passepartout-llm-gateway-tests)
+
+(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM Gateway skill")
+(fiveam:in-suite llm-gateway-suite)
+
+(fiveam:test test-llm-gateway-timeout
+  "Tier 2 Chaos: Verify that LLM Gateway handles connection failures gracefully."
+  (let ((old-host (uiop:getenv "OLLAMA_HOST")))
+    (unwind-protect
+         (progn
+           (setf (uiop:getenv "OLLAMA_HOST") "localhost:1")
+           (let ((fn (or (find-symbol "EXECUTE-LLM-REQUEST" :passepartout.gateway-llm)
+                         (find-symbol "EXECUTE-LLM-REQUEST" :passepartout))))
+             (if fn
+                 (let ((result (funcall fn :prompt "hello" :provider :ollama)))
+                   (fiveam:is (eq (getf result :status) :error))
+                   (fiveam:is (uiop:string-prefix-p "Ollama Failure" (getf result :message))))
+                 (fiveam:fail "Could not find EXECUTE-LLM-REQUEST symbol"))))
+      (if old-host
+          (setf (uiop:getenv "OLLAMA_HOST") old-host)
+          (sb-posix:unsetenv "OLLAMA_HOST")))))

lisp/gateway-manager.lisp

@@ -0,0 +1,214 @@
+(defvar *gateway-configs* (make-hash-table :test 'equal)
+  "Maps platform name → plist (:token :thread :interval :enabled)")
+
+(defvar *gateway-registry* (make-hash-table :test 'equal)
+  "Maps platform name → plist (:poll-fn :send-fn :default-interval)")
+
+(defun telegram-get-token ()
+  (vault-get-secret :telegram))
+
+(defun telegram-poll ()
+  "Polls Telegram for new messages and injects them into the harness."
+  (let* ((token (telegram-get-token)))
+    (when token
+      (let* ((last-id (getf (gethash "telegram" *gateway-configs*) :last-update-id 0))
+             (url (format nil "https://api.telegram.org/bot~a/getUpdates?offset=~a"
+                          token (1+ last-id))))
+        (handler-case
+            (let* ((response (dex:get url))
+                   (json (cl-json:decode-json-from-string response))
+                   (updates (cdr (assoc :result json))))
+              (dolist (update updates)
+                (let* ((update-id (cdr (assoc :update--id update)))
+                       (message (cdr (assoc :message update)))
+                       (chat (cdr (assoc :chat message)))
+                       (chat-id (cdr (assoc :id chat)))
+                       (text (cdr (assoc :text message))))
+                  (setf (getf (gethash "telegram" *gateway-configs*) :last-update-id) update-id)
+                  (when (and text chat-id)
+                    (harness-log "TELEGRAM: Received message from ~a" chat-id)
+                    (inject-stimulus
+                     (list :type :EVENT
+                           :meta (list :source :telegram :chat-id (format nil "~a" chat-id))
+                           :payload (list :sensor :user-input :text text)))))))
+          (error (c) (harness-log "TELEGRAM POLL ERROR: ~a" c))))))
+
+(defun telegram-send (action context)
+  "Sends a message via Telegram."
+  (declare (ignore context))
+  (let* ((payload (getf action :payload))
+         (meta (getf action :meta))
+         (chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
+         (text (or (getf payload :text) (getf action :text)))
+         (token (telegram-get-token)))
+    (when (and token chat-id text)
+      (harness-log "TELEGRAM: Sending message to ~a..." chat-id)
+      (handler-case
+          (let ((url (format nil "https://api.telegram.org/bot~a/sendMessage" token)))
+            (dex:post url
+                      :headers '(("Content-Type" . "application/json"))
+                      :content (cl-json:encode-json-to-string
+                                `((chat_id . ,chat-id) (text . ,text)))))
+        (error (c) (harness-log "TELEGRAM ERROR: ~a" c))))))
+
+(defun signal-get-account ()
+  (vault-get-secret :signal))
+
+(defun signal-poll ()
+  "Polls Signal for new messages and injects them into the harness."
+  (let ((account (signal-get-account)))
+    (when account
+      (handler-case
+          (let* ((output (uiop:run-program (list "signal-cli" "-u" account "receive" "--json")
+                                            :output :string :error-output :string :ignore-error-status t))
+                 (lines (cl-ppcre:split "\\n" output)))
+            (dolist (line lines)
+              (when (and line (> (length line) 0))
+                (let* ((json (ignore-errors (cl-json:decode-json-from-string line)))
+                       (envelope (cdr (assoc :envelope json)))
+                       (source (cdr (assoc :source envelope)))
+                       (data-message (cdr (assoc :data-message envelope)))
+                       (text (cdr (assoc :message data-message))))
+                  (when (and source text)
+                    (harness-log "SIGNAL: Received message from ~a" source)
+                    (inject-stimulus
+                     (list :type :EVENT
+                           :meta (list :source :signal :chat-id source)
+                           :payload (list :sensor :user-input :text text))))))))
+        (error (c) (harness-log "SIGNAL POLL ERROR: ~a" c))))))
+
+(defun signal-send (action context)
+  "Sends a message via Signal."
+  (declare (ignore context))
+  (let* ((payload (getf action :payload))
+         (meta (getf action :meta))
+         (chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
+         (text (or (getf payload :text) (getf action :text)))
+         (account (signal-get-account)))
+    (when (and account chat-id text)
+      (harness-log "SIGNAL: Sending message to ~a..." chat-id)
+      (handler-case
+          (uiop:run-program (list "signal-cli" "-u" account "send" "-m" text chat-id)
+                            :output :string :error-output :string)
+        (error (c) (harness-log "SIGNAL ERROR: ~a" c))))))
+
+(defun gateway-registry-initialize ()
+  "Registers all built-in gateway handlers."
+  (setf (gethash "telegram" *gateway-registry*)
+        (list :poll-fn #'telegram-poll
+              :send-fn #'telegram-send
+              :default-interval 3))
+  (setf (gethash "signal" *gateway-registry*)
+        (list :poll-fn #'signal-poll
+              :send-fn #'signal-send
+              :default-interval 5)))
+
+(defun gateway-configured-p (platform)
+  "Returns T if a platform has a stored token."
+  (let ((config (gethash platform *gateway-configs*)))
+    (and config (getf config :token))))
+
+(defun gateway-active-p (platform)
+  "Returns T if a platform's polling thread is alive."
+  (let ((config (gethash platform *gateway-configs*)))
+    (and config
+         (getf config :thread)
+         (bt:thread-alive-p (getf config :thread)))))
+
+(defun gateway-link (platform token)
+  "Links a platform with a token and starts polling."
+  (let ((platform-lc (string-downcase platform)))
+    (unless (gethash platform-lc *gateway-registry*)
+      (error "Unknown platform: ~a. Available: ~{~a~^, ~}"
+             platform (loop for k being the hash-keys of *gateway-registry* collect k)))
+    (when (or (null token) (zerop (length token)))
+      (error "Token cannot be empty"))
+    (harness-log "GATEWAY: Linking to ~a..." platform-lc)
+    (gateway-unlink platform-lc)
+    (let* ((registry-entry (gethash platform-lc *gateway-registry*))
+           (interval (or (getf registry-entry :default-interval) 5)))
+      (setf (gethash platform-lc *gateway-configs*)
+            (list :token token :interval interval :enabled t))
+      (vault-set-secret (intern (string-upcase platform-lc) :keyword) token)
+      (gateway-start platform-lc)
+      (harness-log "GATEWAY: Successfully linked ~a" platform-lc)
+      (format t "Successfully linked ~a gateway. Token stored securely.~%" platform-lc)
+      t)))
+
+(defun gateway-unlink (platform)
+  "Unlinks a platform and stops its polling thread."
+  (let ((platform-lc (string-downcase platform)))
+    (gateway-stop platform-lc)
+    (remhash platform-lc *gateway-configs*)
+    (harness-log "GATEWAY: Unlinked ~a" platform-lc)
+    (format t "Successfully unlinked ~a gateway.~%" platform-lc)
+    t))
+
+(defun gateway-start (platform)
+  "Starts the polling thread for a linked gateway."
+  (let ((platform-lc (string-downcase platform)))
+    (let ((config (gethash platform-lc *gateway-configs*)))
+      (when (and config (getf config :enabled) (not (gateway-active-p platform-lc)))
+        (let ((poll-fn (getf (gethash platform-lc *gateway-registry*) :poll-fn)))
+          (when poll-fn
+            (let ((interval (getf config :interval)))
+              (setf (getf config :thread)
+                    (bt:make-thread
+                     (lambda ()
+                       (loop
+                         (when (getf (gethash platform-lc *gateway-configs*) :enabled)
+                           (funcall poll-fn))
+                         (sleep interval)))
+                     :name (format nil "passepartout-~a-gateway" platform-lc)))
+              (harness-log "GATEWAY: Started ~a polling (interval: ~as)" platform-lc interval)))))))))
+
+(defun gateway-stop (platform)
+  "Stops the polling thread for a gateway."
+  (let ((platform-lc (string-downcase platform)))
+    (let ((config (gethash platform-lc *gateway-configs*)))
+      (when (and config (getf config :thread))
+        (when (bt:thread-alive-p (getf config :thread))
+          (harness-log "GATEWAY: Stopping ~a polling thread" platform-lc)
+          (bt:destroy-thread (getf config :thread))))
+      (setf (getf config :thread) nil))))
+
+(defun gateway-list ()
+  "Returns a list of all gateways with their status."
+  (loop for platform being the hash-keys of *gateway-registry*
+        collect (let ((configured (gateway-configured-p platform))
+                      (active (gateway-active-p platform)))
+                  (list :platform platform
+                        :configured configured
+                        :active active))))
+
+(defun gateway-list-print ()
+  "Prints a formatted table of gateways."
+  (format t "~%")
+  (format t "  ~20@A ~12@A ~10@A~%" "PLATFORM" "CONFIGURED" "STATUS")
+  (dolist (gw (gateway-list))
+    (format t "  ~20@A ~12@A ~10@A~%"
+            (getf gw :platform)
+            (if (getf gw :configured) "yes" "no")
+            (cond
+              ((getf gw :active) "ACTIVE")
+              ((getf gw :configured) "stopped")
+              (t "not linked"))))
+  (format t "~%"))
+
+(defun gateway-start-all ()
+  "Called at boot to start all configured gateways."
+  (dolist (config (loop for platform being the hash-keys of *gateway-configs*
+                       collect (list platform (gethash platform *gateway-configs*))))
+    (destructuring-bind (platform config) config
+      (when (and (getf config :enabled) (not (gateway-active-p platform)))
+        (gateway-start platform)))))
+
+(register-actuator :telegram #'telegram-send)
+(register-actuator :signal #'signal-send)
+
+(defskill :passepartout-gateway-manager
+  :priority 150
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
+
+(gateway-registry-initialize)
+(gateway-start-all)

lisp/gateway-provider.lisp

@@ -0,0 +1,81 @@
+(defparameter *provider-configs*
+  '((:ollama     . (:base-url nil          :key-env nil           :default-model "llama3"))
+    (:openrouter . (:base-url "https://openrouter.ai/api/v1" :key-env "OPENROUTER_API_KEY" :default-model "openrouter/auto"))
+    (:openai     . (:base-url "https://api.openai.com/v1"    :key-env "OPENAI_API_KEY"     :default-model "gpt-4o-mini"))
+    (:anthropic  . (:base-url "https://api.anthropic.com/v1" :key-env "ANTHROPIC_API_KEY"  :default-model "claude-3-5-sonnet-20241022"))
+    (:groq       . (:base-url "https://api.groq.com/openai/v1" :key-env "GROQ_API_KEY"     :default-model "llama-3.1-70b-versatile"))
+    (:gemini     . (:base-url "https://generativelanguage.googleapis.com/v1beta/openai" :key-env "GEMINI_API_KEY" :default-model "gemini-2.0-flash"))
+    (:deepseek   . (:base-url "https://api.deepseek.com/v1"  :key-env "DEEPSEEK_API_KEY"  :default-model "deepseek-chat"))
+    (:nvidia     . (:base-url "https://integrate.api.nvidia.com/v1" :key-env "NVIDIA_API_KEY" :default-model "meta/llama-3.1-405b-instruct"))))
+
+(defun provider-config (provider)
+  "Returns the configuration plist for a provider keyword."
+  (cdr (assoc provider *provider-configs*)))
+
+(defun provider-available-p (provider)
+  "Checks if a provider is configured. Ollama is always considered available."
+  (let* ((config (provider-config provider))
+         (key-env (getf config :key-env))
+         (base-url (getf config :base-url)))
+    (cond ((eq provider :ollama) t)
+          (key-env (let ((key (uiop:getenv key-env))) (and key (> (length key) 0))))
+          (base-url t))))
+
+(defun provider-openai-request (prompt system-prompt &key model (provider :ollama))
+  "Executes a request against any OpenAI-compatible API endpoint."
+  (let* ((config (provider-config provider))
+         (base-url (getf config :base-url))
+         (key-env (getf config :key-env))
+         (default-model (getf config :default-model))
+         (api-key (when key-env (uiop:getenv key-env)))
+         (model-id (or model default-model))
+         (url (if (eq provider :ollama)
+                  (format nil "http://~a/v1/chat/completions" (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
+                  (format nil "~a/chat/completions" base-url)))
+         (headers `(("Content-Type" . "application/json")
+                    ,@(when api-key `(("Authorization" . ,(format nil "Bearer ~a" api-key))))
+                    ,@(when (eq provider :openrouter)
+                        `(("HTTP-Referer" . "https://github.com/amrgharbeia/passepartout")
+                          ("X-Title" . "Passepartout")))))
+         (body (cl-json:encode-json-to-string
+                `((model . ,model-id)
+                  (messages . (( (role . "system") (content . ,system-prompt) )
+                               ( (role . "user") (content . ,prompt) )))))))
+    (handler-case
+        (let* ((response (dex:post url :headers headers :content body :connect-timeout 10 :read-timeout 60))
+               (json (cl-json:decode-json-from-string response))
+               (choices (cdr (assoc :choices json)))
+               (first-choice (car choices))
+               (message (cdr (assoc :message first-choice)))
+               (content (cdr (assoc :content message))))
+          (if content
+              (list :status :success :content content)
+              (list :status :error :message (format nil "~a: No content in response (~s)" provider json))))
+      (error (c)
+        (list :status :error :message (format nil "~a Failure: ~a" provider c))))))
+
+(defun provider-register-all ()
+  "Scans environment variables and registers all available LLM backends."
+  (dolist (entry *provider-configs*)
+    (let ((provider (car entry)))
+      (when (provider-available-p provider)
+        (log-message "LLM BACKEND: Registering provider ~a" provider)
+        (register-probabilistic-backend provider
+          (lambda (prompt system-prompt &key model)
+            (provider-openai-request prompt system-prompt :model model :provider provider)))))))
+
+(defun provider-cascade-initialize ()
+  "Reads PROVIDER_CASCADE from env and sets *provider-cascade*."
+  (let ((cascade-str (uiop:getenv "PROVIDER_CASCADE")))
+    (if cascade-str
+        (setf *provider-cascade*
+              (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
+                      (uiop:split-string cascade-str :separator '(#\,))))
+        (setf *provider-cascade* (mapcar #'car *provider-configs*)))))
+
+(provider-register-all)
+(provider-cascade-initialize)
+
+(defskill :passepartout-gateway-provider
+  :priority 50
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

lisp/gateway-tui.lisp

@@ -0,0 +1,155 @@
+(in-package :cl-user)
+(defpackage :passepartout.gateway-tui
+  (:use :cl :croatoan :usocket :bordeaux-threads)
+  (:export :main))
+(in-package :passepartout.gateway-tui)
+
+(defvar *daemon-host* "localhost")
+
+(defvar *daemon-port* 9105)
+
+(defvar *socket* nil)
+
+(defvar *stream* nil)
+
+(defvar *chat-history* nil)
+
+(defvar *input-buffer* nil)
+
+(defvar *is-running* t)
+
+(defvar *queue-lock* (bt:make-lock "incoming-queue-lock"))
+
+(defvar *incoming* nil)
+
+(defun log-debug (msg &rest args)
+  (ignore-errors
+    (with-open-file (s "/tmp/passepartout-tui-debug.log" :direction :output :if-exists :append :if-does-not-exist :create)
+      (format s "[~a] " (get-universal-time))
+      (apply #'format s msg args)
+      (terpri s)
+      (finish-output s))))
+
+(defun message-queue-push (msg)
+  (bt:with-lock-held (*queue-lock*)
+    (setf *incoming* (append *incoming* (list msg)))))
+
+(defun message-queue-drain ()
+  (bt:with-lock-held (*queue-lock*)
+    (let ((msgs *incoming*))
+      (setf *incoming* nil)
+      msgs)))
+
+(defun chat-render (win h)
+  (when (and win (integerp h))
+    (clear win)
+    (box win 0 0)
+    (let* ((view-height (- h 2))
+           (history (copy-list *chat-history*))
+           (len (length history))
+           (num-to-draw (min len view-height))
+           (slice (subseq history 0 num-to-draw)))
+      (loop for i from 0 below num-to-draw
+            for msg in (reverse slice)
+            do (when msg
+                 (add-string win (format nil "│ ~a" msg) :y (1+ i) :x 2))))
+    (refresh win)))
+
+(defun input-backspace ()
+  (pop *input-buffer*))
+
+(defun input-submit (stream)
+  (let ((cmd (coerce (reverse *input-buffer*) 'string)))
+    (setf *input-buffer* nil)
+    (log-debug "SUBMITTING: '~a'" cmd)
+    (when (> (length cmd) 0)
+      (push (format nil "⬆ ~a" cmd) *chat-history*)
+      (handler-case
+          (progn
+            (if (and stream (open-stream-p stream))
+                (let* ((msg (list :TYPE :EVENT 
+                                 :META (list :SOURCE :tui)
+                                 :PAYLOAD (list :SENSOR :user-input :TEXT cmd)))
+                       (payload (format nil "~s" msg))
+                       (len (length payload)))
+                  (format stream "~6,'0x~a" len payload)
+                  (finish-output stream)
+                  (log-debug "SENT WIRE: ~a" payload))
+                (push "ERROR: Not connected." *chat-history*)))
+        (error (c)
+          (log-debug "SEND ERROR: ~a" c)
+          (push (format nil "ERROR: ~a" c) *chat-history*)
+          (setf *is-running* nil))))
+    (when (string= cmd "/exit") (setf *is-running* nil))
+    (when (string= cmd "/clear") (setf *chat-history* nil))))
+
+(defun reader-start (stream)
+  (bt:make-thread
+   (lambda ()
+     (loop while *is-running* do
+       (handler-case
+           (let* ((len-buf (make-string 6))
+                  (count (read-sequence len-buf stream)))
+             (if (= count 6)
+                 (let* ((msg-len (parse-integer len-buf :radix 16))
+                        (msg-buf (make-string msg-len)))
+                   (read-sequence msg-buf stream)
+                   (log-debug "DAEMON MSG: ~a" msg-buf)
+                   (let ((msg (read-from-string msg-buf)))
+                     (let ((payload (getf msg :payload)))
+                       (cond
+                         ((eq (getf payload :action) :handshake)
+                          (message-queue-push "* Connected *"))
+                         (t
+                          (let ((text (or (getf payload :text) (format nil "~a" payload))))
+                            (message-queue-push (format nil "⬇ ~a" text))))))))
+                 (sleep 0.05)))
+         (error (c)
+           (when *is-running*
+             (log-debug "READER ERROR: ~a" c)
+             (message-queue-push "ERROR: Connection lost.")
+             (setf *is-running* nil))))))
+   :name "passepartout-tui-reader"))
+
+(defun main ()
+  (log-debug "=== START ===")
+  (handler-case
+      (setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
+    (error (e) (format t "Offline: ~a~%" e) (return-from main)))
+  (setf *stream* (usocket:socket-stream *socket*))
+  
+  (unwind-protect
+      (with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t)
+        (let* ((h (or (height scr) 24))
+               (w (or (width scr) 80))
+               (chat-h (- h 4))
+               (chat-win (make-instance 'window :height chat-h :width (- w 2) :y 1 :x 1))
+               (input-win (make-instance 'window :height 1 :width (- w 2) :y (- h 2) :x 1)))
+          (setf (input-blocking input-win) nil)
+          (reader-start *stream*)
+          (loop :while *is-running* :do
+            (let ((msgs (message-queue-drain)))
+              (when msgs 
+                (dolist (m msgs) (push m *chat-history*))
+                (chat-render chat-win chat-h)))
+            (let ((ch (get-char input-win)))
+              (when (and ch (not (equal ch -1)))
+                (log-debug "KEY: ~s" ch)
+                (cond
+                  ((or (eql ch 10) (eql ch 13) (eq ch :enter) (eql ch #\Newline) (eql ch #\Return))
+                   (input-submit *stream*)
+                   (chat-render chat-win chat-h))
+                  ((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
+                   (input-backspace))
+                  ((characterp ch)
+                   (push ch *input-buffer*))
+                  ((integerp ch)
+                   (let ((converted (code-char ch)))
+                     (when (graphic-char-p converted)
+                       (push converted *input-buffer*))))))
+              (clear input-win)
+              (add-string input-win (format nil "▶ ~a" (coerce (reverse *input-buffer*) 'string)) :y 0 :x 1)
+              (refresh input-win))
+            (sleep 0.01))))
+    (setf *is-running* nil)
+    (when *socket* (ignore-errors (usocket:socket-close *socket*)))))

lisp/lisp

@@ -0,0 +1 @@
+/home/user/memex/projects/opencortex/lisp

lisp/programming-lisp.lisp

@@ -0,0 +1,223 @@
+(defun lisp-structural-check (code)
+  "Checks if parentheses are balanced and the code is readable."
+  (handler-case
+      (let ((*read-eval* nil))
+        (with-input-from-string (s code)
+          (loop for form = (read s nil :eof) until (eq form :eof)))
+        (values t nil))
+    (error (c)
+      (values nil (format nil "Reader Error: ~a" c)))))
+
+(defun lisp-syntactic-check (code)
+  "Checks for valid Lisp syntax beyond just balanced parentheses."
+  (lisp-structural-check code))
+
+(defun lisp-semantic-check (code)
+  "Checks for potentially unsafe forms."
+  (let ((unsafe-tokens '("eval" "load" "uiop:run-program" "sb-ext:run-program" "cl-user::eval")))
+    (loop for token in unsafe-tokens
+          when (search token (string-downcase code))
+          do (return-from lisp-semantic-check (values nil (format nil "Unsafe form detected: ~a" token))))
+    (values t nil)))
+
+(defun lisp-validate (code &key (strict t))
+  "Unified validation gate for Lisp code."
+  (multiple-value-bind (struct-ok struct-err) (lisp-structural-check code)
+    (unless struct-ok
+      (return-from lisp-validate (list :status :error :reason struct-err)))
+    (when strict
+      (multiple-value-bind (sem-ok sem-err) (lisp-semantic-check code)
+        (unless sem-ok
+          (return-from lisp-validate (list :status :error :reason sem-err)))))
+    (list :status :success)))
+
+(defun lisp-eval (code-string &key (package :passepartout))
+  "Evaluates a Lisp string and captures its output/results."
+  (let ((out (make-string-output-stream))
+        (err (make-string-output-stream)))
+    (handler-case
+        (let* ((*standard-output* out)
+               (*error-output* err)
+               (*package* (or (find-package package) (find-package :passepartout)))
+               (result (with-input-from-string (s code-string)
+                         (let ((last-val nil))
+                           (loop for form = (read s nil :eof) until (eq form :eof)
+                                 do (setf last-val (eval form)))
+                           last-val))))
+          (list :status :success
+                :result (format nil "~a" result)
+                :output (get-output-stream-string out)
+                :error (get-output-stream-string err)))
+      (error (c)
+        (list :status :error
+              :reason (format nil "~a" c)
+              :output (get-output-stream-string out)
+              :error (get-output-stream-string err))))))
+
+(defun lisp-format (code-string)
+  "Attempts to format Lisp code using Emacs batch mode if available."
+  (handler-case
+      (let ((tmp-file "/tmp/oc-format-temp.lisp"))
+        (uiop:with-output-file (s tmp-file :if-exists :supersede)
+          (format s "~a" code-string))
+        (multiple-value-bind (out err code)
+            (uiop:run-program (list "emacs" "--batch" tmp-file 
+                                   "--eval" "(indent-region (point-min) (point-max))"
+                                   "--eval" "(princ (buffer-string))")
+                             :output :string :error-output :string :ignore-error-status t)
+          (if (= code 0)
+              out
+              (progn
+                (harness-log "FORMAT ERROR: ~a" err)
+                code-string))))
+    (error (c)
+      (harness-log "FORMAT EXCEPTION: ~a" c)
+      code-string)))
+
+(defun lisp-extract (code function-name)
+  "Extracts the definition of a specific function from a code string."
+  (let ((*read-eval* nil))
+    (with-input-from-string (s code)
+      (loop for form = (read s nil :eof) until (eq form :eof)
+            when (and (listp form) 
+                      (symbolp (car form))
+                      (member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
+                      (symbolp (second form))
+                      (string-equal (symbol-name (second form)) function-name))
+            do (return-from lisp-extract (format nil "~s" form))))
+    nil))
+
+(defun lisp-wrap (code target-name wrapper-symbol)
+  "Wraps a specific form in a wrapper form (e.g., wrap in a let)."
+  (let ((*read-eval* nil) (results nil))
+    (with-input-from-string (s code)
+      (loop for form = (read s nil :eof) until (eq form :eof)
+            do (if (and (listp form) 
+                        (symbolp (second form))
+                        (string-equal (symbol-name (second form)) target-name))
+                   (push (list wrapper-symbol form) results)
+                   (push form results))))
+    (format nil "~{~s~^~%~%~}" (nreverse results))))
+
+(defun lisp-list-definitions (code)
+  "Returns a list of names for all top-level definitions (defun, defmacro, etc.)."
+  (let ((*read-eval* nil) (names nil))
+    (with-input-from-string (s code)
+      (loop for form = (read s nil :eof) until (eq form :eof)
+            when (and (listp form) 
+                      (symbolp (car form))
+                      (member (symbol-name (car form)) 
+                              '("DEFUN" "DEFMACRO" "DEFMETHOD" "DEFVAR" "DEFPARAMETER")
+                              :test #'string-equal)
+                      (symbolp (second form)))
+            do (push (second form) names)))
+    (nreverse names)))
+
+(defun lisp-inject (code target-name new-form-string)
+  "Injects a new form into the body of a targeted definition."
+  (let ((*read-eval* nil)
+        (new-form (read-from-string new-form-string))
+        (results nil))
+    (with-input-from-string (s code)
+      (loop for form = (read s nil :eof) until (eq form :eof)
+            do (if (and (listp form) 
+                        (symbolp (car form))
+                        (member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
+                        (symbolp (second form))
+                        (string-equal (symbol-name (second form)) target-name))
+                   (push (append form (list new-form)) results)
+                   (push form results))))
+    (format nil "~{~s~^~%~%~}" (nreverse results))))
+
+(defun lisp-slurp (code target-name form-to-slurp-string)
+  "Adds a form to the end of a named list or definition (Paredit slurp)."
+  (let ((*read-eval* nil)
+        (to-slurp (read-from-string form-to-slurp-string))
+        (results nil))
+    (with-input-from-string (s code)
+      (loop for form = (read s nil :eof) until (eq form :eof)
+            do (if (and (listp form) 
+                        (symbolp (second form))
+                        (string-equal (symbol-name (second form)) target-name))
+                   (push (append form (list to-slurp)) results)
+                   (push form results))))
+    (format nil "~{~s~^~%~%~}" (nreverse results))))
+
+(defskill :passepartout-programming-lisp
+  :priority 400
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
+
+(defpackage :passepartout-utils-lisp-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:utils-lisp-suite))
+
+(in-package :passepartout-utils-lisp-tests)
+
+(def-suite utils-lisp-suite
+  :description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
+
+(in-suite utils-lisp-suite)
+
+(test structural-balanced
+  (is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
+
+(test structural-unbalanced-open
+  (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
+    (is (null ok))
+    (is (search "Reader Error" reason))))
+
+(test structural-unbalanced-close
+  (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
+    (is (null ok))
+    (is (search "Reader Error" reason))))
+
+(test syntactic-valid
+  (is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
+
+(test semantic-safe
+  (is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
+
+(test semantic-blocked-eval
+  (multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
+    (is (null ok))
+    (is (search "Unsafe" reason))))
+
+(test unified-success
+  (let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
+    (is (eq (getf result :status) :success))))
+
+(test unified-failure
+  (let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
+    (is (eq (getf result :status) :error))))
+
+(test eval-basic
+  (let ((result (passepartout:lisp-eval "(+ 1 2)")))
+    (is (eq (getf result :status) :success))
+    (is (string= (getf result :result) "3"))))
+
+(test structural-extract
+  (let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
+         (extracted (passepartout:lisp-extract code "hello")))
+    (is (not (null extracted)))
+    (let ((form (read-from-string extracted)))
+      (is (eq (car form) 'DEFUN))
+      (is (eq (second form) 'HELLO)))))
+
+(test list-definitions
+  (let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
+    (let ((names (passepartout:lisp-list-definitions code)))
+      (is (member 'FOO names))
+      (is (member 'BAR names))
+      (is (member '*BAZ* names)))))
+
+(test structural-inject
+  (let* ((code "(defun my-fun (x) (print x))")
+         (injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
+    (let ((form (read-from-string injected)))
+      (is (equal (last form) '((FINISH-OUTPUT)))))))
+
+(test structural-slurp
+  (let* ((code "(defun work () (step-1))")
+         (slurped (passepartout:lisp-slurp code "work" "(step-2)")))
+    (let ((form (read-from-string slurped)))
+      (is (equal (last form) '((STEP-2)))))))

lisp/programming-literate.lisp

@@ -0,0 +1,13 @@
+(defun literate-block-balance-check (org-file)
+  "Verifies that all Lisp source blocks in an Org file are balanced."
+  (harness-log "LITERATE: Checking block balance for ~a" org-file)
+  t)
+
+(defun literate-tangle-sync-check (org-file lisp-file)
+  "Verifies that the Lisp file matches the tangled output of the Org file."
+  (harness-log "LITERATE: Checking tangle sync for ~a <-> ~a" org-file lisp-file)
+  t)
+
+(defskill :passepartout-programming-literate
+  :priority 300
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

lisp/programming-org.lisp

@@ -0,0 +1,193 @@
+(defun org-filetags-extract (content)
+  "Extracts the list of tags from a #+FILETAGS: line."
+  (let ((lines (uiop:split-string content :separator '(#\Newline))))
+    (dolist (line lines)
+      (when (uiop:string-prefix-p "#+FILETAGS:" (string-trim '(#\Space) line))
+        (let ((tag-str (string-trim " :" (subseq (string-trim '(#\Space) line) 10))))
+          (return-from org-filetags-extract
+            (mapcar (lambda (tag) (format nil ":~a" (string-trim '(#\Space) tag)))
+                    (uiop:split-string tag-str :separator '(#\space #\tab))))))))
+  nil)
+
+(defun org-privacy-tag-p (tags-list)
+  "Returns T if any tag in TAGS-LIST matches bouncer-privacy-tags."
+  (let ((privacy-tags (symbol-value (find-symbol "BOUNCER-PRIVACY-TAGS" :passepartout))))
+    (when (and tags-list privacy-tags)
+      (some (lambda (tag)
+              (some (lambda (private-tag)
+                      (string-equal (string-trim '(#\: #\space) tag)
+                                    (string-trim '(#\: #\space) private-tag))
+                    privacy-tags))
+            tags-list)))))
+
+(defun org-privacy-strip (content)
+  "Removes Org headlines whose :TAGS: property contains a privacy-filtered tag.
+Returns the filtered content as a string."
+  (let* ((lines (uiop:split-string content :separator '(#\Newline)))
+         (result-lines nil)
+         (skip-depth nil)
+         (current-tags nil)
+         (in-properties nil))
+    (dolist (line lines)
+      (cond
+        (skip-depth
+         ;; We're inside a skipped subtree
+         (when (and (uiop:string-prefix-p "*" (string-trim '(#\Space) line))
+                    (<= (length (string-trim '(#\Space) line)) skip-depth))
+           (setf skip-depth nil)))
+        ((uiop:string-prefix-p ":PROPERTIES:" (string-trim '(#\Space) line))
+         (setf in-properties t)
+         (push line result-lines))
+        ((uiop:string-prefix-p ":END:" (string-trim '(#\Space) line))
+         (setf in-properties nil)
+         (when current-tags
+           (when (org-privacy-tag-p (reverse current-tags))
+             (setf skip-depth
+                   (length (car (last result-lines
+                                      (1+ (position-if
+                                           (lambda (l)
+                                             (uiop:string-prefix-p "*" (string-trim '(#\Space) l)))
+                                           (reverse result-lines))))))))
+           (setf current-tags nil))
+         (push line result-lines))
+        ((and in-properties (uiop:string-prefix-p ":TAGS:" (string-trim '(#\Space) line)))
+         (let ((tag-val (string-trim '(#\Space) (subseq (string-trim '(#\Space) line) 6))))
+           (setf current-tags (uiop:split-string tag-val :separator '(#\space #\tab))))
+         (push line result-lines))
+        (t
+         (push line result-lines))))
+    (format nil "~{~a~%~}" (nreverse result-lines))))
+
+(defun org-read-file (filepath)
+  "Reads an Org file into a string, applying privacy filtering."
+  (let* ((raw (uiop:read-file-string filepath))
+         (filetags (org-filetags-extract raw)))
+    (if (org-privacy-tag-p filetags)
+        (progn
+          (harness-log "UTILS-ORG: Blocked read of ~a — file-level privacy tag(s) ~a" filepath filetags)
+          nil)
+        (org-privacy-strip raw))))
+
+(defun org-write-file (filepath content)
+  "Writes content to an Org file."
+  (uiop:with-output-file (s filepath :if-exists :supersede)
+    (format s "~a" content)))
+
+(defun org-id-generate ()
+  "Generates a new UUID for an Org node."
+  (string-downcase (format nil "~a" (uuid:make-v4-uuid))))
+
+(defun org-id-format (id)
+  "Ensures the ID has the 'id:' prefix."
+  (if (uiop:string-prefix-p "id:" id)
+      id
+      (format nil "id:~a" id)))
+
+(defun org-property-set (ast target-id property value)
+  "Recursively sets a property on a headline with a matching ID in the AST."
+  (let ((type (getf ast :type))
+        (props (getf ast :properties))
+        (contents (getf ast :contents)))
+    (when (and (eq type :HEADLINE) (string= (getf props :ID) target-id))
+      (setf (getf (getf ast :properties) property) value)
+      (return-from org-property-set t))
+    (dolist (child contents)
+      (when (listp child)
+        (when (org-property-set child target-id property value)
+          (return-from org-property-set t)))))
+  nil)
+
+(defun org-todo-set (ast target-id status)
+  "Sets the TODO status of a headline in the AST."
+  (org-property-set ast target-id :TODO status))
+
+(defun org-headline-add (ast parent-id title)
+  "Adds a new headline as a child of the parent-id in the AST."
+  (let* ((type (getf ast :type))
+         (props (getf ast :properties))
+         (id (getf props :ID))
+         (contents (getf ast :contents)))
+    (when (and (eq type :HEADLINE) (string= id parent-id))
+      (let ((new-node (list :type :HEADLINE
+                           :properties (list :ID (org-id-format (org-id-generate))
+                                            :TITLE title)
+                           :contents nil)))
+        (setf (getf ast :contents) (append contents (list new-node)))
+        (return-from org-headline-add t)))
+    (dolist (child contents)
+      (when (listp child)
+        (when (org-headline-add child parent-id title)
+          (return-from org-headline-add t)))))
+  nil)
+
+(defun org-headline-find-by-id (ast id)
+  "Finds a headline by its ID in the AST."
+  (let ((props (getf ast :properties)))
+    (when (string= (getf props :ID) id)
+      (return-from org-headline-find-by-id ast))
+    (dolist (child (getf ast :contents))
+      (when (listp child)
+        (let ((found (org-headline-find-by-id child id)))
+          (when found (return-from org-headline-find-by-id found)))))
+    nil))
+
+(defun org-headline-find-by-title (ast title)
+  "Finds a headline by its title in the AST."
+  (let ((props (getf ast :properties)))
+    (when (string-equal (getf props :TITLE) title)
+      (return-from org-headline-find-by-title ast))
+    (dolist (child (getf ast :contents))
+      (when (listp child)
+        (let ((found (org-headline-find-by-title child title)))
+          (when found (return-from org-headline-find-by-title found)))))
+    nil))
+
+(defun org-modify (filepath id changes)
+  "Placeholder for Emacs-driven modification of a specific node."
+  (declare (ignore changes))
+  (harness-log "UTILS-ORG: Applying changes to ~a in ~a" id filepath)
+  t)
+
+(defun org-ast-render (ast)
+  "Minimal converter from AST back to Org text (Placeholder)."
+  (declare (ignore ast))
+  "* TITLE (Placeholder)")
+
+(defskill :passepartout-programming-org
+  :priority 100
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
+
+(defpackage :passepartout-utils-org-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:utils-org-suite))
+
+(in-package :passepartout-utils-org-tests)
+
+(def-suite utils-org-suite
+  :description "Tests for Utils Org skill.")
+
+(in-suite utils-org-suite)
+
+(test id-generation
+  (let ((id1 (org-id-generate))
+        (id2 (org-id-generate)))
+    (is (plusp (length id1)))
+    (is (not (string= id1 id2)))))
+
+(test id-format
+  (let ((formatted (org-id-format "abc12345")))
+    (is (search "id:" formatted))))
+
+(test property-setter
+  (let ((ast (list :type :HEADLINE
+                  :properties (list :ID "id:test123" :TITLE "Test")
+                  :contents nil)))
+    (org-property-set ast "id:test123" :STATUS "ACTIVE")
+    (is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
+
+(test todo-setter
+  (let ((ast (list :type :HEADLINE
+                  :properties (list :ID "id:todo001" :TITLE "Task")
+                  :contents nil)))
+    (org-todo-set ast "id:todo001" "DONE")
+    (is (string= (getf (getf ast :properties) :TODO) "DONE"))))

lisp/programming-repl.lisp

@@ -0,0 +1,124 @@
+(in-package :passepartout)
+
+(defvar *repl-package* :passepartout
+  "Default package for REPL evaluations.")
+
+(defvar *repl-history* nil
+  "History of evaluated forms for session continuity.")
+
+(defvar *repl-variables* (make-hash-table :test #'eq)
+  "Cache of bound variables for inspection.")
+
+(defun repl-eval (code-string &key (package *repl-package*))
+  "Evaluate Lisp code and return (values result output error).
+   - result: the return value as string
+   - output: captured stdout
+   - error: error message or nil on success"
+  (let ((out (make-string-output-stream))
+        (err (make-string-output-stream))
+        (pkg (or (find-package package) (find-package :passepartout))))
+    (handler-case
+        (let* ((*standard-output* out)
+               (*error-output* err)
+               (*package* pkg)
+               (*read-eval* nil)
+               (result nil))
+          (with-input-from-string (s code-string)
+            (loop for form = (read s nil :eof) until (eq form :eof)
+                  do (setf result (eval form))))
+          (push code-string *repl-history*)
+          (values
+           (format nil "~a" result)
+           (get-output-stream-string out)
+           nil))
+      (error (c)
+        (values
+         nil
+         (get-output-stream-string out)
+         (format nil "~a" c))))))
+
+(defun repl-inspect (symbol-name &key (package *repl-package*))
+  "Inspect a variable's value and structure."
+  (let* ((pkg (or (find-package package) (find-package :passepartout)))
+         (sym (find-symbol (string-upcase symbol-name) pkg)))
+    (cond
+      ((null sym)
+       (format nil "Symbol ~a not found in package ~a" symbol-name package))
+      ((boundp sym)
+       (let ((val (symbol-value sym)))
+         (format nil "~a = ~a~%Type: ~a~%~%"
+                 sym val (type-of val))))
+      ((fboundp sym)
+       (format nil "~a is a function~%Args: ~a~%"
+               sym (documentation sym 'function)))
+      (t
+       (format nil "~a is unbound" symbol-name)))))
+
+(defun repl-list-vars (&key (package *repl-package*))
+  "List all bound variables in the package."
+  (let* ((pkg (or (find-package package) (find-package :passepartout)))
+         (vars nil))
+    (do-symbols (sym pkg)
+      (when (boundp sym)
+        (push (format nil "~a" sym) vars)))
+    (sort vars #'string<)))
+
+(defun repl-load-file (filepath)
+  "Load a Lisp file into the current image."
+  (handler-case
+      (progn
+        (load filepath)
+        (format nil "Loaded ~a" filepath))
+    (error (c)
+      (format nil "Error loading ~a: ~a" filepath c))))
+
+(defun repl-set-package (package-name)
+  "Set the default package for REPL evaluations."
+  (let ((pkg (find-package (string-upcase package-name))))
+    (if pkg
+        (setf *repl-package* pkg)
+        (format nil "Package ~a not found" package-name))))
+
+(defun repl-help ()
+  "Return available REPL commands."
+  (format nil "~%
+REPL Skill Commands:
+-------------------
+(repl-eval \"code\" :package :passepartout)
+  - Evaluate Lisp code, returns (values result output error)
+
+(repl-inspect \"symbol\" :package :passepartout)
+  - Inspect a variable or function
+
+(repl-list-vars :package :passepartout)
+  - List all bound variables
+
+(repl-load-file \"/path/to/file.lisp\")
+  - Load a file into the image
+
+(repl-set-package :package-name)
+  - Switch default package
+
+(repl-help)
+  - Show this message
+"))
+
+(defun repl-mandate (context)
+  "Returns REPL-first engineering mandate when context involves code editing."
+  (let ((raw (or (proto-get (proto-get context :payload) :text) "")))
+    (when (or (search "org-skill-" raw :test #'char-equal)
+              (and (search ".org" raw :test #'char-equal)
+                   (or (search "defun" raw :test #'char-equal)
+                       (search "tangle" raw :test #'char-equal)
+                       (search "write-file" raw :test #'char-equal)
+                       (search "lisp" raw :test #'char-equal)))
+              (search "defun " raw :test #'char-equal)
+              (search "repl-eval" raw :test #'char-equal)
+              (search "validate" raw :test #'char-equal))
+      (format nil "~%REPL-FIRST MANDATE:~%Before writing any defun to an Org file, prototype it in the REPL first. Set :repl-verified t on the write action. On rejection, fix the error and retry.~%"))))
+
+(defskill :passepartout-programming-repl
+  :priority 200
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil)
+  :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)
+  :system-prompt-augment #'repl-mandate)

lisp/programming-standards.lisp

@@ -0,0 +1,21 @@
+(defun standards-git-clean-p (dir)
+  "Checks if a directory has uncommitted changes."
+  (let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain")
+                                 :output :string
+                                 :ignore-error-status t)))
+    (string= "" (string-trim '(#\Space #\Newline #\Tab) status))))
+
+(defun standards-lisp-verify (code)
+  "Enforces Lisp structural and semantic standards using utils-lisp."
+  (let ((result (utils-lisp-validate code :strict t)))
+    (if (eq (getf result :status) :success)
+        t
+        (error (getf result :reason)))))
+
+(defun standards-lisp-format (code)
+  "Ensures Lisp code adheres to formatting standards."
+  (utils-lisp-format code))
+
+(defskill :passepartout-programming-standards
+  :priority 100
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

lisp/security-dispatcher.lisp

@@ -0,0 +1,327 @@
+(defvar *dispatcher-network-whitelist*
+  '("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")
+  "Domains the Bouncer considers safe for outbound connections.")
+
+(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.")
+
+(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.")
+
+(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.")
+
+(defvar *dispatcher-shell-timeout* 30
+  "Maximum seconds for a shell command before timeout.")
+
+(defvar *dispatcher-shell-max-output* 100000
+  "Maximum characters of shell output to capture.")
+
+(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.")
+
+(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)))
+
+(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*)))
+
+(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)))
+
+(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)))
+
+(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)))
+
+(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*))))
+
+(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))))
+
+(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)))))))
+
+(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)))
+
+(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))))))
+
+(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)))
+
+(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*)))))))
+
+(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
+       (harness-log "BOUNCER: ~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))
+       (harness-log "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)))
+         (harness-log "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 3: Content contains secret patterns
+      ((and text (dispatcher-exposure-scan text))
+       (let ((matched (dispatcher-exposure-scan text)))
+         (harness-log "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)))
+         (harness-log "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))
+       (harness-log "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))
+       (harness-log "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)))
+         (harness-log "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))
+        (harness-log "SECURITY WARNING: External network call detected. Queuing for approval.")
+        (list :type :EVENT :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)))
+       (harness-log "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))))
+
+(defun dispatcher-approvals-process ()
+  "Scans for APPROVED flight plans and re-injects them."
+  (let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
+        (found-any nil))
+    (dolist (node approved-nodes)
+      (let* ((attrs (org-object-attributes node))
+             (tags (getf attrs :TAGS))
+             (action-str (getf attrs :ACTION)))
+        (when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
+          (harness-log "BOUNCER: Found approved flight plan '~a'. Re-injecting..." (org-object-id node))
+          (let ((action (ignore-errors (read-from-string action-str))))
+            (when action
+              (setf (getf action :approved) t)
+              (inject-stimulus action)
+              (setf (getf (org-object-attributes node) :TODO) "DONE")
+              (setq found-any t))))))
+    found-any))
+
+(defun dispatcher-flight-plan-create (blocked-action)
+  "Creates a Flight Plan node for manual approval."
+  (let ((id (org-id-new)))
+    (harness-log "BOUNCER: 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))))))
+
+(defun dispatcher-gate (action context)
+  "Main deterministic gate for the Bouncer 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)))))
+
+(defskill :passepartout-security-dispatcher
+  :priority 150
+  :trigger (lambda (ctx) (declare (ignore ctx)) t)
+  :deterministic #'dispatcher-gate)

lisp/security-permissions.lisp

@@ -0,0 +1,13 @@
+(defvar *permission-table* (make-hash-table :test 'equal))
+
+(defun permission-set (tool-name level)
+  "Sets the permission level for a tool."
+  (setf (gethash (string-downcase (string tool-name)) *permission-table*) level))
+
+(defun permission-get (tool-name)
+  "Retrieves the permission level for a tool. Defaults to :ask."
+  (gethash (string-downcase (string tool-name)) *permission-table* :ask))
+
+(defskill :passepartout-security-permissions
+  :priority 600
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

lisp/security-policy.lisp

@@ -0,0 +1,17 @@
+(defun policy-compliance-check (action context)
+  "Enforces constitutional invariants on proposed actions."
+  (declare (ignore context))
+  (let* ((payload (proto-get action :payload))
+         (explanation (proto-get payload :explanation)))
+    (if (and explanation (stringp explanation) (> (length explanation) 10))
+        action
+        (progn
+          (harness-log "POLICY VIOLATION: Action lacks sufficient explanation.")
+          (list :type :LOG
+                :payload (list :level :warn
+                              :text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning."))))))
+
+(defskill :passepartout-security-policy
+  :priority 500
+  :trigger (lambda (ctx) (declare (ignore ctx)) t)
+  :deterministic #'policy-compliance-check)

lisp/security-validator.lisp

@@ -0,0 +1,13 @@
+(defun validator-protocol-check (msg)
+  "Enforces structural schema compliance on protocol messages."
+  (validate-communication-protocol-schema msg))
+
+(defskill :passepartout-security-validator
+  :priority 95
+  :trigger (lambda (ctx) (declare (ignore ctx)) t)
+  :deterministic (lambda (action ctx)
+                   (declare (ignore ctx))
+                   (handler-case
+                       (progn (validator-protocol-check action) action)
+                     (error (c)
+                       (list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))

lisp/security-vault.lisp

@@ -0,0 +1,25 @@
+(defvar *vault-memory* (make-hash-table :test 'equal)
+  "In-memory cache of sensitive credentials.")
+
+(defun vault-get (provider &key (type :api-key))
+  "Retrieves a credential from the vault or environment."
+  (let* ((key (format nil "~a-~a" provider type))
+         (val (gethash key *vault-memory*)))
+    (if val
+        val
+        (let ((env-var (case provider
+                          (:gemini "GEMINI_API_KEY")
+                          (:openai "OPENAI_API_KEY")
+                          (:anthropic "ANTHROPIC_API_KEY")
+                          (:openrouter "OPENROUTER_API_KEY")
+                          (otherwise nil))))
+          (when env-var (uiop:getenv env-var))))))
+
+(defun vault-set (provider secret &key (type :api-key))
+  "Stores a secret in the vault."
+  (let ((key (format nil "~a-~a" provider type)))
+    (setf (gethash key *vault-memory*) secret)))
+
+(defskill :passepartout-security-vault
+  :priority 600
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

lisp/system-actuator-shell.lisp

@@ -0,0 +1,27 @@
+(defun actuator-shell-execute (action context)
+  "Executes a bash command with timeout (via timeout(1)) and output limit."
+  (declare (ignore context))
+  (let* ((payload (getf action :payload))
+         (cmd (getf payload :cmd))
+         (timeout-sym (find-symbol "*BOUNCER-SHELL-TIMEOUT*" :passepartout))
+         (timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30)))
+         (max-sym (find-symbol "*BOUNCER-SHELL-MAX-OUTPUT*" :passepartout))
+         (max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))
+         (wrapped-cmd (format nil "timeout ~a bash -c ~s" timeout cmd)))
+    (harness-log "ACT [Shell]: ~a (timeout: ~as)" cmd timeout)
+    (multiple-value-bind (out err code)
+        (uiop:run-program (list "bash" "-c" wrapped-cmd)
+                          :output :string :error-output :string
+                          :ignore-error-status t)
+      (cond
+        ((= code 124) (format nil "ERROR: Command timed out after ~a seconds" timeout))
+        ((> (length out) max-output)
+         (format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output))
+        ((= code 0) out)
+        (t (format nil "ERROR [~a]: ~a" code err))))))
+
+(register-actuator :shell #'actuator-shell-execute)
+
+(defskill :passepartout-system-actuator-shell
+  :priority 50
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

lisp/system-archivist.lisp

@@ -0,0 +1,10 @@
+(defun archivist-log (signal)
+  "Logs a metabolic signal for later analysis."
+  (let ((type (getf signal :type))
+        (payload (getf signal :payload)))
+    (harness-log "SCRIBE: [~a] ~s" type payload)))
+
+(defskill :passepartout-system-archivist
+  :priority 100
+  :trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :STATUS)))
+  :deterministic (lambda (action ctx) (declare (ignore action)) (archivist-log ctx) nil))

lisp/system-config.lisp

@@ -0,0 +1,243 @@
+(defun config-directory ()
+  "Returns the absolute path to the opencortex config directory."
+  (let ((xdg (uiop:getenv "OC_CONFIG_DIR")))
+    (if xdg xdg (namestring (merge-pathnames ".config/passepartout/" (user-homedir-pathname))))))
+
+(defun config-file-path ()
+  "Returns the path to the .env configuration file."
+  (merge-pathnames ".env" (config-directory)))
+
+(defun config-directory-ensure ()
+  "Creates the configuration directory if it does not exist."
+  (ensure-directories-exist (config-directory)))
+
+(defun config-read ()
+  "Reads the .env config file and returns an alist of KEY=VALUE pairs."
+  (let ((config-file (config-file-path)))
+    (when (uiop:file-exists-p config-file)
+      (let ((lines (uiop:read-file-lines config-file))
+            (result nil))
+        (dolist (line lines)
+          (when (and line (> (length line) 0)
+                     (not (uiop:string-prefix-p "#" line)))
+            (let ((eq-pos (position #\= line)))
+              (when eq-pos
+                (let ((key (string-trim " " (subseq line 0 eq-pos)))
+                      (value (string-trim " " (subseq line (1+ eq-pos)))))
+                  (push (cons key value) result))))))
+        (nreverse result)))))
+
+(defun config-write (config-alist)
+  "Writes the config alist to the .env file."
+  (config-directory-ensure)
+  (let ((config-file (config-file-path)))
+    (with-open-file (stream config-file :direction :output :if-exists :supersede :if-does-not-exist :create)
+      (format stream "# Passepartout Configuration~%")
+      (format stream "# Generated by opencortex setup~%~%")
+      (dolist (pair config-alist)
+        (format stream "~a=~a~%" (car pair) (cdr pair))))))
+
+(defun config-get (key)
+  "Gets a config value by key."
+  (let ((config (config-read)))
+    (cdr (assoc key config :test #'string=))))
+
+(defun config-set (key value)
+  "Sets a config value and saves to file."
+  (let ((config (config-read))
+        (pair (cons key value)))
+    (let ((existing (assoc key config :test #'string=)))
+      (if existing
+          (setf (cdr existing) value)
+          (push pair config))
+      (config-write config))))
+
+(defun prompt (prompt-text)
+  "Simple prompt that returns user input as a string."
+  (format t "~a" prompt-text)
+  (finish-output)
+  (read-line))
+
+(defun prompt-yes-no (prompt-text)
+  "Prompts yes/no question. Returns T for yes, nil for no."
+  (let ((response (prompt (format nil "~a [Y/n]: " prompt-text))))
+    (or (string= response "")
+        (string-equal response "Y")
+        (string-equal response "y")
+        (string-equal response "yes"))))
+
+(defun prompt-choice (prompt-text options)
+  "Prompts user to choose from a list of options. Returns the chosen option or nil."
+  (format t "~a~%" prompt-text)
+  (let ((i 1))
+    (dolist (opt options)
+      (format t "  ~a) ~a~%" i opt)
+      (incf i)))
+  (let ((response (prompt "Choice")))
+    (let ((num (ignore-errors (parse-integer response))))
+      (when (and num (<= 1 num) (>= (length options) num))
+        (nth (1- num) options)))))
+
+(defparameter *available-providers*
+  '(("OpenAI" . "OPENAI_API_KEY")
+    ("Anthropic" . "ANTHROPIC_API_KEY")
+    ("OpenRouter" . "OPENROUTER_API_KEY")
+    ("Groq" . "GROQ_API_KEY")
+    ("Gemini" . "GEMINI_API_KEY")
+    ("Ollama (local)" . "OLLAMA_URL")))
+
+(defun setup-llm-providers ()
+  "Interactive wizard for configuring LLM providers."
+  (format t "~%~%")
+  (format t "==================================================~%")
+  (format t " LLM Provider Configuration~%")
+  (format t "==================================================~%~%")
+  
+  (let ((current-providers (loop for (name . key) in *available-providers*
+                                when (config-get key)
+                                collect name)))
+    (when current-providers
+      (format t "Current providers: ~{~a~^, ~}~%~%" current-providers))
+    
+    (format t "Available providers:~%")
+    (dolist (p *available-providers*)
+      (format t "  - ~a~%" (car p)))
+    (format t "~%")
+    
+    (when (prompt-yes-no "Configure a new provider?")
+      (let ((chosen (prompt-choice "Select provider:" (mapcar #'car *available-providers*))))
+        (when chosen
+          (let ((env-key (cdr (assoc chosen *available-providers* :test #'string=))))
+            (if (string= chosen "Ollama (local)")
+                (progn
+                  (format t "Enter Ollama URL (e.g., http://localhost:11434): ")
+                  (let ((url (read-line)))
+                    (config-set env-key url)
+                    (format t "✓ Ollama configured at ~a~%" url)))
+                (progn
+                  (format t "Enter API key for ~a: " chosen)
+                  (let ((key (read-line)))
+                    (config-set env-key key)
+                    (format t "✓ ~a API key saved~%" chosen)))))))))
+  
+  (format t "~%"))
+
+(defun setup-add-provider ()
+  "Entry point for adding a single provider (called from CLI)."
+  (setup-llm-providers))
+
+(defun setup-gateways ()
+  "Interactive wizard for configuring external gateways."
+  (format t "~%~%")
+  (format t "==================================================~%")
+  (format t " Gateway Configuration~%")
+  (format t "==================================================~%~%")
+  
+  (format t "Available gateways:~%")
+  (format t "  - Slack (https://api.slack.com/)~%")
+  (format t "  - Discord (https://discord.com/developers/)~%")
+  (format t "~%")
+  
+  (when (prompt-yes-no "Configure a gateway?")
+    (let ((chosen (prompt-choice "Select platform:" '("Slack" "Discord"))))
+      (when chosen
+        (let ((token (prompt (format nil "Enter ~a bot token: " chosen))))
+          (if (string= chosen "Slack")
+              (config-set "SLACK_TOKEN" token)
+              (config-set "DISCORD_TOKEN" token))
+          (format t "✓ ~a gateway configured~%" chosen)))))
+  
+  (format t "~%"))
+
+(defun setup-skills ()
+  "Interactive wizard for enabling/disabling skills."
+  (format t "~%~%")
+  (format t "==================================================~%")
+  (format t " Skill Management~%")
+  (format t "==================================================~%~%")
+  
+  (format t "Note: Skill management is not yet implemented.~%")
+  (format t "Skills are automatically loaded from ~a~%" (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") "~/.local/share/passepartout"))
+  (format t "~%"))
+
+(defun setup-memory ()
+  "Interactive wizard for memory settings."
+  (format t "~%~%")
+  (format t "==================================================~%")
+  (format t " Memory Settings~%")
+  (format t "==================================================~%~%")
+  
+  (let ((auto-save (prompt "Auto-save interval in seconds [300]:")))
+    (when (and auto-save (> (length auto-save) 0))
+      (config-set "MEMORY_AUTO_SAVE_INTERVAL" auto-save)))
+  
+  (let ((history (prompt "History retention in lines [1000]:")))
+    (when (and history (> (length history) 0))
+      (config-set "MEMORY_HISTORY_RETENTION" history)))
+  
+  (format t "✓ Memory settings saved~%")
+  (format t "~%"))
+
+(defun setup-network ()
+  "Interactive wizard for network settings."
+  (format t "~%~%")
+  (format t "==================================================~%")
+  (format t " Network Settings~%")
+  (format t "==================================================~%~%")
+  
+  (let ((timeout (prompt "Request timeout in seconds [30]:")))
+    (when (and timeout (> (length timeout) 0))
+      (config-set "REQUEST_TIMEOUT" timeout)))
+  
+  (let ((proxy (prompt "Proxy URL (leave empty for none) []:")))
+    (when (and proxy (> (length proxy) 0))
+      (config-set "HTTP_PROXY" proxy)))
+  
+  (format t "✓ Network settings saved~%")
+  (format t "~%"))
+
+(defun setup-wizard-run ()
+  "Main entry point for the interactive setup wizard."
+  (format t "~%~%")
+  (format t "╔═══════════════════════════════════════════════════╗~%")
+  (format t "║         Passepartout Setup Wizard                   ║~%")
+  (format t "╚═══════════════════════════════════════════════════╝~%")
+  (format t "~%")
+  (format t "This wizard will help you configure:~%")
+  (format t "  1. LLM Providers (OpenAI, Anthropic, etc.)~%")
+  (format t "  2. Gateway Links (Slack, Discord)~%")
+  (format t "  3. Memory Settings~%")
+  (format t "  4. Network Settings~%")
+  (format t "~%")
+  
+  (config-directory-ensure)
+  
+  ;; Step 1: LLM Providers
+  (when (prompt-yes-no "Configure LLM providers?")
+    (setup-llm-providers))
+  
+  ;; Step 2: Gateways
+  (when (prompt-yes-no "Configure gateways?")
+    (setup-gateways))
+  
+  ;; Step 3: Memory
+  (when (prompt-yes-no "Configure memory settings?")
+    (setup-memory))
+  
+  ;; Step 4: Network
+  (when (prompt-yes-no "Configure network settings?")
+    (setup-network))
+  
+  ;; Summary
+  (format t "==================================================~%")
+  (format t " Setup Complete!~%")
+  (format t "==================================================~%")
+  (format t "~%")
+  (format t "Configuration saved to: ~a~%" (config-file-path))
+  (format t "~%")
+  (format t "To verify your setup, run: passepartout doctor~%")
+  (format t "~%"))
+
+(defskill :passepartout-system-config
+  :priority 100
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

lisp/system-diagnostics.lisp

@@ -0,0 +1,176 @@
+(defvar *diagnostics-binaries* '("sbcl" "emacs" "git" "socat" "nc")
+  "List of external binaries required for full system operation.")
+
+(defvar *diagnostics-package-map*
+  '(("sbcl" . "sbcl")
+    ("emacs" . "emacs")
+    ("git" . "git")
+    ("socat" . "socat")
+    ("nc" . "netcat-openbsd")
+    ("curl" . "curl")
+    ("rlwrap" . "rlwrap"))
+  "Map binary names to apt package names.")
+
+(defvar *doctor-missing-deps* nil
+  "List of missing dependencies populated by diagnostics-dependencies-check.")
+
+(defvar *doctor-auto-install* t
+  "When T, doctor will attempt to install missing dependencies automatically.")
+
+(defun diagnostics-dependencies-check ()
+  "Verifies that required external binaries are available in the PATH via shell probe."
+  (setf *doctor-missing-deps* nil)
+  (let ((all-ok t))
+    (format t "DOCTOR: Checking system dependencies...~%")
+    (dolist (dep *diagnostics-binaries*)
+      (let ((path (ignore-errors
+                    (uiop:run-program (list "which" dep)
+                                      :output :string :ignore-error-status t))))
+        (if (and path (> (length path) 0))
+            (format t "  [OK] Found ~a~%" dep)
+            (progn
+              (format t "  [FAIL] Missing binary: ~a~%" dep)
+              (push dep *doctor-missing-deps*)
+              (setf all-ok nil)))))
+    (when (and all-ok (null *doctor-missing-deps*))
+      (format t "DOCTOR: All dependencies satisfied.~%"))
+    all-ok))
+
+(defun diagnostics-dependencies-install ()
+  "Attempts to install missing system dependencies via apt."
+  (when (null *doctor-missing-deps*)
+    (format t "DOCTOR: No missing dependencies to install.~%")
+    (return-from diagnostics-dependencies-install t))
+
+  (format t "DOCTOR: Attempting to install ~a missing dependencies...~%" (length *doctor-missing-deps*))
+
+  (let ((packages (remove-duplicates
+                   (mapcar (lambda (dep)
+                             (or (cdr (assoc dep *diagnostics-package-map* :test #'string=))
+                                 dep))
+                           *doctor-missing-deps*)
+                   :test #'string=)))
+    (format t "DOCTOR: Packages to install: ~a~%" packages)
+
+    (let ((cmd (format nil "apt-get install -y ~{~a~^ ~}" packages)))
+      (format t "DOCTOR: Running: ~a~%" cmd)
+      (handler-case
+          (let ((output (uiop:run-program cmd
+                                           :output :string
+                                           :error-output :string
+                                           :external-format :utf-8)))
+            (if (zerop (uiop:run-program (format nil "which ~a" (car *doctor-missing-deps*))
+                                          :ignore-error-status t))
+                (progn
+                  (format t "DOCTOR: Dependencies installed successfully.~%")
+                  (setf *doctor-missing-deps* nil)
+                  t)
+                (progn
+                  (format t "DOCTOR: Installation failed. Output: ~a~%" output)
+                  nil)))
+        (error (c)
+          (format t "DOCTOR: Installation error: ~a~%" c)
+          nil)))))
+
+(defun diagnostics-env-check ()
+  "Validates XDG directories and environment configuration."
+  (format t "DOCTOR: Checking XDG environment...~%")
+  (let ((all-ok t)
+        (config-dir (uiop:getenv "PASSEPARTOUT_CONFIG_DIR"))
+        (data-dir (uiop:getenv "PASSEPARTOUT_DATA_DIR"))
+        (state-dir (uiop:getenv "PASSEPARTOUT_STATE_DIR"))
+        (memex-dir (uiop:getenv "MEMEX_DIR")))
+
+    (flet ((check-dir (name path critical)
+             (if (and path (> (length path) 0))
+                 (if (uiop:directory-exists-p path)
+                     (format t "  [OK] ~a: ~a~%" name path)
+                     (progn
+                       (format t "  [FAIL] ~a directory missing: ~a~%" name path)
+                       (when critical (setf all-ok nil))))
+                 (progn
+                   (format t "  [FAIL] ~a variable not set.~%" name)
+                   (when critical (setf all-ok nil))))))
+
+      (check-dir "Config (PASSEPARTOUT_CONFIG_DIR)" config-dir t)
+      (check-dir "Data (PASSEPARTOUT_DATA_DIR)" data-dir t)
+      (check-dir "State (PASSEPARTOUT_STATE_DIR)" state-dir t)
+      (check-dir "Memex (MEMEX_DIR)" memex-dir t))
+    all-ok))
+
+(defun diagnostics-llm-check ()
+  "Tests connectivity to LLM providers. Returns T if at least one provider is configured."
+  (format t "DOCTOR: Checking LLM connectivity...~%")
+  (let ((providers '((:openrouter . "OPENROUTER_API_KEY")
+                     (:anthropic . "ANTHROPIC_API_KEY")
+                     (:openai . "OPENAI_API_KEY")
+                     (:groq . "GROQ_API_KEY")
+                     (:gemini . "GEMINI_API_KEY")
+                     (:deepseek . "DEEPSEEK_API_KEY")
+                     (:nvidia . "NVIDIA_API_KEY")
+                     (:ollama . "OLLAMA_URL")))
+        (configured nil))
+    (dolist (p providers)
+      (let ((env-val (uiop:getenv (cdr p))))
+        (cond
+          ((and env-val (> (length env-val) 0))
+           (format t "  [OK] ~a configured~%" (car p))
+           (setf configured t))
+          ((eq (car p) :ollama)
+           (let ((ollama-check (ignore-errors
+                                 (uiop:run-program '("curl" "-s" "http://localhost:11434/api/tags")
+                                                    :output :string :ignore-error-status t))))
+             (when (and ollama-check (search "\"models\"" ollama-check))
+               (format t "  [OK] Ollama local model server detected~%")
+               (setf configured t)))))))
+    (if configured
+        (progn
+          (format t "  [OK] LLM provider(s) available~%")
+          t)
+        (progn
+          (format t "  [WARN] No LLM provider configured.~%")
+          (format t "  Run 'passepartout configure' to configure a provider.~%")
+          t))))
+
+(defun diagnostics-run-all (&key (auto-install t))
+  "Executes the full diagnostic suite and returns T if system is healthy."
+  (format t "==================================================~%")
+  (format t " PASSEPARTOUT DOCTOR: Commencing Health Check~%")
+  (format t "==================================================~%")
+  (let ((dep-ok (diagnostics-dependencies-check)))
+    (when (and (not dep-ok) auto-install *doctor-auto-install*)
+      (format t "DOCTOR: Attempting automatic installation...~%")
+      (setf dep-ok (diagnostics-dependencies-install))
+      (when dep-ok
+        (setf dep-ok (diagnostics-dependencies-check))))
+    (let ((env-ok (diagnostics-env-check))
+          (llm-ok (diagnostics-llm-check)))
+      (format t "==================================================~%")
+      (if (and dep-ok env-ok)
+          (progn
+            (format t " ✓ SYSTEM HEALTHY: Ready for ignition.~%")
+            t)  ;; Explicitly return T
+          (progn
+            (format t "==================================================~%")
+            (format t " ISSUES FOUND:~%")
+            (when (not dep-ok)
+              (format t "  - Missing system dependencies~%"))
+            (when (not llm-ok)
+              (format t "  - No LLM provider configured~%"))
+            (format t "~%")
+            (format t " RECOMMENDED ACTIONS:~%")
+            (format t "  1. Run 'passepartout configure' to configure everything~%")
+            (format t "  2. Or run 'passepartout doctor --fix' for auto-repair~%")
+            (format t "==================================================~%")
+            nil)))))  ;; Return nil when issues found
+
+(defun diagnostics-main ()
+  "Entry point for the 'doctor' CLI command."
+  (if (diagnostics-run-all)
+      (uiop:quit 0)
+      (uiop:quit 1)))
+
+(defskill :passepartout-system-diagnostics
+  :priority 100
+  :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
+  :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))

lisp/system-memory.lisp

@@ -0,0 +1,7 @@
+(defun memory-inspect ()
+  "Allows the system to inspect its own memory state."
+  (harness-log "MEMORY: Self-inspection triggered."))
+
+(defskill :passepartout-system-memory
+  :priority 100
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))

lisp/system-self-improve-add.lisp

@@ -0,0 +1,18 @@
+(defun self-improve-edit (filepath old-text new-text)
+  "Applies a transformation to a source file."
+  (declare (ignore old-text new-text))
+  (harness-log "SELF-EDIT: Applying changes to ~a" filepath))
+
+(defskill :passepartout-system-self-improve
+  :priority 100
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil))
+
+(defun self-improve-fix (skill-name error-log)
+  "Attempts to diagnose and repair a broken skill."
+  (declare (ignore error-log))
+  (harness-log "SELF-FIX: Attempting repair of ~a..." skill-name))
+
+(defskill :passepartout-system-self-improve
+  :priority 100
+  :trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :EVENT)))
+  :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))