diff options
| -rw-r--r-- | README.md | 42 | ||||
| -rw-r--r-- | packages.tl | 2 | ||||
| -rw-r--r-- | specials.tl | 8 | ||||
| -rw-r--r-- | test/simple.tl | 69 | ||||
| -rw-r--r-- | who.tl | 49 |
5 files changed, 150 insertions, 20 deletions
@@ -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) + #<PACKAGE CL-WHO> + WHO[2]> (with-html-output-to-string (str) + (:foo :bar t)) + "<foo bar='bar'></foo>" + WHO[3]> (with-html-output-to-string (str) + (:foo :bar (quote t))) + "<foo bar='T'></foo>" + WHO[4]> (with-html-output-to-string (str) + (:foo :bar nil)) + "<foo></foo>" + WHO[5]> (with-html-output-to-string (str) + (:foo :bar 'nil)) + "<foo bar='NIL'></foo>" + +* 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) + #<PACKAGE CL-WHO> + WHO[2]> (with-html-output-to-string (out) + (:a :href "https://example.com'>malicious here</a><a href='blah" "click me")) + "<a href='https://example.com'>malicious here</a><a href='blah'>click me</a>" + +* TL-WHO provides a `noesc` syntax. When the value of an attribute is + expressed as `(noesc <expr>)`, 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 @@ ;; <tag></tag> (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 @@ <div>\n \ \ <p>Bar</p>\n \ </div>") + +;;; 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))) + "<foo bar='bar'></foo>") + +;;; 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))) + "<foo></foo>") + +;;; 30 +;;; Test that complex constant evaluating to t is treated right. +(test (with-html-output-to-string (out) + (:foo :bar (quote t))) + "<foo bar='bar'></foo>") + +;;; 31 +;;; Test that complex constant nil attribute value treated right. +(test (with-html-output-to-string (out) + (:foo :bar (quote nil))) + "<foo></foo>") + +;;; 32 +;;; Test that we escape a constant string attribute properly. +(test (with-html-output-to-string (out) + (:foo :bar "'blah<tag>")) + "<foo bar=''blah<tag>'></foo>") + +;;; 33 +;;; Test that we escape a non-constant string attribute properly. +(test (let ((attr-val "'blah<tag>")) + (with-html-output-to-string (out) + (:foo :bar attr-val))) + "<foo bar=''blah<tag>'></foo>") + +;;; 34 +;;; Test that noesc works for constant. +(test (with-html-output-to-string (out) + (:foo :bar (noesc "'blah<tag>"))) + "<foo bar=''blah<tag>'></foo>") + +;;; 35 +;;; Test that noesc works for non-constant. +(test (let ((attr-val "'blah<tag>")) + (with-html-output-to-string (out) + (:foo :bar (noesc attr-val)))) + "<foo bar=''blah<tag>'></foo>") + +;;; 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<tag>")))) + "<foo bar=''blah<tag>'></foo>") + +;;; 37 +;;; Test that *cl-who-compat* defeats escaping for non-constant. +(test (expander-let ((*cl-who-compat* t)) + (let ((attr-val "'blah<tag>")) + (with-html-output-to-string (out) + (:foo :bar (noesc attr-val))))) + "<foo bar=''blah<tag>'></foo>") @@ -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 |