[araneida: html-escaped-stream
Alan-Shields@omrf.ouhsc.edu**20051018190807
Trying to keep track of whether or not you've escaped the HTML properly is
quite a pain. Doing it instead at the stream level seems to work out much better.
Of course, if you have code that already does escaping then you shouldn't use this call.
] {
hunk ./defpackage.lisp 43
- :html :html-escape :html-stream :search-html-tree
+ :html :html-escape :html-stream :html-escaped-stream :search-html-tree
hunk ./html.lisp 48
+(defun html-attr-escaped (attr)
+ (with-output-to-string (o)
+ (loop for (att val . rest) on attr by #'cddr do
+ (if (symbolp att)
+ (progn
+ (princ " " o)
+ (princ (string-downcase (symbol-name att)) o)
+ (princ "=\"" o)
+ (princ (html-escape val) o)
+ (princ "\"" o))
+ (error "attribute ~S is not a symbol in attribute list ~S" att attr)))))
+
hunk ./html.lisp 123
+ t)
+
+(defun html-escaped-stream (stream things &optional inline-elements)
+ "Format supplied argument as HTML, escaping properly.
+Just like html-stream except certain things are now html-escaped.
+Content - in '(p \"foo\") \"foo\" is the content - is escaped,
+as well as the values of attributes. Please note that this CAN
+result in double escaping if calling code also escapes."
+ (declare (optimize (speed 3))
+ (type stream stream))
+ (cond ((and (consp things) (not (stringp (car things))))
+ (let* ((tag (if (consp (car things)) (caar things) (car things)))
+ (attrs (if (consp (car things)) (cdar things) ()))
+ (content (cdr things)))
+ (if (not (empty-element-p tag))
+ (progn
+ (format stream "<~A~A>" (string-downcase (symbol-name tag)) (html-attr-escaped attrs))
+ (dolist (c content)
+ (html-escaped-stream stream c inline-elements))
+ (format stream "~:[~;~%~]" (string-downcase (symbol-name tag)) (not (member tag inline-elements))))
+ (format stream "<~A~A>" (string-downcase (symbol-name tag)) (html-attr-escaped attrs)))))
+ ((consp things)
+ (dolist (thing things) (princ thing stream)))
+ ((keywordp things)
+ (format stream "<~A>" (string-downcase (symbol-name things))))
+ ((functionp things)
+ (funcall things stream))
+ (t
+ (princ (html-escape things) stream)))
hunk ./test-server-walker.pl 58
+# HTML stream basics
+urlin "/html/html-stream", qr[\s*
+ \s*\s*testing\s*
+ \s*\s*\s*foo\s*\s*
+ \s*\s*\|RANDOMID=$randomtext\|\s*
+ \s*\s*]ix;
+
+# Now! With! HTML! Escaping!
+# -- araneida escapes using character codes - that's why these things are the way they are
+urlin "/html/html-escaped-stream", qr[\s*
+ \s*\s*testing\s&\#38;\swaiting\s*
+ \s*\s*\s*foo\s&\#62;\sbar\s*\s*
+ \s*\s*\|RANDOMID=$randomtext\|\s*
+ \s*\s*]ix;
+
+
hunk ./test-server.lisp 103
+#| -------- url: /html/html-stream ------------------ |#
+(defclass html-streamer (araneida:handler) ())
+(defmethod handle-request-response ((handler html-streamer) method request)
+ (request-send-headers request)
+ (html-stream (request-stream request)
+ `(html (body
+ (h1 "testing")
+ (p ((a :href "/foo.html") "foo"))
+ (h1 ,*uniquetext*)))))
+(my-install-handler html-streamer "/html/html-stream")
+
+#| -------- url: /html/html-escaped-stream ------------------ |#
+(defclass html-escaped-streamer (araneida:handler) ())
+(defmethod handle-request-response ((handler html-escaped-streamer) method request)
+ (request-send-headers request)
+ (html-escaped-stream (request-stream request)
+ `(html (body
+ (h1 "testing & waiting")
+ (p ((a :href "/foo.html?a=1&b=2") "foo > bar"))
+ (h1 ,*uniquetext*)))))
+(my-install-handler html-escaped-streamer "/html/html-escaped-stream")
+
}