content: asSx wire string-escaping (String>>sxEscaped) + 5 tests (243/243)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 58s

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-06-07 01:03:45 +00:00
parent 2c1d8c8064
commit 9c1c8f6b75
5 changed files with 60 additions and 18 deletions

View File

@@ -6,9 +6,9 @@
;; children's renderings, so (asHTML doc) / (asSx doc) are pure polymorphic
;; sends with no type dispatch in the SX layer.
;;
;; 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).
;; Escaping happens HERE, at the boundary. asHTML routes text/attrs through
;; String>>htmlEscaped (& < > "); asSx routes them through String>>sxEscaped
;; (\ and ") so values cannot break out of an element or an SX string literal.
(define
content-bootstrap-render!
@@ -19,6 +19,10 @@
"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!
"String"
"sxEscaped"
"sxEscaped | out i n c | out := ''. n := self size. i := 1. [i <= n] whileTrue: [c := self at: i. (c = $\\) ifTrue: [out := out , '\\\\'] ifFalse: [(c = $\") ifTrue: [out := out , '\\\"'] ifFalse: [out := out , c asString]]. i := i + 1]. ^ out")
(ct-def-method!
"CtHeading"
"asHTML"
@@ -55,20 +59,29 @@
(ct-def-method!
"CtHeading"
"asSx"
"asSx | t | t := level printString. ^ '(h' , t , ' \"' , text , '\")'")
(ct-def-method! "CtText" "asSx" "asSx ^ '(p \"' , text , '\")'")
(ct-def-method! "CtCode" "asSx" "asSx ^ '(pre (code \"' , text , '\"))'")
(ct-def-method! "CtQuote" "asSx" "asSx ^ '(blockquote \"' , text , '\")'")
"asSx | t | t := level printString. ^ '(h' , t , ' \"' , text sxEscaped , '\")'")
(ct-def-method! "CtText" "asSx" "asSx ^ '(p \"' , text sxEscaped , '\")'")
(ct-def-method!
"CtCode"
"asSx"
"asSx ^ '(pre (code \"' , text sxEscaped , '\"))'")
(ct-def-method!
"CtQuote"
"asSx"
"asSx ^ '(blockquote \"' , text sxEscaped , '\")'")
(ct-def-method!
"CtImage"
"asSx"
"asSx ^ '(img :src \"' , src , '\" :alt \"' , alt , '\")'")
(ct-def-method! "CtEmbed" "asSx" "asSx ^ '(iframe :src \"' , url , '\")'")
"asSx ^ '(img :src \"' , src sxEscaped , '\" :alt \"' , alt sxEscaped , '\")'")
(ct-def-method!
"CtEmbed"
"asSx"
"asSx ^ '(iframe :src \"' , url sxEscaped , '\")'")
(ct-def-method! "CtDivider" "asSx" "asSx ^ '(hr)'")
(ct-def-method!
"CtList"
"asSx"
"asSx | tag | tag := ordered ifTrue: ['ol'] ifFalse: ['ul']. ^ '(' , tag , ' ' , (items inject: '' into: [:a :x | a , '(li \"' , x , '\")']) , ')'")
"asSx | tag | tag := ordered ifTrue: ['ol'] ifFalse: ['ul']. ^ '(' , tag , ' ' , (items inject: '' into: [:a :x | a , '(li \"' , x sxEscaped , '\")']) , ')'")
(ct-def-method!
"CtDoc"
"asSx"