[Tbnl-devel] [hunchentoot-devel] 404 page

[Patrick May]

	Hmm.  Here’s a full working example:

(in-package :common-lisp-user)

(ql:quickload :hunchentoot)
(ql:quickload :drakma)
(ql:quickload :cl-who)

(defpackage :org.softwarematters.hunchentoot-test
  (:nicknames :hunchentoot-test :web-test)
  (:use :common-lisp
        :cl-who))

(in-package :web-test)

;;; Define the web server acceptor

(defparameter *test-acceptor*
  (make-instance 'hunchentoot:easy-acceptor
                 :port 8081
                 :document-root #p"/Users/Patrick/src/lisp/web/"
                 :access-log-destination "/tmp/web-test-access.log"
                 :message-log-destination "/tmp/web-test-message.log"))

;;; A couple of macros for encapsulating the details of a standard page.
;;; This came from Stack Overflow (How to connect a web app to Hunchentoot)
;;; and http://www.adampetersen.se/articles/lispweb.htm.

(defmacro standard-page ((&key title) &body body)
  "Abstract away the placing of standard page stuff."
  `(with-html-output-to-string (*standard-output* nil :prologue t :indent t)
     (:html :xmlns "http://www.w3.org/1999/xhtml"
	    :xml\:lang "en" 
	    :lang "en"
	    (:head 
	     (:meta :http-equiv "content-type" 
		    :content    "text/html;charset=UTF-8")
	     (:title ,title)
	     (:link :type "text/css" 
		    :rel "stylesheet"
		    :href "/test.css"))
	    (:body 
	     (:div :id "header")
	     , at body
	     (:div :id "footer")))))

(defmacro defpage (name (title) &body body)
  `(progn
     (defmethod ,name ()
       (standard-page (,title)
         , at body))
     (push (create-prefix-dispatcher ,(format nil "/~(~a~).html" name) ',name)
           *dispatch-table*)))

;;; URI implementations

(defun display-home-page ()
  "Display the home page."
  (hunchentoot:redirect "/index.html"))

(push (hunchentoot:create-regex-dispatcher "^/$" 'display-home-page)
      hunchentoot:*dispatch-table*)

(hunchentoot:define-easy-handler (home-page-handler
                                  :uri "/index.html"
                                  :default-request-type :GET)
    ()
  "Return the home page."
  (standard-page (:title "Web Test Home Page")
                 (:h1 "Web Test")
                 (:p "remote IP address: "
                     (format t "~A" (hunchentoot:remote-addr*)))
                 (:p "real remote IP address: "
                     (format t "~A" (hunchentoot:real-remote-addr)))
                 (:p "headers: "
                     (:br)
                     (dolist (header (hunchentoot:headers-in*))
                       (format t "~A: ~A<br/>" (car header) (cdr header))))
                 (:p "GET parameters: "
                     (format t "~A" (hunchentoot:get-parameters*)))))

;;; Override 404 handling

(defun display-404-page ()
  (standard-page (:title "Web Test 404 Page") (:h1 "404")))

(defmethod acceptor-status-message (acceptor (http-status-code (eql 404)) &key)
  (display-404-page))

;(defmethod hunchentoot:acceptor-status-message (acceptor (http-status-code (eql 404)) &key) "NOT FOUND")

;;; Start the web server

(hunchentoot:start *test-acceptor*)

I tried calling (display-404-page) in an easy-handler and it works fine.

	Thanks for any help.

Regards,

Patrick

On May 8, 2014, at 9:12 AM, Hans Hübner <hans.huebner at gmail.com> wrote:

> 2014-05-08 15:07 GMT+02:00 Patrick May <patrick.may at mac.com>:
> 	Removing the incorrect eql specialization still doesn’t result in my 404 page being displayed.  Do I have to subclass acceptor to get it to work?
> 
> No, it works just fine without an extra subclass, e.g.:
> 
> (defmethod hunchentoot:acceptor-status-message (acceptor (http-status-code (eql 404)) &key) "NOT FOUND")
> 
> -Hans

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/tbnl-devel/attachments/20140508/9774a759/attachment.html>