From c70f1828889e5ec014aea22d41f6a09512ca0e19 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Mon, 20 Apr 2026 18:19:54 -0400 Subject: [PATCH] FEAT: Stabilize Unified Envelope Architecture & TUI UX - 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. --- literate/act.org | 75 +++++++++---- literate/communication.org | 68 ++++++++++++ literate/perceive.org | 3 +- literate/reason.org | 31 ++++-- literate/tui-client.org | 33 +++++- mock_daemon.lisp | 28 +++++ mock_daemon.py | 28 +++++ opencortex.sh | 128 ++++++++++++---------- scripts/opencortex-chat.sh | 31 ++++-- skills/org-skill-cli-gateway.org | 12 ++- skills/org-skill-llm-gateway.org | 4 +- src/act.lisp | 90 ++++++++++------ src/communication.lisp | 67 +++++++++--- src/org-agent.el | 8 +- src/perceive.lisp | 3 +- src/reason.lisp | 31 ++++-- src/tui-client.lisp | 178 +++++++++++++++++++++---------- test_llm_final.lisp | 27 +++++ verify_response.py | 15 ++- 19 files changed, 637 insertions(+), 223 deletions(-) create mode 100644 mock_daemon.lisp create mode 100644 mock_daemon.py create mode 100644 test_llm_final.lisp diff --git a/literate/act.org b/literate/act.org index 8e82c6c..1e0165f 100644 --- a/literate/act.org +++ b/literate/act.org @@ -29,7 +29,12 @@ The core harness can be configured via environment variables to operate silently ;; Register core harness actuators (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 ** 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 (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* ((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*))) + ;; 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 ~a" target))))) + (harness-log "ACT ERROR: No actuator for ~s (from ~s)" target raw-target))))) #+end_src ** 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. #+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) "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))) - (list :type :EVENT :depth (1+ depth) :reply-stream (getf context :reply-stream) - :payload (list :sensor :tool-output :result result :tool tool-name))) + (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) :reply-stream (getf context :reply-stream) - :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) - :payload (list :sensor :tool-error :message "Tool not found"))))) + (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"))))) #+end_src ** 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." (let* ((approved (getf signal :approved-action)) (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) (when approved @@ -119,23 +159,22 @@ The final stage of the metabolic loop. It performs a "last-mile" safety check be ;; 2. Actuation Logic (case type - (:REQUEST (dispatch-action signal signal)) - (:LOG (dispatch-action signal signal)) + (:REQUEST (dispatch-action signal context)) + (:LOG (dispatch-action signal context)) (:EVENT (if approved (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. ;; 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)) - :reply-stream (getf signal :reply-stream) + (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 reply-stream, this might be a raw event/log stimulus. - (when (getf signal :reply-stream) - (dispatch-action signal signal))))) + ;; 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)) diff --git a/literate/communication.org b/literate/communication.org index b8df047..be3c5c3 100644 --- a/literate/communication.org +++ b/literate/communication.org @@ -80,3 +80,71 @@ The ~communication.lisp~ module defines the low-level transport and framing logi :VERSION version :CAPABILITIES '(:AUTH :SWANK :ORG-AST)))) #+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 diff --git a/literate/perceive.org b/literate/perceive.org index 4b5a135..28484d8 100644 --- a/literate/perceive.org +++ b/literate/perceive.org @@ -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." (let* ((payload (getf signal :payload)) (type (getf signal :type)) + (meta (getf signal :meta)) (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) (case sensor diff --git a/literate/reason.org b/literate/reason.org index d987cef..669db89 100644 --- a/literate/reason.org +++ b/literate/reason.org @@ -60,20 +60,35 @@ The Reason stage is the cognitive engine of the OpenCortex. It bridges the gap b (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" + (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 \"\")) + +To call a tool, you MUST use: +(:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"\" :ARGS (:arg1 \"val\")) + +PROVIDER RULE: Always use :provider :openrouter if calling LLM tools unless specified otherwise." assistant-name global-context tool-belt system-logs))) (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)) (let ((*read-eval* nil)) (if (and (> (length cleaned) 0) (char= (char cleaned 0) #\()) (handler-case (let ((parsed (read-from-string cleaned))) - (if (and (listp parsed) (member (proto-get parsed :TYPE) '(:CHAT :REQUEST :EVENT :STATUS :RESPONSE))) - parsed - (list :TYPE :CHAT :TEXT cleaned))) - (error (c) (list :TYPE :CHAT :TEXT cleaned))) - (list :TYPE :CHAT :TEXT 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 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))))) #+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)) (payload (proto-get signal :payload)) (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)) (let ((candidate (think signal))) (if candidate diff --git a/literate/tui-client.org b/literate/tui-client.org index 98c89e9..fc18f49 100644 --- a/literate/tui-client.org +++ b/literate/tui-client.org @@ -47,6 +47,27 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro (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 @@ -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]" (or (getf msg :SCRIBE) (getf msg :scribe)) (or (getf msg :GARDENER) (getf msg :gardener))))) - ((and (listp msg) (eq type :CHAT)) - (let ((text (or (getf msg :TEXT) (getf msg :text)))) (when text (enqueue-msg text)))) + ((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")))) @@ -126,7 +151,9 @@ The OpenCortex TUI Client is a standalone Common Lisp application built on **Cro ;; Local Echo (enqueue-msg (concatenate 'string "> " cmd)) ;; 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) (finish-output *stream*))) (when (string= cmd "/exit") (setf *is-running* nil)))) diff --git a/mock_daemon.lisp b/mock_daemon.lisp new file mode 100644 index 0000000..b332b18 --- /dev/null +++ b/mock_daemon.lisp @@ -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))) diff --git a/mock_daemon.py b/mock_daemon.py new file mode 100644 index 0000000..64aefbe --- /dev/null +++ b/mock_daemon.py @@ -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() diff --git a/opencortex.sh b/opencortex.sh index 9452bc5..6559de7 100755 --- a/opencortex.sh +++ b/opencortex.sh @@ -17,21 +17,13 @@ done export SCRIPT_DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )" # Load environment variables if they exist -# Priority 1: $HOME/.local/share/opencortex/.env -# 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 +if [ -f "$SCRIPT_DIR/.env" ]; then while IFS="=" read -r key value || [ -n "$key" ]; do 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" fi - done < "$ENV_PATH" + done < "$SCRIPT_DIR/.env" [ -n "$HARNESS_PORT" ] && PORT=$HARNESS_PORT [ -n "$HARNESS_HOST" ] && HOST=$HARNESS_HOST fi @@ -47,10 +39,9 @@ fi # --- 2. SETUP --- setup_system() { echo -e "${BLUE}=== OpenCortex: Initializing System ===${NC}" - echo -e "${YELLOW}--- Installing System Dependencies ---${NC}" 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 if [ ! -d "$HOME/quicklisp" ]; then curl -O https://beta.quicklisp.org/quicklisp.lisp @@ -59,7 +50,7 @@ setup_system() { fi cd "$SCRIPT_DIR" - if [ ! -f .env ] && [ ! -f "$HOME/.local/share/opencortex/.env" ]; then + if [ ! -f .env ]; then cp .env.example .env 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 echo -e "\n${YELLOW}--- Memex Folder Structure ---${NC}" - read -p "Memex Root [$HOME/memex]: " memex_root < /dev/tty - memex_root=${memex_root:-$HOME/memex} - sed -i "s|MEMEX_ROOT=.*|MEMEX_ROOT=\"$memex_root\"|" .env + read -p "Memex Root [\$HOME/memex]: " memex_dir < /dev/tty + memex_dir=${memex_dir:-\$HOME/memex} + 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 - echo -e "\n${YELLOW}--- Warming Neural Cache ---${NC}" - rm -rf "$HOME/.cache/common-lisp" - sbcl --non-interactive --eval "(load (merge-pathnames \"quicklisp/setup.lisp\" (user-homedir-pathname)))" \ - --eval "(push (truename \"$SCRIPT_DIR\") asdf:*central-registry*)" \ - --eval "(ql:quickload '(:opencortex :opencortex/tui :croatoan))" + mkdir -p src + for f in literate/*.org; do + emacs --batch --eval "(require 'org)" --eval "(org-babel-tangle-file \"$f\")" >/dev/null 2>&1 || true + done + + mkdir -p "$HOME/.local/bin" + ln -sf "$SCRIPT_DIR/opencortex.sh" "$HOME/.local/bin/opencortex" - echo -e "\n${YELLOW}--- Finalizing: Awakening the Brain as a background daemon ---${NC}" + 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" - 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 for i in {1..30}; do @@ -103,14 +131,18 @@ setup_system() { success=true break fi - echo -n "." sleep 2 + echo -n "." done if [ "$success" = true ]; then echo -e "\n${GREEN}✓ Brain is alive and responsive on port $PORT.${NC}" echo -e "${GREEN}✓ Setup complete.${NC}" - echo -e "${BLUE}To start, run:${NC} ${GREEN}opencortex tui${NC}" + if command -v opencortex >/dev/null 2>&1; then + 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 else echo -e "\n${RED}✗ Brain failed to wake up.${NC}" @@ -121,9 +153,11 @@ setup_system() { } # --- 3. COMMAND ROUTER --- +# By default, if no arguments are provided, we assume the user wants the CLI fallback. 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" fi @@ -133,56 +167,32 @@ case "$COMMAND" in ;; --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" [ -z "$MEMEX_DIR" ] && export MEMEX_DIR="$HOME/memex" - - # 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)" + 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)' ;; tui) 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..." - touch "$SCRIPT_DIR/boot.lock" - bash "$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 & - fi - - for i in {1..30}; do + echo -e "Brain is offline. Awakening..." + "$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 & + for i in {1..15}; do sleep 2 if nc -z $HOST $PORT 2>/dev/null; then break; fi echo -n "." done echo "" - rm -f "$SCRIPT_DIR/boot.lock" fi - echo -e "Launching Croatoan TUI..." export SKILLS_DIR="${SCRIPT_DIR}/skills" [ -z "$MEMEX_DIR" ] && export MEMEX_DIR="$HOME/memex" - exec sbcl --disable-debugger --eval "(load (merge-pathnames \"quicklisp/setup.lisp\" (user-homedir-pathname)))" \ - --eval "(push (truename \"$SCRIPT_DIR\") asdf:*central-registry*)" \ - --eval "(ql:quickload :opencortex/tui)" \ - --eval "(opencortex.tui:main)" + 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)' ;; cli) if ! nc -z $HOST $PORT 2>/dev/null; then 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 sleep 2 if nc -z $HOST $PORT 2>/dev/null; then break; fi @@ -191,9 +201,9 @@ case "$COMMAND" in echo "" fi if command_exists socat; then - exec socat - TCP:$HOST:$PORT + exec socat - TCP:: else - exec nc $HOST $PORT + exec nc fi ;; diff --git a/scripts/opencortex-chat.sh b/scripts/opencortex-chat.sh index eee422a..3706ca4 100755 --- a/scripts/opencortex-chat.sh +++ b/scripts/opencortex-chat.sh @@ -7,14 +7,33 @@ HOST=${1:-localhost} if command -v socat >/dev/null 2>&1; then # Use socat with READLINE for history and arrow-key support. # It establishes a persistent bidirectional connection. - socat READLINE,history=$HOME/.org_agent_history TCP:$HOST:$PORT -else - # 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 "WARNING: socat not found. Falling back to nc (no line-editing support)." + # Note: socat READLINE doesn't handle hex-length framing automatically for input. + # We use a wrapper to frame the message. + + echo "Connected to OpenCortex on $HOST:$PORT (Channel: CLI)" while true; do read -p "User: " MESSAGE if [ -z "$MESSAGE" ]; then continue; fi - echo "$MESSAGE" | nc -N $HOST $PORT + if [ "$MESSAGE" = "/exit" ]; then break; fi + + # 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 diff --git a/skills/org-skill-cli-gateway.org b/skills/org-skill-cli-gateway.org index e11b7b6..b529fed 100644 --- a/skills/org-skill-cli-gateway.org +++ b/skills/org-skill-cli-gateway.org @@ -24,12 +24,11 @@ The *CLI Gateway* is the primary sensory and actuating interface for human inter (defun execute-cli-action (action context) "Sends a framed message back to the connected CLI client." (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))) (handler-case (if (and stream (open-stream-p stream)) (progn - (format stream "~a" (frame-message (list :TYPE :CHAT :TEXT text))) + (format stream "~a" (frame-message action)) (finish-output stream) (format stream "~a" (frame-message '(:TYPE :STATUS :SCRIBE :IDLE :GARDENER :SLEEPING))) (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) (cond ((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) "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))) (cond ((eq msg :eof) (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) #\/)) (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))) diff --git a/skills/org-skill-llm-gateway.org b/skills/org-skill-llm-gateway.org index 5b16259..86df082 100644 --- a/skills/org-skill-llm-gateway.org +++ b/skills/org-skill-llm-gateway.org @@ -122,12 +122,12 @@ The gateway utilizes a functional dispatch pattern. A single entry point, `execu "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 "The provider.") + (:provider :type :keyword :description "The provider. (Default: :openrouter)") (: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) + :provider (or (getf args :provider) :openrouter) :model (getf args :model)))) (defskill :skill-llm-gateway diff --git a/src/act.lisp b/src/act.lisp index 8b5a2d3..fcd118e 100644 --- a/src/act.lisp +++ b/src/act.lisp @@ -1,25 +1,27 @@ (in-package :opencortex) -(defvar *default-actuator* :CLI) -(defvar *silent-actuators* '(:CLI :SYSTEM-MESSAGE :EMACS)) +(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 (string-trim '(#\Space #\" #\') (or (uiop:getenv "DEFAULT_ACTUATOR") "CLI"))) - (silent (or (uiop:getenv "SILENT_ACTUATORS") "CLI,SYSTEM-MESSAGE,EMACS"))) + (let ((def (uiop:getenv "DEFAULT_ACTUATOR")) + (silent (uiop:getenv "SILENT_ACTUATORS"))) (when def - (let ((clean-def (string-trim '(#\Space #\" #\') def))) - (setf *default-actuator* (intern (string-upcase clean-def) "KEYWORD")))) + (setf *default-actuator* (intern (string-upcase def) "KEYWORD"))) (when silent (setf *silent-actuators* - (mapcar (lambda (s) - (let ((clean-s (string-trim '(#\Space #\" #\') s))) - (intern (string-upcase clean-s) "KEYWORD"))) - (uiop:split-string silent :separator '(#\,)))))) + (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 :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) (let ((payload (proto-get action :payload))) @@ -27,11 +29,17 @@ (return-from dispatch-action nil))) "Routes an approved action to its registered physical actuator." (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)) + 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))))) @@ -52,34 +60,53 @@ (: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) :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)))) - ;; If we have a reply stream, also send a chat message with the result - (when (getf context :REPLY-STREAM) - (dispatch-action (list :TYPE :CHAT :TEXT (format nil "TOOL [~a] RESULT: ~a" tool-name result)) context)) + ;; 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) :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))))) - (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"))))) (defun act-gate (signal) "Final Stage: Actuation and feedback generation." - (let* ((approved (proto-get signal :approved-action)) - (type (proto-get signal :type)) - (feedback nil)) + (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 @@ -90,32 +117,31 @@ (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 (getf signal :approved-action) nil) (setf approved nil) (setf feedback verified)) (progn - (setf (getf signal :APPROVED-ACTION) verified) + (setf (getf signal :approved-action) verified) (setf approved verified))))) ;; 2. Actuation Logic (case type - (:REQUEST (dispatch-action signal signal)) - (:LOG (dispatch-action signal signal)) + (:REQUEST (dispatch-action signal context)) + (:LOG (dispatch-action signal context)) (:EVENT (if approved - (let* ((target (proto-get approved :target)) - (result (dispatch-action approved signal))) + (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+ (or (proto-get signal :depth) 0)) - :reply-stream (proto-get signal :reply-stream) + (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 reply-stream, this might be a raw event/log stimulus. - (when (proto-get signal :reply-stream) - (dispatch-action signal signal))))) + ;; 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)) diff --git a/src/communication.lisp b/src/communication.lisp index 265cd0e..4f9fb2b 100644 --- a/src/communication.lisp +++ b/src/communication.lisp @@ -1,12 +1,15 @@ (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)))) (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)) @@ -14,25 +17,59 @@ (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))) - (if (< count 6) :eof - (let ((len (ignore-errors (parse-integer length-buffer :radix 16)))) - (if (not len) :error - (let ((msg-buffer (make-string len))) - (read-sequence msg-buffer stream) - (let ((*read-eval* nil) (*print-pretty* nil)) - (handler-case - (let ((msg (read-from-string msg-buffer))) - (validate-communication-protocol-schema msg) - msg) - (error (c) :error))))))))) - (error (c) :error)))) + (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) - (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))) diff --git a/src/org-agent.el b/src/org-agent.el index ce86a22..504ed5b 100644 --- a/src/org-agent.el +++ b/src/org-agent.el @@ -143,8 +143,9 @@ will assume you have started it manually (e.g., via SBCL)." ((member type '(:response :RESPONSE)) (message "opencortex: Received response for ID %s" id)) ((member type '(:log :LOG)) - (let ((text (opencortex--plist-get payload :text))) - (opencortex--insert-to-history (concat "[reasoning] " text "\n") 'opencortex-system-face))) + (let ((text (opencortex--plist-get payload :text)) + (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))))) (defun opencortex--execute-request (proc id payload) @@ -359,7 +360,8 @@ Opens a history buffer and a dedicated input area." ;; Send to daemon (opencortex-send `(:type :EVENT - :payload (:sensor :chat-message + :meta (:source :emacs) + :payload (:sensor :user-input :text ,clean-text))) (message "opencortex: Message sent.")))) diff --git a/src/perceive.lisp b/src/perceive.lisp index ecbd95a..62d5b7e 100644 --- a/src/perceive.lisp +++ b/src/perceive.lisp @@ -27,8 +27,9 @@ "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)" 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) (case sensor diff --git a/src/reason.lisp b/src/reason.lisp index e37fb8f..a6a6e13 100644 --- a/src/reason.lisp +++ b/src/reason.lisp @@ -38,20 +38,35 @@ (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" + (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 \"\")) + +To call a tool, you MUST use: +(:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"\" :ARGS (:arg1 \"val\")) + +PROVIDER RULE: Always use :provider :openrouter if calling LLM tools unless specified otherwise." assistant-name global-context tool-belt system-logs))) (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)) (let ((*read-eval* nil)) (if (and (> (length cleaned) 0) (char= (char cleaned 0) #\()) (handler-case (let ((parsed (read-from-string cleaned))) - (if (and (listp parsed) (member (proto-get parsed :TYPE) '(:CHAT :REQUEST :EVENT :STATUS :RESPONSE))) - parsed - (list :TYPE :CHAT :TEXT cleaned))) - (error (c) (list :TYPE :CHAT :TEXT cleaned))) - (list :TYPE :CHAT :TEXT 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 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))))) (defun deterministic-verify (proposed-action context) @@ -80,7 +95,7 @@ (let* ((type (proto-get signal :type)) (payload (proto-get signal :payload)) (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)) (let ((candidate (think signal))) (if candidate diff --git a/src/tui-client.lisp b/src/tui-client.lisp index b04076f..563ac7b 100644 --- a/src/tui-client.lisp +++ b/src/tui-client.lisp @@ -1,30 +1,60 @@ (in-package :cl-user) -(defpackage :opencortex.tui (:use :cl :croatoan) (:export :main)) +(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* 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 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-upcase (string k)) :keyword) clean) + 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 @@ -32,17 +62,27 @@ (let ((raw-msg (opencortex:read-framed-message *stream*))) (unless (member raw-msg '(:eof :error)) (let* ((msg (clean-keywords raw-msg)) - (type (getf msg :TYPE)) - (payload (getf msg :PAYLOAD))) - (cond ((eq type :EVENT) - (when (eq (getf payload :ACTION) :HANDSHAKE) (setf *status-text* "Ready"))) - ((eq type :STATUS) - (setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]" (getf msg :SCRIBE) (getf msg :GARDENER)))) - ((eq type :CHAT) - (let ((text (getf msg :TEXT))) (when text (enqueue-msg text)))) - (t (enqueue-msg (format nil "MSG: ~s" msg)))))) - (when (eq raw-msg :eof) (setf *is-running* nil)))) - (error (c) (setf *is-running* nil))) + (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 () @@ -50,43 +90,71 @@ (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) + (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 - (let ((new (dequeue-msgs))) - (when new - (dolist (m new) (push m *chat-history*)) - (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))) - (refresh chat-win))) - (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*)) - (let* ((ev (get-wide-event input-win)) (ch (and ev (typep ev 'event) (event-key ev)))) - (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) - (enqueue-msg (concatenate 'string "> " cmd)) - (let ((framed (opencortex:frame-message (list :TYPE :EVENT :PAYLOAD (list :SENSOR :chat-message :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)) - (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*)))) + (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*)))) diff --git a/test_llm_final.lisp b/test_llm_final.lisp new file mode 100644 index 0000000..cedd05d --- /dev/null +++ b/test_llm_final.lisp @@ -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))) diff --git a/verify_response.py b/verify_response.py index 2f1bb55..b512ee5 100644 --- a/verify_response.py +++ b/verify_response.py @@ -17,23 +17,22 @@ def verify(): # Send "Hi" # Make sure we use the right length. - # (:TYPE :EVENT :PAYLOAD (:SENSOR :CHAT-MESSAGE :TEXT "Hi")) is 57 chars. - # Let s calculate it. - payload = '(:TYPE :EVENT :PAYLOAD (:SENSOR :CHAT-MESSAGE :TEXT "Hi"))' + # Send "Hi" + # (:TYPE :EVENT :META (:SOURCE :CLI) :PAYLOAD (:SENSOR :USER-INPUT :TEXT "Hi")) + payload = '(:TYPE :EVENT :META (:SOURCE :CLI) :PAYLOAD (:SENSOR :USER-INPUT :TEXT "Hi"))' length = len(payload) msg = f"{length:06x}{payload}".encode() print(f"Sending: {msg.decode()}") s.sendall(msg) - + # Read response while True: - chunk = s.recv(4096) + chunk = s.recv(4096).decode() if not chunk: break - print(f"Received chunk: {chunk.decode()}") - if ":CHAT" in chunk.decode() or "Neural Cascade Failure" in chunk.decode(): + print(f"Received chunk: {chunk}") + if ":REQUEST" in chunk or ":PAYLOAD" in chunk or "Neural Cascade Failure" in chunk: print("SUCCESS: Response received!") break - s.close() except Exception as e: print(f"Error: {e}")