ywatds/server-wrapper.lisp

(defpackage :ywatds-server-wrapper
  (:use :cl)
  (:nicknames :ywsw)
  (:export :toxml :safe-text-route))
(in-package :ywsw)

(defun toxml (l)
  (cond
    ((null l) "")
    ((listp l)
     (let ((tag (car l)) (attrs (cadr l)) (body (cddr l)))
       (format nil "<~a~@[~{ ~a~@[='~a'~]~}~]~:[/~;~:*>~{~a~}<~0@*/~a~]>"
	       tag attrs
	       (loop for i in body collect (toxml i)))))
    ((eql t l) "true")
    (t (format nil "~a" l))))

(defmacro wrap-html (title &body body)
  `(progn
     (setf (hunchentoot:content-type*) "text/html")
     (toxml
      `("html" ()
	       ("head" () ("title" () ,,title))
	       ("body" () ,,@body)))))

;; Lazy error handler: deny access if error occurs
(defmacro safe-route (&body body)
  (let ((c (gensym)))
    `(handler-case (progn ,@body)
       (file-error (,c)
	 (setf (hunchentoot:return-code*) 404)
	 (hunchentoot:log-message* :error (format nil "~a" ,c))
	 nil)
       (t (,c)
	 (setf (hunchentoot:return-code*) 403)
	 (hunchentoot:log-message* :error (format nil "~a" ,c))
	 nil))))

(defmacro safe-text-route (options params &body body)
  (let ((name (gensym)) (response (gensym)))
    `(easy-routes:defroute ,name ,options ,params
       (setf (hunchentoot:content-type*) "text/plain")
       (let ((,response (safe-route ,@body)))
	 (if (stringp ,response) ,response nil)))))