FEAT: Stabilize Unified Envelope Architecture & TUI UX
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s

- Fixed background boot crash via --non-interactive flag.
- Implemented robust protocol sanitization (stripped raw streams).
- Refined TUI formatting to display human-readable tool results.
- Fixed opencortex.sh variable shadowing and connection logic.
- Resolved :target field schema validation errors.
This commit is contained in:
2026-04-20 18:19:54 -04:00
parent 5a164363b8
commit c70f182888
19 changed files with 637 additions and 223 deletions

View File

@@ -29,7 +29,12 @@ The core harness can be configured via environment variables to operate silently
;; Register core harness actuators ;; Register core harness actuators
(register-actuator :system #'execute-system-action) (register-actuator :system #'execute-system-action)
(register-actuator :tool #'execute-tool-action)) (register-actuator :tool #'execute-tool-action)
(register-actuator :tui (lambda (action context)
(let ((stream (getf context :reply-stream)))
(when stream
(format stream "~a" (frame-message action))
(finish-output stream))))))
#+end_src #+end_src
** Dispatching Actions ** Dispatching Actions
@@ -37,13 +42,25 @@ The `dispatch-action` function is the primary router. It identifies the target a
#+begin_src lisp :tangle ../src/act.lisp #+begin_src lisp :tangle ../src/act.lisp
(defun dispatch-action (action context) (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." "Routes an approved action to its registered physical actuator."
(when (and action (listp action)) (when (and action (listp action))
(let* ((target (or (ignore-errors (getf action :target)) *default-actuator*)) (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*))) (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 (if actuator-fn
(funcall actuator-fn action context) (funcall actuator-fn action context)
(harness-log "ACT ERROR: No actuator for ~a" target))))) (harness-log "ACT ERROR: No actuator for ~s (from ~s)" target raw-target)))))
#+end_src #+end_src
** Internal System Actions ** Internal System Actions
@@ -71,24 +88,43 @@ The `:system` actuator handles internal harness commands like code evaluation an
The `:tool` actuator handles the execution of registered cognitive tools. The `:tool` actuator handles the execution of registered cognitive tools.
#+begin_src lisp :tangle ../src/act.lisp #+begin_src lisp :tangle ../src/act.lisp
(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) (defun execute-tool-action (action context)
"Executes a registered cognitive tool. (ACTUATOR)" "Executes a registered cognitive tool. (ACTUATOR)"
(let* ((payload (getf action :payload)) (let* ((payload (getf action :payload))
(tool-name (getf payload :tool)) (tool-name (getf payload :tool))
(tool-args (getf payload :args)) (tool-args (getf payload :args))
(depth (getf context :depth 0)) (depth (getf context :depth 0))
(meta (getf context :meta))
(source (getf meta :source))
(tool (gethash (string-downcase (string tool-name)) *cognitive-tools*))) (tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
(if tool (if tool
(handler-case (handler-case
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args)) (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))) (result (funcall (cognitive-tool-body tool) clean-args)))
(list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream) (let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:payload (list :sensor :tool-output :result result :tool tool-name))) :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) (error (c)
(list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream) (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:payload (list :sensor :tool-error :tool tool-name :message (format nil "~a" c))))) :PAYLOAD (list :SENSOR :tool-error :tool tool-name :message (format nil "~a" c)))))
(list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream) (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:payload (list :sensor :tool-error :message "Tool not found"))))) :PAYLOAD (list :SENSOR :tool-error :message "Tool not found")))))
#+end_src #+end_src
** The Act Gate ** The Act Gate
@@ -99,7 +135,11 @@ The final stage of the metabolic loop. It performs a "last-mile" safety check be
"Final Stage: Actuation and feedback generation." "Final Stage: Actuation and feedback generation."
(let* ((approved (getf signal :approved-action)) (let* ((approved (getf signal :approved-action))
(type (getf signal :type)) (type (getf signal :type))
(feedback nil)) (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) ;; 1. Last-Mile Safety Check (The Bouncer & Deterministic Gates)
(when approved (when approved
@@ -119,23 +159,22 @@ The final stage of the metabolic loop. It performs a "last-mile" safety check be
;; 2. Actuation Logic ;; 2. Actuation Logic
(case type (case type
(:REQUEST (dispatch-action signal signal)) (:REQUEST (dispatch-action signal context))
(:LOG (dispatch-action signal signal)) (:LOG (dispatch-action signal context))
(:EVENT (:EVENT
(if approved (if approved
(let* ((target (getf approved :target)) (let* ((target (getf approved :target))
(result (dispatch-action approved signal))) (result (dispatch-action approved context)))
;; If the actuator returns a signal (like :tool-output), it becomes the feedback. ;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
;; Otherwise, generate tool-output feedback for non-silent actuators. ;; Otherwise, generate tool-output feedback for non-silent actuators.
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG))) (cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
(setf feedback result)) (setf feedback result))
((and result (not (member target *silent-actuators*))) ((and result (not (member target *silent-actuators*)))
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
:reply-stream (getf signal :reply-stream)
:payload (list :sensor :tool-output :result result :tool approved)))))) :payload (list :sensor :tool-output :result result :tool approved))))))
;; If no approved action but we have a reply-stream, this might be a raw event/log stimulus. ;; If no approved action but we have a source, this might be a raw event/log stimulus.
(when (getf signal :reply-stream) (when source
(dispatch-action signal signal))))) (dispatch-action signal context)))))
(setf (getf signal :status) :acted) (setf (getf signal :status) :acted)
feedback)) feedback))

View File

@@ -80,3 +80,71 @@ The ~communication.lisp~ module defines the low-level transport and framing logi
:VERSION version :VERSION version
:CAPABILITIES '(:AUTH :SWANK :ORG-AST)))) :CAPABILITIES '(:AUTH :SWANK :ORG-AST))))
#+end_src #+end_src
** Structural Validation (communication-validator.lisp)
The validator ensures that incoming messages adhere to the strict property list schema of the communication protocol.
#+begin_src lisp :tangle ../src/communication-validator.lisp
(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))
#+end_src
** Message Framing (communication.lisp)
Frames a message with a hex length prefix and ensures all data is serializable.
#+begin_src lisp :tangle ../src/communication.lisp
(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)))
#+end_src

View File

@@ -55,8 +55,9 @@ The initial stage of the metabolic loop. It logs the signal, performs selective
"Initial processing: Normalizes raw stimuli and updates memory." "Initial processing: Normalizes raw stimuli and updates memory."
(let* ((payload (getf signal :payload)) (let* ((payload (getf signal :payload))
(type (getf signal :type)) (type (getf signal :type))
(meta (getf signal :meta))
(sensor (getf payload :sensor))) (sensor (getf payload :sensor)))
(harness-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor")) (harness-log "GATE [Perceive]: ~a (~a) [Source: ~s]" type (or sensor "no-sensor") (getf meta :source))
(cond ((eq type :EVENT) (cond ((eq type :EVENT)
(case sensor (case sensor

View File

@@ -60,20 +60,35 @@ The Reason stage is the cognitive engine of the OpenCortex. It bridges the gap b
(funcall prompt-generator context) (funcall prompt-generator context)
(let ((p (proto-get (proto-get context :payload) :text))) (let ((p (proto-get (proto-get context :payload) :text)))
(if (and p (stringp p)) p "Maintain metabolic stasis.")))) (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" (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 :provider :openrouter if calling LLM tools unless specified otherwise."
assistant-name global-context tool-belt system-logs))) assistant-name global-context tool-belt system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context)) (let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (if (stringp thought) (string-trim '(#\Space #\Newline #\Tab) thought) thought))) (cleaned (if (stringp thought) (string-trim '(#\Space #\Newline #\Tab) thought) thought))
(meta (proto-get context :meta))
(source (proto-get meta :source)))
(if (and cleaned (stringp cleaned)) (if (and cleaned (stringp cleaned))
(let ((*read-eval* nil)) (let ((*read-eval* nil))
(if (and (> (length cleaned) 0) (char= (char cleaned 0) #\()) (if (and (> (length cleaned) 0) (char= (char cleaned 0) #\())
(handler-case (handler-case
(let ((parsed (read-from-string cleaned))) (let ((parsed (read-from-string cleaned)))
(if (and (listp parsed) (member (proto-get parsed :TYPE) '(:CHAT :REQUEST :EVENT :STATUS :RESPONSE))) (let ((type (proto-get parsed :TYPE))
parsed (target (or (proto-get parsed :TARGET) (proto-get parsed :target))))
(list :TYPE :CHAT :TEXT cleaned))) (cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
(error (c) (list :TYPE :CHAT :TEXT cleaned))) (unless (proto-get parsed :target) (setf (getf parsed :target) (or source :CLI)))
(list :TYPE :CHAT :TEXT cleaned))) parsed)
;; Handle raw plists that look like tool calls
((or (eq target :TOOL) (eq target :tool) (getf parsed :TOOL) (getf parsed :tool))
(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))))) thought)))))
#+end_src #+end_src
@@ -108,7 +123,7 @@ The Reason stage is the cognitive engine of the OpenCortex. It bridges the gap b
(let* ((type (proto-get signal :type)) (let* ((type (proto-get signal :type))
(payload (proto-get signal :payload)) (payload (proto-get signal :payload))
(sensor (proto-get payload :sensor))) (sensor (proto-get payload :sensor)))
(unless (and (eq type :EVENT) (eq sensor :chat-message)) (unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
(return-from reason-gate signal)) (return-from reason-gate signal))
(let ((candidate (think signal))) (let ((candidate (think signal)))
(if candidate (if candidate

View File

@@ -47,6 +47,27 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
(nreverse clean)) (nreverse clean))
msg)) 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 () (defun listen-thread ()
(loop while *is-running* do (loop while *is-running* do
(handler-case (handler-case
@@ -65,8 +86,12 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
(setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]" (setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]"
(or (getf msg :SCRIBE) (getf msg :scribe)) (or (getf msg :SCRIBE) (getf msg :scribe))
(or (getf msg :GARDENER) (getf msg :gardener))))) (or (getf msg :GARDENER) (getf msg :gardener)))))
((and (listp msg) (eq type :CHAT)) ((and (listp msg) (member type '(:REQUEST :RESPONSE :LOG)))
(let ((text (or (getf msg :TEXT) (getf msg :text)))) (when text (enqueue-msg text)))) (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))))) (t (harness-log "TUI: Ignored unknown type ~a" type)))))
(when (eq raw-msg :eof) (setf *is-running* nil)) (when (eq raw-msg :eof) (setf *is-running* nil))
(when (eq raw-msg :error) (setf *status-text* "Protocol Error")))) (when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
@@ -126,7 +151,9 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro
;; Local Echo ;; Local Echo
(enqueue-msg (concatenate 'string "> " cmd)) (enqueue-msg (concatenate 'string "> " cmd))
;; Send to Brain ;; Send to Brain
(let ((framed (opencortex:frame-message (format nil "~s" (list :TYPE :EVENT :PAYLOAD (list :SENSOR :chat-message :TEXT cmd)))))) (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) (format *stream* "~a" framed)
(finish-output *stream*))) (finish-output *stream*)))
(when (string= cmd "/exit") (setf *is-running* nil)))) (when (string= cmd "/exit") (setf *is-running* nil))))

28
mock_daemon.lisp Normal file
View File

@@ -0,0 +1,28 @@
(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))
(push (truename "./") asdf:*central-registry*)
(ql:quickload '(:usocket :bordeaux-threads :opencortex))
(defun handle-client (stream)
(handler-case
(progn
(format stream "~a" (opencortex:frame-message (opencortex:make-hello-message "0.1.0")))
(finish-output stream)
(loop
(let ((msg (opencortex:read-framed-message stream)))
(when (or (eq msg :eof) (eq msg :error)) (return))
(let ((text (getf (getf msg :payload) :text)))
(format t "MOCK: Received ~s~%" text)
(let ((resp (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (format nil "ECHO: ~a" text)))))
(format stream "~a" (opencortex:frame-message resp))
(finish-output stream))))))
(error (c) (format t "MOCK ERROR: ~a~%" c))))
(let ((socket (usocket:socket-listen "127.0.0.1" 9105 :reuse-address t)))
(format t "MOCK DAEMON LIVE ON 9105~%")
(unwind-protect
(loop (let ((client (usocket:socket-accept socket)))
(bt:make-thread (lambda ()
(unwind-protect
(handle-client (usocket:socket-stream client))
(usocket:socket-close client))))))
(usocket:socket-close socket)))

28
mock_daemon.py Normal file
View File

@@ -0,0 +1,28 @@
import socket
import select
server = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
server.setsockopt(socket.SOL_SOCKET, socket.SO_REUSEADDR, 1)
server.bind(('127.0.0.1', 9105))
server.listen(1)
print("MOCK DAEMON LIVE ON 9105")
conn, addr = server.accept()
# 1. Send Handshake
hello = '(:TYPE :EVENT :PAYLOAD (:ACTION :HANDSHAKE :VERSION \"0.1.0\"))'
conn.sendall(f"{len(hello):06x}{hello}".encode())
# 2. Receive and Echo
data = conn.recv(1024).decode()
print(f"MOCK RECEIVED: {data}")
if data:
payload = data[6:] # Strip hex length
# extract message text simple way
import re
match = re.search(r':TEXT \"([^\"]*)\"', payload)
text = match.group(1) if match else "unknown"
resp = f'(:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"PYTHON_MOCK_ECHO: {text}\"))'
conn.sendall(f"{len(resp):06x}{resp}".encode())
conn.close()
server.close()

View File

@@ -17,21 +17,13 @@ done
export SCRIPT_DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" export SCRIPT_DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )"
# Load environment variables if they exist # Load environment variables if they exist
# Priority 1: $HOME/.local/share/opencortex/.env if [ -f "$SCRIPT_DIR/.env" ]; then
# Priority 2: $SCRIPT_DIR/.env
if [ -f "$HOME/.local/share/opencortex/.env" ]; then
ENV_PATH="$HOME/.local/share/opencortex/.env"
elif [ -f "$SCRIPT_DIR/.env" ]; then
ENV_PATH="$SCRIPT_DIR/.env"
fi
if [ -n "$ENV_PATH" ]; then
while IFS="=" read -r key value || [ -n "$key" ]; do while IFS="=" read -r key value || [ -n "$key" ]; do
if [[ $key =~ ^[a-zA-Z_][a-zA-Z0-9_]*$ ]]; then if [[ $key =~ ^[a-zA-Z_][a-zA-Z0-9_]*$ ]]; then
val=$(echo "$value" | sed "s/^\"//;s/\"$//;s/^'//;s/'$//") val=$(echo "$value" | sed "s/^\"//;s/\"$//")
export "$key=$val" export "$key=$val"
fi fi
done < "$ENV_PATH" done < "$SCRIPT_DIR/.env"
[ -n "$HARNESS_PORT" ] && PORT=$HARNESS_PORT [ -n "$HARNESS_PORT" ] && PORT=$HARNESS_PORT
[ -n "$HARNESS_HOST" ] && HOST=$HARNESS_HOST [ -n "$HARNESS_HOST" ] && HOST=$HARNESS_HOST
fi fi
@@ -47,10 +39,9 @@ fi
# --- 2. SETUP --- # --- 2. SETUP ---
setup_system() { setup_system() {
echo -e "${BLUE}=== OpenCortex: Initializing System ===${NC}" echo -e "${BLUE}=== OpenCortex: Initializing System ===${NC}"
echo -e "${YELLOW}--- Installing System Dependencies ---${NC}" echo -e "${YELLOW}--- Installing System Dependencies ---${NC}"
if command_exists apt-get; then if command_exists apt-get; then
sudo apt-get update && sudo apt-get install -y sbcl emacs-nox rlwrap netcat-openbsd curl git socat libssl-dev libncurses-dev libffi-dev zlib1g-dev libsqlite3-dev sudo apt-get update && sudo apt-get install -y sbcl emacs-nox rlwrap netcat-openbsd curl git socat libssl-dev libncurses5-dev libffi-dev zlib1g-dev libsqlite3-dev
fi fi
if [ ! -d "$HOME/quicklisp" ]; then if [ ! -d "$HOME/quicklisp" ]; then
curl -O https://beta.quicklisp.org/quicklisp.lisp curl -O https://beta.quicklisp.org/quicklisp.lisp
@@ -59,7 +50,7 @@ setup_system() {
fi fi
cd "$SCRIPT_DIR" cd "$SCRIPT_DIR"
if [ ! -f .env ] && [ ! -f "$HOME/.local/share/opencortex/.env" ]; then if [ ! -f .env ]; then
cp .env.example .env cp .env.example .env
echo -e "\n${YELLOW}--- Identity Configuration ---${NC}" echo -e "\n${YELLOW}--- Identity Configuration ---${NC}"
@@ -82,20 +73,57 @@ setup_system() {
[ -n "$openrouter_key" ] && sed -i "s|OPENROUTER_API_KEY=.*|OPENROUTER_API_KEY=\"$openrouter_key\"|" .env [ -n "$openrouter_key" ] && sed -i "s|OPENROUTER_API_KEY=.*|OPENROUTER_API_KEY=\"$openrouter_key\"|" .env
echo -e "\n${YELLOW}--- Memex Folder Structure ---${NC}" echo -e "\n${YELLOW}--- Memex Folder Structure ---${NC}"
read -p "Memex Root [$HOME/memex]: " memex_root < /dev/tty read -p "Memex Root [\$HOME/memex]: " memex_dir < /dev/tty
memex_root=${memex_root:-$HOME/memex} memex_dir=${memex_dir:-\$HOME/memex}
sed -i "s|MEMEX_ROOT=.*|MEMEX_ROOT=\"$memex_root\"|" .env sed -i "s|MEMEX_DIR=.*|MEMEX_DIR=\"$memex_dir\"|" .env
sed -i "s|\"/memex/|\"$memex_dir/|g" .env
sed -i "s|SKILLS_DIR=.*|SKILLS_DIR=\"$SCRIPT_DIR/skills\"|" .env
sed -i "s|ZETTELKASTEN_DIR=.*|ZETTELKASTEN_DIR=\"$memex_dir/notes\"|" .env
read -p "Inbox Directory [\$memex_dir/inbox]: " inbox_dir < /dev/tty
inbox_dir=${inbox_dir:-\$memex_dir/inbox}
sed -i "s|INBOX_DIR=.*|INBOX_DIR=\"$inbox_dir\"|" .env
read -p "Daily Directory [\$memex_dir/daily]: " daily_dir < /dev/tty
daily_dir=${daily_dir:-\$memex_dir/daily}
sed -i "s|DAILY_DIR=.*|DAILY_DIR=\"$daily_dir\"|" .env
read -p "Projects Directory [\$memex_dir/projects]: " proj_dir < /dev/tty
proj_dir=${proj_dir:-\$memex_dir/projects}
sed -i "s|PROJECTS_DIR=.*|PROJECTS_DIR=\"$proj_dir\"|" .env
mkdir -p "$memex_dir" "$inbox_dir" "$daily_dir" "$proj_dir"
mkdir -p "$memex_dir/notes" "$memex_dir/areas" "$memex_dir/resources" "$memex_dir/archives" "$memex_dir/system"
fi fi
echo -e "\n${YELLOW}--- Warming Neural Cache ---${NC}" mkdir -p src
rm -rf "$HOME/.cache/common-lisp" for f in literate/*.org; do
sbcl --non-interactive --eval "(load (merge-pathnames \"quicklisp/setup.lisp\" (user-homedir-pathname)))" \ emacs --batch --eval "(require 'org)" --eval "(org-babel-tangle-file \"$f\")" >/dev/null 2>&1 || true
--eval "(push (truename \"$SCRIPT_DIR\") asdf:*central-registry*)" \ done
--eval "(ql:quickload '(:opencortex :opencortex/tui :croatoan))"
echo -e "\n${YELLOW}--- Finalizing: Awakening the Brain as a background daemon ---${NC}" mkdir -p "$HOME/.local/bin"
ln -sf "$SCRIPT_DIR/opencortex.sh" "$HOME/.local/bin/opencortex"
for shell_config in "$HOME/.bashrc" "$HOME/.profile"; do
if [ -f "$shell_config" ]; then
if ! grep -q ".local/bin" "$shell_config"; then
echo 'export PATH="$HOME/.local/bin:$PATH"' >> "$shell_config"
fi
fi
done
export PATH="$HOME/.local/bin:$PATH"
echo -e "${YELLOW}--- Compiling and Loading OpenCortex (this may take a minute) ---${NC}"
sbcl --non-interactive --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' --eval '(push (truename (uiop:getenv "SCRIPT_DIR")) asdf:*central-registry*)' --eval "(ql:quickload '(:opencortex :croatoan))"
if [ $? -ne 0 ]; then
echo -e "${RED}✗ Compilation or Loading failed.${NC}"
exit 1
fi
echo -e "${YELLOW}--- Finalizing: Awakening the Brain as a background daemon ---${NC}"
> "$SCRIPT_DIR/brain.log" > "$SCRIPT_DIR/brain.log"
bash "$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 & "$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 &
local success=false local success=false
for i in {1..30}; do for i in {1..30}; do
@@ -103,14 +131,18 @@ setup_system() {
success=true success=true
break break
fi fi
echo -n "."
sleep 2 sleep 2
echo -n "."
done done
if [ "$success" = true ]; then if [ "$success" = true ]; then
echo -e "\n${GREEN}✓ Brain is alive and responsive on port $PORT.${NC}" echo -e "\n${GREEN}✓ Brain is alive and responsive on port $PORT.${NC}"
echo -e "${GREEN}✓ Setup complete.${NC}" echo -e "${GREEN}✓ Setup complete.${NC}"
if command -v opencortex >/dev/null 2>&1; then
echo -e "${BLUE}To start, run:${NC} ${GREEN}opencortex tui${NC}" echo -e "${BLUE}To start, run:${NC} ${GREEN}opencortex tui${NC}"
else
echo -e "${BLUE}To start, run:${NC} ${GREEN}exec bash && opencortex tui${NC}"
fi
exit 0 exit 0
else else
echo -e "\n${RED}✗ Brain failed to wake up.${NC}" echo -e "\n${RED}✗ Brain failed to wake up.${NC}"
@@ -121,9 +153,11 @@ setup_system() {
} }
# --- 3. COMMAND ROUTER --- # --- 3. COMMAND ROUTER ---
# By default, if no arguments are provided, we assume the user wants the CLI fallback.
COMMAND=${1:-"cli"} COMMAND=${1:-"cli"}
if [ ! -f "$SCRIPT_DIR/src/package.lisp" ] || ([ ! -f "$SCRIPT_DIR/.env" ] && [ ! -f "$HOME/.local/share/opencortex/.env" ]); then # However, if the system is completely uninitialized, we force the 'setup' command.
if [ ! -f "$SCRIPT_DIR/src/package.lisp" ] || [ ! -f "$SCRIPT_DIR/.env" ]; then
COMMAND="setup" COMMAND="setup"
fi fi
@@ -133,56 +167,32 @@ case "$COMMAND" in
;; ;;
--boot|boot) --boot|boot)
# Prevent double-booting
if nc -z localhost $PORT 2>/dev/null; then
echo -e "${GREEN}Brain is already active on port $PORT.${NC}"
exit 0
fi
echo -e "${YELLOW}--- Awakening OpenCortex Conducter ---${NC}"
export SKILLS_DIR="${SCRIPT_DIR}/skills" export SKILLS_DIR="${SCRIPT_DIR}/skills"
[ -z "$MEMEX_DIR" ] && export MEMEX_DIR="$HOME/memex" [ -z "$MEMEX_DIR" ] && export MEMEX_DIR="$HOME/memex"
exec sbcl --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' --eval '(setf *debugger-hook* (lambda (c h) (declare (ignore h)) (format *error-output* "FATAL LISP ERROR: ~a~%" c) (uiop:print-backtrace :stream *error-output*) (uiop:quit 1)))' --eval '(push (truename (uiop:getenv "SCRIPT_DIR")) asdf:*central-registry*)' --eval '(format t "--- Quickloading OpenCortex ---~%")' --eval "(ql:quickload '(:opencortex :croatoan))" --eval '(opencortex:main)'
# We don't purge cache here to avoid race conditions with TUI launch
exec sbcl --eval "(load (merge-pathnames \"quicklisp/setup.lisp\" (user-homedir-pathname)))" \
--eval "(setf *debugger-hook* (lambda (c h) (declare (ignore h)) (format *error-output* \"FATAL LISP ERROR: ~a~%\" c) (uiop:print-backtrace :stream *error-output*) (uiop:quit 1)))" \
--eval "(push (truename \"$SCRIPT_DIR\") asdf:*central-registry*)" \
--eval "(ql:quickload '(:opencortex :croatoan))" \
--eval "(opencortex:main)"
;; ;;
tui) tui)
if ! nc -z $HOST $PORT 2>/dev/null; then if ! nc -z $HOST $PORT 2>/dev/null; then
if [ -f "$SCRIPT_DIR/boot.lock" ]; then
echo -e "${YELLOW}Brain is currently waking up. Waiting for initialization...${NC}"
else
echo -e "Brain is offline. Awakening..." echo -e "Brain is offline. Awakening..."
touch "$SCRIPT_DIR/boot.lock" "$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 &
bash "$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 & for i in {1..15}; do
fi
for i in {1..30}; do
sleep 2 sleep 2
if nc -z $HOST $PORT 2>/dev/null; then break; fi if nc -z $HOST $PORT 2>/dev/null; then break; fi
echo -n "." echo -n "."
done done
echo "" echo ""
rm -f "$SCRIPT_DIR/boot.lock"
fi fi
echo -e "Launching Croatoan TUI..." echo -e "Launching Croatoan TUI..."
export SKILLS_DIR="${SCRIPT_DIR}/skills" export SKILLS_DIR="${SCRIPT_DIR}/skills"
[ -z "$MEMEX_DIR" ] && export MEMEX_DIR="$HOME/memex" [ -z "$MEMEX_DIR" ] && export MEMEX_DIR="$HOME/memex"
exec sbcl --disable-debugger --eval "(load (merge-pathnames \"quicklisp/setup.lisp\" (user-homedir-pathname)))" \ exec sbcl --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' --eval '(push (truename (uiop:getenv "SCRIPT_DIR")) asdf:*central-registry*)' --eval '(ql:quickload :opencortex/tui)' --eval '(opencortex.tui:main)'
--eval "(push (truename \"$SCRIPT_DIR\") asdf:*central-registry*)" \
--eval "(ql:quickload :opencortex/tui)" \
--eval "(opencortex.tui:main)"
;; ;;
cli) cli)
if ! nc -z $HOST $PORT 2>/dev/null; then if ! nc -z $HOST $PORT 2>/dev/null; then
echo -e "Brain is offline. Awakening..." echo -e "Brain is offline. Awakening..."
bash "$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 & "$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 &
for i in {1..15}; do for i in {1..15}; do
sleep 2 sleep 2
if nc -z $HOST $PORT 2>/dev/null; then break; fi if nc -z $HOST $PORT 2>/dev/null; then break; fi
@@ -191,9 +201,9 @@ case "$COMMAND" in
echo "" echo ""
fi fi
if command_exists socat; then if command_exists socat; then
exec socat - TCP:$HOST:$PORT exec socat - TCP::
else else
exec nc $HOST $PORT exec nc
fi fi
;; ;;

View File

@@ -7,14 +7,33 @@ HOST=${1:-localhost}
if command -v socat >/dev/null 2>&1; then if command -v socat >/dev/null 2>&1; then
# Use socat with READLINE for history and arrow-key support. # Use socat with READLINE for history and arrow-key support.
# It establishes a persistent bidirectional connection. # It establishes a persistent bidirectional connection.
socat READLINE,history=$HOME/.org_agent_history TCP:$HOST:$PORT # Note: socat READLINE doesn't handle hex-length framing automatically for input.
else # We use a wrapper to frame the message.
# Fallback to nc (netcat) for a single-shot connection if socat is missing.
# Note: This is less robust for agents with long-thinking times. echo "Connected to OpenCortex on $HOST:$PORT (Channel: CLI)"
echo "WARNING: socat not found. Falling back to nc (no line-editing support)."
while true; do while true; do
read -p "User: " MESSAGE read -p "User: " MESSAGE
if [ -z "$MESSAGE" ]; then continue; fi if [ -z "$MESSAGE" ]; then continue; fi
echo "$MESSAGE" | nc -N $HOST $PORT if [ "$MESSAGE" = "/exit" ]; then break; fi
done
# Frame the message: (:TYPE :EVENT :META (:SOURCE :CLI) :PAYLOAD (:SENSOR :USER-INPUT :TEXT "msg"))
PAYLOAD="(:TYPE :EVENT :META (:SOURCE :CLI) :PAYLOAD (:SENSOR :USER-INPUT :TEXT \"$MESSAGE\"))"
LEN=$(printf "%s" "$PAYLOAD" | wc -c)
HEXLEN=$(printf "%06x" $LEN)
# Send and read response
(printf "%s%s" "$HEXLEN" "$PAYLOAD" | nc -N $HOST $PORT) | while read -r LINE; do
# The line will have the 6-char hex length prefix.
# We strip it and look for the response.
CLEAN=$(echo "$LINE" | sed 's/^......//')
if [[ "$CLEAN" == *":TEXT"* ]]; then
# Extract the text content (simple grep-like extraction for CLI fallback)
TEXT=$(echo "$CLEAN" | sed -n 's/.*:TEXT "\([^"]*\)".*/\1/p')
echo "Agent: $TEXT"
fi
done
done
else
echo "Error: socat or nc required."
exit 1
fi fi

View File

@@ -24,12 +24,11 @@ The *CLI Gateway* is the primary sensory and actuating interface for human inter
(defun execute-cli-action (action context) (defun execute-cli-action (action context)
"Sends a framed message back to the connected CLI client." "Sends a framed message back to the connected CLI client."
(let* ((payload (proto-get action :PAYLOAD)) (let* ((payload (proto-get action :PAYLOAD))
(text (or (proto-get payload :TEXT) (proto-get payload :MESSAGE) (proto-get action :TEXT)))
(stream (proto-get context :REPLY-STREAM))) (stream (proto-get context :REPLY-STREAM)))
(handler-case (handler-case
(if (and stream (open-stream-p stream)) (if (and stream (open-stream-p stream))
(progn (progn
(format stream "~a" (frame-message (list :TYPE :CHAT :TEXT text))) (format stream "~a" (frame-message action))
(finish-output stream) (finish-output stream)
(format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING))) (format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING)))
(finish-output stream)) (finish-output stream))
@@ -39,7 +38,7 @@ The *CLI Gateway* is the primary sensory and actuating interface for human inter
(defun handle-cli-slash-command (cmd stream) (defun handle-cli-slash-command (cmd stream)
(cond (cond
((string= cmd "/exit") (return-from handle-cli-slash-command :exit)) ((string= cmd "/exit") (return-from handle-cli-slash-command :exit))
(t (format stream "~a" (frame-message (list :TYPE :CHAT :TEXT (format nil "Unknown command: ~a" cmd))))))) (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) (defun handle-cli-client (stream)
"Reads framed messages from a CLI client and injects them as stimuli." "Reads framed messages from a CLI client and injects them as stimuli."
@@ -57,10 +56,15 @@ The *CLI Gateway* is the primary sensory and actuating interface for human inter
(let ((msg (read-framed-message stream))) (let ((msg (read-framed-message stream)))
(cond ((eq msg :eof) (return)) (cond ((eq msg :eof) (return))
((eq msg :error) (return)) ((eq msg :error) (return))
(t (let ((text (proto-get msg :TEXT))) (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) #\/)) (if (and text (stringp text) (char= (char text 0) #\/))
(when (eq (handle-cli-slash-command text stream) :exit) (return)) (when (eq (handle-cli-slash-command text stream) :exit) (return))
(progn (progn
;; Default meta if missing
(unless meta
(setf (getf msg :meta) (list :SOURCE :CLI :SESSION-ID "default")))
(harness-log "CLI: Received input -> ~s" msg) (harness-log "CLI: Received input -> ~s" msg)
(inject-stimulus msg :stream stream))))))))) (inject-stimulus msg :stream stream)))))))))
(error (c) (harness-log "CLI CLIENT DISCONNECT: ~a" c))) (error (c) (harness-log "CLI CLIENT DISCONNECT: ~a" c)))

View File

@@ -122,12 +122,12 @@ The gateway utilizes a functional dispatch pattern. A single entry point, `execu
"Queries an LLM provider via the unified gateway." "Queries an LLM provider via the unified gateway."
((:prompt :type :string :description "The user prompt.") ((:prompt :type :string :description "The user prompt.")
(:system-prompt :type :string :description "The system instructions.") (:system-prompt :type :string :description "The system instructions.")
(:provider :type :keyword :description "The provider.") (:provider :type :keyword :description "The provider. (Default: :openrouter)")
(:model :type :string :description "Optional specific model ID.")) (:model :type :string :description "Optional specific model ID."))
:body (lambda (args) :body (lambda (args)
(execute-llm-request (getf args :prompt) (execute-llm-request (getf args :prompt)
(or (getf args :system-prompt) "You are a helpful assistant.") (or (getf args :system-prompt) "You are a helpful assistant.")
:provider (getf args :provider) :provider (or (getf args :provider) :openrouter)
:model (getf args :model)))) :model (getf args :model))))
(defskill :skill-llm-gateway (defskill :skill-llm-gateway

View File

@@ -1,25 +1,27 @@
(in-package :opencortex) (in-package :opencortex)
(defvar *default-actuator* :CLI) (defvar *default-actuator* :cli)
(defvar *silent-actuators* '(:CLI :SYSTEM-MESSAGE :EMACS)) (defvar *silent-actuators* '(:cli :system-message :emacs))
(defun initialize-actuators () (defun initialize-actuators ()
"Loads actuator routing defaults from environment variables and registers core harness actuators." "Loads actuator routing defaults from environment variables and registers core harness actuators."
(let ((def (string-trim '(#\Space #\" #\') (or (uiop:getenv "DEFAULT_ACTUATOR") "CLI"))) (let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
(silent (or (uiop:getenv "SILENT_ACTUATORS") "CLI,SYSTEM-MESSAGE,EMACS"))) (silent (uiop:getenv "SILENT_ACTUATORS")))
(when def (when def
(let ((clean-def (string-trim '(#\Space #\" #\') def))) (setf *default-actuator* (intern (string-upcase def) "KEYWORD")))
(setf *default-actuator* (intern (string-upcase clean-def) "KEYWORD"))))
(when silent (when silent
(setf *silent-actuators* (setf *silent-actuators*
(mapcar (lambda (s) (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) "KEYWORD"))
(let ((clean-s (string-trim '(#\Space #\" #\') s))) (str:split "," silent)))))
(intern (string-upcase clean-s) "KEYWORD")))
(uiop:split-string silent :separator '(#\,))))))
;; Register core harness actuators ;; Register core harness actuators
(register-actuator :system #'execute-system-action) (register-actuator :system #'execute-system-action)
(register-actuator :tool #'execute-tool-action)) (register-actuator :tool #'execute-tool-action)
(register-actuator :tui (lambda (action context)
(let ((stream (getf context :reply-stream)))
(when stream
(format stream "~a" (frame-message action))
(finish-output stream))))))
(defun dispatch-action (action context) (defun dispatch-action (action context)
(let ((payload (proto-get action :payload))) (let ((payload (proto-get action :payload)))
@@ -27,11 +29,17 @@
(return-from dispatch-action nil))) (return-from dispatch-action nil)))
"Routes an approved action to its registered physical actuator." "Routes an approved action to its registered physical actuator."
(when (and action (listp action)) (when (and action (listp action))
(let* ((raw-target (or (ignore-errors (getf action :TARGET)) (let* ((meta (proto-get context :meta))
(source (proto-get meta :source))
(raw-target (or (ignore-errors (getf action :TARGET))
(ignore-errors (getf action :target)) (ignore-errors (getf action :target))
source
*default-actuator*)) *default-actuator*))
(target (intern (string-upcase (string raw-target)) :keyword)) (target (intern (string-upcase (string raw-target)) :keyword))
(actuator-fn (gethash target *actuator-registry*))) (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 (if actuator-fn
(funcall actuator-fn action context) (funcall actuator-fn action context)
(harness-log "ACT ERROR: No actuator for ~s (from ~s)" target raw-target))))) (harness-log "ACT ERROR: No actuator for ~s (from ~s)" target raw-target)))))
@@ -52,34 +60,53 @@
(:message (harness-log "ACT [System]: ~a" (getf payload :text))) (:message (harness-log "ACT [System]: ~a" (getf payload :text)))
(t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd))))) (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) (defun execute-tool-action (action context)
"Executes a registered cognitive tool. (ACTUATOR)" "Executes a registered cognitive tool. (ACTUATOR)"
(let* ((payload (getf action :payload)) (let* ((payload (getf action :payload))
(tool-name (getf payload :tool)) (tool-name (getf payload :tool))
(tool-args (getf payload :args)) (tool-args (getf payload :args))
(depth (getf context :depth 0)) (depth (getf context :depth 0))
(meta (getf context :meta))
(source (getf meta :source))
(tool (gethash (string-downcase (string tool-name)) *cognitive-tools*))) (tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
(if tool (if tool
(handler-case (handler-case
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args)) (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))) (result (funcall (cognitive-tool-body tool) clean-args)))
(let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :REPLY-STREAM (getf context :REPLY-STREAM) (let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name)))) :PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))))
;; If we have a reply stream, also send a chat message with the result ;; If we have a source, send a status message with the result, formatted for humans
(when (getf context :REPLY-STREAM) (when source
(dispatch-action (list :TYPE :CHAT :TEXT (format nil "TOOL [~a] RESULT: ~a" tool-name result)) context)) (dispatch-action (list :TYPE :REQUEST :TARGET source
:PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result)))
context))
feedback)) feedback))
(error (c) (error (c)
(list :TYPE :EVENT :DEPTH (1+ depth) :REPLY-STREAM (proto-get context :REPLY-STREAM) (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :tool tool-name :message (format nil "~a" c))))) :PAYLOAD (list :SENSOR :tool-error :tool tool-name :message (format nil "~a" c)))))
(list :TYPE :EVENT :DEPTH (1+ depth) :REPLY-STREAM (proto-get context :REPLY-STREAM) (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :message "Tool not found"))))) :PAYLOAD (list :SENSOR :tool-error :message "Tool not found")))))
(defun act-gate (signal) (defun act-gate (signal)
"Final Stage: Actuation and feedback generation." "Final Stage: Actuation and feedback generation."
(let* ((approved (proto-get signal :approved-action)) (let* ((approved (getf signal :approved-action))
(type (proto-get signal :type)) (type (getf signal :type))
(feedback nil)) (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) ;; 1. Last-Mile Safety Check (The Bouncer & Deterministic Gates)
(when approved (when approved
@@ -90,32 +117,31 @@
(not (member original-type '(:LOG :EVENT :log :event)))) (not (member original-type '(:LOG :EVENT :log :event))))
(progn (progn
(harness-log "ACT BLOCKED: Action failed last-mile deterministic check.") (harness-log "ACT BLOCKED: Action failed last-mile deterministic check.")
(setf (getf signal :APPROVED-ACTION) nil) (setf (getf signal :approved-action) nil)
(setf approved nil) (setf approved nil)
(setf feedback verified)) (setf feedback verified))
(progn (progn
(setf (getf signal :APPROVED-ACTION) verified) (setf (getf signal :approved-action) verified)
(setf approved verified))))) (setf approved verified)))))
;; 2. Actuation Logic ;; 2. Actuation Logic
(case type (case type
(:REQUEST (dispatch-action signal signal)) (:REQUEST (dispatch-action signal context))
(:LOG (dispatch-action signal signal)) (:LOG (dispatch-action signal context))
(:EVENT (:EVENT
(if approved (if approved
(let* ((target (proto-get approved :target)) (let* ((target (getf approved :target))
(result (dispatch-action approved signal))) (result (dispatch-action approved context)))
;; If the actuator returns a signal (like :tool-output), it becomes the feedback. ;; If the actuator returns a signal (like :tool-output), it becomes the feedback.
;; Otherwise, generate tool-output feedback for non-silent actuators. ;; Otherwise, generate tool-output feedback for non-silent actuators.
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG))) (cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
(setf feedback result)) (setf feedback result))
((and result (not (member target *silent-actuators*))) ((and result (not (member target *silent-actuators*)))
(setf feedback (list :TYPE :EVENT :depth (1+ (or (proto-get signal :depth) 0)) (setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
:reply-stream (proto-get signal :reply-stream)
:payload (list :sensor :tool-output :result result :tool approved)))))) :payload (list :sensor :tool-output :result result :tool approved))))))
;; If no approved action but we have a reply-stream, this might be a raw event/log stimulus. ;; If no approved action but we have a source, this might be a raw event/log stimulus.
(when (proto-get signal :reply-stream) (when source
(dispatch-action signal signal))))) (dispatch-action signal context)))))
(setf (getf signal :status) :acted) (setf (getf signal :status) :acted)
feedback)) feedback))

View File

@@ -1,12 +1,15 @@
(in-package :opencortex) (in-package :opencortex)
(defvar *actuator-registry* (make-hash-table :test 'equalp)) (defvar *actuator-registry* (make-hash-table :test 'equalp)
"Global registry mapping target keywords to their physical actuator functions.")
(defun register-actuator (name fn) (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)))) (let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword))))
(setf (gethash key *actuator-registry*) fn))) (setf (gethash key *actuator-registry*) fn)))
(defun frame-message (msg-plist) (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) (let* ((*print-pretty* nil)
(*print-circle* nil) (*print-circle* nil)
(msg-string (format nil "~s" msg-plist)) (msg-string (format nil "~s" msg-plist))
@@ -14,25 +17,59 @@
(format nil "~6,'0x~a~%" len msg-string))) (format nil "~6,'0x~a~%" len msg-string)))
(defun read-framed-message (stream) (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))) (let ((length-buffer (make-string 6)))
(handler-case (handler-case
(progn (progn
;; 1. Skip leading whitespace (newlines, spaces, etc.)
(loop for char = (peek-char nil stream nil :eof) (loop for char = (peek-char nil stream nil :eof)
while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return))) while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
do (read-char stream)) do (read-char stream))
;; 2. Read the 6-char hex length
(let ((count (read-sequence length-buffer stream))) (let ((count (read-sequence length-buffer stream)))
(if (< count 6) :eof (cond ((< count 6) :eof)
(let ((len (ignore-errors (parse-integer length-buffer :radix 16)))) (t (let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
(if (not len) :error (if (not len)
(progn
(harness-log "PROTOCOL ERROR: Invalid header ~s. Attempting resync..." length-buffer)
:error)
(let ((msg-buffer (make-string len))) (let ((msg-buffer (make-string len)))
(read-sequence msg-buffer stream) (read-sequence msg-buffer stream)
(let ((*read-eval* nil) (*print-pretty* nil)) (let ((*read-eval* nil)
(*print-pretty* nil))
(handler-case (handler-case
(let ((msg (read-from-string msg-buffer))) (let ((msg (read-from-string msg-buffer)))
(validate-communication-protocol-schema msg) (validate-communication-protocol-schema msg)
msg) msg)
(error (c) :error))))))))) (error (c)
(error (c) :error)))) (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) (defun make-hello-message (version)
(list :TYPE :EVENT :PAYLOAD (list :ACTION :handshake :VERSION version :CAPABILITIES '(:AUTH :SWANK :ORG-AST)))) "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)))

View File

@@ -143,8 +143,9 @@ will assume you have started it manually (e.g., via SBCL)."
((member type '(:response :RESPONSE)) ((member type '(:response :RESPONSE))
(message "opencortex: Received response for ID %s" id)) (message "opencortex: Received response for ID %s" id))
((member type '(:log :LOG)) ((member type '(:log :LOG))
(let ((text (opencortex--plist-get payload :text))) (let ((text (opencortex--plist-get payload :text))
(opencortex--insert-to-history (concat "[reasoning] " text "\n") 'opencortex-system-face))) (meta (opencortex--plist-get plist :meta)))
(opencortex--insert-to-history (concat "[reasoning" (if meta (format " (%s)" (opencortex--plist-get meta :source)) "") "] " text "\n") 'opencortex-system-face)))
(t (message "opencortex: Received unknown message type %s" type))))) (t (message "opencortex: Received unknown message type %s" type)))))
(defun opencortex--execute-request (proc id payload) (defun opencortex--execute-request (proc id payload)
@@ -359,7 +360,8 @@ Opens a history buffer and a dedicated input area."
;; Send to daemon ;; Send to daemon
(opencortex-send (opencortex-send
`(:type :EVENT `(:type :EVENT
:payload (:sensor :chat-message :meta (:source :emacs)
:payload (:sensor :user-input
:text ,clean-text))) :text ,clean-text)))
(message "opencortex: Message sent.")))) (message "opencortex: Message sent."))))

View File

@@ -27,8 +27,9 @@
"Initial processing: Normalizes raw stimuli and updates memory." "Initial processing: Normalizes raw stimuli and updates memory."
(let* ((payload (getf signal :payload)) (let* ((payload (getf signal :payload))
(type (getf signal :type)) (type (getf signal :type))
(meta (getf signal :meta))
(sensor (getf payload :sensor))) (sensor (getf payload :sensor)))
(harness-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor")) (harness-log "GATE [Perceive]: ~a (~a) [Source: ~s]" type (or sensor "no-sensor") (getf meta :source))
(cond ((eq type :EVENT) (cond ((eq type :EVENT)
(case sensor (case sensor

View File

@@ -38,20 +38,35 @@
(funcall prompt-generator context) (funcall prompt-generator context)
(let ((p (proto-get (proto-get context :payload) :text))) (let ((p (proto-get (proto-get context :payload) :text)))
(if (and p (stringp p)) p "Maintain metabolic stasis.")))) (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" (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 :provider :openrouter if calling LLM tools unless specified otherwise."
assistant-name global-context tool-belt system-logs))) assistant-name global-context tool-belt system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context)) (let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (if (stringp thought) (string-trim '(#\Space #\Newline #\Tab) thought) thought))) (cleaned (if (stringp thought) (string-trim '(#\Space #\Newline #\Tab) thought) thought))
(meta (proto-get context :meta))
(source (proto-get meta :source)))
(if (and cleaned (stringp cleaned)) (if (and cleaned (stringp cleaned))
(let ((*read-eval* nil)) (let ((*read-eval* nil))
(if (and (> (length cleaned) 0) (char= (char cleaned 0) #\()) (if (and (> (length cleaned) 0) (char= (char cleaned 0) #\())
(handler-case (handler-case
(let ((parsed (read-from-string cleaned))) (let ((parsed (read-from-string cleaned)))
(if (and (listp parsed) (member (proto-get parsed :TYPE) '(:CHAT :REQUEST :EVENT :STATUS :RESPONSE))) (let ((type (proto-get parsed :TYPE))
parsed (target (or (proto-get parsed :TARGET) (proto-get parsed :target))))
(list :TYPE :CHAT :TEXT cleaned))) (cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
(error (c) (list :TYPE :CHAT :TEXT cleaned))) (unless (proto-get parsed :target) (setf (getf parsed :target) (or source :CLI)))
(list :TYPE :CHAT :TEXT cleaned))) parsed)
;; Handle raw plists that look like tool calls
((or (eq target :TOOL) (eq target :tool) (getf parsed :TOOL) (getf parsed :tool))
(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))))) thought)))))
(defun deterministic-verify (proposed-action context) (defun deterministic-verify (proposed-action context)
@@ -80,7 +95,7 @@
(let* ((type (proto-get signal :type)) (let* ((type (proto-get signal :type))
(payload (proto-get signal :payload)) (payload (proto-get signal :payload))
(sensor (proto-get payload :sensor))) (sensor (proto-get payload :sensor)))
(unless (and (eq type :EVENT) (eq sensor :chat-message)) (unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
(return-from reason-gate signal)) (return-from reason-gate signal))
(let ((candidate (think signal))) (let ((candidate (think signal)))
(if candidate (if candidate

View File

@@ -1,30 +1,60 @@
(in-package :cl-user) (in-package :cl-user)
(defpackage :opencortex.tui (:use :cl :croatoan) (:export :main)) (defpackage :opencortex.tui
(:use :cl :croatoan)
(:export :main))
(in-package :opencortex.tui) (in-package :opencortex.tui)
(defvar *daemon-host* "127.0.0.1") (defvar *daemon-host* "127.0.0.1")
(defvar *daemon-port* 9105) (defvar *daemon-port* 9105)
(defvar *socket* nil) (defvar *socket* nil)
(defvar *stream* nil) (defvar *stream* nil)
(defvar *chat-history* nil) (defvar *chat-history* (list))
(defvar *status-text* "Connecting...") (defvar *status-text* "Connecting...")
(defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t)) (defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t))
(defvar *is-running* t) (defvar *is-running* t)
(defvar *queue-lock* (bt:make-lock)) (defvar *queue-lock* (bt:make-lock))
(defvar *incoming-msgs* nil) (defvar *incoming-msgs* nil)
(defun enqueue-msg (msg) (bt:with-lock-held (*queue-lock*) (push msg *incoming-msgs*))) (defun enqueue-msg (msg)
(defun dequeue-msgs () (bt:with-lock-held (*queue-lock*) (let ((msgs (nreverse *incoming-msgs*))) (setf *incoming-msgs* nil) msgs))) (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) (defun clean-keywords (msg)
(if (listp msg) (if (listp msg)
(let ((clean nil)) (let ((clean nil))
(loop for (k v) on msg by #'cddr (loop for (k v) on msg by #'cddr
do (push (intern (string-upcase (string k)) :keyword) clean) do (push (intern (string k) :keyword) clean)
(push v clean)) (push v clean))
(nreverse clean)) (nreverse clean))
msg)) 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 () (defun listen-thread ()
(loop while *is-running* do (loop while *is-running* do
(handler-case (handler-case
@@ -32,17 +62,27 @@
(let ((raw-msg (opencortex:read-framed-message *stream*))) (let ((raw-msg (opencortex:read-framed-message *stream*)))
(unless (member raw-msg '(:eof :error)) (unless (member raw-msg '(:eof :error))
(let* ((msg (clean-keywords raw-msg)) (let* ((msg (clean-keywords raw-msg))
(type (getf msg :TYPE)) (type (or (getf msg :TYPE) (getf msg :type)))
(payload (getf msg :PAYLOAD))) (payload (or (getf msg :PAYLOAD) (getf msg :payload))))
(cond ((eq type :EVENT) (cond ((and (listp msg) (eq type :EVENT))
(when (eq (getf payload :ACTION) :HANDSHAKE) (setf *status-text* "Ready"))) (let ((action (or (getf payload :ACTION) (getf payload :action)))
((eq type :STATUS) (text (or (getf payload :TEXT) (getf payload :text) (getf payload :MESSAGE) (getf payload :message))))
(setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]" (getf msg :SCRIBE) (getf msg :GARDENER)))) (cond ((eq action :handshake) (setf *status-text* "Ready"))
((eq type :CHAT) (text (enqueue-msg (format nil "SYSTEM: ~a" text))))))
(let ((text (getf msg :TEXT))) (when text (enqueue-msg text)))) ((and (listp msg) (eq type :STATUS))
(t (enqueue-msg (format nil "MSG: ~s" msg)))))) (setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]"
(when (eq raw-msg :eof) (setf *is-running* nil)))) (or (getf msg :SCRIBE) (getf msg :scribe))
(error (c) (setf *is-running* nil))) (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))) (sleep 0.05)))
(defun main () (defun main ()
@@ -50,43 +90,71 @@
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*)) (setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
(error (e) (format t "Error connecting: ~a~%" e) (return-from main))) (error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
(setf *stream* (usocket:socket-stream *socket*)) (setf *stream* (usocket:socket-stream *socket*))
(bt:make-thread #'listen-thread) (bt:make-thread #'listen-thread :name "tui-listener")
(unwind-protect (unwind-protect
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t) (with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t)
(let* ((h (height scr)) (w (width scr)) (let* ((h (height scr))
(w (width scr))
(chat-win (make-instance 'window :height (- h 2) :width w :position (list 0 0))) (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))) (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))) (input-win (make-instance 'window :height 1 :width w :position (list (- h 1) 0)))
(last-status nil)) (last-status nil))
(setf (function-keys-enabled-p input-win) t) (setf (function-keys-enabled-p input-win) t)
(setf (input-blocking input-win) nil) (setf (input-blocking input-win) nil)
(loop while *is-running* do (loop while *is-running* do
(let ((new (dequeue-msgs))) ;; 1. Handle incoming messages
(when new (let ((new-msgs (dequeue-msgs)))
(dolist (m new) (push m *chat-history*)) (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) (clear chat-win)
(let ((line 0)) (dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- h 3))))) (add-string chat-win m :y line :x 0) (incf line))) (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))) (refresh chat-win)))
;; 2. Render Status Bar ONLY if changed
(unless (equal *status-text* last-status) (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*)) (clear status-win)
(let* ((ev (get-wide-event input-win)) (ch (and ev (typep ev 'event) (event-key ev)))) (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 (when ch
(cond ((or (eq ch #\Newline) (eq ch #\Return)) (cond
((or (eq ch #\Newline) (eq ch #\Return))
(let ((cmd (coerce *input-buffer* 'string))) (let ((cmd (coerce *input-buffer* 'string)))
(setf (fill-pointer *input-buffer*) 0) (setf (fill-pointer *input-buffer*) 0)
(when (> (length cmd) 0) (when (> (length cmd) 0)
;; Local Echo
(enqueue-msg (concatenate 'string "> " cmd)) (enqueue-msg (concatenate 'string "> " cmd))
(let ((framed (opencortex:frame-message (list :TYPE :EVENT :PAYLOAD (list :SENSOR :chat-message :TEXT 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) (format *stream* "~a" framed)
(finish-output *stream*)) (finish-output *stream*)))
(when (string= cmd "/exit") (setf *is-running* nil))))) (when (string= cmd "/exit") (setf *is-running* nil))))
((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout)) ((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout) (eq ch #\Del))
(when (> (length *input-buffer*) 0) (decf (fill-pointer *input-buffer*)))) (when (> (length *input-buffer*) 0)
(decf (fill-pointer *input-buffer*))))
((characterp ch) ((characterp ch)
(vector-push-extend ch *input-buffer*)))) (vector-push-extend ch *input-buffer*))))
(clear input-win) (clear input-win)
(add-string input-win (concatenate 'string "> " (coerce *input-buffer* 'string))) (add-string input-win (concatenate 'string "> " (coerce *input-buffer* 'string)))
(move input-win 0 (+ 2 (length *input-buffer*))) (move input-win 0 (+ 2 (length *input-buffer*)))
(refresh input-win)) (refresh input-win))
(sleep 0.02)))) (sleep 0.02))))
(setf *is-running* nil) (when *socket* (usocket:socket-close *socket*)))) (setf *is-running* nil)
(when *socket* (usocket:socket-close *socket*))))

27
test_llm_final.lisp Normal file
View File

@@ -0,0 +1,27 @@
(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))
(push (truename "./") asdf:*central-registry*)
(ql:quickload :opencortex)
;; Manually load .env for testing
(with-open-file (in ".env" :if-does-not-exist nil)
(when in
(loop for line = (read-line in nil) while line do
(let ((pos (position #\= line)))
(when pos
(let ((key (string-trim " \"" (subseq line 0 pos)))
(val (string-trim " \"" (subseq line (1+ pos)))))
(sb-posix:putenv (format nil "~a=~a" key val))))))))
(opencortex:initialize-all-skills)
(format t "~%--- PROBING OPENROUTER ---~%")
;; Inject it directly into the vault memory to be sure
(let ((key (uiop:getenv "OPENROUTER_API_KEY")))
(when key
(setf (gethash "OPENROUTER-API-KEY" opencortex::*vault-memory*) key)))
(let ((res (opencortex:ask-probabilistic "Say Cognitive Loop Active" :cascade (list :openrouter))))
(format t "~%--- PROBE RESULT ---~%~s~%--------------------~%" res)
(if (and (stringp res) (search "Active" res))
(uiop:quit 0)
(uiop:quit 1)))

View File

@@ -17,9 +17,9 @@ def verify():
# Send "Hi" # Send "Hi"
# Make sure we use the right length. # Make sure we use the right length.
# (:TYPE :EVENT :PAYLOAD (:SENSOR :CHAT-MESSAGE :TEXT "Hi")) is 57 chars. # Send "Hi"
# Let s calculate it. # (:TYPE :EVENT :META (:SOURCE :CLI) :PAYLOAD (:SENSOR :USER-INPUT :TEXT "Hi"))
payload = '(:TYPE :EVENT :PAYLOAD (:SENSOR :CHAT-MESSAGE :TEXT "Hi"))' payload = '(:TYPE :EVENT :META (:SOURCE :CLI) :PAYLOAD (:SENSOR :USER-INPUT :TEXT "Hi"))'
length = len(payload) length = len(payload)
msg = f"{length:06x}{payload}".encode() msg = f"{length:06x}{payload}".encode()
print(f"Sending: {msg.decode()}") print(f"Sending: {msg.decode()}")
@@ -27,13 +27,12 @@ def verify():
# Read response # Read response
while True: while True:
chunk = s.recv(4096) chunk = s.recv(4096).decode()
if not chunk: break if not chunk: break
print(f"Received chunk: {chunk.decode()}") print(f"Received chunk: {chunk}")
if ":CHAT" in chunk.decode() or "Neural Cascade Failure" in chunk.decode(): if ":REQUEST" in chunk or ":PAYLOAD" in chunk or "Neural Cascade Failure" in chunk:
print("SUCCESS: Response received!") print("SUCCESS: Response received!")
break break
s.close() s.close()
except Exception as e: except Exception as e:
print(f"Error: {e}") print(f"Error: {e}")