content: HTML escaping at render boundary (String>>htmlEscaped) + 8 tests (238/238)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-06-07 00:53:06 +00:00
parent 9722e97e0a
commit 2c1d8c8064
5 changed files with 74 additions and 16 deletions

View File

@@ -6,40 +6,48 @@
;; children's renderings, so (asHTML doc) / (asSx doc) are pure polymorphic ;; children's renderings, so (asHTML doc) / (asSx doc) are pure polymorphic
;; sends with no type dispatch in the SX layer. ;; sends with no type dispatch in the SX layer.
;; ;;
;; NOTE: no HTML escaping yet — text is emitted verbatim. Escaping is a boundary ;; HTML escaping happens HERE, at the boundary: text and attribute values are
;; concern to add before any untrusted content reaches render. ;; passed through String>>htmlEscaped (& < > "), so untrusted content cannot
;; break out of its element. asSx wire output is not yet string-escaped (next).
(define (define
content-bootstrap-render! content-bootstrap-render!
(fn (fn
() ()
(begin (begin
(ct-def-method!
"String"
"htmlEscaped"
"htmlEscaped | out i n c | out := ''. n := self size. i := 1. [i <= n] whileTrue: [c := self at: i. (c = $&) ifTrue: [out := out , '&amp;'] ifFalse: [(c = $<) ifTrue: [out := out , '&lt;'] ifFalse: [(c = $>) ifTrue: [out := out , '&gt;'] ifFalse: [(c = $\") ifTrue: [out := out , '&quot;'] ifFalse: [out := out , c asString]]]]. i := i + 1]. ^ out")
(ct-def-method! (ct-def-method!
"CtHeading" "CtHeading"
"asHTML" "asHTML"
"asHTML | t | t := level printString. ^ '<h' , t , '>' , text , '</h' , t , '>'") "asHTML | t | t := level printString. ^ '<h' , t , '>' , text htmlEscaped , '</h' , t , '>'")
(ct-def-method! "CtText" "asHTML" "asHTML ^ '<p>' , text , '</p>'") (ct-def-method!
"CtText"
"asHTML"
"asHTML ^ '<p>' , text htmlEscaped , '</p>'")
(ct-def-method! (ct-def-method!
"CtCode" "CtCode"
"asHTML" "asHTML"
"asHTML ^ '<pre><code class=\"language-' , language , '\">' , text , '</code></pre>'") "asHTML ^ '<pre><code class=\"language-' , language htmlEscaped , '\">' , text htmlEscaped , '</code></pre>'")
(ct-def-method! (ct-def-method!
"CtQuote" "CtQuote"
"asHTML" "asHTML"
"asHTML ^ '<blockquote>' , text , '</blockquote>'") "asHTML ^ '<blockquote>' , text htmlEscaped , '</blockquote>'")
(ct-def-method! (ct-def-method!
"CtImage" "CtImage"
"asHTML" "asHTML"
"asHTML ^ '<img src=\"' , src , '\" alt=\"' , alt , '\">'") "asHTML ^ '<img src=\"' , src htmlEscaped , '\" alt=\"' , alt htmlEscaped , '\">'")
(ct-def-method! (ct-def-method!
"CtEmbed" "CtEmbed"
"asHTML" "asHTML"
"asHTML ^ '<iframe src=\"' , url , '\"></iframe>'") "asHTML ^ '<iframe src=\"' , url htmlEscaped , '\"></iframe>'")
(ct-def-method! "CtDivider" "asHTML" "asHTML ^ '<hr>'") (ct-def-method! "CtDivider" "asHTML" "asHTML ^ '<hr>'")
(ct-def-method! (ct-def-method!
"CtList" "CtList"
"asHTML" "asHTML"
"asHTML | tag | tag := ordered ifTrue: ['ol'] ifFalse: ['ul']. ^ '<' , tag , '>' , (items inject: '' into: [:a :x | a , '<li>' , x , '</li>']) , '</' , tag , '>'") "asHTML | tag | tag := ordered ifTrue: ['ol'] ifFalse: ['ul']. ^ '<' , tag , '>' , (items inject: '' into: [:a :x | a , '<li>' , x htmlEscaped , '</li>']) , '</' , tag , '>'")
(ct-def-method! (ct-def-method!
"CtDoc" "CtDoc"
"asHTML" "asHTML"

View File

@@ -2,14 +2,14 @@
"suites": { "suites": {
"block": {"pass": 38, "fail": 0}, "block": {"pass": 38, "fail": 0},
"doc": {"pass": 40, "fail": 0}, "doc": {"pass": 40, "fail": 0},
"render": {"pass": 29, "fail": 0}, "render": {"pass": 37, "fail": 0},
"api": {"pass": 26, "fail": 0}, "api": {"pass": 26, "fail": 0},
"store": {"pass": 29, "fail": 0}, "store": {"pass": 29, "fail": 0},
"crdt": {"pass": 34, "fail": 0}, "crdt": {"pass": 34, "fail": 0},
"sync": {"pass": 14, "fail": 0}, "sync": {"pass": 14, "fail": 0},
"fed": {"pass": 20, "fail": 0} "fed": {"pass": 20, "fail": 0}
}, },
"total_pass": 230, "total_pass": 238,
"total_fail": 0, "total_fail": 0,
"total": 230 "total": 238
} }

View File

@@ -6,10 +6,10 @@ _Generated by `lib/content/conformance.sh`_
|-------|-----:|-----:|------:| |-------|-----:|-----:|------:|
| block | 38 | 0 | 38 | | block | 38 | 0 | 38 |
| doc | 40 | 0 | 40 | | doc | 40 | 0 | 40 |
| render | 29 | 0 | 29 | | render | 37 | 0 | 37 |
| api | 26 | 0 | 26 | | api | 26 | 0 | 26 |
| store | 29 | 0 | 29 | | store | 29 | 0 | 29 |
| crdt | 34 | 0 | 34 | | crdt | 34 | 0 | 34 |
| sync | 14 | 0 | 14 | | sync | 14 | 0 | 14 |
| fed | 20 | 0 | 20 | | fed | 20 | 0 | 20 |
| **Total** | **230** | **0** | **230** | | **Total** | **238** | **0** | **238** |

View File

@@ -1,5 +1,5 @@
;; Phase 1 — render boundary. asHTML / asSx are polymorphic message sends on ;; Phase 1 — render boundary. asHTML / asSx are polymorphic message sends on
;; blocks and the document. ;; blocks and the document. HTML escaping happens at the boundary.
(st-bootstrap-classes!) (st-bootstrap-classes!)
(content-bootstrap-blocks!) (content-bootstrap-blocks!)
@@ -71,3 +71,41 @@
"render after delete" "render after delete"
(asHTML (doc-delete d "p")) (asHTML (doc-delete d "p"))
"<h2>Title</h2><hr>") "<h2>Title</h2><hr>")
;; ── HTML escaping at the boundary ──
(define xh (mk-heading "xh" 2 "A < B & \"C\""))
(define xp (mk-text "xp" "<script>alert(1)</script>"))
(define xi (mk-image "xi" "/a.png?x=1&y=2" "tag <b>"))
(define xl (mk-list "xl" false (list "a<1" "b&2")))
(content-test
"escape heading text"
(asHTML xh)
"<h2>A &lt; B &amp; &quot;C&quot;</h2>")
(content-test
"escape paragraph"
(asHTML xp)
"<p>&lt;script&gt;alert(1)&lt;/script&gt;</p>")
(content-test
"escape image attrs"
(asHTML xi)
"<img src=\"/a.png?x=1&amp;y=2\" alt=\"tag &lt;b&gt;\">")
(content-test
"escape list items"
(asHTML xl)
"<ul><li>a&lt;1</li><li>b&amp;2</li></ul>")
(content-test
"escape ampersand once"
(asHTML (mk-text "amp" "a & b"))
"<p>a &amp; b</p>")
(content-test
"escape in document"
(asHTML (doc-append (doc-empty "e") xp))
"<p>&lt;script&gt;alert(1)&lt;/script&gt;</p>")
(content-test
"no over-escape plain"
(asHTML (mk-text "plain" "hello world"))
"<p>hello world</p>")
(content-test
"escape code body"
(asHTML (mk-code "xc" "html" "<div> & </div>"))
"<pre><code class=\"language-html\">&lt;div&gt; &amp; &lt;/div&gt;</code></pre>")

View File

@@ -19,7 +19,7 @@ injected adapter, not core.
## Status (rolling) ## Status (rolling)
`bash lib/content/conformance.sh`**230/230** (Phases 14 COMPLETE: blocks, doc, render, api, persist op log, CRDT merge, Ghost sync, federation) `bash lib/content/conformance.sh`**238/238** (Phases 14 COMPLETE + extensions: HTML escaping)
## Ground rules ## Ground rules
@@ -75,8 +75,20 @@ lib/content/api.sx ── (content/edit) (content/render) (content/history) ─
- [x] federated documents (peer-authored blocks) — trust-gated stub - [x] federated documents (peer-authored blocks) — trust-gated stub
- [x] tests: round-trip import/export, conflict on concurrent external edit - [x] tests: round-trip import/export, conflict on concurrent external edit
## Extensions (post-roadmap)
- [x] HTML escaping at the render boundary (`String>>htmlEscaped`: & < > ")
- [ ] asSx wire string-escaping (" and \ in SX string literals)
## Progress log ## Progress log
- 2026-06-07 — Extension: HTML escaping at the render boundary. Added
`String>>htmlEscaped` (recursive char walk escaping & < > ", order-safe so &
isn't double-escaped) and routed every `asHTML` text/attr through it — heading,
text, code body + language, quote, image src/alt, embed url, list items.
Render stays fully polymorphic in Smalltalk; escaping lives at the boundary.
+8 render tests (incl. `<script>` payloads, attr breakout, ampersand-once).
asSx wire-escaping deferred to next. Suite 238/238.
- 2026-06-07 — Phase 4 `fed.sx` (**Phase 4 COMPLETE — roadmap done**): - 2026-06-07 — Phase 4 `fed.sx` (**Phase 4 COMPLETE — roadmap done**):
trust-gated federation. Peer ops carry provenance (`:author`, `:sig` stub); trust-gated federation. Peer ops carry provenance (`:author`, `:sig` stub);
none are auto-accepted. The trust gate is a pluggable predicate (acl-on-sx none are auto-accepted. The trust gate is a pluggable predicate (acl-on-sx