From eff4b89cff4e1b8fcceb23c54cb62ec636ce62fe Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 07:47:30 +0200 Subject: feat(render): per-flavour escaping and RFC 5545 line folding Six flavours: latex, groff, html, xml, ics, none. Markdown, AsciiDoc and plain text map to none deliberately -- their metacharacters are context-dependent and escaping them aggressively produces worse output than not escaping. An unrecognised extension returns None rather than falling back to none: guessing the flavour wrong produces malformed output that looks fine until it does not. Folding backs off to a non-continuation byte, so a fold never splits a UTF-8 sequence -- the failure mode that would corrupt Polish and Latin names in a published feed. --- lib/render/dune | 5 +++ lib/render/escape.ml | 87 +++++++++++++++++++++++++++++++++++++++++++++++++++ lib/render/escape.mli | 28 +++++++++++++++++ 3 files changed, 120 insertions(+) create mode 100644 lib/render/dune create mode 100644 lib/render/escape.ml create mode 100644 lib/render/escape.mli (limited to 'lib/render') diff --git a/lib/render/dune b/lib/render/dune new file mode 100644 index 0000000..7880188 --- /dev/null +++ b/lib/render/dune @@ -0,0 +1,5 @@ +(library + (name colitur_render) + (libraries colitur_kernel sexplib) + (preprocess + (pps ppx_sexp_conv))) diff --git a/lib/render/escape.ml b/lib/render/escape.ml new file mode 100644 index 0000000..53fdd46 --- /dev/null +++ b/lib/render/escape.ml @@ -0,0 +1,87 @@ +type flavour = Latex | Groff | Html | Xml | Ics | None_ + +let all = [ Latex; Groff; Html; Xml; Ics; None_ ] + +let to_string = function + | Latex -> "latex" | Groff -> "groff" | Html -> "html" + | Xml -> "xml" | Ics -> "ics" | None_ -> "none" + +let of_string = function + | "latex" -> Some Latex | "groff" -> Some Groff | "html" -> Some Html + | "xml" -> Some Xml | "ics" -> Some Ics | "none" -> Some None_ + | _ -> None + +let of_extension = function + | ".tex" -> Some Latex + | ".ms" | ".mom" | ".me" -> Some Groff + | ".html" | ".htm" -> Some Html + | ".xml" -> Some Xml + | ".ics" -> Some Ics + | ".md" | ".adoc" | ".txt" -> Some None_ + | _ -> None + +(* Replace each character with its expansion, in ONE pass. A sequence of + String.concat replacements would double-escape: "&" -> "\\&" then the + backslash rule would rewrite the backslash it just introduced. *) +let expand f s = + let b = Buffer.create (String.length s + 16) in + String.iter (fun c -> Buffer.add_string b (f c)) s; + Buffer.contents b + +let latex = function + | '\\' -> "\\textbackslash{}" + | '{' -> "\\{" | '}' -> "\\}" + | '$' -> "\\$" | '&' -> "\\&" | '#' -> "\\#" + | '_' -> "\\_" | '%' -> "\\%" + | '^' -> "\\textasciicircum{}" + | '~' -> "\\textasciitilde{}" + | c -> String.make 1 c + +let html = function + | '&' -> "&" | '<' -> "<" | '>' -> ">" + | '"' -> """ | '\'' -> "'" + | c -> String.make 1 c + +let ics = function + | '\\' -> "\\\\" | ';' -> "\\;" | ',' -> "\\," + | '\n' -> "\\n" | '\r' -> "" + | c -> String.make 1 c + +(* groff: a backslash starts an escape, and a '.' or '\'' in COLUMN ONE starts a + request. \& is the zero-width non-printing character that defuses it. *) +let groff s = + let escaped = expand (function '\\' -> "\\e" | c -> String.make 1 c) s in + if String.length escaped > 0 && (escaped.[0] = '.' || escaped.[0] = '\'') then "\\&" ^ escaped + else escaped + +let apply flavour s = + match flavour with + | Latex -> expand latex s + | Groff -> groff s + | Html | Xml -> expand html s + | Ics -> expand ics s + | None_ -> s + +(* RFC 5545 section 3.1. A continuation byte is 0x80-0xBF; backing off to a + non-continuation byte keeps every fold on a character boundary. *) +let fold_ics line = + let n = String.length line in + let b = Buffer.create (n + (n / 70) + 8) in + let is_cont c = Char.code c land 0xC0 = 0x80 in + let rec go pos first = + let limit = if first then 75 else 74 (* the leading space costs one octet *) in + if n - pos <= limit then ( + if not first then Buffer.add_char b ' '; + Buffer.add_string b (String.sub line pos (n - pos)); + Buffer.add_string b "\r\n") + else begin + let cut = ref (pos + limit) in + while !cut > pos && is_cont line.[!cut] do decr cut done; + if not first then Buffer.add_char b ' '; + Buffer.add_string b (String.sub line pos (!cut - pos)); + Buffer.add_string b "\r\n"; + go !cut false + end + in + go 0 true; + Buffer.contents b diff --git a/lib/render/escape.mli b/lib/render/escape.mli new file mode 100644 index 0000000..97cf050 --- /dev/null +++ b/lib/render/escape.mli @@ -0,0 +1,28 @@ +(** Per-flavour escaping for the template engine, plus RFC 5545 line folding. + + Knows nothing about calendars. Pure and total: every function is defined on + every string, and none reads the clock, the environment or the filesystem. *) + +(** The six escaping modes. Markdown, AsciiDoc and plain text all use [None_]: + their metacharacter sets are context-dependent, and escaping them + aggressively produces worse output than not escaping at all (spec section 5). + This is a documented limitation of those flavours. *) +type flavour = Latex | Groff | Html | Xml | Ics | None_ + +val all : flavour list +val to_string : flavour -> string +val of_string : string -> flavour option + +(** [of_extension ".tex"] is [Some Latex]. Returns [None] for an unrecognised + extension: the caller must treat that as an error, never as a fallback to + [None_] (spec section 5 -- guessing wrong here produces malformed output + that looks fine until it does not). *) +val of_extension : string -> flavour option + +(** Escape one interpolated value for [flavour]. *) +val apply : flavour -> string -> string + +(** Fold one unfolded content line per RFC 5545 section 3.1: at most 75 octets + per line, continuation lines prefixed with one space, CRLF terminators, + never splitting a UTF-8 sequence. The returned string ends with CRLF. *) +val fold_ics : string -> string -- cgit v1.3 From 7228d0634a960c38da96b80378ec617768dfedf7 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 07:55:53 +0200 Subject: fix(render): make fold_ics total on arbitrary octet strings fold_ics's UTF-8 backoff loop could back `cut` all the way down to `pos` on 74+ consecutive continuation bytes (0x80-0xBF), producing a zero-length chunk and recursing on the identical position forever -- not producible by valid UTF-8, whose longest continuation run is 3, but the kernel's own totality requirement covers arbitrary octet strings, not only valid ones. When backoff finds no boundary inside the window, cut hard at the limit instead, so forward progress is unconditional. test_fold_never_splits_utf8 previously asserted only that unfolding reproduced the original bytes, a property folding preserves at any cut position and therefore blind to a boundary violation. It now also asserts the named property directly: no continuation chunk may start with a UTF-8 continuation byte. A new regression test feeds fold_ics 100 consecutive continuation bytes and asserts it terminates with every line at or under 75 octets. --- lib/render/escape.ml | 8 ++++++++ test/test_escape.ml | 42 ++++++++++++++++++++++++++++++++++-------- 2 files changed, 42 insertions(+), 8 deletions(-) (limited to 'lib/render') diff --git a/lib/render/escape.ml b/lib/render/escape.ml index 53fdd46..f506c44 100644 --- a/lib/render/escape.ml +++ b/lib/render/escape.ml @@ -77,6 +77,14 @@ let fold_ics line = else begin let cut = ref (pos + limit) in while !cut > pos && is_cont line.[!cut] do decr cut done; + (* Valid UTF-8's longest continuation run is 3, so backoff finds a + boundary within a few bytes. But this function must stay TOTAL on + ARBITRARY octet strings, not only valid UTF-8: 74+ consecutive + continuation bytes back `cut` all the way down to `pos`, which would + yield a zero-length chunk and recurse on the identical position + forever. When backoff finds no boundary inside the window, cut hard + at the limit instead -- forward progress is then unconditional. *) + if !cut = pos then cut := pos + limit; if not first then Buffer.add_char b ' '; Buffer.add_string b (String.sub line pos (!cut - pos)); Buffer.add_string b "\r\n"; diff --git a/test/test_escape.ml b/test/test_escape.ml index 1587388..35a9b9d 100644 --- a/test/test_escape.ml +++ b/test/test_escape.ml @@ -70,16 +70,41 @@ let test_fold_long_line () = let test_fold_never_splits_utf8 () = let long = "SUMMARY:" ^ String.concat "" (List.init 40 (fun _ -> "\xc4\x99\xc5\x9b\xc4\x87")) in let out = E.fold_ics long in - let stripped = - String.concat "" - (List.filter_map - (fun l -> - let l = if l <> "" && l.[String.length l - 1] = '\r' then String.sub l 0 (String.length l - 1) else l in - if l = "" then None else if l.[0] = ' ' then Some (String.sub l 1 (String.length l - 1)) else Some l) - (String.split_on_char '\n' out)) + let chunks = + List.filter_map + (fun l -> + let l = if l <> "" && l.[String.length l - 1] = '\r' then String.sub l 0 (String.length l - 1) else l in + if l = "" then None else if l.[0] = ' ' then Some (String.sub l 1 (String.length l - 1)) else Some l) + (String.split_on_char '\n' out) in + (* The named property: no chunk may START with a UTF-8 continuation byte + (0x80-0xBF) -- that would mean the previous fold cut mid-character. + Unfolding losslessly (below) cannot detect this on its own: concatenation + is insensitive to where the cuts fell, so a fold at ANY position still + round-trips. *) + List.iter + (fun c -> + if String.length c > 0 then + Alcotest.(check bool) "chunk does not start mid-UTF-8" true (Char.code c.[0] land 0xC0 <> 0x80)) + chunks; + let stripped = String.concat "" chunks in check "unfolds to the original" long stripped +(* B1 regression: 100 consecutive UTF-8 continuation bytes (0x80-0xBF) is not + producible by valid UTF-8 (whose longest continuation run is 3), but + fold_ics must stay TOTAL on arbitrary octet strings. A backoff loop with no + hard-cut fallback backs `cut` all the way down to `pos`, yielding a + zero-length chunk and recursing on the identical position forever. *) +let test_fold_pathological_input_terminates () = + let pathological = String.make 100 '\x80' in + let out = E.fold_ics pathological in + let lines = String.split_on_char '\n' out in + List.iter + (fun l -> + let l = if l <> "" && l.[String.length l - 1] = '\r' then String.sub l 0 (String.length l - 1) else l in + if String.length l > 75 then Alcotest.failf "line of %d octets exceeds 75" (String.length l)) + (List.filter (fun l -> l <> "") lines) + let suite = ( "Escape", [ Alcotest.test_case "latex" `Quick test_latex; @@ -90,4 +115,5 @@ let suite = Alcotest.test_case "flavour names" `Quick test_flavour_names; Alcotest.test_case "fold: short unchanged" `Quick test_fold_short_line_unchanged; Alcotest.test_case "fold: long line" `Quick test_fold_long_line; - Alcotest.test_case "fold: never splits utf8" `Quick test_fold_never_splits_utf8 ] ) + Alcotest.test_case "fold: never splits utf8" `Quick test_fold_never_splits_utf8; + Alcotest.test_case "fold: pathological input terminates" `Quick test_fold_pathological_input_terminates ] ) -- cgit v1.3 From eacb54ae44f655c010fdfc2b7292d24f06ffc445 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 08:01:11 +0200 Subject: feat(render): logic-less template parser Placeholders, sections, inverted sections, comments. Nothing else: no partials, no lambdas, no expression evaluation, no raw form. A template is data, never a program, which is what keeps an untrusted template safe. Errors rather than silence on a malformed template: an unterminated tag, an unclosed section, a mismatched close and a partial all return Error. Swallowing '{{name' as text is how a typo becomes invisible missing output in a printed booklet. --- lib/render/template.ml | 86 +++++++++++++++++++++++++++++++++++++++++++++++++ lib/render/template.mli | 28 ++++++++++++++++ test/test_colitur.ml | 3 +- test/test_template.ml | 61 +++++++++++++++++++++++++++++++++++ 4 files changed, 177 insertions(+), 1 deletion(-) create mode 100644 lib/render/template.ml create mode 100644 lib/render/template.mli create mode 100644 test/test_template.ml (limited to 'lib/render') diff --git a/lib/render/template.ml b/lib/render/template.ml new file mode 100644 index 0000000..8de91a6 --- /dev/null +++ b/lib/render/template.ml @@ -0,0 +1,86 @@ +type value = + | Str of string + | Bool of bool + | List of value list + | Obj of (string * value) list + +type node = + | Text of string + | Var of string list + | Section of string list * node list + | Inverted of string list * node list + +type tag = TVar of string list | TOpen of string list | TInv of string list | TClose of string list | TComment + +let trim = String.trim + +let path s = + String.split_on_char '.' (trim s) |> List.map trim |> List.filter (fun x -> x <> "") + +(* Lex into a flat list of text and tags. Returns Error on an unterminated tag + rather than treating the remainder as text: silently swallowing "{{name" is + how a typo becomes invisible missing output. *) +let lex src = + let n = String.length src in + let out = ref [] in + let buf = Buffer.create 256 in + let flush () = + if Buffer.length buf > 0 then (out := `Text (Buffer.contents buf) :: !out; Buffer.clear buf) + in + let rec go i = + if i >= n then (flush (); Ok (List.rev !out)) + else if i + 1 < n && src.[i] = '{' && src.[i + 1] = '{' then + match String.index_from_opt src (i + 2) '}' with + | Some j when j + 1 < n && src.[j + 1] = '}' -> + let body = String.sub src (i + 2) (j - i - 2) in + flush (); + let tag = + let b = trim body in + if b = "" then Error "empty tag {{}}" + else + match b.[0] with + | '#' -> Ok (TOpen (path (String.sub b 1 (String.length b - 1)))) + | '^' -> Ok (TInv (path (String.sub b 1 (String.length b - 1)))) + | '/' -> Ok (TClose (path (String.sub b 1 (String.length b - 1)))) + | '!' -> Ok TComment + | '>' -> Error "partials are not supported: a template may not include another file" + | _ -> Ok (TVar (path b)) + in + (match tag with + | Error e -> Error e + | Ok t -> out := `Tag t :: !out; go (j + 2)) + | _ -> Error "unterminated tag: '{{' with no matching '}}'" + else (Buffer.add_char buf src.[i]; go (i + 1)) + in + go 0 + +(* Fold the flat list into a tree, checking that every close matches its open. *) +let build items = + let rec go acc stack items = + match items with + | [] -> ( + match stack with + | [] -> Ok (List.rev acc) + | (p, _, _) :: _ -> Error ("unclosed section {{#" ^ String.concat "." p ^ "}}")) + | `Text "" :: rest -> go acc stack rest + | `Text t :: rest -> go (Text t :: acc) stack rest + | `Tag TComment :: rest -> go acc stack rest + | `Tag (TVar p) :: rest -> go (Var p :: acc) stack rest + | `Tag (TOpen p) :: rest -> go [] ((p, `Sec, acc) :: stack) rest + | `Tag (TInv p) :: rest -> go [] ((p, `Inv, acc) :: stack) rest + | `Tag (TClose p) :: rest -> ( + match stack with + | [] -> Error ("close tag {{/" ^ String.concat "." p ^ "}} with no open section") + | (op, kind, outer) :: tl -> + if op <> p then + Error + ("mismatched close: {{#" ^ String.concat "." op ^ "}} closed by {{/" + ^ String.concat "." p ^ "}}") + else + let inner = List.rev acc in + let node = match kind with `Sec -> Section (op, inner) | `Inv -> Inverted (op, inner) in + go (node :: outer) tl rest) + in + go [] [] items + +let parse src = match lex src with Error e -> Error e | Ok items -> build items diff --git a/lib/render/template.mli b/lib/render/template.mli new file mode 100644 index 0000000..3f9ef97 --- /dev/null +++ b/lib/render/template.mli @@ -0,0 +1,28 @@ +(** A deliberately logic-less template engine (spec section 5). + + A template is DATA, never a program: placeholders, sections, inverted + sections and comments, and nothing else. There are no partials, no lambdas, + no expression evaluation, no arithmetic, and no filesystem or process + access. There is deliberately no "raw" or triple-brace form -- a template + cannot opt out of its flavour's escaping. + + Anything a calendar needs that this cannot express (a month grid's leading + blanks, week bucketing) is computed in {!View} and handed in as data. That + division is the design, not a workaround. *) + +(** What a template can be rendered against. *) +type value = + | Str of string + | Bool of bool + | List of value list + | Obj of (string * value) list + +type node = + | Text of string + | Var of string list (** dotted path, e.g. ["name"; "la"] *) + | Section of string list * node list + | Inverted of string list * node list + +(** Never raises; a malformed template is an [Error] with a human-readable + reason, because the template is user input. *) +val parse : string -> (node list, string) result diff --git a/test/test_colitur.ml b/test/test_colitur.ml index 2295a3f..a264174 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -7,4 +7,5 @@ let () = Test_differential.suite; Test_oracle.suite; Test_oracle.suite_2038; Test_oracle.suite_2035; Test_golden.suite; ("lectionary", Test_lectionary.suite); ("lectionary-ef", Test_lectionary_ef.suite); - Test_escape.suite ] + Test_escape.suite; + Test_template.suite ] diff --git a/test/test_template.ml b/test/test_template.ml new file mode 100644 index 0000000..dee281b --- /dev/null +++ b/test/test_template.ml @@ -0,0 +1,61 @@ +module T = Colitur_render.Template + +let parse_ok s = match T.parse s with Ok ns -> ns | Error e -> Alcotest.failf "parse: %s" e + +let test_plain_text () = + Alcotest.(check bool) "text only" true (parse_ok "hello" = [ T.Text "hello" ]) + +let test_var () = + Alcotest.(check bool) "var" true (parse_ok "{{name}}" = [ T.Var [ "name" ] ]); + Alcotest.(check bool) "dotted" true (parse_ok "{{name.la}}" = [ T.Var [ "name"; "la" ] ]); + Alcotest.(check bool) "spaces trimmed" true (parse_ok "{{ name.la }}" = [ T.Var [ "name"; "la" ] ]) + +let test_section () = + Alcotest.(check bool) "section" true + (parse_ok "{{#days}}x{{/days}}" = [ T.Section ([ "days" ], [ T.Text "x" ]) ]); + Alcotest.(check bool) "inverted" true + (parse_ok "{{^days}}x{{/days}}" = [ T.Inverted ([ "days" ], [ T.Text "x" ]) ]) + +let test_nested_sections () = + Alcotest.(check bool) "nested" true + (parse_ok "{{#months}}{{#weeks}}w{{/weeks}}{{/months}}" + = [ T.Section ([ "months" ], [ T.Section ([ "weeks" ], [ T.Text "w" ]) ]) ]) + +let test_comment_is_dropped () = + Alcotest.(check bool) "comment" true (parse_ok "a{{! note }}b" = [ T.Text "a"; T.Text "b" ]) + +let test_unclosed_section_is_an_error () = + match T.parse "{{#days}}x" with + | Error _ -> () + | Ok _ -> Alcotest.fail "an unclosed section must be a parse error, not silently accepted" + +let test_mismatched_close_is_an_error () = + match T.parse "{{#days}}x{{/weeks}}" with + | Error _ -> () + | Ok _ -> Alcotest.fail "a mismatched close tag must be a parse error" + +let test_unterminated_tag_is_an_error () = + match T.parse "{{name" with + | Error _ -> () + | Ok _ -> Alcotest.fail "an unterminated tag must be a parse error" + +(* The safety promise (spec section 5): a template is data, never a program. + There is no raw/triple-brace form to opt out of escaping, and no partial. *) +let test_no_raw_or_partial_form () = + Alcotest.(check bool) "triple brace is not an unescaped var" true + (match T.parse "{{{name}}}" with Ok [ T.Var [ "{name" ] ] -> false | Ok _ -> true | Error _ -> true); + match T.parse "{{>partial}}" with + | Error _ -> () + | Ok _ -> Alcotest.fail "partials must not parse: a template may not pull in another file" + +let suite = + ( "Template/parse", + [ Alcotest.test_case "plain text" `Quick test_plain_text; + Alcotest.test_case "vars" `Quick test_var; + Alcotest.test_case "sections" `Quick test_section; + Alcotest.test_case "nested sections" `Quick test_nested_sections; + Alcotest.test_case "comments dropped" `Quick test_comment_is_dropped; + Alcotest.test_case "unclosed section errors" `Quick test_unclosed_section_is_an_error; + Alcotest.test_case "mismatched close errors" `Quick test_mismatched_close_is_an_error; + Alcotest.test_case "unterminated tag errors" `Quick test_unterminated_tag_is_an_error; + Alcotest.test_case "no raw or partial form" `Quick test_no_raw_or_partial_form ] ) -- cgit v1.3 From a526d934cea17ff1b76ddad5c5f2934fb85c11cb Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 08:09:12 +0200 Subject: fix(render): reject empty tag paths, sharpen the raw-form test F1: test_no_raw_or_partial_form's first assertion only excluded one literal shape (Ok [Var ["{name"]]), so it could not actually catch a future raw/unescaped constructor under a different name. Replace it with an assertion of the real parse result for {{{name}}} (Ok [Var ["{name"]; Text "}"]), documented behaviour rather than a guarantee this test cannot check -- the real guarantee is structural: node has exactly four constructors and none of them is raw. F2: {{.}}, {{#}}, {{^}} and {{/}} used to parse to a Var/Section/ Inverted with an empty path, reachable but never designed. This engine has no "current context" for a bare dot to mean, so a bare-dot or empty-sigil path is now a parse error at lex time, covering all four sigil forms via one path helper. The existing "empty tag {{}}" branch is unchanged and still reachable (a fully empty body is a distinct case from a sigil with an empty path). --- lib/render/template.ml | 18 ++++++++++++++---- test/test_template.ml | 31 ++++++++++++++++++++++++++++--- 2 files changed, 42 insertions(+), 7 deletions(-) (limited to 'lib/render') diff --git a/lib/render/template.ml b/lib/render/template.ml index 8de91a6..3e35d53 100644 --- a/lib/render/template.ml +++ b/lib/render/template.ml @@ -38,13 +38,23 @@ let lex src = let b = trim body in if b = "" then Error "empty tag {{}}" else + (* Every sigil form (var, #, ^, /) resolves a dotted path; an + empty path ("{{.}}", "{{#}}", "{{^}}", "{{/}}") names + nothing -- there is no "current context" concept for a bare + dot to mean, so it is a parse error rather than an invented + behaviour Task 3 would have to define. *) + let with_path ctor rest = + match path rest with + | [] -> Error "empty tag path: {{.}} and {{#}} name nothing" + | p -> Ok (ctor p) + in match b.[0] with - | '#' -> Ok (TOpen (path (String.sub b 1 (String.length b - 1)))) - | '^' -> Ok (TInv (path (String.sub b 1 (String.length b - 1)))) - | '/' -> Ok (TClose (path (String.sub b 1 (String.length b - 1)))) + | '#' -> with_path (fun p -> TOpen p) (String.sub b 1 (String.length b - 1)) + | '^' -> with_path (fun p -> TInv p) (String.sub b 1 (String.length b - 1)) + | '/' -> with_path (fun p -> TClose p) (String.sub b 1 (String.length b - 1)) | '!' -> Ok TComment | '>' -> Error "partials are not supported: a template may not include another file" - | _ -> Ok (TVar (path b)) + | _ -> with_path (fun p -> TVar p) b in (match tag with | Error e -> Error e diff --git a/test/test_template.ml b/test/test_template.ml index dee281b..cfb3b04 100644 --- a/test/test_template.ml +++ b/test/test_template.ml @@ -42,12 +42,36 @@ let test_unterminated_tag_is_an_error () = (* The safety promise (spec section 5): a template is data, never a program. There is no raw/triple-brace form to opt out of escaping, and no partial. *) let test_no_raw_or_partial_form () = - Alcotest.(check bool) "triple brace is not an unescaped var" true - (match T.parse "{{{name}}}" with Ok [ T.Var [ "{name" ] ] -> false | Ok _ -> true | Error _ -> true); + (* {{{name}}} is not a triple-brace "unescaped" form -- there is no such + form in this engine, so this assertion states what parsing it ACTUALLY + produces rather than gesturing at a guarantee it cannot check: the + lexer only recognises double braces, so it reads an ordinary var whose + path is the literal string "{name", then a leftover "}" as text. The + real guarantee against a raw form is structural, not this assertion: + [node] has exactly four constructors -- Text, Var, Section, Inverted -- + and none of them is raw/unescaped. If [node] ever grows a fifth, raw + constructor, this test is not what will catch it. *) + Alcotest.(check bool) "triple brace parses as var + stray text" true + (parse_ok "{{{name}}}" = [ T.Var [ "{name" ]; T.Text "}" ]); match T.parse "{{>partial}}" with | Error _ -> () | Ok _ -> Alcotest.fail "partials must not parse: a template may not pull in another file" +(* No "current context" concept exists in this engine (sections push an + object; lookup falls back outward), so a bare-dot or empty-sigil path has + no meaning. Reject at parse time rather than inventing behaviour Task 3's + renderer would otherwise have to define for a case nobody designed. *) +let test_empty_path_is_an_error () = + let expect_error label s = + match T.parse s with + | Error _ -> () + | Ok _ -> Alcotest.failf "%s: an empty tag path must be a parse error" label + in + expect_error "{{.}}" "{{.}}"; + expect_error "{{ . }}" "{{ . }}"; + expect_error "{{#}}{{/}}" "{{#}}{{/}}"; + expect_error "{{^}}{{/}}" "{{^}}{{/}}" + let suite = ( "Template/parse", [ Alcotest.test_case "plain text" `Quick test_plain_text; @@ -58,4 +82,5 @@ let suite = Alcotest.test_case "unclosed section errors" `Quick test_unclosed_section_is_an_error; Alcotest.test_case "mismatched close errors" `Quick test_mismatched_close_is_an_error; Alcotest.test_case "unterminated tag errors" `Quick test_unterminated_tag_is_an_error; - Alcotest.test_case "no raw or partial form" `Quick test_no_raw_or_partial_form ] ) + Alcotest.test_case "no raw or partial form" `Quick test_no_raw_or_partial_form; + Alcotest.test_case "empty path errors" `Quick test_empty_path_is_an_error ] ) -- cgit v1.3 From da9cf402ceed8102aec1a9d008f8e918a23d39f3 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 08:17:30 +0200 Subject: feat(render): template renderer with mandatory escaping Every interpolated value is escaped for the template's flavour; the template's own literal text never is, because that is the author's markup. There is no raw form, so a template cannot opt out. Scope is a stack with outward fallback, so a grid template can reach the year number from inside a week without the view duplicating it into every cell. A missing key renders empty -- the one deliberate silence, so a template survives a rite that does not set every optional field. Mutation-tested: dropping the Escape.apply call reddens the data-cannot-escape-flavour case. --- lib/render/template.ml | 55 ++++++++++++++++++++++++++++++++++ lib/render/template.mli | 9 ++++++ test/test_colitur.ml | 3 +- test/test_template.ml | 79 +++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 145 insertions(+), 1 deletion(-) (limited to 'lib/render') diff --git a/lib/render/template.ml b/lib/render/template.ml index 3e35d53..7efa92b 100644 --- a/lib/render/template.ml +++ b/lib/render/template.ml @@ -94,3 +94,58 @@ let build items = go [] [] items let parse src = match lex src with Error e -> Error e | Ok items -> build items + +(* Scope is a STACK, innermost first: a section pushes its own object, and a + lookup falls back outward. Without the fallback a grid template could not + reach the year number from inside a week. *) +let rec lookup stack path = + match stack with + | [] -> None + | top :: rest -> ( + match descend top path with Some v -> Some v | None -> lookup rest path) + +and descend v path = + match (v, path) with + | _, [] -> Some v + | Obj kvs, k :: tl -> ( + match List.assoc_opt k kvs with Some v' -> descend v' tl | None -> None) + | _ -> None + +let truthy = function + | Bool b -> b + | Str "" -> false + | Str _ -> true + | List [] -> false + | List _ -> true + | Obj _ -> true + +let render ~flavour nodes value = + let b = Buffer.create 4096 in + let rec go stack nodes = + List.iter + (fun node -> + match node with + | Text t -> Buffer.add_string b t + | Var p -> ( + match lookup stack p with + | Some (Str s) -> Buffer.add_string b (Escape.apply flavour s) + | Some (Bool true) -> Buffer.add_string b "true" + | Some (Bool false) -> () + | Some (List _) | Some (Obj _) | None -> ()) + | Section (p, body) -> ( + match lookup stack p with + | None -> () + | Some (List items) -> List.iter (fun it -> go (it :: stack) body) items + | Some v when truthy v -> go (v :: stack) body + | Some _ -> ()) + | Inverted (p, body) -> ( + match lookup stack p with + | None -> go stack body + | Some v -> if not (truthy v) then go stack body)) + nodes + in + go [ value ] nodes; + Buffer.contents b + +let render_string ~flavour src value = + match parse src with Error e -> Error e | Ok nodes -> Ok (render ~flavour nodes value) diff --git a/lib/render/template.mli b/lib/render/template.mli index 3f9ef97..4118496 100644 --- a/lib/render/template.mli +++ b/lib/render/template.mli @@ -26,3 +26,12 @@ type node = (** Never raises; a malformed template is an [Error] with a human-readable reason, because the template is user input. *) val parse : string -> (node list, string) result + +(** Render against a value. Escaping is applied to every interpolated value and + NEVER to the template's own literal text, which is the author's markup. + A missing key renders as the empty string -- the one deliberate silence, so + that a template survives a rite that does not set every optional field. *) +val render : flavour:Escape.flavour -> node list -> value -> string + +(** [parse] then [render]. *) +val render_string : flavour:Escape.flavour -> string -> value -> (string, string) result diff --git a/test/test_colitur.ml b/test/test_colitur.ml index a264174..f12dab5 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -8,4 +8,5 @@ let () = ("lectionary", Test_lectionary.suite); ("lectionary-ef", Test_lectionary_ef.suite); Test_escape.suite; - Test_template.suite ] + Test_template.suite; + Test_template.render_suite ] diff --git a/test/test_template.ml b/test/test_template.ml index cfb3b04..b83c378 100644 --- a/test/test_template.ml +++ b/test/test_template.ml @@ -84,3 +84,82 @@ let suite = Alcotest.test_case "unterminated tag errors" `Quick test_unterminated_tag_is_an_error; Alcotest.test_case "no raw or partial form" `Quick test_no_raw_or_partial_form; Alcotest.test_case "empty path errors" `Quick test_empty_path_is_an_error ] ) + +module E = Colitur_render.Escape + +let render ?(flavour = E.None_) tpl v = + match T.render_string ~flavour tpl v with Ok s -> s | Error e -> Alcotest.failf "render: %s" e + +let obj kvs = T.Obj kvs + +let test_render_var () = + Alcotest.(check string) "var" "Hilary" (render "{{name}}" (obj [ ("name", T.Str "Hilary") ])); + Alcotest.(check string) "dotted" "Hilarii" + (render "{{name.la}}" (obj [ ("name", obj [ ("la", T.Str "Hilarii") ]) ])) + +(* A missing key renders empty. This is the ONE silent case, and it is + deliberate: a template written for a rite that does not set every optional + field must still render (spec section 5). *) +let test_missing_key_is_empty () = + Alcotest.(check string) "missing" "[]" (render "[{{nope}}]" (obj [ ("name", T.Str "x") ])) + +let test_section_iterates () = + let v = obj [ ("days", T.List [ obj [ ("dom", T.Str "1") ]; obj [ ("dom", T.Str "2") ] ]) ] in + Alcotest.(check string) "iterate" "1|2|" (render "{{#days}}{{dom}}|{{/days}}" v) + +let test_bool_section () = + Alcotest.(check string) "true" "yes" (render "{{#f}}yes{{/f}}" (obj [ ("f", T.Bool true) ])); + Alcotest.(check string) "false" "" (render "{{#f}}yes{{/f}}" (obj [ ("f", T.Bool false) ])); + Alcotest.(check string) "inverted true" "" (render "{{^f}}no{{/f}}" (obj [ ("f", T.Bool true) ])); + Alcotest.(check string) "inverted false" "no" (render "{{^f}}no{{/f}}" (obj [ ("f", T.Bool false) ])) + +let test_empty_list_section_is_skipped () = + Alcotest.(check string) "empty list" "" (render "{{#days}}x{{/days}}" (obj [ ("days", T.List []) ])); + Alcotest.(check string) "inverted empty list" "none" + (render "{{^days}}none{{/days}}" (obj [ ("days", T.List []) ])) + +let test_outer_scope_visible_inside_section () = + let v = obj [ ("year", T.Str "2027"); ("days", T.List [ obj [ ("dom", T.Str "1") ] ]) ] in + Alcotest.(check string) "outer visible" "2027-1" + (render "{{#days}}{{year}}-{{dom}}{{/days}}" v) + +(* THE safety property (spec section 9.2): a data value can never escape its + flavour. This is the test that must redden if any escape rule is broken. *) +let test_data_cannot_escape_flavour () = + let nasty = obj [ ("name", T.Str "A & B \\ 50% {x} $y_z") ] in + let out = render ~flavour:E.Latex "{{name}}" nasty in + Alcotest.(check string) "fully escaped" "A \\& B \\textbackslash{} 50\\% \\{x\\} \\$y\\_z" out; + let hout = render ~flavour:E.Html "{{name}}" (obj [ ("name", T.Str "