diff --git a/.env.example b/.env.example index c5e861c..808e23d 100644 --- a/.env.example +++ b/.env.example @@ -25,7 +25,13 @@ PROVIDER_CASCADE="openrouter,openai,anthropic,groq,gemini-api,ollama" OLLAMA_HOST="localhost:11434" # llama.cpp backend (for local GGUF models) -LLAMACPP_ENDPOINT="http://localhost:8080" +LLAMA_HOST="localhost:8080" + +# ============================================================================= +# VECTOR EMBEDDINGS (semantic search) +# ============================================================================= +EMBEDDING_PROVIDER="ollama" # "ollama" or "llama.cpp" +EMBEDDING_MODEL="nomic-embed-text" # model name for embeddings # ============================================================================= # MESSAGING GATEWAYS (optional) diff --git a/harness/memory.org b/harness/memory.org index 470811c..df3edd3 100644 --- a/harness/memory.org +++ b/harness/memory.org @@ -201,6 +201,69 @@ Reconstitutes alists into hash tables." t)) #+end_src +** Semantic Search (get-embedding, semantic-search) +Support for vector embeddings via Ollama and semantic search with cosine similarity. + +The vector slot on org-objects enables semantic recall - searching memory by meaning rather than just keywords. Embeddings are generated on ingest when the :EMBED property is set to "t", and cached locally to avoid redundant API calls. + +#+begin_src lisp :tangle ../library/memory.lisp +(defvar *embedding-cache* (make-hash-table :test 'equal) + "Cache for embeddings to avoid redundant API calls.") + +(defun get-embedding (text) + "Generates a vector embedding for the given text via Ollama. Returns nil on failure." + (when (or (null text) (string= text "")) + (return-from get-embedding nil)) + (let ((cached (gethash text *embedding-cache*))) + (when cached (return-from get-embedding cached))) + (let ((result (funcall (get-cognitive-tool-body :get-ollama-embedding) (list :text text)))) + (when (eq (getf result :status) :success) + (let ((vec (getf result :vector))) + (setf (gethash text *embedding-cache*) vec) + vec)))) + +(defun cosine-similarity (vec-a vec-b) + "Computes cosine similarity between two vectors. Both should be sequences of numbers." + (when (or (null vec-a) (null vec-b) (zerop (length vec-a)) (zerop (length vec-b))) + (return-from cosine-similarity 0.0)) + (let ((dot-product (loop for a across vec-a + for b across vec-b + sum (* a b))) + (norm-a (sqrt (loop for a across vec-a sum (* a a)))) + (norm-b (sqrt (loop for b across vec-b sum (* b b))))) + (if (or (zerop norm-a) (zerop norm-b)) + 0.0 + (/ dot-product (* norm-a norm-b))))) + +(defun semantic-search (query &key (limit 10) (min-similarity 0.5)) + "Searches memory for objects semantically similar to the query. +Returns up to LIMIT objects with similarity >= MIN-SIMILARITY, sorted by similarity descending." + (let* ((query-vec (get-embedding query)) + (results nil)) + (unless query-vec + (harness-log "EMBEDDING: Failed to generate embedding for query: ~a" query) + (return-from semantic-search nil)) + (maphash (lambda (id obj) + (let ((obj-vec (org-object-vector obj))) + (when obj-vec + (let ((sim (cosine-similarity query-vec obj-vec))) + (when (>= sim min-similarity) + (push (list :id id :object obj :similarity sim) results)))))) + *memory*) + (setf results (sort results #'> :key (lambda (r) (getf r :similarity)))) + (subseq results 0 (min limit (length results))))) + +(def-cognitive-tool :semantic-search + "Searches memory for objects semantically similar to a query." + ((:query :type :string :description "The search query.") + (:limit :type :integer :description "Maximum results to return." :default 10) + (:min-similarity :type :number :description "Minimum similarity threshold (0-1)." :default 0.5)) + :body (lambda (args) + (semantic-search (getf args :query) + :limit (or (getf args :limit) 10) + :min-similarity (or (getf args :min-similarity) 0.5)))) +#+end_src + ** Lookup Utilities Basic functions for retrieving objects by ID or type. diff --git a/library/act.lisp b/library/act.lisp index 46c4551..042c286 100644 --- a/library/act.lisp +++ b/library/act.lisp @@ -81,8 +81,18 @@ (meta (getf context :meta)) (source (getf meta :source)) (tool (gethash (string-downcase (string tool-name)) *cognitive-tools*))) - (if tool - (handler-case + (when tool + ;; Tool Permission Gate: Check permission before execution + (let ((permission (check-tool-permission-gate tool-name context))) + (when (eq permission :deny) + (return-from execute-tool-action + (list :TYPE :EVENT :DEPTH (1+ depth) :META meta + :PAYLOAD (list :SENSOR :tool-error :tool tool-name :message (format nil "Tool PERMISSION DENIED: ~a" tool-name)))))) + (when (listp permission) + (return-from execute-tool-action + (list :TYPE :EVENT :DEPTH (1+ depth) :META meta + :PAYLOAD (list :SENSOR :permission-pending :tool tool-name :args tool-args))))) + (handler-case (let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args)) (result (funcall (cognitive-tool-body tool) clean-args))) (let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta @@ -94,10 +104,10 @@ context)) feedback)) (error (c) - (list :TYPE :EVENT :DEPTH (1+ depth) :META meta - :PAYLOAD (list :SENSOR :tool-error :tool tool-name :message (format nil "~a" c))))) (list :TYPE :EVENT :DEPTH (1+ depth) :META meta - :PAYLOAD (list :SENSOR :tool-error :message "Tool not found"))))) + :PAYLOAD (list :SENSOR :tool-error :tool tool-name :message (format nil "~a" c))))) + (list :TYPE :EVENT :DEPTH (1+ depth) :META meta + :PAYLOAD (list :SENSOR :tool-error :message "Tool not found")))) (defun act-gate (signal) "Final Stage: Actuation and feedback generation." diff --git a/library/communication.lisp b/library/communication.lisp index 4f9fb2b..a5b7b2a 100644 --- a/library/communication.lisp +++ b/library/communication.lisp @@ -16,6 +16,13 @@ (len (length msg-string))) (format nil "~6,'0x~a~%" len msg-string))) +(defun parse-message (framed-string) + "Parses a hex-length prefixed framed string into a Lisp plist." + (let* ((len (parse-integer (subseq framed-string 0 6) :radix 16)) + (payload (subseq framed-string 6 (+ 6 len)))) + (let ((*read-eval* nil)) + (read-from-string payload)))) + (defun read-framed-message (stream) "Reads a hex-length prefixed S-expression from the stream securely. Skips leading whitespace." (let ((length-buffer (make-string 6))) diff --git a/library/gen/org-skill-llm-gateway.lisp b/library/gen/org-skill-llm-gateway.lisp index 5c4fc2e..ff79ff3 100644 --- a/library/gen/org-skill-llm-gateway.lisp +++ b/library/gen/org-skill-llm-gateway.lisp @@ -91,6 +91,30 @@ (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." + ((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))))))) + +(defun get-embedding (text) + "Generates a vector embedding for the given text via Ollama. Returns nil on failure." + (let ((result (funcall (get-cognitive-tool-body :get-ollama-embedding) (list :text text)))) + (when (eq (getf result :status) :success) + (getf result :vector)))) + (def-cognitive-tool :ask-llm "Queries an LLM provider via the unified gateway." ((:prompt :type :string :description "The user prompt.") diff --git a/library/gen/org-skill-tool-permissions.lisp b/library/gen/org-skill-tool-permissions.lisp new file mode 100644 index 0000000..0eb3777 --- /dev/null +++ b/library/gen/org-skill-tool-permissions.lisp @@ -0,0 +1,91 @@ +(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") + (case (intern (string-upcase provider) :keyword) + (:NOMIC-EMBED-TEXT "nomic-embed-text") + (:LLAMA-CPP "llama.cpp") + (t "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))))) \ No newline at end of file diff --git a/library/memory.lisp b/library/memory.lisp index 1724c00..cb34d8e 100644 --- a/library/memory.lisp +++ b/library/memory.lisp @@ -161,3 +161,58 @@ Reconstitutes alists into hash tables." (defun file-name-nondirectory (path) "Extracts the filename from a full path string." (let ((pos (position #\/ path :from-end t))) (if pos (subseq path (1+ pos)) path))) + +(defvar *embedding-cache* (make-hash-table :test 'equal) + "Cache for embeddings to avoid redundant API calls.") + +(defun get-embedding (text) + "Generates a vector embedding for the given text via Ollama. Returns nil on failure." + (when (or (null text) (string= text "")) + (return-from get-embedding nil)) + (let ((cached (gethash text *embedding-cache*))) + (when cached (return-from get-embedding cached))) + (let ((result (funcall (get-cognitive-tool-body :get-ollama-embedding) (list :text text)))) + (when (eq (getf result :status) :success) + (let ((vec (getf result :vector))) + (setf (gethash text *embedding-cache*) vec) + vec)))) + +(defun cosine-similarity (vec-a vec-b) + "Computes cosine similarity between two vectors. Both should be sequences of numbers." + (when (or (null vec-a) (null vec-b) (zerop (length vec-a)) (zerop (length vec-b))) + (return-from cosine-similarity 0.0)) + (let ((dot-product (loop for a across vec-a + for b across vec-b + sum (* a b))) + (norm-a (sqrt (loop for a across vec-a sum (* a a)))) + (norm-b (sqrt (loop for b across vec-b sum (* b b))))) + (if (or (zerop norm-a) (zerop norm-b)) + 0.0 + (/ dot-product (* norm-a norm-b))))) + +(defun semantic-search (query &key (limit 10) (min-similarity 0.5)) + "Searches memory for objects semantically similar to the query." + (let* ((query-vec (get-embedding query)) + (results nil)) + (unless query-vec + (harness-log "EMBEDDING: Failed to generate embedding for query: ~a" query) + (return-from semantic-search nil)) + (maphash (lambda (id obj) + (let ((obj-vec (org-object-vector obj))) + (when obj-vec + (let ((sim (cosine-similarity query-vec obj-vec))) + (when (>= sim min-similarity) + (push (list :id id :object obj :similarity sim) results)))))) + *memory*) + (setf results (sort results #'> :key (lambda (r) (getf r :similarity)))) + (subseq results 0 (min limit (length results))))) + +(def-cognitive-tool :semantic-search + "Searches memory for objects semantically similar to a query." + ((:query :type :string :description "The search query.") + (:limit :type :integer :description "Maximum results to return." :default 10) + (:min-similarity :type :number :description "Minimum similarity threshold (0-1)." :default 0.5)) + :body (lambda (args) + (semantic-search (getf args :query) + :limit (or (getf args :limit) 10) + :min-similarity (or (getf args :min-similarity) 0.5)))) diff --git a/library/package.lisp b/library/package.lisp index a0c3091..09629f3 100644 --- a/library/package.lisp +++ b/library/package.lisp @@ -167,3 +167,16 @@ (setq *system-logs* (subseq *system-logs* 0 *max-log-history*)))) (format t "~a~%" formatted-msg) (finish-output))) + +(defun proto-get (plist key) + "Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions." + (let* ((s (string key)) + (up (intern (string-upcase s) :keyword)) + (dn (intern (string-downcase s) :keyword))) + (or (getf plist up) (getf plist dn)))) + +(defun get-cognitive-tool-body (tool-name) + "Retrieves the body function of a cognitive tool, or nil if not found." + (let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tools*))) + (when tool + (cognitive-tool-body tool)))) diff --git a/opencortex.asd b/opencortex.asd index addd737..113d990 100644 --- a/opencortex.asd +++ b/opencortex.asd @@ -4,46 +4,72 @@ :version "0.1.0" :license "AGPLv3" :description "The Probabilistic-Deterministic Lisp Machine Harness" - :depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid) - :serial t - :components ((:file "library/package") - (:file "library/skills" :depends-on ("library/package")) - (:file "library/memory" :depends-on ("library/package")) - (:file "library/context" :depends-on ("library/package" "library/memory")) - (:file "library/communication" :depends-on ("library/package")) - (:file "library/communication-validator" :depends-on ("library/package" "library/communication")) - (:file "library/perceive" :depends-on ("library/package")) - (:file "library/reason" :depends-on ("library/package" "library/perceive")) - (:file "library/act" :depends-on ("library/package" "library/reason")) - (:file "library/loop" :depends-on ("library/package" "library/act"))) + + :depends-on (:usocket ; TCP socket networking + :bordeaux-threads ; Threading (heartbeat, async sensors) + :dexador ; HTTP client (LLM APIs) + :uiop ; Portable I/O, file operations + :cl-dotenv ; Environment variable loading + :cl-ppcre ; Regular expressions (parsing) + :hunchentoot ; HTTP server (optional web interface) + :ironclad ; Cryptography (Merkle hashing) + :str ; String utilities + :cl-json ; JSON parsing/serialization + :uuid) ; UUID generation for org-mode IDs + + :serial t ; Load files in order listed below + + :components ((:file "library/package") ; Package definitions, core vars + (:file "library/skills") ; Skill engine, cognitive tools + (:file "library/communication") ; Protocol, framing + (:file "library/communication-validator") ; Schema validation + (:file "library/memory") ; Org-object store, snapshots + (:file "library/context") ; Context assembly, query + (:file "library/perceive") ; Stage 1: Sensory normalization + (:file "library/reason") ; Stage 2: Neural + deterministic + (:file "library/act") ; Stage 3: Actuation + (:file "library/loop")) ; Main entry, heartbeat + :build-operation "program-op" :build-pathname "opencortex-server" :entry-point "opencortex:main") (defsystem :opencortex/tests - :depends-on (:opencortex :fiveam) - :components ((:file "tests/communication-tests") - (:file "tests/pipeline-tests") - (:file "tests/act-tests") - (:file "tests/boot-sequence-tests") - (:file "tests/memory-tests") - (:file "tests/immune-system-tests") - (:file "tests/emacs-edit-tests") - (:file "tests/lisp-utils-tests")) - :perform (test-op (o s) - (uiop:symbol-call :fiveam :run! :communication-protocol-suite) - (uiop:symbol-call :fiveam :run! :pipeline-suite) - (uiop:symbol-call :fiveam :run! :safety-suite) - (uiop:symbol-call :fiveam :run! :boot-suite) - (uiop:symbol-call :fiveam :run! :memory-suite) - (uiop:symbol-call :fiveam :run! :immune-suite) - (uiop:symbol-call :fiveam :run! :emacs-edit-suite) - (uiop:symbol-call :fiveam :run! :lisp-utils-suite))) + :depends-on (:opencortex ; The harness we're testing + :fiveam) ; Testing framework -(defsystem opencortex-test - :depends-on (:opencortex/tests) - :perform (test-op (o s) (asdf:test-system :opencortex/tests))) + :components ((:file "library/gen/org-skill-emacs-edit") + (:file "library/gen/org-skill-lisp-utils") + (:file "library/gen/org-skill-tool-permissions") + (:file "tests/communication-tests") + (:file "tests/pipeline-tests") + (:file "tests/act-tests") + (:file "tests/boot-sequence-tests") + (:file "tests/memory-tests") + (:file "tests/immune-system-tests") + (:file "tests/emacs-edit-tests") + (:file "tests/lisp-utils-tests")) + + :perform (test-op (o s) + (uiop:symbol-call :fiveam :run! + (uiop:find-symbol* :communication-protocol-suite :opencortex-tests)) + (uiop:symbol-call :fiveam :run! + (uiop:find-symbol* :pipeline-suite :opencortex-pipeline-tests)) + (uiop:symbol-call :fiveam :run! + (uiop:find-symbol* :boot-suite :opencortex-boot-tests)) + (uiop:symbol-call :fiveam :run! + (uiop:find-symbol* :memory-suite :opencortex-memory-tests)) + (uiop:symbol-call :fiveam :run! + (uiop:find-symbol* :immune-suite :opencortex-immune-system-tests)) + (uiop:symbol-call :fiveam :run! + (uiop:find-symbol* :emacs-edit-suite :opencortex-emacs-edit-tests)) + (uiop:symbol-call :fiveam :run! + (uiop:find-symbol* :lisp-utils-suite :opencortex-lisp-utils-tests)))) (defsystem :opencortex/tui - :depends-on (:opencortex :croatoan :usocket :bordeaux-threads) - :components ((:file "library/tui-client"))) \ No newline at end of file + :depends-on (:opencortex ; The daemon we're connecting to + :croatoan ; Terminal UI library + :usocket ; Socket communication + :bordeaux-threads) ; Background listening thread + + :components ((:file "library/tui-client"))) diff --git a/skills/org-skill-emacs-edit.org b/skills/org-skill-emacs-edit.org index 3bfce0c..eaa8814 100644 --- a/skills/org-skill-emacs-edit.org +++ b/skills/org-skill-emacs-edit.org @@ -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))) diff --git a/skills/org-skill-lisp-utils.org b/skills/org-skill-lisp-utils.org index 8ccb809..1ce1f13 100644 --- a/skills/org-skill-lisp-utils.org +++ b/skills/org-skill-lisp-utils.org @@ -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 diff --git a/skills/org-skill-llm-gateway.org b/skills/org-skill-llm-gateway.org index 6feef67..3302b38 100644 --- a/skills/org-skill-llm-gateway.org +++ b/skills/org-skill-llm-gateway.org @@ -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.") diff --git a/skills/org-skill-tool-permissions.org b/skills/org-skill-tool-permissions.org new file mode 100644 index 0000000..e71da72 --- /dev/null +++ b/skills/org-skill-tool-permissions.org @@ -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 \ No newline at end of file