89 lines
2.9 KiB
Common Lisp
89 lines
2.9 KiB
Common Lisp
;;;; errors.lisp
|
|
|
|
(defpackage :lspx.errors
|
|
(:use :cl)
|
|
(:local-nicknames (:a :alexandria))
|
|
(:import-from :html-entities :encode-entities)
|
|
(:import-from :trivial-backtrace :print-backtrace)
|
|
(:import-from :lspx.template
|
|
:deftemplate :maybe-render-template
|
|
:maybe-defragment-html)
|
|
(:export
|
|
:generate-error-handlers
|
|
:with-printable-backtrace
|
|
*http-errors* *html-backtrace*))
|
|
|
|
(in-package :lspx.errors)
|
|
|
|
(eval-when (:compile-toplevel :execute :load-toplevel)
|
|
(defparameter *html-backtrace* nil)
|
|
|
|
(defparameter *http-errors*
|
|
'((404 "404 - page not found")
|
|
500 501)
|
|
"list of HTTP codes to generate error pages for
|
|
|
|
if an element is a list, we assume CDR is an HTML string to return for the error
|
|
otherwise, we just return an empty response"))
|
|
|
|
(a:define-constant +backtrace-html-style+
|
|
"
|
|
html {
|
|
white-space: pre-line;
|
|
background: #505A5B;
|
|
color: #DCEDFF;
|
|
font-family: Chalkboard, Comic Sans MS, Calibri, Sans Serif;
|
|
}
|
|
|
|
a {
|
|
color: #94B0DA;
|
|
}
|
|
|
|
p {
|
|
padding: 2%;
|
|
}"
|
|
:test #'string=)
|
|
|
|
(deftemplate "Internal--BackTrace" (inner)
|
|
(format nil "<!DOCTYPE html><head><title>LSPX Error - Backtrace</title><style>~A</style></head><html><body><p>~A</p></body></html>"
|
|
+backtrace-html-style+ inner))
|
|
|
|
(defmacro with-printable-backtrace (&body body)
|
|
"quick macro to wrap up printing backtraces in case of a request error"
|
|
`(handler-case ,@body
|
|
(error (e)
|
|
(if *html-backtrace*
|
|
(list 500 nil
|
|
(list (maybe-render-template "Internal--BackTrace"
|
|
"<Internal--BackTrace>~A</Internal--BackTrace>"
|
|
(str:replace-all
|
|
(string #\newline) "<br/>"
|
|
(encode-entities (print-backtrace e :output nil))))))
|
|
(prog1 (500-handler)
|
|
(log:error "~%~A" (print-backtrace e :output nil)))))))
|
|
|
|
(defmacro http-error (code &optional html)
|
|
"defines an http error handler function of the form <CODE>-HANDLER (e.g., 404-handler)
|
|
|
|
if HTML is provided that value is returned to the user when the error occurs. otherwise nothing is returned and the backend returns it's default value
|
|
|
|
automatically exports generated handler function"
|
|
(let* ((package #.(find-package :lspx.errors))
|
|
(handler-name (format nil "~:@(~A-HANDLER~)" code)))
|
|
`(progn
|
|
(defun ,(intern handler-name package) ()
|
|
'(,code nil ,(when html `(,html))))
|
|
(export ',(intern handler-name package) ,package))))
|
|
|
|
(defmacro generate-error-handlers ()
|
|
"iterates over all values in *HTTP-ERRORS* and generates error handlers based off of the values within"
|
|
`(progn
|
|
,@(loop :for c :in *http-errors*
|
|
:if (listp c)
|
|
:collect `(http-error ,(car c) ,(cadr c))
|
|
:else
|
|
:collect `(http-error ,c))))
|
|
|
|
(eval-when (:compile-toplevel :execute :load-toplevel)
|
|
(generate-error-handlers))
|