Amr Gharbeia
e0a47575e9
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
REPL tool: - ~/.opencode/bin/repl — connects to running daemon, evaluates Lisp forms, returns results. Usage: repl '(+ 1 2)' or via stdin. - Server-side handler in programming-repl skill registers for :repl-eval sensor, bypasses LLM pipeline, writes result back through reply-stream. - Core provides pre-reason-handler registry (register-pre-reason-handler) for skills to register custom sensors without modifying core code. HITL gateway integration: - hitl-handle-message: TUI, Telegram, and Signal gateways intercept approval/deny commands before they reach the LLM. - hitl-create/hitl-approve/hitl-deny: in-memory HITL store with correlation tokens for gateway-agnostic approval. - loop-gate-perceive detects HITL commands and blocks LLM processing. Naming drift fixes (the complete batch): - register-actuator vs actuator-register — fixed to register-actuator - process-signal vs loop-process — alias added - perceive-gate/reason-gate/act-gate vs loop-gate-* — aliases added - initialize-actuators vs actuator-initialize — fixed to actuator-initialize - initialize-all-skills vs skill-initialize-all — fixed to skill-initialize-all - inject-stimulus alias added for backward compatibility - All original gateway-manager inject-stimulus → stimulus-inject + HITL check
166 lines
6.7 KiB
Common Lisp
166 lines
6.7 KiB
Common Lisp
(in-package :passepartout)
|
|
|
|
(defvar *interrupt-flag* nil
|
|
"Atomic flag set by signal handlers to trigger graceful shutdown.")
|
|
|
|
(defvar *loop-interrupt-lock* (bt:make-lock "harness-interrupt-lock")
|
|
"Mutex protecting *interrupt-flag* access.")
|
|
|
|
(defvar *heartbeat-thread* nil
|
|
"Handle to the heartbeat thread.")
|
|
|
|
;; Alias: process-signal → loop-process (backward compatibility)
|
|
(defun process-signal (signal)
|
|
(loop-process signal))
|
|
|
|
(defun loop-process (signal)
|
|
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
|
|
(let ((current-signal signal))
|
|
(loop while current-signal do
|
|
(let ((depth (getf current-signal :depth 0))
|
|
(meta (getf current-signal :meta)))
|
|
(when (> depth 10)
|
|
(log-message "METABOLISM ERROR: Max recursion depth reached.")
|
|
(return nil))
|
|
|
|
(when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
|
|
(log-message "METABOLISM: Interrupted by shutdown signal.")
|
|
(return nil))
|
|
|
|
(handler-case
|
|
(progn
|
|
(setf current-signal (perceive-gate current-signal))
|
|
(setf current-signal (reason-gate current-signal))
|
|
(let ((feedback (act-gate current-signal)))
|
|
(if feedback
|
|
(progn
|
|
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
|
|
(setf current-signal feedback))
|
|
(setf current-signal nil))))
|
|
(error (c)
|
|
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
|
|
(log-message "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
|
|
(unless (member sensor '(:loop-error :tool-error :syntax-error))
|
|
(log-message "CRITICAL ERROR: Initiating Micro-Rollback.")
|
|
(rollback-memory 0))
|
|
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
|
|
(setf current-signal nil)
|
|
(setf current-signal
|
|
(list :type :EVENT :depth (1+ depth) :meta meta
|
|
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
|
|
|
|
(defvar *memory-auto-save-interval* 300)
|
|
|
|
(defvar *heartbeat-save-counter* 0)
|
|
|
|
(defun heartbeat-start ()
|
|
"Starts the background heartbeat thread."
|
|
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60))
|
|
(auto-save (or (ignore-errors (parse-integer (uiop:getenv "MEMORY_AUTO_SAVE_INTERVAL"))) *memory-auto-save-interval*)))
|
|
(setf *memory-auto-save-interval* auto-save)
|
|
(setf *heartbeat-save-counter* 0)
|
|
|
|
(setf *heartbeat-thread*
|
|
(bt:make-thread
|
|
(lambda ()
|
|
(loop
|
|
(sleep interval)
|
|
(incf *heartbeat-save-counter*)
|
|
(when (>= *heartbeat-save-counter* (/ *memory-auto-save-interval* interval))
|
|
(setf *heartbeat-save-counter* 0)
|
|
(save-memory-to-disk))
|
|
(inject-stimulus
|
|
(list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
|
|
:name "passepartout-heartbeat"))))
|
|
|
|
(defvar *shutdown-save-enabled* t)
|
|
|
|
(defvar *system-health* :unknown
|
|
"Current system health status: :healthy, :degraded, :unhealthy, or :unknown.")
|
|
|
|
(defvar *health-check-ran* nil
|
|
"Flag indicating if initial health check has completed.")
|
|
|
|
(defun diagnostics-startup-run ()
|
|
"Runs the doctor diagnostics on startup. Returns health status."
|
|
(format t "~%")
|
|
(format t "==================================================~%")
|
|
(format t " DOCTOR: Running Startup Health Check~%")
|
|
(format t "==================================================~%")
|
|
(handler-case
|
|
(progn
|
|
(when (fboundp 'doctor-run-all)
|
|
(let ((result (doctor-run-all :auto-install nil)))
|
|
(setf *health-check-ran* t)
|
|
(if result
|
|
(progn
|
|
(setf *system-health* :healthy)
|
|
(format t "DAEMON: Health check passed. Starting services.~%"))
|
|
(progn
|
|
(setf *system-health* :degraded)
|
|
(format t "DAEMON: Health check found issues.~%")
|
|
(format t " Run 'passepartout doctor --fix' to repair.~%")))))
|
|
(setf *health-check-ran* t))
|
|
(error (c)
|
|
(format t "DOCTOR ERROR: ~a~%" c)
|
|
(setf *system-health* :unhealthy)
|
|
(setf *health-check-ran* t)))
|
|
(format t "==================================================~%~%"))
|
|
|
|
(defun main ()
|
|
"Entry point for Passepartout. Initializes the system and enters idle loop."
|
|
(let* ((home (uiop:getenv "HOME"))
|
|
(env-file (uiop:merge-pathnames* ".config/passepartout/.env" (uiop:ensure-directory-pathname home))))
|
|
(when (uiop:file-exists-p env-file)
|
|
(cl-dotenv:load-env env-file)))
|
|
|
|
(load-memory-from-disk)
|
|
(actuator-initialize)
|
|
(skill-initialize-all)
|
|
|
|
;; Run proactive doctor before starting services
|
|
(diagnostics-startup-run)
|
|
|
|
(heartbeat-start)
|
|
(start-daemon)
|
|
|
|
#+sbcl
|
|
(sb-sys:enable-interrupt sb-unix:sigint
|
|
(lambda (sig code scp)
|
|
(declare (ignore sig code scp))
|
|
(log-message "SHUTDOWN: SIGINT received. Saving memory...")
|
|
(when *shutdown-save-enabled* (save-memory-to-disk))
|
|
(uiop:quit 0)))
|
|
|
|
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
|
|
(loop
|
|
(when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
|
|
(log-message "SHUTDOWN: Interrupt flag set. Saving memory...")
|
|
(when *shutdown-save-enabled* (save-memory-to-disk))
|
|
(return))
|
|
(sleep sleep-interval))))
|
|
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(ql:quickload :fiveam :silent t))
|
|
|
|
(defpackage :passepartout-immune-system-tests
|
|
(:use :cl :fiveam :passepartout)
|
|
(:export #:immune-suite))
|
|
|
|
(in-package :passepartout-immune-system-tests)
|
|
|
|
(def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)")
|
|
(in-suite immune-suite)
|
|
|
|
(test loop-error-injection
|
|
"Verify that a crash in think/decide triggers a :loop-error stimulus."
|
|
(clrhash passepartout::*skills-registry*)
|
|
(passepartout:defskill :evil-skill
|
|
:priority 100
|
|
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input))
|
|
:probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE"))
|
|
:deterministic nil)
|
|
(passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
|
|
(let ((logs (passepartout:context-get-system-logs 20)))
|
|
(is (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs))))))
|