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

feat: implement stateful Micro-Loader and centralized Boot Sequence

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-09 16:34:59 -04:00
parent 2ed6555183
commit aa9151d9fc
7 changed files with 261 additions and 281 deletions
Download Patch File Download Diff File Expand all files Collapse all files

76
src/core.lisp
View File

@@ -197,80 +197,8 @@
(setf *heartbeat-thread* nil)))
(defun load-all-skills ()
"Scans the directory defined by SKILLS_DIR and hot-loads skills using topological order."
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
(skills-dir-str (or env-path (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
(resolved-path (context-resolve-path skills-dir-str))
(skills-dir (if resolved-path (uiop:ensure-directory-pathname resolved-path) nil)))
(if (and skills-dir (uiop:directory-exists-p skills-dir))
(let ((sorted-files (topological-sort-skills skills-dir)))
;; GATEWAY ENFORCEMENT: Kernel cannot function without the Executive Soul
(unless (member "org-skill-agent" sorted-files :key #'pathname-name :test #'string-equal)
(error "GATEWAY FAILURE: org-skill-agent.org not found in skills directory."))
(dolist (file sorted-files)
(kernel-log "KERNEL: Loading skill ~a..." (pathname-name file))
(load-skill-with-timeout file 5)))
(kernel-log "KERNEL ERROR: Skills directory not found: ~a" skills-dir-str))))
(defvar *daemon-thread* nil) (defvar *daemon-socket* nil)
(defvar *emacs-clients* nil)
(defvar *clients-lock* (bt:make-lock "emacs-clients-lock"))
(defun register-emacs-client (stream)
"Tracks an active Emacs socket connection."
(bt:with-lock-held (*clients-lock*)
(pushnew stream *emacs-clients*)))
(defun unregister-emacs-client (stream)
"Removes a disconnected Emacs socket from the registry."
(bt:with-lock-held (*clients-lock*)
(setf *emacs-clients* (remove stream *emacs-clients*))))
(defun handle-client (stream)
"Main loop for a single OACP client connection."
(kernel-log "DAEMON: New client connected.~%")
(register-emacs-client stream)
(unwind-protect
(loop
(handler-case
(progn
(loop for char = (peek-char nil stream nil :eof)
while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Return #\Tab)))
do (read-char stream))
(let ((peek (peek-char nil stream nil :eof)))
(if (eq peek :eof) (return))
(let* ((len-prefix (make-string 6)))
(unless (read-sequence len-prefix stream) (return))
(let* ((len (parse-integer len-prefix :radix 16))
(msg-payload (make-string len)))
(unless (read-sequence msg-payload stream) (return))
(let ((msg (read-from-string msg-payload)))
(kernel-log "DAEMON: Received stimulus (~a characters)~%" len)
(inject-stimulus msg :stream stream))))))
(error (c) (kernel-log "DAEMON CLIENT ERROR: ~a~%" c) (return))))
(kernel-log "DAEMON: Client disconnected.~%")
(unregister-emacs-client stream)
(ignore-errors (close stream))))
(defun start-daemon (&key port interval)
(let* ((env-host (uiop:getenv "DAEMON_HOST")) (env-port (uiop:getenv "ORG_AGENT_DAEMON_PORT"))
(listen-host (if env-host (string-trim " \"'" env-host) "127.0.0.1"))
(listen-port (or (or port (when env-port (ignore-errors (parse-integer (string-trim " \"'" env-port) :junk-allowed t)))) 9105)))
(register-actuator :system #'execute-system-action)
(register-actuator :emacs (lambda (action context)
(declare (ignore context))
(kernel-log "ACTUATOR [Emacs] - Action: ~a~%" action)))
(start-heartbeat (or interval 60))
(kernel-log "DAEMON: Binding to ~a:~a..." listen-host listen-port)
(setf *daemon-socket* (usocket:socket-listen listen-host listen-port :reuse-address t))
(setf *daemon-thread* (bt:make-thread (lambda () (unwind-protect (loop (handler-case (let ((client-socket (usocket:socket-accept *daemon-socket*)))
(bt:make-thread (lambda () (handle-client (usocket:socket-stream client-socket))) :name "org-agent-client-handler"))
(error (c) (kernel-log "DAEMON ERROR: ~a" c) (sleep 0.1))))
(usocket:socket-close *daemon-socket*))) :name "org-agent-tcp-listener"))
(kernel-log "==================================================~% org-agent Kernel Booted Successfully.~% Daemon Listening: ~a:~a~%==================================================" listen-host listen-port)
(load-all-skills)))
(defun stop-daemon () (stop-heartbeat) (when *daemon-socket* (usocket:socket-close *daemon-socket*) (setf *daemon-socket* nil)) (kernel-log "org-agent Kernel stopped.~%"))
"Deprecated: use initialize-all-skills. Centralized boot orchestrator."
(initialize-all-skills))
(defun main ()
"The entry point for the compiled standalone binary."

1
src/package.lisp
View File

@@ -59,6 +59,7 @@
;; --- Skill Engine ---
#:load-skill-from-org
#:initialize-all-skills
#:load-skill-with-timeout
#:topological-sort-skills
#:validate-lisp-syntax

129
src/skills.lisp
View File

@@ -4,6 +4,15 @@
(defstruct skill name priority dependencies trigger-fn neuro-prompt symbolic-fn)
(defvar *skill-catalog* (make-hash-table :test 'equal)
"A stateful tracking table for all skill files discovered in the environment.")
(defstruct skill-entry
filename
(status :discovered) ;; :discovered, :loading, :ready, :failed
error-log
(load-time 0))
(defvar *cognitive-tools* (make-hash-table :test 'equal))
(defstruct cognitive-tool name description parameters guard body)
@@ -54,8 +63,6 @@ EXAMPLES:
(push name resolved))))
(visit skill-name) (nreverse resolved))))
;; --- Boot Sequence & Micro-Loader ---
(defun parse-skill-metadata (filepath)
"Extracts ID and DEPENDS_ON tags using robust line-scanning."
(let ((dependencies nil)
@@ -82,14 +89,12 @@ EXAMPLES:
(result nil)
(visited (make-hash-table :test 'equal))
(stack (make-hash-table :test 'equal)))
;; First pass: Build ID-to-File mapping and store raw dependencies
(dolist (file files)
(let ((filename (pathname-name file)))
(multiple-value-bind (id deps) (parse-skill-metadata file)
(setf (gethash (string-downcase filename) id-to-file) file)
(when id (setf (gethash (string-downcase id) id-to-file) file))
(setf (gethash (string-downcase filename) adj) deps))))
(labels ((visit (file)
(let* ((filename (pathname-name file))
(node-key (string-downcase filename)))
@@ -108,24 +113,64 @@ EXAMPLES:
(setf (gethash node-key stack) nil)
(setf (gethash node-key visited) t)
(push file result)))))
(let ((filenames (sort (mapcar #'pathname-name files) #'string<)))
(dolist (name filenames)
(let ((file (gethash (string-downcase name) id-to-file)))
(when file (visit file)))))
result)))
(defun load-skill-from-org (filepath)
"Parses and evaluates Lisp blocks from an Org file into a jailed package."
(let* ((skill-base-name (pathname-name filepath))
(entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))
(setf (skill-entry-status entry) :loading)
(setf (gethash skill-base-name *skill-catalog*) entry)
(handler-case
(let* ((content (uiop:read-file-string filepath))
(lines (uiop:split-string content :separator '(#\Newline)))
(in-lisp-block nil)
(lisp-code "")
(pkg-name (intern (string-upcase (format nil "ORG-AGENT.SKILLS.~a" skill-base-name)) :keyword)))
(dolist (line lines)
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line)) (setf in-lisp-block t))
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line)) (setf in-lisp-block nil))
(in-lisp-block (setf lisp-code (concatenate 'string lisp-code line (string #\Newline)))))))
(if (= (length lisp-code) 0)
(progn (setf (skill-entry-status entry) :ready) t) ;; Valid empty skill
(progn
;; PRE-FLIGHT: Syntax Validation
(multiple-value-bind (valid-p err) (validate-lisp-syntax lisp-code)
(unless valid-p
(error "Syntax Error: ~a" err)))
(kernel-log "KERNEL: 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))))
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
(eval (read-from-string (format nil "(progn ~a)" lisp-code))))
(setf (skill-entry-status entry) :ready)
t)))
(error (c)
(let ((msg (format nil "~a" c)))
(kernel-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)))))
(defun load-skill-with-timeout (filepath timeout-seconds)
"Loads a skill Org file with a hard execution timeout."
(let* ((finished nil)
(thread (bt:make-thread (lambda ()
(handler-case
(progn
(load-skill-from-org filepath)
(setf finished t))
(error (c)
(kernel-log "THREAD ERROR: ~a" c)
(setf finished :error))))
(if (load-skill-from-org filepath)
(setf finished t)
(setf finished :error)))
:name (format nil "loader-~a" (pathname-name filepath))))
(start-time (get-internal-real-time))
(timeout-units (truncate (* timeout-seconds internal-time-units-per-second))))
@@ -140,29 +185,39 @@ EXAMPLES:
(return :timeout))
(sleep 0.05))))
(defun load-skill-from-org (filepath)
"Parses and evaluates Lisp blocks from an Org file into a jailed package."
(when (uiop:file-exists-p filepath)
(let* ((content (uiop:read-file-string filepath)) (lines (uiop:split-string content :separator '(#\Newline)))
(in-lisp-block nil) (lisp-code "") (dependencies nil) (skill-base-name (pathname-name filepath))
(pkg-name (intern (string-upcase (format nil "ORG-AGENT.SKILLS.~a" skill-base-name)) :keyword)))
(dolist (line lines)
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
(when (uiop:string-prefix-p "#+DEPENDS_ON:" (string-upcase clean-line))
(setf dependencies (mapcar (lambda (s) (string-trim "[] " s)) (uiop:split-string (subseq clean-line 13) :separator '(#\Space)))))))
(dolist (line lines)
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line)) (setf in-lisp-block t))
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line)) (setf in-lisp-block nil))
(in-lisp-block (setf lisp-code (concatenate 'string lisp-code line (string #\Newline)))))))
(when (> (length lisp-code) 0)
(kernel-log "KERNEL: 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))))
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
(handler-case (eval (read-from-string (format nil "(progn ~a)" lisp-code)))
(error (c) (kernel-log "READER ERROR in skill '~a': ~a~%" skill-base-name c))))))))
(defun initialize-all-skills ()
"Scans the directory defined by SKILLS_DIR and hot-loads skills using topological order."
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
(skills-dir-str (or env-path (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
(resolved-path (context-resolve-path skills-dir-str))
(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)
(return-from initialize-all-skills nil))
(let ((sorted-files (topological-sort-skills skills-dir)))
;; MANDATE: The Executive Soul must be present
(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))
(dolist (file sorted-files)
(let ((skill-name (pathname-name file)))
(kernel-log " LOADER: Loading ~a..." skill-name)
(load-skill-with-timeout file 5)))
;; Final Summary
(let ((ready 0) (failed 0))
(maphash (lambda (k v)
(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 "==================================================")
(values ready failed)))))
(defun validate-lisp-syntax (code-string)
"Checks if a string contains valid, readable Common Lisp forms."
@@ -175,11 +230,10 @@ EXAMPLES:
:guard (lambda (args context)
(declare (ignore context))
(let ((code (getf args :code)))
;; Reuse the global safety harness if it exists
(let ((harness-pkg (find-package :org-agent.skills.org-skill-safety-harness)))
(if harness-pkg
(uiop:symbol-call :org-agent.skills.org-skill-safety-harness :safety-harness-validate code)
t)))) ; Implicitly safe if harness not loaded
t))))
:body (lambda (args)
(let ((code (getf args :code)))
(handler-case (let ((result (eval (read-from-string code))))
@@ -199,7 +253,6 @@ EXAMPLES:
:parameters ((:cmd :type :string :description "The full bash command to execute"))
:guard (lambda (args context)
(declare (ignore context))
;; Global safety: prohibit destructive commands
(let ((cmd (getf args :cmd)))
(not (or (search "rm -rf /" cmd) (search ":(){ :|:& };:" cmd)))))
:body (lambda (args)