aboutsummaryrefslogtreecommitdiff
path: root/lib/kernel/sexp_error.ml
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-20 22:11:17 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-20 22:11:17 +0200
commit1988d350242b47aa52aa07904c495e7e2c0eba82 (patch)
tree463254012c555da51aa976dbe350415070b80a63 /lib/kernel/sexp_error.ml
parent2d8942e08edcbe5430f97270bdb1233e287600ee (diff)
downloadcolitur-1988d350242b47aa52aa07904c495e7e2c0eba82.tar.gz
colitur-1988d350242b47aa52aa07904c495e7e2c0eba82.zip
fix: audit findings — parser strictness, name ambiguity, and errors
Found by auditing the shipped program rather than the diff. The parser accepted OCaml integer-literal syntax, so "Luke 1_1:5" read as chapter ELEVEN and "+5" as 5 -- a typo silently becoming a different chapter, reachable through any user overlay. Numbers are now plain digits and positive, and a descending range is rejected: 1:20-10 is always a transcription error. No shipped citation changed. FOUR PAIRS OF DIFFERENT BOOKS SHARED A FULL TITLE. 1 and 2 Corinthians both rendered "Epistola ad Corinthios", as did Thessalonians, Timothy and Peter -- 108 citations in 2027 alone that a reader cannot resolve to a book. This is the Kings defect fixed earlier and not generalised. The titles now carry their volume numeral, marked CONSTRUCTED, and a test asserts no two books share a name -- while allowing the case where two ids ARE the same book under different numbering, which a tradition relates. Spec section 8.5 is now delivered rather than merely recorded. Shipped styles did not re-parse their own output: 32 of 52 Latin abbreviations and 49 of 52 full titles failed, so a citation copied from colitur's own output into an overlay was passed through untouched and printed in the wrong language, silently. Every shipped name is registered as a spelling and split_book learned multi-word titles by longest-token match. Now 0 of 52 fail beyond the same-book aliases. Overlay errors were written for a compiler author: they named an OCaml source file the reader does not have and buried the useful token. The existing five-path rewriter is replaced by a generic one, applied to every load path rather than one, so "rank: is not one of the allowed values (at Class9)" replaces the raw Of_sexp_error dump. Also: the new-overlay scaffold documented citations and layer without showing them, and its comment implied the wrong nesting -- the single easiest thing to get wrong; error messages echoed whole file lines, copying an unrelated file's contents into stderr when a flag pointed at one; and config --show validated partway down its table, exiting 2 after writing five rows to stdout.
Diffstat (limited to 'lib/kernel/sexp_error.ml')
-rw-r--r--lib/kernel/sexp_error.ml177
1 files changed, 177 insertions, 0 deletions
diff --git a/lib/kernel/sexp_error.ml b/lib/kernel/sexp_error.ml
new file mode 100644
index 0000000..88cc139
--- /dev/null
+++ b/lib/kernel/sexp_error.ml
@@ -0,0 +1,177 @@
+(* SPDX-License-Identifier: AGPL-3.0-or-later *)
+
+(* Turn a raw sexplib exception string into something a person editing an
+ overlay can act on.
+
+ The derived parsers report failures as [Of_sexp_error] carrying the
+ OCaml source path of the converter that failed, e.g.
+
+ (Of_sexp_error "lib/rites/rite_ef/vocab_ef.ml.rank_of_sexp:
+ unexpected variant constructor" (invalid_sexp Class9))
+
+ which names a file the reader does not have and buries the one useful
+ token (Class9) at the end. A user writing a diocesan calendar is the
+ most likely person to hit this and the least likely to read OCaml.
+
+ An earlier version of this lived in overlay.ml and rewrote five
+ hardcoded module paths; anything else -- a rank, a layer entry, the
+ top-level record -- came through raw. This one is generic, so a
+ converter added later is covered without being listed. *)
+
+let ends_with ~suffix s =
+ let ls = String.length s and lf = String.length suffix in
+ ls >= lf && String.sub s (ls - lf) lf = suffix
+
+(* "lib/kernel/layer.ml.entry_of_sexp" -> "entry"
+ "lib/kernel/overlay.ml.t_of_sexp" -> "overlay" (t is the module itself) *)
+let noun_of_converter tok =
+ match String.index_opt tok '/' with
+ | None when not (String.length tok > 4 && String.sub tok 0 4 = "lib/") -> None
+ | _ ->
+ let dot_ml = ".ml." in
+ let n = String.length tok and d = String.length dot_ml in
+ let rec find i =
+ if i > n - d then None
+ else if String.sub tok i d = dot_ml then Some i
+ else find (i + 1)
+ in
+ Option.bind (find 0) (fun i ->
+ let fn = String.sub tok (i + d) (n - i - d) in
+ if not (ends_with ~suffix:"_of_sexp" fn) then None
+ else
+ let base = String.sub fn 0 (String.length fn - 8) in
+ if base <> "t" then Some base
+ else
+ (* fall back to the module's own name *)
+ let path = String.sub tok 0 i in
+ let start =
+ match String.rindex_opt path '/' with
+ | Some j -> j + 1
+ | None -> 0
+ in
+ Some (String.sub path start (String.length path - start)))
+
+let replace ~sub ~by s =
+ let n = String.length sub and len = String.length s in
+ if n = 0 then s
+ else
+ let b = Buffer.create len in
+ let i = ref 0 in
+ while !i <= len - n do
+ if String.sub s !i n = sub then begin
+ Buffer.add_string b by;
+ i := !i + n
+ end
+ else begin
+ Buffer.add_char b s.[!i];
+ incr i
+ end
+ done;
+ Buffer.add_string b (String.sub s !i (len - !i));
+ Buffer.contents b
+
+(* Every whitespace/paren-delimited token that looks like a converter path. *)
+let rec humanise msg =
+ let is_sep c = c = ' ' || c = '"' || c = '(' || c = ')' || c = '\n' in
+ let out = ref msg in
+ let n = String.length msg in
+ let i = ref 0 in
+ while !i < n do
+ if is_sep msg.[!i] then incr i
+ else begin
+ let start = !i in
+ while !i < n && not (is_sep msg.[!i]) do incr i done;
+ let tok = String.sub msg start (!i - start) in
+ let tok = if ends_with ~suffix:":" tok then String.sub tok 0 (String.length tok - 1) else tok in
+ match noun_of_converter tok with
+ | Some noun -> out := replace ~sub:tok ~by:noun !out
+ | None -> ()
+ end
+ done;
+ !out
+ (* sexplib's own phrasing, in the reader's terms. Order matters: the
+ longer "... for record expected" forms are rewritten before the
+ shorter ones so no stray "expected" is left behind. *)
+ |> replace ~sub:"unexpected variant constructor" ~by:"is not one of the allowed values"
+ |> replace ~sub:"list instead of atom for record expected"
+ ~by:"expected a record, found a plain value"
+ |> replace ~sub:"atom instead of list for record expected"
+ ~by:"expected a record, found a plain value"
+ |> replace ~sub:"extra fields" ~by:"unknown field(s)"
+ |> replace ~sub:"element of list" ~by:"item"
+ |> strip_wrapper
+
+(* [(Of_sexp_error "MSG" (invalid_sexp VALUE))] -> [MSG (at VALUE)].
+ The wrapper is the parser's own structure, not anything the reader
+ wrote, and leaving it in makes an error look like more sexp to debug. A
+ long VALUE is truncated: the offending FIELD is what identifies the
+ problem, and echoing an entire record -- or, when the file is not a
+ calendar at all, a line of its contents -- is noise at best and leaks
+ file content into logs at worst. *)
+and strip_wrapper msg =
+ (* sexplib PRETTY-PRINTS the exception, so the wrapper is followed by a
+ newline and indentation rather than a single space. Collapse all
+ whitespace first, or the prefix match silently never fires and every
+ message comes through raw -- which is exactly what happened on the
+ first attempt at this. *)
+ let msg =
+ String.concat " "
+ (List.filter (fun w -> w <> "")
+ (String.split_on_char ' '
+ (String.map (function '\n' | '\t' | '\r' -> ' ' | c -> c) msg)))
+ in
+ let msg = String.trim msg in
+ let strip_prefix p s =
+ let lp = String.length p in
+ if String.length s >= lp && String.sub s 0 lp = p then
+ Some (String.sub s lp (String.length s - lp))
+ else None
+ in
+ match strip_prefix "(Of_sexp_error " msg with
+ | None -> msg
+ | Some rest ->
+ let rest = String.trim rest in
+ let body, value =
+ match String.index_opt rest '"' with
+ | Some 0 -> (
+ match String.index_from_opt rest 1 '"' with
+ | Some close ->
+ let m = String.sub rest 1 (close - 1) in
+ let tail = String.trim (String.sub rest (close + 1)
+ (String.length rest - close - 1)) in
+ (m, tail)
+ | None -> (rest, ""))
+ | _ -> (rest, "")
+ in
+ let value =
+ match strip_prefix "(invalid_sexp " value with
+ | Some v ->
+ let v = String.trim v in
+ (* Drop the closing parens of BOTH wrappers -- invalid_sexp's and
+ Of_sexp_error's -- keeping any that belong to the value
+ itself, by removing only the excess over what the value
+ opens. *)
+ let v =
+ let opens = ref 0 and closes = ref 0 in
+ String.iter
+ (function '(' -> incr opens | ')' -> incr closes | _ -> ())
+ v;
+ let excess = ref (!closes - !opens) in
+ let b = Buffer.create (String.length v) in
+ let n = String.length v in
+ let i = ref (n - 1) in
+ let tail = ref [] in
+ while !i >= 0 do
+ (if v.[!i] = ')' && !excess > 0 then decr excess
+ else tail := v.[!i] :: !tail);
+ decr i
+ done;
+ List.iter (Buffer.add_char b) !tail;
+ Buffer.contents b
+ in
+ let v = String.concat " " (String.split_on_char '\n' v) in
+ let v = String.trim v in
+ if String.length v > 60 then String.sub v 0 57 ^ "..." else v
+ | None -> ""
+ in
+ if value = "" then body else body ^ " (at " ^ value ^ ")"