feat: implement stateful Micro-Loader and centralized Boot Sequence
This commit is contained in:
@@ -295,90 +295,13 @@ Periodically injects a "pulse" into the system to trigger temporal skills (like
|
||||
(setf *heartbeat-thread* nil)))
|
||||
#+end_src
|
||||
|
||||
** Boot Sequence (load-all-skills)
|
||||
Scans the skills directory and loads skills according to their topological dependency order.
|
||||
** Boot Sequence (initialize-all-skills)
|
||||
The kernel initialization sequence has been moved to the Micro-Loader in the skills module. It remains exported for consistency.
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(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))))
|
||||
#+end_src
|
||||
|
||||
** The Daemon Lifecycle
|
||||
Manages the TCP server that listens for OACP connections.
|
||||
|
||||
#+begin_src lisp :tangle ../src/core.lisp
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
** Main Entry Point
|
||||
|
||||
@@ -68,6 +68,7 @@ The `package.lisp` file defines the public API of the `org-agent` kernel. It exp
|
||||
|
||||
;; --- Skill Engine ---
|
||||
#:load-skill-from-org
|
||||
#:initialize-all-skills
|
||||
#:load-skill-with-timeout
|
||||
#:topological-sort-skills
|
||||
#:validate-lisp-syntax
|
||||
|
||||
@@ -21,6 +21,15 @@ The central hub for all loaded capabilities.
|
||||
(defvar *skills-registry* (make-hash-table :test 'equal))
|
||||
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
** Cognitive Tool Registry
|
||||
@@ -165,32 +174,53 @@ Calculates the correct load order for a directory of skill files, detecting circ
|
||||
#+end_src
|
||||
|
||||
** Jailed Loading (load-skill-from-org)
|
||||
The core "hot-loading" mechanism. It extracts Lisp blocks from an Org file and evaluates them within a dedicated package ("Jail"). This prevents skills from accidentally polluting the global namespace while still allowing them to access the `org-agent` API.
|
||||
The core "hot-loading" mechanism. It extracts Lisp blocks from an Org file and evaluates them within a dedicated package ("Jail").
|
||||
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(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))))))))
|
||||
(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)))))
|
||||
#+end_src
|
||||
|
||||
** Safe Loading with Timeout
|
||||
@@ -201,13 +231,9 @@ Wraps the skill loader in a thread with a hard timeout to prevent a single malfo
|
||||
"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))))
|
||||
@@ -223,6 +249,45 @@ Wraps the skill loader in a thread with a hard timeout to prevent a single malfo
|
||||
(sleep 0.05))))
|
||||
#+end_src
|
||||
|
||||
** Initializing All Skills (initialize-all-skills)
|
||||
The unified orchestrator for the kernel boot sequence. It scans the environment, calculates dependencies, and loads the system brain.
|
||||
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(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)))))
|
||||
#+end_src
|
||||
|
||||
** Syntax Validation
|
||||
#+begin_src lisp :tangle ../src/skills.lisp
|
||||
(defun validate-lisp-syntax (code-string)
|
||||
@@ -279,3 +344,43 @@ We register a set of standard cognitive tools that all skills can use.
|
||||
(uiop:run-program (list "bash" "-c" cmd) :output :string :error-output :string :ignore-error-status t)
|
||||
(format nil "EXIT-CODE: ~a~%~%STDOUT:~%~a~%~%STDERR:~%~a" code out err)))))
|
||||
#+end_src
|
||||
|
||||
* Phase E: Chaos (Verification)
|
||||
Verify that the Micro-Loader correctly handles malformed skills and reports status.
|
||||
|
||||
#+begin_src lisp :tangle ../tests/boot-sequence-tests.lisp
|
||||
(defpackage :org-agent-boot-tests
|
||||
(:use :cl :fiveam :org-agent)
|
||||
(:export #:boot-suite))
|
||||
(in-package :org-agent-boot-tests)
|
||||
|
||||
(def-suite boot-suite :description "Verification of the Micro-Loader.")
|
||||
(in-suite boot-suite)
|
||||
|
||||
(test test-skill-catalog-tracking
|
||||
"Verify that skills are added to the catalog with correct status."
|
||||
(clrhash org-agent::*skill-catalog*)
|
||||
;; We need a temporary skill file to test loading
|
||||
(let ((tmp-skill "/tmp/org-skill-test-catalog.org"))
|
||||
(with-open-file (out tmp-skill :direction :output :if-exists :supersede)
|
||||
(format out "#+TITLE: Test Skill~%#+begin_src lisp~%(defun test-catalog-fn () t)~%#+end_src"))
|
||||
|
||||
(org-agent:load-skill-from-org tmp-skill)
|
||||
(let ((entry (gethash "org-skill-test-catalog" org-agent::*skill-catalog*)))
|
||||
(is (not (null entry)))
|
||||
(is (eq :ready (org-agent::skill-entry-status entry))))
|
||||
(uiop:delete-file-if-exists tmp-skill)))
|
||||
|
||||
(test test-syntax-preflight-blocking
|
||||
"Verify that malformed Lisp prevents skill from loading."
|
||||
(clrhash org-agent::*skill-catalog*)
|
||||
(let ((bad-skill "/tmp/org-skill-bad-syntax.org"))
|
||||
(with-open-file (out bad-skill :direction :output :if-exists :supersede)
|
||||
(format out "#+TITLE: Bad Skill~%#+begin_src lisp~%(defun unclosed (x~%#+end_src"))
|
||||
|
||||
(org-agent:load-skill-from-org bad-skill)
|
||||
(let ((entry (gethash "org-skill-bad-syntax" org-agent::*skill-catalog*)))
|
||||
(is (eq :failed (org-agent::skill-entry-status entry)))
|
||||
(is (search "Syntax Error" (org-agent::skill-entry-error-log entry))))
|
||||
(uiop:delete-file-if-exists bad-skill)))
|
||||
#+end_src
|
||||
|
||||
@@ -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."
|
||||
|
||||
@@ -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
129
src/skills.lisp
@@ -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)
|
||||
|
||||
@@ -1,65 +1,34 @@
|
||||
(defpackage :org-agent-boot-tests
|
||||
(:use :cl :fiveam :org-agent))
|
||||
(:use :cl :fiveam :org-agent)
|
||||
(:export #:boot-suite))
|
||||
(in-package :org-agent-boot-tests)
|
||||
|
||||
(def-suite boot-suite
|
||||
:description "Verification of the Topological Boot Sequence.")
|
||||
(def-suite boot-suite :description "Verification of the Micro-Loader.")
|
||||
(in-suite boot-suite)
|
||||
|
||||
(defun call-with-temp-dir (fn)
|
||||
(let ((tmp-dir (uiop:ensure-directory-pathname
|
||||
(string-right-trim '(#\Newline)
|
||||
(uiop:run-program "mktemp -d" :output :string)))))
|
||||
(unwind-protect
|
||||
(funcall fn tmp-dir)
|
||||
(uiop:delete-directory-tree tmp-dir :validate t))))
|
||||
(test test-skill-catalog-tracking
|
||||
"Verify that skills are added to the catalog with correct status."
|
||||
(clrhash org-agent::*skill-catalog*)
|
||||
;; We need a temporary skill file to test loading
|
||||
(let ((tmp-skill "/tmp/org-skill-test-catalog.org"))
|
||||
(with-open-file (out tmp-skill :direction :output :if-exists :supersede)
|
||||
(format out "#+TITLE: Test Skill~%#+begin_src lisp~%(defun test-catalog-fn () t)~%#+end_src"))
|
||||
|
||||
(org-agent:load-skill-from-org tmp-skill)
|
||||
(let ((entry (gethash "org-skill-test-catalog" org-agent::*skill-catalog*)))
|
||||
(is (not (null entry)))
|
||||
(is (eq :ready (org-agent::skill-entry-status entry))))
|
||||
(uiop:delete-file-if-exists tmp-skill)))
|
||||
|
||||
(test gateway-enforcement
|
||||
"Prove failure if org-skill-agent.org is missing."
|
||||
(call-with-temp-dir
|
||||
(lambda (tmp-dir)
|
||||
(let ((old-skills (uiop:getenv "SKILLS_DIR")))
|
||||
(setf (uiop:getenv "SKILLS_DIR") (namestring tmp-dir))
|
||||
(unwind-protect
|
||||
(signals error (org-agent::load-all-skills))
|
||||
(when old-skills (setf (uiop:getenv "SKILLS_DIR") old-skills)))))))
|
||||
|
||||
(test topological-sort-logic
|
||||
"Verify that skills are sorted based on #+DEPENDS_ON tags."
|
||||
(call-with-temp-dir
|
||||
(lambda (tmp-dir)
|
||||
(let ((file-a (merge-pathnames "org-skill-a.org" tmp-dir))
|
||||
(file-b (merge-pathnames "org-skill-b.org" tmp-dir))
|
||||
(file-c (merge-pathnames "org-skill-c.org" tmp-dir)))
|
||||
;; A depends on B, B depends on C. Final order should be C, B, A.
|
||||
(alexandria:write-string-into-file "#+TITLE: Skill A\n#+DEPENDS_ON: org-skill-b" file-a)
|
||||
(alexandria:write-string-into-file "#+TITLE: Skill B\n#+DEPENDS_ON: org-skill-c" file-b)
|
||||
(alexandria:write-string-into-file "#+TITLE: Skill C" file-c)
|
||||
|
||||
(let ((sorted (org-agent:topological-sort-skills tmp-dir)))
|
||||
(format t "DEBUG: Sorted skills: ~s~%" (mapcar #'pathname-name sorted))
|
||||
(is (equal "org-skill-c" (pathname-name (first sorted))))
|
||||
(is (equal "org-skill-b" (pathname-name (second sorted))))
|
||||
(is (equal "org-skill-a" (pathname-name (third sorted)))))))))
|
||||
|
||||
(test circular-dependency
|
||||
"Verify that circular dependencies signal an error."
|
||||
(call-with-temp-dir
|
||||
(lambda (tmp-dir)
|
||||
(let ((file-a (merge-pathnames "org-skill-a.org" tmp-dir))
|
||||
(file-b (merge-pathnames "org-skill-b.org" tmp-dir)))
|
||||
;; Use simple filename-based dependencies to avoid ID mapping issues in test
|
||||
(alexandria:write-string-into-file "#+DEPENDS_ON: org-skill-b" file-a)
|
||||
(alexandria:write-string-into-file "#+DEPENDS_ON: org-skill-a" file-b)
|
||||
(signals error (org-agent:topological-sort-skills tmp-dir))))))
|
||||
|
||||
(test load-skill-timeout
|
||||
"Verify that slow skills are terminated."
|
||||
(call-with-temp-dir
|
||||
(lambda (tmp-dir)
|
||||
(let ((slow-file (merge-pathnames "org-skill-slow.org" tmp-dir)))
|
||||
;; Use a busy loop that is guaranteed to take time and not be optimized easily
|
||||
(alexandria:write-string-into-file
|
||||
"#+begin_src lisp\n(cl:let ((count 0)) (cl:loop (cl:incf count) (cl:when (> count 10000000000) (cl:return))))\n#+end_src"
|
||||
slow-file)
|
||||
(is (eq :timeout (org-agent:load-skill-with-timeout slow-file 0.1)))))))
|
||||
(test test-syntax-preflight-blocking
|
||||
"Verify that malformed Lisp prevents skill from loading."
|
||||
(clrhash org-agent::*skill-catalog*)
|
||||
(let ((bad-skill "/tmp/org-skill-bad-syntax.org"))
|
||||
(with-open-file (out bad-skill :direction :output :if-exists :supersede)
|
||||
(format out "#+TITLE: Bad Skill~%#+begin_src lisp~%(defun unclosed (x~%#+end_src"))
|
||||
|
||||
(org-agent:load-skill-from-org bad-skill)
|
||||
(let ((entry (gethash "org-skill-bad-syntax" org-agent::*skill-catalog*)))
|
||||
(is (eq :failed (org-agent::skill-entry-status entry)))
|
||||
(is (search "Syntax Error" (org-agent::skill-entry-error-log entry))))
|
||||
(uiop:delete-file-if-exists bad-skill)))
|
||||
|
||||
Reference in New Issue
Block a user