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.")