security: bound Lisp callbacks, native comparisons, and local file reads (CWE-400, CWE-407) (#1842)

* security: bound Lisp callbacks, native comparisons, and local file reads (CWE-400, CWE-407)

The command and scripting engine had several unbounded paths a supplied LISP
routine or a selected path could exploit to monopolise the thread or exhaust
memory:

- `call_sync` ran synchronous callbacks (vl-sort comparators, vl-remove-if
  predicates, …) with `u64::MAX` fuel, so a constant-memory infinite loop never
  yielded and bypassed the blocking execution cap. It now drives the callback in
  bounded slices and aborts with an error past a hard step cap (row 2).
- `wcmatch`/`glob` explored `*` placements with only a recursion-depth guard,
  and `equal` re-traversed shared cons subtrees. Both now charge every step
  against a shared work budget and stop when it is exhausted (row 33).
- `setvar` converted a LISP value to JSON unboundedly, so a shared cons DAG
  expanded into gigabytes of owned arrays. Conversion is now depth- and
  element-bounded and rejects over-budget values with a LISP error (row 39).
- OPEN/LOAD/APPLOAD (`read_text_file`), SCRIPT, and native open (`read_file`,
  `run_open`) buffered a path with `std::fs::read`, so an endless device
  exhausted memory before any size check. Reads now go through a new
  `capped_read` helper that rejects non-regular files and caps bytes
  (rows 21, 34).

New tests cover the callback loop, the oversized setvar structure, and the
capped reader. Addresses findings rows 2, 21, 33, 34, 39.

* fix: bound native Lisp scans and nonblocking file reads

* fix: enforce callback fuel before each execution slice

---------

Co-authored-by: skylartaylor <26588250+skylartaylor@users.noreply.github.com>

Cargo.lock

@@ -637,6 +637,7 @@ dependencies = [
  "cadcraft-io",
  "cadcraft-render",
  "craft-docpath",
+ "libc",
  "log",
  "rstar",
  "serde",

crates/engine/Cargo.toml

@@ -24,6 +24,9 @@ log = { workspace = true }
 # R-tree spatial index for picking, window selection and object snaps (MIT OR Apache-2.0).
 rstar = { version = "0.12", default-features = false }
 
+[target.'cfg(unix)'.dependencies]
+libc = "0.2"
+
 [dev-dependencies]
 # Real DXF files for the external reference tests (io is a lower layer).
 cadcraft-io = { workspace = true }

crates/engine/src/capped_read.rs

@@ -0,0 +1,81 @@
+//! Bounded reads of local files.
+//!
+//! Reading a path with [`std::fs::read`] buffers until EOF, so a path naming an endless readable
+//! device (for example `/dev/urandom` or a FIFO) exhausts process memory before any size check
+//! runs (CWE-400). [`read_capped`] opens the path once, refuses anything that is not a regular
+//! file, and reads through a reader limited to `max + 1` bytes so oversized input is rejected
+//! before it is fully buffered.
+
+#![cfg(not(target_arch = "wasm32"))]
+
+use std::fs::OpenOptions;
+use std::io::{self, Read};
+use std::path::Path;
+
+/// Read at most `max` bytes from the regular file at `path`.
+///
+/// Returns an error if the path is not a regular file, cannot be opened, or holds more than `max`
+/// bytes. At most `max + 1` bytes are ever buffered, so an endless device cannot exhaust memory.
+pub fn read_capped(path: &Path, max: usize) -> io::Result<Vec<u8>> {
+    let mut options = OpenOptions::new();
+    options.read(true);
+    #[cfg(unix)]
+    {
+        use std::os::unix::fs::OpenOptionsExt;
+        options.custom_flags(libc::O_NONBLOCK);
+    }
+    let file = options.open(path)?;
+    let meta = file.metadata()?;
+    if !meta.is_file() {
+        return Err(io::Error::new(io::ErrorKind::InvalidInput, "not a regular file"));
+    }
+    // Read one byte past the limit so we can tell "exactly max" from "too big" without trusting
+    // the metadata length (which a device may misreport).
+    let mut buf = Vec::new();
+    let cap = (max as u64).saturating_add(1);
+    let read = file.take(cap).read_to_end(&mut buf)?;
+    if read as u64 > max as u64 {
+        return Err(io::Error::new(io::ErrorKind::InvalidData, format!("file is larger than the {max}-byte limit")));
+    }
+    Ok(buf)
+}
+
+#[cfg(test)]
+mod tests {
+    use super::*;
+
+    #[test]
+    fn reads_within_limit_and_rejects_oversize() {
+        let dir = std::env::temp_dir().join(format!("cadcraft-cr-{}", std::process::id()));
+        std::fs::create_dir_all(&dir).unwrap();
+        let p = dir.join("f.bin");
+        std::fs::write(&p, vec![7u8; 100]).unwrap();
+        assert_eq!(read_capped(&p, 100).unwrap().len(), 100);
+        assert_eq!(read_capped(&p, 200).unwrap().len(), 100);
+        assert!(read_capped(&p, 99).is_err());
+        assert_eq!(read_capped(&p, usize::MAX).unwrap().len(), 100);
+        std::fs::remove_dir_all(&dir).ok();
+    }
+
+    #[cfg(unix)]
+    #[test]
+    fn rejects_non_regular_file() {
+        // /dev/zero is an endless readable device; it must be rejected, not buffered.
+        let p = Path::new("/dev/zero");
+        if p.exists() {
+            assert!(read_capped(p, 8 << 20).is_err());
+        }
+    }
+    #[cfg(unix)]
+    #[test]
+    fn rejects_fifo_without_a_writer() {
+        let dir = std::env::temp_dir().join(format!("cadcraft-cr-fifo-{}", std::process::id()));
+        std::fs::create_dir_all(&dir).unwrap();
+        let fifo = dir.join("pipe");
+        assert!(std::process::Command::new("mkfifo").arg(&fifo).status().unwrap().success());
+        let started = std::time::Instant::now();
+        assert_eq!(read_capped(&fifo, 1024).unwrap_err().kind(), io::ErrorKind::InvalidInput);
+        assert!(started.elapsed() < std::time::Duration::from_secs(2));
+        std::fs::remove_dir_all(dir).unwrap();
+    }
+}

crates/engine/src/cmd/file.rs

@@ -19,6 +19,15 @@ pub use pgp::{MAX_ALIASES, alias_name, command_id};
 pub(crate) use pgp::{specs as alias_specs, user_alias};
 pub use template::{qnew_template, set_qnew_template};
 
+/// Largest drawing accepted from a local path, matching the per-file xref limit. A path naming an
+/// endless device must be rejected before it exhausts memory (CWE-400), so native opens read
+/// through [`crate::capped_read`] rather than buffering to EOF.
+#[cfg(not(target_arch = "wasm32"))]
+const MAX_DRAWING_BYTES: usize = 512 << 20;
+/// Largest `.scr` script accepted from a local path.
+#[cfg(not(target_arch = "wasm32"))]
+const MAX_SCRIPT_BYTES: usize = 64 << 20;
+
 /// Plot a space to PDF bytes with JSON options (`{paper?, landscape?, fit?, lineweights?, …}`).
 pub type PlotHook = fn(&Drawing, &cadcraft_doc::Space, &Value) -> std::result::Result<Vec<u8>, String>;
 
@@ -192,7 +201,8 @@ fn run_script(s: &mut Session, p: &Value) -> Result<Value> {
         let path = _path;
         #[cfg(not(target_arch = "wasm32"))]
         {
-            let bytes = std::fs::read(path).map_err(|e| bad("script", format!("{path}: {e}")))?;
+            let bytes =
+                crate::capped_read::read_capped(std::path::Path::new(path), MAX_SCRIPT_BYTES).map_err(|e| bad("script", format!("{path}: {e}")))?;
             String::from_utf8_lossy(&bytes).into_owned()
         }
         #[cfg(target_arch = "wasm32")]
@@ -265,7 +275,8 @@ pub fn read_file(path: &str) -> std::result::Result<ReadFile, String> {
     #[cfg(not(target_arch = "wasm32"))]
     {
         let r = std::panic::catch_unwind(|| {
-            let bytes = std::fs::read(path).map_err(|e| bad("open", format!("{path}: {e}")))?;
+            let bytes =
+                crate::capped_read::read_capped(std::path::Path::new(path), MAX_DRAWING_BYTES).map_err(|e| bad("open", format!("{path}: {e}")))?;
             read_bytes(&bytes, path, Some(path.to_string()))
         });
         match r {
@@ -332,7 +343,8 @@ fn run_open(s: &mut Session, p: &Value) -> Result<Value> {
         let path = _path;
         #[cfg(not(target_arch = "wasm32"))]
         {
-            let bytes = std::fs::read(path).map_err(|e| bad("open", format!("{path}: {e}")))?;
+            let bytes =
+                crate::capped_read::read_capped(std::path::Path::new(path), MAX_DRAWING_BYTES).map_err(|e| bad("open", format!("{path}: {e}")))?;
             let i = open_bytes(s, &bytes, path, Some(path.to_string()))?;
             super::blocks::xref::after_open(s, i);
             return Ok(opened(s, i, true));

crates/engine/src/lib.rs

@@ -14,6 +14,8 @@ pub mod atomic_write;
 pub mod audit;
 pub mod autosave;
 pub mod blockedit;
+#[cfg(not(target_arch = "wasm32"))]
+pub mod capped_read;
 pub mod cmd;
 pub mod doc_path;
 mod finite;

crates/engine/src/lisp/builtins.rs

@@ -679,19 +679,44 @@ fn wcmatch(a: &[Value]) -> R {
     arity(a, 2, 2)?;
     let (s, pat) = (string(&a[0])?, string(&a[1])?);
     let text: Vec<char> = s.chars().collect();
-    Ok(Value::bool(split_patterns(&pat).iter().any(|p| match_pattern(&text, p))))
+    // Native wildcard matching runs as a single interpreter step, so its internal `*` backtracking
+    // must not explore exponentially many placements unchecked (CWE-400). Charge every glob step
+    // against a shared budget and fail the call if it is exhausted.
+    let mut budget: u64 = WCMATCH_BUDGET;
+    for p in split_patterns(&pat, &mut budget).map_err(|()| LispError::new("wcmatch: pattern too complex"))? {
+        match match_pattern(&text, &p, &mut budget) {
+            Ok(true) => return Ok(Value::bool(true)),
+            Ok(false) => {}
+            Err(()) => return Err(LispError::new("wcmatch: pattern too complex")),
+        }
+    }
+    Ok(Value::bool(false))
 }
 
-fn split_patterns(pat: &str) -> Vec<Vec<char>> {
+/// Shared step budget for one `wcmatch` call's wildcard matching. Large enough for the patterns
+/// AutoLISP routines legitimately use (including the pathological-but-bounded cases the tests
+/// cover), but finite so truly exponential `*`-heavy patterns are rejected rather than hanging.
+const WCMATCH_BUDGET: u64 = 200_000_000;
+
+fn charge_match(budget: &mut u64) -> Result<(), ()> {
+    *budget = budget.checked_sub(1).ok_or(())?;
+    Ok(())
+}
+
+fn split_patterns(pat: &str, budget: &mut u64) -> Result<Vec<Vec<char>>, ()> {
     let mut out = vec![Vec::new()];
     let mut chars = pat.chars().peekable();
     let mut in_set = false;
     while let Some(c) = chars.next() {
+        charge_match(budget)?;
         match c {
             '`' => {
                 if let Some(cur) = out.last_mut() {
                     cur.push('`');
-                    cur.extend(chars.next());
+                    if let Some(escaped) = chars.next() {
+                        charge_match(budget)?;
+                        cur.push(escaped);
+                    }
                 }
             }
             '[' => {
@@ -714,41 +739,93 @@ fn split_patterns(pat: &str) -> Vec<Vec<char>> {
             }
         }
     }
-    out
+    Ok(out)
 }
 
-fn match_pattern(text: &[char], pat: &[char]) -> bool {
+fn match_pattern(text: &[char], pat: &[char], budget: &mut u64) -> Result<bool, ()> {
     if let Some(('~', rest)) = pat.split_first().map(|(c, r)| (*c, r))
         && !rest.is_empty()
     {
-        return !glob(text, rest, 0);
+        return glob(text, rest, 0, budget).map(|m| !m);
     }
-    glob(text, pat, 0)
+    glob(text, pat, 0, budget)
 }
 
-/// Iterative-enough glob with `*` backtracking; `depth` bounds the recursion on `*`.
+/// Iterative-enough glob with `*` backtracking; `depth` bounds the recursion on `*`. Every step is
-fn glob(text: &[char], pat: &[char], depth: usize) -> bool {
+/// charged against `budget`; `Err(())` means the shared budget ran out (treated as too complex).
+fn glob(text: &[char], pat: &[char], depth: usize, budget: &mut u64) -> Result<bool, ()> {
+    glob_cached(text, pat, depth, budget, &mut std::collections::HashSet::new())
+}
+
+fn glob_cached(
+    text: &[char],
+    pat: &[char],
+    depth: usize,
+    budget: &mut u64,
+    failed: &mut std::collections::HashSet<(usize, usize, usize)>,
+) -> Result<bool, ()> {
+    charge_match(budget)?;
+    let key = (text.len(), pat.len(), depth);
+    if failed.contains(&key) {
+        return Ok(false);
+    }
+    let matched = glob_inner(text, pat, depth, budget, failed)?;
+    // Avoid revisiting the same failed suffix exponentially. Bound the memo table independently
+    // of the step limit so a very large pattern cannot turn the optimization into an allocation bomb.
+    if !matched && failed.len() < 100_000 {
+        failed.insert(key);
+    }
+    Ok(matched)
+}
+
+fn glob_inner(
+    text: &[char],
+    pat: &[char],
+    depth: usize,
+    budget: &mut u64,
+    failed: &mut std::collections::HashSet<(usize, usize, usize)>,
+) -> Result<bool, ()> {
+    if *budget == 0 {
+        return Err(());
+    }
+    *budget -= 1;
     if depth > 64 {
-        return false;
+        return Ok(false);
     }
     let (mut t, mut p) = (0usize, 0usize);
     while p < pat.len() {
+        charge_match(budget)?;
         match pat[p] {
             '*' => {
                 let rest = &pat[p + 1..];
-                return (t..=text.len()).any(|i| glob(&text[i..], rest, depth + 1));
+                for i in t..=text.len() {
+                    if glob_cached(&text[i..], rest, depth + 1, budget, failed)? {
+                        return Ok(true);
+                    }
+                }
+                return Ok(false);
             }
             '`' => {
-                let Some(&lit) = pat.get(p + 1) else { return false };
+                let Some(&lit) = pat.get(p + 1) else { return Ok(false) };
                 if text.get(t) != Some(&lit) {
-                    return false;
+                    return Ok(false);
                 }
                 t += 1;
                 p += 2;
             }
             '[' => {
-                let Some(close) = pat[p..].iter().position(|c| *c == ']').map(|i| p + i) else { return false };
+                let mut close = p;
-                let Some(&c) = text.get(t) else { return false };
+                while let Some(c) = pat.get(close) {
+                    charge_match(budget)?;
+                    if *c == ']' {
+                        break;
+                    }
+                    close += 1;
+                }
+                if close == pat.len() {
+                    return Ok(false);
+                }
+                let Some(&c) = text.get(t) else { return Ok(false) };
                 let set = &pat[p + 1..close];
                 let (neg, set) = match set.split_first() {
                     Some(('~', r)) if !r.is_empty() => (true, r),
@@ -757,6 +834,7 @@ fn glob(text: &[char], pat: &[char], depth: usize) -> bool {
                 let mut hit = false;
                 let mut i = 0;
                 while i < set.len() {
+                    charge_match(budget)?;
                     if set.get(i + 1) == Some(&'-') && i + 2 < set.len() {
                         if set[i] <= c && c <= set[i + 2] {
                             hit = true;
@@ -770,13 +848,13 @@ fn glob(text: &[char], pat: &[char], depth: usize) -> bool {
                     }
                 }
                 if hit == neg {
-                    return false;
+                    return Ok(false);
                 }
                 t += 1;
                 p = close + 1;
             }
             pc => {
-                let Some(&c) = text.get(t) else { return false };
+                let Some(&c) = text.get(t) else { return Ok(false) };
                 let ok = match pc {
                     '#' => c.is_ascii_digit(),
                     '@' => c.is_alphabetic(),
@@ -785,14 +863,14 @@ fn glob(text: &[char], pat: &[char], depth: usize) -> bool {
                     other => other == c,
                 };
                 if !ok {
-                    return false;
+                    return Ok(false);
                 }
                 t += 1;
                 p += 1;
             }
         }
     }
-    t == text.len()
+    Ok(t == text.len())
 }
 
 // ---------------- geometry ----------------
@@ -984,11 +1062,10 @@ fn findfile(a: &[Value]) -> R {
 
 #[cfg(not(target_arch = "wasm32"))]
 pub fn read_text_file(path: &str) -> Option<String> {
-    let bytes = std::fs::read(path).ok()?;
+    // Read through a byte-limited, regular-file-only reader so a path naming an endless device
-    // Cap what a routine can pull into memory.
+    // cannot exhaust memory before the 64 MiB cap is enforced (CWE-400).
-    if bytes.len() > 64 * 1024 * 1024 {
+    const MAX: usize = 64 * 1024 * 1024;
-        return None;
+    let bytes = crate::capped_read::read_capped(std::path::Path::new(path), MAX).ok()?;
-    }
     Some(String::from_utf8_lossy(&bytes).into_owned())
 }
 #[cfg(target_arch = "wasm32")]
@@ -1503,5 +1580,24 @@ pub fn real(r: f64) -> String {
 /// `wcmatch` for other callers (`ssget` filters).
 pub fn wild_match(text: &str, pattern: &str) -> bool {
     let t: Vec<char> = text.chars().collect();
-    split_patterns(pattern).iter().any(|p| match_pattern(&t, p))
+    let mut budget: u64 = WCMATCH_BUDGET;
+    split_patterns(pattern, &mut budget).is_ok_and(|patterns| patterns.iter().any(|p| match_pattern(&t, p, &mut budget) == Ok(true)))
+}
+
+#[cfg(test)]
+mod wildcard_budget_tests {
+    use super::*;
+
+    #[test]
+    fn all_native_scans_consume_fuel() {
+        assert!(split_patterns("abcdefgh", &mut 4).is_err());
+        assert!(split_patterns("`a`b`c", &mut 4).is_err());
+        let text: Vec<_> = "abcdefgh".chars().collect();
+        assert!(glob(&text, &text, 0, &mut 4).is_err());
+        let pattern: Vec<_> = "[abcdefgh]".chars().collect();
+        assert!(glob(&['!'], &pattern, 0, &mut 6).is_err());
+        // Enough for finding the closing bracket, but not scanning the entire set again.
+        assert!(glob(&['!'], &pattern, 0, &mut 14).is_err());
+        assert_eq!(glob(&['a'], &pattern, 0, &mut 100), Ok(true));
+    }
 }

crates/engine/src/lisp/drawing.rs

@@ -151,16 +151,32 @@ pub fn from_json(v: &serde_json::Value) -> Value {
     }
 }
 
-/// A LISP value as JSON (for `setvar`).
+/// A LISP value as JSON (for `setvar`), bounded so a shared cons structure cannot expand into
-pub fn to_json(v: &Value) -> serde_json::Value {
+/// exponentially many owned array elements before the setter can reject it (CWE-400).
-    match v {
+///
+/// Largest number of elements it may expand, and the deepest nesting it follows.
+const TO_JSON_BUDGET: u64 = 2_000_000;
+const TO_JSON_MAX_DEPTH: usize = 256;
+
+fn to_json_bounded(v: &Value, depth: usize, budget: &mut u64) -> Option<serde_json::Value> {
+    if depth > TO_JSON_MAX_DEPTH || *budget == 0 {
+        return None;
+    }
+    *budget -= 1;
+    Some(match v {
         Value::Nil => serde_json::Value::Null,
         Value::Int(i) => serde_json::json!(i),
         Value::Real(r) => serde_json::json!(r),
         Value::Str(s) => serde_json::json!(&**s),
-        Value::Cons(_) => serde_json::Value::Array(v.iter().map(|x| to_json(&x)).collect()),
+        Value::Cons(_) => {
+            let mut arr = Vec::new();
+            for x in v.iter() {
+                arr.push(to_json_bounded(&x, depth + 1, budget)?);
+            }
+            serde_json::Value::Array(arr)
+        }
         other => serde_json::json!(to_text(other, false)),
-    }
+    })
 }
 
 pub fn getvar(ctx: &mut Ctx<'_>, a: Vec<Value>) -> Result<Flow, LispError> {
@@ -172,7 +188,11 @@ pub fn getvar(ctx: &mut Ctx<'_>, a: Vec<Value>) -> Result<Flow, LispError> {
 pub fn setvar(ctx: &mut Ctx<'_>, a: Vec<Value>) -> Result<Flow, LispError> {
     arity(&a, 2, 2)?;
     let name = string(&a[0])?;
-    match crate::sysvars::set(ctx.s, &name, &to_json(&a[1])) {
+    let mut budget: u64 = TO_JSON_BUDGET;
+    let Some(json) = to_json_bounded(&a[1], 0, &mut budget) else {
+        return Err(LispError::new(format!("AutoCAD variable setting rejected: {} value too large", to_text(&a[0], true))));
+    };
+    match crate::sysvars::set(ctx.s, &name, &json) {
         Ok(()) => Ok(Flow::Value(a[1].clone())),
         Err(_) => Err(LispError::new(format!("AutoCAD variable setting rejected: {} {}", to_text(&a[0], true), to_text(&a[1], true)))),
     }

crates/engine/src/lisp/eval.rs

@@ -163,7 +163,8 @@ pub struct Ctx<'a> {
 pub const MAX_STACK: usize = 100_000;
 /// Nesting depth of synchronous callbacks (`vl-sort` comparing with a LISP function, …).
 const MAX_SYNC_DEPTH: usize = 32;
-
+/// Steps per slice while driving a synchronous callback ([`Ctx::call_sync`]).
+const SYNC_SLICE: u64 = 400_000;
 enum State {
     Eval(Value),
     Ret(Value),
@@ -645,12 +646,31 @@ impl Ctx<'_> {
             super::value::charge_result(&v)?;
             return Ok(v);
         }
+        let cap = self.s.lisp.limits.callback_steps;
         let mut m = Machine::calling(f.clone(), args);
         let mut sub = Ctx { s: &mut *self.s, env: &mut *self.env, depth: self.depth + 1 };
-        match m.run(&mut sub, u64::MAX) {
+        // Drive the callback in bounded slices instead of granting it `u64::MAX` fuel. A `Yield`
-            Outcome::Done(v) => Ok(v),
+        // (the step budget ran out) is retried until a hard cap, so a constant-memory infinite
-            Outcome::Error(e) => Err(e),
+        // loop inside a comparator or predicate terminates with an error rather than hanging the
-            Outcome::Wait(_) => Err(LispError::new("this function can't ask for input here")),
+        // thread and bypassing the blocking execution cap (CWE-400).
+        let mut spent: u64 = 0;
+        loop {
+            let remaining = cap.saturating_sub(spent);
+            if remaining == 0 {
+                return Err(LispError::new(format!("callback stopped after {cap} steps")));
+            }
+            let slice = remaining.min(SYNC_SLICE);
+            match m.run(&mut sub, slice) {
+                Outcome::Done(v) => return Ok(v),
+                Outcome::Error(e) => return Err(e),
+                Outcome::Wait(Need::Yield) => {
+                    spent = spent.saturating_add(slice);
+                    if spent >= cap {
+                        return Err(LispError::new(format!("callback stopped after {cap} steps")));
+                    }
+                }
+                Outcome::Wait(_) => return Err(LispError::new("this function can't ask for input here")),
+            }
         }
     }
 }

crates/engine/src/lisp/mod.rs

@@ -126,11 +126,13 @@ pub(crate) struct Limits {
     pub cells: usize,
     /// Bytes of strings, printed text and files read per run.
     pub string_bytes: u64,
+    /// Maximum interpreter steps per synchronous callback.
+    pub callback_steps: u64,
 }
 
 impl Default for Limits {
     fn default() -> Self {
-        Limits { cells: value::MAX_CELLS, string_bytes: value::STRING_BUDGET }
+        Limits { cells: value::MAX_CELLS, string_bytes: value::STRING_BUDGET, callback_steps: 500_000_000 }
     }
 }
 

crates/engine/src/lisp/tests.rs

@@ -221,6 +221,64 @@ fn runaway_routines_are_errors_not_crashes() {
     assert_eq!(r, Ok("3000000".into()));
 }
 
+#[test]
+fn synchronous_callback_loop_is_an_error_not_a_hang() {
+    // A comparator with an infinite loop used to run with u64::MAX fuel and hang the thread; it
+    // now terminates at the synchronous-callback step cap (CWE-400, finding row 2).
+    let mut s = session();
+    s.lisp.limits.callback_steps = 1_000;
+    assert!(eval(&mut s, "(vl-sort '(1 2) (function (lambda (a b) (while t))))").is_err());
+    // A well-behaved comparator still works afterwards.
+    assert_eq!(ok(&mut s, "(vl-sort '(3 1 2) '<)"), "(1 2 3)");
+}
+
+#[test]
+fn a_zero_callback_budget_does_not_run_the_callback() {
+    let mut s = session();
+    s.lisp.limits.callback_steps = 0;
+    ok(&mut s, "(setq callback-ran nil)");
+    let result = eval(&mut s, "(vl-remove-if '(lambda (x) (setq callback-ran t)) '(1))");
+    assert_eq!(result, Err("callback stopped after 0 steps".into()));
+    assert_eq!(ok(&mut s, "callback-ran"), "nil");
+}
+
+#[test]
+fn a_callback_must_fit_within_a_partial_slice() {
+    let mut s = session();
+    s.lisp.limits.callback_steps = 1_000;
+    ok(&mut s, "(setq callback-count 0)");
+    let result = eval(&mut s, "(vl-remove-if '(lambda (x) (repeat 1000 (setq callback-count (1+ callback-count)))) '(1))");
+    assert_eq!(result, Err("callback stopped after 1000 steps".into()));
+    assert_eq!(ok(&mut s, "(and (> callback-count 0) (< callback-count 1000))"), "T");
+}
+
+#[test]
+fn reaching_a_callback_slice_boundary_does_not_grant_another_slice() {
+    let counts: Vec<u64> = [399_999, 400_000]
+        .into_iter()
+        .map(|cap| {
+            let mut s = session();
+            s.lisp.limits.callback_steps = cap;
+            ok(&mut s, "(setq callback-count 0)");
+            let result = eval(&mut s, "(vl-remove-if '(lambda (x) (while t (setq callback-count (1+ callback-count)))) '(1))");
+            assert_eq!(result, Err(format!("callback stopped after {cap} steps")));
+            ok(&mut s, "callback-count").parse().unwrap()
+        })
+        .collect();
+    // One additional VM step can perform at most one assignment, even at SYNC_SLICE's boundary.
+    assert!(counts[0] > 0);
+    assert!(counts[1] >= counts[0] && counts[1] - counts[0] <= 1, "{counts:?}");
+}
+
+#[test]
+fn setvar_rejects_an_oversized_shared_structure() {
+    // A list repeatedly sharing its own contents expands exponentially; setvar's bounded JSON
+    // conversion rejects it instead of allocating gigabytes (CWE-400, finding row 39).
+    let mut s = session();
+    let build = "(setq x '(1)) (repeat 40 (setq x (list x x))) (setvar \"GRIDUNIT\" x)";
+    assert!(eval(&mut s, build).is_err());
+}
+
 #[test]
 fn printing() {
     let mut s = session();

crates/engine/src/lisp/value.rs

@@ -343,18 +343,29 @@ pub fn eq(a: &Value, b: &Value) -> bool {
 
 /// `equal`: the same structure, numbers within `fuzz`.
 pub fn equal(a: &Value, b: &Value, fuzz: f64) -> bool {
-    equal_depth(a, b, fuzz, 0)
+    // A shared cons DAG can expand into exponentially many node visits when compared as a tree.
+    // Bound the total comparisons so `equal` on adversarial shared structure cannot monopolise the
+    // thread (CWE-407); exhausting the budget reports "not equal" rather than looping.
+    let mut budget: u64 = EQUAL_BUDGET;
+    equal_depth(a, b, fuzz, 0, &mut budget)
 }
 
-fn equal_depth(a: &Value, b: &Value, fuzz: f64, depth: usize) -> bool {
+/// Largest number of node comparisons one `equal` call may perform.
-    if depth > MAX_DEPTH {
+const EQUAL_BUDGET: u64 = 50_000_000;
+
+fn equal_depth(a: &Value, b: &Value, fuzz: f64, depth: usize, budget: &mut u64) -> bool {
+    if depth > MAX_DEPTH || *budget == 0 {
         return false;
     }
+    *budget -= 1;
     let (mut a, mut b) = (a.clone(), b.clone());
     loop {
+        if *budget == 0 {
+            return false;
+        }
         match (&a, &b) {
             (Value::Cons(x), Value::Cons(y)) => {
-                if !equal_depth(&x.car, &y.car, fuzz, depth + 1) {
+                if !equal_depth(&x.car, &y.car, fuzz, depth + 1, budget) {
                     return false;
                 }
                 let (na, nb) = (x.cdr.clone(), y.cdr.clone());