From 86eeaab66e78ad85155bb4afbef3b795bdf13b41 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Sat, 25 Apr 2026 20:31:05 -0400 Subject: [PATCH] Fix duplicate frame-message, tangled files, package.lisp corruption - Removed duplicate frame-message from communication.org (was in 2 src blocks) - Fixed communication.org :tangle directive (was wrongly targeting package.lisp) - Added (in-package :opencortex) to engineering-standards.lisp - Retangled package.org, communication.org, engineering-standards.org Tests still not running - investigation in progress. --- harness/communication.org | 10 +-- library/communication-tests.lisp | 41 +++++++++ library/communication.lisp | 24 +++--- .../gen/org-skill-engineering-standards.lisp | 2 + library/package.lisp | 84 +++++++------------ skills/org-skill-engineering-standards.org | 2 + 6 files changed, 85 insertions(+), 78 deletions(-) create mode 100644 library/communication-tests.lisp diff --git a/harness/communication.org b/harness/communication.org index 2e9079c..a3bb354 100644 --- a/harness/communication.org +++ b/harness/communication.org @@ -10,7 +10,7 @@ The ~communication.lisp~ module defines the low-level transport and framing logi * Implementation (communication.lisp) -#+begin_src lisp :tangle ../library/package.lisp +#+begin_src lisp :tangle ../library/communication.lisp (in-package :opencortex) (defun proto-get (plist key) @@ -32,13 +32,7 @@ The ~communication.lisp~ module defines the low-level transport and framing logi (let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword)))) (setf (gethash key *actuator-registry*) fn))) -(defun frame-message (msg-plist) - "Frames a Lisp plist with a 6-character hex length and a newline for stream integrity." - (let* ((*print-pretty* nil) - (*print-circle* nil) - (msg-string (format nil "~s" msg-plist)) - (len (length msg-string))) - (format nil "~6,'0x~a~%" len msg-string))) +;; Removed duplicate frame-message - kept the sanitized version below (defun read-framed-message (stream) "Reads a hex-length prefixed S-expression from the stream securely. Skips leading whitespace." diff --git a/library/communication-tests.lisp b/library/communication-tests.lisp new file mode 100644 index 0000000..15dc7ef --- /dev/null +++ b/library/communication-tests.lisp @@ -0,0 +1,41 @@ +(defpackage :opencortex-communication-tests + (:use :cl :fiveam :opencortex) + (:export #:communication-protocol-suite)) + +(in-package :opencortex-communication-tests) + +(def-suite communication-protocol-suite + :description "Test suite for opencortex Communication Protocol") + +(in-suite communication-protocol-suite) + +(test test-framing + "Verify that messages are correctly prefixed with a 6-character hex length." + (let* ((msg '(:type :EVENT :payload (:action :handshake))) + (framed (frame-message msg)) + (len-str (subseq framed 0 6)) + (payload (subseq framed 6))) + (is (string= "00002C" (string-upcase len-str))) + (is (equalp msg (read-from-string payload))))) + +(test test-parse-message + "Verify that incoming framed strings are parsed into Lisp plists." + (let ((framed "00002c(:type :EVENT :payload (:action :handshake))")) + (is (equal '(:type :EVENT :payload (:action :handshake)) + (read-from-string (subseq framed 6)))))) + +(test test-hello-handshake + "Verify the structure of the HELLO handshake message." + (let ((hello (make-hello-message "0.1.0"))) + (is (eq :EVENT (getf hello :type))) + (is (eq :handshake (getf (getf hello :payload) :action))) + (is (string= "0.1.0" (getf (getf hello :payload) :version))))) + +(test test-find-missing-id + "Verify that the daemon can find a headline missing an ID." + (let* ((ast '(:type :org-data :contents + ((:type :HEADLINE :properties (:TITLE "No ID Here") :contents nil) + (:type :HEADLINE :properties (:ID "exists" :TITLE "Has ID") :contents nil)))) + (found (find-headline-missing-id ast))) + (is (not (null found))) + (is (string= "No ID Here" (getf (getf found :properties) :TITLE))))) diff --git a/library/communication.lisp b/library/communication.lisp index a5b7b2a..c307a3f 100644 --- a/library/communication.lisp +++ b/library/communication.lisp @@ -1,5 +1,14 @@ (in-package :opencortex) +(defun proto-get (plist key) + "Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions." + (let* ((s (string key)) + (up (intern (string-upcase s) :keyword)) + (dn (intern (string-downcase s) :keyword))) + (or (getf plist up) (getf plist dn)))) + +(in-package :opencortex) + (defvar *actuator-registry* (make-hash-table :test 'equalp) "Global registry mapping target keywords to their physical actuator functions.") @@ -8,20 +17,7 @@ (let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword)))) (setf (gethash key *actuator-registry*) fn))) -(defun frame-message (msg-plist) - "Frames a Lisp plist with a 6-character hex length and a newline for stream integrity." - (let* ((*print-pretty* nil) - (*print-circle* nil) - (msg-string (format nil "~s" msg-plist)) - (len (length msg-string))) - (format nil "~6,'0x~a~%" len msg-string))) - -(defun parse-message (framed-string) - "Parses a hex-length prefixed framed string into a Lisp plist." - (let* ((len (parse-integer (subseq framed-string 0 6) :radix 16)) - (payload (subseq framed-string 6 (+ 6 len)))) - (let ((*read-eval* nil)) - (read-from-string payload)))) +;; Removed duplicate frame-message - kept the sanitized version below (defun read-framed-message (stream) "Reads a hex-length prefixed S-expression from the stream securely. Skips leading whitespace." diff --git a/library/gen/org-skill-engineering-standards.lisp b/library/gen/org-skill-engineering-standards.lisp index 123ebb7..bfcff96 100644 --- a/library/gen/org-skill-engineering-standards.lisp +++ b/library/gen/org-skill-engineering-standards.lisp @@ -1,3 +1,5 @@ +(in-package :opencortex) + (defvar *engineering-std-*project-root* nil "Path to the project root for enforcement checks.") diff --git a/library/package.lisp b/library/package.lisp index 272064a..2cdc300 100644 --- a/library/package.lisp +++ b/library/package.lisp @@ -1,6 +1,6 @@ (defpackage :opencortex (:use :cl) - (:export + (:export ;; --- communication protocol --- #:frame-message #:read-framed-message @@ -12,13 +12,13 @@ #:parse-message #:make-hello-message #:validate-communication-protocol-schema - + ;; --- Daemon Lifecycle --- #:start-daemon #:stop-daemon #:harness-log #:main - + ;; --- Memory (CLOSOS) --- #:ingest-ast #:lookup-object @@ -40,9 +40,7 @@ #:org-object-hash #:snapshot-memory #:rollback-memory - #:save-memory-to-disk - #:load-memory-from-disk - + ;; --- Context API (Peripheral Vision) --- #:context-query-store #:context-get-active-projects @@ -54,7 +52,7 @@ #:context-get-skill-telemetry #:harness-track-telemetry #:context-assemble-global-awareness - + ;; --- Reactive Signal Pipeline --- #:process-signal #:perceive-gate @@ -68,7 +66,7 @@ #:initialize-actuators #:dispatch-action #:register-actuator - + ;; --- Skill Engine --- #:load-skill-from-org #:initialize-all-skills @@ -101,63 +99,50 @@ #:register-emacs-client #:unregister-emacs-client - ;; --- Probabilistic Engine --- - #:ask-probabilistic - #:register-probabilistic-backend - #:distill-prompt - #:*provider-cascade* + ;; --- Probabilistic Engine --- + #:ask-probabilistic + #:register-probabilistic-backend + #:distill-prompt + #:*provider-cascade* - ;; --- Vector Search --- - #:get-embedding - #:cosine-similarity - #:semantic-search - - ;; --- Tool Permissions --- - #:get-tool-permission - #:set-tool-permission - #:check-tool-permission-gate - - ;; --- Emacs Edit Skill --- - #:emacs-edit-generate-id - #:emacs-edit-id-format - #:emacs-edit-set-property - #:emacs-edit-set-todo - - ;; --- Self-Edit Skill --- - #:self-edit-balance-parens - #:self-edit-apply - - ;; --- Security Vault --- + ;; --- Security Vault --- #:vault-get-secret #:vault-set-secret - + ;; --- Deterministic Logic --- #:list-objects-with-attribute #:deterministic-verify - + ;; --- AST Helpers --- #:find-headline-missing-id)) (in-package :opencortex) +(defun proto-get (plist key) + "Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions." + (let* ((s (string key)) + (up (intern (string-upcase s) :keyword)) + (dn (intern (string-downcase s) :keyword))) + (or (getf plist up) (getf plist dn)))) + (defvar *system-logs* nil) -(defvar *logs-lock* (bordeaux-threads:make-lock "harness-logs-lock")) +(defvar *logs-lock* (bt:make-lock "harness-logs-lock")) (defvar *max-log-history* 100) (defvar *skills-registry* (make-hash-table :test 'equal) "Global registry of all loaded skills.") (defvar *skill-telemetry* (make-hash-table :test 'equal)) -(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock")) +(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock")) (defun harness-track-telemetry (skill-name duration status) "Updates performance metrics for a specific skill. Status should be :success or :rejected." - (when skill-name - (bordeaux-threads:with-lock-held (*telemetry-lock*) + (when skill-name + (bt:with-lock-held (*telemetry-lock*) (let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0)))) - (incf (getf entry :executions)) + (incf (getf entry :executions)) (incf (getf entry :total-time) duration) - (when (eq status :rejected) (incf (getf entry :failures))) + (when (eq status :rejected) (incf (getf entry :failures))) (setf (gethash skill-name *skill-telemetry*) entry))))) (defvar *cognitive-tools* (make-hash-table :test 'equal)) @@ -181,22 +166,9 @@ (defun harness-log (msg &rest args) "Centralized logging for the harness." (let ((formatted-msg (apply #'format nil msg args))) - (bordeaux-threads:with-lock-held (*logs-lock*) + (bt:with-lock-held (*logs-lock*) (push formatted-msg *system-logs*) (when (> (length *system-logs*) *max-log-history*) (setq *system-logs* (subseq *system-logs* 0 *max-log-history*)))) (format t "~a~%" formatted-msg) (finish-output))) - -(defun proto-get (plist key) - "Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions." - (let* ((s (string key)) - (up (intern (string-upcase s) :keyword)) - (dn (intern (string-downcase s) :keyword))) - (or (getf plist up) (getf plist dn)))) - -(defun get-cognitive-tool-body (tool-name) - "Retrieves the body function of a cognitive tool, or nil if not found." - (let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tools*))) - (when tool - (cognitive-tool-body tool)))) diff --git a/skills/org-skill-engineering-standards.org b/skills/org-skill-engineering-standards.org index 0d3bff6..8715589 100644 --- a/skills/org-skill-engineering-standards.org +++ b/skills/org-skill-engineering-standards.org @@ -108,6 +108,8 @@ The engineering standards skill is a HARD BLOCK gate. Violations are rejected, n ** Pre-Task Enforcement (Blocking) #+begin_src lisp :tangle ../library/gen/org-skill-engineering-standards.lisp +(in-package :opencortex) + (defvar *engineering-std-*project-root* nil "Path to the project root for enforcement checks.")