feat: add DeepSeek and NVIDIA NIM providers
- Add deepseek and nvidia entries to gateway-provider config - Add DEEPSEEK_API_KEY and NVIDIA_API_KEY to .env.example - Add deepseek and nvidia to doctor's LLM provider check - Fix remaining harness-log → log-message reference
This commit is contained in:
@@ -1,405 +0,0 @@
|
||||
#+TITLE: SKILL: Bouncer (org-skill-bouncer.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:bouncer:authorization:autonomy:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-bouncer.lisp
|
||||
|
||||
* Overview
|
||||
The *Bouncer Skill* is the physical security layer of OpenCortex. It enforces operational security checks on all proposed actions.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Security Configuration — network whitelist
|
||||
Domains that the Bouncer considers safe for outbound connections. Network calls to unlisted domains are blocked or queued for approval.
|
||||
#+begin_src lisp
|
||||
(defvar *bouncer-network-whitelist*
|
||||
'("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")
|
||||
"Domains the Bouncer considers safe for outbound connections.")
|
||||
#+end_src
|
||||
|
||||
** Privacy filter tags (bouncer-privacy-tags)
|
||||
List of tag strings that mark content as private. Content with these tags is filtered from the LLM context window. Configurable via ~PRIVACY_FILTER_TAGS~ env var.
|
||||
#+begin_src lisp
|
||||
(defvar bouncer-privacy-tags
|
||||
(let ((env (uiop:getenv "PRIVACY_FILTER_TAGS")))
|
||||
(if env
|
||||
(uiop:split-string env :separator '(#\,))
|
||||
'("@personal")))
|
||||
"Tags marking content as private. Set via PRIVACY_FILTER_TAGS.")
|
||||
#+end_src
|
||||
|
||||
** Protected file paths (bouncer-protected-paths)
|
||||
Path patterns (with * wildcards) that are blocked from file reads. Covers SSH keys, PEM/PGP files, credentials, tokens, env files, and cloud configs.
|
||||
#+begin_src lisp
|
||||
(defvar bouncer-protected-paths
|
||||
'(".env" ".env.example" ".env.local" ".env.production"
|
||||
"*credentials*" "*cred*"
|
||||
"*id_rsa*" "*id_dsa*" "*id_ecdsa*" "*id_ed25519*"
|
||||
"*.pem" "*.key" "*.p12" "*.pfx" "*.asc" "*.gpg" "*.pgp"
|
||||
"secring.*" "pubring.*" "private-keys-v1.d/*"
|
||||
"token*" "*secret*" "*token*"
|
||||
".netrc" ".git-credentials" "auth.json"
|
||||
".aws/credentials" ".aws/config"
|
||||
".kube/config" "kubeconfig"
|
||||
"*.cert" "*.crt" "*.csr"
|
||||
"*password*" "*passwd*")
|
||||
"Path patterns blocked from file reads.")
|
||||
#+end_src
|
||||
|
||||
** Content exposure patterns (bouncer-exposure-patterns)
|
||||
Named regex patterns for scanning content for secret exposure. Each entry is a (name regex) pair. Matches are reported by name so downstream code can act on specific categories.
|
||||
#+begin_src lisp
|
||||
(defvar bouncer-exposure-patterns
|
||||
'((:pem-key "-----BEGIN +(RSA|DSA|EC|OPENSSH|PGP) +PRIVATE +KEY *-----")
|
||||
(:pgp-key "-----BEGIN +PGP +PRIVATE +KEY +BLOCK-----")
|
||||
(:pgp-public "-----BEGIN +PGP +PUBLIC +KEY +BLOCK-----")
|
||||
(:openai-key "sk-[A-Za-z0-9-]{20,}")
|
||||
(:google-key "AIza[0-9A-Za-z_-]{35}")
|
||||
(:github-token "gh[pousr]_[A-Za-z0-9]{36,}")
|
||||
(:slack-token "xox[baprs]-[A-Za-z0-9-]{24,}")
|
||||
(:env-assignment "[A-Z_]+=[A-Za-z0-9+/=_\\-]{20,}")
|
||||
(:generic-secret "(api|secret|password|token)[ ]*[:=][ ]*[\"']?[A-Za-z0-9_\\-]{16,}"))
|
||||
"Named regex patterns for secret exposure detection.")
|
||||
#+end_src
|
||||
|
||||
** Shell safety — timeout
|
||||
Maximum seconds a shell command is allowed to run before being killed.
|
||||
#+begin_src lisp
|
||||
(defvar *bouncer-shell-timeout* 30
|
||||
"Maximum seconds for a shell command before timeout.")
|
||||
#+end_src
|
||||
|
||||
** Shell safety — output limit
|
||||
Maximum characters of shell command output to capture. Prevents memory exhaustion from infinite output.
|
||||
#+begin_src lisp
|
||||
(defvar *bouncer-shell-max-output* 100000
|
||||
"Maximum characters of shell output to capture.")
|
||||
#+end_src
|
||||
|
||||
** Shell safety — blocked patterns
|
||||
Destructive and injection patterns that are blocked in shell commands. Covers ~rm -rf /~, ~dd~, ~mkfs~, ~shred~, backtick injection, and ~$()~ subshell injection.
|
||||
#+begin_src lisp
|
||||
(defvar *bouncer-shell-blocked-patterns*
|
||||
'((:destructive-rm "\\brm\\s+-rf\\s+/")
|
||||
(:destructive-dd "\\bdd\\s+if=")
|
||||
(:destructive-mkfs "\\bmkfs\\.")
|
||||
(:destructive-format "\\bmformat\\b")
|
||||
(:disk-wipe "\\bshred\\s+/dev/")
|
||||
(:disk-wipe-b "\\bwipefs\\s+/dev/")
|
||||
(:injection-backtick "`[^`]+`")
|
||||
(:injection-subshell "\\$\\([^)]+\\)"))
|
||||
"Destructive and injection patterns blocked in shell commands.")
|
||||
#+end_src
|
||||
|
||||
** Secret Path Check (bouncer-check-secret-path)
|
||||
#+begin_src lisp
|
||||
(defun bouncer-wildcard-match (pattern path)
|
||||
"Matches PATH against PATTERN where * matches any characters."
|
||||
(let ((regex (cl-ppcre:regex-replace-all
|
||||
"\\*" (cl-ppcre:quote-meta-chars pattern) ".*")))
|
||||
(cl-ppcre:scan regex path)))
|
||||
|
||||
(defun bouncer-check-secret-path (filepath)
|
||||
"Returns the matching pattern if FILEPATH matches a protected path, nil otherwise."
|
||||
(when (and filepath (stringp filepath))
|
||||
(some (lambda (pattern)
|
||||
(when (bouncer-wildcard-match pattern filepath)
|
||||
pattern))
|
||||
bouncer-protected-paths)))
|
||||
#+end_src
|
||||
|
||||
** Content Exposure Scanner (bouncer-scan-exposure)
|
||||
#+begin_src lisp
|
||||
(defun bouncer-scan-exposure (text)
|
||||
"Scans TEXT for patterns matching known secret formats.
|
||||
Returns a list of matched category keywords."
|
||||
(when (and text (stringp text) (> (length text) 0))
|
||||
(let ((matches nil))
|
||||
(dolist (entry bouncer-exposure-patterns)
|
||||
(let ((name (first entry))
|
||||
(regex (second entry)))
|
||||
(when (cl-ppcre:scan regex text)
|
||||
(push name matches))))
|
||||
matches)))
|
||||
#+end_src
|
||||
|
||||
** Vault Secret Scanning (bouncer-scan-secrets)
|
||||
#+begin_src lisp
|
||||
(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)))
|
||||
#+end_src
|
||||
|
||||
** Privacy Tag Check (bouncer-check-privacy-tags)
|
||||
#+begin_src lisp
|
||||
(defun bouncer-check-privacy-tags (tags-list)
|
||||
"Returns T if any tag in TAGS-LIST matches a privacy filter tag."
|
||||
(when (and tags-list (listp tags-list))
|
||||
(some (lambda (tag)
|
||||
(some (lambda (private)
|
||||
(or (string-equal tag private)
|
||||
(search private tag :test #'string-equal)))
|
||||
bouncer-privacy-tags))
|
||||
tags-list)))
|
||||
|
||||
(defun bouncer-check-text-for-privacy (text)
|
||||
"Scans TEXT for leaked privacy-tagged content."
|
||||
(when (and text (stringp text))
|
||||
(let ((lower (string-downcase text)))
|
||||
(some (lambda (tag)
|
||||
(search (string-downcase tag) lower))
|
||||
bouncer-privacy-tags))))
|
||||
#+end_src
|
||||
|
||||
** Lisp Validation Gate (bouncer-check-lisp-valid)
|
||||
#+begin_src lisp
|
||||
(defun bouncer-extract-org-lisp-blocks (content)
|
||||
"Extracts concatenated Lisp code from #+begin_src lisp blocks in an Org string."
|
||||
(when (and content (stringp content))
|
||||
(let ((lines (uiop:split-string content :separator '(#\Newline)))
|
||||
(in-block nil)
|
||||
(code ""))
|
||||
(dolist (line lines)
|
||||
(let ((clean (string-trim '(#\Space #\Tab) line)))
|
||||
(cond
|
||||
((search "#+begin_src lisp" clean)
|
||||
(setf in-block t))
|
||||
((search "#+end_src" clean)
|
||||
(setf in-block nil))
|
||||
(in-block
|
||||
(setf code (concatenate 'string code line (string #\Newline)))))))
|
||||
(when (> (length code) 0) code))))
|
||||
|
||||
(defun bouncer-check-lisp-valid (filepath content)
|
||||
"Validates Lisp syntax when writing .lisp files or Org files with lisp blocks.
|
||||
Returns the validation result plist or nil if not applicable."
|
||||
(when (and content (stringp content) (> (length content) 0))
|
||||
(let ((to-validate
|
||||
(cond
|
||||
((uiop:string-suffix-p filepath ".lisp") content)
|
||||
((uiop:string-suffix-p filepath ".org") (bouncer-extract-org-lisp-blocks content))
|
||||
(t nil))))
|
||||
(when to-validate
|
||||
(multiple-value-bind (valid-p err) (ignore-errors
|
||||
(let ((*read-eval* nil))
|
||||
(with-input-from-string (s (format nil "(progn ~a)" to-validate))
|
||||
(loop for form = (read s nil :eof) until (eq form :eof)))
|
||||
(values t nil)))
|
||||
(unless valid-p
|
||||
(list :status :error :reason err)))))))
|
||||
#+end_src
|
||||
|
||||
** REPL Verification Gate (bouncer-check-repl-verified)
|
||||
#+begin_src lisp
|
||||
(defun bouncer-org-contains-defuns-p (content)
|
||||
"Returns T if the Org content contains any #+begin_src lisp blocks with defuns."
|
||||
(when (and content (stringp content))
|
||||
(search "defun " content :test #'char-equal)))
|
||||
|
||||
(defun bouncer-check-repl-verified (action filepath content)
|
||||
"Warns if writing a defun to an Org file without :repl-verified metadata."
|
||||
(let ((repl-verified (getf action :repl-verified)))
|
||||
(when (and filepath
|
||||
(uiop:string-suffix-p filepath ".org")
|
||||
(bouncer-org-contains-defuns-p content)
|
||||
(not repl-verified))
|
||||
(list :type :LOG
|
||||
:payload (list :level :warn
|
||||
:text (format nil "Lint: Writing defun to ~a without :repl-verified flag. Did you prototype this in the REPL first?" filepath))))))
|
||||
#+end_src
|
||||
|
||||
** Shell Safety Check (bouncer-check-shell-safety)
|
||||
#+begin_src lisp
|
||||
(defun bouncer-check-shell-safety (cmd)
|
||||
"Checks a shell command for destructive patterns and injection vectors.
|
||||
Returns a list of matched pattern names or nil if safe."
|
||||
(when (and cmd (stringp cmd) (> (length cmd) 0))
|
||||
(let ((matches nil))
|
||||
(dolist (entry *bouncer-shell-blocked-patterns*)
|
||||
(let ((name (first entry))
|
||||
(regex (second entry)))
|
||||
(when (cl-ppcre:scan regex cmd)
|
||||
(push name matches))))
|
||||
matches)))
|
||||
#+end_src
|
||||
|
||||
** Network Check (bouncer-check-network-exfil)
|
||||
#+begin_src lisp
|
||||
(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*)))))))
|
||||
#+end_src
|
||||
|
||||
** Main Security Gate (bouncer-check)
|
||||
#+begin_src lisp
|
||||
(defun bouncer-check (action context)
|
||||
"Security gate for high-risk actions.
|
||||
Vectors: lisp validation, secret path, secret content, vault secrets,
|
||||
privacy tags, privacy text, shell safety, network exfil, high-impact approval."
|
||||
(declare (ignore context))
|
||||
(let* ((target (proto-get action :target))
|
||||
(payload (proto-get action :payload))
|
||||
(text (or (proto-get payload :text) (proto-get action :text)))
|
||||
(filepath (or (proto-get payload :filepath)
|
||||
(when (equal (proto-get payload :tool) "read-file")
|
||||
(proto-get (proto-get payload :args) :filepath))
|
||||
(when (equal (proto-get payload :tool) "write-file")
|
||||
(proto-get (proto-get payload :args) :filepath))))
|
||||
(content (when filepath (proto-get (proto-get payload :args) :content)))
|
||||
(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))
|
||||
(tags (proto-get payload :tags))
|
||||
(lisp-valid (when (and filepath content (not approved))
|
||||
(bouncer-check-lisp-valid filepath content)))
|
||||
(repl-lint (when (and filepath content (not approved))
|
||||
(bouncer-check-repl-verified action filepath content))))
|
||||
(cond
|
||||
(approved action)
|
||||
|
||||
;; Vector 0: REPL verification lint (warn, don't block)
|
||||
(repl-lint
|
||||
(harness-log "BOUNCER: ~a" (proto-get repl-lint :text))
|
||||
action)
|
||||
|
||||
;; Vector 1: Lisp syntax validation (block bad lisp writes)
|
||||
((and lisp-valid (eq (getf lisp-valid :status) :error))
|
||||
(harness-log "LINT VIOLATION: Blocked write — lisp syntax error in ~a: ~a" filepath (getf lisp-valid :reason))
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text (format nil "Lisp syntax error in ~a: ~a. The write was blocked. Fix the parenthesis balance and retry." filepath (getf lisp-valid :reason)))))
|
||||
|
||||
;; Vector 2: File read to a protected secret path
|
||||
((and filepath (bouncer-check-secret-path filepath))
|
||||
(let ((matched (bouncer-check-secret-path filepath)))
|
||||
(harness-log "SECURITY VIOLATION: Blocked read of protected path '~a' (matched: ~a)" filepath matched)
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text (format nil "Action blocked: Attempted read of protected path '~a'" filepath)))))
|
||||
|
||||
;; Vector 3: Content contains secret patterns
|
||||
((and text (bouncer-scan-exposure text))
|
||||
(let ((matched (bouncer-scan-exposure text)))
|
||||
(harness-log "SECURITY VIOLATION: Content contains secret patterns: ~a" matched)
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text "Action blocked: Content contains potential secret exposure."))))
|
||||
|
||||
;; Vector 4: Content contains vault secrets
|
||||
((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)))))
|
||||
|
||||
;; Vector 5: Privacy-tagged content in action
|
||||
((and tags (bouncer-check-privacy-tags tags))
|
||||
(harness-log "PRIVACY VIOLATION: Action contains privacy-tagged content")
|
||||
(list :type :LOG
|
||||
:payload (list :level :warn
|
||||
:text "Action blocked: Content tagged with privacy filter.")))
|
||||
|
||||
;; Vector 6: Text leaks privacy tag names
|
||||
((and text (bouncer-check-text-for-privacy text))
|
||||
(harness-log "PRIVACY WARNING: Text may contain leaked private content")
|
||||
(list :type :LOG
|
||||
:payload (list :level :warn
|
||||
:text "Action blocked: Text may reference private content.")))
|
||||
|
||||
;; Vector 7: Shell destructive/injection patterns
|
||||
((and cmd (bouncer-check-shell-safety cmd))
|
||||
(let ((matched (bouncer-check-shell-safety cmd)))
|
||||
(harness-log "SHELL VIOLATION: Destructive or injection pattern in command: ~a" matched)
|
||||
(list :type :LOG
|
||||
:payload (list :level :error
|
||||
:text (format nil "Shell command blocked: contains unsafe pattern ~a" matched)))))
|
||||
|
||||
;; Vector 8: Network exfiltration
|
||||
((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)))
|
||||
|
||||
;; Vector 8: High-impact action approval
|
||||
((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))))
|
||||
|
||||
#+end_src
|
||||
|
||||
** Approval Processing (bouncer-process-approvals)
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
** Flight Plan Creation (bouncer-create-flight-plan)
|
||||
#+begin_src lisp
|
||||
(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))))))
|
||||
#+end_src
|
||||
|
||||
** Gate Logic (bouncer-deterministic-gate)
|
||||
#+begin_src lisp
|
||||
(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)))))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-bouncer
|
||||
:priority 150
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||
:deterministic #'bouncer-deterministic-gate)
|
||||
#+end_src
|
||||
@@ -1,26 +0,0 @@
|
||||
#+TITLE: SKILL: CLI Gateway (org-skill-cli-gateway.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:gateway:cli:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-cli-gateway.lisp
|
||||
|
||||
* Overview
|
||||
The *CLI Gateway* provides a command-line interface for interacting with the OpenCortex daemon.
|
||||
|
||||
* Implementation
|
||||
|
||||
** CLI Command Handling
|
||||
#+begin_src lisp
|
||||
(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))))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-cli-gateway
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
|
||||
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))
|
||||
#+end_src
|
||||
@@ -1,292 +0,0 @@
|
||||
#+TITLE: SKILL: Config Manager (org-skill-config-manager.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:setup:config:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-config-manager.lisp
|
||||
|
||||
* Overview
|
||||
The *Config Manager* skill provides the OpenCortex Agent with the capability to manage its own environment variables and provider configurations. It includes an interactive setup wizard for LLM providers, gateways, and system settings.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Configuration directory (get-oc-config-dir)
|
||||
Resolves the XDG config directory for OpenCortex.
|
||||
#+begin_src lisp
|
||||
(defun get-oc-config-dir ()
|
||||
"Returns the absolute path to the opencortex config directory."
|
||||
(let ((xdg (uiop:getenv "OC_CONFIG_DIR")))
|
||||
(if xdg xdg (namestring (merge-pathnames ".config/opencortex/" (user-homedir-pathname))))))
|
||||
#+end_src
|
||||
|
||||
** Config file path (get-config-file)
|
||||
Returns the path to the ~.env~ file within the config directory.
|
||||
#+begin_src lisp
|
||||
(defun get-config-file ()
|
||||
"Returns the path to the .env configuration file."
|
||||
(merge-pathnames ".env" (get-oc-config-dir)))
|
||||
#+end_src
|
||||
|
||||
** Ensure config directory (ensure-config-dir)
|
||||
Creates the config directory tree if it does not exist.
|
||||
#+begin_src lisp
|
||||
(defun ensure-config-dir ()
|
||||
"Creates the configuration directory if it does not exist."
|
||||
(ensure-directories-exist (get-oc-config-dir)))
|
||||
#+end_src
|
||||
|
||||
** Config File Operations
|
||||
#+begin_src lisp
|
||||
(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))))
|
||||
#+end_src
|
||||
|
||||
** Input Utilities
|
||||
#+begin_src lisp
|
||||
(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)))))
|
||||
#+end_src
|
||||
|
||||
** LLM Provider Setup
|
||||
#+begin_src lisp
|
||||
(defparameter *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=))))
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
** Gateway Setup
|
||||
#+begin_src lisp
|
||||
(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 "~%"))
|
||||
#+end_src
|
||||
|
||||
** Skill Management
|
||||
#+begin_src lisp
|
||||
(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 "OC_DATA_DIR") "~/.local/share/opencortex"))
|
||||
(format t "~%"))
|
||||
#+end_src
|
||||
|
||||
** Memory Settings
|
||||
#+begin_src lisp
|
||||
(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 "~%"))
|
||||
#+end_src
|
||||
|
||||
** Network Settings
|
||||
#+begin_src lisp
|
||||
(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 "~%"))
|
||||
#+end_src
|
||||
|
||||
** Main Setup Wizard
|
||||
#+begin_src lisp
|
||||
(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 "~%"))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-config-manager
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
@@ -1,44 +0,0 @@
|
||||
#+TITLE: SKILL: Credentials Vault (org-skill-credentials-vault.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:security:vault:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-credentials-vault.lisp
|
||||
|
||||
* Overview
|
||||
The *Credentials Vault* provides secure in-memory storage for sensitive API keys and session tokens.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Vault Storage
|
||||
#+begin_src lisp
|
||||
(defvar *vault-memory* (make-hash-table :test 'equal)
|
||||
"In-memory cache of sensitive credentials.")
|
||||
#+end_src
|
||||
|
||||
** Secret Management
|
||||
#+begin_src lisp
|
||||
(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)))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-credentials-vault
|
||||
:priority 600
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
@@ -1,247 +0,0 @@
|
||||
#+TITLE: SKILL: Diagnostics (org-skill-diagnostics.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:diagnostics:doctor:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-diagnostics.lisp
|
||||
|
||||
* Overview
|
||||
The *Diagnostics Skill* (Doctor) provides system-wide health checks and dependency verification. It validates external dependencies, XDG environment, and LLM provider connectivity.
|
||||
|
||||
* Phase A: Demand (Thinking)
|
||||
** Why a Doctor?
|
||||
The Doctor transforms opaque startup failures into actionable engineering reports. It ensures the Brain never attempts to boot in a compromised state.
|
||||
|
||||
** Detection Invariant
|
||||
Binary detection must use shell probing (`which`) to account for varying `$PATH` inheritance between interactive and headless sessions.
|
||||
|
||||
* Phase B: Protocol (Success Criteria)
|
||||
- Dependency check passes when all required binaries are found
|
||||
- Environment check passes when XDG directories exist and are accessible
|
||||
- LLM check passes when at least one provider is configured or Ollama is running locally
|
||||
|
||||
* Phase C: Implementation (Build)
|
||||
|
||||
** Global Configuration
|
||||
#+begin_src lisp
|
||||
(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.")
|
||||
#+end_src
|
||||
|
||||
** Dependency Verification
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
** Auto-Install Dependencies
|
||||
#+begin_src lisp
|
||||
(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)))))
|
||||
#+end_src
|
||||
|
||||
** XDG Environment Validation
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
** LLM Connectivity
|
||||
The doctor checks all supported LLM providers and detects local Ollama instances.
|
||||
|
||||
#+begin_src lisp
|
||||
(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))))
|
||||
#+end_src
|
||||
|
||||
** Orchestration
|
||||
#+begin_src lisp
|
||||
(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
|
||||
#+end_src
|
||||
|
||||
** CLI Entry Point
|
||||
#+begin_src lisp
|
||||
(defun doctor-main ()
|
||||
"Entry point for the 'doctor' CLI command."
|
||||
(if (doctor-run-all)
|
||||
(uiop:quit 0)
|
||||
(uiop:quit 1)))
|
||||
#+end_src
|
||||
|
||||
* Phase D: Verification (Testing)
|
||||
|
||||
** Dependency Test
|
||||
#+begin_src lisp :tangle no
|
||||
(test test-doctor-dependency-check
|
||||
"Verify that missing binaries are correctly identified as failures."
|
||||
(let ((opencortex::*doctor-required-binaries* '("non-existent-binary-123")))
|
||||
(is (null (opencortex:doctor-check-dependencies)))))
|
||||
#+end_src
|
||||
|
||||
** Environment Test
|
||||
#+begin_src lisp :tangle no
|
||||
(test test-doctor-env-check
|
||||
"Verify that an invalid MEMEX_DIR triggers a critical failure."
|
||||
(let ((old-m (uiop:getenv "MEMEX_DIR")))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setf (uiop:getenv "MEMEX_DIR") "/non/existent/path/999")
|
||||
(is (null (opencortex:doctor-check-env))))
|
||||
(setf (uiop:getenv "MEMEX_DIR") (or old-m "")))))
|
||||
#+end_src
|
||||
|
||||
* Phase E: Lifecycle
|
||||
The doctor skill should be loaded early (priority 100) to validate system health before other skills initialize.
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-diagnostics
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
|
||||
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
|
||||
#+end_src
|
||||
@@ -1,90 +0,0 @@
|
||||
#+TITLE: SKILL: Engineering Standards (org-skill-engineering-standards.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:engineering:chaos:
|
||||
#+DEPENDS_ON: org-skill-utils-lisp
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-engineering-standards.lisp
|
||||
|
||||
* Overview
|
||||
The *Engineering Standards Skill* defines the REPL-first engineering lifecycle and enforces technical invariants, including the **Commit-Before-Modify** rule and **Chaos-Driven Development**.
|
||||
|
||||
** Engineering Lifecycle (Two-Track)
|
||||
|
||||
The canonical workflow. Two tracks, not to be confused:
|
||||
|
||||
*** Track 1 — Org-First: Prose, Tests, Thinking (Phases 0/A)
|
||||
|
||||
This track stays in Org. No code is written yet.
|
||||
|
||||
**** Phase 0: Exploration & Documentation
|
||||
1. Read the relevant Org source files for context
|
||||
2. Explore the problem in the running REPL with ~repl-inspect~ and ~repl-eval~
|
||||
3. Document findings in Org prose
|
||||
4. If a bug: document investigation in Org before fixing (Org as thinking medium)
|
||||
|
||||
**** Phase A: Test-First Design
|
||||
1. Write the success criteria in Org prose — what the function does, arguments, return value, rationale
|
||||
2. Write the FiveAM test in a ~#+begin_src lisp :tangle no~ block
|
||||
3. Tangle the test and evaluate in the REPL — confirm it fails (red)
|
||||
4. The failing test is the success criteria. Do not proceed to Track 2 until it exists and is red.
|
||||
|
||||
*** Track 2 — REPL-First: Implementation, Iteration, Reflection (Phases B/C/D/E)
|
||||
|
||||
Code is prototyped in the REPL, never written directly into Org first.
|
||||
|
||||
**** Phase B/C: REPL Implementation
|
||||
1. Write the function directly in the REPL using ~repl-eval~
|
||||
2. Iterate: evaluate, inspect, fix, re-evaluate — the image accumulates state
|
||||
3. Run the test in the REPL — confirm green
|
||||
4. Explore edge cases with ~repl-inspect~ and ad-hoc evaluations
|
||||
5. Before writing any ~defun~ in an Org block, verify it was prototyped and tested in the REPL first
|
||||
|
||||
**** Phase D: Chaos Verification
|
||||
Run the appropriate chaos tier before reflecting code back to Org:
|
||||
- *Tier 1 (Deterministic)*: Full FiveAM test suite — required on every change
|
||||
- *Tier 2 (Probabilistic)*: Randomized fuzzing — required on every major release
|
||||
- *Tier 3 (Stress)*: Load and resource starvation — required during hardening sprints
|
||||
|
||||
**** Phase E: Reflect Back to Org
|
||||
1. Copy the working function into its own ~#+begin_src lisp~ block in the Org file
|
||||
2. Update the prose to match what the function actually does (arguments, return, rationale)
|
||||
3. Before closing Phase E, run ~(utils-lisp-validate (uiop:read-file-string "path/to/file.lisp") :strict t)~ in the REPL — never external scripts or manual paren-counting
|
||||
4. Verify the Org file tangles correctly
|
||||
5. Tangle, commit, update GTD
|
||||
|
||||
**** Syntax Error Protocol
|
||||
If a LOADER ERROR or reader-error occurs:
|
||||
1. Run ~(utils-lisp-validate (uiop:read-file-string "file.lisp") :strict t)~ in the REPL — never Python, never grep, never manual counting
|
||||
2. Fix the error in the Org file (since the code was prototyped in REPL first, this should be rare)
|
||||
3. Retangle and re-evaluate
|
||||
|
||||
Rationale: The two tracks prevent the two failure modes we have observed. Writing implementation code directly in Org (without REPL prototyping) produces syntax errors that require external tools to debug. Skipping Org-first test writing produces code without verified success criteria. The split is not bureaucratic — it is the mechanism by which both failures are prevented.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Standards Enforcement
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-engineering-standards
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
@@ -1,32 +0,0 @@
|
||||
#+TITLE: SKILL: Gardener (org-skill-gardener.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:maintenance:gardener:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-gardener.lisp
|
||||
|
||||
* Overview
|
||||
The *Gardener Skill* performs periodic maintenance on the Memex knowledge graph.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Maintenance Logic
|
||||
#+begin_src lisp
|
||||
(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..."))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
#+end_src
|
||||
@@ -1,290 +0,0 @@
|
||||
#+TITLE: SKILL: Gateway Manager (org-skill-gateway-manager.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:gateway:manager:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-gateway-manager.lisp
|
||||
|
||||
* Overview
|
||||
The *Gateway Manager* is a unified skill that handles all external communication platforms (Telegram, Signal, etc.). It provides a single consolidated handler for polling, injection, and actuation across any number of gateways.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Platform state — configs
|
||||
Storage for active gateway connections: tokens, polling threads, and intervals.
|
||||
#+begin_src lisp
|
||||
(defvar *gateway-configs* (make-hash-table :test 'equal)
|
||||
"Maps platform name → plist (:token :thread :interval :enabled)")
|
||||
#+end_src
|
||||
|
||||
** Platform state — registry
|
||||
Registration of available gateway implementations: each platform registers its poll and send functions here.
|
||||
#+begin_src lisp
|
||||
(defvar *gateway-registry* (make-hash-table :test 'equal)
|
||||
"Maps platform name → plist (:poll-fn :send-fn :default-interval)")
|
||||
#+end_src
|
||||
|
||||
** Telegram Implementation
|
||||
#+begin_src lisp
|
||||
(defun telegram-get-token ()
|
||||
(vault-get-secret :telegram))
|
||||
|
||||
(defun telegram-poll ()
|
||||
"Polls Telegram for new messages and injects them into the harness."
|
||||
(let* ((token (telegram-get-token)))
|
||||
(when token
|
||||
(let* ((last-id (getf (gethash "telegram" *gateway-configs*) :last-update-id 0))
|
||||
(url (format nil "https://api.telegram.org/bot~a/getUpdates?offset=~a"
|
||||
token (1+ last-id))))
|
||||
(handler-case
|
||||
(let* ((response (dex:get url))
|
||||
(json (cl-json:decode-json-from-string response))
|
||||
(updates (cdr (assoc :result json))))
|
||||
(dolist (update updates)
|
||||
(let* ((update-id (cdr (assoc :update--id update)))
|
||||
(message (cdr (assoc :message update)))
|
||||
(chat (cdr (assoc :chat message)))
|
||||
(chat-id (cdr (assoc :id chat)))
|
||||
(text (cdr (assoc :text message))))
|
||||
(setf (getf (gethash "telegram" *gateway-configs*) :last-update-id) update-id)
|
||||
(when (and text chat-id)
|
||||
(harness-log "TELEGRAM: Received message from ~a" chat-id)
|
||||
(inject-stimulus
|
||||
(list :type :EVENT
|
||||
:meta (list :source :telegram :chat-id (format nil "~a" chat-id))
|
||||
:payload (list :sensor :user-input :text text)))))))
|
||||
(error (c) (harness-log "TELEGRAM POLL ERROR: ~a" c))))))
|
||||
|
||||
(defun telegram-send (action context)
|
||||
"Sends a message via Telegram."
|
||||
(declare (ignore context))
|
||||
(let* ((payload (getf action :payload))
|
||||
(meta (getf action :meta))
|
||||
(chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
|
||||
(text (or (getf payload :text) (getf action :text)))
|
||||
(token (telegram-get-token)))
|
||||
(when (and token chat-id text)
|
||||
(harness-log "TELEGRAM: Sending message to ~a..." chat-id)
|
||||
(handler-case
|
||||
(let ((url (format nil "https://api.telegram.org/bot~a/sendMessage" token)))
|
||||
(dex:post url
|
||||
:headers '(("Content-Type" . "application/json"))
|
||||
:content (cl-json:encode-json-to-string
|
||||
`((chat_id . ,chat-id) (text . ,text)))))
|
||||
(error (c) (harness-log "TELEGRAM ERROR: ~a" c))))))
|
||||
#+end_src
|
||||
|
||||
** Signal Implementation
|
||||
#+begin_src lisp
|
||||
(defun signal-get-account ()
|
||||
(vault-get-secret :signal))
|
||||
|
||||
(defun signal-poll ()
|
||||
"Polls Signal for new messages and injects them into the harness."
|
||||
(let ((account (signal-get-account)))
|
||||
(when account
|
||||
(handler-case
|
||||
(let* ((output (uiop:run-program (list "signal-cli" "-u" account "receive" "--json")
|
||||
:output :string :error-output :string :ignore-error-status t))
|
||||
(lines (cl-ppcre:split "\\n" output)))
|
||||
(dolist (line lines)
|
||||
(when (and line (> (length line) 0))
|
||||
(let* ((json (ignore-errors (cl-json:decode-json-from-string line)))
|
||||
(envelope (cdr (assoc :envelope json)))
|
||||
(source (cdr (assoc :source envelope)))
|
||||
(data-message (cdr (assoc :data-message envelope)))
|
||||
(text (cdr (assoc :message data-message))))
|
||||
(when (and source text)
|
||||
(harness-log "SIGNAL: Received message from ~a" source)
|
||||
(inject-stimulus
|
||||
(list :type :EVENT
|
||||
:meta (list :source :signal :chat-id source)
|
||||
:payload (list :sensor :user-input :text text))))))))
|
||||
(error (c) (harness-log "SIGNAL POLL ERROR: ~a" c))))))
|
||||
|
||||
(defun signal-send (action context)
|
||||
"Sends a message via Signal."
|
||||
(declare (ignore context))
|
||||
(let* ((payload (getf action :payload))
|
||||
(meta (getf action :meta))
|
||||
(chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
|
||||
(text (or (getf payload :text) (getf action :text)))
|
||||
(account (signal-get-account)))
|
||||
(when (and account chat-id text)
|
||||
(harness-log "SIGNAL: Sending message to ~a..." chat-id)
|
||||
(handler-case
|
||||
(uiop:run-program (list "signal-cli" "-u" account "send" "-m" text chat-id)
|
||||
:output :string :error-output :string)
|
||||
(error (c) (harness-log "SIGNAL ERROR: ~a" c))))))
|
||||
#+end_src
|
||||
|
||||
** Gateway Registry Initialization
|
||||
#+begin_src lisp
|
||||
(defun initialize-gateway-registry ()
|
||||
"Registers all built-in gateway handlers."
|
||||
(setf (gethash "telegram" *gateway-registry*)
|
||||
(list :poll-fn #'telegram-poll
|
||||
:send-fn #'telegram-send
|
||||
:default-interval 3))
|
||||
(setf (gethash "signal" *gateway-registry*)
|
||||
(list :poll-fn #'signal-poll
|
||||
:send-fn #'signal-send
|
||||
:default-interval 5)))
|
||||
#+end_src
|
||||
|
||||
** Core gateway functions
|
||||
|
||||
*** Configuration check (gateway-configured-p)
|
||||
Returns T if a platform has a stored token in ~*gateway-configs*~.
|
||||
#+begin_src lisp
|
||||
(defun gateway-configured-p (platform)
|
||||
"Returns T if a platform has a stored token."
|
||||
(let ((config (gethash platform *gateway-configs*)))
|
||||
(and config (getf config :token))))
|
||||
#+end_src
|
||||
|
||||
*** Active check (gateway-active-p)
|
||||
Returns T if a platform's polling thread is alive.
|
||||
#+begin_src lisp
|
||||
(defun gateway-active-p (platform)
|
||||
"Returns T if a platform's polling thread is alive."
|
||||
(let ((config (gethash platform *gateway-configs*)))
|
||||
(and config
|
||||
(getf config :thread)
|
||||
(bt:thread-alive-p (getf config :thread)))))
|
||||
#+end_src
|
||||
|
||||
*** Link a gateway (gateway-link)
|
||||
The main entry point for linking. Validates the registry entry, stores the token in the vault, starts the polling thread, and updates the config.
|
||||
#+begin_src lisp
|
||||
(defun gateway-link (platform token)
|
||||
"Links a platform with a token and starts polling."
|
||||
(let ((platform-lc (string-downcase platform)))
|
||||
(unless (gethash platform-lc *gateway-registry*)
|
||||
(error "Unknown platform: ~a. Available: ~{~a~^, ~}"
|
||||
platform (loop for k being the hash-keys of *gateway-registry* collect k)))
|
||||
(when (or (null token) (zerop (length token)))
|
||||
(error "Token cannot be empty"))
|
||||
(harness-log "GATEWAY: Linking to ~a..." platform-lc)
|
||||
(gateway-unlink platform-lc)
|
||||
(let* ((registry-entry (gethash platform-lc *gateway-registry*))
|
||||
(interval (or (getf registry-entry :default-interval) 5)))
|
||||
(setf (gethash platform-lc *gateway-configs*)
|
||||
(list :token token :interval interval :enabled t))
|
||||
(vault-set-secret (intern (string-upcase platform-lc) :keyword) token)
|
||||
(gateway-start platform-lc)
|
||||
(harness-log "GATEWAY: Successfully linked ~a" platform-lc)
|
||||
(format t "Successfully linked ~a gateway. Token stored securely.~%" platform-lc)
|
||||
t)))
|
||||
#+end_src
|
||||
|
||||
*** Unlink a gateway (gateway-unlink)
|
||||
Stops the polling thread and removes the config entry.
|
||||
#+begin_src lisp
|
||||
(defun gateway-unlink (platform)
|
||||
"Unlinks a platform and stops its polling thread."
|
||||
(let ((platform-lc (string-downcase platform)))
|
||||
(gateway-stop platform-lc)
|
||||
(remhash platform-lc *gateway-configs*)
|
||||
(harness-log "GATEWAY: Unlinked ~a" platform-lc)
|
||||
(format t "Successfully unlinked ~a gateway.~%" platform-lc)
|
||||
t))
|
||||
#+end_src
|
||||
|
||||
*** Start polling (gateway-start)
|
||||
Creates a background thread that calls the platform's poll function on an interval. The thread checks the ~:enabled~ flag on each cycle so it can be stopped cleanly via ~gateway-stop~.
|
||||
#+begin_src lisp
|
||||
(defun gateway-start (platform)
|
||||
"Starts the polling thread for a linked gateway."
|
||||
(let ((platform-lc (string-downcase platform)))
|
||||
(let ((config (gethash platform-lc *gateway-configs*)))
|
||||
(when (and config (getf config :enabled) (not (gateway-active-p platform-lc)))
|
||||
(let ((poll-fn (getf (gethash platform-lc *gateway-registry*) :poll-fn)))
|
||||
(when poll-fn
|
||||
(let ((interval (getf config :interval)))
|
||||
(setf (getf config :thread)
|
||||
(bt:make-thread
|
||||
(lambda ()
|
||||
(loop
|
||||
(when (getf (gethash platform-lc *gateway-configs*) :enabled)
|
||||
(funcall poll-fn))
|
||||
(sleep interval)))
|
||||
:name (format nil "opencortex-~a-gateway" platform-lc)))
|
||||
(harness-log "GATEWAY: Started ~a polling (interval: ~as)" platform-lc interval)))))))))
|
||||
#+end_src
|
||||
|
||||
*** Stop polling (gateway-stop)
|
||||
Destroys the polling thread and nulls the thread reference.
|
||||
#+begin_src lisp
|
||||
(defun gateway-stop (platform)
|
||||
"Stops the polling thread for a gateway."
|
||||
(let ((platform-lc (string-downcase platform)))
|
||||
(let ((config (gethash platform-lc *gateway-configs*)))
|
||||
(when (and config (getf config :thread))
|
||||
(when (bt:thread-alive-p (getf config :thread))
|
||||
(harness-log "GATEWAY: Stopping ~a polling thread" platform-lc)
|
||||
(bt:destroy-thread (getf config :thread))))
|
||||
(setf (getf config :thread) nil))))
|
||||
#+end_src
|
||||
|
||||
*** List gateways (gateway-list)
|
||||
Returns a list of plists, one per registered platform, with :platform, :configured, and :active keys.
|
||||
#+begin_src lisp
|
||||
(defun gateway-list ()
|
||||
"Returns a list of all gateways with their status."
|
||||
(loop for platform being the hash-keys of *gateway-registry*
|
||||
collect (let ((configured (gateway-configured-p platform))
|
||||
(active (gateway-active-p platform)))
|
||||
(list :platform platform
|
||||
:configured configured
|
||||
:active active))))
|
||||
#+end_src
|
||||
|
||||
*** Print gateways (gateway-list-print)
|
||||
Formats ~gateway-list~ for display in the CLI.
|
||||
#+begin_src lisp
|
||||
(defun gateway-list-print ()
|
||||
"Prints a formatted table of gateways."
|
||||
(format t "~%")
|
||||
(format t " ~20@A ~12@A ~10@A~%" "PLATFORM" "CONFIGURED" "STATUS")
|
||||
(dolist (gw (gateway-list))
|
||||
(format t " ~20@A ~12@A ~10@A~%"
|
||||
(getf gw :platform)
|
||||
(if (getf gw :configured) "yes" "no")
|
||||
(cond
|
||||
((getf gw :active) "ACTIVE")
|
||||
((getf gw :configured) "stopped")
|
||||
(t "not linked"))))
|
||||
(format t "~%"))
|
||||
#+end_src
|
||||
|
||||
*** Start all configured gateways (start-all-gateways)
|
||||
Called during boot to start all gateways that have tokens stored in their configs.
|
||||
#+begin_src lisp
|
||||
(defun start-all-gateways ()
|
||||
"Called at boot to start all configured gateways."
|
||||
(dolist (config (loop for platform being the hash-keys of *gateway-configs*
|
||||
collect (list platform (gethash platform *gateway-configs*))))
|
||||
(destructuring-bind (platform config) config
|
||||
(when (and (getf config :enabled) (not (gateway-active-p platform)))
|
||||
(gateway-start platform)))))
|
||||
#+end_src
|
||||
|
||||
** Actuator Registration
|
||||
Register :telegram and :signal as actuators for outbound messages.
|
||||
#+begin_src lisp
|
||||
(register-actuator :telegram #'telegram-send)
|
||||
(register-actuator :signal #'signal-send)
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-gateway-manager
|
||||
:priority 150
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
|
||||
** Initialization
|
||||
Initialize registry and start configured gateways on skill load.
|
||||
#+begin_src lisp
|
||||
(initialize-gateway-registry)
|
||||
(start-all-gateways)
|
||||
#+end_src
|
||||
@@ -1,23 +0,0 @@
|
||||
#+TITLE: SKILL: Homoiconic Memory (org-skill-homoiconic-memory.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :harness:memory:homoiconic:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-homoiconic-memory.lisp
|
||||
|
||||
* Overview
|
||||
Because Lisp is homoiconic (code is data), memory objects can be read as executable forms. This skill provides the bridge between the org-object store and live Lisp evaluation — it can serialize an org-object into an s-expression, evaluate it to reconstruct state, and store the result back as a new object. This is the foundation of the agent's ability to save, restore, and inspect its own cognitive state at runtime.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Memory Logic
|
||||
#+begin_src lisp
|
||||
(defun memory-self-inspect ()
|
||||
"Allows the system to inspect its own memory state."
|
||||
(harness-log "MEMORY: Self-inspection triggered."))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-homoiconic-memory
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
@@ -1,55 +0,0 @@
|
||||
#+TITLE: SKILL: Literate Programming (org-skill-literate-programming.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:literate:tangle:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-literate-programming.lisp
|
||||
|
||||
* Overview
|
||||
This skill enforces the literal programming discipline for all OpenCortex source code. It defines the rules for one-function-per-block, prose-before-code, reflecting working code back from the REPL to Org, and the tangle mandate (never edit .lisp directly). Every Org file that contains Lisp code should follow the rules defined here.
|
||||
|
||||
** Discipline Rules
|
||||
|
||||
*** One Function, One Block
|
||||
Every ~#+begin_src lisp~ block contains exactly one function definition. Never bundle multiple definitions in a single block. This keeps the Org file granular, reviewable, and tanglable without side effects.
|
||||
|
||||
*** Prose Before Code
|
||||
Every block must be preceded by an Org headline and explanatory prose that covers:
|
||||
- What the function does
|
||||
- Its arguments (including any &key, &optional)
|
||||
- Its return value
|
||||
- The rationale for its existence
|
||||
|
||||
The prose is not a comment — it is the authoritative specification. The code implements what the prose describes.
|
||||
|
||||
*** Reflect Back, Don't Write Directly
|
||||
Code is explored and verified in the REPL first (per Engineering Standards lifecycle). Once working, it is *reflected back* into the Org file. This means:
|
||||
- The REPL is the proving ground — iterate there
|
||||
- The Org file is the record — copy working code there
|
||||
- Never write code directly into an Org block without first evaluating it in the REPL
|
||||
|
||||
*** Code and Prose Together
|
||||
Every ~#+begin_src lisp~ block flows from the prose above it. The reader (human or agent) should understand the function's contract from the prose before reading the code. If the code and prose disagree, the prose is wrong — update both.
|
||||
|
||||
*** Tangle Mandate
|
||||
The `.lisp` file is derived, not authored. Never edit `.lisp` directly. All changes flow through Org: edit Org → tangle → `.lisp` updates. Violating this corrupts the skill loader and causes boot failure.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Synchronization Logic
|
||||
#+begin_src lisp
|
||||
(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)
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-literate-programming
|
||||
:priority 300
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
@@ -1,62 +0,0 @@
|
||||
#+TITLE: SKILL: LLM Gateway (org-skill-llm-gateway.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:llm:gateway:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-llm-gateway.lisp
|
||||
|
||||
* Overview
|
||||
The LLM Gateway dispatches inference requests to the registered probabilistic backends. It receives a prompt and system prompt, looks up the provider's registered function from ~*probabilistic-backends*~, calls it with the given model, and returns the result. This is the thin routing layer that sits between the reason pipeline and the provider-specific implementations in the unified-llm-backend skill.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Request Execution (execute-llm-request)
|
||||
#+begin_src lisp
|
||||
(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)))))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-llm-gateway
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) (getf ctx :user-input))
|
||||
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))
|
||||
#+end_src
|
||||
|
||||
* Test Suite
|
||||
#+begin_src lisp :tangle ../tests/llm-gateway-tests.lisp
|
||||
(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")))))
|
||||
#+end_src
|
||||
@@ -1,26 +0,0 @@
|
||||
#+TITLE: SKILL: Peripheral Vision (org-skill-peripheral-vision.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :harness:peripheral:context:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-peripheral-vision.lisp
|
||||
|
||||
* Overview
|
||||
The *Peripheral Vision* skill enhances the context engine with high-level summaries of distant memory nodes.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Context Logic
|
||||
#+begin_src lisp
|
||||
(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]")))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-peripheral-vision
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
@@ -1,33 +0,0 @@
|
||||
#+TITLE: SKILL: Policy (org-skill-policy.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:policy:constitutional:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-policy.lisp
|
||||
|
||||
* Overview
|
||||
The *Policy Skill* is the constitutional layer of OpenCortex. It enforces foundational invariants like transparency and autonomy on all proposed actions.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Policy Logic (policy-check)
|
||||
#+begin_src lisp
|
||||
(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."))))))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-policy
|
||||
:priority 500
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||
:deterministic #'policy-check)
|
||||
#+end_src
|
||||
@@ -1,29 +0,0 @@
|
||||
#+TITLE: SKILL: Protocol Validator (org-skill-protocol-validator.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:protocol:validation:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-protocol-validator.lisp
|
||||
|
||||
* Overview
|
||||
The *Protocol Validator* skill enforces strict schema compliance for all internal and external communication.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Validation Logic
|
||||
#+begin_src lisp
|
||||
(defun protocol-validate (msg)
|
||||
"Enforces structural schema compliance on protocol messages."
|
||||
(validate-communication-protocol-schema msg))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(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)))))))
|
||||
#+end_src
|
||||
@@ -1,211 +0,0 @@
|
||||
#+TITLE: SKILL: REPL (org-skill-repl.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:repl:interactive:debug:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-repl.lisp
|
||||
|
||||
* Overview
|
||||
The *REPL Skill* provides persistent Lisp evaluation, inspection, and debugging capabilities. This enables the agent to verify behavior at runtime rather than just at the text level.
|
||||
|
||||
* Phase A: Demand (Thinking)
|
||||
** Why a REPL?
|
||||
The utils-lisp-eval function provides one-shot evaluation but:
|
||||
- No state persistence between calls
|
||||
- No variable inspection
|
||||
- No debugging capabilities
|
||||
|
||||
The REPL skill fills this gap by:
|
||||
- Maintaining evaluation state across turns
|
||||
- Supporting variable inspection
|
||||
- Providing debugging commands
|
||||
- Optionally connecting to external Swank servers
|
||||
|
||||
** Success Criteria
|
||||
- Code evaluation returns result + stdout/stderr separately
|
||||
- Variables can be inspected
|
||||
- Can load code into image
|
||||
- Optional: connect to external SLIME/Swank session
|
||||
|
||||
* Phase B: Protocol (Spec)
|
||||
- `repl-eval` returns: (values result output error)
|
||||
- `repl-inspect` returns: structured description
|
||||
- `repl-list-vars` returns: list of bound symbols
|
||||
- `repl-load-file` returns: t on success, error on failure
|
||||
|
||||
* Phase C: Implementation
|
||||
|
||||
** Global State
|
||||
#+begin_src lisp
|
||||
(in-package :opencortex)
|
||||
|
||||
(defvar *repl-package* :opencortex
|
||||
"Default package for REPL evaluations.")
|
||||
|
||||
(defvar *repl-history* nil
|
||||
"History of evaluated forms for session continuity.")
|
||||
|
||||
(defvar *repl-variables* (make-hash-table :test #'eq)
|
||||
"Cache of bound variables for inspection.")
|
||||
#+end_src
|
||||
|
||||
** Core Evaluation
|
||||
#+begin_src lisp
|
||||
(defun repl-eval (code-string &key (package *repl-package*))
|
||||
"Evaluate Lisp code and return (values result output error).
|
||||
- result: the return value as string
|
||||
- output: captured stdout
|
||||
- error: error message or nil on success"
|
||||
(let ((out (make-string-output-stream))
|
||||
(err (make-string-output-stream))
|
||||
(pkg (or (find-package package) (find-package :opencortex))))
|
||||
(handler-case
|
||||
(let* ((*standard-output* out)
|
||||
(*error-output* err)
|
||||
(*package* pkg)
|
||||
(*read-eval* nil)
|
||||
(result nil))
|
||||
(with-input-from-string (s code-string)
|
||||
(loop for form = (read s nil :eof) until (eq form :eof)
|
||||
do (setf result (eval form))))
|
||||
(push code-string *repl-history*)
|
||||
(values
|
||||
(format nil "~a" result)
|
||||
(get-output-stream-string out)
|
||||
nil))
|
||||
(error (c)
|
||||
(values
|
||||
nil
|
||||
(get-output-stream-string out)
|
||||
(format nil "~a" c))))))
|
||||
#+end_src
|
||||
|
||||
** Variable Inspection
|
||||
#+begin_src lisp
|
||||
(defun repl-inspect (symbol-name &key (package *repl-package*))
|
||||
"Inspect a variable's value and structure."
|
||||
(let* ((pkg (or (find-package package) (find-package :opencortex)))
|
||||
(sym (find-symbol (string-upcase symbol-name) pkg)))
|
||||
(cond
|
||||
((null sym)
|
||||
(format nil "Symbol ~a not found in package ~a" symbol-name package))
|
||||
((boundp sym)
|
||||
(let ((val (symbol-value sym)))
|
||||
(format nil "~a = ~a~%Type: ~a~%~%"
|
||||
sym val (type-of val))))
|
||||
((fboundp sym)
|
||||
(format nil "~a is a function~%Args: ~a~%"
|
||||
sym (documentation sym 'function)))
|
||||
(t
|
||||
(format nil "~a is unbound" symbol-name)))))
|
||||
#+end_src
|
||||
|
||||
** List Bound Variables
|
||||
#+begin_src lisp
|
||||
(defun repl-list-vars (&key (package *repl-package*))
|
||||
"List all bound variables in the package."
|
||||
(let* ((pkg (or (find-package package) (find-package :opencortex)))
|
||||
(vars nil))
|
||||
(do-symbols (sym pkg)
|
||||
(when (boundp sym)
|
||||
(push (format nil "~a" sym) vars)))
|
||||
(sort vars #'string<)))
|
||||
#+end_src
|
||||
|
||||
** Load File into Image
|
||||
#+begin_src lisp
|
||||
(defun repl-load-file (filepath)
|
||||
"Load a Lisp file into the current image."
|
||||
(handler-case
|
||||
(progn
|
||||
(load filepath)
|
||||
(format nil "Loaded ~a" filepath))
|
||||
(error (c)
|
||||
(format nil "Error loading ~a: ~a" filepath c))))
|
||||
#+end_src
|
||||
|
||||
** Package Switching
|
||||
#+begin_src lisp
|
||||
(defun repl-set-package (package-name)
|
||||
"Set the default package for REPL evaluations."
|
||||
(let ((pkg (find-package (string-upcase package-name))))
|
||||
(if pkg
|
||||
(setf *repl-package* pkg)
|
||||
(format nil "Package ~a not found" package-name))))
|
||||
#+end_src
|
||||
|
||||
** Help/Info
|
||||
#+begin_src lisp
|
||||
(defun repl-help ()
|
||||
"Return available REPL commands."
|
||||
(format nil "~%
|
||||
REPL Skill Commands:
|
||||
-------------------
|
||||
(repl-eval \"code\" :package :opencortex)
|
||||
- Evaluate Lisp code, returns (values result output error)
|
||||
|
||||
(repl-inspect \"symbol\" :package :opencortex)
|
||||
- Inspect a variable or function
|
||||
|
||||
(repl-list-vars :package :opencortex)
|
||||
- List all bound variables
|
||||
|
||||
(repl-load-file \"/path/to/file.lisp\")
|
||||
- Load a file into the image
|
||||
|
||||
(repl-set-package :package-name)
|
||||
- Switch default package
|
||||
|
||||
(repl-help)
|
||||
- Show this message
|
||||
"))
|
||||
#+end_src
|
||||
|
||||
* Phase D: Verification
|
||||
|
||||
** Basic Evaluation Test
|
||||
#+begin_src lisp :tangle no
|
||||
(test test-repl-eval-simple
|
||||
"Test basic arithmetic evaluation."
|
||||
(multiple-value-bind (result output error)
|
||||
(opencortex:repl-eval "(+ 1 2)")
|
||||
(is (string= result "3"))
|
||||
(is (null error))))
|
||||
#+end_src
|
||||
|
||||
** Error Handling Test
|
||||
#+begin_src lisp :tangle no
|
||||
(test test-repl-eval-error
|
||||
"Test that errors are caught and returned."
|
||||
(multiple-value-bind (result output error)
|
||||
(opencortex:repl-eval "(+ 1 \"string\")")
|
||||
(is (null result))
|
||||
(is (not (null error)))))
|
||||
#+end_src
|
||||
|
||||
* Phase E: Lifecycle
|
||||
The REPL skill loads at priority 200 (after diagnostics at 100, before utils-lisp at 400).
|
||||
|
||||
** System Prompt Augment (repl-mandate)
|
||||
#+begin_src lisp
|
||||
(defun repl-mandate (context)
|
||||
"Returns REPL-first engineering mandate when context involves code editing."
|
||||
(let ((raw (or (proto-get (proto-get context :payload) :text) "")))
|
||||
(when (or (search "org-skill-" raw :test #'char-equal)
|
||||
(and (search ".org" raw :test #'char-equal)
|
||||
(or (search "defun" raw :test #'char-equal)
|
||||
(search "tangle" raw :test #'char-equal)
|
||||
(search "write-file" raw :test #'char-equal)
|
||||
(search "lisp" raw :test #'char-equal)))
|
||||
(search "defun " raw :test #'char-equal)
|
||||
(search "repl-eval" raw :test #'char-equal)
|
||||
(search "validate" raw :test #'char-equal))
|
||||
(format nil "~%REPL-FIRST MANDATE:~%Before writing any defun to an Org file, prototype it in the REPL first. Set :repl-verified t on the write action. On rejection, fix the error and retry.~%"))))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-repl
|
||||
:priority 200
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil)
|
||||
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)
|
||||
:system-prompt-augment #'repl-mandate)
|
||||
#+end_src
|
||||
@@ -1,26 +0,0 @@
|
||||
#+TITLE: SKILL: Scribe (org-skill-scribe.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:scribe:documentation:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-scribe.lisp
|
||||
|
||||
* Overview
|
||||
The *Scribe Skill* manages the agent's internal documentation and logs.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Documentation Logic
|
||||
#+begin_src lisp
|
||||
(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)))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
#+end_src
|
||||
@@ -1,24 +0,0 @@
|
||||
#+TITLE: SKILL: Self Edit (org-skill-self-edit.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:autonomy:self-edit:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-self-edit.lisp
|
||||
|
||||
* Overview
|
||||
The *Self Edit* skill allows the OpenCortex Agent to modify its own literate source code.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Self-Edit Logic
|
||||
#+begin_src lisp
|
||||
(defun self-edit-apply (filepath old-text new-text)
|
||||
"Applies a transformation to a source file."
|
||||
(declare (ignore old-text new-text))
|
||||
(harness-log "SELF-EDIT: Applying changes to ~a" filepath))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-self-edit
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
@@ -1,25 +0,0 @@
|
||||
#+TITLE: SKILL: Self Fix (org-skill-self-fix.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:autonomy:self-fix:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-self-fix.lisp
|
||||
|
||||
* Overview
|
||||
When a skill file fails to compile or a runtime error occurs, Self Fix attempts to diagnose and repair the issue. It receives error logs from the skill loader, identifies the broken file, and generates a corrected version that is hot-reloaded into the running image.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Self-Fix Logic
|
||||
#+begin_src lisp
|
||||
(defun self-fix-broken-skill (skill-name error-log)
|
||||
"Attempts to diagnose and repair a broken skill."
|
||||
(declare (ignore error-log))
|
||||
(harness-log "SELF-FIX: Attempting repair of ~a..." skill-name))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-self-fix
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :EVENT)))
|
||||
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
|
||||
#+end_src
|
||||
@@ -1,43 +0,0 @@
|
||||
#+TITLE: SKILL: Shell Actuator (org-skill-shell-actuator.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:actuator:shell:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-shell-actuator.lisp
|
||||
|
||||
* Overview
|
||||
The *Shell Actuator* provides the agent with the capability to execute bash commands.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Shell Execution (shell-execute)
|
||||
#+begin_src lisp
|
||||
(defun shell-execute (action context)
|
||||
"Executes a bash command with timeout (via timeout(1)) and output limit."
|
||||
(declare (ignore context))
|
||||
(let* ((payload (getf action :payload))
|
||||
(cmd (getf payload :cmd))
|
||||
(timeout-sym (find-symbol "*BOUNCER-SHELL-TIMEOUT*" :opencortex))
|
||||
(timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30)))
|
||||
(max-sym (find-symbol "*BOUNCER-SHELL-MAX-OUTPUT*" :opencortex))
|
||||
(max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))
|
||||
(wrapped-cmd (format nil "timeout ~a bash -c ~s" timeout cmd)))
|
||||
(harness-log "ACT [Shell]: ~a (timeout: ~as)" cmd timeout)
|
||||
(multiple-value-bind (out err code)
|
||||
(uiop:run-program (list "bash" "-c" wrapped-cmd)
|
||||
:output :string :error-output :string
|
||||
:ignore-error-status t)
|
||||
(cond
|
||||
((= code 124) (format nil "ERROR: Command timed out after ~a seconds" timeout))
|
||||
((> (length out) max-output)
|
||||
(format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output))
|
||||
((= code 0) out)
|
||||
(t (format nil "ERROR [~a]: ~a" code err))))))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(register-actuator :shell #'shell-execute)
|
||||
|
||||
(defskill :skill-shell-actuator
|
||||
:priority 50
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
@@ -1,38 +0,0 @@
|
||||
#+TITLE: SKILL: Tool Permissions (org-skill-tool-permissions.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:security:permissions:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-tool-permissions.lisp
|
||||
|
||||
* Overview
|
||||
The *Tool Permissions* skill manages the authorization levels for different cognitive tools.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Permission store (tool level)
|
||||
Hash table mapping tool names to their permission level.
|
||||
#+begin_src lisp
|
||||
(defvar *tool-permissions* (make-hash-table :test 'equal))
|
||||
#+end_src
|
||||
|
||||
** Set permission
|
||||
Sets the permission level for a specific cognitive tool.
|
||||
#+begin_src lisp
|
||||
(defun set-tool-permission (tool-name level)
|
||||
"Sets the permission level for a tool."
|
||||
(setf (gethash (string-downcase (string tool-name)) *tool-permissions*) level))
|
||||
#+end_src
|
||||
|
||||
** Get permission
|
||||
Retrieves the current permission level for a tool. Defaults to ~:ask~ if unset.
|
||||
#+begin_src lisp
|
||||
(defun get-tool-permission (tool-name)
|
||||
"Retrieves the permission level for a tool. Defaults to :ask."
|
||||
(gethash (string-downcase (string tool-name)) *tool-permissions* :ask))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-tool-permissions
|
||||
:priority 600
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
@@ -1,115 +0,0 @@
|
||||
#+TITLE: SKILL: Unified LLM Backend (org-skill-unified-llm-backend.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:llm:backend:openai-compatible:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-unified-llm-backend.lisp
|
||||
|
||||
* Overview
|
||||
The *Unified LLM Backend* provides a single OpenAI-compatible API client that works with:
|
||||
- Local engines: Ollama, vLLM, LM Studio, llama.cpp (anything exposing /v1/chat/completions)
|
||||
- Cloud providers: OpenRouter, OpenAI, Anthropic, Groq, Gemini (all OpenAI-compatible)
|
||||
|
||||
Providers are registered automatically based on available environment variables.
|
||||
No separate skills per provider — just different base URLs and API keys.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Provider registry (~*unified-llm-providers*~)
|
||||
The authoritative list of supported LLM providers and their configuration: base URL, env var for API key, and default model name.
|
||||
#+begin_src lisp
|
||||
(defparameter *unified-llm-providers*
|
||||
'((:ollama . (:base-url nil :key-env nil :default-model "llama3"))
|
||||
(:openrouter . (:base-url "https://openrouter.ai/api/v1" :key-env "OPENROUTER_API_KEY" :default-model "openrouter/auto"))
|
||||
(:openai . (:base-url "https://api.openai.com/v1" :key-env "OPENAI_API_KEY" :default-model "gpt-4o-mini"))
|
||||
(:anthropic . (:base-url "https://api.anthropic.com/v1" :key-env "ANTHROPIC_API_KEY" :default-model "claude-3-5-sonnet-20241022"))
|
||||
(:groq . (:base-url "https://api.groq.com/openai/v1" :key-env "GROQ_API_KEY" :default-model "llama-3.1-70b-versatile"))
|
||||
(:gemini . (:base-url "https://generativelanguage.googleapis.com/v1beta/openai" :key-env "GEMINI_API_KEY" :default-model "gemini-2.0-flash"))))
|
||||
#+end_src
|
||||
|
||||
** Provider config lookup (get-provider-config)
|
||||
Returns the config plist for a given provider keyword.
|
||||
#+begin_src lisp
|
||||
(defun get-provider-config (provider)
|
||||
"Returns the configuration plist for a provider keyword."
|
||||
(cdr (assoc provider *unified-llm-providers*)))
|
||||
#+end_src
|
||||
|
||||
** Availability check (provider-available-p)
|
||||
Returns T if a provider is configured — meaning it either has an API key set, or it is Ollama (always available locally).
|
||||
#+begin_src lisp
|
||||
(defun provider-available-p (provider)
|
||||
"Checks if a provider is configured. Ollama is always considered available."
|
||||
(let* ((config (get-provider-config provider))
|
||||
(key-env (getf config :key-env))
|
||||
(base-url (getf config :base-url)))
|
||||
(cond ((eq provider :ollama) t)
|
||||
(key-env (let ((key (uiop:getenv key-env))) (and key (> (length key) 0))))
|
||||
(base-url t))))
|
||||
#+end_src
|
||||
|
||||
** Unified Request Execution
|
||||
#+begin_src lisp
|
||||
(defun execute-openai-compatible-request (prompt system-prompt &key model (provider :ollama))
|
||||
"Executes a request against any OpenAI-compatible API endpoint."
|
||||
(let* ((config (get-provider-config provider))
|
||||
(base-url (getf config :base-url))
|
||||
(key-env (getf config :key-env))
|
||||
(default-model (getf config :default-model))
|
||||
(api-key (when key-env (uiop:getenv key-env)))
|
||||
(model-id (or model default-model))
|
||||
(url (if (eq provider :ollama)
|
||||
(format nil "http://~a/v1/chat/completions" (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
|
||||
(format nil "~a/chat/completions" base-url)))
|
||||
(headers `(("Content-Type" . "application/json")
|
||||
,@(when api-key `(("Authorization" . ,(format nil "Bearer ~a" api-key))))
|
||||
,@(when (eq provider :openrouter)
|
||||
`(("HTTP-Referer" . "https://github.com/amrgharbeia/opencortex")
|
||||
("X-Title" . "OpenCortex")))))
|
||||
(body (cl-json:encode-json-to-string
|
||||
`((model . ,model-id)
|
||||
(messages . (( (role . "system") (content . ,system-prompt) )
|
||||
( (role . "user") (content . ,prompt) )))))))
|
||||
(handler-case
|
||||
(let* ((response (dex:post url :headers headers :content body :connect-timeout 10 :read-timeout 60))
|
||||
(json (cl-json:decode-json-from-string response))
|
||||
(choices (cdr (assoc :choices json)))
|
||||
(first-choice (car choices))
|
||||
(message (cdr (assoc :message first-choice)))
|
||||
(content (cdr (assoc :content message))))
|
||||
(if content
|
||||
(list :status :success :content content)
|
||||
(list :status :error :message (format nil "~a: No content in response (~s)" provider json))))
|
||||
(error (c)
|
||||
(list :status :error :message (format nil "~a Failure: ~a" provider c))))))
|
||||
#+end_src
|
||||
|
||||
** Dynamic Backend Registration
|
||||
#+begin_src lisp
|
||||
(defun register-available-llm-backends ()
|
||||
"Scans environment variables and registers all available LLM backends."
|
||||
(dolist (entry *unified-llm-providers*)
|
||||
(let ((provider (car entry)))
|
||||
(when (provider-available-p provider)
|
||||
(harness-log "LLM BACKEND: Registering provider ~a" provider)
|
||||
(register-probabilistic-backend provider
|
||||
(lambda (prompt system-prompt &key model)
|
||||
(execute-openai-compatible-request prompt system-prompt :model model :provider provider)))))))
|
||||
|
||||
(defun initialize-provider-cascade ()
|
||||
"Reads PROVIDER_CASCADE from env and sets *provider-cascade*."
|
||||
(let ((cascade-str (uiop:getenv "PROVIDER_CASCADE")))
|
||||
(if cascade-str
|
||||
(setf *provider-cascade*
|
||||
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
|
||||
(uiop:split-string cascade-str :separator '(#\,))))
|
||||
(setf *provider-cascade* (mapcar #'car *unified-llm-providers*)))))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(register-available-llm-backends)
|
||||
(initialize-provider-cascade)
|
||||
|
||||
(defskill :skill-unified-llm-backend
|
||||
:priority 50
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
@@ -1,273 +0,0 @@
|
||||
#+TITLE: SKILL: Utils Lisp (org-skill-utils-lisp.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:utils:lisp:validation:evaluation:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-utils-lisp.lisp
|
||||
|
||||
* Overview
|
||||
Structural manipulation tools for Lisp code. This skill provides the full toolkit used by the agent when self-editing: ~utils-lisp-validate~ (three-phase structural/syntactic/semantic gate), ~utils-lisp-eval~ (sandboxed evaluation in a jailed package), ~utils-lisp-structural-extract~ / ~inject~ / ~wrap~ / ~slurp~ (surgical code transformations), and ~utils-lisp-format~ (auto-indentation via Emacs batch). Every self-edit operation goes through these functions.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Structural Validation
|
||||
#+begin_src lisp
|
||||
(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)))))
|
||||
#+end_src
|
||||
|
||||
** Syntactic Validation
|
||||
#+begin_src lisp
|
||||
(defun utils-lisp-check-syntactic (code)
|
||||
"Checks for valid Lisp syntax beyond just balanced parentheses."
|
||||
(utils-lisp-check-structural code))
|
||||
#+end_src
|
||||
|
||||
** Semantic Validation (Safety)
|
||||
#+begin_src lisp
|
||||
(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)))
|
||||
#+end_src
|
||||
|
||||
** Unified Validation Gate
|
||||
#+begin_src lisp
|
||||
(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)))
|
||||
#+end_src
|
||||
|
||||
** Evaluation (REPL)
|
||||
#+begin_src lisp
|
||||
(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))))))
|
||||
#+end_src
|
||||
|
||||
** Formatting (Emacs Batch)
|
||||
#+begin_src lisp
|
||||
(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)))
|
||||
#+end_src
|
||||
|
||||
** Structural Extraction (AST)
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
** Structural Wrapping (AST)
|
||||
#+begin_src lisp
|
||||
(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))))
|
||||
#+end_src
|
||||
|
||||
** List Definitions
|
||||
#+begin_src lisp
|
||||
(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)))
|
||||
#+end_src
|
||||
|
||||
** Structural Injection (AST)
|
||||
#+begin_src lisp
|
||||
(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))))
|
||||
#+end_src
|
||||
|
||||
** Structural Slurp (AST)
|
||||
#+begin_src lisp
|
||||
(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))))
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-utils-lisp
|
||||
:priority 400
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
|
||||
* Test Suite
|
||||
Tests for the Lisp Validator structural, syntactic, and semantic gates.
|
||||
#+begin_src lisp :tangle ../tests/utils-lisp-tests.lisp
|
||||
(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)))))))
|
||||
#+end_src
|
||||
@@ -1,243 +0,0 @@
|
||||
#+TITLE: SKILL: Utils Org (org-skill-utils-org.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:utils:org:
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-utils-org.lisp
|
||||
|
||||
* Overview
|
||||
Structural manipulation tools for Org-mode files. This skill handles reading, writing, and modifying Org files at the AST level: finding headlines by ID or title, setting properties and TODO states, adding new headlines, generating UUIDs, and converting ASTs back to Org text. It also implements the privacy filter — when reading an Org file, it strips headlines tagged with ~@personal~ (or any tag in ~bouncer-privacy-tags~) and rejects files with matching ~#+FILETAGS:~.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Reading Files (with Privacy Filter)
|
||||
#+begin_src lisp
|
||||
(defun utils-org-extract-filetags (content)
|
||||
"Extracts the list of tags from a #+FILETAGS: line."
|
||||
(let ((lines (uiop:split-string content :separator '(#\Newline))))
|
||||
(dolist (line lines)
|
||||
(when (uiop:string-prefix-p "#+FILETAGS:" (string-trim '(#\Space) line))
|
||||
(let ((tag-str (string-trim " :" (subseq (string-trim '(#\Space) line) 10))))
|
||||
(return-from utils-org-extract-filetags
|
||||
(mapcar (lambda (tag) (format nil ":~a" (string-trim '(#\Space) tag)))
|
||||
(uiop:split-string tag-str :separator '(#\space #\tab))))))))
|
||||
nil)
|
||||
|
||||
(defun utils-org-tag-matches-privacy-p (tags-list)
|
||||
"Returns T if any tag in TAGS-LIST matches bouncer-privacy-tags."
|
||||
(let ((privacy-tags (symbol-value (find-symbol "BOUNCER-PRIVACY-TAGS" :opencortex))))
|
||||
(when (and tags-list privacy-tags)
|
||||
(some (lambda (tag)
|
||||
(some (lambda (private-tag)
|
||||
(string-equal (string-trim '(#\: #\space) tag)
|
||||
(string-trim '(#\: #\space) private-tag))
|
||||
privacy-tags))
|
||||
tags-list)))))
|
||||
|
||||
(defun utils-org-strip-tagged-subtrees (content)
|
||||
"Removes Org headlines whose :TAGS: property contains a privacy-filtered tag.
|
||||
Returns the filtered content as a string."
|
||||
(let* ((lines (uiop:split-string content :separator '(#\Newline)))
|
||||
(result-lines nil)
|
||||
(skip-depth nil)
|
||||
(current-tags nil)
|
||||
(in-properties nil))
|
||||
(dolist (line lines)
|
||||
(cond
|
||||
(skip-depth
|
||||
;; We're inside a skipped subtree
|
||||
(when (and (uiop:string-prefix-p "*" (string-trim '(#\Space) line))
|
||||
(<= (length (string-trim '(#\Space) line)) skip-depth))
|
||||
(setf skip-depth nil)))
|
||||
((uiop:string-prefix-p ":PROPERTIES:" (string-trim '(#\Space) line))
|
||||
(setf in-properties t)
|
||||
(push line result-lines))
|
||||
((uiop:string-prefix-p ":END:" (string-trim '(#\Space) line))
|
||||
(setf in-properties nil)
|
||||
(when current-tags
|
||||
(when (utils-org-tag-matches-privacy-p (reverse current-tags))
|
||||
(setf skip-depth
|
||||
(length (car (last result-lines
|
||||
(1+ (position-if
|
||||
(lambda (l)
|
||||
(uiop:string-prefix-p "*" (string-trim '(#\Space) l)))
|
||||
(reverse result-lines))))))))
|
||||
(setf current-tags nil))
|
||||
(push line result-lines))
|
||||
((and in-properties (uiop:string-prefix-p ":TAGS:" (string-trim '(#\Space) line)))
|
||||
(let ((tag-val (string-trim '(#\Space) (subseq (string-trim '(#\Space) line) 6))))
|
||||
(setf current-tags (uiop:split-string tag-val :separator '(#\space #\tab))))
|
||||
(push line result-lines))
|
||||
(t
|
||||
(push line result-lines))))
|
||||
(format nil "~{~a~%~}" (nreverse result-lines))))
|
||||
|
||||
(defun utils-org-read-file (filepath)
|
||||
"Reads an Org file into a string, applying privacy filtering."
|
||||
(let* ((raw (uiop:read-file-string filepath))
|
||||
(filetags (utils-org-extract-filetags raw)))
|
||||
(if (utils-org-tag-matches-privacy-p filetags)
|
||||
(progn
|
||||
(harness-log "UTILS-ORG: Blocked read of ~a — file-level privacy tag(s) ~a" filepath filetags)
|
||||
nil)
|
||||
(utils-org-strip-tagged-subtrees raw))))
|
||||
#+end_src
|
||||
|
||||
** Writing Files
|
||||
#+begin_src lisp
|
||||
(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)))
|
||||
#+end_src
|
||||
|
||||
** ID Generation
|
||||
#+begin_src lisp
|
||||
(defun utils-org-generate-id ()
|
||||
"Generates a new UUID for an Org node."
|
||||
(string-downcase (format nil "~a" (uuid:make-v4-uuid))))
|
||||
#+end_src
|
||||
|
||||
** ID Formatting
|
||||
#+begin_src lisp
|
||||
(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)))
|
||||
#+end_src
|
||||
|
||||
** Setting Properties (Recursive)
|
||||
#+begin_src lisp
|
||||
(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)
|
||||
#+end_src
|
||||
|
||||
** Setting TODO Status
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
** Adding Headlines
|
||||
#+begin_src lisp
|
||||
(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)
|
||||
#+end_src
|
||||
|
||||
** Searching Headlines (by ID)
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
** Searching Headlines (by Title)
|
||||
#+begin_src lisp
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
** Placeholder for External Edits
|
||||
#+begin_src lisp
|
||||
(defun utils-org-modify (filepath id changes)
|
||||
"Placeholder for Emacs-driven modification of a specific node."
|
||||
(declare (ignore changes))
|
||||
(harness-log "UTILS-ORG: Applying changes to ~a in ~a" id filepath)
|
||||
t)
|
||||
#+end_src
|
||||
|
||||
** Placeholder for AST to Org conversion
|
||||
#+begin_src lisp
|
||||
(defun utils-org-ast-to-org (ast)
|
||||
"Minimal converter from AST back to Org text (Placeholder)."
|
||||
(declare (ignore ast))
|
||||
"* TITLE (Placeholder)")
|
||||
#+end_src
|
||||
|
||||
** Skill Registration
|
||||
#+begin_src lisp
|
||||
(defskill :skill-utils-org
|
||||
:priority 100
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|
||||
#+end_src
|
||||
|
||||
* Test Suite
|
||||
Verification of the structural manipulation for Org-mode files and their AST representation.
|
||||
#+begin_src lisp :tangle ../tests/utils-org-tests.lisp
|
||||
(defpackage :opencortex-utils-org-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:utils-org-suite))
|
||||
|
||||
(in-package :opencortex-utils-org-tests)
|
||||
|
||||
(def-suite utils-org-suite
|
||||
:description "Tests for Utils Org skill.")
|
||||
|
||||
(in-suite utils-org-suite)
|
||||
|
||||
(test id-generation
|
||||
(let ((id1 (utils-org-generate-id))
|
||||
(id2 (utils-org-generate-id)))
|
||||
(is (plusp (length id1)))
|
||||
(is (not (string= id1 id2)))))
|
||||
|
||||
(test id-format
|
||||
(let ((formatted (utils-org-id-format "abc12345")))
|
||||
(is (search "id:" formatted))))
|
||||
|
||||
(test property-setter
|
||||
(let ((ast (list :type :HEADLINE
|
||||
:properties (list :ID "id:test123" :TITLE "Test")
|
||||
:contents nil)))
|
||||
(utils-org-set-property ast "id:test123" :STATUS "ACTIVE")
|
||||
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
|
||||
|
||||
(test todo-setter
|
||||
(let ((ast (list :type :HEADLINE
|
||||
:properties (list :ID "id:todo001" :TITLE "Task")
|
||||
:contents nil)))
|
||||
(utils-org-set-todo ast "id:todo001" "DONE")
|
||||
(is (string= (getf (getf ast :properties) :TODO) "DONE"))))
|
||||
#+end_src
|
||||
Reference in New Issue
Block a user