@@ -1521,6 +1522,17 @@
saved and may be retrieved with RAW-POST-DATA.
+
[Special variable]
+
*http-error-handler*
+
+
+This variable holds NIL or a function designator. The function gets called with an error code
+other than +http-ok+ or +http-not-modified+ and can return the content of an
+error page. Return NIL if the submitted error can't be handled.
+(Note that the handler function can access the request and reply data.)
+
+
If you want to debug your TBNL applications it is recommend that you start Apache (i.e. the httpd binary) with the -X command-line option. Then set *DEBUG-MODE* to a true value and poke around in the listener. Good luck... :)
diff -ru --exclude='*.fasl' --exclude='*~' tbnl-0.3.11/modlisp.lisp tbnl-0.3.11-stesch/modlisp.lisp
--- tbnl-0.3.11/modlisp.lisp 2005-03-01 15:05:31.000000000 +0100
+++ tbnl-0.3.11-stesch/modlisp.lisp 2005-03-01 15:31:08.000000000 +0100
@@ -51,26 +51,30 @@
return-code +http-internal-server-error+
status-line (status-line return-code)))
(unless (member return-code `(,+http-ok+ ,+http-not-modified+))
- ;; handle common return codes other than 200
- (setf (content-type *reply*)
+ ;; Call error handler, if any. Should return nil if it can't handle the error.
+ (when *http-error-handler*
+ (setq content (funcall *http-error-handler* return-code)))
+ ;; handle common return codes other than 200, which weren't handled by the error handler.
+ (unless content
+ (setf (content-type *reply*)
"text/html; charset=iso-8859-1"
- content
+ content
(format nil "~D ~A~A
~A
~A / mod_lisp~A/~A / TBNL ~A (~A ~A) at ~A Port ~D"
return-code status-line status-line
(case return-code
((#.+http-internal-server-error+)
- content)
+ content)
((#.+http-moved-temporarily+ #.+http-moved-permanently+)
- (format nil "The document has moved here"
- (header-out "Location")))
+ (format nil "The document has moved here"
+ (header-out "Location")))
((#.+http-authorization-required+)
- "The server could not verify that you are authorized to access the document requested. Either you supplied the wrong credentials \(e.g., bad password), or your browser doesn't understand how to supply the credentials required.")
+ "The server could not verify that you are authorized to access the document requested. Either you supplied the wrong credentials \(e.g., bad password), or your browser doesn't understand how to supply the credentials required.")
((#.+http-forbidden+)
- (format nil "You don't have permission to access ~A on this server."
- (script-name)))
+ (format nil "You don't have permission to access ~A on this server."
+ (script-name)))
((#.+http-not-found+)
- (format nil "The requested URL ~A was not found on this server."
- (script-name))))
+ (format nil "The requested URL ~A was not found on this server."
+ (script-name))))
(or (header-in "server-baseversion") "Apache")
(or (header-in "modlisp-major-version") "")
(or (header-in "modlisp-version") "")
@@ -79,7 +83,7 @@
(lisp-implementation-type)
(lisp-implementation-version)
(host *request*)
- (server-port :request *request*))))
+ (server-port :request *request*)))))
;; start with status line
(write-header-line "Status" (format nil "~d ~a" return-code status-line))
;; if there's content write the corresponding headers
diff -ru --exclude='*.fasl' --exclude='*~' tbnl-0.3.11/packages.lisp tbnl-0.3.11-stesch/packages.lisp
--- tbnl-0.3.11/packages.lisp 2005-03-01 15:24:13.000000000 +0100
+++ tbnl-0.3.11-stesch/packages.lisp 2005-03-01 15:32:00.000000000 +0100
@@ -40,6 +40,7 @@
#:*error*
#:*default-content-type*
#:*default-handler*
+ #:*http-error-handler*
#:*default-log-level*
#:*dispatch-table*
#:*lisp-errors-log-level*
diff -ru --exclude='*.fasl' --exclude='*~' tbnl-0.3.11/specials.lisp tbnl-0.3.11-stesch/specials.lisp
--- tbnl-0.3.11/specials.lisp 2005-03-01 15:23:57.000000000 +0100
+++ tbnl-0.3.11-stesch/specials.lisp 2005-03-01 15:27:46.000000000 +0100
@@ -242,6 +242,9 @@
(defparameter *default-handler* 'default-handler
"The name of the function which is always returned by DEFAULT-DISPATCHER.")
+(defvar *http-error-handler* nil
+ "A list of error dispatch functions.")
+
(defparameter *default-log-level* nil
"The default log level for LOG-MESSAGE*")