ARCH: Finalize semantic reorganization, skill jailing, and unified CLI

library/act.lisp

@@ -0,0 +1,148 @@
+(in-package :opencortex)
+
+(defvar *default-actuator* :cli)
+(defvar *silent-actuators* '(:cli :system-message :emacs))
+
+(defun initialize-actuators ()
+  "Loads actuator routing defaults from environment variables and registers core harness actuators."
+  (let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
+        (silent (uiop:getenv "SILENT_ACTUATORS")))
+    (when def
+      (setf *default-actuator* (intern (string-upcase def) "KEYWORD")))
+    (when silent
+      (setf *silent-actuators*
+            (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) "KEYWORD"))
+                    (str:split "," silent)))))
+  
+  ;; Register core harness actuators
+  (register-actuator :system #'execute-system-action)
+  (register-actuator :tool #'execute-tool-action)
+  (register-actuator :tui (lambda (action context)
+                            (let* ((meta (getf context :meta))
+                                   (stream (getf meta :reply-stream)))
+                              (when (and stream (open-stream-p stream))
+                                (format stream "~a" (frame-message action))
+                                (finish-output stream))))))
+
+(defun dispatch-action (action context)
+  (let ((payload (proto-get action :payload)))
+    (when (eq (proto-get payload :sensor) :heartbeat)
+      (return-from dispatch-action nil)))
+  "Routes an approved action to its registered physical actuator."
+  (when (and action (listp action))
+    (let* ((meta (proto-get context :meta))
+           (source (proto-get meta :source))
+           (raw-target (or (ignore-errors (getf action :TARGET))
+                           (ignore-errors (getf action :target))
+                           source
+                           *default-actuator*))
+           (target (intern (string-upcase (string raw-target)) :keyword))
+           (actuator-fn (gethash target *actuator-registry*)))
+      ;; Ensure outbound action has meta if context had it
+      (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 for ~s (from ~s)" target raw-target)))))
+
+(defun execute-system-action (action context)
+  "Processes internal harness commands. (ACTUATOR)"
+  (declare (ignore context))
+  (let* ((payload (ignore-errors (getf action :payload))) 
+         (cmd (ignore-errors (getf payload :action))))
+    (case cmd
+      (:eval (let ((code (getf payload :code)))
+               (eval (read-from-string code))))
+      (:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content))
+                            (skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :opencortex))) 
+                            (full-path (merge-pathnames filename skills-dir)))
+                       (with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out))
+                       (load-skill-from-org full-path)))
+      (:message (harness-log "ACT [System]: ~a" (getf payload :text)))
+      (t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd)))))
+
+(defun format-tool-result (tool-name result)
+  "Intelligently formats a tool result for user 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 execute-tool-action (action context)
+  "Executes a registered cognitive tool. (ACTUATOR)"
+  (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)))
+              (let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
+                                    :PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))))
+                ;; If we have a source, send a status message with the result, formatted for humans
+                (when source
+                   (dispatch-action (list :TYPE :REQUEST :TARGET source 
+                                          :PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result))) 
+                                    context))
+                feedback))
+          (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 "Tool not found")))))
+
+(defun act-gate (signal)
+  "Final Stage: Actuation and feedback generation."
+  (let* ((approved (getf signal :approved-action))
+         (type (getf signal :type))
+         (meta (getf signal :meta))
+         (source (getf meta :source))
+         (feedback nil)
+         ;; context must keep internal objects for actuators to function
+         (context signal))
+    
+    ;; 1. Last-Mile Safety Check (The Bouncer & Deterministic Gates)
+    (when approved
+      (let* ((original-type (getf approved :type))
+             (verified (deterministic-verify approved signal)))
+        (if (and (listp verified) 
+                 (member (getf verified :type) '(:LOG :EVENT :log :event))
+                 (not (member original-type '(:LOG :EVENT :log :event))))
+            (progn
+              (harness-log "ACT BLOCKED: Action failed last-mile deterministic check.")
+              (setf (getf signal :approved-action) nil)
+              (setf approved nil)
+              (setf feedback verified))
+            (progn
+              (setf (getf signal :approved-action) verified)
+              (setf approved verified)))))
+
+    ;; 2. Actuation Logic
+    (case type
+      (:REQUEST (dispatch-action signal context))
+      (:LOG (dispatch-action signal context))
+      (:EVENT 
+       (if approved
+           (let* ((target (getf approved :target))
+                  (result (dispatch-action approved context)))
+             ;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
+             ;; Otherwise, generate tool-output feedback for non-silent actuators.
+             (cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
+                    (setf feedback result))
+                   ((and result (not (member target *silent-actuators*)))
+                    (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
+                                         :payload (list :sensor :tool-output :result result :tool approved))))))
+           ;; If no approved action but we have a source, this might be a raw event/log stimulus.
+           (when source
+             (dispatch-action signal context)))))
+    
+    (setf (getf signal :status) :acted)
+    feedback))

library/communication-validator.lisp

@@ -0,0 +1,39 @@
+(in-package :opencortex)
+
+(defun validate-communication-protocol-schema (msg)
+  "Strict structural validation for incoming communication protocol messages."
+  (unless (listp msg)
+    (error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
+  
+  (let ((type (let ((raw (proto-get msg :type))) (if (keywordp raw) (intern (string-upcase (string raw)) :keyword) raw))))
+    (unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS))
+      (progn (harness-log "REJECTED MSG: ~s" msg) (error "Communication Protocol Schema Error: Invalid message type '~a'" type)))
+    
+    (case type
+      (:REQUEST 
+       (unless (proto-get msg :target)
+         (error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
+       (unless (proto-get msg :payload)
+         (error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))
+      
+      (:EVENT
+       (let ((payload (proto-get msg :payload)))
+         (unless (and payload (listp payload))
+           (error "Communication Protocol Schema Error: EVENT missing or invalid :payload"))
+         (unless (or (proto-get payload :action) (proto-get payload :sensor))
+           (error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor"))))
+      
+      (:RESPONSE
+       (unless (proto-get msg :payload)
+         (error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
+    
+    t))
+
+(defskill :skill-communication-protocol-validator
+  :priority 95
+  :trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
+  :probabilistic nil
+  :deterministic (lambda (action ctx)
+              (declare (ignore ctx))
+              (validate-communication-protocol-schema action)
+              action))

library/communication.lisp

@@ -0,0 +1,75 @@
+(in-package :opencortex)
+
+(defvar *actuator-registry* (make-hash-table :test 'equalp)
+  "Global registry mapping target keywords to their physical actuator functions.")
+
+(defun register-actuator (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 frame-message (msg-plist)
+  "Frames a Lisp plist with a 6-character hex length and a newline for stream integrity."
+  (let* ((*print-pretty* nil)
+         (*print-circle* nil)
+         (msg-string (format nil "~s" msg-plist))
+         (len (length msg-string)))
+    (format nil "~6,'0x~a~%" len msg-string)))
+
+(defun read-framed-message (stream)
+  "Reads a hex-length prefixed S-expression from the stream securely. Skips leading whitespace."
+  (let ((length-buffer (make-string 6)))
+    (handler-case
+        (progn
+          ;; 1. Skip leading whitespace (newlines, spaces, etc.)
+          (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))
+          
+          ;; 2. Read the 6-char hex length
+          (let ((count (read-sequence length-buffer stream)))
+            (cond ((< count 6) :eof)
+                  (t (let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
+                       (if (not len)
+                           (progn
+                             (harness-log "PROTOCOL ERROR: Invalid header ~s. Attempting resync..." length-buffer)
+                             :error)
+                           (let ((msg-buffer (make-string len)))
+                             (read-sequence msg-buffer stream)
+                             (let ((*read-eval* nil)
+                                   (*print-pretty* nil))
+                               (handler-case 
+                                   (let ((msg (read-from-string msg-buffer)))
+                                     (validate-communication-protocol-schema msg)
+                                     msg)
+                                 (error (c)
+                                   (harness-log "PROTOCOL PARSE ERROR: ~a in ~s" c msg-buffer)
+                                   :error))))))))))
+      (error (c) 
+        (harness-log "PROTOCOL READ ERROR: ~a" c)
+        :error))))
+
+(defun make-hello-message (version)
+  "Constructs the standard HELLO handshake message."
+  (list :TYPE :EVENT 
+        :PAYLOAD (list :ACTION :handshake 
+                       :VERSION version 
+                       :CAPABILITIES '(:AUTH :SWANK :ORG-AST))))
+
+(defun sanitize-protocol-message (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) (sanitize-protocol-message 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 (sanitize-protocol-message msg))
+         (payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
+         (len (length payload)))
+    (format nil "~6,'0x~a" len payload)))

library/context.lisp

@@ -0,0 +1,119 @@
+(in-package :opencortex)
+
+(defun context-query-store (&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-get-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-store :tag "project" :type :HEADLINE)))
+
+(defun context-get-recent-completed-tasks () 
+  "Retrieves recently finished tasks from the store."
+  (context-query-store :todo-state "DONE" :type :HEADLINE))
+
+(defun context-list-all-skills ()
+  "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-get-skill-source (skill-name)
+  "Reads the raw literate source of a specific skill for inspection."
+  (let* ((filename (format nil "~a.org" skill-name))
+         (skills-dir-str (or (uiop:getenv "SKILLS_DIR") (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
+         (skills-dir (uiop:ensure-directory-pathname (context-resolve-path skills-dir-str)))
+         (full-path (merge-pathnames filename skills-dir)))
+    (if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
+
+(defun context-get-system-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-render-to-org (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))
+         ;; We always render depth 1 and 2 (Projects and main tasks).
+         ;; We always render the foveal node and its immediate children.
+         ;; We render deeper nodes ONLY if they are semantically relevant.
+         (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:~%")))
+      
+      ;; Only include full body content if this is the Foveal focus or highly relevant
+      (when (and content (or is-foveal is-semantically-relevant))
+        (setf output (concatenate 'string output content (string #\Newline))))
+      
+      ;; Recursively render children
+      (dolist (child-id children)
+        (let ((child-obj (lookup-object child-id)))
+          (when child-obj
+            ;; If the current node is Foveal, its children should be rendered (depth effectively resets)
+            (let ((next-foveal (if is-foveal child-id foveal-id)))
+              (setf output (concatenate 'string output 
+                                        (context-render-to-org child-obj 
+                                                               :depth (1+ depth) 
+                                                               :foveal-id next-foveal
+                                                               :semantic-threshold threshold
+                                                               :foveal-vector foveal-vector))))))))
+    output))
+
+(defun context-resolve-path (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-assemble-global-awareness (&optional signal)
+  "Produces a high-level skeletal outline of the current Memory for the LLM."
+  (let* ((foveal-id (or (getf signal :foveal-focus) 
+                        (ignore-errors (getf (getf signal :payload) :target-id))))
+         (projects (context-get-active-projects))
+         (output "GLOBAL MEMEX AWARENESS (Peripheral Vision):
+"))
+    (if projects
+        (dolist (project projects)
+          (setf output (concatenate 'string output
+                                    (context-render-to-org project :foveal-id foveal-id))))
+        (setf output (concatenate 'string output "No active projects found.~%")))
+    output))

library/gen/org-skill-bouncer.lisp

@@ -0,0 +1,109 @@
+(in-package :opencortex)
+
+(defun bouncer-scan-secrets (text)
+  "Returns the name of the secret found in TEXT, or NIL if clean."
+  (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))))
+               opencortex::*vault-memory*)
+      found-secret)))
+
+(defun bouncer-check-network-exfil (cmd)
+  "Returns T if the command appears to target an unwhitelisted external host."
+  (when (and cmd (stringp cmd))
+    ;; Basic check for common data exfiltration tools being used with IPs/URLs
+    (let ((network-whitelist '("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")))
+      (when (cl-ppcre:scan "(http|https|ftp)://([\\w\\.-]+)" cmd)
+        (multiple-value-bind (match regs) 
+            (cl-ppcre:scan-to-strings "(http|https|ftp)://([\\w\\.-]+)" cmd)
+          (declare (ignore match))
+          (let ((domain (aref regs 1)))
+            (not (some (lambda (safe) (search safe domain)) network-whitelist))))))))
+
+(defun bouncer-check (action context)
+  "The 5-Vector security gate. Blocks or queues actions based on risk."
+  (let* ((target (getf action :target))
+         (payload (getf action :payload))
+         (text (or (getf payload :text) (getf action :text)))
+         ;; Extract cmd from direct shell or tool-mediated shell call
+         (cmd (or (getf payload :cmd)
+                  (when (and (eq target :tool) (equal (getf payload :tool) "shell"))
+                    (getf (getf payload :args) :cmd))))
+         (approved (getf action :approved)))
+    
+    (cond
+      ;; 0. Bypass for already approved actions
+      (approved action)
+
+      ;; 1. Secret Exposure Vector (Hard Block)
+      ((and text (bouncer-scan-secrets text))
+       (let ((secret-name (bouncer-scan-secrets text)))
+         (harness-log "SECURITY VIOLATION: Blocked leak of secret ~a" secret-name)
+         `(:type :log :payload (:level :error :text ,(format nil "Action blocked: Potential exposure of ~a" secret-name)))))
+
+      ;; 2. Network Exfiltration Vector (Authorization Required)
+      ((and (or (eq target :shell) 
+                (and (eq target :tool) (equal (getf payload :tool) "shell")))
+            (bouncer-check-network-exfil cmd))
+       (harness-log "SECURITY WARNING: External network call detected. Queuing for approval.")
+       `(:type :EVENT :payload (:sensor :approval-required :action ,action)))
+
+      ;; 3. High-Impact Target Vector (Authorization Required)
+      ((or (member target '(:shell))
+           (and (eq target :tool) (member (getf payload :tool) '("shell" "repair-file") :test #'string=))
+           (and (eq target :EMACS) (eq (getf payload :action) :eval)))
+       (harness-log "SECURITY: High-impact action ~a requires approval." (or (getf payload :tool) target))
+       `(:type :EVENT :payload (:sensor :approval-required :action ,action)))
+
+      ;; 4. Default Pass
+      (t action))))
+
+(defun bouncer-process-approvals ()
+  "Scans the object store for APPROVED flight plans and re-injects their actions."
+  (let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
+        (found-any nil))
+    (dolist (node approved-nodes)
+      (let* ((tags (getf (org-object-attributes node) :TAGS))
+             (action-str (getf (org-object-attributes node) :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
+              ;; Mark as approved to bypass the gate
+              (setf (getf action :approved) t)
+              (inject-stimulus action)
+              ;; Mark as DONE
+              (setf (getf (org-object-attributes node) :TODO) "DONE")
+              (setq found-any t))))))
+    found-any))
+
+(defun bouncer-deterministic-gate (action context)
+  "Main gate for the bouncer skill."
+  (let* ((payload (getf context :payload))
+         (sensor (getf payload :sensor)))
+    (case sensor
+      (:approval-required
+       (let* ((blocked-action (getf payload :action))
+              (id (org-id-new)))
+         (harness-log "BOUNCER: Creating flight plan node...")
+         ;; Create the node in Emacs (or inbox)
+         (list :type :REQUEST :target :EMACS :action :insert-node 
+               :id id :attributes `(:TITLE "Flight Plan: High-Risk Action" 
+                                    :TODO "PLAN" 
+                                    :TAGS ("FLIGHT_PLAN")
+                                    :ACTION ,(format nil "~s" blocked-action)))))
+      (:heartbeat
+       ;; Periodically check for approvals
+       (bouncer-process-approvals)
+       (if action (bouncer-check action context) action))
+      (otherwise
+       (if action (bouncer-check action context) action)))))
+
+(defskill :skill-bouncer
+  :priority 150
+  :trigger (lambda (ctx) t) ;; Bouncer evaluates all actions deterministically
+  :probabilistic nil
+  :deterministic #'bouncer-deterministic-gate)

library/gen/org-skill-cli-gateway.lisp

@@ -0,0 +1,81 @@
+(defvar *cli-port* 9105)
+(defvar *cli-server-socket* nil)
+(defvar *cli-server-thread* nil)
+
+(defun execute-cli-action (action context)
+  "Sends a framed message back to the connected CLI client."
+  (let* ((payload (proto-get action :PAYLOAD))
+         (meta (getf context :meta))
+         (stream (getf meta :reply-stream)))
+    (handler-case
+        (if (and stream (open-stream-p stream))
+            (progn
+              (format stream "~a" (frame-message action))
+              (finish-output stream)
+              (format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING)))
+              (finish-output stream))
+            (harness-log "CLI ERROR: No active or open reply stream for signal."))
+      (error (c) (harness-log "CLI ACTUATOR ERROR: ~a" c)))))
+
+(defun handle-cli-slash-command (cmd stream)
+  (cond
+    ((string= cmd "/exit") (return-from handle-cli-slash-command :exit))
+    (t (format stream "~a" (frame-message (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (format nil "Unknown command: ~a" cmd))))))))
+
+(defun handle-cli-client (stream)
+  "Reads framed messages from a CLI client and injects them as stimuli."
+  (harness-log "CLI: Client connected.")
+  (handler-case
+      (progn
+        ;; 1. Send Handshake
+        (format stream "~a" (frame-message (make-hello-message "0.1.0")))
+        (finish-output stream)
+        (format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING)))
+        (finish-output stream)
+        
+        ;; 2. Communication Loop
+        (loop
+          (let ((msg (read-framed-message stream)))
+            (cond ((eq msg :eof) (return))
+                  ((eq msg :error) (return))
+                  (t (let* ((payload (proto-get msg :payload))
+                            (text (proto-get payload :text))
+                            (meta (proto-get msg :meta)))
+                       (if (and text (stringp text) (char= (char text 0) #\/))
+                           (when (eq (handle-cli-slash-command text stream) :exit) (return))
+                           (progn
+                             ;; Default meta if missing
+                             (unless meta
+                               (setf (getf msg :meta) (list :SOURCE :CLI :SESSION-ID "default")))
+                             (harness-log "CLI: Received input -> ~s" msg)
+                             (inject-stimulus msg :stream stream)))))))))
+    (error (c) (harness-log "CLI CLIENT DISCONNECT: ~a" c)))
+  (harness-log "CLI: Client disconnected."))
+
+(defun start-cli-gateway (&optional (port *cli-port*))
+  "Starts the TCP listener for local CLI clients."
+  (setf *cli-server-socket* (usocket:socket-listen "0.0.0.0" port :reuse-address t))
+  (setf *cli-server-thread*
+        (bt:make-thread
+         (lambda ()
+           (unwind-protect
+                (loop
+                  (let* ((socket (usocket:socket-accept *cli-server-socket*))
+                         (stream (usocket:socket-stream socket)))
+                    (bt:make-thread (lambda () 
+                                      (unwind-protect (handle-cli-client stream)
+                                        (usocket:socket-close socket)))
+                                    :name "opencortex-cli-client-handler")))
+             (usocket:socket-close *cli-server-socket*)))
+         :name "opencortex-cli-gateway"))
+  (harness-log "CLI: Gateway listening on port ~a" port))
+
+(register-actuator :CLI #'execute-cli-action)
+
+(defskill :skill-gateway-cli
+  :priority 200
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil)
+  :probabilistic nil
+  :deterministic (lambda (action ctx) (declare (ignore ctx)) action))
+
+(start-cli-gateway)

library/gen/org-skill-credentials-vault.lisp

@@ -0,0 +1,82 @@
+(defun vault-get-secret (provider &key type)
+  "Retrieves a secret (api-key or session) for a provider.")
+
+(defun vault-set-secret (provider secret &key type)
+  "Securely stores a secret and triggers a Merkle snapshot.")
+
+
+
+(defvar opencortex::*vault-memory* (make-hash-table :test 'equal)
+  "In-memory cache of sensitive credentials.")
+
+(defun vault-mask-string (str)
+  "Returns a masked version of a sensitive string."
+  (if (and str (> (length str) 8))
+      (format nil "~a...~a" (subseq str 0 4) (subseq str (- (length str) 4)))
+      "[REDACTED]"))
+
+(defun vault-get-secret (provider &key (type :api-key))
+  "Retrieves a credential. Type can be :api-key or :session."
+  (let* ((key (format nil "~a-~a" provider type))
+         (val (gethash key opencortex::*vault-memory*)))
+    (if val
+        val
+        ;; Fallback to environment
+        (let ((env-var (case provider
+                         ((:gemini :gemini-api) "GEMINI_API_KEY")
+                         (:openai "OPENAI_API_KEY")
+                         (:anthropic "ANTHROPIC_API_KEY")
+                         (:groq "GROQ_API_KEY")
+                         (:openrouter "OPENROUTER_API_KEY")
+                         (:telegram "TELEGRAM_BOT_TOKEN")
+                         (:signal "SIGNAL_ACCOUNT_NUMBER")
+                         (:matrix-homeserver "MATRIX_HOMESERVER")
+                         (:matrix-token "MATRIX_ACCESS_TOKEN")
+                         (t nil))))
+          (when (and env-var (eq type :api-key))
+            (uiop:getenv env-var))))))
+
+(defun vault-set-secret (provider secret &key (type :api-key))
+  "Securely stores a secret and triggers a Merkle snapshot."
+  (let ((key (format nil "~a-~a" provider type)))
+    (setf (gethash key opencortex::*vault-memory*) secret)
+    (harness-log "VAULT - Updated ~a for ~a. Triggering Merkle snapshot..." type provider)
+    (snapshot-memory)
+    t))
+
+(defun vault-onboard-gemini-web ()
+  "Instructions for the Autonomous Cookie Handshake."
+  (harness-log "--- GEMINI WEB ONBOARDING ---")
+  (harness-log "1. Visit gemini.google.com")
+  (harness-log "2. Run the 'Get Gemini Cookies' Bookmarklet.")
+  (harness-log "   CODE: javascript:(function(){const c=document.cookie.split('; ').reduce((r,v)=>{const [n,val]=v.split('=');r[n]=val;return r},{});const target=['__Secure-1PSID','__Secure-1PSIDTS'];const out=target.map(n=>({name:n,value:c[n]}));prompt('Copy JSON:',JSON.stringify(out));})();")
+  (harness-log "PLATFORM GUIDE: Chrome/Firefox/Safari all support Bookmarklets via 'Add Page' or 'New Bookmark'.")
+  t)
+
+(progn
+  (defskill :skill-credentials-vault
+    :priority 200 ; High priority, foundational
+    :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :onboarding-request))
+    :probabilistic nil
+    :deterministic (lambda (action ctx) 
+                (vault-onboard-gemini-web)
+                action)))
+
+#|
+(defpackage :opencortex-vault-tests
+  (:use :cl :fiveam :opencortex))
+(in-package :opencortex-vault-tests)
+
+(def-suite vault-suite :description "Tests for the Credentials Vault.")
+(in-suite vault-suite)
+
+(test test-masking
+  (is (equal "sk-t...-key" (opencortex::vault-mask-string "sk-test-key")))
+  (is (equal "[REDACTED]" (opencortex::vault-mask-string "short"))))
+
+(test test-vault-persistence
+  "Verify that setting a secret triggers a snapshot (mock check)."
+  (let ((old-version (opencortex::org-object-version (gethash "root" *memory*))))
+    (opencortex:vault-set-secret :test "secret-val")
+    (is (> (opencortex::org-object-version (gethash "root" *memory*)) old-version))))
+|#

library/gen/org-skill-gardener.lisp

@@ -0,0 +1,68 @@
+(in-package :opencortex)
+
+(defvar *gardener-last-audit* 0
+  "The universal-time of the last full Memex audit.")
+
+(defun gardener-find-broken-links ()
+  "Returns a list of broken ID links found in the Memex."
+  (let ((broken nil))
+    (maphash (lambda (id obj)
+               (let ((content (org-object-content obj)))
+                 (when content
+                   (cl-ppcre:do-register-groups (target-id) ("id:([A-Za-z0-9-]+)" content)
+                     (unless (lookup-object target-id)
+                       (push (list :source id :broken-target target-id) broken))))))
+             *memory*)
+    broken))
+
+(defun gardener-find-orphans ()
+  "Returns a list of IDs for headlines that are structurally isolated."
+  (let ((inbound (make-hash-table :test 'equal))
+        (outbound (make-hash-table :test 'equal))
+        (orphans nil))
+    ;; 1. Map all connections
+    (maphash (lambda (id obj)
+               (let ((content (org-object-content obj)))
+                 (when content
+                   (cl-ppcre:do-register-groups (target-id) ("id:([A-Za-z0-9-]+)" content)
+                     (setf (gethash id outbound) t)
+                     (setf (gethash target-id inbound) t)))))
+             *memory*)
+    ;; 2. Identify nodes with zero connections
+    (maphash (lambda (id obj)
+               (declare (ignore obj))
+               (unless (or (gethash id inbound) (gethash id outbound))
+                 (push id orphans)))
+             *memory*)
+    orphans))
+
+(defun gardener-deterministic-gate (action context)
+  "Main gate for the Gardener skill. Audits graph integrity."
+  (declare (ignore action context))
+  (let ((broken (gardener-find-broken-links))
+        (orphans (gardener-find-orphans)))
+    
+    (when (or broken orphans)
+      (harness-log "GARDENER: Audit found ~a broken links and ~a orphans." 
+                   (length broken) (length orphans))
+      
+      (dolist (link broken)
+        (harness-log "  [BROKEN LINK] Node ~a -> ~a" (getf link :source) (getf link :broken-target)))
+      
+      (dolist (orphan orphans)
+        (harness-log "  [ORPHAN] Node ~a is isolated." orphan)))
+    
+    (setf *gardener-last-audit* (get-universal-time))
+    ;; Return a log to stop the loop
+    (list :type :LOG :payload (list :text "Gardener audit complete."))))
+
+(defskill :skill-gardener
+  :priority 40
+  :trigger (lambda (ctx)
+             (let* ((payload (getf ctx :payload))
+                    (sensor (getf payload :sensor)))
+               (and (eq sensor :heartbeat)
+                    ;; Only audit once per day
+                    (> (- (get-universal-time) *gardener-last-audit*) 86400))))
+  :probabilistic nil
+  :deterministic #'gardener-deterministic-gate)

library/gen/org-skill-homoiconic-memory.lisp

@@ -0,0 +1,28 @@
+(defun memory-org-to-json (source)
+  "Converts Org-mode source to JSON AST."
+  (declare (ignore source))
+  "")
+
+(defun memory-json-to-org (ast)
+  "Converts JSON AST back to Org-mode text."
+  (declare (ignore ast))
+  "")
+
+(defun memory-normalize-ast (ast)
+  "Recursively ensures ID uniqueness across the AST."
+  (declare (ignore ast))
+  nil)
+
+(defun make-memory-node (headline &key content properties children)
+  "Constructor for a normalized Org node alist."
+  (declare (ignore headline))
+  (list :TYPE :HEADLINE 
+        :PROPERTIES (or properties nil)
+        :CONTENT content 
+        :CONTENTS children))
+
+(defskill :skill-homoiconic-memory
+  :priority 100
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil)
+  :probabilistic nil
+  :deterministic (lambda (action ctx) (declare (ignore ctx)) action))

library/gen/org-skill-llama-backend.lisp

@@ -0,0 +1,33 @@
+(in-package :opencortex)
+
+(defun llama-inference (prompt system-prompt &key (model "local-model"))
+  "Sends a completion request to the local llama.cpp server."
+  (let ((endpoint (uiop:getenv "LLAMACPP_ENDPOINT")))
+    (unless endpoint
+      (harness-log "LLAMA ERROR: LLAMACPP_ENDPOINT not set in environment.")
+      (return-from llama-inference (list :error "LLAMACPP_ENDPOINT_MISSING")))
+
+    (handler-case
+        (let* ((full-prompt (format nil "System: ~a~%User: ~a~%Assistant:" system-prompt prompt))
+               (payload (cl-json:encode-json-to-string 
+                         `((:prompt . ,full-prompt)
+                           (:n_predict . 1024)
+                           (:stop . ("User:" "System:")))))
+               (response (dex:post (format nil "~a/completion" endpoint)
+                                   :content payload
+                                   :headers '(("Content-Type" . "application/json"))))
+               (data (cl-json:decode-json-from-string response)))
+          (cdr (assoc :content data)))
+      (error (c)
+        (harness-log "LLAMA ERROR: Connection failed -> ~a" c)
+        (list :error (format nil "~a" c))))))
+
+(progn
+  (register-probabilistic-backend :llama #'llama-inference)
+  (harness-log "LLAMA: Local backend registered and active."))
+
+(defskill :skill-llama-backend
+  :priority 50
+  :trigger (lambda (ctx) (declare (ignore ctx)) nil) ; Pure infrastructure skill
+  :probabilistic nil
+  :deterministic (lambda (action ctx) (declare (ignore ctx)) action))

library/gen/org-skill-llm-gateway.lisp

@@ -0,0 +1,110 @@
+(defun get-nested (alist &rest keys)
+  "Recursively extracts nested values from an alist, handling both objects and arrays."
+  (let ((val alist))
+    (dolist (k keys)
+      ;; Descend into arrays (cl-json style: ((key . val)) or ( ( (key . val) ) ))
+      (loop while (and (listp val) (listp (car val)) (not (keywordp (caar val))))
+            do (setf val (car val)))
+      (let ((pair (or (assoc k val)
+                      (assoc (intern (string-upcase (string k)) :keyword) val)
+                      (assoc (intern (string-downcase (string k)) :keyword) val))))
+        (if pair
+            (setf val (cdr pair))
+            (return-from get-nested nil))))
+    val))
+
+(defun execute-llm-request (prompt system-prompt &key provider model)
+  "Unified entry point for all LLM providers. Respects the global cascade."
+  (let* ((active-provider (or provider (car opencortex::*provider-cascade*) :openrouter))
+         (api-key (vault-get-secret active-provider :type :api-key))
+         (full-prompt (format nil "~a~%~%Prompt: ~a" system-prompt prompt)))
+
+    (harness-log "PROBABILISTIC ENGINE: Requesting ~a (Model: ~s)" 
+                active-provider (or model "default"))
+
+    ;; If the specifically requested provider has no key, try falling back to the cascade
+    (when (or (null api-key) (string= api-key ""))
+       (harness-log "GATEWAY: Provider ~a has no key. Cascade fallback would trigger here." active-provider)
+       (return-from execute-llm-request (list :status :error :message "API Key missing.")))
+
+    (case active-provider
+      (:gemini-web
+       (let ((res (uiop:symbol-call :opencortex.skills.org-skill-web-research :ask-gemini-web full-prompt)))
+         (if res (list :status :success :content res) (list :status :error :message "Web Research Failure"))))
+      
+      (:ollama
+       (let* ((host (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
+              (url (format nil "http://~a/api/generate" host))
+              (body (cl-json:encode-json-to-string `((model . ,(or model "llama3")) (prompt . ,full-prompt) (stream . :false)))))
+         (handler-case 
+             (progn
+               (harness-log "LLM DEBUG: Requesting Ollama...")
+               (let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body :connect-timeout 5 :read-timeout 60))
+                      (json (cl-json:decode-json-from-string response)))
+                 (list :status :success :content (cdr (assoc :response json)))))
+           (error (c) (list :status :error :message (format nil "Ollama Failure: ~a" c))))))
+
+      (t ;; Cloud Providers (Anthropic, Gemini API, Groq, OpenAI, OpenRouter)
+       (let* ((endpoint (case active-provider
+                          (:anthropic "https://api.anthropic.com/v1/messages")
+                          (:gemini-api (format nil "https://generativelanguage.googleapis.com/v1/models/~a:generateContent" (or model "gemini-1.5-flash-latest")))
+                          (:groq "https://api.groq.com/openai/v1/chat/completions")
+                          (:openai "https://api.openai.com/v1/chat/completions")
+                          (:openrouter "https://openrouter.ai/api/v1/chat/completions")))
+              (headers (case active-provider
+                         (:anthropic `(("Content-Type" . "application/json") ("x-api-key" . ,api-key) ("anthropic-version" . "2023-06-01")))
+                         (:gemini-api `(("Content-Type" . "application/json") ("x-goog-api-key" . ,api-key)))
+                         (:openrouter `(("Content-Type" . "application/json") ("Authorization" . ,(format nil "Bearer ~a" api-key)) 
+                                        ("HTTP-Referer" . "https://github.com/amr/opencortex") ("X-Title" . "opencortex Autonomous Kernel")))
+                         (t `(("Content-Type" . "application/json") ("Authorization" . ,(format nil "Bearer ~a" api-key))))))
+              (body (case active-provider
+                      (:anthropic (cl-json:encode-json-to-string `((model . ,(or model "claude-3-5-sonnet-20240620")) (max_tokens . 4096) (system . ,system-prompt) (messages . (( (role . "user") (content . ,prompt) ))))))
+                      (:gemini-api (cl-json:encode-json-to-string `((contents . (((parts . (((text . ,full-prompt))))))))))
+                      (t (cl-json:encode-json-to-string `((model . ,(or model (case active-provider (:groq "llama-3.3-70b-versatile") (t "google/gemini-2.0-flash-001"))))
+                                                         (messages . (( (role . "system") (content . ,system-prompt) ) ( (role . "user") (content . ,prompt) )))))))))
+         (handler-case 
+             (progn
+               (harness-log "LLM DEBUG: Requesting ~a..." active-provider)
+               (let* ((response (dex:post endpoint :headers headers :content body :connect-timeout 10 :read-timeout 30))
+                      (json (cl-json:decode-json-from-string response)))
+                 (let ((content (case active-provider
+                                  (:anthropic (get-nested json :content :text))
+                                  (:gemini-api (get-nested json :candidates :parts :text))
+                                  (t (get-nested json :choices :message :content)))))
+                   (if content
+                       (list :status :success :content content)
+                       (list :status :error :message (format nil "Failed to parse ~a response structure." active-provider))))))
+           (error (c) (list :status :error :message (format nil "LLM Gateway Failure (~a): ~a" active-provider c)))))))))
+
+;; Initialize Cascade
+(let* ((env-cascade (uiop:getenv "PROVIDER_CASCADE"))
+       (default-list '(:openrouter :openai :anthropic :groq :gemini-api :ollama))
+       (final-list (if (and env-cascade (not (string= env-cascade "")))
+                       (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
+                               (uiop:split-string env-cascade :separator '(#\,)))
+                       default-list)))
+  (setf opencortex::*provider-cascade* final-list)
+  (opencortex:harness-log "PROBABILISTIC: Neural Cascade Initialized -> ~a" final-list))
+
+;; Register Providers
+(dolist (p '(:anthropic :gemini-api :gemini-web :groq :ollama :openrouter :openai))
+  (opencortex:register-probabilistic-backend p (lambda (prompt system-prompt &key model)
+                                        (execute-llm-request prompt system-prompt :provider p :model model))))
+
+(def-cognitive-tool :ask-llm 
+  "Queries an LLM provider via the unified gateway."
+  ((:prompt :type :string :description "The user prompt.")
+   (:system-prompt :type :string :description "The system instructions.")
+   (:provider :type :keyword :description "Optional specific provider.")
+   (:model :type :string :description "Optional specific model ID."))
+  :body (lambda (args)
+          (execute-llm-request (getf args :prompt) 
+                               (or (getf args :system-prompt) "You are a helpful assistant.")
+                               :provider (getf args :provider)
+                               :model (getf args :model))))
+
+(defskill :skill-llm-gateway
+  :priority 150
+  :trigger (lambda (context) (declare (ignore context)) nil)
+  :probabilistic (lambda (context) (declare (ignore context)) nil)
+  :deterministic (lambda (action context) (declare (ignore context)) action))

library/gen/org-skill-peripheral-vision.lisp

@@ -0,0 +1,76 @@
+(defun context-render-to-org (obj &key depth foveal-id semantic-threshold foveal-vector)
+  "Recursively renders an org-object with foveal-peripheral pruning.")
+
+(defun context-assemble-global-awareness (&optional signal)
+  "Assembles the full context block for a neural request.")
+
+(defun context-render-to-org (obj &key (depth 1) (foveal-id nil) (semantic-threshold 0.75) (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))
+         (similarity (if (and foveal-vector obj-vector (not is-foveal))
+                         (cosine-similarity foveal-vector obj-vector)
+                         0.0))
+         (is-semantically-relevant (>= similarity semantic-threshold))
+         ;; We always render depth 1 and 2 (Projects and main tasks).
+         ;; We always render the foveal node and its immediate children.
+         ;; We render deeper nodes ONLY if they are semantically relevant.
+         (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 (and is-semantically-relevant (> similarity 0))
+        (setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity))))
+      (setf output (concatenate 'string output (format nil ":END:~%")))
+      
+      ;; Only include full body content if this is the Foveal focus or highly relevant
+      (when (and content (or is-foveal is-semantically-relevant))
+        (setf output (concatenate 'string output content (string #\Newline))))
+      
+      ;; Recursively render children
+      (dolist (child-id children)
+        (let ((child-obj (lookup-object child-id)))
+          (when child-obj
+            ;; If the current node is Foveal, its children should be rendered (depth effectively resets)
+            (let ((next-foveal (if is-foveal child-id foveal-id)))
+              (setf output (concatenate 'string output 
+                                        (context-render-to-org child-obj 
+                                                               :depth (1+ depth) 
+                                                               :foveal-id next-foveal
+                                                               :semantic-threshold semantic-threshold
+                                                               :foveal-vector foveal-vector))))))))
+    output))
+
+(defun context-assemble-global-awareness (&optional signal)
+  "Produces a high-level skeletal outline of the current Memory for the LLM."
+  (let* ((payload (when signal (getf signal :payload)))
+         (foveal-id (when payload (getf payload :target-id)))
+         (foveal-vector (when foveal-id (org-object-vector (lookup-object foveal-id))))
+         (projects (context-get-active-projects))
+         (output "GLOBAL MEMEX AWARENESS (Peripheral Vision):
+"))
+    (if projects
+        (dolist (project projects)
+          (setf output (concatenate 'string output
+                                    (context-render-to-org project 
+                                                           :foveal-id foveal-id 
+                                                           :foveal-vector foveal-vector))))
+        (setf output (concatenate 'string output "No active projects found.~%")))
+    output))
+
+(defskill :skill-peripheral-vision
+  :priority 90
+  :dependencies ("org-skill-embedding")
+  :trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:perceive :context-refresh)))
+  :probabilistic nil
+  :deterministic (lambda (action ctx)
+              (declare (ignore action ctx))
+              ;; This skill primarily provides the context-assemble-global-awareness function
+              ;; used by the probabilistic-gate, rather than handling specific actions.
+              nil))

library/gen/org-skill-policy.lisp

@@ -0,0 +1,25 @@
+(in-package :opencortex)
+
+(defun policy-check-autonomy (action context)
+  "Ensures the action does not violate the Autonomy invariant."
+  (declare (ignore context))
+  ;; Implementation placeholder: currently permits all actions.
+  ;; Future: Scan for non-autonomous domain names or proprietary API endpoints.
+  action)
+
+(defun policy-deterministic-gate (action context)
+  "The main policy gate. Sub-calls engineering standards if available."
+  (let ((current-action (policy-check-autonomy action context)))
+    (when current-action
+      (let ((eng-pkg (find-package :opencortex.skills.org-skill-engineering-standards)))
+        (when eng-pkg
+          (let ((eng-gate (find-symbol "ENGINEERING-STANDARDS-GATE" eng-pkg)))
+            (when (and eng-gate (fboundp eng-gate))
+              (setf current-action (funcall (symbol-function eng-gate) current-action context)))))))
+    current-action))
+
+(defskill :skill-policy
+  :priority 100
+  :trigger (lambda (ctx) t)
+  :probabilistic nil
+  :deterministic #'policy-deterministic-gate)

library/gen/org-skill-protocol-validator.lisp

@@ -0,0 +1,39 @@
+(in-package :opencortex)
+
+(defun validate-communication-protocol-schema (msg)
+  "Strict structural validation for incoming communication protocol messages."
+  (unless (listp msg)
+    (error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
+  
+  (let ((type (let ((raw (proto-get msg :type))) (if (keywordp raw) (intern (string-upcase (string raw)) :keyword) raw))))
+    (unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS :CHAT))
+      (progn (harness-log "REJECTED MSG: ~s" msg) (error "Communication Protocol Schema Error: Invalid message type '~a'" type)))
+    
+    (case type
+      (:REQUEST 
+       (unless (proto-get msg :target)
+         (error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
+       (unless (proto-get msg :payload)
+         (error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))
+      
+      (:EVENT
+       (let ((payload (proto-get msg :payload)))
+         (unless (and payload (listp payload))
+           (error "Communication Protocol Schema Error: EVENT missing or invalid :payload"))
+         (unless (or (proto-get payload :action) (proto-get payload :sensor))
+           (error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor"))))
+      
+      (:RESPONSE
+       (unless (proto-get msg :payload)
+         (error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
+    
+    t))
+
+(defskill :skill-communication-protocol-validator
+  :priority 95
+  :trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
+  :probabilistic nil
+  :deterministic (lambda (action ctx)
+              (declare (ignore ctx))
+              (validate-communication-protocol-schema action)
+              action))

library/gen/org-skill-scribe.lisp

@@ -0,0 +1,108 @@
+(in-package :opencortex)
+
+(defvar *scribe-last-checkpoint* 0
+  "The universal-time of the last successful distillation run.")
+
+(defun scribe-load-state ()
+  "Loads the scribe checkpoint from the state directory."
+  (let ((state-file (uiop:merge-pathnames* "state/scribe-checkpoint.lisp" (asdf:system-source-directory :opencortex))))
+    (if (uiop:file-exists-p state-file)
+        (setf *scribe-last-checkpoint* (read-from-string (uiop:read-file-string state-file)))
+        (setf *scribe-last-checkpoint* 0))))
+
+(defun scribe-save-state ()
+  "Saves the current universal-time as the new checkpoint."
+  (let ((state-file (uiop:merge-pathnames* "state/scribe-checkpoint.lisp" (asdf:system-source-directory :opencortex))))
+    (ensure-directories-exist state-file)
+    (with-open-file (out state-file :direction :output :if-exists :supersede)
+      (format out "~a" (get-universal-time)))))
+
+(defun scribe-get-distillable-nodes ()
+  "Returns a list of org-objects from the daily/ folder that require distillation."
+  (let ((results nil))
+    (maphash (lambda (id obj)
+               (declare (ignore id))
+               (let* ((attrs (org-object-attributes obj))
+                      (tags (getf attrs :TAGS))
+                      (type (org-object-type obj))
+                      (version (org-object-version obj)))
+                 (when (and (eq type :HEADLINE)
+                            (> version *scribe-last-checkpoint*)
+                            (not (member "@personal" tags :test #'string-equal)))
+                   (push obj results))))
+             *memory*)
+    results))
+
+(defun probabilistic-skill-scribe (context)
+  "Generates the extraction prompt for the Scribe."
+  (let* ((payload (getf context :payload))
+         (nodes (scribe-get-distillable-nodes)))
+    (if nodes
+        (let ((text-to-process ""))
+          (dolist (node nodes)
+            (setf text-to-process (concatenate 'string text-to-process 
+                                               (format nil "ID: ~a~%TITLE: ~a~%CONTENT: ~a~%---~%" 
+                                                       (org-object-id node)
+                                                       (getf (org-object-attributes node) :TITLE)
+                                                       (org-object-content node)))))
+          (format nil "DISTILLATION TASK:
+Below are raw chronological logs from my daily journal.
+Extract ATOMIC EVERGREEN NOTES from this text.
+
+RULES:
+1. One note per distinct concept.
+2. Output a list of Lisp plists: ((:title \"...\" :content \"...\" :source-id \"...\") ...)
+3. The content should be in Org-mode format.
+4. Keep titles descriptive and snake_case.
+
+TEXT:
+~a" text-to-process))
+        nil)))
+
+(defun scribe-commit-notes (proposals)
+  "Writes proposed atomic notes to the notes/ directory. Appends if the note exists."
+  (let ((notes-dir (uiop:merge-pathnames* "notes/" (asdf:system-source-directory :opencortex))))
+    (ensure-directories-exist notes-dir)
+    (dolist (note proposals)
+      (let* ((title (getf note :title))
+             (content (getf note :content))
+             (source-id (getf note :source-id))
+             (filename (format nil "~a.org" (string-downcase (cl-ppcre:regex-replace-all " " title "_"))))
+             (path (merge-pathnames filename notes-dir)))
+        (if (uiop:file-exists-p path)
+            (with-open-file (out path :direction :output :if-exists :append)
+              (format out "~%~%* Appended insight from ~a~%~a" source-id content))
+            (with-open-file (out path :direction :output :if-exists :supersede)
+              (format out ":PROPERTIES:~%:ID: ~a~%:SOURCE_ID: ~a~%:END:~%#+TITLE: ~a~%~%~a" 
+                      (org-id-new) source-id title content)))
+        (harness-log "SCRIBE: Processed evergreen note ~a" filename)))))
+
+(defun verify-skill-scribe (action context)
+  "Executes the note creation and marks source nodes as distilled."
+  (declare (ignore context))
+  (let ((data (cond ((and (listp action) (eq (getf action :type) :REQUEST))
+                     (getf (getf action :payload) :payload))
+                    ((and (listp action) (not (member (getf action :type) '(:LOG :EVENT))))
+                     action)
+                    (t nil))))
+    (when data
+      (harness-log "SCRIBE: Committing ~a atomic notes..." (length data))
+      (scribe-commit-notes data)
+      (scribe-save-state)
+      (harness-log "SCRIBE: Distillation complete.")
+      ;; Return a log event to stop the loop
+      (list :type :LOG :payload (list :text "Distillation successful.")))))
+
+(defskill :skill-scribe
+  :priority 50
+  :trigger (lambda (ctx)
+             (let* ((payload (getf ctx :payload))
+                    (sensor (getf payload :sensor)))
+               (and (eq sensor :heartbeat)
+                    ;; Only run once per hour to check if we need to distill
+                    (> (- (get-universal-time) *scribe-last-checkpoint*) 3600)
+                    (scribe-get-distillable-nodes))))
+  :probabilistic #'probabilistic-skill-scribe
+  :deterministic #'verify-skill-scribe)
+
+(scribe-load-state)

library/gen/org-skill-shell-actuator.lisp

@@ -0,0 +1,56 @@
+(defparameter *allowed-commands* '("ls" "git" "rg" "grep" "date" "echo" "cat" "node" "python3" "sbcl"))
+
+(defparameter *shell-metacharacters* '(#\; #\& #\| #\> #\< #\$ #\` #\\ #\!))
+
+(defun shell-command-safe-p (cmd-string)
+  "Returns T if the command string contains no dangerous metacharacters."
+  (not (some (lambda (char) (find char cmd-string)) *shell-metacharacters*)))
+
+(defun execute-shell-safely (action context)
+  (let* ((payload (getf action :PAYLOAD))
+         (cmd-string (getf payload :cmd))
+         (executable (car (uiop:split-string (string-trim " " cmd-string) :separator '(#\Space)))))
+    
+    (cond
+      ((not (shell-command-safe-p cmd-string))
+       (opencortex:inject-stimulus 
+        `(:TYPE :EVENT :PAYLOAD (:SENSOR :shell-response :cmd ,cmd-string :stdout "" :stderr "ERROR - Security Violation: Dangerous metacharacters detected." :exit-code 1))
+        :stream (getf context :reply-stream)))
+      
+      ((not (member executable *allowed-commands* :test #'string=))
+       (opencortex:inject-stimulus 
+        `(:TYPE :EVENT :PAYLOAD (:SENSOR :shell-response :cmd ,cmd-string :stdout "" :stderr "ERROR - Command not in security whitelist." :exit-code 1))
+        :stream (getf context :reply-stream)))
+      
+      (t
+       (multiple-value-bind (stdout stderr exit-code)
+           (uiop:run-program cmd-string :output :string :error-output :string :ignore-error-status t)
+         (opencortex:inject-stimulus 
+          `(:TYPE :EVENT :PAYLOAD (:SENSOR :shell-response :cmd ,cmd-string :stdout ,(or stdout "") :stderr ,(or stderr "") :exit-code ,exit-code))
+          :stream (getf context :reply-stream)))))))
+
+(defun trigger-skill-shell-actuator (context)
+  (let ((type (getf context :TYPE))
+        (payload (getf context :PAYLOAD)))
+    (and (eq type :EVENT)
+         (eq (getf payload :SENSOR) :shell-response))))
+
+(defun probabilistic-skill-shell-actuator (context)
+  (let* ((p (getf context :PAYLOAD))
+         (cmd (getf p :cmd))
+         (stdout (getf p :stdout))
+         (stderr (getf p :stderr))
+         (exit-code (getf p :exit-code)))
+    (format nil "SHELL COMMAND RESULT:
+Command: ~a
+Exit Code: ~a
+STDOUT: ~a
+STDERR: ~a" cmd exit-code stdout stderr)))
+
+(opencortex:register-actuator :shell #'execute-shell-safely)
+
+(defskill :skill-shell-actuator
+  :priority 80
+  :trigger #'trigger-skill-shell-actuator
+  :probabilistic #'probabilistic-skill-shell-actuator
+  :deterministic (lambda (action context) (declare (ignore context)) action))

library/loop.lisp

@@ -0,0 +1,76 @@
+(in-package :opencortex)
+
+(defvar *interrupt-flag* nil)
+(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock"))
+(defvar *heartbeat-thread* nil)
+
+(defun process-signal (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 depth reached.") (return nil))
+        (when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
+          (harness-log "METABOLISM: Interrupted.")
+          (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
+          (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)))
+                ;; feedback generation
+                (if feedback
+                    (progn
+                      ;; Inherit meta from trigger signal
+                      (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)
+              ;; Only rollback on critical errors, not standard tool or loop errors
+              (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)))))))))))
+
+(defun start-heartbeat ()
+  "Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL."
+  (let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
+    (setf *heartbeat-thread* 
+          (bt:make-thread 
+           (lambda () 
+             (loop 
+               (sleep interval) 
+               ;; inject-stimulus is synchronous for heartbeats, preventing accumulation.
+               (inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time)))))) 
+           :name "opencortex-heartbeat"))))
+
+(defun main ()
+  "Entry point for the Skeleton MVP. Handles initialization and graceful shutdown."
+  (let* ((home (uiop:getenv "HOME"))
+         (env-file (uiop:merge-pathnames* ".local/share/opencortex/.env" (uiop:ensure-directory-pathname home))))
+    (when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file)))
+  
+  (initialize-actuators)
+  (initialize-all-skills)
+
+  (start-heartbeat)
+  
+  ;; Graceful shutdown handler for SBCL
+  #+sbcl
+  (sb-sys:enable-interrupt sb-unix:sigint 
+                           (lambda (sig code scp) 
+                             (declare (ignore sig code scp)) 
+                             (harness-log "SHUTDOWN: SIGINT received. Exiting...")
+                             (uiop:quit 0)))
+
+  (let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
+    (loop 
+      (when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (return))
+      (sleep sleep-interval))))

library/memory.lisp

@@ -0,0 +1,115 @@
+(in-package :opencortex)
+
+(defvar *memory* (make-hash-table :test 'equal))
+
+(defvar *history-store* (make-hash-table :test 'equal)
+  "Immutable Merkle-Tree versioning store mapping hashes to objects.")
+
+(defstruct org-object
+  id type attributes content vector parent-id children version last-sync hash)
+
+(defun compute-merkle-hash (id type attributes content child-hashes)
+  "Computes a SHA-256 Merkle hash for a node based on its core properties and children's 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)
+  "Parses an Org AST into the recursive Lisp Memory with Merkle hashing."
+  (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 (cl:getf ast :raw-content) ""))))
+         (should-embed (and raw-content (equal (getf props :EMBED) "t")))
+         (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-id-val child-id))
+             (let ((child-obj (lookup-object child-id-val)))
+               (when child-obj (push (org-object-hash child-obj) child-hashes)))))))
+    (setf child-ids (nreverse child-ids))
+    (setf child-hashes (nreverse child-hashes))
+    (let* ((hash (compute-merkle-hash id type props raw-content child-hashes))
+           (existing-obj (gethash hash *history-store*))
+           (obj (or existing-obj
+                    (make-org-object 
+                     :id id :type type :attributes props :content raw-content
+                     :vector (when should-embed (get-embedding 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 *history-store*) obj))
+      (setf (gethash id *memory*) obj)
+      id)))
+
+(defvar *object-store-snapshots* nil)
+
+(defun copy-hash-table (hash-table)
+  "Creates a shallow 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 lightweight, Copy-on-Write snapshot using Merkle-Tree pointers."
+  (let ((snapshot (copy-hash-table *memory*)))
+    (push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
+    (when (> (length *object-store-snapshots*) 20)
+      (setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))
+    (harness-log "MEMORY - CoW Memory snapshot created.")))
+
+(defun rollback-memory (&optional (index 0))
+  "Restores the Memory to a previously captured snapshot using immutable history pointers."
+  (let ((snapshot (nth index *object-store-snapshots*)))
+    (if snapshot
+        (progn (setf *memory* (copy-hash-table (getf snapshot :data)))
+               (harness-log "MEMORY - Memory rolled back to snapshot ~a" index))
+        (harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
+
+(defun org-id-new ()
+  "Generates a new UUID string for Org-mode identification."
+  (string-downcase (format nil "~a" (uuid:make-v4-uuid))))
+
+(defun lookup-object (id) 
+  "Retrieves an object from the store by its unique ID."
+  (gethash id *memory*))
+
+(defun list-objects-by-type (type)
+  "Returns a list of all objects matching a specific Org element type."
+  (let ((results nil))
+    (maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *memory*)
+    results))
+(defun list-objects-with-attribute (attr-name value)
+  "Returns a list of all objects where ATTR-NAME matches VALUE."
+  (let ((results nil))
+    (maphash (lambda (id obj)
+               (declare (ignore id))
+               (let ((attrs (org-object-attributes obj)))
+                 (when (equal (getf attrs attr-name) value)
+                   (push obj results))))
+             *memory*)
+    results))
+
+(defun find-headline-missing-id (ast)
+  "Traverses an AST to find headlines that lack an :ID: property."
+  (when (listp ast)
+    (if (and (eq (getf ast :type) :HEADLINE) (not (getf (getf ast :properties) :ID)))
+        ast
+        (cl:some #'find-headline-missing-id (getf ast :contents)))))
+
+(defun file-name-nondirectory (path)
+  "Extracts the filename from a full path string."
+  (let ((pos (position #\/ path :from-end t))) (if pos (subseq path (1+ pos)) path)))

library/package.lisp

@@ -0,0 +1,185 @@
+(defpackage :opencortex
+  (:use :cl)
+  (:export 
+   ;; --- communication protocol ---
+   #: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
+   
+   ;; --- Daemon Lifecycle ---
+   #:start-daemon
+   #:stop-daemon
+   #:harness-log
+   #:main
+   
+   ;; --- Memory (CLOSOS) ---
+   #: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 API (Peripheral Vision) ---
+   #: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
+   #:harness-track-telemetry
+   #:context-assemble-global-awareness
+   
+   ;; --- Reactive Signal Pipeline ---
+   #:process-signal
+   #:perceive-gate
+   #:probabilistic-gate
+   #:consensus-gate
+   #:act-gate
+   #:reason-gate
+   #:perceive-gate
+   #:dispatch-gate
+   #:inject-stimulus
+   #:initialize-actuators
+   #:dispatch-action
+   #:register-actuator
+   
+   ;; --- Skill Engine ---
+   #:load-skill-from-org
+   #:initialize-all-skills
+   #:load-skill-with-timeout
+   #:topological-sort-skills
+   #:validate-lisp-syntax
+   #:defskill
+   #:*skills-registry*
+   #:skill
+   #:skill-name
+   #:skill-priority
+   #:skill-dependencies
+   #:skill-trigger-fn
+   #:skill-probabilistic-prompt
+   #:skill-deterministic-fn
+
+   ;; --- Tool Registry ---
+   #:def-cognitive-tool
+   #:*cognitive-tools*
+   #:cognitive-tool
+   #:cognitive-tool-name
+   #:cognitive-tool-description
+   #:cognitive-tool-parameters
+   #:cognitive-tool-guard
+   #:cognitive-tool-body
+
+   ;; --- Emacs Client Registry ---
+   #:*emacs-clients*
+   #:*clients-lock*
+   #:register-emacs-client
+   #:unregister-emacs-client
+
+   ;; --- Probabilistic Engine ---
+   #:ask-probabilistic
+   #:register-probabilistic-backend
+   #:distill-prompt
+   #:*provider-cascade*
+   
+   ;; --- Security Vault ---
+   #:vault-get-secret
+   #:vault-set-secret
+   
+   ;; --- Deterministic Logic ---
+   #:list-objects-with-attribute
+   #:deterministic-verify
+   
+   ;; --- AST Helpers ---
+   #:find-headline-missing-id))
+
+(in-package :opencortex)
+
+(defun proto-get (plist key)
+  "Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
+  (let* ((s (string key))
+         (up (intern (string-upcase s) :keyword))
+         (dn (intern (string-downcase s) :keyword)))
+    (or (getf plist up) (getf plist dn))))
+
+(in-package :opencortex)
+
+(defun proto-get (plist key)
+  "Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
+  (let* ((s (string key))
+         (up (intern (string-upcase s) :keyword))
+         (dn (intern (string-downcase s) :keyword)))
+    (or (getf plist up) (getf plist dn))))
+
+(in-package :opencortex)
+
+(defvar *system-logs* nil)
+(defvar *logs-lock* (bt:make-lock "harness-logs-lock"))
+(defvar *max-log-history* 100)
+
+(defvar *skills-registry* (make-hash-table :test 'equal)
+  "Global registry of all loaded skills.")
+
+(defvar *skill-telemetry* (make-hash-table :test 'equal))
+(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock"))
+
+(defun harness-track-telemetry (skill-name duration status)
+  "Updates performance metrics for a specific skill. Status should be :success or :rejected."
+  (when skill-name 
+    (bt:with-lock-held (*telemetry-lock*)
+      (let ((entry (or (gethash skill-name *skill-telemetry*) (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 *skill-telemetry*) entry)))))
+
+(defvar *cognitive-tools* (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 new cognitive tool into the global registry. Parameters must be a list of property lists."
+  `(setf (gethash (string-downcase (string ',name)) *cognitive-tools*)
+         (make-cognitive-tool :name (string-downcase (string ',name))
+                              :description ,description
+                              :parameters ',parameters
+                              :guard ,guard
+                              :body ,body)))
+
+(defun harness-log (msg &rest args)
+  "Centralized logging for the harness."
+  (let ((formatted-msg (apply #'format nil msg args)))
+    (bt:with-lock-held (*logs-lock*)
+      (push formatted-msg *system-logs*)
+      (when (> (length *system-logs*) *max-log-history*)
+        (setq *system-logs* (subseq *system-logs* 0 *max-log-history*))))
+    (format t "~a~%" formatted-msg)
+    (finish-output)))

library/perceive.lisp

@@ -0,0 +1,60 @@
+(in-package :opencortex)
+
+(defvar *async-sensors* '(:chat-message :delegation :user-command)
+  "List of sensors that should be processed asynchronously to avoid blocking gateways.")
+
+(defvar *foveal-focus-id* nil
+  "The Org ID of the node the user is currently interacting with.")
+
+(defun inject-stimulus (raw-message &key stream (depth 0))
+  "Enqueues a raw message into the reactive signal 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 *async-sensors*))))
+    
+    ;; Ensure META exists and contains the stream if provided
+    (unless meta (setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
+    (when stream (setf (getf meta :reply-stream) stream))
+    (setf (getf raw-message :meta) meta)
+
+    (if async-p 
+        (bt:make-thread 
+         (lambda () 
+           (restart-case (handler-bind ((error (lambda (c) (harness-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event))))
+                           (process-signal raw-message)) 
+             (skip-event () nil))) 
+         :name "opencortex-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 perceive-gate (signal)
+  "Initial processing: Normalizes raw stimuli and updates memory."
+  (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 *foveal-focus-id* (ignore-errors (getf element :id)))
+                  (ingest-ast element))))
+             (:interrupt 
+              (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t)))))
+          ((eq type :RESPONSE)
+           (harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
+           
+    (setf (getf signal :status) :perceived)
+    (setf (getf signal :foveal-focus) *foveal-focus-id*)
+    signal))

library/reason.lisp

@@ -0,0 +1,116 @@
+(in-package :opencortex)
+
+(defvar *probabilistic-backends* (make-hash-table :test 'equal))
+(defvar *provider-cascade* nil)
+(defvar *model-selector-fn* nil)
+(defvar *consensus-enabled-p* nil)
+
+(defun register-probabilistic-backend (name fn)
+  "Registers a neural provider (e.g., :gemini, :anthropic) with its calling function."
+  (setf (gethash name *probabilistic-backends*) fn))
+
+(defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil))
+  "Dispatches a neural request through the provider cascade. Returns a Lisp plist or a failure log."
+  (let ((backends (or cascade *provider-cascade*)))
+    (or (dolist (backend backends)
+          (let ((backend-fn (gethash backend *probabilistic-backends*)))
+            (when backend-fn
+              (harness-log "PROBABILISTIC: Attempting backend ~a..." backend)
+              (let* ((model (when *model-selector-fn* (funcall *model-selector-fn* 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 strip-markdown (text)
+  "Strips common markdown code block markers from 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 think (context)
+  "Generates a Lisp action proposal based on current 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")))
+    (let* ((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."))))
+           (system-prompt (format nil "IDENTITY: ~a. MANDATE: Respond with ONE Lisp plist. ~a ~a RECENT_LOGS: ~a
+IMPORTANT: To reply to the user, you MUST use:
+(:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"<Response Text>\"))
+
+To call a tool, you MUST use:
+(:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"<name>\" :ARGS (:arg1 \"val\"))
+
+PROVIDER RULE: Always use the default cascade provider unless a specific model or capability is required for the task." 
+                                  assistant-name global-context tool-belt system-logs)))
+      (let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
+             (cleaned (strip-markdown thought))
+             (meta (proto-get context :meta))
+             (source (proto-get meta :source)))
+        (if (and cleaned (stringp cleaned))
+            (let ((*read-eval* nil))
+              (if (and (> (length cleaned) 0) (char= (char cleaned 0) #\())
+                  (handler-case 
+                      (let ((parsed (read-from-string cleaned)))
+                        (let ((type (proto-get parsed :TYPE))
+                              (target (or (proto-get parsed :TARGET) (proto-get parsed :target))))
+                          (cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
+                                 (unless (proto-get parsed :target) (setf (getf parsed :target) (or source :CLI)))
+                                 parsed)
+                                ;; Handle raw plists or lists of plists that look like tool calls or data
+                                ((or (eq target :TOOL) (eq target :tool) (getf parsed :TOOL) (getf parsed :tool)
+                                     (and (listp parsed) (listp (car parsed)) (keywordp (caar parsed))))
+                                 (list :TYPE :REQUEST :TARGET :TOOL :PAYLOAD parsed))
+                                (t (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))))
+                    (error (c) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
+                  (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
+            thought)))))
+
+(defun deterministic-verify (proposed-action context)
+  "Iterates through all skill deterministic-gates sorted by priority."
+  (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)))
+            (let ((original-type (proto-get current-action :type)))
+              (when (and (listp next-action) 
+                         (member (proto-get next-action :type) '(:LOG :EVENT :log :event))
+                         (or (not (member original-type '(:LOG :EVENT :log :event)))
+                             (not (eq next-action current-action))))
+                (harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
+                (return-from deterministic-verify next-action)))
+            (setf current-action next-action)))))
+    current-action))
+
+(defun reason-gate (signal)
+  "Unified Stage: Combines Probabilistic proposals and Deterministic verification."
+  (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 reason-gate signal))
+    (let ((candidate (think signal)))
+      (if candidate
+          (setf (getf signal :approved-action) (deterministic-verify candidate signal))
+          (setf (getf signal :approved-action) nil))
+      (setf (getf signal :status) :reasoned)
+      signal)))

library/skills.lisp

@@ -0,0 +1,284 @@
+(in-package :opencortex)
+
+(defun COSINE-SIMILARITY (v1 v2) 1.0) ; Stub
+(defun VAULT-MASK-STRING (s) "[MASKED]") ; Stub
+(defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
+
+
+(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn)
+
+(defvar *skill-catalog* (make-hash-table :test 'equal)
+  "A stateful tracking table for all skill files discovered in the environment.")
+
+(defstruct skill-entry 
+  filename 
+  (status :discovered) ;; :discovered, :loading, :ready, :failed
+  error-log
+  (load-time 0))
+
+(defun find-triggered-skill (context)
+  "Returns the highest priority skill whose trigger matches context AND has a probabilistic prompt."
+  (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))) 
+             *skills-registry*)
+    (first (sort triggered #'> :key #'skill-priority))))
+
+(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic)
+  "Registers a new skill into the global registry."
+  `(setf (gethash (string-downcase (string ,name)) *skills-registry*)
+         (make-skill :name (string-downcase (string ,name)) 
+                     :priority (or ,priority 10) 
+                     :dependencies ',dependencies
+                     :trigger-fn ,trigger 
+                     :probabilistic-prompt ,probabilistic 
+                     :deterministic-fn ,deterministic)))
+
+(defun resolve-skill-dependencies (skill-name)
+  "Recursively resolves dependencies for a given skill name."
+  (let ((resolved nil) (seen nil))
+    (labels ((visit (name) 
+               (unless (member name seen :test #'equal) 
+                 (push name seen)
+                 (let ((skill (gethash (string-downcase (string name)) *skills-registry*)))
+                   (when skill 
+                     (dolist (dep (skill-dependencies skill)) 
+                       (visit dep))))
+                 (push name resolved))))
+      (visit skill-name) 
+      (nreverse resolved))))
+
+(defun parse-skill-metadata (filepath)
+  "Extracts ID and DEPENDS_ON tags using robust regex scanning."
+  (let ((dependencies nil)
+        (id nil)
+        (content (uiop:read-file-string filepath)))
+    ;; Extract ID
+    (multiple-value-bind (match regs)
+        (ppcre:scan-to-strings "(?im:^:ID:\\s*([^\\s\\r\\n]+))" content)
+      (when match (setf id (aref regs 0))))
+    ;; Extract all DEPENDS_ON lines
+    (ppcre:do-register-groups (deps-string)
+        ("(?im:^#\\+DEPENDS_ON:\\s*(.*))" content)
+      (let ((deps (ppcre:split "\\s+" (string-trim " " deps-string))))
+        (setf dependencies (append dependencies (mapcar (lambda (s) (string-trim "[] " s)) deps)))))
+    (values id (remove-if (lambda (s) (= 0 (length s))) dependencies))))
+
+(defun topological-sort-skills (skills-dir)
+  "Returns a list of skill filepaths sorted by dependency (dependencies first)."
+  (let ((files (uiop:directory-files skills-dir "org-skill-*.org"))
+        (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)))
+        (multiple-value-bind (id deps) (parse-skill-metadata 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: ~a -> ~a" filename dep-filename)
+                               (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 validate-lisp-syntax (code-string)
+  "Checks if a string contains valid, readable Common Lisp forms."
+  (handler-case 
+      (let ((*read-eval* nil)) 
+        (with-input-from-string (stream (format nil "(progn ~a)" code-string))
+          (loop for form = (read stream nil :eof) until (eq form :eof)) 
+          (values t nil)))
+    (error (c) (values nil (format nil "~a" c)))))
+
+(defun load-skill-from-org (filepath)
+  "Parses and evaluates Lisp blocks from an Org file into a jailed package."
+  (let* ((skill-base-name (pathname-name filepath))
+         (entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))
+    (setf (skill-entry-status entry) :loading)
+    (setf (gethash skill-base-name *skill-catalog*) entry)
+    
+    (handler-case
+        (let* ((content (uiop:read-file-string filepath)) 
+               (lines (uiop:split-string content :separator '(#\Newline)))
+               (in-lisp-block nil) 
+               (lisp-code "") 
+               (pkg-name (intern (string-upcase (format nil "OPENCORTEX.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" (string-downcase clean-line))
+                     (setf in-lisp-block t))
+                    ((uiop:string-prefix-p "#+end_src" (string-downcase clean-line))
+                     (setf in-lisp-block nil))
+                    (in-lisp-block 
+                     (unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
+                                 (uiop:string-prefix-p ":END:" (string-upcase clean-line)))
+                       (setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
+          
+          (if (= (length lisp-code) 0)
+              (progn (setf (skill-entry-status entry) :ready) t)
+              (progn
+                (multiple-value-bind (valid-p err) (validate-lisp-syntax lisp-code)
+                  (unless valid-p (error "Syntax Error: ~a" err)))
+                (harness-log "HARNESS: Jailing skill '~a' in package ~a" skill-base-name pkg-name)
+                (unless (find-package pkg-name)
+                  (let ((new-pkg (make-package pkg-name :use '(:cl))))
+                    (use-package :opencortex new-pkg)))
+                (let ((*read-eval* nil) (*package* (find-package pkg-name)))
+                  (eval (read-from-string (format nil "(progn ~a)" lisp-code))))
+                (setf (skill-entry-status entry) :ready)
+                t)))
+      (error (c)
+        (let ((msg (format nil "~a" c)))
+          (harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name msg)
+          (setf (skill-entry-status entry) :failed)
+          (setf (skill-entry-error-log entry) msg)
+          nil)))))
+
+(defun load-skill-with-timeout (filepath timeout-seconds)
+  "Loads a skill Org file with a hard execution timeout."
+  (let* ((finished nil)
+         (thread (bt:make-thread (lambda () 
+                                   (if (load-skill-from-org filepath)
+                                       (setf finished t)
+                                       (setf finished :error)))
+                                 :name (format nil "loader-~a" (pathname-name filepath))))
+         (start-time (get-internal-real-time))
+         (timeout-units (truncate (* timeout-seconds internal-time-units-per-second))))
+    (loop 
+      (when (eq finished t) (return :success))
+      (when (eq finished :error) (return :error))
+      (unless (bt:thread-alive-p thread) (return :error))
+      (when (> (- (get-internal-real-time) start-time) timeout-units)
+        (harness-log "HARNESS: Timing out skill ~a..." (pathname-name filepath))
+        #+sbcl (sb-thread:terminate-thread thread)
+        #-sbcl (bt:destroy-thread thread)
+        (return :timeout))
+      (sleep 0.05))))
+
+(defun initialize-all-skills ()
+  "Scans the directory defined by SKILLS_DIR and hot-loads skills using topological order."
+  (let* ((env-path (uiop:getenv "SKILLS_DIR"))
+         (skills-dir-str (or env-path (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
+         (resolved-path (context-resolve-path skills-dir-str))
+         (skills-dir (if resolved-path (uiop:ensure-directory-pathname resolved-path) nil)))
+    
+    (unless (and skills-dir (uiop:directory-exists-p skills-dir))
+      (harness-log "HARNESS ERROR: Skills directory not found: ~a" skills-dir-str)
+      (return-from initialize-all-skills nil))
+
+    (let ((sorted-files (topological-sort-skills skills-dir)))
+      (let* ((mandatory-env (uiop:getenv "MANDATORY_SKILLS"))
+             (mandatory-skills (if mandatory-env 
+                                   (mapcar (lambda (s) (string-trim '(#\Space #\" #\') s)) 
+                                           (uiop:split-string mandatory-env :separator '( #\,)))
+                                   '("org-skill-policy" "org-skill-bouncer"))))
+        (dolist (req mandatory-skills)
+          (unless (member req sorted-files :key #'pathname-name :test #'string-equal)
+            (error "BOOT FAILURE: Mandatory skill '~a' not found in skills directory: ~a" req (uiop:native-namestring skills-dir))))
+      
+        (harness-log "==================================================")
+        (harness-log " LOADER: Initializing ~a skills..." (length sorted-files))
+      
+        (dolist (file sorted-files)
+          (let* ((skill-name (pathname-name file))
+                 (is-mandatory (member skill-name mandatory-skills :test #'string-equal)))
+            (harness-log " LOADER: Loading ~a..." skill-name)
+            (let ((status (load-skill-with-timeout file 5)))
+              (unless (eq status :success)
+                (if is-mandatory
+                    (error "BOOT FAILURE: Mandatory skill '~a' failed to load (Status: ~a)." skill-name status)
+                    (harness-log "LOADER WARNING: Skill '~a' failed to load." skill-name))))))
+      
+        (let ((ready 0) (failed 0))
+          (maphash (lambda (k v) 
+                     (declare (ignore k))
+                     (if (eq (skill-entry-status v) :ready) (incf ready) (incf failed)))
+                   *skill-catalog*)
+          (harness-log " LOADER: Boot Complete. [Ready: ~a] [Failed: ~a]" ready failed)
+          (harness-log "==================================================")
+          (values ready failed))))))
+
+(defun generate-tool-belt-prompt ()
+  "Aggregates all registered cognitive tools into a descriptive prompt."
+  (let ((output (format nil "AVAILABLE TOOLS:
+You can call tools by returning a Lisp plist: (:target :tool :action :call :tool <name> :args (...))
+
+EXAMPLES:
+(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\"))
+(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"autonomousty\"))
+(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\"))
+
+---
+" )))
+    (maphash (lambda (name tool)
+               (setf output (concatenate 'string output
+                                         (format nil "- ~a: ~a~%  Parameters: ~s~%~%"
+                                                 name
+                                                 (cognitive-tool-description tool)
+                                                 (cognitive-tool-parameters tool)))))
+             *cognitive-tools*)
+    output))
+
+(def-cognitive-tool :eval "Evaluates raw Common Lisp code in the harness image. Use this for complex calculations or internal state inspection."
+  ((:code :type :string :description "The Lisp code to evaluate"))
+  :guard (lambda (args context)
+           (declare (ignore context))
+           (let ((code (getf args :code)))
+             (let ((harness-pkg (find-package :opencortex.skills.org-skill-lisp-validator)))
+               (if harness-pkg 
+                   (uiop:symbol-call :opencortex.skills.org-skill-lisp-validator :lisp-validator-validate code)
+                   t))))
+  :body (lambda (args)
+          (let ((code (getf args :code)))
+            (handler-case (let ((result (eval (read-from-string code))))
+                            (format nil "~s" result))
+              (error (c) (format nil "ERROR: ~a" c))))))
+
+(def-cognitive-tool :grep-search "Searches for a pattern in the project files."
+  ((:pattern :type :string :description "The regex pattern to search for")
+   (:dir :type :string :description "Directory to search in (default is project root)"))
+  :body (lambda (args)
+          (let ((pattern (getf args :pattern))
+                (dir (or (getf args :dir) (uiop:getenv "MEMEX_DIR"))))
+            (uiop:run-program (list "grep" "-r" "-n" "--exclude-dir=node_modules" pattern dir) 
+                              :output :string :ignore-error-status t))))
+
+(def-cognitive-tool :shell "Executes a shell command on the local machine. Use this for file operations, system checks, or running tests."
+  ((:cmd :type :string :description "The full bash command to execute"))
+  :guard (lambda (args context)
+           (declare (ignore context))
+           (let ((cmd (getf args :cmd)))
+             (not (or (search "rm -rf /" cmd) (search ":(){ :|:& };:" cmd)))))
+  :body (lambda (args)
+          (let ((cmd (getf args :cmd)))
+            (multiple-value-bind (out err code)
+                (uiop:run-program (list "bash" "-c" cmd) :output :string :error-output :string :ignore-error-status t)
+              (format nil "EXIT-CODE: ~a~%~%STDOUT:~%~a~%~%STDERR:~%~a" code out err)))))

library/tui-client.lisp

@@ -0,0 +1,160 @@
+(in-package :cl-user)
+(defpackage :opencortex.tui
+  (:use :cl :croatoan)
+  (:export :main))
+(in-package :opencortex.tui)
+
+(defvar *daemon-host* "127.0.0.1")
+(defvar *daemon-port* 9105)
+(defvar *socket* nil)
+(defvar *stream* nil)
+(defvar *chat-history* (list))
+(defvar *status-text* "Connecting...")
+(defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t))
+(defvar *is-running* t)
+(defvar *queue-lock* (bt:make-lock))
+(defvar *incoming-msgs* nil)
+
+(defun enqueue-msg (msg)
+  (bt:with-lock-held (*queue-lock*)
+    (push msg *incoming-msgs*)))
+
+(defun dequeue-msgs ()
+  (bt:with-lock-held (*queue-lock*)
+    (let ((msgs (nreverse *incoming-msgs*)))
+      (setf *incoming-msgs* nil)
+      msgs)))
+
+(defun clean-keywords (msg)
+  (if (listp msg)
+      (let ((clean nil))
+        (loop for (k v) on msg by #'cddr
+              do (push (intern (string k) :keyword) clean)
+                 (push v clean))
+        (nreverse clean))
+      msg))
+
+(defun format-payload (payload)
+  "Extracts human-readable text from a protocol payload, handling nested tool calls."
+  (let* ((action (getf payload :ACTION))
+         (text (getf payload :TEXT))
+         (msg (getf payload :MESSAGE))
+         (tool (getf payload :TOOL))
+         (prompt (getf payload :PROMPT))
+         (args (getf payload :ARGS))
+         (result (getf payload :RESULT)))
+    (cond (text text)
+          (msg msg)
+          ((eq action :MESSAGE) (getf payload :TEXT))
+          ((and tool prompt) (format nil "THOUGHT [~a]: ~a" tool prompt))
+          ((and tool args) 
+           (let ((inner-prompt (or (getf args :PROMPT) (getf args :TEXT))))
+             (if inner-prompt
+                 (format nil "THOUGHT [~a]: ~a" tool inner-prompt)
+                 (format nil "CALL [~a] (ARGS: ~s)" tool args))))
+          (result (format nil "RESULT: ~a" result))
+          (t (format nil "~s" payload)))))
+
+(defun listen-thread ()
+  (loop while *is-running* do
+    (handler-case
+        (when (and *stream* (open-stream-p *stream*))
+          (let ((raw-msg (opencortex:read-framed-message *stream*)))
+            (unless (member raw-msg '(:eof :error))
+              (let* ((msg (clean-keywords raw-msg))
+                     (type (or (getf msg :TYPE) (getf msg :type)))
+                     (payload (or (getf msg :PAYLOAD) (getf msg :payload))))
+                (cond ((and (listp msg) (eq type :EVENT))
+                       (let ((action (or (getf payload :ACTION) (getf payload :action)))
+                             (text (or (getf payload :TEXT) (getf payload :text) (getf payload :MESSAGE) (getf payload :message))))
+                         (cond ((eq action :handshake) (setf *status-text* "Ready"))
+                               (text (enqueue-msg (format nil "SYSTEM: ~a" text))))))
+                      ((and (listp msg) (eq type :STATUS))
+                       (setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]" 
+                                                   (or (getf msg :SCRIBE) (getf msg :scribe))
+                                                   (or (getf msg :GARDENER) (getf msg :gardener)))))
+                      ((and (listp msg) (member type '(:REQUEST :RESPONSE :LOG)))
+                       (let ((formatted (format-payload payload)))
+                         (when formatted (enqueue-msg formatted))))
+                      ((and (listp msg) (eq type :EVENT) (eq (getf payload :SENSOR) :TOOL-OUTPUT))
+                       (let ((formatted (format-payload payload)))
+                         (when formatted (enqueue-msg formatted))))
+                      (t (harness-log "TUI: Ignored unknown type ~a" type)))))
+            (when (eq raw-msg :eof) (setf *is-running* nil))
+            (when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
+      (error (c) (setf *status-text* (format nil "Net Error: ~a" c)) (setf *is-running* nil)))
+    (sleep 0.05)))
+
+(defun main ()
+  (handler-case
+      (setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
+    (error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
+  (setf *stream* (usocket:socket-stream *socket*))
+  (bt:make-thread #'listen-thread :name "tui-listener")
+  
+  (unwind-protect
+      (with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t)
+        (let* ((h (height scr))
+               (w (width scr))
+               (chat-win (make-instance 'window :height (- h 2) :width w :position (list 0 0)))
+               (status-win (make-instance 'window :height 1 :width w :position (list (- h 2) 0)))
+               (input-win (make-instance 'window :height 1 :width w :position (list (- h 1) 0)))
+               (last-status nil))
+          
+          (setf (function-keys-enabled-p input-win) t)
+          (setf (input-blocking input-win) nil)
+
+          (loop while *is-running* do
+            ;; 1. Handle incoming messages
+            (let ((new-msgs (dequeue-msgs)))
+              (when new-msgs
+                (dolist (msg new-msgs)
+                  (push msg *chat-history*)
+                  (setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))
+                
+                (clear chat-win)
+                (let ((line-num 0))
+                  (dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- h 3)))))
+                    (add-string chat-win m :y line-num :x 0)
+                    (incf line-num)))
+                (refresh chat-win)))
+
+            ;; 2. Render Status Bar ONLY if changed
+            (unless (equal *status-text* last-status)
+              (clear status-win)
+              (add-string status-win *status-text* :attributes '(:reverse))
+              (refresh status-win)
+              (setf last-status *status-text*))
+
+            ;; 3. Handle Keyboard Input
+            (let* ((event (get-wide-event input-win))
+                   (ch (and event (typep event 'event) (event-key event))))
+              (when ch
+                (cond
+                  ((or (eq ch #\Newline) (eq ch #\Return))
+                   (let ((cmd (coerce *input-buffer* 'string)))
+                     (setf (fill-pointer *input-buffer*) 0)
+                     (when (> (length cmd) 0)
+                       ;; Local Echo
+                       (enqueue-msg (concatenate 'string "> " cmd))
+                       ;; Send to Brain
+                       (let ((framed (opencortex:frame-message (list :TYPE :EVENT 
+                                                                    :META (list :SOURCE :tui :SESSION-ID "default")
+                                                                    :PAYLOAD (list :SENSOR :user-input :TEXT cmd)))))
+                         (format *stream* "~a" framed)
+                         (finish-output *stream*)))
+                     (when (string= cmd "/exit") (setf *is-running* nil))))
+                  ((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout) (eq ch #\Del))
+                   (when (> (length *input-buffer*) 0)
+                     (decf (fill-pointer *input-buffer*))))
+                  ((characterp ch)
+                   (vector-push-extend ch *input-buffer*))))
+              
+              (clear input-win)
+              (add-string input-win (concatenate 'string "> " (coerce *input-buffer* 'string)))
+              (move input-win 0 (+ 2 (length *input-buffer*)))
+              (refresh input-win))
+            
+            (sleep 0.02))))
+    (setf *is-running* nil)
+    (when *socket* (usocket:socket-close *socket*))))