From cff43523a86dcfa75bff8b50660ac3e60f798882 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 31 May 2023 19:08:55 -0700
Subject: Fix lack of escaping for constant items.

* who.tl (tree-to-template): Recognize string elements
and html-encode them at macro time before adding
to list. Recognize (noesc ...) syntax to defeat this.
Error if it isn't given one argument that is a constant.

* test/simple.tl: New test cases 46 to 49.

* README.md: Document new differences between
CL-WHO and TL-WHO.
---
 README.md      | 21 +++++++++++++++++++--
 test/simple.tl | 37 +++++++++++++++++++++++++++++++++++++
 who.tl         |  8 ++++++++
 3 files changed, 64 insertions(+), 2 deletions(-)

diff --git a/README.md b/README.md
index 3ef41c6..32a5f1a 100644
--- a/README.md
+++ b/README.md
@@ -51,7 +51,7 @@ properties, those are the attributes:
     ::text
     (:a :href "foo.html")
     -> <a href="foo.html"></a>
-    
+
     (:a :href "foo.html" :target "__blank")
     -> <a href="foo.html" target="__blank"></a>
 
@@ -165,7 +165,9 @@ Here are the differences to be aware of:
         "<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.
+    of constant string material, of attributes, and of material added
+    by local macro `fmt`.
+
     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
@@ -178,12 +180,27 @@ Here are the differences to be aware of:
                   (: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>"
 
+    Not escaping constant material is error-prone.
+    The CL-WHO user has to remember to write (:div "black&amp;white")
+    whereas the TL-WHO user just writes (:div "black&white"); the &amp;
+    escape is produced by TL-WHO.
+
 *   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")
 
+    A more limited form of `noesc` can be used in tag bodies,
+    to defeat the default escaping applied to constant material.
+
+    The following:
+
+        ::text
+        (:div (noesc "&amp;") " &lt;")
+
+    produces `<div>&amp; &amp;lt;</div>`.
+
 *   TL-WHO provides a `noesc-fmt` which doesn't HTML-escape.
 
 *   TL-WHO provides `escq` and `escj` local macros. `escq` is like `esc`
diff --git a/test/simple.tl b/test/simple.tl
index 4dc5b88..6f9464d 100644
--- a/test/simple.tl
+++ b/test/simple.tl
@@ -487,3 +487,40 @@
         (:div :span (fmt "~a&" 42)
               :color (escj "</script>")))
       "<div span='42&amp;' color='&lt;\\/script&gt;'></div>")
+
+;;; 46
+;;; Test that literal material is being escaped
+(test (with-html-output-to-string (out)
+        (:div :attr "&" "this & that"))
+      "<div attr='&amp;'>this &amp; that</div>")
+
+;;; 47
+;;; Test for issues in JS <script> escaping.
+(test (with-html-output-to-string (out)
+        (:script
+          "var x = a&lt; // </script>\n"
+          "var nl = \"" (escj "\n") "\";\n"))
+      "<script>var x = a&amp;lt; // &lt;/script&gt;\n \
+       var nl = \"\\n\";\n \
+       </script>")
+
+;;; 48
+;;; Test noesc syntax in tag body.
+(test (with-html-output-to-string (out)
+        (:div
+          (noesc "&")))
+      "<div>&</div>")
+
+;;; 49
+;;; Test noesc with wrong arguments or nonconstant argument
+(test (catch
+        (each ((syntax '((noesc "&" "<")
+                         (noesc)
+                         (noesc *stdout*))))
+          (eval ^(with-html-output-to-string (out)
+                   (:div
+                     ,syntax))))
+        (error (x) (if (and (contains "noesc" x)
+                            (contains "requires" x))
+                     :good)))
+      :good)
diff --git a/who.tl b/who.tl
index 3817e43..b605ba2 100644
--- a/who.tl
+++ b/who.tl
@@ -188,9 +188,17 @@
               ((@(keywordp) .@nil) . @nil))
           ;; the syntax for a tag - process it
          (ncon [process-tag element tree-to-template]))
+        ((noesc @(constantp @item))
+         ;; (noesc ...) syntax on constant
+         (add item))
+        ((noesc . @nil)
+         (compile-error tree "noesc requires single constant argument"))
         (@(consp)
          ;; list - insert as sexp
          (add ^(expander-let ((*indent* , *indent*)) ,element)))
+        (@(stringp)
+         ;; string - insert escaped version
+         (add (html-encode* element)))
         ;; something else - insert verbatim
         (@else (add else))))))
 
-- 
cgit v1.2.3