Add error page for internal server error

This commit is contained in:
Akira Tempaku 2024-10-03 15:01:40 +09:00
parent 136eff6782
commit b403e6643f
2 changed files with 17 additions and 9 deletions

View file

@ -1,14 +1,22 @@
(defpackage #:hp/middlewares/recoverer
(:use #:cl)
(:use #:cl
#:hsx)
(:local-nicknames (#:tb #:trivial-backtrace))
(:local-nicknames (#:env #:hp/env))
(:export #:*recoverer*))
(in-package #:hp/middlewares/recoverer)
(defun message (condition)
(if (env:dev-mode-p)
(tb:print-backtrace condition :output nil)
"Internal Server Error"))
(defun error-page (condition)
(hsx
(html :lang "ja"
(head
(title "Internal Server Error"))
(body
(main
(h1 "500 Internal Server Error")
(when (env:dev-mode-p)
(pre
(code (tb:print-backtrace condition :output nil)))))))))
(defparameter *recoverer*
(lambda (app)
@ -16,5 +24,5 @@
(handler-case
(funcall app env)
(error (c)
`(500 (:content-type "text/plain")
(,(message c))))))))
`(500 (:content-type "text/html; charset=utf-8")
(,(hsx:render-to-string (error-page c)))))))))

View file

@ -21,8 +21,8 @@
:name "description"
:content (or description "pakuの個人サイト")))
(body :hx-ext "head-support"
(main :class "container mx-auto"
children)))))
(main :class "container mx-auto"
children)))))
(defmethod jg:process-response ((app jg:app) result)
(jg:set-response-header :content-type "text/html; charset=utf-8")