[bknr-cvs] hans changed trunk/

[BKNR Commits]

Revision: 4398
Author: hans
URL: http://bknr.net/trac/changeset/4398

improved redirection of /
U   trunk/bknr/web/src/web/handlers.lisp
U   trunk/projects/lisp-ecoop/src/webserver.lisp

Modified: trunk/bknr/web/src/web/handlers.lisp
===================================================================
--- trunk/bknr/web/src/web/handlers.lisp	2009-05-13 08:54:32 UTC (rev 4397)
+++ trunk/bknr/web/src/web/handlers.lisp	2009-05-13 09:27:27 UTC (rev 4398)
@@ -374,14 +374,16 @@
 		(script-name*)))
 
 (defclass redirect-handler (page-handler)
-  ((to :initarg :to :reader redirect-handler-to :documentation "url to redirect to")))
+  ((to :initarg :to :reader redirect-handler-to :documentation "url to redirect to")
+   (args :initarg :args :reader redirect-handler-args :documentation "redirect arguments"))
+  (:default-initargs :args nil))
 
 (defmethod initialize-instance :after ((handler redirect-handler) &key to)
   (unless (equal #\/ (aref to 0))
     (warn "path ~S provided as target to redirect-handler does not begin with a slash" to)))
 
 (defmethod handle ((page-handler redirect-handler))
-  (redirect (redirect-handler-to page-handler)))
+  (apply #'redirect (redirect-handler-to page-handler) (redirect-handler-args page-handler)))
 
 (defclass random-redirect-handler (redirect-handler)
   ())

Modified: trunk/projects/lisp-ecoop/src/webserver.lisp
===================================================================
--- trunk/projects/lisp-ecoop/src/webserver.lisp	2009-05-13 08:54:32 UTC (rev 4397)
+++ trunk/projects/lisp-ecoop/src/webserver.lisp	2009-05-13 09:27:27 UTC (rev 4398)
@@ -24,7 +24,7 @@
                                         mailinglist
                                         mailinglist-registration
 					participants schedule
-					("/" redirect-handler :to "/home")
+					("/" redirect-handler :to "/home" :args (:host "elw2009.bknr.net"))
 					("/static" directory-handler
 					 :destination ,(probe-file (merge-pathnames #p"static/" *website-directory*))))
 		 :admin-navigation nil