From 3b108a5e3751e6acf49bf20e184b94094cc05de6 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Sat, 11 Apr 2026 16:52:41 -0400 Subject: [PATCH] FEAT: Implement Micro-Loader with Topological Sort and Jailing --- docs/rca/rca-boot-sequence.org | 42 +++++ literate/skills.org | 199 ++++++++++-------------- src/skills.lisp | 273 ++++++++++++++++++++++++++++++--- tests/boot-sequence-tests.lisp | 88 ++++++++--- 4 files changed, 432 insertions(+), 170 deletions(-) create mode 100644 docs/rca/rca-boot-sequence.org diff --git a/docs/rca/rca-boot-sequence.org b/docs/rca/rca-boot-sequence.org new file mode 100644 index 0000000..419392c --- /dev/null +++ b/docs/rca/rca-boot-sequence.org @@ -0,0 +1,42 @@ +#+TITLE: Root Cause Analysis: Micro-Loader & Deterministic Boot Sequence +#+DATE: 2026-04-11 +#+FILETAGS: :rca:boot:loader:topological-sort:psf: + +* Executive Summary +Refactored the arbitrary skill loading mechanism into a robust **Micro-Loader**. The system now calculates a deterministic boot sequence based on `#+DEPENDS_ON:` tags and protects the kernel from malformed or hanging skills via package-based jailing and execution timeouts. + +* 1. Issue: Fragile Load Order +** Symptoms +Skills that depended on functions or variables from other skills would randomly fail to load depending on the filesystem's directory traversal order. +** Root Cause +`initialize-all-skills` used a simple `dolist` over `uiop:directory-files`, which has no semantic awareness of inter-skill dependencies. +** Resolution +1. **Metadata Scanning:** Implemented `parse-skill-metadata` to extract `:ID:` and `#+DEPENDS_ON:` without executing code. +2. **Topological Sort:** Implemented a DFS-based `topological-sort-skills` to guarantee that prerequisites are loaded before their dependents. +3. **Circular Detection:** Added explicit detection and error reporting for circular dependency loops. + +* 2. Issue: Shared State Corruption (Brain Rot) +** Symptoms +Variables or functions with the same name in different skills would silently overwrite each other, causing unpredictable behavior. +** Root Cause +All skills were being evaluated directly into the `org-agent` package. +** Resolution +**Package-Based Jailing:** Each skill is now evaluated within its own dedicated, shadowed package (e.g., `ORG-AGENT.SKILLS.ORG-SKILL-CHAT`). This ensures logical isolation while still allowing access to kernel exports. + +* 3. Issue: Boot Stall (The Hanging Skill) +** Symptoms +A single skill with an infinite loop or heavy synchronous initialization could hang the entire agent during startup. +** Root Cause +Skill loading was strictly synchronous and blocking on the main thread. +** Resolution +**Execution Timeouts:** Implemented `load-skill-with-timeout`, which wraps the loader in a monitored thread. If a skill takes longer than 5 seconds to initialize, the loader terminates the thread, jails the failure, and continues with the rest of the boot sequence. + +* 4. PSF Mandate Alignment +** Evolutionary Kernel +The boot sequence is now a verifiable, mathematical process rather than a side-effect of filesystem organization. +** Literate Granularity +The `org-skill-skills.org` source was refactored into a strictly granular "one definition per block" format. + +* 5. Permanent Learnings +- **Reverse Topological Order:** Remember that a DFS-based sort with `push` needs an `nreverse` to place dependencies at the front of the list. +- **Path Portability:** Use `uiop:getcwd` instead of `pwd` for more reliable path resolution across different Lisp implementations and OSes. diff --git a/literate/skills.org b/literate/skills.org index 946b0b4..1ee42c3 100644 --- a/literate/skills.org +++ b/literate/skills.org @@ -14,25 +14,21 @@ Hardcoding logic into a compiled binary creates a "Brittle Kernel." (in-package :org-agent) #+end_src -** Skill Registry -The central hub for all loaded capabilities. - -#+begin_src lisp :tangle ../src/skills.lisp -;; MOVED TO package.lisp -#+end_src - ** Skill Definition (defstruct skill) #+begin_src lisp :tangle ../src/skills.lisp (defstruct skill name priority dependencies trigger-fn neuro-prompt symbolic-fn) #+end_src -** Skill Catalog +** Skill Catalog Tracking A stateful tracking table for all skill files discovered in the environment. #+begin_src lisp :tangle ../src/skills.lisp (defvar *skill-catalog* (make-hash-table :test 'equal) "A stateful tracking table for all skill files discovered in the environment.") #+end_src + +** Skill Entry Structure +#+begin_src lisp :tangle ../src/skills.lisp (defstruct skill-entry filename (status :discovered) ;; :discovered, :loading, :ready, :failed @@ -40,81 +36,53 @@ A stateful tracking table for all skill files discovered in the environment. (load-time 0)) #+end_src -** Cognitive Tool Registry -Tools are discrete actions that System 1 (Neuro) can request. This registry tracks tool definitions, their parameters, and their safety guards. - -#+begin_src lisp :tangle ../src/skills.lisp -;; MOVED TO package.lisp -#+end_src - -** Cognitive Tool Definition (defstruct cognitive-tool) -#+begin_src lisp :tangle ../src/skills.lisp -;; MOVED TO package.lisp -#+end_src - -** Cognitive Tool Registration (def-cognitive-tool) -Allows skills to register hot-reloadable capabilities that System 1 can discover and invoke. - -#+begin_src lisp :tangle ../src/skills.lisp -;; MOVED TO package.lisp -#+end_src - -** Toolbelt Prompt Generation (generate-tool-belt-prompt) -Constructs the technical documentation of available tools that is injected into the LLM system prompt. - -#+begin_src lisp :tangle ../src/skills.lisp -(defun generate-tool-belt-prompt () - (let ((output (format nil "AVAILABLE TOOLS: -You can call tools by returning a Lisp plist: (:target :tool :action :call :tool :args (...)) - -EXAMPLES: -(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\")) -(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"sovereignty\")) -(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\")) - ---- -"))) - (maphash (lambda (name tool) - (setf output (concatenate 'string output - (format nil "- ~a: ~a~% Parameters: ~s~%~%" - name - (cognitive-tool-description tool) - (cognitive-tool-parameters tool))))) - *cognitive-tools*) - output)) -#+end_src - -** Defining Skills (defskill) -The primary macro used within Org files to register new agent capabilities. - -#+begin_src lisp :tangle ../src/skills.lisp -(defmacro defskill (name &key priority dependencies trigger neuro symbolic) - `(setf (gethash ,(string-downcase (string name)) *skills-registry*) - (make-skill :name ,(string-downcase (string name)) :priority (or ,priority 10) :dependencies ,dependencies - :trigger-fn ,trigger :neuro-prompt ,neuro :symbolic-fn ,symbolic))) -#+end_src - ** Skill Selection (find-triggered-skill) Iterates through the registry to find the highest-priority skill whose trigger function matches the current context. #+begin_src lisp :tangle ../src/skills.lisp (defun find-triggered-skill (context) + "Returns the highest priority skill whose trigger condition matches the context." (let ((triggered nil)) - (maphash (lambda (name skill) (declare (ignore name)) (when (ignore-errors (funcall (skill-trigger-fn skill) context)) (push skill triggered))) *skills-registry*) + (maphash (lambda (name skill) + (declare (ignore name)) + (when (ignore-errors (funcall (skill-trigger-fn skill) context)) + (push skill triggered))) + *skills-registry*) (first (sort triggered #'> :key #'skill-priority)))) #+end_src -** Dependency Resolution +** Skill Definition Macro (defskill) +The primary macro used within Org files to register new agent capabilities. + +#+begin_src lisp :tangle ../src/skills.lisp +(defmacro defskill (name &key priority dependencies trigger neuro symbolic) + "Registers a new skill into the global registry." + `(setf (gethash (string-downcase (string ,name)) *skills-registry*) + (make-skill :name (string-downcase (string ,name)) + :priority (or ,priority 10) + :dependencies ,dependencies + :trigger-fn ,trigger + :neuro-prompt ,neuro + :symbolic-fn ,symbolic))) +#+end_src + +** Dependency Resolution (resolve-skill-dependencies) Ensures that skills are loaded and unloaded in the correct order. #+begin_src lisp :tangle ../src/skills.lisp (defun resolve-skill-dependencies (skill-name) + "Recursively resolves dependencies for a given skill name." (let ((resolved nil) (seen nil)) - (labels ((visit (name) (unless (member name seen :test #'equal) (push name seen) - (let ((skill (gethash (string-downcase (string name)) *skills-registry*))) - (when skill (dolist (dep (skill-dependencies skill)) (visit dep)))) - (push name resolved)))) - (visit skill-name) (nreverse resolved)))) + (labels ((visit (name) + (unless (member name seen :test #'equal) + (push name seen) + (let ((skill (gethash (string-downcase (string name)) *skills-registry*))) + (when skill + (dolist (dep (skill-dependencies skill)) + (visit dep)))) + (push name resolved)))) + (visit skill-name) + (nreverse resolved)))) #+end_src ** Metadata Parsing (parse-skill-metadata) @@ -141,7 +109,7 @@ Robustly extracts `#+DEPENDS_ON:` and `:ID:` tags from an Org file without full #+end_src ** Topological Sorting (topological-sort-skills) -Calculates the correct load order for a directory of skill files, detecting circular dependencies. +Calculates the correct load order for a directory of skill filepaths, detecting circular dependencies. #+begin_src lisp :tangle ../src/skills.lisp (defun topological-sort-skills (skills-dir) @@ -183,6 +151,18 @@ Calculates the correct load order for a directory of skill files, detecting circ result))) #+end_src +** Syntax Validation (validate-lisp-syntax) +#+begin_src lisp :tangle ../src/skills.lisp +(defun validate-lisp-syntax (code-string) + "Checks if a string contains valid, readable Common Lisp forms." + (handler-case + (let ((*read-eval* nil)) + (with-input-from-string (stream (format nil "(progn ~a)" code-string)) + (loop for form = (read stream nil :eof) until (eq form :eof)) + (values t nil))) + (error (c) (values nil (format nil "~a" c))))) +#+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"). @@ -233,7 +213,7 @@ The core "hot-loading" mechanism. It extracts Lisp blocks from an Org file and e nil))))) #+end_src -** Safe Loading with Timeout +** Safe Loading with Timeout (load-skill-with-timeout) Wraps the skill loader in a thread with a hard timeout to prevent a single malformed skill from hanging the entire kernel boot sequence. #+begin_src lisp :tangle ../src/skills.lisp @@ -298,13 +278,30 @@ The unified orchestrator for the kernel boot sequence. It scans the environment, (values ready failed))))) #+end_src -** Syntax Validation +** Toolbelt Prompt Generation (generate-tool-belt-prompt) +Constructs the technical documentation of available tools that is injected into the LLM system prompt. + #+begin_src lisp :tangle ../src/skills.lisp -(defun validate-lisp-syntax (code-string) - "Checks if a string contains valid, readable Common Lisp forms." - (handler-case (let ((*read-eval* nil)) (with-input-from-string (stream (format nil "(progn ~a)" code-string)) - (loop for form = (read stream nil :eof) until (eq form :eof)) (values t nil))) - (error (c) (values nil (format nil "~a" c))))) +(defun generate-tool-belt-prompt () + "Aggregates all registered cognitive tools into a descriptive prompt." + (let ((output (format nil "AVAILABLE TOOLS: +You can call tools by returning a Lisp plist: (:target :tool :action :call :tool :args (...)) + +EXAMPLES: +(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\")) +(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"sovereignty\")) +(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\")) + +--- +"))) + (maphash (lambda (name tool) + (setf output (concatenate 'string output + (format nil "- ~a: ~a~% Parameters: ~s~%~%" + name + (cognitive-tool-description tool) + (cognitive-tool-parameters tool))))) + *cognitive-tools*) + output)) #+end_src ** The Default Tool Belt @@ -313,7 +310,7 @@ We register a set of standard cognitive tools that all skills can use. *** The Eval Tool #+begin_src lisp :tangle ../src/skills.lisp (def-cognitive-tool :eval "Evaluates raw Common Lisp code in the kernel image. Use this for complex calculations or internal state inspection." - :parameters ((:code :type :string :description "The Lisp code to evaluate")) + ((:code :type :string :description "The Lisp code to evaluate")) :guard (lambda (args context) (declare (ignore context)) (let ((code (getf args :code))) @@ -331,8 +328,8 @@ We register a set of standard cognitive tools that all skills can use. *** The Grep Tool #+begin_src lisp :tangle ../src/skills.lisp (def-cognitive-tool :grep-search "Searches for a pattern in the project files." - :parameters ((:pattern :type :string :description "The regex pattern to search for") - (:dir :type :string :description "Directory to search in (default is project root)")) + ((:pattern :type :string :description "The regex pattern to search for") + (:dir :type :string :description "Directory to search in (default is project root)")) :body (lambda (args) (let ((pattern (getf args :pattern)) (dir (or (getf args :dir) (uiop:getenv "MEMEX_DIR")))) @@ -343,7 +340,7 @@ We register a set of standard cognitive tools that all skills can use. *** The Shell Tool #+begin_src lisp :tangle ../src/skills.lisp (def-cognitive-tool :shell "Executes a shell command on the local machine. Use this for file operations, system checks, or running tests." - :parameters ((:cmd :type :string :description "The full bash command to execute")) + ((:cmd :type :string :description "The full bash command to execute")) :guard (lambda (args context) (declare (ignore context)) (let ((cmd (getf args :cmd))) @@ -354,43 +351,3 @@ 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 diff --git a/src/skills.lisp b/src/skills.lisp index 392a288..4541906 100644 --- a/src/skills.lisp +++ b/src/skills.lisp @@ -13,36 +13,259 @@ (defun find-triggered-skill (context) "Returns the highest priority skill whose trigger condition matches the context." - (let ((matched-skills nil)) - (maphash (lambda (name skill) - (declare (ignore name)) - (let ((trigger-fn (skill-trigger-fn skill))) - (when (and trigger-fn (funcall trigger-fn context)) - (push skill matched-skills)))) + (let ((triggered nil)) + (maphash (lambda (name skill) + (declare (ignore name)) + (when (ignore-errors (funcall (skill-trigger-fn skill) context)) + (push skill triggered))) *skills-registry*) - (first (sort matched-skills #'> :key #'skill-priority)))) + (first (sort triggered #'> :key #'skill-priority)))) (defmacro defskill (name &key priority dependencies trigger neuro symbolic) - `(setf (gethash ,(string-downcase (string name)) *skills-registry*) - (make-skill :name ,(string-downcase (string name)) :priority (or ,priority 10) :dependencies ,dependencies :trigger-fn ,trigger :neuro-prompt ,neuro :symbolic-fn ,symbolic))) + "Registers a new skill into the global registry." + `(setf (gethash (string-downcase (string ,name)) *skills-registry*) + (make-skill :name (string-downcase (string ,name)) + :priority (or ,priority 10) + :dependencies ,dependencies + :trigger-fn ,trigger + :neuro-prompt ,neuro + :symbolic-fn ,symbolic))) -(defun load-skill-from-org (path) - "Extracts Lisp source from an Org file and evaluates it." - (let ((skill-name (pathname-name path))) +(defun resolve-skill-dependencies (skill-name) + "Recursively resolves dependencies for a given skill name." + (let ((resolved nil) (seen nil)) + (labels ((visit (name) + (unless (member name seen :test #'equal) + (push name seen) + (let ((skill (gethash (string-downcase (string name)) *skills-registry*))) + (when skill + (dolist (dep (skill-dependencies skill)) + (visit dep)))) + (push name resolved)))) + (visit skill-name) + (nreverse resolved)))) + +(defun parse-skill-metadata (filepath) + "Extracts ID and DEPENDS_ON tags using robust line-scanning." + (let ((dependencies nil) + (id nil)) + (with-open-file (stream filepath) + (loop for line = (read-line stream nil :eof) + until (eq line :eof) + do (let ((clean (string-trim '(#\Space #\Tab #\Return #\Newline) line))) + (cond + ((uiop:string-prefix-p "#+DEPENDS_ON:" (string-upcase clean)) + (let* ((deps-part (string-trim " " (subseq clean 13)))) + (setf dependencies (append dependencies + (mapcar (lambda (s) (string-trim "[] " s)) + (uiop:split-string deps-part :separator '(#\Space #\Tab))))))) + ((uiop:string-prefix-p ":ID:" (string-upcase clean)) + (setf id (string-trim '(#\Space #\Tab) (subseq clean 4)))))))) + (values id (remove-if (lambda (s) (= 0 (length s))) dependencies)))) + +(defun topological-sort-skills (skills-dir) + "Returns a list of skill filepaths sorted by dependency (dependencies first)." + (let ((files (uiop:directory-files skills-dir "org-skill-*.org")) + (adj (make-hash-table :test 'equal)) + (id-to-file (make-hash-table :test 'equal)) + (result nil) + (visited (make-hash-table :test 'equal)) + (stack (make-hash-table :test 'equal))) + (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))) + (unless (gethash node-key visited) + (setf (gethash node-key stack) t) + (dolist (dep (gethash node-key adj)) + (let* ((dep-id (if (and (> (length dep) 3) (uiop:string-prefix-p "id:" (string-downcase dep))) + (subseq dep 3) + dep)) + (dep-file (gethash (string-downcase dep-id) id-to-file))) + (when dep-file + (let ((dep-filename (pathname-name dep-file))) + (if (gethash (string-downcase dep-filename) stack) + (error "Circular dependency detected: ~a -> ~a" filename dep-filename) + (visit dep-file)))))) + (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))))) + (nreverse result)))) + +(defun validate-lisp-syntax (code-string) + "Checks if a string contains valid, readable Common Lisp forms." + (handler-case + (let ((*read-eval* nil)) + (with-input-from-string (stream (format nil "(progn ~a)" code-string)) + (loop for form = (read stream nil :eof) until (eq form :eof)) + (values t nil))) + (error (c) (values nil (format nil "~a" c))))) + +(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 ((source (uiop:read-file-string path))) - (cl-ppcre:do-register-groups (code) ("#\\+begin_src lisp.*\\n([\\s\\S]*?)\\n#\\+end_src" source) - (let ((*package* (find-package :org-agent))) - (eval (read-from-string (concatenate 'string "(progn " code ")"))))) - (setf (gethash skill-name *skill-catalog*) (make-skill-entry :filename path :status :ready :load-time (get-universal-time))) - (kernel-log "SKILL [Loader] - Successfully loaded ~a" skill-name)) + (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) - (kernel-log "SKILL ERROR [Loader] - Failed to load ~a: ~a" skill-name c) - (setf (gethash skill-name *skill-catalog*) (make-skill-entry :filename path :status :failed :error-log (format nil "~a" 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 () + (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)))) + (loop + (when (eq finished t) (return :success)) + (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)) + #+sbcl (sb-thread:terminate-thread thread) + #-sbcl (bt:destroy-thread thread) + (return :timeout)) + (sleep 0.05)))) (defun initialize-all-skills () - "Discovers and loads all .org skills from the project directory." - (let ((skill-dir (or (uiop:getenv "SKILLS_DIR") "projects/org-agent/skills/"))) - (ensure-directories-exist skill-dir) - (dolist (path (uiop:directory-files skill-dir "*.org")) - (load-skill-from-org path)))) + "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 "projects/org-agent/skills/" (uiop:getcwd))))) + (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) + ;; Fallback check + (setq skills-dir (uiop:ensure-directory-pathname (merge-pathnames "projects/org-agent/skills/" (uiop:getcwd)))) + (unless (uiop:directory-exists-p skills-dir) + (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 generate-tool-belt-prompt () + "Aggregates all registered cognitive tools into a descriptive prompt." + (let ((output (format nil "AVAILABLE TOOLS: +You can call tools by returning a Lisp plist: (:target :tool :action :call :tool :args (...)) + +EXAMPLES: +(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\")) +(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"sovereignty\")) +(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\")) + +--- +"))) + (maphash (lambda (name tool) + (setf output (concatenate 'string output + (format nil "- ~a: ~a~% Parameters: ~s~%~%" + name + (cognitive-tool-description tool) + (cognitive-tool-parameters tool))))) + *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." + ((:code :type :string :description "The Lisp code to evaluate")) + :guard (lambda (args context) + (declare (ignore context)) + (let ((code (getf args :code))) + (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)))) + :body (lambda (args) + (let ((code (getf args :code))) + (handler-case (let ((result (eval (read-from-string code)))) + (format nil "~s" result)) + (error (c) (format nil "ERROR: ~a" c)))))) + +(def-cognitive-tool :grep-search "Searches for a pattern in the project files." + ((:pattern :type :string :description "The regex pattern to search for") + (:dir :type :string :description "Directory to search in (default is project root)")) + :body (lambda (args) + (let ((pattern (getf args :pattern)) + (dir (or (getf args :dir) (uiop:getenv "MEMEX_DIR")))) + (uiop:run-program (list "grep" "-r" "-n" "--exclude-dir=node_modules" pattern dir) + :output :string :ignore-error-status t)))) + +(def-cognitive-tool :shell "Executes a shell command on the local machine. Use this for file operations, system checks, or running tests." + ((:cmd :type :string :description "The full bash command to execute")) + :guard (lambda (args context) + (declare (ignore context)) + (let ((cmd (getf args :cmd))) + (not (or (search "rm -rf /" cmd) (search ":(){ :|:& };:" cmd))))) + :body (lambda (args) + (let ((cmd (getf args :cmd))) + (multiple-value-bind (out err code) + (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))))) diff --git a/tests/boot-sequence-tests.lisp b/tests/boot-sequence-tests.lisp index 2afb558..d1a45bd 100644 --- a/tests/boot-sequence-tests.lisp +++ b/tests/boot-sequence-tests.lisp @@ -6,29 +6,69 @@ (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-parse-skill-metadata + "Verify extraction of ID and DEPENDS_ON from Org headers." + (let ((tmp-file "/tmp/org-skill-test-metadata.org")) + (with-open-file (out tmp-file :direction :output :if-exists :supersede) + (format out ":PROPERTIES:~%:ID: test-id~%:END:~%#+DEPENDS_ON: dep1 dep2~%")) + (unwind-protect + (multiple-value-bind (id deps) (org-agent::parse-skill-metadata tmp-file) + (is (equal "test-id" id)) + (is (member "dep1" deps :test #'string=)) + (is (member "dep2" deps :test #'string=))) + (uiop:delete-file-if-exists tmp-file)))) -(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")) +(test test-topological-sort-basic + "Verify that skills are ordered by dependency." + (let ((tmp-dir "/tmp/org-agent-boot-test/")) + (uiop:ensure-all-directories-exist (list tmp-dir)) + ;; A depends on B + (with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede) + (format out "#+DEPENDS_ON: id:skill-b-id~%")) + (with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede) + (format out ":PROPERTIES:~%:ID: skill-b-id~%:END:~%")) + ;; Add executive soul (required) + (with-open-file (out (merge-pathnames "org-skill-agent.org" tmp-dir) :direction :output :if-exists :supersede) + (format out "#+TITLE: Agent~%")) - (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))) + (unwind-protect + (let ((sorted (org-agent::topological-sort-skills tmp-dir))) + ;; B must appear before A + (let ((pos-a (position "org-skill-a" sorted :key #'pathname-name :test #'string-equal)) + (pos-b (position "org-skill-b" sorted :key #'pathname-name :test #'string-equal))) + (is (not (null pos-a))) + (is (not (null pos-b))) + (is (< pos-b pos-a)))) + (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t)))) + +(test test-topological-sort-circular + "Verify that circular dependencies raise an error." + (let ((tmp-dir "/tmp/org-agent-boot-test-circ/")) + (uiop:ensure-all-directories-exist (list tmp-dir)) + ;; A depends on B, B depends on A + (with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede) + (format out "#+DEPENDS_ON: org-skill-b~%")) + (with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede) + (format out "#+DEPENDS_ON: org-skill-a~%")) + + (unwind-protect + (signals error (org-agent::topological-sort-skills tmp-dir)) + (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t)))) + +(test test-skill-jailing + "Verify that skills are loaded into their own packages." + (let ((tmp-skill "/tmp/org-skill-jail-test.org")) + (with-open-file (out tmp-skill :direction :output :if-exists :supersede) + (format out "#+begin_src lisp~%(defvar *jailed-var* 42)~%#+end_src")) + (unwind-protect + (progn + (org-agent::load-skill-from-org tmp-skill) + (let ((pkg (find-package :ORG-AGENT.SKILLS.ORG-SKILL-JAIL-TEST))) + (is (not (null pkg))) + (is (= 42 (symbol-value (find-symbol "*JAILED-VAR*" pkg)))))) + (uiop:delete-file-if-exists tmp-skill)))) + +(test test-syntax-validation + "Verify that malformed Lisp is caught by the pre-flight check." + (is (nth-value 0 (org-agent::validate-lisp-syntax "(defun x () t)"))) + (is (not (nth-value 0 (org-agent::validate-lisp-syntax "(defun x (")))))