amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

docs: global terminology update from kernel/core to harness

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-12 18:28:11 -04:00
parent 475f79e79d
commit 3f8c37712c
71 changed files with 255 additions and 499 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/accountant-logic.lisp
View File

@@ -5,7 +5,7 @@
(defun token-accountant-record-pain (provider)
"Marks a provider as 'pained' (failed). It will be de-prioritized."
(setf (gethash provider *provider-pain-table*) (+ (get-universal-time) 600)) ; 10 min penalty
(kernel-log "ACCOUNTANT - Provider ~a de-prioritized due to failure." provider))
(harness-log "ACCOUNTANT - Provider ~a de-prioritized due to failure." provider))
(defun token-accountant-get-cascade (context)
"Returns a dynamic list of providers, routing around pained ones. Uses standardized gateway keywords."
@@ -37,6 +37,6 @@
(t nil))))
(defun token-accountant-patch-kernel ()
"Hot-patches the kernel's cascade and model selector to use our dynamic logic."
"Hot-patches the harness's cascade and model selector to use our dynamic logic."
(setf org-agent:*provider-cascade* #'token-accountant-get-cascade)
(setf org-agent::*model-selector-fn* #'token-accountant-get-model-for-provider))

10
src/bouncer.lisp
View File

@@ -42,21 +42,21 @@
;; 1. Secret Exposure Vector (Hard Block)
((and text (bouncer-scan-secrets text))
(let ((secret-name (bouncer-scan-secrets text)))
(kernel-log "SECURITY VIOLATION: Blocked leak of secret ~a" secret-name)
(harness-log "SECURITY VIOLATION: Blocked leak of secret ~a" secret-name)
`(:type :log :payload (:level :error :text ,(format nil "Action blocked: Potential exposure of ~a" secret-name)))))
;; 2. Network Exfiltration Vector (Authorization Required)
((and (or (eq target :shell)
(and (eq target :tool) (equal (getf payload :tool) "shell")))
(bouncer-check-network-exfil cmd))
(kernel-log "SECURITY WARNING: External network call detected. Queuing for approval.")
(harness-log "SECURITY WARNING: External network call detected. Queuing for approval.")
`(:type :EVENT :payload (:sensor :approval-required :action ,action)))
;; 3. High-Impact Target Vector (Authorization Required)
((or (member target '(:shell))
(and (eq target :tool) (member (getf payload :tool) '("shell" "repair-file") :test #'string=))
(and (eq target :emacs) (eq (getf payload :action) :eval)))
(kernel-log "SECURITY: High-impact action ~a requires approval." (or (getf payload :tool) target))
(harness-log "SECURITY: High-impact action ~a requires approval." (or (getf payload :tool) target))
`(:type :EVENT :payload (:sensor :approval-required :action ,action)))
;; 4. Default Pass
@@ -71,7 +71,7 @@
(let* ((tags (getf (org-object-attributes node) :TAGS))
(action-str (getf (org-object-attributes node) :ACTION)))
(when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
(kernel-log "BOUNCER: Found approved flight plan ~a. Re-injecting..." (org-object-id node))
(harness-log "BOUNCER: Found approved flight plan ~a. Re-injecting..." (org-object-id node))
(let ((action (ignore-errors (read-from-string action-str))))
(when action
;; Mark as approved to bypass the gate
@@ -97,7 +97,7 @@
(:approval-required
(let* ((blocked-action (getf payload :action))
(id (org-id-new)))
(kernel-log "BOUNCER: Creating flight plan node...")
(harness-log "BOUNCER: Creating flight plan node...")
;; Create the node in Emacs (or inbox)
(list :type :REQUEST :target :emacs :action :insert-node
:id id :attributes `(:TITLE "Flight Plan: High-Risk Action"

12
src/chaos-logic.lisp
View File

@@ -3,9 +3,9 @@
(defun chaos-inject-error (sensor-type)
"Injects a synthetic error into a specific sensor pipeline."
(unless *chaos-enabled-p*
(kernel-log "CHAOS ERROR - Injection blocked. Production gate is ACTIVE.")
(harness-log "CHAOS ERROR - Injection blocked. Production gate is ACTIVE.")
(return-from chaos-inject-error nil))
(kernel-log "CHAOS - Injecting synthetic error into ~a sensor..." sensor-type)
(harness-log "CHAOS - Injecting synthetic error into ~a sensor..." sensor-type)
(inject-stimulus
`(:type :EVENT :payload (:sensor ,sensor-type :error "SYNTHETIC_CHAOS_ERROR"))))
@@ -13,12 +13,12 @@
"Executes a randomized stress test by injecting failures into the system."
(declare (ignore context))
(unless *chaos-enabled-p*
(kernel-log "CHAOS ERROR - Stress test blocked. Production gate is ACTIVE.")
(harness-log "CHAOS ERROR - Stress test blocked. Production gate is ACTIVE.")
(return-from chaos-stress-test "FAILURE - Production gate active."))
(let* ((payload (getf action :payload))
(mode (or (getf payload :mode) :random))
(intensity (or (getf payload :intensity) 3)))
(kernel-log "CHAOS - Commencing stress test (Mode: ~a, Intensity: ~a)" mode intensity)
(harness-log "CHAOS - Commencing stress test (Mode: ~a, Intensity: ~a)" mode intensity)
(snapshot-object-store)
(case mode
(:random (dotimes (i intensity)
@@ -33,11 +33,11 @@
(defun chaos-enable ()
"Disables the production gate and allows chaos injection."
(setf *chaos-enabled-p* t)
(kernel-log "CHAOS - Production gate DISABLED. Chaos injection is now ALLOWED.")
(harness-log "CHAOS - Production gate DISABLED. Chaos injection is now ALLOWED.")
t)
(defun chaos-disable ()
"Enables the production gate and blocks chaos injection."
(setf *chaos-enabled-p* nil)
(kernel-log "CHAOS - Production gate ENABLED. Chaos injection is now BLOCKED.")
(harness-log "CHAOS - Production gate ENABLED. Chaos injection is now BLOCKED.")
t)

2
src/chat-logic.lisp
View File

@@ -10,7 +10,7 @@
:content text
:version (get-universal-time))))
(setf (gethash msg-id *object-store*) obj)
(kernel-log "CHAT - Message archived: ~a (~a)" msg-id role)
(harness-log "CHAT - Message archived: ~a (~a)" msg-id role)
(snapshot-object-store)
msg-id))

2
src/config-logic.lisp
View File

@@ -10,7 +10,7 @@
:content (format nil "Fleet preference for ~a set to ~a" provider model-id)
:version (get-universal-time))))
(setf (gethash config-id *object-store*) obj)
(kernel-log "CONFIG - Fleet updated: ~a -> ~a" provider model-id)
(harness-log "CONFIG - Fleet updated: ~a -> ~a" provider model-id)
t)))
(defun get-llm-model (provider &optional default)

2
src/context.lisp
View File

@@ -39,7 +39,7 @@
(if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
(defun context-get-system-logs (&optional (limit 20))
"Retrieves the most recent lines from the kernel's internal log."
"Retrieves the most recent lines from the harness's internal log."
(bt:with-lock-held (*logs-lock*)
(let ((count (min limit (length *system-logs*)))) (subseq *system-logs* 0 count))))

244
src/core.lisp
View File

@@ -1,244 +0,0 @@
(in-package :org-agent)
(defvar *interrupt-flag* nil)
;; MOVED TO package.lisp
(defvar *interrupt-lock* (bt:make-lock "kernel-interrupt-lock"))
;; MOVED TO package.lisp
;; MOVED TO package.lisp
(defun dispatch-action (action context)
"Routes an approved action to its registered physical actuator."
(when (and action (listp action))
(let* ((target (or (ignore-errors (getf action :target)) :emacs))
(actuator-fn (gethash target *actuator-registry*)))
(if actuator-fn
(funcall actuator-fn action context)
(kernel-log "DISPATCH ERROR: No actuator for ~a" target)))))
(defun kernel-track-telemetry (skill-name duration status)
"Updates performance metrics for a specific skill."
(when skill-name (bt:with-lock-held (*telemetry-lock*)
(let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0))))
(incf (getf entry :executions)) (incf (getf entry :total-time) duration)
(when (eq status :rejected) (incf (getf entry :failures))) (setf (gethash skill-name *skill-telemetry*) entry)))))
(defun kernel-log (fmt &rest args)
"Records a formatted message to the system log and standard output."
(let ((msg (apply #'format nil fmt args)))
(bt:with-lock-held (*logs-lock*) (push msg *system-logs*) (when (> (length *system-logs*) *max-log-history*) (setf *system-logs* (subseq *system-logs* 0 *max-log-history*))))
(format t "~a~%" msg) (finish-output)))
(defun inject-stimulus (raw-message &key stream (depth 0))
"Enqueues a raw message into the reactive signal pipeline, handling async/sync execution and recovery."
(let* ((payload (getf raw-message :payload))
(sensor (getf payload :sensor))
;; Force Chat and Delegation to be async
(async-p (or (getf payload :async-p) (member sensor '(:chat-message :delegation :user-command)))))
(when stream (setf (getf raw-message :reply-stream) stream))
(if async-p (bt:make-thread (lambda () (restart-case (handler-bind ((error (lambda (c) (kernel-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event))))
(process-signal raw-message)) (skip-event () nil))) :name "org-agent-async-task")
(restart-case (handler-bind ((error (lambda (c) (kernel-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event)))) (process-signal raw-message))
(skip-event () (kernel-log "SYSTEM RECOVERY: Stimulus dropped.~%"))))))
(defun execute-system-action (action context)
"Processes internal kernel commands like skill creation or environment updates."
(declare (ignore context))
(let* ((payload (ignore-errors (getf action :payload))) (cmd (ignore-errors (getf payload :action))))
(case cmd
(:eval (let ((code (getf payload :code)))
(kernel-log "ACTUATOR [System] - Evaluating: ~a" code)
(handler-case (let ((result (eval (read-from-string code))))
(kernel-log "ACTUATOR [System] - Result: ~s" result)
result)
(error (c) (kernel-log "ACTUATOR ERROR [System] - Eval failed: ~a" c)))))
(:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content))
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent))) (full-path (merge-pathnames filename skills-dir)))
(kernel-log "ACTUATOR [System] - Creating skill ~a..." filename)
(with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out))
(load-skill-from-org full-path)))
(:set-cascade (setf *provider-cascade* (getf payload :cascade)))
(:message (kernel-log "ACTUATOR [System] - ~a" (getf payload :text)))
(t (kernel-log "ACTUATOR [System] - Unknown command ~s" cmd)))))
(defun perceive-gate (signal)
"Initial processing: Normalizes raw stimuli and updates memory."
(let* ((payload (getf signal :payload))
(type (getf signal :type))
(sensor (getf payload :sensor)))
(kernel-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor"))
(snapshot-object-store)
(cond ((eq type :EVENT)
(case sensor
(:buffer-update (let ((ast (getf payload :ast))) (when ast (ingest-ast ast))))
(:point-update (let ((element (getf payload :element))) (when element (ingest-ast element))))
(:interrupt (bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t)))))
((eq type :RESPONSE)
(kernel-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
(setf (getf signal :status) :perceived)
signal))
(defun neuro-gate (signal)
"Associative: Intuition and proposed actions."
(unless (eq (getf signal :type) :EVENT)
(return-from neuro-gate signal))
(kernel-log "GATE [Associative]: Consulting System 1...")
(let ((thoughts (think signal)))
(setf (getf signal :proposals) (if (and (listp thoughts) (listp (car thoughts)))
thoughts
(if thoughts (list thoughts) nil)))
(setf (getf signal :status) :thought)
signal))
(defun resolve-consensus (proposals signal)
"Resolves diverging proposals by voting or selecting the safest one."
(declare (ignore signal))
(kernel-log "CONSENSUS: ~a proposals found. Resolving..." (length proposals))
;; Simplified consensus: Majority vote or first safe one
;; For now, we'll select the proposal that appears most frequently.
(let ((counts (make-hash-table :test 'equal)))
(dolist (p proposals)
(incf (gethash p counts 0)))
(let ((winner (first proposals))
(max-count 0))
(maphash (lambda (p count)
(when (> count max-count)
(setq max-count count
winner p)))
counts)
(kernel-log "CONSENSUS: Winner selected with ~a votes." max-count)
winner)))
(defun consensus-gate (signal)
"Resolves multiple proposals into a single candidate action."
(let ((proposals (getf signal :proposals)))
(if (and proposals (cdr proposals))
(let ((winner (resolve-consensus proposals signal)))
(setf (getf signal :candidate) winner))
(setf (getf signal :candidate) (first proposals)))
(setf (getf signal :status) :consensus)
signal))
(defun decide-gate (signal)
"Deliberate: Safety and validation."
(let ((candidate (getf signal :candidate)))
(if candidate
(let* ((normalized-candidate (if (listp candidate) candidate (list :type :RESPONSE :payload (list :text candidate))))
(decision (decide normalized-candidate signal)))
(setf (getf signal :approved-action) decision))
(setf (getf signal :approved-action) nil))
(setf (getf signal :status) :decided)
signal))
(defun dispatch-gate (signal)
"Final Stage: Actuation and feedback generation."
(let* ((approved (getf signal :approved-action))
(type (getf signal :type))
(depth (getf signal :depth 0))
(feedback nil))
(case type
(:REQUEST (dispatch-action signal signal))
(:EVENT
(when approved
(let* ((payload (getf approved :payload))
(target (getf approved :target))
(action (or (getf payload :action) (getf approved :action)))
(tool-name (or (getf payload :tool) (getf approved :tool)))
(tool-args (or (getf payload :args) (getf approved :args))))
(if (and (eq target :tool) (eq action :call))
(let ((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)))
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream)
:payload (list :sensor :tool-output :result result :tool tool-name))))
(error (c)
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream)
:payload (list :sensor :tool-error :tool tool-name :message (format nil "~a" c))))))
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream)
:payload (list :sensor :tool-error :message "Tool not found")))))
(let ((result (dispatch-action approved signal)))
(when (and result (not (member target '(:emacs :system-message))))
(setf feedback (list :type :EVENT :depth (1+ depth) :reply-stream (getf signal :reply-stream)
:payload (list :sensor :tool-output :result result :tool approved))))))))))
(setf (getf signal :status) :dispatched)
feedback))
(defun process-signal (signal)
"The entry point to the Reactive Signal Pipeline."
(let ((current-signal signal))
(loop while current-signal do
(let ((depth (getf current-signal :depth 0)))
(when (> depth 10)
(kernel-log "PIPELINE ERROR: Max depth reached.")
(return nil))
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
(kernel-log "PIPELINE: Interrupted.")
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
(return nil))
(handler-case
(progn
(setf current-signal (perceive-gate current-signal))
(setf current-signal (neuro-gate current-signal))
(setf current-signal (consensus-gate current-signal))
(setf current-signal (decide-gate current-signal))
(setf current-signal (dispatch-gate current-signal)))
(error (c)
(kernel-log "PIPELINE CRASH: ~a - Initiating Micro-Rollback." c)
(rollback-object-store 0)
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
(setf current-signal nil)
(setf current-signal (list :type :EVENT :depth (1+ depth) :reply-stream (getf current-signal :reply-stream)
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
(defun delegate-task (task-id recipient &key context)
"Enqueues a task for another agent or background process."
(kernel-log "ORCHESTRATOR: Delegating task ~a to ~a" task-id recipient)
(inject-stimulus (list :type :EVENT
:payload (list :sensor :delegation
:task-id task-id
:recipient recipient
:context context))))
(defvar *heartbeat-thread* nil)
(defun start-heartbeat (&optional (interval 60))
"Spawns a thread that periodically injects a heartbeat stimulus."
(setf *heartbeat-thread*
(bt:make-thread
(lambda ()
(loop
(sleep interval)
(kernel-log "KERNEL: Heartbeat pulse...")
(inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
:name "org-agent-heartbeat")))
(defun stop-heartbeat ()
"Gracefully terminates the heartbeat pulse thread."
(when (and *heartbeat-thread* (bt:thread-alive-p *heartbeat-thread*))
(bt:destroy-thread *heartbeat-thread*)
(setf *heartbeat-thread* nil)))
(defun load-all-skills ()
"Deprecated: use initialize-all-skills. Centralized boot orchestrator."
(initialize-all-skills))
(defun main ()
"The entry point for the compiled standalone binary."
(let* ((home (uiop:getenv "HOME"))
(env-file (uiop:merge-pathnames* ".local/share/org-agent/.env" (uiop:ensure-directory-pathname home))))
(if (uiop:file-exists-p env-file)
(progn
(format t "KERNEL: Loading environment from ~a~%" env-file)
(cl-dotenv:load-env env-file))
(format t "KERNEL ERROR: .env not found at ~a~%" env-file)))
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL") :junk-allowed t)) 60)))
(format t "KERNEL: Heartbeat interval set to ~a seconds.~%" interval)
(start-daemon :interval interval))
(loop (sleep 3600)))

12
src/credentials-vault.lisp
View File

@@ -34,17 +34,17 @@
"Securely stores a secret and triggers a Merkle snapshot."
(let ((key (format nil "~a-~a" provider type)))
(setf (gethash key *vault-memory*) secret)
(kernel-log "VAULT - Updated ~a for ~a. Triggering Merkle snapshot..." type provider)
(harness-log "VAULT - Updated ~a for ~a. Triggering Merkle snapshot..." type provider)
(snapshot-object-store)
t))
(defun vault-onboard-gemini-web ()
"Instructions for the Sovereign Cookie Handshake."
(kernel-log "--- GEMINI WEB ONBOARDING ---")
(kernel-log "1. Visit gemini.google.com")
(kernel-log "2. Run the 'Get Gemini Cookies' Bookmarklet.")
(kernel-log " CODE: javascript:(function(){const c=document.cookie.split('; ').reduce((r,v)=>{const [n,val]=v.split('=');r[n]=val;return r},{});const target=['__Secure-1PSID','__Secure-1PSIDTS'];const out=target.map(n=>({name:n,value:c[n]}));prompt('Copy JSON:',JSON.stringify(out));})();")
(kernel-log "PLATFORM GUIDE: Chrome/Firefox/Safari all support Bookmarklets via 'Add Page' or 'New Bookmark'.")
(harness-log "--- GEMINI WEB ONBOARDING ---")
(harness-log "1. Visit gemini.google.com")
(harness-log "2. Run the 'Get Gemini Cookies' Bookmarklet.")
(harness-log " CODE: javascript:(function(){const c=document.cookie.split('; ').reduce((r,v)=>{const [n,val]=v.split('=');r[n]=val;return r},{});const target=['__Secure-1PSID','__Secure-1PSIDTS'];const out=target.map(n=>({name:n,value:c[n]}));prompt('Copy JSON:',JSON.stringify(out));})();")
(harness-log "PLATFORM GUIDE: Chrome/Firefox/Safari all support Bookmarklets via 'Add Page' or 'New Bookmark'.")
t)
(progn

4
src/embedding-logic.lisp
View File

@@ -6,7 +6,7 @@
(api-key (getf auth :api-key))
(endpoint "https://generativelanguage.googleapis.com/v1beta/models/text-embedding-004:embedContent"))
(unless api-key
(kernel-log "EMBEDDING ERROR: No API key for :gemini")
(harness-log "EMBEDDING ERROR: No API key for :gemini")
(return-from get-embedding nil))
(let* ((url (format nil "~a?key=~a" endpoint api-key))
(headers `(("Content-Type" . "application/json")))
@@ -19,7 +19,7 @@
(embedding (getf (getf json :embedding) :values)))
embedding)
(error (c)
(kernel-log "EMBEDDING FAILURE: ~a" c)
(harness-log "EMBEDDING FAILURE: ~a" c)
nil)))))
(defun dot-product (v1 v2)

2
src/embedding.lisp
View File

@@ -10,7 +10,7 @@
(handler-case (let* ((response (dex:post url :headers headers :content body))
(json (cl-json:decode-json-from-string response)))
(cdr (assoc :values (cdr (assoc :embedding json)))))
(error (c) (kernel-log "EMBEDDING FAILURE: ~a" c) nil)))))
(error (c) (harness-log "EMBEDDING FAILURE: ~a" c) nil)))))
(defun dot-product (v1 v2)
"Calculates the dot product of two numerical vectors."

10
src/event-orchestrator.lisp
View File

@@ -9,7 +9,7 @@
(defun orchestrator-register-hook (hook-name fn)
"Registers a function for a named hook. Triggers a Merkle snapshot."
(pushnew fn (gethash hook-name *hook-registry*))
(kernel-log "ORCHESTRATOR - Registered hook function for ~a" hook-name)
(harness-log "ORCHESTRATOR - Registered hook function for ~a" hook-name)
(snapshot-object-store)
t)
@@ -18,17 +18,17 @@
(let ((functions (gethash hook-name *hook-registry*)))
(dolist (fn functions)
(handler-case (apply fn args)
(error (c) (kernel-log "ORCHESTRATOR ERROR - Hook ~a failed: ~a" hook-name c))))))
(error (c) (harness-log "ORCHESTRATOR ERROR - Hook ~a failed: ~a" hook-name c))))))
(defun orchestrator-schedule-task (task-id schedule fn)
"Schedules a task for execution. Schedule can be an interval (integer seconds) or 'heartbeat'."
(setf (gethash task-id *cron-registry*) (list :schedule schedule :fn fn :last-run 0))
(kernel-log "ORCHESTRATOR - Scheduled task ~a (~a)" task-id schedule)
(harness-log "ORCHESTRATOR - Scheduled task ~a (~a)" task-id schedule)
(snapshot-object-store)
t)
(defun orchestrator-process-cron ()
"Checked by the kernel on every heartbeat."
"Checked by the harness on every heartbeat."
(let ((now (get-universal-time)))
(maphash (lambda (id task)
(let ((schedule (getf task :schedule))
@@ -37,7 +37,7 @@
(when (or (eq schedule :heartbeat)
(and (integerp schedule) (>= (- now last-run) schedule)))
(handler-case (funcall fn)
(error (c) (kernel-log "ORCHESTRATOR ERROR - Cron task ~a failed: ~a" id c)))
(error (c) (harness-log "ORCHESTRATOR ERROR - Cron task ~a failed: ~a" id c)))
(setf (getf (gethash id *cron-registry*) :last-run) now))))
*cron-registry*)))

10
src/gateway-matrix.lisp
View File

@@ -19,14 +19,14 @@
(txn-id (get-universal-time))
(url (format nil "~a/_matrix/client/v3/rooms/~a/send/m.room.message/~a" hs room-id txn-id)))
(when (and hs token room-id text)
(kernel-log "MATRIX: Sending message to ~a..." room-id)
(harness-log "MATRIX: Sending message to ~a..." room-id)
(handler-case
(dex:put url
:headers `(("Authorization" . ,(format nil "Bearer ~a" token))
("Content-Type" . "application/json"))
:content (cl-json:encode-json-to-string
`((msgtype . "m.text") (body . ,text))))
(error (c) (kernel-log "MATRIX ERROR: ~a" c))))))
(error (c) (harness-log "MATRIX ERROR: ~a" c))))))
(defun matrix-process-sync ()
"Calls Matrix sync and injects new messages."
@@ -57,7 +57,7 @@
(sender (cdr (assoc :sender event)))
(body (cdr (assoc :body content))))
(when (and (string= type "m.room.message") body)
(kernel-log "MATRIX: Received message from ~a in ~a" sender room-id)
(harness-log "MATRIX: Received message from ~a in ~a" sender room-id)
(inject-stimulus
(list :type :EVENT
:payload (list :sensor :chat-message
@@ -65,7 +65,7 @@
:room-id room-id
:sender sender
:text body)))))))))
(error (c) (kernel-log "MATRIX SYNC ERROR: ~a" c))))))
(error (c) (harness-log "MATRIX SYNC ERROR: ~a" c))))))
(defun start-matrix-gateway ()
"Initializes the Matrix background thread."
@@ -77,7 +77,7 @@
(matrix-process-sync)
(sleep 2)))
:name "org-agent-matrix-gateway"))
(kernel-log "MATRIX: Gateway sync active.")))
(harness-log "MATRIX: Gateway sync active.")))
(defun stop-matrix-gateway ()
(when (and *matrix-polling-thread* (bt:thread-alive-p *matrix-polling-thread*))

12
src/gateway-signal.lisp
View File

@@ -12,14 +12,14 @@
(text (or (getf payload :text) (getf action :text)))
(account (get-signal-account)))
(when (and account chat-id text)
(kernel-log "SIGNAL: Sending message to ~a..." chat-id)
(harness-log "SIGNAL: Sending message to ~a..." chat-id)
(handler-case
(uiop:run-program (list "signal-cli" "-u" account "send" "-m" text chat-id)
:output :string :error-output :string)
(error (c) (kernel-log "SIGNAL ERROR: ~a" c))))))
(error (c) (harness-log "SIGNAL ERROR: ~a" c))))))
(defun signal-process-updates ()
"Polls for new messages via signal-cli and injects them into the kernel."
"Polls for new messages via signal-cli and injects them into the harness."
(let ((account (get-signal-account)))
(when account
(handler-case
@@ -34,14 +34,14 @@
(data-message (cdr (assoc :data-message envelope)))
(text (cdr (assoc :message data-message))))
(when (and source text)
(kernel-log "SIGNAL: Received message from ~a" source)
(harness-log "SIGNAL: Received message from ~a" source)
(inject-stimulus
(list :type :EVENT
:payload (list :sensor :chat-message
:channel :signal
:chat-id source
:text text))))))))
(error (c) (kernel-log "SIGNAL POLL ERROR: ~a" c))))))
(error (c) (harness-log "SIGNAL POLL ERROR: ~a" c))))))
(defun start-signal-gateway ()
"Initializes the Signal background thread."
@@ -53,7 +53,7 @@
(signal-process-updates)
(sleep 5)))
:name "org-agent-signal-gateway"))
(kernel-log "SIGNAL: Gateway polling active.")))
(harness-log "SIGNAL: Gateway polling active.")))
(defun stop-signal-gateway ()
(when (and *signal-polling-thread* (bt:thread-alive-p *signal-polling-thread*))

12
src/gateway-telegram.lisp
View File

@@ -18,16 +18,16 @@
(token (get-telegram-token))
(url (format nil "https://api.telegram.org/bot~a/sendMessage" token)))
(when (and token chat-id text)
(kernel-log "TELEGRAM: Sending message to ~a..." chat-id)
(harness-log "TELEGRAM: Sending message to ~a..." chat-id)
(handler-case
(dex:post url
:headers '(("Content-Type" . "application/json"))
:content (cl-json:encode-json-to-string
`((chat_id . ,chat-id) (text . ,text))))
(error (c) (kernel-log "TELEGRAM ERROR: ~a" c))))))
(error (c) (harness-log "TELEGRAM ERROR: ~a" c))))))
(defun telegram-process-updates ()
"Polls for new messages and injects them into the kernel."
"Polls for new messages and injects them into the harness."
(let* ((token (get-telegram-token))
(url (format nil "https://api.telegram.org/bot~a/getUpdates?offset=~a"
token (1+ *telegram-last-update-id*))))
@@ -44,14 +44,14 @@
(text (cdr (assoc :text message))))
(setf *telegram-last-update-id* update-id)
(when (and text chat-id)
(kernel-log "TELEGRAM: Received message from ~a" chat-id)
(harness-log "TELEGRAM: Received message from ~a" chat-id)
(inject-stimulus
(list :type :EVENT
:payload (list :sensor :chat-message
:channel :telegram
:chat-id (format nil "~a" chat-id)
:text text)))))))
(error (c) (kernel-log "TELEGRAM POLL ERROR: ~a" c))))))
(error (c) (harness-log "TELEGRAM POLL ERROR: ~a" c))))))
(defun start-telegram-gateway ()
"Initializes the Telegram background thread."
@@ -63,7 +63,7 @@
(telegram-process-updates)
(sleep 3)))
:name "org-agent-telegram-gateway"))
(kernel-log "TELEGRAM: Gateway polling active.")))
(harness-log "TELEGRAM: Gateway polling active.")))
(defun stop-telegram-gateway ()
(when (and *telegram-polling-thread* (bt:thread-alive-p *telegram-polling-thread*))

6
src/homoiconic-memory.lisp
View File

@@ -19,7 +19,7 @@
node
(let ((new-id (org-agent:org-id-get-create)))
(setf (getf node :properties) (append props (list :ID new-id)))
(kernel-log "MEMORY - Injected standard ID ~a" new-id)
(harness-log "MEMORY - Injected standard ID ~a" new-id)
node))))
(defun memory-normalize-ast (ast)
@@ -40,13 +40,13 @@
(defun memory-org-to-json (source-path)
"Routes to the Emacs-based Org-JSON bridge."
;; Future implementation will use the org-json-convert CLI tool
(kernel-log "MEMORY - Parsing ~a to JSON..." source-path)
(harness-log "MEMORY - Parsing ~a to JSON..." source-path)
nil)
(defun memory-json-to-org (ast)
"Materializes a JSON AST into Org-mode text."
;; Placeholder for org-element-interpret-data equivalent
(kernel-log "MEMORY - Rendering AST to text...")
(harness-log "MEMORY - Rendering AST to text...")
"")
(progn

2
src/latent-reflection.lisp
View File

@@ -33,7 +33,7 @@
(if (and (eq sensor :heartbeat)
(> (- now *last-reflection-time*) *reflection-interval*))
(progn
(kernel-log "GARDENER - Initiating Latent Reflection...")
(harness-log "GARDENER - Initiating Latent Reflection...")
(setf *last-reflection-time* now)
t)
nil)))

10
src/lisp-repair.lisp
View File

@@ -36,19 +36,19 @@ MANDATE: Output EXACTLY ONE valid Common Lisp list. Do not explain. Do not use m
(let* ((payload (getf context :payload))
(code (getf payload :code))
(error-msg (getf payload :error)))
(kernel-log "SYNTAX GATE: Reacting to broken Lisp stimulus...")
(harness-log "SYNTAX GATE: Reacting to broken Lisp stimulus...")
(let ((fast-fix (deterministic-repair code)))
(handler-case
(let ((repaired (read-from-string fast-fix)))
(kernel-log "SYNTAX GATE: Deterministic repair SUCCESS.")
(harness-log "SYNTAX GATE: Deterministic repair SUCCESS.")
repaired)
(error ()
(kernel-log "SYNTAX GATE: Deterministic repair failed. Escalating...")
(harness-log "SYNTAX GATE: Deterministic repair failed. Escalating...")
(let ((deep-fix (neural-repair code error-msg)))
(handler-case
(let ((repaired (read-from-string deep-fix)))
(kernel-log "SYNTAX GATE: Neural repair SUCCESS.")
(harness-log "SYNTAX GATE: Neural repair SUCCESS.")
repaired)
(error ()
(kernel-log "SYNTAX GATE: Neural repair failed.")
(harness-log "SYNTAX GATE: Neural repair failed.")
(list :type :LOG :payload (list :text "Lisp Repair Failed.")))))))))))

2
src/llm-gateway.lisp
View File

@@ -19,7 +19,7 @@
(let ((api-key (vault-get-secret provider :type :api-key))
(full-prompt (format nil "~a~%~%Prompt: ~a" system-prompt prompt)))
(kernel-log "SYSTEM 1: Requesting ~a (Model: ~a) [Key: ~a]"
(harness-log "SYSTEM 1: Requesting ~a (Model: ~a) [Key: ~a]"
provider (or model "default") (vault-mask-string api-key))
(case provider

10
src/neuro.lisp
View File

@@ -26,7 +26,7 @@
(when backend-fn
(push (bt:make-thread
(lambda ()
(kernel-log "ASSOCIATIVE [Consensus]: Querying backend ~a..." backend)
(harness-log "ASSOCIATIVE [Consensus]: Querying backend ~a..." backend)
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
(result (ignore-errors
(if model
@@ -50,7 +50,7 @@
(or (dolist (backend backends)
(let ((backend-fn (gethash backend *neuro-backends*)))
(when backend-fn
(kernel-log "ASSOCIATIVE: Attempting backend ~a..." backend)
(harness-log "ASSOCIATIVE: Attempting backend ~a..." backend)
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
(result (if model
(funcall backend-fn prompt system-prompt :model model)
@@ -67,7 +67,7 @@
(global-context (context-assemble-global-awareness)))
(if active-skill
(progn
(kernel-log "ASSOCIATIVE: Engaging skill '~a'~%" (skill-name active-skill))
(harness-log "ASSOCIATIVE: Engaging skill '~a'~%" (skill-name active-skill))
(let* ((prompt-generator (skill-neuro-prompt active-skill))
(raw-prompt (when prompt-generator (funcall prompt-generator context)))
(full-system-prompt (concatenate 'string
@@ -95,7 +95,7 @@ To call a tool, you MUST use:
(raw-thoughts (cl-ppcre:split (cl-ppcre:quote-meta-chars "|CONSENSUS-SEP|") thought))
(suggestions nil))
(dolist (raw-thought raw-thoughts)
(kernel-log "ASSOCIATIVE RAW: ~a~%" raw-thought)
(harness-log "ASSOCIATIVE RAW: ~a~%" raw-thought)
(let* ((cleaned-thought
(let ((match (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" raw-thought)))
(if match
@@ -109,7 +109,7 @@ To call a tool, you MUST use:
(list :sensor :syntax-error
:code cleaned-thought
:error (format nil "~a" c)))))))
(kernel-log "ASSOCIATIVE Suggestion: ~a~%" cleaned-thought)
(harness-log "ASSOCIATIVE Suggestion: ~a~%" cleaned-thought)
(when (and suggestion (listp suggestion))
(push suggestion suggestions))))
(if (and *consensus-enabled-p* suggestions)

6
src/object-store.lisp
View File

@@ -69,15 +69,15 @@
(push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
(when (> (length *object-store-snapshots*) 20)
(setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))
(kernel-log "MEMORY - CoW Object Store snapshot created.")))
(harness-log "MEMORY - CoW Object Store snapshot created.")))
(defun rollback-object-store (&optional (index 0))
"Restores the Object Store to a previously captured snapshot using immutable history pointers."
(let ((snapshot (nth index *object-store-snapshots*)))
(if snapshot
(progn (setf *object-store* (copy-hash-table (getf snapshot :data)))
(kernel-log "MEMORY - Object Store rolled back to snapshot ~a" index))
(kernel-log "MEMORY ERROR - Snapshot ~a not found." index))))
(harness-log "MEMORY - Object Store rolled back to snapshot ~a" index))
(harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
(defun lookup-object (id)
"Retrieves an object from the store by its unique ID."

8
src/package.lisp
View File

@@ -9,7 +9,7 @@
;; --- Daemon Lifecycle ---
#:start-daemon
#:stop-daemon
#:kernel-log
#:harness-log
#:main
;; --- Object Store (CLOSOS) ---
@@ -118,7 +118,7 @@
(in-package :org-agent)
(defvar *system-logs* nil)
(defvar *logs-lock* (bt:make-lock "kernel-logs-lock"))
(defvar *logs-lock* (bt:make-lock "harness-logs-lock"))
(defvar *max-log-history* 100)
(defvar *skills-registry* (make-hash-table :test 'equal)
@@ -144,8 +144,8 @@
:guard ,guard
:body ,body)))
(defun kernel-log (msg &rest args)
"Centralized logging for the kernel."
(defun harness-log (msg &rest args)
"Centralized logging for the harness."
(let ((formatted-msg (apply #'format nil msg args)))
(bt:with-lock-held (*logs-lock*)
(push formatted-msg *system-logs*)

2
src/processor-logic.lisp
View File

@@ -28,6 +28,6 @@ RULES:
(when (eq sensor :heartbeat)
(let* ((base-dir (or (uiop:getenv "MEMEX_DIR") "/home/user/memex/"))
(inbox-path (merge-pathnames "inbox.org" base-dir)))
(org-agent:kernel-log "INBOX - Scanning ~a for migration..." (uiop:native-namestring inbox-path))
(org-agent:harness-log "INBOX - Scanning ~a for migration..." (uiop:native-namestring inbox-path))
;; Physical move logic would go here using Org AST parsing
'(:target :system :payload (:action :message :text "Inbox processing complete (Simulation)."))))))

2
src/safety-harness.lisp
View File

@@ -14,7 +14,7 @@
;; Strings
format concatenate string-downcase string-upcase search
;; Kernel specifics
org-agent::kernel-log
org-agent::harness-log
org-agent::snapshot-object-store
org-agent::rollback-object-store
org-agent::lookup-object

16
src/self-fix.lisp
View File

@@ -11,7 +11,7 @@
(search "skills/" (namestring target-file)))))
(org-agent:snapshot-object-store)
(org-agent:kernel-log "SELF-FIX - Attempting surgical fix on ~a..." target-file)
(org-agent:harness-log "SELF-FIX - Attempting surgical fix on ~a..." target-file)
(handler-case
(if (uiop:file-exists-p target-file)
@@ -23,24 +23,24 @@
(if is-skill
(progn
(org-agent:kernel-log "SELF-FIX - Reloading modified skill ~a..." target-file)
(org-agent:harness-log "SELF-FIX - Reloading modified skill ~a..." target-file)
(if (org-agent:load-skill-from-org target-file)
(progn
(org-agent:kernel-log "SELF-FIX SUCCESS - Applied and reloaded.")
(org-agent:harness-log "SELF-FIX SUCCESS - Applied and reloaded.")
t)
(progn
(org-agent:kernel-log "SELF-FIX FAILURE - Skill reload failed. Rolling back.")
(org-agent:harness-log "SELF-FIX FAILURE - Skill reload failed. Rolling back.")
(with-open-file (out target-file :direction :output :if-exists :supersede)
(write-string content out))
(org-agent:rollback-object-store 0)
nil)))
(progn
(org-agent:kernel-log "SELF-FIX SUCCESS - Applied fix to file.")
(org-agent:harness-log "SELF-FIX SUCCESS - Applied fix to file.")
t)))
(progn (org-agent:kernel-log "SELF-FIX FAILURE - Pattern not found.") nil)))
(progn (org-agent:kernel-log "SELF-FIX FAILURE - File not found.") nil))
(progn (org-agent:harness-log "SELF-FIX FAILURE - Pattern not found.") nil)))
(progn (org-agent:harness-log "SELF-FIX FAILURE - File not found.") nil))
(error (c)
(org-agent:kernel-log "SELF-FIX CRASH - ~a. Rolling back." c)
(org-agent:harness-log "SELF-FIX CRASH - ~a. Rolling back." c)
(org-agent:rollback-object-store 0)
nil))))

2
src/shell-logic.lisp
View File

@@ -65,7 +65,7 @@
(defun provision-microvm (id &key (cpu 1) (ram 512))
"Hardware-Level Isolation: Provisions an ephemeral Firecracker MicroVM.
This is the high-security evolution of directory-based sandboxing."
(kernel-log "SECURITY [Hardware] - Provisioning MicroVM ~a (CPU: ~a, RAM: ~aMB)..." id cpu ram)
(harness-log "SECURITY [Hardware] - Provisioning MicroVM ~a (CPU: ~a, RAM: ~aMB)..." id cpu ram)
;; Future implementation: Wraps 'fcvm' or 'firecracker' CLI calls.
(format nil "vm-~a-provisioned" id))

20
src/skills.lisp
View File

@@ -146,7 +146,7 @@
(unless valid-p
(error "Syntax Error: ~a" err)))
(kernel-log "KERNEL: Jailing skill '~a' in package ~a" skill-base-name pkg-name)
(harness-log "HARNESS: Jailing skill '~a' in package ~a" skill-base-name pkg-name)
(unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl))))
(do-external-symbols (sym (find-package :org-agent)) (shadowing-import sym new-pkg))))
@@ -158,7 +158,7 @@
t)))
(error (c)
(let ((msg (format nil "~a" c)))
(kernel-log "LOADER ERROR in skill '~a': ~a" skill-base-name msg)
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name msg)
(setf (skill-entry-status entry) :failed)
(setf (skill-entry-error-log entry) msg)
nil)))))
@@ -178,7 +178,7 @@
(when (eq finished :error) (return :error))
(unless (bt:thread-alive-p thread) (return :error))
(when (> (- (get-internal-real-time) start-time) timeout-units)
(kernel-log "KERNEL: Timing out skill ~a..." (pathname-name filepath))
(harness-log "HARNESS: Timing out skill ~a..." (pathname-name filepath))
#+sbcl (sb-thread:terminate-thread thread)
#-sbcl (bt:destroy-thread thread)
(return :timeout))
@@ -192,7 +192,7 @@
(skills-dir (if resolved-path (uiop:ensure-directory-pathname resolved-path) nil)))
(unless (and skills-dir (uiop:directory-exists-p skills-dir))
(kernel-log "KERNEL ERROR: Skills directory not found: ~a" skills-dir-str)
(harness-log "HARNESS ERROR: Skills directory not found: ~a" skills-dir-str)
(return-from initialize-all-skills nil))
(let ((sorted-files (topological-sort-skills skills-dir)))
@@ -200,12 +200,12 @@
(unless (member "org-skill-agent" sorted-files :key #'pathname-name :test #'string-equal)
(error "BOOT FAILURE: org-skill-agent.org not found in skills directory."))
(kernel-log "==================================================")
(kernel-log " LOADER: Initializing ~a skills..." (length sorted-files))
(harness-log "==================================================")
(harness-log " LOADER: Initializing ~a skills..." (length sorted-files))
(dolist (file sorted-files)
(let ((skill-name (pathname-name file)))
(kernel-log " LOADER: Loading ~a..." skill-name)
(harness-log " LOADER: Loading ~a..." skill-name)
(load-skill-with-timeout file 5)))
;; Final Summary
@@ -214,8 +214,8 @@
(declare (ignore k))
(if (eq (skill-entry-status v) :ready) (incf ready) (incf failed)))
*skill-catalog*)
(kernel-log " LOADER: Boot Complete. [Ready: ~a] [Failed: ~a]" ready failed)
(kernel-log "==================================================")
(harness-log " LOADER: Boot Complete. [Ready: ~a] [Failed: ~a]" ready failed)
(harness-log "==================================================")
(values ready failed)))))
(defun generate-tool-belt-prompt ()
@@ -239,7 +239,7 @@ EXAMPLES:
*cognitive-tools*)
output))
(def-cognitive-tool :eval "Evaluates raw Common Lisp code in the kernel image. Use this for complex calculations or internal state inspection."
(def-cognitive-tool :eval "Evaluates raw Common Lisp code in the harness image. Use this for complex calculations or internal state inspection."
((:code :type :string :description "The Lisp code to evaluate"))
:guard (lambda (args context)
(declare (ignore context))

14
src/state-persistence.lisp
View File

@@ -9,7 +9,7 @@
"Serializes the entire history store and current pointers to a local Lisp image."
(let ((image-file (persistence-get-local-path)))
(ensure-directories-exist image-file)
(kernel-log "PERSISTENCE - Dumping local image to ~a..." (uiop:native-namestring image-file))
(harness-log "PERSISTENCE - Dumping local image to ~a..." (uiop:native-namestring image-file))
(with-open-file (out image-file :direction :output :if-exists :supersede)
(format out "(in-package :org-agent)~%")
;; 1. Dump all immutable objects in the history store
@@ -27,11 +27,11 @@
(let ((image-file (persistence-get-local-path)))
(if (uiop:file-exists-p image-file)
(progn
(kernel-log "PERSISTENCE - Loading local image...")
(harness-log "PERSISTENCE - Loading local image...")
(load image-file)
t)
(progn
(kernel-log "PERSISTENCE ERROR - Local image not found.")
(harness-log "PERSISTENCE ERROR - Local image not found.")
nil))))
(defun persistence-serialize-for-archival ()
@@ -64,10 +64,10 @@
:headers '(("Content-Type" . "multipart/form-data"))))
(result (cl-json:decode-json-from-string response))
(cid (cdr (assoc :hash result))))
(kernel-log "PERSISTENCE - Checkpoint to IPFS successful. CID: ~a" cid)
(harness-log "PERSISTENCE - Checkpoint to IPFS successful. CID: ~a" cid)
cid)
(error (c)
(kernel-log "PERSISTENCE ERROR - IPFS push failed: ~a" c)
(harness-log "PERSISTENCE ERROR - IPFS push failed: ~a" c)
nil))))
(defun persistence-restore-ipfs (cid)
@@ -91,10 +91,10 @@
:last-sync (cdr (assoc :last-sync item))
:hash (cdr (assoc :hash item)))))
(setf (gethash id *object-store*) obj)))
(kernel-log "PERSISTENCE - Restored from IPFS: ~a" cid)
(harness-log "PERSISTENCE - Restored from IPFS: ~a" cid)
t)
(error (c)
(kernel-log "PERSISTENCE ERROR - IPFS restoration failed: ~a" c)
(harness-log "PERSISTENCE ERROR - IPFS restoration failed: ~a" c)
nil))))
(progn

2
src/symbolic.lisp
View File

@@ -21,7 +21,7 @@
;; If any gate returns a LOG or EVENT (blocking/intercepting), stop and return it.
(when (and (listp current-action)
(member (getf current-action :type) '(:LOG :EVENT :log :event)))
(kernel-log "DELIBERATE: Intercepted by skill '~a'~%" (skill-name skill))
(harness-log "DELIBERATE: Intercepted by skill '~a'~%" (skill-name skill))
(return-from decide current-action))))
current-action))

2
src/verification-logic.lisp
View File

@@ -56,7 +56,7 @@
(eq inv-type action-target)
(eq inv-type action-type))
(unless (funcall inv-logic action context)
(kernel-log "FORMAL FAILURE: Action ~s violated invariant ~a" action inv-name)
(harness-log "FORMAL FAILURE: Action ~s violated invariant ~a" action inv-name)
(setf all-passed nil)))))
*formal-invariants*)
all-passed))