Permalink
Browse files

Merge branch 'lost'

  • Loading branch information...
hanshuebner committed Jul 20, 2011
2 parents 9a0eec7 + 13fd914 commit 817025f4a8eb7805a0a34ddb21b72f8ef4d60bb4
Showing with 32 additions and 16 deletions.
  1. +2 −1 src/web/tags.lisp
  2. +30 −15 src/web/template-handler.lisp
View
@@ -23,7 +23,8 @@
(define-bknr-tag redirect-request (&key target)
;; target here is relative to the current request
- (redirect (princ-to-string (puri:merge-uris target (script-name*)))))
+ (redirect (princ-to-string
+ (puri:merge-uris target (format nil "~@[~A~]~A" (header-in* :origin) (script-name*))))))
(define-bknr-tag select-box (name options &key (size 1) default)
(html ((:select :name name :size size)
@@ -313,29 +313,44 @@ name has been specified.")
(defmethod error-template-pathname (handler &optional (error-type "user-error"))
(find-template-pathname handler error-type))
-(defun send-error-response (handler message &key (response-code +http-internal-server-error+))
+(defun send-error-response (handler message backtrace &key (response-code +http-internal-server-error+))
(with-http-response (:content-type "text/html; charset=UTF-8"
:response response-code)
(with-output-to-string (stream)
(emit-template handler
stream
(get-cached-template (error-template-pathname handler) handler)
- (acons :error-message message
- (initial-template-environment
- handler))))))
+ (acons :error message
+ (acons :backtrace backtrace
+ (initial-template-environment handler)))))))
(defun invoke-with-error-handlers (fn handler)
- (handler-case
- (funcall fn)
- (user-error (c)
- (send-error-response handler (apply #'format
- nil
- (simple-condition-format-control c)
- (simple-condition-format-arguments c))
- :response-code +http-ok+))
- (serious-condition (c)
- (warn "unexpected failure: ~A" c)
- (send-error-response handler (format nil "Internal Error:~%~%~A~%" c)))))
+ ;; For now, remove our own error template mechanism and instead rely
+ ;; on hunchentoot's error handling, which should be sufficient
+ ;; anyway.
+ (declare (ignore handler))
+ (funcall fn)
+ #+(or)
+ (let (backtrace)
+ (handler-case
+ (handler-bind
+ ((error (lambda (e)
+ (declare (ignore e))
+ (setf backtrace (with-output-to-string (s)
+ #+sbcl
+ (sb-debug:backtrace 30 s))))))
+ (funcall fn))
+ (user-error (c)
+ (send-error-response handler
+ (apply #'format
+ nil
+ (simple-condition-format-control c)
+ (simple-condition-format-arguments c))
+ backtrace
+ :response-code +http-ok+))
+ (serious-condition (c)
+ (warn "unexpected failure: ~A" c)
+ (send-error-response handler backtrace (format nil "Internal Error:~%~%~A~%" c))))))
(defmacro with-error-handlers ((handler) &body body)
`(invoke-with-error-handlers (lambda () ,@body) ,handler))

0 comments on commit 817025f

Please sign in to comment.