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

fix(v0.2.0): resolve TUI crash and setup wizard errors

Browse Source 
- Fix unbalanced parens in config-manager (set-config-value, setup-gateways)
- Fix assoc :key #'car SBCL compatibility issue in setup-llm-providers
- Add missing generate-tool-belt-prompt function
- Fix deterministic-verify to not overwrite action when skills return nil
- Add :explanation to think fallback responses for policy compliance
- Update opencortex.sh to tangle from repo org to XDG .lisp
- Remove generated .lisp artifacts from repo (skills, tests, state)
This commit is contained in:
Amr Gharbeia
2026-04-30 17:04:01 -04:00
parent 1eb8a3db92
commit b63f5477c1
35 changed files with 249 additions and 1249 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
.env.example
View File

@@ -1,11 +1,6 @@
# opencortex: Environment Configuration Template
# Copy this to .env and fill in your values
# =============================================================================
# INSTALLATION
# =============================================================================
INSTALL_DIR="$HOME/.opencortex"
# =============================================================================
# IDENTITY
# =============================================================================
@@ -76,7 +71,6 @@ CONTEXT_LOG_LIMIT=20
# MEMEX STRUCTURE
# =============================================================================
MEMEX_DIR="$HOME/memex"
SKILLS_DIR="skills/"
ZETTELKASTEN_DIR="$HOME/memex/notes"
INBOX_DIR="$HOME/memex/inbox"
DAILY_DIR="$HOME/memex/daily"

5
harness/memory.lisp
View File

@@ -10,8 +10,7 @@
(defmethod make-load-form ((obj org-object) &optional env)
(make-load-form-saving-slots obj :environment env))
(defun deep-copy-org-object (obj)
"Create a deep copy of an org-object with fresh lists for mutable fields."
(defun copy-org-object (obj)
(make-org-object :id (org-object-id obj)
:type (org-object-type obj)
:attributes (copy-list (org-object-attributes obj))
@@ -72,7 +71,7 @@
(defun snapshot-memory ()
(let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory*))))
(maphash (lambda (k v) (setf (gethash k snapshot) (deep-copy-org-object v))) *memory*)
(maphash (lambda (k v) (setf (gethash k snapshot) (copy-org-object v))) *memory*)
(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)))
(harness-log "MEMORY - CoW Memory snapshot created.")))

17
harness/package.lisp
View File

@@ -224,7 +224,22 @@
:description ,description
:parameters ',parameters
:guard ,guard
:body ,body)))
:body ,body)))
(defun generate-tool-belt-prompt ()
"Generates a prompt string describing all available cognitive tools."
(let ((descriptions nil))
(maphash (lambda (k tool)
(declare (ignore k))
(push (format nil "- ~a: ~a~% Parameters: ~a~%"
(cognitive-tool-name tool)
(cognitive-tool-description tool)
(cognitive-tool-parameters tool))
descriptions))
*cognitive-tools*)
(if descriptions
(format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<)))
"No tools registered.")))
(defun harness-log (msg &rest args)
"Centralized logging for the harness."

17
harness/package.org
View File

@@ -240,7 +240,22 @@ The ~package.lisp~ file defines the public API of the ~opencortex~ harness.
:description ,description
:parameters ',parameters
:guard ,guard
:body ,body)))
:body ,body)))
(defun generate-tool-belt-prompt ()
"Generates a prompt string describing all available cognitive tools."
(let ((descriptions nil))
(maphash (lambda (k tool)
(declare (ignore k))
(push (format nil "- ~a: ~a~% Parameters: ~a~%"
(cognitive-tool-name tool)
(cognitive-tool-description tool)
(cognitive-tool-parameters tool))
descriptions))
*cognitive-tools*)
(if descriptions
(format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<)))
"No tools registered.")))
(defun harness-log (msg &rest args)
"Centralized logging for the harness."

18
harness/reason.lisp
View File

@@ -71,14 +71,14 @@
assistant-name reflection-feedback tool-belt global-context system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (strip-markdown thought)))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(normalize-plist-keywords parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (or cleaned "No response")))))))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(normalize-plist-keywords parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
(defun deterministic-verify (proposed-action context)
(let ((current-action proposed-action)
@@ -98,7 +98,7 @@
(member (proto-get next-action :type) '(:LOG :EVENT)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify next-action))
(setf current-action next-action)))))
(when next-action (setf current-action next-action))))))
current-action))
(defun reason-gate (signal)

18
harness/reason.org
View File

@@ -96,14 +96,14 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
assistant-name reflection-feedback tool-belt global-context system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (strip-markdown thought)))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (char= (char cleaned 0) #\((char= (char cleaned 0) #\()))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(normalize-plist-keywords parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (or cleaned "No response")))))))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(normalize-plist-keywords parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
#+end_src
** Deterministic Engine (Verification)
@@ -126,7 +126,7 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
(member (proto-get next-action :type) '(:LOG :EVENT)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify next-action))
(setf current-action next-action)))))
(when next-action (setf current-action next-action))))))
current-action))
#+end_src

82
harness/skills.lisp
View File

@@ -74,7 +74,9 @@
(defun topological-sort-skills (skills-dir)
"Returns a list of skill filepaths sorted by dependency."
(let ((files (uiop:directory-files skills-dir "org-skill-*.org"))
(let* ((org-files (uiop:directory-files skills-dir "org-skill-*.org"))
(lisp-files (uiop:directory-files skills-dir "org-skill-*.lisp"))
(files (append org-files lisp-files))
(adj (make-hash-table :test 'equal))
(name-to-file (make-hash-table :test 'equal))
(id-to-file (make-hash-table :test 'equal))
@@ -83,10 +85,14 @@
(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) name-to-file) file)
(when id (setf (gethash (string-downcase id) id-to-file) file))
(setf (gethash (string-downcase filename) adj) deps))))
(if (uiop:string-suffix-p (namestring file) ".lisp")
(progn
(setf (gethash (string-downcase filename) name-to-file) file)
(setf (gethash (string-downcase filename) adj) nil))
(multiple-value-bind (id deps) (parse-skill-metadata file)
(setf (gethash (string-downcase filename) name-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)))
@@ -122,6 +128,16 @@
(values t nil))
(error (c) (values nil (format nil "~a" c)))))
(defun remove-in-package-forms (code-string)
"Removes in-package forms so symbols get defined in skill package."
(let ((lines (uiop:split-string code-string :separator '(#\Newline)))
(result ""))
(dolist (line lines)
(let ((trimmed (string-trim '(#\Space #\Tab) line)))
(unless (uiop:string-prefix-p "(in-package" trimmed)
(setf result (concatenate 'string result line (string #\Newline))))))
result))
(defun extract-tangle-target (line)
"Extracts the value of the :tangle header."
(let ((pos (search ":tangle" line)))
@@ -133,7 +149,7 @@
(defun load-skill-from-org (filepath)
"Parses and evaluates Lisp blocks from an Org file."
(let* ((skill-base-name (pathname-name filepath))
(entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))
(entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
(setf (skill-entry-status entry) :loading)
(handler-case
(let* ((content (uiop:read-file-string filepath))
@@ -146,7 +162,7 @@
((uiop:string-prefix-p "#+begin_src lisp" clean-line)
(setf in-lisp-block t)
(let ((target (extract-tangle-target clean-line)))
;; Collect if there's no tangle target (inherits from file)
;; Collect if there's no tangle target (inherits from file)
;; or if it's a lisp file and NOT a test.
(setf collect-this-block (or (null target)
(and (not (search "no" target))
@@ -168,7 +184,7 @@
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
(harness-log "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*))
(eval (read-from-string (format nil "(progn ~a)" lisp-code))))
;; Export symbols back to :OPENCORTEX for discoverability and testing
(let* ((target-pkg (find-package :opencortex))
(raw-name (string-upcase skill-base-name))
@@ -190,13 +206,57 @@
(unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg))))))
(setf (skill-entry-status entry) :ready)))
t)
(error (c)
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name c)
(setf (skill-entry-status entry) :failed) nil))))
(defun load-skill-from-lisp (filepath)
"Loads a .lisp skill file directly, filtering out in-package forms."
(let* ((skill-base-name (pathname-name filepath))
(entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
(setf (skill-entry-status entry) :loading)
(handler-case
(let* ((content (remove-in-package-forms (uiop:read-file-string filepath)))
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword)))
(multiple-value-bind (valid-p err) (validate-lisp-syntax content)
(unless valid-p (error err)))
(unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :opencortex new-pkg)))
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
(harness-log "LOADER: Loading .lisp skill '~a' in package ~a" skill-base-name (package-name *package*))
;; Evaluate forms individually so one bad form doesn't abort the entire skill
(with-input-from-string (s content)
(loop for form = (read s nil :eof) until (eq form :eof)
do (handler-case (eval form)
(error (c) (harness-log "LOADER WARNING in '~a': ~a" skill-base-name c))))))
;; Export symbols
(let* ((target-pkg (find-package :opencortex))
(raw-name (string-upcase skill-base-name))
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
(subseq raw-name 10)
raw-name)))
(harness-log "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
(do-symbols (sym (find-package pkg-name))
(when (eq (symbol-package sym) (find-package pkg-name))
(let ((sn (symbol-name sym)))
(when (or (uiop:string-prefix-p raw-name sn)
(uiop:string-prefix-p short-name sn)
(string-equal sn "DOCTOR-MAIN")
(string-equal sn "RUN-SETUP-WIZARD"))
(harness-log "LOADER: Exporting ~a to :OPENCORTEX" sn)
(let ((existing (find-symbol sn target-pkg)))
(when (and existing (not (eq existing sym)))
(unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg))))))
(setf (skill-entry-status entry) :ready))
(error (c)
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name c)
(setf (skill-entry-status entry) :failed) nil))))
(defun initialize-all-skills ()
"Initializes all skills from SKILLS_DIR."
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
@@ -205,5 +265,7 @@
(let ((sorted-files (topological-sort-skills skills-dir)))
(harness-log "LOADER: Initializing ~a skills..." (length sorted-files))
(dolist (file sorted-files)
(load-skill-from-org file))
(if (uiop:string-suffix-p (namestring file) ".lisp")
(load-skill-from-lisp file)
(load-skill-from-org file)))
(harness-log "LOADER: Boot Complete."))))

82
harness/skills.org
View File

@@ -96,7 +96,9 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
#+begin_src lisp
(defun topological-sort-skills (skills-dir)
"Returns a list of skill filepaths sorted by dependency."
(let ((files (uiop:directory-files skills-dir "org-skill-*.org"))
(let* ((org-files (uiop:directory-files skills-dir "org-skill-*.org"))
(lisp-files (uiop:directory-files skills-dir "org-skill-*.lisp"))
(files (append org-files lisp-files))
(adj (make-hash-table :test 'equal))
(name-to-file (make-hash-table :test 'equal))
(id-to-file (make-hash-table :test 'equal))
@@ -105,10 +107,14 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(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) name-to-file) file)
(when id (setf (gethash (string-downcase id) id-to-file) file))
(setf (gethash (string-downcase filename) adj) deps))))
(if (uiop:string-suffix-p (namestring file) ".lisp")
(progn
(setf (gethash (string-downcase filename) name-to-file) file)
(setf (gethash (string-downcase filename) adj) nil))
(multiple-value-bind (id deps) (parse-skill-metadata file)
(setf (gethash (string-downcase filename) name-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)))
@@ -147,6 +153,16 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(values t nil))
(error (c) (values nil (format nil "~a" c)))))
(defun remove-in-package-forms (code-string)
"Removes in-package forms so symbols get defined in skill package."
(let ((lines (uiop:split-string code-string :separator '(#\Newline)))
(result ""))
(dolist (line lines)
(let ((trimmed (string-trim '(#\Space #\Tab) line)))
(unless (uiop:string-prefix-p "(in-package" trimmed)
(setf result (concatenate 'string result line (string #\Newline))))))
result))
(defun extract-tangle-target (line)
"Extracts the value of the :tangle header."
(let ((pos (search ":tangle" line)))
@@ -158,7 +174,7 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(defun load-skill-from-org (filepath)
"Parses and evaluates Lisp blocks from an Org file."
(let* ((skill-base-name (pathname-name filepath))
(entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))
(entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
(setf (skill-entry-status entry) :loading)
(handler-case
(let* ((content (uiop:read-file-string filepath))
@@ -171,7 +187,7 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
((uiop:string-prefix-p "#+begin_src lisp" clean-line)
(setf in-lisp-block t)
(let ((target (extract-tangle-target clean-line)))
;; Collect if there's no tangle target (inherits from file)
;; Collect if there's no tangle target (inherits from file)
;; or if it's a lisp file and NOT a test.
(setf collect-this-block (or (null target)
(and (not (search "no" target))
@@ -193,7 +209,7 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
(harness-log "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*))
(eval (read-from-string (format nil "(progn ~a)" lisp-code))))
;; Export symbols back to :OPENCORTEX for discoverability and testing
(let* ((target-pkg (find-package :opencortex))
(raw-name (string-upcase skill-base-name))
@@ -215,12 +231,56 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg))))))
(setf (skill-entry-status entry) :ready)))
t)
(error (c)
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name c)
(setf (skill-entry-status entry) :failed) nil))))
(defun load-skill-from-lisp (filepath)
"Loads a .lisp skill file directly, filtering out in-package forms."
(let* ((skill-base-name (pathname-name filepath))
(entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
(setf (skill-entry-status entry) :loading)
(handler-case
(let* ((content (remove-in-package-forms (uiop:read-file-string filepath)))
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword)))
(multiple-value-bind (valid-p err) (validate-lisp-syntax content)
(unless valid-p (error err)))
(unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :opencortex new-pkg)))
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
(harness-log "LOADER: Loading .lisp skill '~a' in package ~a" skill-base-name (package-name *package*))
;; Evaluate forms individually so one bad form doesn't abort the entire skill
(with-input-from-string (s content)
(loop for form = (read s nil :eof) until (eq form :eof)
do (handler-case (eval form)
(error (c) (harness-log "LOADER WARNING in '~a': ~a" skill-base-name c))))))
;; Export symbols
(let* ((target-pkg (find-package :opencortex))
(raw-name (string-upcase skill-base-name))
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
(subseq raw-name 10)
raw-name)))
(harness-log "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
(do-symbols (sym (find-package pkg-name))
(when (eq (symbol-package sym) (find-package pkg-name))
(let ((sn (symbol-name sym)))
(when (or (uiop:string-prefix-p raw-name sn)
(uiop:string-prefix-p short-name sn)
(string-equal sn "DOCTOR-MAIN")
(string-equal sn "RUN-SETUP-WIZARD"))
(harness-log "LOADER: Exporting ~a to :OPENCORTEX" sn)
(let ((existing (find-symbol sn target-pkg)))
(when (and existing (not (eq existing sym)))
(unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg))))))
(setf (skill-entry-status entry) :ready))
(error (c)
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name c)
(setf (skill-entry-status entry) :failed) nil))))
#+end_src
** Initialize (initialize-all-skills)
@@ -233,7 +293,9 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(let ((sorted-files (topological-sort-skills skills-dir)))
(harness-log "LOADER: Initializing ~a skills..." (length sorted-files))
(dolist (file sorted-files)
(load-skill-from-org file))
(if (uiop:string-suffix-p (namestring file) ".lisp")
(load-skill-from-lisp file)
(load-skill-from-org file)))
(harness-log "LOADER: Boot Complete."))))
#+end_src

82
opencortex.sh
View File

@@ -17,11 +17,11 @@ while [ -h "$SOURCE" ]; do
done
export SCRIPT_DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )"
# XDG Defaults
export OC_CONFIG_DIR="${XDG_CONFIG_HOME:-$HOME/.config}/opencortex"
export OC_DATA_DIR="${XDG_DATA_HOME:-$HOME/.local/share}/opencortex"
export OC_STATE_DIR="${XDG_STATE_HOME:-$HOME/.local/state}/opencortex"
export OC_BIN_DIR="${XDG_BIN_HOME:-$HOME/.local/bin}"
# XDG Defaults (realpath ensures no unexpanded ~ in paths)
export OC_CONFIG_DIR="$(realpath -m "${XDG_CONFIG_HOME:-$HOME/.config}/opencortex")"
export OC_DATA_DIR="$(realpath -m "${XDG_DATA_HOME:-$HOME/.local/share}/opencortex")"
export OC_STATE_DIR="$(realpath -m "${XDG_STATE_HOME:-$HOME/.local/state}/opencortex")"
export OC_BIN_DIR="$(realpath -m "${XDG_BIN_HOME:-$HOME/.local/bin}")"
# Dynamic defaults for Skill Engine and Project Root
export SKILLS_DIR="${SKILLS_DIR:-$OC_DATA_DIR/skills}"
@@ -69,7 +69,7 @@ setup_system() {
# Create standard directories
mkdir -p "$OC_CONFIG_DIR" "$OC_DATA_DIR" "$OC_STATE_DIR" "$OC_BIN_DIR"
mkdir -p "$OC_DATA_DIR/harness" "$OC_DATA_DIR/tests" "$OC_DATA_DIR/skills" "$OC_DATA_DIR/library"
mkdir -p "$OC_DATA_DIR/harness" "$OC_DATA_DIR/tests" "$OC_DATA_DIR/skills"
echo -e "${YELLOW}--- Installing System Dependencies ---${NC}"
if command_exists apt-get; then
@@ -81,50 +81,63 @@ setup_system() {
rm quicklisp.lisp
fi
# Tangle the literate source from OC_DATA_DIR to OC_DATA_DIR (The Engine)
# Tangle the literate source from the repo into XDG directories
echo -e "${YELLOW}--- Deploying Engine to $OC_DATA_DIR ---${NC}"
cp "$SCRIPT_DIR/opencortex.asd" "$OC_DATA_DIR/"
cp "$SCRIPT_DIR/harness"/*.org "$OC_DATA_DIR/harness/"
cp "$SCRIPT_DIR/skills"/*.org "$OC_DATA_DIR/skills/"
# Create tests directory before tangling (some org files write to tests/)
mkdir -p "$OC_DATA_DIR/tests"
mkdir -p "$OC_DATA_DIR/harness" "$OC_DATA_DIR/tests" "$OC_DATA_DIR/skills"
export INSTALL_DIR="$OC_DATA_DIR"
# Critical: Tangle manifest first to establish system structure (into root)
# --- Harness files ---
# Copy org files to harness/ so :tangle relative paths resolve to XDG
cp "$SCRIPT_DIR/harness"/*.org "$OC_DATA_DIR/harness/"
# Critical: Tangle manifest first (into root)
echo "Tangling harness/manifest.org..."
(cd "$OC_DATA_DIR" && emacs -Q --batch --eval "(require 'org)" --eval "(setq org-confirm-babel-evaluate nil)" --eval "(org-babel-tangle-file \"harness/manifest.org\")") >/dev/null 2>&1 || true
(cd "$OC_DATA_DIR/harness" && emacs -Q --batch \
--eval "(require 'org)" \
--eval "(setq org-confirm-babel-evaluate nil)" \
--eval "(org-babel-tangle-file \"manifest.org\")") >/dev/null 2>&1 || true
# Tangle harness files into harness/
for f in "$SCRIPT_DIR/harness"/*.org; do
for f in "$OC_DATA_DIR/harness"/*.org; do
fname=$(basename "$f" .org)
if [ "$fname" != "manifest" ]; then
echo "Tangling harness/$fname.org..."
(cd "$OC_DATA_DIR/harness" && emacs -Q --batch --eval "(require 'org)" --eval "(setq org-confirm-babel-evaluate nil)" --eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true
(cd "$OC_DATA_DIR/harness" && emacs -Q --batch \
--eval "(require 'org)" \
--eval "(setq org-confirm-babel-evaluate nil)" \
--eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true
fi
done
# Tangle skill files into skills/
# Move test files that landed in harness/ to tests/
find "$OC_DATA_DIR/harness" -name "*-tests.lisp" -exec mv {} "$OC_DATA_DIR/tests/" \; 2>/dev/null || true
# Remove org files from harness/ (only .lisp should remain)
rm -f "$OC_DATA_DIR/harness"/*.org
# --- Skill files ---
for f in "$SCRIPT_DIR/skills"/*.org; do
fname=$(basename "$f" .org)
echo "Tangling skills/$fname.org..."
# Replace %%SKILLS_DIR%% placeholder with actual XDG path
sed "s|%%SKILLS_DIR%%|$OC_DATA_DIR/skills|g" "$f" > "$OC_DATA_DIR/skills/$fname.org"
(cd "$OC_DATA_DIR/skills" && emacs -Q --batch --eval "(require 'org)" --eval "(setq org-confirm-babel-evaluate nil)" --eval "(org-babel-tangle-file \"${fname}.org\")") >/dev/null 2>&1 || true
sed "s|%%SKILLS_DIR%%|$OC_DATA_DIR/skills|g" "$f" > "/tmp/$fname.org"
(cd "$OC_DATA_DIR/skills" && emacs -Q --batch \
--eval "(require 'org)" \
--eval "(setq org-confirm-babel-evaluate nil)" \
--eval "(org-babel-tangle-file \"/tmp/$fname.org\")") >/dev/null 2>&1 || true
done
# Special handling for tests that need to go into tests/
# We'll just move them after tangling since many .org files tangle to both code and tests
mkdir -p "$OC_DATA_DIR/tests"
find "$OC_DATA_DIR/harness" "$OC_DATA_DIR/skills" -name "*-tests.lisp" -exec mv {} "$OC_DATA_DIR/tests/" \; 2>/dev/null || true
# Move test files that landed in skills/ to tests/
find "$OC_DATA_DIR/skills" -name "*-tests.lisp" -exec mv {} "$OC_DATA_DIR/tests/" \; 2>/dev/null || true
rm -f /tmp/*.org
# Also move run-all-tests.lisp if it landed in the wrong place
[ -f "$OC_DATA_DIR/run-all-tests.lisp" ] && mv "$OC_DATA_DIR/run-all-tests.lisp" "$OC_DATA_DIR/harness/"
# Cleanup: Remove .org files from XDG harness only (skills need .org for loader)
echo "Cleaning up .org files from XDG harness..."
rm -f "$OC_DATA_DIR/harness"/*.org
# Cleanup: Remove .org files from XDG (we only want .lisp)
echo "Cleaning up .org files from XDG..."
rm -f "$OC_DATA_DIR/harness"/*.org "$OC_DATA_DIR/skills"/*.org /tmp/*.org
cd "$SCRIPT_DIR" # Create the bin shim
echo -e "${YELLOW}--- Creating Bin Shim in $OC_BIN_DIR/opencortex ---${NC}"
@@ -140,7 +153,9 @@ setup_system() {
exec sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \
--eval "(setf (uiop:getenv \"SKILLS_DIR\") \"$OC_DATA_DIR/skills\")" \
--eval '(ql:quickload :opencortex)' \
--eval "(setf (uiop:getenv \"SKILLS_DIR\") \"$OC_DATA_DIR/skills\")" \
--eval '(opencortex:initialize-all-skills)' \
--eval '(funcall (find-symbol "RUN-SETUP-WIZARD" :opencortex))'
}
@@ -156,7 +171,7 @@ doctor_repair() {
# 2. Ensure XDG directories exist
echo -e "${YELLOW}--- Fixing XDG Directories ---${NC}"
mkdir -p "$OC_CONFIG_DIR" "$OC_DATA_DIR" "$OC_STATE_DIR" "$OC_BIN_DIR"
mkdir -p "$OC_DATA_DIR/harness" "$OC_DATA_DIR/tests" "$OC_DATA_DIR/skills" "$OC_DATA_DIR/library"
mkdir -p "$OC_DATA_DIR/harness" "$OC_DATA_DIR/tests" "$OC_DATA_DIR/skills"
# 3. Re-tangle harness files that may be broken
echo -e "${YELLOW}--- Re-tangling Harness Files ---${NC}"
@@ -183,8 +198,8 @@ doctor_repair() {
if [ -f "$f" ]; then
fname=$(basename "$f" .org)
echo " Checking skill/$fname..."
# Replace %%SKILLS_DIR%% placeholder and copy to XDG
sed "s|%%SKILLS_DIR%%|$OC_DATA_DIR/skills|g" "$f" > "$OC_DATA_DIR/skills/$fname.org"
# Replace %%SKILLS_DIR%% placeholder with temp file
sed "s|%%SKILLS_DIR%%|$OC_DATA_DIR/skills|g" "$f" > "/tmp/$fname.org"
if ! sbcl --non-interactive \
--eval "(load \"$OC_DATA_DIR/skills/${fname}.lisp\")" \
--eval "(format t \"OK~%\")" 2>/dev/null | grep -q "OK"; then
@@ -192,9 +207,9 @@ doctor_repair() {
(cd "$OC_DATA_DIR/skills" && emacs -Q --batch \
--eval "(require 'org)" \
--eval "(setq org-confirm-babel-evaluate nil)" \
--eval "(org-babel-tangle-file \"$OC_DATA_DIR/skills/${fname}.org\")" >/dev/null 2>&1) || true
--eval "(org-babel-tangle-file \"/tmp/${fname}.org\")" >/dev/null 2>&1) || true
fi
rm -f "$OC_DATA_DIR/skills/${fname}.org"
rm -f "/tmp/$fname.org"
fi
done
@@ -215,7 +230,7 @@ case "$COMMAND" in
PLATFORM=$1
TOKEN=$2
check_dependencies
exec sbcl --non-interactive --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' --eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" --eval '(ql:quickload :opencortex)' --eval '(opencortex:initialize-all-skills)' --eval "(funcall (find-symbol \"GATEWAY-MANAGER-MAIN\" :opencortex) \"$PLATFORM\" \"$TOKEN\")"
exec sbcl --non-interactive --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' --eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" --eval "(setf (uiop:getenv \"SKILLS_DIR\") \"$OC_DATA_DIR/skills\")" --eval '(ql:quickload :opencortex)' --eval '(opencortex:initialize-all-skills)' --eval "(funcall (find-symbol \"GATEWAY-MANAGER-MAIN\" :opencortex) \"$PLATFORM\" \"$TOKEN\")"
;;
doctor)
@@ -282,6 +297,7 @@ case "$COMMAND" in
sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \
--eval "(setf (uiop:getenv \"SKILLS_DIR\") \"$OC_DATA_DIR/skills\")" \
--eval '(ql:quickload :opencortex)' \
--eval '(opencortex:initialize-all-skills)' \
--eval '(funcall (find-symbol "RUN-SETUP-WIZARD" :opencortex))'

103
skills/org-skill-bouncer.lisp
View File

@@ -1,103 +0,0 @@
(in-package :opencortex)
(defvar *bouncer-network-whitelist*
'("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")
"Domains that the Bouncer considers safe for outbound connections.")
(defun bouncer-scan-secrets (text)
"Scans TEXT for known secrets from the vault."
(when (and text (stringp text))
(let ((found-secret nil))
(maphash (lambda (key val)
(when (and val (stringp val) (> (length val) 5))
(when (search val text)
(setf found-secret key))))
*vault-memory*)
found-secret)))
(defun bouncer-check-network-exfil (cmd)
"Detects if CMD attempts to contact an unwhitelisted external host."
(when (and cmd (stringp cmd))
(multiple-value-bind (match regs)
(cl-ppcre:scan-to-strings "(http|https|ftp)://([\\w\\.-]+)" cmd)
(declare (ignore match))
(when regs
(let ((domain (aref regs 1)))
(not (some (lambda (safe) (search safe domain))
*bouncer-network-whitelist*)))))))
(defun bouncer-check (action context)
"The 5-Vector security gate for high-risk actions."
(declare (ignore context))
(let* ((target (proto-get action :target))
(payload (proto-get action :payload))
(text (or (proto-get payload :text) (proto-get action :text)))
(cmd (or (proto-get payload :cmd)
(when (and (eq target :tool) (equal (proto-get payload :tool) "shell"))
(proto-get (proto-get payload :args) :cmd))))
(approved (proto-get action :approved)))
(cond
(approved action)
((and text (bouncer-scan-secrets text))
(let ((secret-name (bouncer-scan-secrets text)))
(harness-log "SECURITY VIOLATION: Blocked potential leak of secret '~a'" secret-name)
(list :type :LOG
:payload (list :level :error
:text (format nil "Action blocked: Potential exposure of '~a'" secret-name)))))
((and (or (eq target :shell)
(and (eq target :tool) (equal (proto-get payload :tool) "shell")))
(bouncer-check-network-exfil cmd))
(harness-log "SECURITY WARNING: External network call detected. Queuing for approval.")
(list :type :EVENT :payload (list :sensor :approval-required :action action)))
((or (member target '(:shell))
(and (eq target :tool) (member (proto-get payload :tool) '("shell" "repair-file") :test #'string=))
(and (eq target :emacs) (eq (proto-get payload :action) :eval)))
(harness-log "SECURITY: High-impact action requires approval: ~a" (or (proto-get payload :tool) target))
(list :type :EVENT :payload (list :sensor :approval-required :action action)))
(t action))))
(defun bouncer-process-approvals ()
"Scans for APPROVED flight plans and re-injects them."
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
(found-any nil))
(dolist (node approved-nodes)
(let* ((attrs (org-object-attributes node))
(tags (getf attrs :TAGS))
(action-str (getf attrs :ACTION)))
(when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
(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
(setf (getf action :approved) t)
(inject-stimulus action)
(setf (getf (org-object-attributes node) :TODO) "DONE")
(setq found-any t)))))
found-any))
(defun bouncer-create-flight-plan (blocked-action)
"Creates a Flight Plan node for manual approval."
(let ((id (org-id-new)))
(harness-log "BOUNCER: Creating flight plan node '~a'..." id)
(list :type :REQUEST :target :emacs
:payload (list :action :insert-node :id id
:attributes (list :TITLE "Flight Plan: High-Risk Action"
:TODO "PLAN" :TAGS '("FLIGHT_PLAN")
:ACTION (format nil "~s" blocked-action))))))
(defun bouncer-deterministic-gate (action context)
"Main deterministic gate for the Bouncer skill."
(let* ((payload (getf context :payload))
(sensor (getf payload :sensor)))
(case sensor
(:approval-required
(bouncer-create-flight-plan (getf payload :action)))
(:heartbeat
(bouncer-process-approvals)
(if action (bouncer-check action context) action))
(otherwise
(if action (bouncer-check action context) action)))))
(defskill :skill-bouncer
:priority 150
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic #'bouncer-deterministic-gate)

12
skills/org-skill-cli-gateway.lisp
View File

@@ -1,12 +0,0 @@
(in-package :opencortex)
(defun cli-process-input (text)
"Processes raw text from the command line."
(inject-stimulus (list :type :EVENT
:payload (list :sensor :user-input :text text)
:meta (list :source :CLI))))
(defskill :skill-cli-gateway
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))

250
skills/org-skill-config-manager.lisp
View File

@@ -1,250 +0,0 @@
(in-package :opencortex)
(defun get-oc-config-dir ()
"Returns the absolute path to the opencortex config directory."
(let ((xdg (uiop:getenv "OC_CONFIG_DIR")))
(if (and xdg (string/= xdg ""))
(uiop:ensure-directory-pathname xdg)
(uiop:ensure-directory-pathname (merge-pathnames ".config/opencortex/" (user-homedir-pathname))))))
(defun get-config-file ()
"Returns the path to the .env config file."
(merge-pathnames ".env" (get-oc-config-dir)))
(defun ensure-config-dir ()
"Ensures the config directory exists."
(let ((dir (get-oc-config-dir)))
(unless (uiop:directory-exists-p dir)
(uiop:ensure-directory-pathname dir))
dir))
(defun read-config-file ()
"Reads the .env config file and returns an alist of KEY=VALUE pairs."
(let ((config-file (get-config-file)))
(when (uiop:file-exists-p config-file)
(let ((lines (uiop:read-file-lines config-file))
(result nil))
(dolist (line lines)
(when (and line (> (length line) 0)
(not (uiop:string-prefix-p "#" line)))
(let ((eq-pos (position #\= line)))
(when eq-pos
(let ((key (string-trim " " (subseq line 0 eq-pos)))
(value (string-trim " " (subseq line (1+ eq-pos)))))
(push (cons key value) result))))))
(nreverse result)))))
(defun write-config-file (config-alist)
"Writes the config alist to the .env file."
(ensure-config-dir)
(let ((config-file (get-config-file)))
(with-open-file (stream config-file :direction :output :if-exists :supersede :if-does-not-exist :create)
(format stream "# OpenCortex Configuration~%")
(format stream "# Generated by opencortex setup~%~%")
(dolist (pair config-alist)
(format stream "~a=~a~%" (car pair) (cdr pair))))))
(defun get-config-value (key)
"Gets a config value by key."
(let ((config (read-config-file)))
(cdr (assoc key config :test #'string=))))
(defun set-config-value (key value)
"Sets a config value and saves to file."
(let ((config (read-config-file))
(pair (cons key value)))
(let ((existing (assoc key config :test #'string=)))
(if existing
(setf (cdr existing) value)
(push pair config))
(write-config-file config)))
(defun prompt (prompt-text)
"Simple prompt that returns user input as a string."
(format t "~a" prompt-text)
(finish-output)
(read-line))
(defun prompt-yes-no (prompt-text)
"Prompts yes/no question. Returns T for yes, nil for no."
(let ((response (prompt (format nil "~a [Y/n]: " prompt-text))))
(or (string= response "")
(string-equal response "Y")
(string-equal response "y")
(string-equal response "yes"))))
(defun prompt-choice (prompt-text options)
"Prompts user to choose from a list of options. Returns the chosen option or nil."
(format t "~a~%" prompt-text)
(let ((i 1))
(dolist (opt options)
(format t " ~a) ~a~%" i opt)
(incf i)))
(let ((response (prompt "Choice")))
(let ((num (ignore-errors (parse-integer response))))
(when (and num (<= 1 num) (>= (length options) num))
(nth (1- num) options)))))
(defvar *available-providers*
'(("OpenAI" . "OPENAI_API_KEY")
("Anthropic" . "ANTHROPIC_API_KEY")
("OpenRouter" . "OPENROUTER_API_KEY")
("Groq" . "GROQ_API_KEY")
("Gemini" . "GEMINI_API_KEY")
("Ollama (local)" . "OLLAMA_URL")))
(defun setup-llm-providers ()
"Interactive wizard for configuring LLM providers."
(format t "~%~%")
(format t "==================================================~%")
(format t " LLM Provider Configuration~%")
(format t "==================================================~%~%")
(let ((current-providers (loop for (name . key) in *available-providers*
when (get-config-value key)
collect name)))
(when current-providers
(format t "Current providers: ~{~a~^, ~}~%~%" current-providers))
(format t "Available providers:~%")
(dolist (p *available-providers*)
(format t " - ~a~%" (car p)))
(format t "~%")
(when (prompt-yes-no "Configure a new provider?")
(let ((chosen (prompt-choice "Select provider:" (mapcar #'car *available-providers*))))
(when chosen
(let ((env-key (cdr (assoc chosen *available-providers* :test #'string= :key #'car))))
(if (string= chosen "Ollama (local)")
(progn
(format t "Enter Ollama URL (e.g., http://localhost:11434): ")
(let ((url (read-line)))
(set-config-value env-key url)
(format t "✓ Ollama configured at ~a~%" url)))
(progn
(format t "Enter API key for ~a: " chosen)
(let ((key (read-line)))
(set-config-value env-key key)
(format t "✓ ~a API key saved~%" chosen)))))))))
(format t "~%"))
(defun setup-add-provider ()
"Entry point for adding a single provider (called from CLI)."
(setup-llm-providers))
(defun setup-gateways ()
"Interactive wizard for configuring external gateways."
(format t "~%~%")
(format t "==================================================~%")
(format t " Gateway Configuration~%")
(format t "==================================================~%~%")
(format t "Available gateways:~%")
(format t " - Slack (https://api.slack.com/)~%")
(format t " - Discord (https://discord.com/developers/)~%")
(format t "~%")
(when (prompt-yes-no "Configure a gateway?")
(let ((chosen (prompt-choice "Select platform:" '("Slack" "Discord"))))
(when chosen
(let ((token (prompt (format nil "Enter ~a bot token: " chosen))))
(if (string= chosen "Slack")
(set-config-value "SLACK_TOKEN" token)
(set-config-value "DISCORD_TOKEN" token))
(format t "✓ ~a gateway configured~%" chosen))))))
(format t "~%"))
(defun setup-skills ()
"Interactive wizard for enabling/disabling skills."
(format t "~%~%")
(format t "==================================================~%")
(format t " Skill Management~%")
(format t "==================================================~%~%")
(format t "Note: Skill management is not yet implemented.~%")
(format t "Skills are automatically loaded from ~a~%" (or (uiop:getenv "SKILLS_DIR") "default location"))
(format t "~%"))
(defun setup-memory ()
"Interactive wizard for memory settings."
(format t "~%~%")
(format t "==================================================~%")
(format t " Memory Settings~%")
(format t "==================================================~%~%")
(let ((auto-save (prompt "Auto-save interval in seconds [300]:")))
(when (and auto-save (> (length auto-save) 0))
(set-config-value "MEMORY_AUTO_SAVE_INTERVAL" auto-save)))
(let ((history (prompt "History retention in lines [1000]:")))
(when (and history (> (length history) 0))
(set-config-value "MEMORY_HISTORY_RETENTION" history)))
(format t "✓ Memory settings saved~%")
(format t "~%"))
(defun setup-network ()
"Interactive wizard for network settings."
(format t "~%~%")
(format t "==================================================~%")
(format t " Network Settings~%")
(format t "==================================================~%~%")
(let ((timeout (prompt "Request timeout in seconds [30]:")))
(when (and timeout (> (length timeout) 0))
(set-config-value "REQUEST_TIMEOUT" timeout)))
(let ((proxy (prompt "Proxy URL (leave empty for none) []:")))
(when (and proxy (> (length proxy) 0))
(set-config-value "HTTP_PROXY" proxy)))
(format t "✓ Network settings saved~%")
(format t "~%"))
(defun run-setup-wizard ()
"Main entry point for the interactive setup wizard."
(format t "~%~%")
(format t "╔═══════════════════════════════════════════════════╗~%")
(format t "║ OpenCortex Setup Wizard ║~%")
(format t "╚═══════════════════════════════════════════════════╝~%")
(format t "~%")
(format t "This wizard will help you configure:~%")
(format t " 1. LLM Providers (OpenAI, Anthropic, etc.)~%")
(format t " 2. Gateway Links (Slack, Discord)~%")
(format t " 3. Memory Settings~%")
(format t " 4. Network Settings~%")
(format t "~%")
(ensure-config-dir)
;; Step 1: LLM Providers
(when (prompt-yes-no "Configure LLM providers?")
(setup-llm-providers))
;; Step 2: Gateways
(when (prompt-yes-no "Configure gateways?")
(setup-gateways))
;; Step 3: Memory
(when (prompt-yes-no "Configure memory settings?")
(setup-memory))
;; Step 4: Network
(when (prompt-yes-no "Configure network settings?")
(setup-network))
;; Summary
(format t "==================================================~%")
(format t " Setup Complete!~%")
(format t "==================================================~%")
(format t "~%")
(format t "Configuration saved to: ~a~%" (get-config-file))
(format t "~%")
(format t "To verify your setup, run: opencortex doctor~%")
(format t "~%"))
(defskill :skill-config-manager
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

8
skills/org-skill-config-manager.org
View File

@@ -70,7 +70,7 @@ The *Config Manager* skill provides the OpenCortex Agent with the capability to
(if existing
(setf (cdr existing) value)
(push pair config))
(write-config-file config)))
(write-config-file config))))
#+end_src
** Input Utilities
@@ -104,7 +104,7 @@ The *Config Manager* skill provides the OpenCortex Agent with the capability to
** LLM Provider Setup
#+begin_src lisp
(defvar *available-providers*
(defparameter *available-providers*
'(("OpenAI" . "OPENAI_API_KEY")
("Anthropic" . "ANTHROPIC_API_KEY")
("OpenRouter" . "OPENROUTER_API_KEY")
@@ -133,7 +133,7 @@ The *Config Manager* skill provides the OpenCortex Agent with the capability to
(when (prompt-yes-no "Configure a new provider?")
(let ((chosen (prompt-choice "Select provider:" (mapcar #'car *available-providers*))))
(when chosen
(let ((env-key (cdr (assoc chosen *available-providers* :test #'string= :key #'car))))
(let ((env-key (cdr (assoc chosen *available-providers* :test #'string=))))
(if (string= chosen "Ollama (local)")
(progn
(format t "Enter Ollama URL (e.g., http://localhost:11434): ")
@@ -174,7 +174,7 @@ The *Config Manager* skill provides the OpenCortex Agent with the capability to
(if (string= chosen "Slack")
(set-config-value "SLACK_TOKEN" token)
(set-config-value "DISCORD_TOKEN" token))
(format t "✓ ~a gateway configured~%" chosen))))))
(format t "✓ ~a gateway configured~%" chosen)))))
(format t "~%"))
#+end_src

27
skills/org-skill-credentials-vault.lisp
View File

@@ -1,27 +0,0 @@
(in-package :opencortex)
(defvar *vault-memory* (make-hash-table :test 'equal)
"In-memory cache of sensitive credentials.")
(defun vault-get-secret (provider &key (type :api-key))
"Retrieves a credential from the vault or environment."
(let* ((key (format nil "~a-~a" provider type))
(val (gethash key *vault-memory*)))
(if val
val
(let ((env-var (case provider
(:gemini "GEMINI_API_KEY")
(:openai "OPENAI_API_KEY")
(:anthropic "ANTHROPIC_API_KEY")
(:openrouter "OPENROUTER_API_KEY")
(otherwise nil))))
(when env-var (uiop:getenv env-var))))))
(defun vault-set-secret (provider secret &key (type :api-key))
"Stores a secret in the vault."
(let ((key (format nil "~a-~a" provider type)))
(setf (gethash key *vault-memory*) secret)))
(defskill :skill-credentials-vault
:priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

176
skills/org-skill-diagnostics.lisp
View File

@@ -1,176 +0,0 @@
(in-package :opencortex)
(defvar *doctor-required-binaries* '("sbcl" "emacs" "git" "socat" "nc")
"List of external binaries required for full system operation.")
(defvar *doctor-package-map*
'(("sbcl" . "sbcl")
("emacs" . "emacs")
("git" . "git")
("socat" . "socat")
("nc" . "netcat-openbsd")
("curl" . "curl")
("rlwrap" . "rlwrap"))
"Map binary names to apt package names.")
(defvar *doctor-missing-deps* nil
"List of missing dependencies populated by doctor-check-dependencies.")
(defvar *doctor-auto-install* t
"When T, doctor will attempt to install missing dependencies automatically.")
(defun doctor-check-dependencies ()
"Verifies that required external binaries are available in the PATH via shell probe."
(setf *doctor-missing-deps* nil)
(let ((all-ok t))
(format t "DOCTOR: Checking system dependencies...~%")
(dolist (dep *doctor-required-binaries*)
(let ((path (ignore-errors
(uiop:run-program (list "which" dep)
:output :string :ignore-error-status t))))
(if (and path (> (length path) 0))
(format t " [OK] Found ~a~%" dep)
(progn
(format t " [FAIL] Missing binary: ~a~%" dep)
(push dep *doctor-missing-deps*)
(setf all-ok nil)))))
(when (and all-ok (null *doctor-missing-deps*))
(format t "DOCTOR: All dependencies satisfied.~%"))
all-ok))
(defun doctor-install-dependencies ()
"Attempts to install missing system dependencies via apt."
(when (null *doctor-missing-deps*)
(format t "DOCTOR: No missing dependencies to install.~%")
(return-from doctor-install-dependencies t))
(format t "DOCTOR: Attempting to install ~a missing dependencies...~%" (length *doctor-missing-deps*))
(let ((packages (remove-duplicates
(mapcar (lambda (dep)
(or (cdr (assoc dep *doctor-package-map* :test #'string=))
dep))
*doctor-missing-deps*)
:test #'string=)))
(format t "DOCTOR: Packages to install: ~a~%" packages)
(let ((cmd (format nil "apt-get install -y ~{~a~^ ~}" packages)))
(format t "DOCTOR: Running: ~a~%" cmd)
(handler-case
(let ((output (uiop:run-program cmd
:output :string
:error-output :string
:external-format :utf-8)))
(if (zerop (uiop:run-program (format nil "which ~a" (car *doctor-missing-deps*))
:ignore-error-status t))
(progn
(format t "DOCTOR: Dependencies installed successfully.~%")
(setf *doctor-missing-deps* nil)
t)
(progn
(format t "DOCTOR: Installation failed. Output: ~a~%" output)
nil)))
(error (c)
(format t "DOCTOR: Installation error: ~a~%" c)
nil)))))
(defun doctor-check-env ()
"Validates XDG directories and environment configuration."
(format t "DOCTOR: Checking XDG environment...~%")
(let ((all-ok t)
(config-dir (uiop:getenv "OC_CONFIG_DIR"))
(data-dir (uiop:getenv "OC_DATA_DIR"))
(state-dir (uiop:getenv "OC_STATE_DIR"))
(memex-dir (uiop:getenv "MEMEX_DIR")))
(flet ((check-dir (name path critical)
(if (and path (> (length path) 0))
(if (uiop:directory-exists-p path)
(format t " [OK] ~a: ~a~%" name path)
(progn
(format t " [FAIL] ~a directory missing: ~a~%" name path)
(when critical (setf all-ok nil))))
(progn
(format t " [FAIL] ~a variable not set.~%" name)
(when critical (setf all-ok nil))))))
(check-dir "Config (OC_CONFIG_DIR)" config-dir t)
(check-dir "Data (OC_DATA_DIR)" data-dir t)
(check-dir "State (OC_STATE_DIR)" state-dir t)
(check-dir "Memex (MEMEX_DIR)" memex-dir t))
all-ok))
(defun doctor-check-llm ()
"Tests connectivity to LLM providers. Returns T if at least one provider is configured."
(format t "DOCTOR: Checking LLM connectivity...~%")
(let ((providers '((:openrouter . "OPENROUTER_API_KEY")
(:anthropic . "ANTHROPIC_API_KEY")
(:openai . "OPENAI_API_KEY")
(:groq . "GROQ_API_KEY")
(:gemini . "GEMINI_API_KEY")
(:ollama . "OLLAMA_URL")))
(configured nil))
(dolist (p providers)
(let ((env-val (uiop:getenv (cdr p))))
(cond
((and env-val (> (length env-val) 0))
(format t " [OK] ~a configured~%" (car p))
(setf configured t))
((eq (car p) :ollama)
(let ((ollama-check (ignore-errors
(uiop:run-program '("curl" "-s" "http://localhost:11434/api/tags")
:output :string :ignore-error-status t))))
(when (and ollama-check (search "\"models\"" ollama-check))
(format t " [OK] Ollama local model server detected~%")
(setf configured t)))))))
(if configured
(progn
(format t " [OK] LLM provider(s) available~%")
t)
(progn
(format t " [WARN] No LLM provider configured.~%")
(format t " Run 'opencortex setup' to configure a provider.~%")
t))))
(defun doctor-run-all (&key (auto-install t))
"Executes the full diagnostic suite and returns T if system is healthy."
(format t "==================================================~%")
(format t " OPENCORTEX DOCTOR: Commencing Health Check~%")
(format t "==================================================~%")
(let ((dep-ok (doctor-check-dependencies)))
(when (and (not dep-ok) auto-install *doctor-auto-install*)
(format t "DOCTOR: Attempting automatic installation...~%")
(setf dep-ok (doctor-install-dependencies))
(when dep-ok
(setf dep-ok (doctor-check-dependencies))))
(let ((env-ok (doctor-check-env))
(llm-ok (doctor-check-llm)))
(format t "==================================================~%")
(if (and dep-ok env-ok)
(progn
(format t " ✓ SYSTEM HEALTHY: Ready for ignition.~%")
t) ;; Explicitly return T
(progn
(format t "==================================================~%")
(format t " ISSUES FOUND:~%")
(when (not dep-ok)
(format t " - Missing system dependencies~%"))
(when (not llm-ok)
(format t " - No LLM provider configured~%"))
(format t "~%")
(format t " RECOMMENDED ACTIONS:~%")
(format t " 1. Run 'opencortex setup' to configure everything~%")
(format t " 2. Or run 'opencortex doctor --fix' for auto-repair~%")
(format t "==================================================~%")
nil))))) ;; Return nil when issues found
(defun doctor-main ()
"Entry point for the 'doctor' CLI command."
(if (doctor-run-all)
(uiop:quit 0)
(uiop:quit 1)))
(defskill :skill-diagnostics
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))

23
skills/org-skill-engineering-standards.lisp
View File

@@ -1,23 +0,0 @@
(in-package :opencortex)
(defun verify-git-clean-p (dir)
"Checks if a directory has uncommitted changes."
(let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain")
:output :string
:ignore-error-status t)))
(string= "" (string-trim '(#\Space #\Newline #\Tab) status))))
(defun engineering-standards-verify-lisp (code)
"Enforces Lisp structural and semantic standards using utils-lisp."
(let ((result (utils-lisp-validate code :strict t)))
(if (eq (getf result :status) :success)
t
(error (getf result :reason)))))
(defun engineering-standards-format-lisp (code)
"Ensures Lisp code adheres to formatting standards."
(utils-lisp-format code))
(defskill :skill-engineering-standards
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

18
skills/org-skill-gardener.lisp
View File

@@ -1,18 +0,0 @@
(in-package :opencortex)
(defun gardener-prune-orphans ()
"Identifies and handles orphaned objects in memory."
(harness-log "GARDENER: Pruning orphans..."))
(defun gardener-verify-merkle-integrity ()
"Validates the hashes of all objects in memory."
(harness-log "GARDENER: Verifying Merkle integrity..."))
(defskill :skill-gardener
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
:deterministic (lambda (action ctx)
(declare (ignore action ctx))
(gardener-prune-orphans)
(gardener-verify-merkle-integrity)
nil))

18
skills/org-skill-gateway-manager.lisp
View File

@@ -1,18 +0,0 @@
(in-package :opencortex)
(defun skill-gateway-register (platform token)
"Registers a new external gateway."
(harness-log "GATEWAY: Registered ~a with token ~a" platform (VAULT-MASK-STRING token)))
(defun skill-gateway-link (platform)
"Establishes a link with an external platform."
(harness-log "GATEWAY: Linking to ~a..." platform))
(defun gateway-manager-main (platform token)
"Main entry point for gateway configuration."
(skill-gateway-register platform token)
(skill-gateway-link platform))
(defskill :skill-gateway-manager
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

9
skills/org-skill-homoiconic-memory.lisp
View File

@@ -1,9 +0,0 @@
(in-package :opencortex)
(defun memory-self-inspect ()
"Allows the system to inspect its own memory state."
(harness-log "MEMORY: Self-inspection triggered."))
(defskill :skill-homoiconic-memory
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

15
skills/org-skill-literate-programming.lisp
View File

@@ -1,15 +0,0 @@
(in-package :opencortex)
(defun literate-check-block-balance (org-file)
"Verifies that all Lisp source blocks in an Org file are balanced."
(harness-log "LITERATE: Checking block balance for ~a" org-file)
t)
(defun check-tangle-sync (org-file lisp-file)
"Verifies that the Lisp file matches the tangled output of the Org file."
(harness-log "LITERATE: Checking tangle sync for ~a <-> ~a" org-file lisp-file)
t)
(defskill :skill-literate-programming
:priority 300
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

23
skills/org-skill-llama-backend.lisp
View File

@@ -1,23 +0,0 @@
(in-package :opencortex)
(defun ollama-call (prompt system-prompt &key (model "llama3"))
"Sends a request to the local Ollama API."
(let* ((host (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
(url (format nil "http://~a/api/generate" host))
(payload (cl-json:encode-json-to-string
`((model . ,model)
(prompt . ,prompt)
(system . ,system-prompt)
(stream . nil)))))
(handler-case
(let ((response (dex:post url :content payload :headers '(("Content-Type" . "application/json")))))
(let ((data (cl-json:decode-json-from-string response)))
(list :status :success :content (getf data :response))))
(error (c)
(list :status :error :message (format nil "Ollama Failure: ~a" c))))))
(register-probabilistic-backend :ollama #'ollama-call)
(defskill :skill-llama-backend
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

16
skills/org-skill-llm-gateway.lisp
View File

@@ -1,16 +0,0 @@
(in-package :opencortex)
(defun execute-llm-request (&key prompt system-prompt (provider :ollama) model)
"Central dispatcher for LLM requests."
(let ((backend (gethash provider *probabilistic-backends*)))
(if backend
(handler-case
(funcall backend prompt system-prompt :model model)
(error (c)
(list :status :error :message (format nil "~a Failure: ~a" provider c))))
(list :status :error :message (format nil "Provider ~a not registered" provider)))))
(defskill :skill-llm-gateway
:priority 100
:trigger (lambda (ctx) (getf ctx :user-input))
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))

12
skills/org-skill-peripheral-vision.lisp
View File

@@ -1,12 +0,0 @@
(in-package :opencortex)
(defun peripheral-vision-summarize (obj-id)
"Generates a low-resolution summary of an object."
(let ((obj (lookup-object obj-id)))
(if obj
(format nil "Node: ~a (~a)" (getf (org-object-attributes obj) :TITLE) obj-id)
"[Unknown Node]")))
(defskill :skill-peripheral-vision
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

19
skills/org-skill-policy.lisp
View File

@@ -1,19 +0,0 @@
(in-package :opencortex)
(defun policy-check (action context)
"Enforces constitutional invariants on proposed actions."
(declare (ignore context))
(let* ((payload (proto-get action :payload))
(explanation (proto-get payload :explanation)))
(if (and explanation (stringp explanation) (> (length explanation) 10))
action
(progn
(harness-log "POLICY VIOLATION: Action lacks sufficient explanation.")
(list :type :LOG
:payload (list :level :warn
:text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning."))))))
(defskill :skill-policy
:priority 500
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic #'policy-check)

15
skills/org-skill-protocol-validator.lisp
View File

@@ -1,15 +0,0 @@
(in-package :opencortex)
(defun protocol-validate (msg)
"Enforces structural schema compliance on protocol messages."
(validate-communication-protocol-schema msg))
(defskill :skill-protocol-validator
:priority 95
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(handler-case
(progn (protocol-validate action) action)
(error (c)
(list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))

12
skills/org-skill-scribe.lisp
View File

@@ -1,12 +0,0 @@
(in-package :opencortex)
(defun scribe-log-event (signal)
"Logs a metabolic signal for later analysis."
(let ((type (getf signal :type))
(payload (getf signal :payload)))
(harness-log "SCRIBE: [~a] ~s" type payload)))
(defskill :skill-scribe
:priority 100
:trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :STATUS)))
:deterministic (lambda (action ctx) (declare (ignore action)) (scribe-log-event ctx) nil))

9
skills/org-skill-self-edit.lisp
View File

@@ -1,9 +0,0 @@
(in-package :opencortex)
(defun self-edit-apply (filepath old-text new-text)
"Applies a transformation to a source file."
(harness-log "SELF-EDIT: Applying changes to ~a" filepath))
(defskill :skill-self-edit
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

10
skills/org-skill-self-fix.lisp
View File

@@ -1,10 +0,0 @@
(in-package :opencortex)
(defun self-fix-broken-skill (skill-name error-log)
"Attempts to diagnose and repair a broken skill."
(harness-log "SELF-FIX: Attempting repair of ~a..." skill-name))
(defskill :skill-self-fix
:priority 100
:trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :EVENT)))
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))

19
skills/org-skill-shell-actuator.lisp
View File

@@ -1,19 +0,0 @@
(in-package :opencortex)
(defun shell-execute (action context)
"Executes a bash command and returns the output."
(declare (ignore context))
(let* ((payload (getf action :payload))
(cmd (getf payload :cmd)))
(harness-log "ACT [Shell]: ~a" cmd)
(multiple-value-bind (out err code)
(uiop:run-program (list "bash" "-c" cmd) :output :string :error-output :string :ignore-error-status t)
(if (= code 0)
out
(format nil "ERROR [~a]: ~a" code err)))))
(register-actuator :shell #'shell-execute)
(defskill :skill-shell-actuator
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

15
skills/org-skill-tool-permissions.lisp
View File

@@ -1,15 +0,0 @@
(in-package :opencortex)
(defvar *tool-permissions* (make-hash-table :test 'equal))
(defun set-tool-permission (tool-name level)
"Sets the permission level for a tool."
(setf (gethash (string-downcase (string tool-name)) *tool-permissions*) level))
(defun get-tool-permission (tool-name)
"Retrieves the permission level for a tool."
(gethash (string-downcase (string tool-name)) *tool-permissions* :ask))
(defskill :skill-tool-permissions
:priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

150
skills/org-skill-utils-lisp.lisp
View File

@@ -1,150 +0,0 @@
(in-package :opencortex)
(defun utils-lisp-check-structural (code)
"Checks if parentheses are balanced and the code is readable."
(handler-case
(let ((*read-eval* nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)))
(values t nil))
(error (c)
(values nil (format nil "Reader Error: ~a" c)))))
(defun utils-lisp-check-syntactic (code)
"Checks for valid Lisp syntax beyond just balanced parentheses."
(utils-lisp-check-structural code))
(defun utils-lisp-check-semantic (code)
"Checks for potentially unsafe forms."
(let ((unsafe-tokens '("eval" "load" "uiop:run-program" "sb-ext:run-program" "cl-user::eval")))
(loop for token in unsafe-tokens
when (search token (string-downcase code))
do (return-from utils-lisp-check-semantic (values nil (format nil "Unsafe form detected: ~a" token))))
(values t nil)))
(defun utils-lisp-validate (code &key (strict t))
"Unified validation gate for Lisp code."
(multiple-value-bind (struct-ok struct-err) (utils-lisp-check-structural code)
(unless struct-ok
(return-from utils-lisp-validate (list :status :error :reason struct-err)))
(when strict
(multiple-value-bind (sem-ok sem-err) (utils-lisp-check-semantic code)
(unless sem-ok
(return-from utils-lisp-validate (list :status :error :reason sem-err)))))
(list :status :success)))
(defun utils-lisp-eval (code-string &key (package :opencortex))
"Evaluates a Lisp string and captures its output/results."
(let ((out (make-string-output-stream))
(err (make-string-output-stream)))
(handler-case
(let* ((*standard-output* out)
(*error-output* err)
(*package* (or (find-package package) (find-package :opencortex)))
(result (with-input-from-string (s code-string)
(let ((last-val nil))
(loop for form = (read s nil :eof) until (eq form :eof)
do (setf last-val (eval form)))
last-val))))
(list :status :success
:result (format nil "~a" result)
:output (get-output-stream-string out)
:error (get-output-stream-string err)))
(error (c)
(list :status :error
:reason (format nil "~a" c)
:output (get-output-stream-string out)
:error (get-output-stream-string err))))))
(defun utils-lisp-format (code-string)
"Attempts to format Lisp code using Emacs batch mode if available."
(handler-case
(let ((tmp-file "/tmp/oc-format-temp.lisp"))
(uiop:with-output-file (s tmp-file :if-exists :supersede)
(format s "~a" code-string))
(multiple-value-bind (out err code)
(uiop:run-program (list "emacs" "--batch" tmp-file
"--eval" "(indent-region (point-min) (point-max))"
"--eval" "(princ (buffer-string))")
:output :string :error-output :string :ignore-error-status t)
(if (= code 0)
out
(progn
(harness-log "FORMAT ERROR: ~a" err)
code-string))))
(error (c)
(harness-log "FORMAT EXCEPTION: ~a" c)
code-string)))
(defun utils-lisp-structural-extract (code function-name)
"Extracts the definition of a specific function from a code string."
(let ((*read-eval* nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
when (and (listp form)
(symbolp (car form))
(member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
(symbolp (second form))
(string-equal (symbol-name (second form)) function-name))
do (return-from utils-lisp-structural-extract (format nil "~s" form))))
nil))
(defun utils-lisp-structural-wrap (code target-name wrapper-symbol)
"Wraps a specific form in a wrapper form (e.g., wrap in a let)."
(let ((*read-eval* nil) (results nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
do (if (and (listp form)
(symbolp (second form))
(string-equal (symbol-name (second form)) target-name))
(push (list wrapper-symbol form) results)
(push form results))))
(format nil "~{~s~^~%~%~}" (nreverse results))))
(defun utils-lisp-list-definitions (code)
"Returns a list of names for all top-level definitions (defun, defmacro, etc.)."
(let ((*read-eval* nil) (names nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
when (and (listp form)
(symbolp (car form))
(member (symbol-name (car form))
'("DEFUN" "DEFMACRO" "DEFMETHOD" "DEFVAR" "DEFPARAMETER")
:test #'string-equal)
(symbolp (second form)))
do (push (second form) names)))
(nreverse names)))
(defun utils-lisp-structural-inject (code target-name new-form-string)
"Injects a new form into the body of a targeted definition."
(let ((*read-eval* nil)
(new-form (read-from-string new-form-string))
(results nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
do (if (and (listp form)
(symbolp (car form))
(member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
(symbolp (second form))
(string-equal (symbol-name (second form)) target-name))
(push (append form (list new-form)) results)
(push form results))))
(format nil "~{~s~^~%~%~}" (nreverse results))))
(defun utils-lisp-structural-slurp (code target-name form-to-slurp-string)
"Adds a form to the end of a named list or definition (Paredit slurp)."
(let ((*read-eval* nil)
(to-slurp (read-from-string form-to-slurp-string))
(results nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
do (if (and (listp form)
(symbolp (second form))
(string-equal (symbol-name (second form)) target-name))
(push (append form (list to-slurp)) results)
(push form results))))
(format nil "~{~s~^~%~%~}" (nreverse results))))
(defskill :skill-utils-lisp
:priority 400
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

94
skills/org-skill-utils-org.lisp
View File

@@ -1,94 +0,0 @@
(in-package :opencortex)
(defun utils-org-read-file (filepath)
"Reads an Org file into a string."
(uiop:read-file-string filepath))
(defun utils-org-write-file (filepath content)
"Writes content to an Org file."
(uiop:with-output-file (s filepath :if-exists :supersede)
(format s "~a" content)))
(defun utils-org-generate-id ()
"Generates a new UUID for an Org node."
(string-downcase (format nil "~a" (uuid:make-v4-uuid))))
(defun utils-org-id-format (id)
"Ensures the ID has the 'id:' prefix."
(if (uiop:string-prefix-p "id:" id)
id
(format nil "id:~a" id)))
(defun utils-org-set-property (ast target-id property value)
"Recursively sets a property on a headline with a matching ID in the AST."
(let ((type (getf ast :type))
(props (getf ast :properties))
(contents (getf ast :contents)))
(when (and (eq type :HEADLINE) (string= (getf props :ID) target-id))
(setf (getf (getf ast :properties) property) value)
(return-from utils-org-set-property t))
(dolist (child contents)
(when (listp child)
(when (utils-org-set-property child target-id property value)
(return-from utils-org-set-property t)))))
nil)
(defun utils-org-set-todo (ast target-id status)
"Sets the TODO status of a headline in the AST."
(utils-org-set-property ast target-id :TODO status))
(defun utils-org-add-headline (ast parent-id title)
"Adds a new headline as a child of the parent-id in the AST."
(let ((type (getf ast :type))
(props (getf ast :properties))
(id (getf props :ID))
(contents (getf ast :contents)))
(when (and (eq type :HEADLINE) (string= id parent-id))
(let ((new-node (list :type :HEADLINE
:properties (list :ID (utils-org-id-format (utils-org-generate-id))
:TITLE title)
:contents nil)))
(setf (getf ast :contents) (append contents (list new-node)))
(return-from utils-org-add-headline t)))
(dolist (child contents)
(when (listp child)
(when (utils-org-add-headline child parent-id title)
(return-from utils-org-add-headline t)))))
nil)
(defun utils-org-find-headline-by-id (ast id)
"Finds a headline by its ID in the AST."
(let ((props (getf ast :properties)))
(when (string= (getf props :ID) id)
(return-from utils-org-find-headline-by-id ast))
(dolist (child (getf ast :contents))
(when (listp child)
(let ((found (utils-org-find-headline-by-id child id)))
(when found (return-from utils-org-find-headline-by-id found)))))
nil))
(defun utils-org-find-headline-by-title (ast title)
"Finds a headline by its title in the AST."
(let ((props (getf ast :properties)))
(when (string-equal (getf props :TITLE) title)
(return-from utils-org-find-headline-by-title ast))
(dolist (child (getf ast :contents))
(when (listp child)
(let ((found (utils-org-find-headline-by-title child title)))
(when found (return-from utils-org-find-headline-by-title found)))))
nil))
(defun utils-org-modify (filepath id changes)
"Placeholder for Emacs-driven modification of a specific node."
(harness-log "UTILS-ORG: Applying changes to ~a in ~a" id filepath)
(declare (ignore changes))
t)
(defun utils-org-ast-to-org (ast)
"Minimal converter from AST back to Org text (Placeholder)."
(declare (ignore ast))
"* TITLE (Placeholder)")
(defskill :skill-utils-org
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

16
state/memory-image.lisp
View File

@@ -1,16 +0,0 @@
(in-package :opencortex)
(SETF (GETHASH "fake-hash-123" *HISTORY-STORE*)
#S(ORG-OBJECT
:ID "persist-test-1"
:TYPE NIL
:ATTRIBUTES NIL
:CONTENT "Integrity Check"
:VECTOR NIL
:PARENT-ID NIL
:CHILDREN NIL
:VERSION NIL
:LAST-SYNC NIL
:HASH "fake-hash-123"))
(SETF (GETHASH "persist-test-1" *MEMORY*)
(GETHASH "fake-hash-123" *HISTORY-STORE*))

28
tests/llm-gateway-tests.lisp
View File

@@ -1,28 +0,0 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :opencortex-llm-gateway-tests
(:use :cl :opencortex)
(:export #:llm-gateway-suite))
(in-package :opencortex-llm-gateway-tests)
(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM Gateway skill")
(fiveam:in-suite llm-gateway-suite)
(fiveam:test test-llm-gateway-timeout
"Tier 2 Chaos: Verify that LLM Gateway handles connection failures gracefully."
(let ((old-host (uiop:getenv "OLLAMA_HOST")))
(unwind-protect
(progn
(setf (uiop:getenv "OLLAMA_HOST") "localhost:1")
(let ((fn (or (find-symbol "EXECUTE-LLM-REQUEST" :opencortex.skills.org-skill-llm-gateway)
(find-symbol "EXECUTE-LLM-REQUEST" :opencortex))))
(if fn
(let ((result (funcall fn :prompt "hello" :provider :ollama)))
(fiveam:is (eq (getf result :status) :error))
(fiveam:is (uiop:string-prefix-p "Ollama Failure" (getf result :message))))
(fiveam:fail "Could not find EXECUTE-LLM-REQUEST symbol"))))
(if old-host
(setf (uiop:getenv "OLLAMA_HOST") old-host)
(sb-posix:unsetenv "OLLAMA_HOST")))))

74
tests/utils-lisp-tests.lisp
View File

@@ -1,74 +0,0 @@
(defpackage :opencortex-utils-lisp-tests
(:use :cl :fiveam :opencortex)
(:export #:utils-lisp-suite))
(in-package :opencortex-utils-lisp-tests)
(def-suite utils-lisp-suite
:description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
(in-suite utils-lisp-suite)
(test structural-balanced
(is (eq t (opencortex:utils-lisp-check-structural "(+ 1 2)"))))
(test structural-unbalanced-open
(multiple-value-bind (ok reason) (opencortex:utils-lisp-check-structural "(+ 1 2")
(is (null ok))
(is (search "Reader Error" reason))))
(test structural-unbalanced-close
(multiple-value-bind (ok reason) (opencortex:utils-lisp-check-structural "+ 1 2)")
(is (null ok))
(is (search "Reader Error" reason))))
(test syntactic-valid
(is (eq t (opencortex:utils-lisp-check-syntactic "(+ 1 2)"))))
(test semantic-safe
(is (eq t (opencortex:utils-lisp-check-semantic "(+ 1 2)"))))
(test semantic-blocked-eval
(multiple-value-bind (ok reason) (opencortex:utils-lisp-check-semantic "(eval '(+ 1 2))")
(is (null ok))
(is (search "Unsafe" reason))))
(test unified-success
(let ((result (opencortex:utils-lisp-validate "(+ 1 2)" :strict t)))
(is (eq (getf result :status) :success))))
(test unified-failure
(let ((result (opencortex:utils-lisp-validate "(+ 1 2" :strict nil)))
(is (eq (getf result :status) :error))))
(test eval-basic
(let ((result (opencortex:utils-lisp-eval "(+ 1 2)")))
(is (eq (getf result :status) :success))
(is (string= (getf result :result) "3"))))
(test structural-extract
(let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
(extracted (opencortex:utils-lisp-structural-extract code "hello")))
(is (not (null extracted)))
(let ((form (read-from-string extracted)))
(is (eq (car form) 'DEFUN))
(is (eq (second form) 'HELLO)))))
(test list-definitions
(let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
(let ((names (opencortex:utils-lisp-list-definitions code)))
(is (member 'FOO names))
(is (member 'BAR names))
(is (member '*BAZ* names)))))
(test structural-inject
(let* ((code "(defun my-fun (x) (print x))")
(injected (opencortex:utils-lisp-structural-inject code "my-fun" "(finish-output)")))
(let ((form (read-from-string injected)))
(is (equal (last form) '((FINISH-OUTPUT)))))))
(test structural-slurp
(let* ((code "(defun work () (step-1))")
(slurped (opencortex:utils-lisp-structural-slurp code "work" "(step-2)")))
(let ((form (read-from-string slurped)))
(is (equal (last form) '((STEP-2)))))))