REFACTOR: Explanatory Core Architecture & Terminology Alignment
This commit is contained in:
183
skills/org-skill-lisp-validator.org
Normal file
183
skills/org-skill-lisp-validator.org
Normal file
@@ -0,0 +1,183 @@
|
||||
:PROPERTIES:
|
||||
:ID: 98576df2-c496-4e4a-9acb-0bca514a0305
|
||||
:CREATED: [2026-03-31 Tue 18:28]
|
||||
:EDITED: [2026-04-09 Thu]
|
||||
:END:
|
||||
#+TITLE: SKILL: Lisp Validator
|
||||
#+STARTUP: content
|
||||
#+FILETAGS: :security:lisp:ast:psf:
|
||||
|
||||
* Overview
|
||||
The *Lisp Validator* is the primary structural gate for the Neurosymbolic Lisp Machine. It provides a recursive AST validator that subjects all Lisp proposals from the Probabilistic Engine to a strict "Deny-by-Default" sandbox.
|
||||
|
||||
* Phase A: Demand (PRD)
|
||||
:PROPERTIES:
|
||||
:STATUS: FROZEN
|
||||
:END:
|
||||
|
||||
** 1. Purpose
|
||||
Define a high-integrity, recursive security sandbox for Lisp execution.
|
||||
|
||||
** 2. User Needs
|
||||
- *Recursive Validation:* Every nested function call and variable access MUST be checked.
|
||||
- *Deny-by-Default:* Only explicitly whitelisted functions and variables are permitted.
|
||||
- *Eval Protection:* Block all forms of `eval`, `load`, or dynamic execution.
|
||||
- *Symbolic Preemption:* This skill acts as a mandatory global Deterministic Engine check.
|
||||
|
||||
** 3. Success Criteria
|
||||
*** DONE Implement recursive AST walker in Lisp
|
||||
*** DONE Establish strict function whitelist (surgical Org operations)
|
||||
*** DONE Detect and block nested 'eval' attempts
|
||||
*** DONE Verify that malformed or malicious sexps are rejected
|
||||
|
||||
* Implementation
|
||||
|
||||
** Package
|
||||
#+begin_src lisp :tangle ../src/lisp-validator.lisp
|
||||
(in-package :org-agent)
|
||||
#+end_src
|
||||
|
||||
** Whitelist Definition
|
||||
#+begin_src lisp :tangle ../src/lisp-validator.lisp
|
||||
(defparameter *lisp-validator-whitelist*
|
||||
'(;; Math & Logic
|
||||
+ - * / = < > <= >= 1+ 1- min max
|
||||
and or not null eq eql equal string= string-equal
|
||||
;; List Manipulation
|
||||
list cons car cdr cadr cddr cdar caar append mapcar remove-if remove-if-not
|
||||
length reverse sort nth nthcdr push pop
|
||||
;; Plists and Hash Tables
|
||||
getf gethash
|
||||
;; Control Flow
|
||||
let let* if cond when unless case typecase
|
||||
;; Strings
|
||||
format concatenate string-downcase string-upcase search
|
||||
;; Kernel specifics
|
||||
org-agent::harness-log
|
||||
org-agent::snapshot-object-store
|
||||
org-agent::rollback-object-store
|
||||
org-agent::lookup-object
|
||||
org-agent::list-objects-by-type
|
||||
org-agent::ingest-ast
|
||||
org-agent::find-headline-missing-id
|
||||
org-agent::context-query-store
|
||||
org-agent::context-get-active-projects
|
||||
org-agent::context-get-recent-completed-tasks
|
||||
org-agent::context-list-all-skills
|
||||
org-agent::context-get-system-logs
|
||||
org-agent::context-assemble-global-awareness
|
||||
org-agent::org-object-id
|
||||
org-agent::org-object-type
|
||||
org-agent::org-object-attributes
|
||||
org-agent::org-object-content
|
||||
org-agent::org-object-parent-id
|
||||
org-agent::org-object-children
|
||||
org-agent::org-object-version
|
||||
org-agent::org-object-last-sync
|
||||
org-agent::org-object-hash
|
||||
;; Essential macros
|
||||
declare ignore
|
||||
;; Let's also add simple data types
|
||||
t nil quote function))
|
||||
#+end_src
|
||||
|
||||
** Dynamic Symbol Registration
|
||||
We allow other skills to register safe symbols for the validator.
|
||||
|
||||
#+begin_src lisp :tangle ../src/lisp-validator.lisp
|
||||
(defvar *lisp-validator-registry* nil
|
||||
"List of dynamically registered safe symbols.")
|
||||
|
||||
(defun lisp-validator-register (symbols)
|
||||
"Adds symbols to the global validator registry."
|
||||
(setf *lisp-validator-registry* (append *lisp-validator-registry* (if (listp symbols) symbols (list symbols))))
|
||||
(harness-log "LISP VALIDATOR: Registered ~a new safe symbols." (length (if (listp symbols) symbols (list symbols)))))
|
||||
|
||||
(defun lisp-validator-is-safe (symbol)
|
||||
"Checks if a symbol is in the static whitelist or the dynamic registry."
|
||||
(or (member symbol *lisp-validator-whitelist* :test #'string-equal)
|
||||
(member symbol *lisp-validator-registry* :test #'string-equal)))
|
||||
#+end_src
|
||||
|
||||
** Recursive AST Walker
|
||||
#+begin_src lisp :tangle ../src/lisp-validator.lisp
|
||||
(defun lisp-validator-ast-walk (form)
|
||||
"Recursively walks the Lisp AST. Returns T if safe, NIL if unsafe."
|
||||
(cond
|
||||
;; Self-evaluating objects (strings, numbers, keywords) are safe.
|
||||
((or (stringp form) (numberp form) (keywordp form) (characterp form))
|
||||
t)
|
||||
;; Symbols used as variables (in non-function position)
|
||||
((symbolp form)
|
||||
(lisp-validator-is-safe form))
|
||||
;; Lists represent function calls or special forms.
|
||||
((listp form)
|
||||
(let ((head (car form)))
|
||||
(cond
|
||||
((eq head 'quote) t)
|
||||
((not (symbolp head)) nil)
|
||||
((lisp-validator-is-safe head)
|
||||
(every #'lisp-validator-ast-walk (cdr form)))
|
||||
(t
|
||||
(harness-log "LISP VALIDATOR: Blocked call to non-whitelisted function ~a" head)
|
||||
nil))))
|
||||
(t nil)))
|
||||
#+end_src
|
||||
|
||||
** Cognitive Tools
|
||||
#+begin_src lisp :tangle ../src/lisp-validator.lisp
|
||||
(org-agent:def-cognitive-tool :lisp-validator-status "Returns validator-related telemetry, including blocked actions and harness status."
|
||||
nil
|
||||
:body (lambda (args)
|
||||
(declare (ignore args))
|
||||
(format nil "LISP VALIDATOR STATUS:
|
||||
- Static Whitelist: ~a symbols
|
||||
- Dynamic Registry: ~a symbols
|
||||
- Total Blocked Actions: ~a"
|
||||
(length *lisp-validator-whitelist*)
|
||||
(length *lisp-validator-registry*)
|
||||
"Not implemented")))
|
||||
#+end_src
|
||||
|
||||
** Skill Definition
|
||||
#+begin_src lisp :tangle ../src/lisp-validator.lisp
|
||||
(org-agent:defskill :skill-lisp-validator
|
||||
:priority 900 ; High priority, before most skills
|
||||
:trigger (lambda (ctx)
|
||||
;; Check if any proposed action is an :eval or :shell call
|
||||
(let ((candidate (getf ctx :candidate)))
|
||||
(when candidate
|
||||
(let ((payload (getf candidate :payload)))
|
||||
(member (getf payload :action) '(:eval :shell))))))
|
||||
:neuro nil ; Purely deterministic/safety skill
|
||||
:symbolic (lambda (action context)
|
||||
(harness-log "DETERMINISTIC ENGINE [Lisp-Validator]: Intercepted critical action for structural validation.")
|
||||
action))
|
||||
#+end_src
|
||||
|
||||
|
||||
* Phase E: Chaos (Verification)
|
||||
#+begin_src lisp :tangle ../tests/lisp-validator-tests.lisp
|
||||
(defpackage :org-agent-lisp-validator-tests
|
||||
(:use :cl :fiveam :org-agent)
|
||||
(:export #:lisp-validator-suite))
|
||||
(in-package :org-agent-lisp-validator-tests)
|
||||
|
||||
(def-suite lisp-validator-suite :description "Tests for the Lisp Validator.")
|
||||
(in-suite lisp-validator-suite)
|
||||
|
||||
(test test-basic-math-safe
|
||||
(is (org-agent:lisp-validator-validate "(+ 1 2)")))
|
||||
|
||||
(test test-blocked-eval
|
||||
(is (not (org-agent:lisp-validator-validate "(eval '(+ 1 2))"))))
|
||||
|
||||
(test test-blocked-shell
|
||||
(is (not (org-agent:lisp-validator-validate "(uiop:run-program \"ls\")"))))
|
||||
|
||||
(test test-nested-unsafe
|
||||
(is (not (org-agent:lisp-validator-validate "(let ((x 1)) (delete-file \"test.txt\"))"))))
|
||||
|
||||
(test test-safe-kernel-api
|
||||
(is (org-agent:lisp-validator-validate "(org-agent::lookup-object \"node-1\")")))
|
||||
#+end_src
|
||||
Reference in New Issue
Block a user