From c3cdb5cfaf717f01654334b95d384a051ea1b60e Mon Sep 17 00:00:00 2001 From: "Dylan M. Taylor" Date: Tue, 3 Nov 2026 20:25:45 +0000 Subject: [PATCH] fix(lisp): charge READ text, EQUAL string bytes, SETVAR and ENTMAKE copies, and nested callbacks against one budget --- crates/engine/src/lisp.rs | 6 +++ crates/engine/src/lisp/builtins/strings.rs | 10 ++++- crates/engine/src/lisp/drawing.rs | 41 +++++++++++++++++- crates/engine/src/lisp/eval.rs | 50 +++++++++++++++------- crates/engine/src/lisp/tests.rs | 17 ++++++++ crates/engine/src/lisp/value.rs | 34 ++++++++++++++- 6 files changed, 137 insertions(+), 21 deletions(-) diff --git a/crates/engine/src/lisp.rs b/crates/engine/src/lisp.rs index 977d4f551..8b300bb30 100644 --- a/crates/engine/src/lisp.rs +++ b/crates/engine/src/lisp.rs @@ -123,6 +123,12 @@ pub struct LispState { acad_loaded: bool, /// Memory caps (lowered by tests). pub(crate) limits: Limits, + /// Interpreter steps all synchronous callbacks have run, nested ones included. A callback's + /// allowance counts what ran since it started, so the callbacks it calls spend its steps. + pub(crate) callback_used: u64, + /// The `callback_used` value the callback running now (and so every one it calls) must not + /// pass: the lowest of its own and its callers' allowances. + pub(crate) callback_ceiling: Option, } /// What U and REDO inside the running routine take back: the commands it ran, each as the drawing diff --git a/crates/engine/src/lisp/builtins/strings.rs b/crates/engine/src/lisp/builtins/strings.rs index 853e0656f..362183bd2 100644 --- a/crates/engine/src/lisp/builtins/strings.rs +++ b/crates/engine/src/lisp/builtins/strings.rs @@ -1,5 +1,5 @@ use super::args::{R, arity, int, list_arg, string}; -use super::{LispError, OsStr, Value, check_string_len, read, to_text}; +use super::{LispError, OsStr, Value, charge_bytes, check_string_len, read, to_text}; // ---------------- strings ---------------- @@ -114,7 +114,13 @@ pub(super) fn read_fn(a: &[Value]) -> R { arity(a, 0, 1)?; match a.first() { None | Some(Value::Nil) => Ok(Value::Nil), - Some(v) => read::read_one(&string(v)?), + Some(v) => { + // The strings in the list it makes are new, each as long as its text at most: the + // text is charged, though a list result isn't inspected by `charge_result`. + let text = string(v)?; + charge_bytes(text.len())?; + read::read_one(&text) + } } } diff --git a/crates/engine/src/lisp/drawing.rs b/crates/engine/src/lisp/drawing.rs index 238551094..d1ef57447 100644 --- a/crates/engine/src/lisp/drawing.rs +++ b/crates/engine/src/lisp/drawing.rs @@ -179,7 +179,12 @@ fn to_json_bounded(v: &Value, depth: usize, budget: &mut u64) -> Option 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::Str(s) => { + // A string is copied whole each time it occurs: it spends the allowance by its length + // (one unit per 16 bytes, so about 32 MB in all), shared or not. + *budget = budget.checked_sub(s.len() as u64 / 16)?; + serde_json::json!(&**s) + } Value::Cons(_) => { let mut arr = Vec::new(); for x in v.iter() { @@ -296,12 +301,16 @@ fn groups_to_list(tags: &[Tag]) -> Vec { out } +/// The most string bytes an entity list may hold (counted per occurrence, shared or not). +const MAX_GROUP_TEXT: usize = 32 << 20; + /// An association list back to DXF groups (points split into x, y, z groups). The type /// (`0`), the entity name (`-1`), the handle (`5`), the owner (`330`) and the layout (`410`) are /// left out: they aren't the entity's to set. fn list_to_groups(list: &Value) -> Result<(String, Vec), LispError> { let mut kind = None; let mut tags = Vec::new(); + let mut text_left = MAX_GROUP_TEXT; for item in list.iter() { let Value::Cons(c) = &item else { return Err(LispError::bad_arg("listp", &item)) }; let Value::Int(code) = c.car else { return Err(LispError::bad_arg("fixnump", &c.car)) }; @@ -323,7 +332,11 @@ fn list_to_groups(list: &Value) -> Result<(String, Vec), LispError> { _ => tags.push(match &v { Value::Int(i) => Tag::i(code, i64::from(*i)), Value::Real(r) => Tag::f(code, *r), - Value::Str(s) => Tag::s(code, &**s), + Value::Str(s) => { + // Each occurrence of a shared string becomes its own copy in the tag. + text_left = text_left.checked_sub(s.len()).ok_or_else(|| LispError::new("out of memory: the entity list holds too much text"))?; + Tag::s(code, &**s) + } Value::Ename(h) => Tag::s(code, h.hex()), other => return Err(LispError::bad_arg("DXF group value", other)), }), @@ -1125,3 +1138,27 @@ pub fn load_source(s: &Session, name: &str) -> Option { s.lisp_support_dir().map(|d| candidates.iter().map(|c| d.join(c).to_string_lossy().into_owned()).collect::>()).unwrap_or_default(); candidates.iter().chain(&support).find_map(super::builtins::read_text_file) } + +#[cfg(test)] +mod budget_tests { + use super::*; + + /// One 64 KB string occurring many times is charged by its length each time. + #[test] + fn shared_strings_spend_the_conversion_budgets() { + let big = Value::str(&"x".repeat(64 << 10)); + // 600 x 64 KB is over the 32 MiB an entity list may hold; 100 x 64 KB is not. + let list = |n: usize| { + let mut items = vec![Value::cons(Value::Int(0), Value::str("TEXT"))]; + items.extend(std::iter::repeat_n(Value::cons(Value::Int(1), big.clone()), n)); + Value::list(items) + }; + assert!(list_to_groups(&list(600)).is_err()); + assert!(list_to_groups(&list(100)).is_ok()); + // 1,000 x 64 KB is 4,096,000 units of the 2,000,000 SETVAR allows; 100 x 64 KB is not. + let mut budget = TO_JSON_BUDGET; + assert!(to_json_bounded(&Value::list(vec![big.clone(); 1_000]), 0, &mut budget).is_none()); + let mut budget = TO_JSON_BUDGET; + assert!(to_json_bounded(&Value::list(vec![big; 100]), 0, &mut budget).is_some()); + } +} diff --git a/crates/engine/src/lisp/eval.rs b/crates/engine/src/lisp/eval.rs index 3101b3933..83cc60e9c 100644 --- a/crates/engine/src/lisp/eval.rs +++ b/crates/engine/src/lisp/eval.rs @@ -175,17 +175,19 @@ pub struct Machine { stack: Vec, state: State, need: Option, + /// Steps the last [`Machine::run`] took. + last_steps: u64, } impl Machine { /// A machine evaluating `forms` in turn. pub fn forms(forms: Vec) -> Machine { - Machine { stack: vec![Frame::Forms { rest: forms.into_iter().rev().collect() }], state: State::Ret(Value::Nil), need: None } + Machine { stack: vec![Frame::Forms { rest: forms.into_iter().rev().collect() }], state: State::Ret(Value::Nil), need: None, last_steps: 0 } } /// A machine calling `f` with `args`. pub fn calling(f: Value, args: Vec) -> Machine { - Machine { stack: Vec::new(), state: State::Call(f, args), need: None } + Machine { stack: Vec::new(), state: State::Call(f, args), need: None, last_steps: 0 } } /// Give the value a [`Need`] waited for, and carry on. @@ -196,9 +198,15 @@ impl Machine { /// Run until done, waiting, or `budget` steps. pub fn run(&mut self, ctx: &mut Ctx<'_>, budget: u64) -> Outcome { let mut n = 0u64; + let outcome = self.run_counted(ctx, budget, &mut n); + self.last_steps = n.min(budget); + outcome + } + + fn run_counted(&mut self, ctx: &mut Ctx<'_>, budget: u64, n: &mut u64) -> Outcome { loop { - n += 1; - if n > budget { + *n += 1; + if *n > budget { return Outcome::Wait(Need::Yield); } let r = match std::mem::replace(&mut self.state, State::Ret(Value::Nil)) { @@ -646,29 +654,41 @@ impl Ctx<'_> { super::value::charge_result(&v)?; return Ok(v); } + let cap = self.s.lisp.limits.callback_steps; + let start = self.s.lisp.callback_used; + // This callback may run until `callback_used` reaches `ceiling`: `cap` steps from now, or + // sooner where a caller's allowance ends, so callbacks nested in callbacks share one + // allowance instead of each taking a fresh one (an exponential tree otherwise). + let outer = self.s.lisp.callback_ceiling; + let ceiling = start.saturating_add(cap).min(outer.unwrap_or(u64::MAX)); + self.s.lisp.callback_ceiling = Some(ceiling); + let r = self.drive_callback(f, args, ceiling); + self.s.lisp.callback_ceiling = outer; + r + } + + /// Run callback `f` in slices until it finishes or `callback_used` reaches `ceiling`. + fn drive_callback(&mut self, f: &Value, args: Vec, ceiling: u64) -> Result { 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 }; // Drive the callback in bounded slices instead of granting it `u64::MAX` fuel. A `Yield` - // (the step budget ran out) is retried until a hard cap, so a constant-memory infinite + // (the step budget ran out) is retried until the ceiling, so a constant-memory infinite // loop inside a comparator or predicate terminates with an error rather than hanging the - // thread and bypassing the blocking execution cap (CWE-400). - let mut spent: u64 = 0; + // thread and bypassing the blocking execution cap (CWE-400). The steps of callbacks this + // one calls are counted in `callback_used` too. loop { - let remaining = cap.saturating_sub(spent); + let remaining = ceiling.saturating_sub(sub.s.lisp.callback_used); 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) { + let outcome = m.run(&mut sub, slice); + sub.s.lisp.callback_used = sub.s.lisp.callback_used.saturating_add(m.last_steps); + match outcome { 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(Need::Yield) => {} Outcome::Wait(_) => return Err(LispError::new("this function can't ask for input here")), } } diff --git a/crates/engine/src/lisp/tests.rs b/crates/engine/src/lisp/tests.rs index 0ed4b22fd..59a64e503 100644 --- a/crates/engine/src/lisp/tests.rs +++ b/crates/engine/src/lisp/tests.rs @@ -286,6 +286,20 @@ fn reaching_a_callback_slice_boundary_does_not_grant_another_slice() { assert!(counts[1] >= counts[0] && counts[1] - counts[0] <= 1, "{counts:?}"); } +/// Callbacks that call callbacks share one allowance: a branching routine can't multiply it. +#[test] +fn nested_callbacks_share_one_step_allowance() { + let mut s = session(); + s.lisp.limits.callback_steps = 1_000_000; + // 4^14 leaf calls if every callback took a fresh allowance; the whole tree gets one. + let started = std::time::Instant::now(); + let e = eval(&mut s, "(defun f (n) (if (> n 0) (vl-every '(lambda (x) (f (1- n)) t) '(1 2 3 4)) t)) (f 14)").unwrap_err(); + assert!(e.contains("callback stopped after 1000000 steps"), "{e}"); + assert!(started.elapsed() < std::time::Duration::from_secs(60)); + // The next run starts afresh. + assert_eq!(ok(&mut s, "(f 1)"), "T"); +} + /// System-variable conversion rejects a shared list whose owned JSON expansion would exceed its budget. #[test] fn setvar_rejects_an_oversized_shared_structure() { @@ -977,6 +991,9 @@ fn strings_are_capped() { assert!(e.contains("too much text"), "{e}"); let e = eval(&mut s, "(repeat 200000 (princ \"0123456789\"))").unwrap_err(); assert!(e.contains("too much text"), "{e}"); + // READ makes new strings inside the list it returns: they count, though the result is a list. + let e = eval(&mut s, "(setq a \"(\\\"0123456789\\\")\") (repeat 100000 (setq b (read a)))").unwrap_err(); + assert!(e.contains("too much text"), "{e}"); // The budget is per run: the next one starts afresh. assert_eq!(ok(&mut s, "(strcat \"a\" \"b\")"), "\"ab\""); } diff --git a/crates/engine/src/lisp/value.rs b/crates/engine/src/lisp/value.rs index 09da1d27a..afae124e6 100644 --- a/crates/engine/src/lisp/value.rs +++ b/crates/engine/src/lisp/value.rs @@ -346,7 +346,11 @@ pub fn equal(a: &Value, b: &Value, fuzz: f64) -> bool { // 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_within(a, b, fuzz, EQUAL_BUDGET) +} + +/// [`equal`] with its work allowance (node visits plus string bytes / 64) given. +fn equal_within(a: &Value, b: &Value, fuzz: f64, mut budget: u64) -> bool { equal_depth(a, b, fuzz, 0, &mut budget) } @@ -373,7 +377,19 @@ fn equal_depth(a: &Value, b: &Value, fuzz: f64, depth: usize, budget: &mut u64) a = na; b = nb; } - _ => return atom_equal(&a, &b, fuzz), + _ => { + // Comparing two strings costs their length, not one visit: a shared list of long + // equal strings must spend the allowance by the bytes it compares (one unit per 64). + if let (Value::Str(x), Value::Str(y)) = (&a, &b) { + let cost = (x.len().min(y.len()) / 64) as u64; + if cost >= *budget { + *budget = 0; + return false; + } + *budget -= cost; + } + return atom_equal(&a, &b, fuzz); + } } } } @@ -540,6 +556,20 @@ fn write_value(out: &mut String, v: &Value, escape: bool, depth: usize) { mod tests { use super::*; + /// `equal` charges the bytes of the strings it compares: a list of long equal strings fits a + /// big allowance but not a small one, though it has few nodes. + #[test] + fn equal_spends_its_allowance_on_string_bytes() { + let long = Value::str(&"x".repeat(6_400)); + let other = Value::str(&"x".repeat(6_400)); + let list = |v: &Value| Value::list(vec![v.clone(); 100]); + let (a, b) = (list(&long), list(&other)); + // 100 strings x 100 units each, plus about 100 node visits. + assert!(equal_within(&a, &b, 0.0, 20_000)); + assert!(!equal_within(&a, &b, 0.0, 5_000)); + assert!(equal(&a, &b, 0.0)); + } + #[test] fn reals_print_with_six_significant_digits() { assert_eq!(real_text(1.0), "1.0");