[bknr-cvs] edi changed trunk/thirdparty/hunchentoot/
BKNR Commits
bknr at bknr.net
Tue Feb 10 10:45:45 UTC 2009
Revision: 4222
Author: edi
URL: http://bknr.net/trac/changeset/4222
Get rid of backtraces
D trunk/thirdparty/hunchentoot/get-backtrace.lisp
U trunk/thirdparty/hunchentoot/hunchentoot.asd
U trunk/thirdparty/hunchentoot/packages.lisp
U trunk/thirdparty/hunchentoot/server.lisp
U trunk/thirdparty/hunchentoot/specials.lisp
Deleted: trunk/thirdparty/hunchentoot/get-backtrace.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/get-backtrace.lisp 2009-02-10 10:32:09 UTC (rev 4221)
+++ trunk/thirdparty/hunchentoot/get-backtrace.lisp 2009-02-10 10:45:45 UTC (rev 4222)
@@ -1,125 +0,0 @@
-;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: HUNCHENTOOT; Base: 10 -*-
-;;; $Header: /usr/local/cvsrep/hunchentoot/port-cmu.lisp,v 1.12 2008/04/08 14:39:18 edi Exp $
-
-;;; Copyright (c) 2004-2009, Dr. Edmund Weitz. All rights reserved.
-
-;;; Redistribution and use in source and binary forms, with or without
-;;; modification, are permitted provided that the following conditions
-;;; are met:
-
-;;; * Redistributions of source code must retain the above copyright
-;;; notice, this list of conditions and the following disclaimer.
-
-;;; * Redistributions in binary form must reproduce the above
-;;; copyright notice, this list of conditions and the following
-;;; disclaimer in the documentation and/or other materials
-;;; provided with the distribution.
-
-;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
-;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
-;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
-;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(in-package :hunchentoot)
-
-#+cmu
-(defun get-backtrace (error)
- "This is the function that is used internally by Hunchentoot to
-show or log backtraces. It accepts a condition object ERROR and
-returns a string with the corresponding backtrace."
- (declare (ignore error))
- (with-output-to-string (s)
- (let ((debug:*debug-print-level* nil)
- (debug:*debug-print-length* nil))
- (debug:backtrace most-positive-fixnum s))))
-
-#+allegro
-(defun get-backtrace (error)
- "This is the function that is used internally by Hunchentoot to
-show or log backtraces. It accepts a condition object ERROR and
-returns a string with the corresponding backtrace."
- (with-output-to-string (s)
- (with-standard-io-syntax
- (let ((*print-readably* nil)
- (*print-miser-width* 40)
- (*print-pretty* t)
- (tpl:*zoom-print-circle* t)
- (tpl:*zoom-print-level* nil)
- (tpl:*zoom-print-length* nil))
- (ignore-errors
- (format *terminal-io* "~
-~@<An unhandled error condition has been signalled:~3I ~a~I~:@>~%~%"
- error))
- (ignore-errors
- (let ((*terminal-io* s)
- (*standard-output* s))
- (tpl:do-command "zoom"
- :from-read-eval-print-loop nil
- :count t
- :all t)))))))
-
-#+openmcl
-(defun get-backtrace (error)
- "This is the function that is used internally by Hunchentoot to
-show or log backtraces. It accepts a condition object ERROR and
-returns a string with the corresponding backtrace."
- (with-output-to-string (s)
- (let ((*debug-io* s))
- (format *terminal-io* "~
-~@<An unhandled error condition has been signalled:~3I ~a~I~:@>~%~%"
- error)
- (ccl:print-call-history :detailed-p nil))))
-
-#+clisp
-(defun get-backtrace (error)
- "This is the function that is used internally by Hunchentoot to
-show or log backtraces."
- (declare (ignore error))
- (with-output-to-string (stream)
- (system::print-backtrace :out stream)))
-
-#+lispworks
-(defun get-backtrace (error)
- "This is the function that is used internally by Hunchentoot to
-show or log backtraces. It accepts a condition object ERROR and
-returns a string with the corresponding backtrace."
- (declare (ignore error))
- (with-output-to-string (s)
- (let ((dbg::*debugger-stack* (dbg::grab-stack nil :how-many most-positive-fixnum))
- (*debug-io* s)
- (dbg:*debug-print-level* nil)
- (dbg:*debug-print-length* nil))
- (dbg:bug-backtrace nil))))
-
-
-;; determine how we're going to access the backtrace in the next
-;; function
-#+sbcl
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (when (find-symbol "*DEBUG-PRINT-VARIABLE-ALIST*" :sb-debug)
- (pushnew :hunchentoot-sbcl-debug-print-variable-alist *features*)))
-
-#+sbcl
-(defun get-backtrace (error)
- "This is the function that is used internally by Hunchentoot to
-show or log backtraces. It accepts a condition object ERROR and
-returns a string with the corresponding backtrace."
- (declare (ignore error))
- (with-output-to-string (s)
- #+:hunchentoot-sbcl-debug-print-variable-alist
- (let ((sb-debug:*debug-print-variable-alist*
- (list* '(*print-level* . nil)
- '(*print-length* . nil)
- sb-debug:*debug-print-variable-alist*)))
- (sb-debug:backtrace most-positive-fixnum s))
- #-:hunchentoot-sbcl-debug-print-variable-alist
- (let ((sb-debug:*debug-print-level* nil)
- (sb-debug:*debug-print-length* nil))
- (sb-debug:backtrace most-positive-fixnum s))))
\ No newline at end of file
Modified: trunk/thirdparty/hunchentoot/hunchentoot.asd
===================================================================
--- trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-10 10:32:09 UTC (rev 4221)
+++ trunk/thirdparty/hunchentoot/hunchentoot.asd 2009-02-10 10:45:45 UTC (rev 4222)
@@ -69,7 +69,6 @@
(:file "misc")
(:file "easy-handlers")
(:file "headers")
- (:file "get-backtrace")
(:file "set-timeouts")
(:file "connection-dispatcher")
(:file "server")
Modified: trunk/thirdparty/hunchentoot/packages.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 10:32:09 UTC (rev 4221)
+++ trunk/thirdparty/hunchentoot/packages.lisp 2009-02-10 10:45:45 UTC (rev 4222)
@@ -56,7 +56,6 @@
"*LISP-ERRORS-LOG-LEVEL*"
"*LISP-WARNINGS-LOG-LEVEL*"
"*LISTENER*"
- "*LOG-LISP-BACKTRACES-P*"
"*LOG-LISP-ERRORS-P*"
"*LOG-LISP-WARNINGS-P*"
"*METHODS-FOR-POST-PARAMETERS*"
@@ -69,7 +68,6 @@
"*SESSION-GC-FREQUENCY*"
"*SESSION-MAX-TIME*"
"*SESSION-REMOVAL-HOOK*"
- "*SHOW-LISP-BACKTRACES-P*"
"*SHOW-LISP-ERRORS-P*"
"*TMP-DIRECTORY*"
"*USE-REMOTE-ADDR-FOR-SESSIONS*"
@@ -145,7 +143,6 @@
"DISPATCH-REQUEST"
"DO-SESSIONS"
"ESCAPE-FOR-HTML"
- "GET-BACKTRACE"
"GET-PARAMETER"
"GET-PARAMETERS"
"GET-PARAMETERS*"
Modified: trunk/thirdparty/hunchentoot/server.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/server.lisp 2009-02-10 10:32:09 UTC (rev 4221)
+++ trunk/thirdparty/hunchentoot/server.lisp 2009-02-10 10:45:45 UTC (rev 4222)
@@ -499,25 +499,13 @@
using START-OUTPUT. If all goes as planned, the function returns T."
(let (*tmp-files* *headers-sent*)
(unwind-protect
- (let* ((*request* request)
- backtrace)
+ (let* ((*request* request))
(multiple-value-bind (body error)
(catch 'handler-done
(handler-bind ((error
(lambda (cond)
- ;; only generate backtrace if needed
- (setq backtrace
- (and (or (and *show-lisp-errors-p*
- *show-lisp-backtraces-p*)
- (and *log-lisp-errors-p*
- *log-lisp-backtraces-p*))
- (get-backtrace cond)))
(when *log-lisp-errors-p*
- (log-message* *lisp-errors-log-level*
- "~A~:[~*~;~%~A~]"
- cond
- *log-lisp-backtraces-p*
- backtrace))
+ (log-message* *lisp-errors-log-level* "~A" cond))
;; if the headers were already sent
;; the error happens within the body
;; and we have to close the stream
@@ -528,11 +516,7 @@
(warning
(lambda (cond)
(when *log-lisp-warnings-p*
- (log-message* *lisp-warnings-log-level*
- "~A~:[~*~;~%~A~]"
- cond
- *log-lisp-backtraces-p*
- backtrace)))))
+ (log-message* *lisp-warnings-log-level* "~A" cond)))))
;; skip dispatch if bad request
(when (eql (return-code) +http-ok+)
;; now do the work
@@ -540,12 +524,7 @@
(when error
(setf (return-code *reply*)
+http-internal-server-error+))
- (start-output :content (cond ((and error *show-lisp-errors-p*)
- (format nil "<pre>~A~:[~*~;~%~%~A~]</pre>"
- (escape-for-html (format nil "~A" error))
- *show-lisp-backtraces-p*
- (escape-for-html (format nil "~A" backtrace))))
- (error
+ (start-output :content (cond (error
"An error has occured.")
(t body))))
t)
Modified: trunk/thirdparty/hunchentoot/specials.lisp
===================================================================
--- trunk/thirdparty/hunchentoot/specials.lisp 2009-02-10 10:32:09 UTC (rev 4221)
+++ trunk/thirdparty/hunchentoot/specials.lisp 2009-02-10 10:45:45 UTC (rev 4222)
@@ -198,22 +198,12 @@
(defvar *show-lisp-errors-p* nil
"Whether Lisp errors should be shown in HTML output.")
-(defvar *show-lisp-backtraces-p* nil
- "Whether Lisp backtraces should be shown in HTML output when an
-error occurs. Will only have an effect if *SHOW-LISP-ERRORS-P* is
-also true.")
-
(defvar *log-lisp-errors-p* t
"Whether Lisp errors should be logged.")
(defvar *log-lisp-warnings-p* t
"Whether Lisp warnings should be logged.")
-(defvar *log-lisp-backtraces-p* nil
- "Whether Lisp backtraces should be logged when an error or warning
-occurs. Will only have an effect if *LOG-LISP-ERRORS-P* or
-*LOG-LISP-BACKTRACES* are also true.")
-
(defvar *lisp-errors-log-level* :error
"Log level for Lisp errors.")
More information about the Bknr-cvs
mailing list