v0.2.1: polish, deploy, CI, and literate refactor
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 11s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 11s
- Secret Exposure Gate + Privacy Filter (Bouncer) - Shell actuator safety harness (timeout, blocked patterns) - REPL-first enforcement (lisp validation gate, system-prompt-augment) - Engineering Standards lifecycle (two-track Org-first + REPL-first) - Literate Programming discipline (one function per block, reflect-back) - AGENTS.md: thin routing layer, skills are authoritative - SKILLS_DIR removed, ~/notes fallback eliminated - opencortex.sh: multi-distro (Debian+Fedora), configure, install service, backup, restore, help - infrastructure/opencortex.service (systemd user unit) - Docker: updated to debian:trixie, fixed build context - GitHub CI: lint + test workflows fixed, trigger on tags only - Gitea CI: deploy workflow paths fixed - README: one-line curl install, badges - USER_MANUAL: Deployment section (bare metal, Docker, backup) - .gitignore: skills/*.lisp and tests/*.lisp as generated artifacts - Prose/block refactor across all 35 org files - Test suite Tier 1: 43/45 pass (env-dependent failures isolated)
This commit is contained in:
@@ -1,21 +1,128 @@
|
||||
#+TITLE: SKILL: Bouncer (org-skill-bouncer.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:bouncer:authorization:autonomy:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-bouncer.lisp
|
||||
#+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
|
||||
** 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 that the Bouncer considers safe for outbound connections.")
|
||||
"Domains the Bouncer considers safe for outbound connections.")
|
||||
#+end_src
|
||||
|
||||
** Secret Scanning (bouncer-scan-secrets)
|
||||
** 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."
|
||||
@@ -29,6 +136,99 @@ The *Bouncer Skill* is the physical security layer of OpenCortex. It enforces op
|
||||
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)
|
||||
@@ -46,28 +246,97 @@ The *Bouncer Skill* is the physical security layer of OpenCortex. It enforces op
|
||||
** Main Security Gate (bouncer-check)
|
||||
#+begin_src lisp
|
||||
(defun bouncer-check (action context)
|
||||
"The 5-Vector security gate for high-risk actions."
|
||||
"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)))
|
||||
(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))
|
||||
(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)))
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#+TITLE: SKILL: CLI Gateway (org-skill-cli-gateway.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:gateway:cli:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-cli-gateway.lisp
|
||||
#+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.
|
||||
|
||||
@@ -1,32 +1,36 @@
|
||||
#+TITLE: SKILL: Config Manager (org-skill-config-manager.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:setup:config:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-config-manager.lisp
|
||||
#+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 Paths
|
||||
** 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 (and xdg (string/= xdg ""))
|
||||
(uiop:ensure-directory-pathname xdg)
|
||||
(uiop:ensure-directory-pathname (merge-pathnames ".config/opencortex/" (user-homedir-pathname))))))
|
||||
(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 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 ()
|
||||
"Ensures the config directory exists."
|
||||
(let ((dir (get-oc-config-dir)))
|
||||
(unless (uiop:directory-exists-p dir)
|
||||
(uiop:ensure-directory-pathname dir))
|
||||
dir))
|
||||
"Creates the configuration directory if it does not exist."
|
||||
(ensure-directories-exist (get-oc-config-dir)))
|
||||
#+end_src
|
||||
|
||||
** Config File Operations
|
||||
@@ -189,7 +193,7 @@ The *Config Manager* skill provides the OpenCortex Agent with the capability to
|
||||
(format t "==================================================~%~%")
|
||||
|
||||
(format t "Note: Skill management is not yet implemented.~%")
|
||||
(format t "Skills are automatically loaded from ~a~%" (or (uiop:getenv "SKILLS_DIR") "default location"))
|
||||
(format t "Skills are automatically loaded from ~a~%" (or (uiop:getenv "OC_DATA_DIR") "~/.local/share/opencortex"))
|
||||
(format t "~%"))
|
||||
#+end_src
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#+TITLE: SKILL: Credentials Vault (org-skill-credentials-vault.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:security:vault:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-credentials-vault.lisp
|
||||
#+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.
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#+TITLE: SKILL: Diagnostics (org-skill-diagnostics.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:diagnostics:doctor:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-diagnostics.lisp
|
||||
#+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.
|
||||
|
||||
@@ -1,10 +1,63 @@
|
||||
#+TITLE: SKILL: Engineering Standards (org-skill-engineering-standards.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:engineering:chaos:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-engineering-standards.lisp
|
||||
#+DEPENDS_ON: org-skill-utils-lisp
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-engineering-standards.lisp
|
||||
|
||||
* Overview
|
||||
The *Engineering Standards Skill* enforces technical invariants, including the **Commit-Before-Modify** rule and **Chaos-Driven Development**.
|
||||
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
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#+TITLE: SKILL: Gardener (org-skill-gardener.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:maintenance:gardener:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-gardener.lisp
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-gardener.lisp
|
||||
|
||||
* Overview
|
||||
The *Gardener Skill* performs periodic maintenance on the Memex knowledge graph.
|
||||
|
||||
@@ -1,32 +1,290 @@
|
||||
#+TITLE: SKILL: Gateway Manager (org-skill-gateway-manager.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:gateway:manager:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-gateway-manager.lisp
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-gateway-manager.lisp
|
||||
|
||||
* Overview
|
||||
The *Gateway Manager* handles the registration and linking of external communication platforms.
|
||||
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
|
||||
|
||||
** Gateway Logic
|
||||
** Platform state — configs
|
||||
Storage for active gateway connections: tokens, polling threads, and intervals.
|
||||
#+begin_src lisp
|
||||
(defun skill-gateway-register (platform token)
|
||||
"Registers a new external gateway."
|
||||
(harness-log "GATEWAY: Registered ~a with token ~a" platform (VAULT-MASK-STRING token)))
|
||||
(defvar *gateway-configs* (make-hash-table :test 'equal)
|
||||
"Maps platform name → plist (:token :thread :interval :enabled)")
|
||||
#+end_src
|
||||
|
||||
(defun skill-gateway-link (platform)
|
||||
"Establishes a link with an external platform."
|
||||
(harness-log "GATEWAY: Linking to ~a..." platform))
|
||||
** 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
|
||||
|
||||
(defun gateway-manager-main (platform token)
|
||||
"Main entry point for gateway configuration."
|
||||
(skill-gateway-register platform token)
|
||||
(skill-gateway-link platform))
|
||||
** 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 100
|
||||
: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,10 +1,10 @@
|
||||
#+TITLE: SKILL: Homoiconic Memory (org-skill-homoiconic-memory.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :harness:memory:homoiconic:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-homoiconic-memory.lisp
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-homoiconic-memory.lisp
|
||||
|
||||
* Overview
|
||||
The *Homoiconic Memory* skill provides the capability to treat system memory as executable code and vice-versa.
|
||||
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
|
||||
|
||||
|
||||
@@ -1,10 +1,36 @@
|
||||
#+TITLE: SKILL: Literate Programming (org-skill-literate-programming.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:literate:tangle:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-literate-programming.lisp
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-literate-programming.lisp
|
||||
|
||||
* Overview
|
||||
The *Literate Programming* skill ensures the synchronization between `.org` sources and `.lisp` artifacts.
|
||||
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
|
||||
|
||||
|
||||
@@ -1,10 +1,10 @@
|
||||
#+TITLE: SKILL: LLM Gateway (org-skill-llm-gateway.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:llm:gateway:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-llm-gateway.lisp
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-llm-gateway.lisp
|
||||
|
||||
* Overview
|
||||
The *LLM Gateway* skill provides a unified interface for interacting with multiple Large Language Model providers.
|
||||
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
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#+TITLE: SKILL: Peripheral Vision (org-skill-peripheral-vision.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :harness:peripheral:context:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-peripheral-vision.lisp
|
||||
#+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.
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#+TITLE: SKILL: Policy (org-skill-policy.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:policy:constitutional:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-policy.lisp
|
||||
#+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.
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#+TITLE: SKILL: Protocol Validator (org-skill-protocol-validator.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:protocol:validation:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-protocol-validator.lisp
|
||||
#+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.
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#+TITLE: SKILL: REPL (org-skill-repl.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:repl:interactive:debug:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-repl.lisp
|
||||
#+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.
|
||||
@@ -184,10 +184,28 @@ REPL Skill Commands:
|
||||
* 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))
|
||||
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)
|
||||
:system-prompt-augment #'repl-mandate)
|
||||
#+end_src
|
||||
@@ -1,7 +1,7 @@
|
||||
#+TITLE: SKILL: Scribe (org-skill-scribe.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:scribe:documentation:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-scribe.lisp
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-scribe.lisp
|
||||
|
||||
* Overview
|
||||
The *Scribe Skill* manages the agent's internal documentation and logs.
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#+TITLE: SKILL: Self Edit (org-skill-self-edit.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:autonomy:self-edit:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-self-edit.lisp
|
||||
#+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.
|
||||
@@ -12,6 +12,7 @@ The *Self Edit* skill allows the OpenCortex Agent to modify its own literate sou
|
||||
#+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
|
||||
|
||||
|
||||
@@ -1,10 +1,10 @@
|
||||
#+TITLE: SKILL: Self Fix (org-skill-self-fix.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :system:autonomy:self-fix:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-self-fix.lisp
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-self-fix.lisp
|
||||
|
||||
* Overview
|
||||
The *Self Fix* skill enables the agent to automatically repair broken skills and harness components.
|
||||
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
|
||||
|
||||
@@ -12,6 +12,7 @@ The *Self Fix* skill enables the agent to automatically repair broken skills and
|
||||
#+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
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#+TITLE: SKILL: Shell Actuator (org-skill-shell-actuator.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:actuator:shell:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-shell-actuator.lisp
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-shell-actuator.lisp
|
||||
|
||||
* Overview
|
||||
The *Shell Actuator* provides the agent with the capability to execute bash commands.
|
||||
@@ -11,16 +11,26 @@ The *Shell Actuator* provides the agent with the capability to execute bash comm
|
||||
** Shell Execution (shell-execute)
|
||||
#+begin_src lisp
|
||||
(defun shell-execute (action context)
|
||||
"Executes a bash command and returns the output."
|
||||
"Executes a bash command with timeout (via timeout(1)) and output limit."
|
||||
(declare (ignore context))
|
||||
(let* ((payload (getf action :payload))
|
||||
(cmd (getf payload :cmd)))
|
||||
(harness-log "ACT [Shell]: ~a" cmd)
|
||||
(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" cmd) :output :string :error-output :string :ignore-error-status t)
|
||||
(if (= code 0)
|
||||
out
|
||||
(format nil "ERROR [~a]: ~a" code err)))))
|
||||
(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
|
||||
|
||||
@@ -1,23 +1,32 @@
|
||||
#+TITLE: SKILL: Tool Permissions (org-skill-tool-permissions.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:security:permissions:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-tool-permissions.lisp
|
||||
#+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 Registry
|
||||
** 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."
|
||||
"Retrieves the permission level for a tool. Defaults to :ask."
|
||||
(gethash (string-downcase (string tool-name)) *tool-permissions* :ask))
|
||||
#+end_src
|
||||
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#+TITLE: SKILL: Unified LLM Backend (org-skill-unified-llm-backend.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:llm:backend:openai-compatible:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-unified-llm-backend.lisp
|
||||
#+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:
|
||||
@@ -13,7 +13,8 @@ No separate skills per provider — just different base URLs and API keys.
|
||||
|
||||
* Implementation
|
||||
|
||||
** Provider Registry
|
||||
** 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"))
|
||||
@@ -22,17 +23,25 @@ No separate skills per provider — just different base URLs and API keys.
|
||||
(: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 (has API key or is local Ollama)."
|
||||
"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) ; Ollama is always tried; failure is handled at call time
|
||||
(cond ((eq provider :ollama) t)
|
||||
(key-env (let ((key (uiop:getenv key-env))) (and key (> (length key) 0))))
|
||||
(base-url t))))
|
||||
#+end_src
|
||||
|
||||
@@ -1,10 +1,10 @@
|
||||
#+TITLE: SKILL: Utils Lisp (org-skill-utils-lisp.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:utils:lisp:validation:evaluation:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-utils-lisp.lisp
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-utils-lisp.lisp
|
||||
|
||||
* Overview
|
||||
The *Utils Lisp* skill provides advanced structural validation, sandboxed evaluation, and formatting for Common Lisp code.
|
||||
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
|
||||
|
||||
@@ -192,3 +192,82 @@ The *Utils Lisp* skill provides advanced structural validation, sandboxed evalua
|
||||
: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,18 +1,84 @@
|
||||
#+TITLE: SKILL: Utils Org (org-skill-utils-org.org)
|
||||
#+AUTHOR: Agent
|
||||
#+FILETAGS: :skill:utils:org:
|
||||
#+PROPERTY: header-args:lisp :tangle %%SKILLS_DIR%%/org-skill-utils-org.lisp
|
||||
#+PROPERTY: header-args:lisp :tangle org-skill-utils-org.lisp
|
||||
|
||||
* Overview
|
||||
The *Utils Org* skill provides advanced structural manipulation for Org-mode files and their AST representation.
|
||||
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
|
||||
** 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."
|
||||
(uiop:read-file-string 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
|
||||
@@ -136,3 +202,42 @@ The *Utils Org* skill provides advanced structural manipulation for Org-mode fil
|
||||
: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