From e8867718be79a6c15c61939676798fb51e344759 Mon Sep 17 00:00:00 2001
From: Matthias Andreas Benkard <code@mail.matthias.benkard.de>
Date: Sun, 1 Mar 2009 17:12:43 +0100
Subject: Output entry content as HTML code.

---
 cljssss-g.clj | 37 +++++++++++++++++++++++++++++++++----
 1 file changed, 33 insertions(+), 4 deletions(-)

diff --git a/cljssss-g.clj b/cljssss-g.clj
index 0311771..ad80a37 100644
--- a/cljssss-g.clj
+++ b/cljssss-g.clj
@@ -2,6 +2,7 @@
   (require [clojure.xml :as xml]
            [clojure.zip :as zip]
            [clojure.contrib.sql :as sql]
+           [clojure.contrib.str-utils :as str-utils]
            clojure.contrib.zip-filter.xml
            compojure)
   (import (org.antlr.stringtemplate StringTemplateGroup)
@@ -182,10 +183,35 @@ to merely being replaced with a div element)?"
     :tag new-tag-name
     :attrs nil))
 
+(defn escape-xml [string]
+  (str-utils/re-gsub #"<" "&#60;"
+                     (str-utils/re-gsub #">" "&#62;" string)))
+
+(defn escape-string [string]
+  (str-utils/re-gsub #"\"" "\\\\\"" string))
+
+(defn print-xml [node]
+  (if (string? node)
+      (print (escape-xml node))
+      (let [{tag :tag, attrs :attrs, content :content} node]
+        (printf "<%s" (name tag))
+        (doseq [[attr-name attr] attrs]
+          (when-not (= attr-name :shape)
+            (printf " %s=\"%s\""
+                    (name attr-name)
+                    (escape-string attr))))
+        (print ">")
+        (doall (map print-xml content))
+        (printf "</%s>" (name tag)))))
+
+(defn print-xml-to-string [xml]
+  (with-out-str (print-xml xml)))
+
 (defn prepare-content
   [xml]
   "Make HTML content safe for displaying by removing suspicious content."
-  ;; FIXME: Output a string rather than a tree.
+  ;; FIXME: Remove Javascript href and src attributes.
+  ;; FIXME: Remove on<foo> handler attributes such as onclick.
   (let [tree (-> (zip/xml-zip xml)
                  (zip/edit retag :div))]
     (loop [loc tree]
@@ -197,6 +223,9 @@ to merely being replaced with a div element)?"
                           (tag-to-kill? node) (zip/remove loc)
                           true (zip/edit loc retag :span)))))))))
 
+(defn prepare-content-string [xml]
+  (print-xml-to-string (prepare-content xml)))
+
 (defn entry-xhtml-content [entry]
   (sql/with-query-results
        [{content :content, content-type :content_type}]
@@ -208,11 +237,11 @@ to merely being replaced with a div element)?"
       (cond (nil? content)
               nil
             (= content-type "xhtml")
-              (prepare-content (xml/parse (make-string-input content)))
+              (prepare-content-string (xml/parse (make-string-input content)))
             (or (= content-type "html") (= content-type "text/html"))
-              (prepare-content (html->xhtml (unescape content)))
+              (prepare-content-string (html->xhtml (unescape content)))
             (or (= content-type "text") (nil? content-type))
-              (prepare-content (text->xhtml content))
+              (prepare-content-string (text->xhtml content))
             true
               nil))))
 
-- 
cgit v1.2.3