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

Add v0.2.0 features: vector search + tool permissions

Browse Source 
- Local vector search: Ollama embeddings + semantic search
  - get-embedding with caching
  - cosine-similarity computation
  - semantic-search cognitive tool
  - :semantic-search tool for LLM queries

- Tool permission tiers: security gating for cognitive tools
  - Three tiers: :allow, :deny, :ask
  - Gate in execute-tool-action before tool runs
  - Defaults: :deny for shell/delete-file, :ask for eval/write-file
  - :tool-permissions cognitive tool for management

- Embedding provider support: Ollama AND llama.cpp
  - EMBEDDING_PROVIDER env var
  - EMBEDDING_MODEL env var
  - LLAMA_HOST for llama.cpp server

- .env.example: Add embedding config variables
- Fix parse-message in communication.lisp

- Update ASDF: add test files, tool-permissions skill

All 60 tests pass (6 suites x 100%)
This commit is contained in:
Amr Gharbeia
2026-04-23 13:43:50 -04:00
parent 4e553f654e
commit dfe318425f
13 changed files with 535 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
skills/org-skill-emacs-edit.org
View File

@@ -69,11 +69,9 @@ Generate unique IDs for headlines.
(defun emacs-edit-generate-id ()
"Generates a unique ID for org-mode headlines.
Format: 8-char hex + timestamp for uniqueness."
(let ((uuid (ironclad:byte-array-to-hex-string
(ironclad:produce-digest :sha256
(format nil "~a-~a"
(get-universal-time)
(random 999999))))))
(let* ((data (format nil "~a-~a" (get-universal-time) (random 999999)))
(digest (ironclad:digest-sequence :sha256 (ironclad:ascii-string-to-byte-array data)))
(uuid (ironclad:byte-array-to-hex-string digest)))
(subseq uuid 0 8)))
(defun emacs-edit-id-format (id)
@@ -106,7 +104,7 @@ INDENT-LEVEL is number of leading asterisks."
unless (member k '(:title :todo :created :id))
collect (format nil ":~a:~a" k v))))
(when lines
(format nil ":PROPERTIES:~%~{~a~^~%~}~:END:~%"
(format nil ":PROPERTIES:~%~{~a~^~%~}~%:END:~%"
lines)))))
(defun emacs-edit-print-section (ast)
@@ -146,7 +144,7 @@ Preserves structure including #+begin_src blocks."
((eq type :src-block)
(let ((lang (or (getf ast :language) ""))
(code (or (getf ast :value) "")))
(format nil "#+begin_src ~a~%~a~#+end_src~%"
(format nil "#+begin_src ~a~%~a~%#+end_src~%"
lang code)))
;; Unknown - return as-is
@@ -208,7 +206,7 @@ Returns modified AST."
(multiple-value-bind (s mi h d mo y)
(decode-universal-time (get-universal-time))
(format nil "~a-~a-~a ~a:~a"
y mo d h mi))))))
y mo d h mi)))))
(merged-props (loop for (k v) on properties by #'cddr
collect k collect v)))

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

@@ -161,7 +161,7 @@ Returns (VALUES t nil) if clean, or (VALUES nil reason-string line col)."
(values nil (format nil "Mismatched ')' expected at line ~a, col ~a" line col) line col)))
(t (pop stack))))
((char= ch #\Newline)
(incf line) (setf col 0))))
(incf line) (setf col 0)))
(unless (char= ch #\Newline) (incf col))))
(if (null stack)
(values t nil nil nil)
@@ -231,7 +231,7 @@ Recursively walks the parsed AST and verifies whitelisted symbols.
;; Time
get-universal-time get-internal-real-time sleep
;; Equality
equalp = equal eq eql))
equalp = equal eq eql)
"Static whitelist of symbols permitted in the Lisp Utils sandbox.")
(defun lisp-utils-ast-walk (form)
@@ -373,7 +373,7 @@ Intercepts :syntax-error events and repairs the code.
repaired)
(error ()
(harness-log "LISP REPAIR: Neural repair failed.")
(list :type :LOG :payload (list :text "Lisp Repair Failed."))))))))))))
(list :type :LOG :payload (list :text "Lisp Repair Failed.")))))))))))
#+end_src
** Skill Definition: Lisp Validator
@@ -419,24 +419,37 @@ Validates all Lisp code before execution.
(in-suite lisp-utils-suite)
;; Character utilities
;; Character utilities
(test count-char-balanced
(is (= (count-char #\( "(+ 1 2)") 1))
(is (= (count-char #\) "(+ 1 2)") 1))
(is (= (opencortex::count-char #\( "(+ 1 2)") 1))
(is (= (opencortex::count-char #\) "(+ 1 2)") 1)))
(test count-char-unbalanced
(is (= (count-char #\( "(+ 1 2") 1))
(is (= (count-char #\) "(+ 1 2") 0))
(is (= (opencortex::count-char #\( "(+ 1 2") 1))
(is (= (opencortex::count-char #\) "(+ 1 2") 0)))
(test count-char-empty
(is (= (opencortex::count-char #\( "") 0)))
;; Deterministic repair
(test deterministic-repair-balanced
(is (string= (deterministic-repair "(+ 1 2)") "(+ 1 2)")))
(is (string= (opencortex::deterministic-repair "(+ 1 2)") "(+ 1 2)")))
(test deterministic-repair-unbalanced
(is (string= (deterministic-repair "(+ 1 2") "(+ 1 2)")))
(test deterministic-repair-unbalanced-open
(is (string= (opencortex::deterministic-repair "(+ 1 2") "(+ 1 2)")))
(test deterministic-repair-unbalanced-close
(is (string= (opencortex::deterministic-repair "(+ 1 2))") "(+ 1 2))")))
(test deterministic-repair-empty
(is (string= (opencortex::deterministic-repair "") "")))
;; Structural check
(test structural-valid
(multiple-value-bind (ok reason line col)
(opencortex::lisp-utils-check-structural "(+ 1 2)")
(is ok)))
(is (eq ok t))))
(test structural-unbalanced
(multiple-value-bind (ok reason line col)
@@ -444,21 +457,40 @@ Validates all Lisp code before execution.
(is (not ok))
(is (search "Unbalanced" reason))))
(test structural-mismatched
(multiple-value-bind (ok reason line col)
(opencortex::lisp-utils-check-structural "[)")
(is (not ok))
(is (search "Mismatched" reason))))
;; Syntactic check
(test syntactic-valid
(multiple-value-bind (ok reason line col)
(opencortex::lisp-utils-check-syntactic "(+ 1 2)")
(is ok)))
(is (eq ok t))))
(test semantic-whitelist
(test syntactic-invalid
(multiple-value-bind (ok reason line col)
(opencortex::lisp-utils-check-syntactic "(1+ 2 #\")")
(is (not ok))))
;; Semantic check
(test semantic-whitelist-safe
(multiple-value-bind (ok reason line col)
(opencortex::lisp-utils-check-semantic "(+ 1 2)")
(is ok)))
(is (eq ok t))))
(test semantic-blocked
(test semantic-blocked-eval
(multiple-value-bind (ok reason line col)
(opencortex::lisp-utils-check-semantic "(eval '(+ 1 2))")
(is (not ok))))
(test semantic-blocked-delete
(multiple-value-bind (ok reason line col)
(opencortex::lisp-utils-check-semantic "(delete-file \"x.txt\")")
(is (not ok))))
;; Unified validation
(test unified-success
(let ((result (opencortex::lisp-utils-validate "(+ 1 2)" :strict t)))
(is (eq (getf result :status) :success))))
@@ -467,6 +499,16 @@ Validates all Lisp code before execution.
(let ((result (opencortex::lisp-utils-validate "(+ 1 2" :strict nil)))
(is (eq (getf result :status) :error))
(is (eq (getf result :failed) :structural))))
(test unified-semantic-fail
(let ((result (opencortex::lisp-utils-validate "(delete-file \"x.txt\")" :strict t)))
(is (eq (getf result :status) :error))
(is (eq (getf result :failed) :semantic))))
(test unified-semantic-fail
(let ((result (opencortex::lisp-utils-validate "(delete-file \"x.txt\")" :strict t)))
(is (eq (getf result :status) :error))
(is (eq (getf result :failed) :semantic))))
#+end_src
* See Also

18
skills/org-skill-llm-gateway.org
View File

@@ -114,6 +114,24 @@ The gateway utilizes a functional dispatch pattern. A single entry point, `execu
(opencortex:register-probabilistic-backend p (lambda (prompt system-prompt &key model)
(execute-llm-request prompt system-prompt :provider p :model model))))
(def-cognitive-tool :get-ollama-embedding
"Generates vector embeddings via Ollama API for semantic search."
((text :type :string :description "Text to embed."))
:body (lambda (args)
(let* ((text (getf args :text))
(host (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
(url (format nil "http://~a/api/embeddings" host))
(model (or (uiop:getenv "OLLAMA_EMBEDDING_MODEL") "nomic-embed-text"))
(body (cl-json:encode-json-to-string `((model . ,model) (prompt . ,text)))))
(handler-case
(let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body :connect-timeout 5 :read-timeout 30))
(json (cl-json:decode-json-from-string response)))
(let ((embedding (cdr (assoc :embedding json))))
(if embedding
(list :status :success :vector embedding)
(list :status :error :message "No embedding in response"))))
(error (c) (list :status :error :message (format nil "Ollama Embedding Failure: ~a" c)))))))
(def-cognitive-tool :ask-llm
"Queries an LLM provider via the unified gateway."
((:prompt :type :string :description "The user prompt.")

118
skills/org-skill-tool-permissions.org Normal file
View File

@@ -0,0 +1,118 @@
:PROPERTIES:
:ID: tool-permissions-skill-001
:CREATED: [2026-04-23 Thu]
:END:
#+TITLE: SKILL: Tool Permission Tiers
#+STARTUP: content
#+FILETAGS: :security:permissions:tool:
* Overview
This skill implements tool permission tiers for security - controlling which cognitive tools can execute without user interaction.
Also provides vector embeddings via Ollama or llama.cpp.
** The Three Tiers
| Tier | Behavior | Use Case |
|------|----------|----------|
| =:allow= | Executes immediately | Trusted, safe tools |
| =:deny= | Blocks before execution | Dangerous tools |
| =:ask= | Prompts user, pauses execution | Sensitive tools |
** Embedding Providers
- =EMBEDDING_PROVIDER= environment: "ollama" or "llama.cpp"
- =OLLAMA_HOST= / =LLAMA_HOST= for the API endpoint
- =EMBEDDING_MODEL= model name
* Implementation
Tool permissions and embedding generation via multiple providers.
#+begin_src lisp :tangle ../library/gen/org-skill-tool-permissions.lisp
(in-package :opencortex)
(defvar *tool-permissions* (make-hash-table :test 'equal)
"Hash table mapping tool names to :allow/:deny/:ask.")
(defun get-tool-permission (tool-name)
(let ((key (string-downcase (string tool-name))))
(or (gethash key *tool-permissions*) :allow)))
(defun set-tool-permission (tool-name tier)
(setf (gethash (string-downcase (string tool-name)) *tool-permissions*) tier)
(harness-log "TOOL PERMISSION: Set ~a = ~a" tool-name tier))
(defun check-tool-permission-gate (tool-name context)
(declare (ignore context))
(let ((perm (get-tool-permission tool-name)))
(case perm
(:allow :allow)
(:deny :deny)
(:ask (list :ask tool-name context))
(t :allow))))
(def-cognitive-tool :get-embedding
"Generates vector embeddings via Ollama or llama.cpp API."
((:text :type :string :description "Text to embed."))
:body (lambda (args)
(let* ((text (getf args :text))
(provider (or (uiop:getenv "EMBEDDING_PROVIDER") "ollama"))
(model (or (uiop:getenv "EMBEDDING_MODEL") "nomic-embed-text"))
(embedding nil))
(cond
((string= provider "ollama")
(let* ((host (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))
(url (format nil "http://~a/api/embeddings" host))
(body (cl-json:encode-json-to-string `((model . ,model) (prompt . ,text)))))
(handler-case
(let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body :connect-timeout 5 :read-timeout 30))
(json (cl-json:decode-json-from-string response))
(vec (cdr (assoc :embedding json))))
(when vec (setf embedding vec)))
(error (c) (harness-log "EMBEDDING: Ollama failed: ~a" c)))))
((string= provider "llama.cpp")
(let* ((host (or (uiop:getenv "LLAMA_HOST") "localhost:8080"))
(url (format nil "http://~a/v1/embeddings" host))
(body (cl-json:encode-json-to-string `((model . ,model) (input . ,text)))))
(handler-case
(let* ((response (dex:post url :headers '(("Content-Type" . "application/json")) :content body :connect-timeout 5 :read-timeout 30))
(json (cl-json:decode-json-from-string response))
(data (cdr (assoc :data json)))
(vec (when data (cdr (assoc :embedding (car data))))))
(when vec (setf embedding vec)))
(error (c) (harness-log "EMBEDDING: llama.cpp failed: ~a" c))))))
(if embedding
(list :status :success :vector embedding)
(list :status :error :message "Embedding generation failed")))))
(def-cognitive-tool :tool-permissions
"View or set tool permission tiers."
((:tool :type :string :description "Tool name")
(:action :type :keyword :description "Action: :get, :set, :list" :default :get)
(:tier :type :keyword :description "For :set: :allow/:deny/:ask"))
:body (lambda (args)
(let ((tool (getf args :tool))
(action (getf args :action :get))
(tier (getf args :tier)))
(case action
(:get (list :status :success :tool tool :permission (get-tool-permission tool)))
(:set (progn (set-tool-permission tool tier)
(list :status :success :message (format nil "Set ~a = ~a" tool tier))))
(:list (let ((r nil))
(maphash (lambda (k v) (push (list :tool k :permission v) r)) *tool-permissions*)
(list :status :success :tools r)))
(t (list :status :error :message "Invalid action"))))))
;; Defaults
(set-tool-permission :shell :deny)
(set-tool-permission :delete-file :deny)
(set-tool-permission :eval :ask)
(set-tool-permission :write-file :ask)
(harness-log "TOOL PERMISSIONS: Initialized")
(defskill :skill-tool-permissions
:priority 600
:trigger (lambda (c) (declare (ignore c)) nil)
:deterministic (lambda (a c)
(let ((tool (getf (getf a :payload) :tool)))
(when tool (check-tool-permission-gate tool c)))))
#+end_src