(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")
,@body
(:div :id "footer")))))

(defmacro defpage (name (title) &body body)
`(progn
(defmethod ,name ()
(standard-page (,title)
,@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*)

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

2014-05-08 15:07 GMT+02:00 Patrick May <patrick.may@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