From 271e541893c4d10b3b4fa8f20cb6c54f0af2527e Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Mon, 29 May 2023 19:14:11 -0700 Subject: Fix CL-WHO attr bugs: no escaping, poor constant handling. CL-WHO tries to handle the case when attribute values are constant NIL and T values, but it bungles it; it applies the correct behavior only when the constants are literally these symbols, not when they are constant expressions which evaluate to these values. Secondly, CL-WHO neglects to HTML-escape attribute values. We fix this behavior and introduce a noesc operator to selectively revert it, as well as a *cl-who-compat* special to revert the behavior more pervasively, for the daredevils. * packages.tl (tl-who): New symbols *cl-who-compat* and noesc. * specials.tl (*cl-who-compat*): New special variable. * who.tl (convert-attributes): When treating a constant expression, evaluate it first, then check for nil or t. Escape interpolated text with html-encode. Check the original expression for (noesc ...) pattern, or the presence of *cl-who-compat*. In these cases, don't generate the escape call. * test/simple.tl: New tests 28 to 37 providing some coverage to all these changes. * README.md: Document. --- README.md | 42 +++++++++++++++++++++++++++++++++++ packages.tl | 2 ++ specials.tl | 8 +++++++ test/simple.tl | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ who.tl | 49 ++++++++++++++++++++++++----------------- 5 files changed, 150 insertions(+), 20 deletions(-) diff --git a/README.md b/README.md index 71d6773..b443472 100644 --- a/README.md +++ b/README.md @@ -139,6 +139,48 @@ Here are the differences to be aware of: The binding construct `expander-let` must be used, or else the variable's global binding must be assigned. +* CL-WHO has some bugs around attribute handling. When the value of an + attribute is a constant expression, only the specific values `T` + and `NIL` are treated properly, not constant expressions which evaluate + to `T` and `NIL`. Then we see the mistaken attribute values `'NIL` and `'T'`: + This works properly in TL-WHO: + + ::text + [1]> (in-package :cl-who) + # + WHO[2]> (with-html-output-to-string (str) + (:foo :bar t)) + "" + WHO[3]> (with-html-output-to-string (str) + (:foo :bar (quote t))) + "" + WHO[4]> (with-html-output-to-string (str) + (:foo :bar nil)) + "" + WHO[5]> (with-html-output-to-string (str) + (:foo :bar 'nil)) + "" + +* TL-WHO fixes the issue that CL-WHO doesn't HTML-escape the values of + attributes, and that its local macro `fmt` likewise doesn't escape. + This is a potential security issue, because if an untrusted value + is interpolated, it can be a vector for an injection attack. + The special variable `*cl-who-compat*` can be set true to disable the + escaping, but is not recommended. + + ::text + [1]> (in-package :cl-who) + # + WHO[2]> (with-html-output-to-string (out) + (:a :href "https://example.com'>malicious heremalicious hereclick me" + +* TL-WHO provides a `noesc` syntax. When the value of an attribute is + expressed as `(noesc )`, escaping is disabled: + + ::text + (:a :href (noesc trusted-url) "click me") + Additionally, users (of CL-WHO and TL-WHO alike) are advised to watch for the following issue: the CL-WHO documentation is not accurately maintained and makes some references to material that no longer exists in CL-WHO, such as the diff --git a/packages.tl b/packages.tl index eb62f6a..55c867c 100644 --- a/packages.tl +++ b/packages.tl @@ -34,6 +34,7 @@ "*html-no-indent-tags*" "*html-empty-tags*" "*html-empty-tag-aware-p*" + "*cl-who-compat*" "conc" "convert-attributes" "convert-tag-to-string-list" @@ -42,6 +43,7 @@ "htm" "html-mode" "str" + "noesc" "with-html-output" "with-html-output-to-string")) diff --git a/specials.tl b/specials.tl index e743e1b..941bdf4 100644 --- a/specials.tl +++ b/specials.tl @@ -113,5 +113,13 @@ ;; (defvar *html-empty-tag-aware-p* t) +;; Change certain TL-WHO behaviors to original CL-WHO behaviors. These +;; are behaviors TL-WHO changed in order to improve the security. +;; TL-WHO performs implicit HTML escaping on the output of the +;; expressions that calculate attribute values. TL-WHO's fmt function +;; also escapes the formatted output. If this varaible is twrue, these +;; behaviors revert to the CL-WHO behaviors of not escaping. +(defvar *cl-who-compat* nil) + ;; Used for indentation. (defconstant +newline+ "\n") diff --git a/test/simple.tl b/test/simple.tl index 374bc7e..7645901 100644 --- a/test/simple.tl +++ b/test/simple.tl @@ -361,3 +361,72 @@
\n \ \

Bar

\n \
") + +;;; TL-WHO Tests + +;;; 28 +;;; Test that non-constant t attribute value treated same as constant t. +(test (let ((attr-val t)) + (with-html-output-to-string (out) + (:foo :bar attr-val))) + "") + +;;; 29 +;;; Test that non-constant nil attribute value treated same as constant t. +(test (let ((attr-val nil)) + (with-html-output-to-string (out) + (:foo :bar attr-val))) + "") + +;;; 30 +;;; Test that complex constant evaluating to t is treated right. +(test (with-html-output-to-string (out) + (:foo :bar (quote t))) + "") + +;;; 31 +;;; Test that complex constant nil attribute value treated right. +(test (with-html-output-to-string (out) + (:foo :bar (quote nil))) + "") + +;;; 32 +;;; Test that we escape a constant string attribute properly. +(test (with-html-output-to-string (out) + (:foo :bar "'blah")) + "") + +;;; 33 +;;; Test that we escape a non-constant string attribute properly. +(test (let ((attr-val "'blah")) + (with-html-output-to-string (out) + (:foo :bar attr-val))) + "") + +;;; 34 +;;; Test that noesc works for constant. +(test (with-html-output-to-string (out) + (:foo :bar (noesc "'blah"))) + "'>") + +;;; 35 +;;; Test that noesc works for non-constant. +(test (let ((attr-val "'blah")) + (with-html-output-to-string (out) + (:foo :bar (noesc attr-val)))) + "'>") + +;;; 36 +;;; Test that *cl-who-compat* defeats escaping for constant. +(test (expander-let ((*cl-who-compat* t)) + (with-html-output-to-string (out) + (:foo :bar (noesc "'blah")))) + "'>") + +;;; 37 +;;; Test that *cl-who-compat* defeats escaping for non-constant. +(test (expander-let ((*cl-who-compat* t)) + (let ((attr-val "'blah")) + (with-html-output-to-string (out) + (:foo :bar (noesc attr-val))))) + "'>") diff --git a/who.tl b/who.tl index 2683450..3c4a440 100644 --- a/who.tl +++ b/who.tl @@ -92,26 +92,35 @@ (with-gensyms (=var=) (let ((aqc *attribute-quote-char*)) (keep-matches (^(,orig-attr . ,val) attr-list) - (let ((attr (maybe-upcase orig-attr))) - (if val - (if (constantp val) - ;; Handle constant attribute value at macro time - (if (and *empty-attribute-syntax* (eq val t)) - ` @attr` - ` @attr=@aqc@(if (eq val t) - attr - (tostringp (eval val)))@aqc`) - ;; For non-constant, do the same things as above but at runtime - ^(let ((,=var= ,val)) - (cond - ((null ,=var=)) - ((eq ,=var= t) - (str ,(if *empty-attribute-syntax* - ^` @,attr` - ^` @,attr=@,aqc@,attr@,aqc`))) - (t - (str ` @,attr=@,aqc@{,=var=}@,aqc`))))))))))) - + (let ((attr (maybe-upcase orig-attr)) + noesc) + (when-match (noesc . @rest) val + (set noesc t) + (set val ^(progn ,*rest))) + (if (constantp val) + ;; Handle constant attribute value at macro time + (let ((eval (eval val))) + (cond + ((null eval)) + ((eq eval t) + (if *empty-attribute-syntax* + ` @attr` + ` @attr=@aqc@attr@aqc`)) + ((or noesc *cl-who-compat*) ;; no escaping in CL-WHO compat mode + ` @attr=@aqc@(tostringp eval)@aqc`) + (t ` @attr=@aqc@(html-encode (tostringp eval))@aqc`))) + ;; For non-constant, do the same things as above but at runtime + ^(let ((,=var= ,val)) + (cond + ((null ,=var=)) + ((eq ,=var= t) + (str ,(if *empty-attribute-syntax* + ^` @,attr` + ^` @,attr=@,aqc@,attr@,aqc`))) + (t + ,(if (or noesc *cl-who-compat*) + ^(str ` @,attr=@,aqc@{,=var=}@,aqc`) + ^(str ` @,attr=@,aqc@(html-encode ,=var=)@,aqc`))))))))))) ;; Used by process-tag to convert `HTML' into a list ;; of strings. tag is a keyword symbol naming the outer tag, attr-list -- cgit v1.2.3