coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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
Details

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

26
lib/content/render.sx
View File

@@ -6,40 +6,48 @@
;; children's renderings, so (asHTML doc) / (asSx doc) are pure polymorphic
;; sends with no type dispatch in the SX layer.
;;
;; NOTE: no HTML escaping yet — text is emitted verbatim. Escaping is a boundary
;; concern to add before any untrusted content reaches render.
;; HTML escaping happens HERE, at the boundary: text and attribute values are
;; passed through String>>htmlEscaped (& < > "), so untrusted content cannot
;; break out of its element. asSx wire output is not yet string-escaped (next).
(define
content-bootstrap-render!
(fn
()
(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!
"CtHeading"
"asHTML"
"asHTML | t | t := level printString. ^ '<h' , t , '>' , text , '</h' , t , '>'")
(ct-def-method! "CtText" "asHTML" "asHTML ^ '<p>' , text , '</p>'")
"asHTML | t | t := level printString. ^ '<h' , t , '>' , text htmlEscaped , '</h' , t , '>'")
(ct-def-method!
"CtText"
"asHTML"
"asHTML ^ '<p>' , text htmlEscaped , '</p>'")
(ct-def-method!
"CtCode"
"asHTML"
"asHTML ^ '<pre><code class=\"language-' , language , '\">' , text , '</code></pre>'")
"asHTML ^ '<pre><code class=\"language-' , language htmlEscaped , '\">' , text htmlEscaped , '</code></pre>'")
(ct-def-method!
"CtQuote"
"asHTML"
"asHTML ^ '<blockquote>' , text , '</blockquote>'")
"asHTML ^ '<blockquote>' , text htmlEscaped , '</blockquote>'")
(ct-def-method!
"CtImage"
"asHTML"
"asHTML ^ '<img src=\"' , src , '\" alt=\"' , alt , '\">'")
"asHTML ^ '<img src=\"' , src htmlEscaped , '\" alt=\"' , alt htmlEscaped , '\">'")
(ct-def-method!
"CtEmbed"
"asHTML"
"asHTML ^ '<iframe src=\"' , url , '\"></iframe>'")
"asHTML ^ '<iframe src=\"' , url htmlEscaped , '\"></iframe>'")
(ct-def-method! "CtDivider" "asHTML" "asHTML ^ '<hr>'")
(ct-def-method!
"CtList"
"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!
"CtDoc"
"asHTML"