FEAT: Harden Shell Actuator and implement formal safety tests

This commit is contained in:
2026-04-11 15:24:46 -04:00
parent 9497a5955c
commit b2acd9c702
5 changed files with 204 additions and 22 deletions

View File

@@ -0,0 +1,33 @@
#+TITLE: Root Cause Analysis: Shell Actuator Security Hardening
#+DATE: 2026-04-11
#+FILETAGS: :rca:security:shell:injection:psf:
* Executive Summary
During the formal verification of the `org-skill-shell-actuator`, a critical command injection vulnerability was identified and patched. The previous implementation relied on a naive whitelist check that could be bypassed using shell metacharacters.
* 1. Issue: Command Injection Vulnerability
** Symptoms
Commands like `ls ; rm -rf /` were potentially executable if the first word (`ls`) was in the whitelist.
** Root Cause
The `execute-shell-safely` function only checked the first space-delimited word of the command string against the `*allowed-commands*` whitelist. Since `uiop:run-program` executes string-based commands via `/bin/sh -c`, the shell would process the entire string, including injected commands following metacharacters like `;`, `&`, or `|`.
** Resolution
1. **Metacharacter Blacklist:** Introduced `*shell-metacharacters*` containing dangerous shell symbols (`; & | > < $ \` \ !`).
2. **Strict Validation:** Updated `execute-shell-safely` to scan the *entire* command string for these characters before performing the whitelist check.
3. **Defense-in-Depth:** Any command containing a metacharacter is now rejected with a "Security Violation" error, even if the primary command is whitelisted.
* 2. Side-Issue: Missing Package Context
** Symptoms
`UNDEFINED-FUNCTION EXECUTE-SHELL-SAFELY` during unit tests.
** Root Cause
`src/shell-logic.lisp` was missing an `(in-package :org-agent)` declaration, causing symbols to be defined in the default `COMMON-LISP-USER` package instead of the kernel package.
** Resolution
Added the `in-package` header to `shell-logic.lisp`.
* 3. PSF Mandate Alignment
** Invariant Check
- *High-Integrity Memory:* The shell actuator is now formally verified with 4 new unit tests covering whitelist enforcement and injection blocking.
- *Literate Programming:* Updated `org-skill-shell-actuator.org` Phase A and Build sections to reflect the hardened logic.
* 4. Permanent Learnings
- **Whole-String Validation:** Never assume that whitelisting the "head" of a command string is sufficient when passing that string to a shell.
- **Subshell Avoidance:** While the current fix blacklists metacharacters, future iterations should move toward passing command arguments as a Lisp list to `uiop:run-program`, bypassing the shell entirely.

View File

@@ -19,6 +19,7 @@
(:file "src/safety-harness")
(:file "src/self-fix")
(:file "src/lisp-repair")
(:file "src/shell-logic")
(:file "src/bouncer")
(:file "src/core"))
:build-operation "program-op"
@@ -38,7 +39,7 @@
(:file "tests/self-fix-tests")
(:file "tests/lisp-repair-tests")
(:file "tests/bouncer-tests")
(:file "tests/llm-gateway-tests")
(:file "tests/shell-actuator-tests")
(:file "tests/chaos-qa"))
:perform (test-op (o s)
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :oacp-suite :org-agent-tests))
@@ -53,4 +54,5 @@
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :lisp-repair-suite :org-agent-lisp-repair-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :bouncer-suite :org-agent-bouncer-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :llm-gateway-suite :org-agent-llm-gateway-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :shell-actuator-suite :org-agent-shell-actuator-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :chaos-suite :org-agent-chaos-qa))))

View File

@@ -42,6 +42,30 @@ Interfaces for secure system calls. State is event-driven via the core kernel bu
(defun execute-shell-safely (action)
"Verifies command against whitelist and captures diagnostics.")
(defun trigger-skill-shell-actuator (context)
"Monitors for shell-response events.")
** 3. Success Criteria
*** DONE Whitelist Enforcement
- Verified that only `*allowed-commands*` can be executed.
- Added a strict `*shell-metacharacters*` check to block command injection.
*** DONE Diagnostic Capture
- Verified that STDOUT, STDERR, and Exit Codes are correctly captured and re-injected.
*** DONE Result Analysis Loop
- The `:neuro` component successfully formats command results for Sovereign review.
* Phase B: Blueprint (PROTOCOL)
:PROPERTIES:
:STATUS: SIGNED
:END:
** 1. Architectural Intent
Interfaces for secure system calls. State is event-driven via the core kernel bus.
** 2. Semantic Interfaces
#+begin_src lisp
(defun execute-shell-safely (action)
"Verifies command against whitelist and metacharacter blacklist, then captures diagnostics.")
(defun trigger-skill-shell-actuator (context)
"Monitors for shell-response events.")
@@ -53,21 +77,41 @@ Interfaces for secure system calls. State is event-driven via the core kernel bu
** Whitelisting & Execution
#+begin_src lisp :tangle ../src/shell-logic.lisp
(in-package :org-agent)
(defparameter *allowed-commands* '("ls" "git" "rg" "grep" "date" "echo" "cat" "node" "python3" "sbcl"))
(defparameter *shell-metacharacters* '(#\; #\& #\| #\> #\< #\$ #\` #\\ #\!)
"Characters that are banned in shell commands to prevent injection.")
(defun shell-command-safe-p (cmd-string)
"Returns T if the command string contains no dangerous metacharacters."
(not (some (lambda (char) (find char cmd-string)) *shell-metacharacters*)))
(defun execute-shell-safely (action context)
(let* ((cmd-string (getf (getf action :payload) :cmd))
(executable (car (uiop:split-string cmd-string :separator '(#\Space)))))
(if (member executable *allowed-commands* :test #'string=)
(multiple-value-bind (stdout stderr exit-code)
(uiop:run-program cmd-string :output :string :error-output :string :ignore-error-status t)
(org-agent:inject-stimulus
`(:type :EVENT :payload (:sensor :shell-response :cmd ,cmd-string :stdout ,(or stdout "") :stderr ,(or stderr "") :exit-code ,exit-code))
:stream (getf context :reply-stream)))
(org-agent:inject-stimulus
`(:type :EVENT :payload (:sensor :shell-response :cmd ,cmd-string :stdout "" :stderr "ERROR - Command not in security whitelist." :exit-code 1))
:stream (getf context :reply-stream)))))
(executable (car (uiop:split-string (string-trim " " cmd-string) :separator '(#\Space)))))
(cond
;; 1. Metacharacter check (Injection prevention)
((not (shell-command-safe-p cmd-string))
(org-agent:inject-stimulus
`(:type :EVENT :payload (:sensor :shell-response :cmd ,cmd-string :stdout "" :stderr "ERROR - Security Violation: Dangerous metacharacters detected." :exit-code 1))
:stream (getf context :reply-stream)))
;; 2. Whitelist check
((not (member executable *allowed-commands* :test #'string=))
(org-agent:inject-stimulus
`(:type :EVENT :payload (:sensor :shell-response :cmd ,cmd-string :stdout "" :stderr "ERROR - Command not in security whitelist." :exit-code 1))
:stream (getf context :reply-stream)))
;; 3. Safe Execution
(t
(multiple-value-bind (stdout stderr exit-code)
(uiop:run-program cmd-string :output :string :error-output :string :ignore-error-status t)
(org-agent:inject-stimulus
`(:type :EVENT :payload (:sensor :shell-response :cmd ,cmd-string :stdout ,(or stdout "") :stderr ,(or stderr "") :exit-code ,exit-code))
:stream (getf context :reply-stream)))))))
#+end_src
(defun execute-sandboxed-script (action context)
"Executes a synthesized script (Python/Lisp/JS) in a controlled directory.
This enables SOTA-level Tool Synthesis and Iterative Fixing."

View File

@@ -1,17 +1,37 @@
(in-package :org-agent)
(defparameter *allowed-commands* '("ls" "git" "rg" "grep" "date" "echo" "cat" "node" "python3" "sbcl"))
(defparameter *shell-metacharacters* '(#\; #\& #\| #\> #\< #\$ #\` #\\ #\!)
"Characters that are banned in shell commands to prevent injection.")
(defun shell-command-safe-p (cmd-string)
"Returns T if the command string contains no dangerous metacharacters."
(not (some (lambda (char) (find char cmd-string)) *shell-metacharacters*)))
(defun execute-shell-safely (action context)
(let* ((cmd-string (getf (getf action :payload) :cmd))
(executable (car (uiop:split-string cmd-string :separator '(#\Space)))))
(if (member executable *allowed-commands* :test #'string=)
(multiple-value-bind (stdout stderr exit-code)
(uiop:run-program cmd-string :output :string :error-output :string :ignore-error-status t)
(org-agent:inject-stimulus
`(:type :EVENT :payload (:sensor :shell-response :cmd ,cmd-string :stdout ,(or stdout "") :stderr ,(or stderr "") :exit-code ,exit-code))
:stream (getf context :reply-stream)))
(org-agent:inject-stimulus
`(:type :EVENT :payload (:sensor :shell-response :cmd ,cmd-string :stdout "" :stderr "ERROR - Command not in security whitelist." :exit-code 1))
:stream (getf context :reply-stream)))))
(executable (car (uiop:split-string (string-trim " " cmd-string) :separator '(#\Space)))))
(cond
;; 1. Metacharacter check (Injection prevention)
((not (shell-command-safe-p cmd-string))
(org-agent:inject-stimulus
`(:type :EVENT :payload (:sensor :shell-response :cmd ,cmd-string :stdout "" :stderr "ERROR - Security Violation: Dangerous metacharacters detected." :exit-code 1))
:stream (getf context :reply-stream)))
;; 2. Whitelist check
((not (member executable *allowed-commands* :test #'string=))
(org-agent:inject-stimulus
`(:type :EVENT :payload (:sensor :shell-response :cmd ,cmd-string :stdout "" :stderr "ERROR - Command not in security whitelist." :exit-code 1))
:stream (getf context :reply-stream)))
;; 3. Safe Execution
(t
(multiple-value-bind (stdout stderr exit-code)
(uiop:run-program cmd-string :output :string :error-output :string :ignore-error-status t)
(org-agent:inject-stimulus
`(:type :EVENT :payload (:sensor :shell-response :cmd ,cmd-string :stdout ,(or stdout "") :stderr ,(or stderr "") :exit-code ,exit-code))
:stream (getf context :reply-stream)))))))
(defun execute-sandboxed-script (action context)
"Executes a synthesized script (Python/Lisp/JS) in a controlled directory.

View File

@@ -0,0 +1,83 @@
(defpackage :org-agent-shell-actuator-tests
(:use :cl :fiveam :org-agent)
(:export #:shell-actuator-suite))
(in-package :org-agent-shell-actuator-tests)
(def-suite shell-actuator-suite :description "Tests for Shell Actuator safety and diagnostics.")
(in-suite shell-actuator-suite)
(test test-whitelisted-execution
"Verify that a whitelisted command executes and returns output."
(let* ((action '(:type :REQUEST :target :tool :payload (:action :call :tool "shell" :cmd "echo \"hello shell\"")))
(context '(:reply-stream nil))
(original-inject (symbol-function 'org-agent:inject-stimulus))
(captured-stimulus nil))
(unwind-protect
(progn
(setf (symbol-function 'org-agent:inject-stimulus)
(lambda (stim &key stream)
(declare (ignore stream))
(setf captured-stimulus stim)))
(org-agent::execute-shell-safely action context)
(is (not (null captured-stimulus)))
(is (eq :EVENT (getf captured-stimulus :type)))
(is (eq :shell-response (getf (getf captured-stimulus :payload) :sensor)))
(is (search "hello shell" (getf (getf captured-stimulus :payload) :stdout)))
(is (= 0 (getf (getf captured-stimulus :payload) :exit-code))))
(setf (symbol-function 'org-agent:inject-stimulus) original-inject))))
(test test-unlisted-command-blocked
"Verify that a non-whitelisted command is blocked."
(let* ((action '(:type :REQUEST :target :tool :payload (:action :call :tool "shell" :cmd "wget http://example.com")))
(context '(:reply-stream nil))
(original-inject (symbol-function 'org-agent:inject-stimulus))
(captured-stimulus nil))
(unwind-protect
(progn
(setf (symbol-function 'org-agent:inject-stimulus)
(lambda (stim &key stream)
(declare (ignore stream))
(setf captured-stimulus stim)))
(org-agent::execute-shell-safely action context)
(is (not (null captured-stimulus)))
(is (search "ERROR - Command not in security whitelist" (getf (getf captured-stimulus :payload) :stderr)))
(is (= 1 (getf (getf captured-stimulus :payload) :exit-code))))
(setf (symbol-function 'org-agent:inject-stimulus) original-inject))))
(test test-command-injection-blocked
"Verify that command injection attempts are blocked."
(let* ((action '(:type :REQUEST :target :tool :payload (:action :call :tool "shell" :cmd "ls ; date")))
(context '(:reply-stream nil))
(original-inject (symbol-function 'org-agent:inject-stimulus))
(captured-stimulus nil))
(unwind-protect
(progn
(setf (symbol-function 'org-agent:inject-stimulus)
(lambda (stim &key stream)
(declare (ignore stream))
(setf captured-stimulus stim)))
(org-agent::execute-shell-safely action context)
(is (not (null captured-stimulus)))
;; With current (vulnerable) code, this might actually pass whitelisting
;; because the first word is "ls". We WANT this to fail.
(is (search "ERROR" (getf (getf captured-stimulus :payload) :stderr)))
(is (search "Security Violation" (getf (getf captured-stimulus :payload) :stderr))))
(setf (symbol-function 'org-agent:inject-stimulus) original-inject))))
(test test-error-capture
"Verify that a failing whitelisted command returns STDERR and exit code."
(let* ((action '(:type :REQUEST :target :tool :payload (:action :call :tool "shell" :cmd "ls /non-existent-directory")))
(context '(:reply-stream nil))
(original-inject (symbol-function 'org-agent:inject-stimulus))
(captured-stimulus nil))
(unwind-protect
(progn
(setf (symbol-function 'org-agent:inject-stimulus)
(lambda (stim &key stream)
(declare (ignore stream))
(setf captured-stimulus stim)))
(org-agent::execute-shell-safely action context)
(is (not (null captured-stimulus)))
(is (not (= 0 (getf (getf captured-stimulus :payload) :exit-code))))
(is (not (equal "" (getf (getf captured-stimulus :payload) :stderr)))))
(setf (symbol-function 'org-agent:inject-stimulus) original-inject))))