diff options
Diffstat (limited to 'cljssss-g.clj')
| -rw-r--r-- | cljssss-g.clj | 37 |
1 files 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 #"<" "<" + (str-utils/re-gsub #">" ">" 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)))) |