html: Fix emission of 'script' and 'style' elements.

The contents of these elements are not to be escaped.

3 files changed, 47 insertions, 6 deletions

diff --git a/Makefile.am b/Makefile.am
index 1c08890..679fb15 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -97,6 +97,7 @@ endif
 
 TESTS =						\
   tests/helper.scm				\
+  tests/html.scm				\
   tests/post.scm				\
   tests/utils.scm
 
diff --git a/haunt/html.scm b/haunt/html.scm
index 5891cd0..795c572 100644
--- a/haunt/html.scm
+++ b/haunt/html.scm
@@ -1,5 +1,6 @@
 ;;; Haunt --- Static site generator for GNU Guile
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2024 Daniel Meißner <dan_m@posteo.de>
 ;;;
 ;;; This file is part of Haunt.
 ;;;
@@ -53,6 +54,13 @@
   "Return #t if TAG is a void element."
   (pair? (memq tag %void-elements)))
 
+(define %raw-elements
+  '(script style))
+
+(define (raw-element? tag)
+  "Return #t if TAG is a raw element."
+  (pair? (memq tag %raw-elements)))
+
 (define %escape-chars
   (alist->hash-table
    '((#\" . "quot")
@@ -96,12 +104,17 @@ list ATTRS and the child nodes in BODY."
               (display #\space port)
               (attribute->html attr value port)))
             attrs)
-  (if (and (null? body) (void-element? tag))
-      (display " />" port)
-      (begin
-        (display #\> port)
-        (for-each (cut sxml->html <> port) body)
-        (format port "</~a>" tag))))
+  (cond
+   ((and (null? body) (void-element? tag))
+    (display " />" port))
+   ((raw-element? tag)
+    (display #\> port)
+    (for-each (lambda (node) (display node port)) body)
+    (format port "</~a>" tag))
+   (else
+     (display #\> port)
+     (for-each (cut sxml->html <> port) body)
+     (format port "</~a>" tag))))
 
 (define (doctype->html doctype port)
   (format port "<!DOCTYPE ~a>" doctype))
diff --git a/tests/html.scm b/tests/html.scm
new file mode 100644
index 0000000..b475bf5
--- /dev/null
+++ b/tests/html.scm
@@ -0,0 +1,27 @@
+;;; Haunt --- Static site generator for GNU Guile
+;;; Copyright © 2024 Daniel Meißner <dan_m@posteo.de>
+;;;
+;;; This file is part of Haunt.
+;;;
+;;; Haunt is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Haunt is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Haunt.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-html)
+  #:use-module (haunt html)
+  #:use-module (srfi srfi-64)
+  #:use-module (tests helper))
+
+(with-tests "html"
+  (test-equal "content of raw elements are not escaped"
+    "<script>console.log(\"Hello, world!\");</script>"
+    (sxml->html-string '(script "console.log(\"Hello, world!\");"))))