Author: hhubner Date: Wed Jan 30 03:46:10 2008 New Revision: 2419 Modified: branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp branches/trunk-reorg/bknr/web/src/packages.lisp branches/trunk-reorg/bknr/web/src/web/handlers.lisp branches/trunk-reorg/projects/quickhoney/src/init.lisp branches/trunk-reorg/projects/quickhoney/src/webserver.lisp Log: Move reference of 'modules' into website handlers definition instead of putting the module handlers at the end of the handler list. Make imageproc work, yay! Modified: branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp (original) +++ branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp Wed Jan 30 03:46:10 2008 @@ -34,9 +34,12 @@ (when (and (true-color-p working-image) (not (true-color-p input-image))) (true-color-to-palette :dither t :image working-image :colors-wanted 256)) - (write-image-to-stream *html-stream* (image-type-keyword image) :image working-image) + (let ((stream (send-headers))) + (setf (flex:flexi-stream-element-type stream) 'flex:octet) + (write-image-to-stream stream (image-type-keyword image) :image working-image)) (unless (eq working-image input-image) (destroy-image working-image))))) + #+(or) (unless (member type '(:jpg :jpeg)) (when (true-color-p input-image) @@ -167,8 +170,9 @@ (defmethod handle-object ((page-handler imageproc-handler) image) (format t "if-modfied-since not implemented for hunchentoot~%") - (with-http-body () - (imageproc image (cdr (decoded-handler-path page-handler)))) + (with-http-response (:content-type (image-content-type (image-type-keyword image))) + (with-http-body () + (imageproc image (cdr (decoded-handler-path page-handler))))) #+(or) (with-http-response (:content-type (image-content-type (image-type-keyword image))) (let ((ims (header-in :if-modified-since)) Modified: branches/trunk-reorg/bknr/web/src/packages.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/packages.lisp (original) +++ branches/trunk-reorg/bknr/web/src/packages.lisp Wed Jan 30 03:46:10 2008 @@ -301,6 +301,7 @@ #:handle-form #:object-handler-object-class #:object-handler-get-object + #:require-user-flag #:bknr-authorizer #:find-user-from-request-parameters Modified: branches/trunk-reorg/bknr/web/src/web/handlers.lisp ============================================================================== --- branches/trunk-reorg/bknr/web/src/web/handlers.lisp (original) +++ branches/trunk-reorg/bknr/web/src/web/handlers.lisp Wed Jan 30 03:46:10 2008 @@ -23,8 +23,6 @@ :accessor website-authorizer) (handler-definitions :initarg :handler-definitions :accessor website-handler-definitions) - (modules :initarg :modules - :accessor website-modules) (handlers :initform nil :accessor website-handlers) (menu :initarg :menu) (menudef-xml-file :initarg :menudef-xml-file @@ -58,7 +56,6 @@ (:default-initargs :url nil :vhosts :wild :authorizer (make-instance 'bknr-authorizer) - :modules nil :menu nil :navigation nil :admin-navigation nil @@ -124,19 +121,26 @@ (setf (choice-submenu (first choices)) (process-choices-xml (cddr choice-xml))))) (reverse choices))) +(defgeneric process-handler-definition (website definition) + (:documentation "Process a handler definition entry DEFINITION which +may either be a LIST of (PATH HANDLER-CLASS &optional INITARGS) or a +symbol, denoting a module to load at this point in the (linear) +handler definition. Every method returns a list of handler instances.") + (:method (website (definition list)) + (list (apply #'make-instance (handler-definition-class definition) + :name (handler-definition-name definition) + :site website + (handler-definition-initargs definition)))) + (:method (website (module-name symbol)) + (mapcan (curry #'process-handler-definition website) + (or (gethash (symbol-name module-name) *website-modules*) + (error "bknr module ~A not known" module-name))))) + (defmethod publish-site ((website website)) (setf (website-handlers website) - (mapcar #'(lambda (handler-definition) - (apply #'make-instance (handler-definition-class - handler-definition) - :name (handler-definition-name handler-definition) - :site website - (handler-definition-initargs handler-definition))) - (apply #'append - (website-handler-definitions website) - (mapcar #'(lambda (module-name) (or (gethash (symbol-name module-name) *website-modules*) - (error "bknr module ~A not known" module-name))) - (website-modules website))))) + (mapcan (curry #'process-handler-definition website) + (website-handler-definitions website))) + ;; XXX implicitly creating a template handler seems wrong: (when (website-template-base-directory website) (setf (slot-value website 'template-handler) (make-instance 'template-handler :name "/" @@ -145,9 +149,7 @@ :command-packages (website-template-command-packages website))) (push (website-template-handler website) (website-handlers website))) - (mapc #'(lambda (handler) - (publish-handler website handler)) - (website-handlers website)) + (mapc (curry #'publish-handler website) (website-handlers website)) (pushnew 'bknr-dispatch *dispatch-table*)) (defmethod website-session-info ((website website)) @@ -253,7 +255,7 @@ (defun bknr-dispatch (request) (declare (ignore request)) - (when-let ((handler (find-if #'handler-matches *handlers*))) + (when-let ((handler (find-if #'handler-matches (website-handlers *website*)))) (curry #'invoke-handler handler))) (defmethod publish-handler ((website website) (handler page-handler)) Modified: branches/trunk-reorg/projects/quickhoney/src/init.lisp ============================================================================== --- branches/trunk-reorg/projects/quickhoney/src/init.lisp (original) +++ branches/trunk-reorg/projects/quickhoney/src/init.lisp Wed Jan 30 03:46:10 2008 @@ -15,4 +15,5 @@ (bknr.cron:make-cron-job "snapshot" 'snapshot-store 0 5 :every :every)) #+cmu (actor-start (make-instance 'cron-actor)) - (publish-quickhoney)) + (publish-quickhoney) + (hunchentoot:start-server :port *webserver-port*)) Modified: branches/trunk-reorg/projects/quickhoney/src/webserver.lisp ============================================================================== --- branches/trunk-reorg/projects/quickhoney/src/webserver.lisp (original) +++ branches/trunk-reorg/projects/quickhoney/src/webserver.lisp Wed Jan 30 03:46:10 2008 @@ -6,7 +6,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun publish-quickhoney (&key (port *webserver-port*)) +(defun publish-quickhoney () (setf bknr.web::*upload-file-size-limit* (* 30 1024 1024)) (unpublish) @@ -25,16 +25,17 @@ ("/rss" rss-handler) ("/" redirect-handler :to "/frontpage") - ("/" template-handler - :destination ,(namestring (merge-pathnames "templates/" *website-directory*)) - :command-packages ((:quickhoney . :quickhoney.tags) - (:bknr . :bknr.web))) + user + images ("/static" directory-handler :destination ,(merge-pathnames #p"static/" *website-directory*)) ("/favicon.ico" file-handler :destination ,(merge-pathnames #p"static/favicon.ico" *website-directory*) - :content-type "application/x-icon")) - :modules '(user images) + :content-type "application/x-icon") + ("/" template-handler + :destination ,(namestring (merge-pathnames "templates/" *website-directory*)) + :command-packages ((:quickhoney . :quickhoney.tags) + (:bknr . :bknr.web)))) :admin-navigation '(("user" . "/user/") ("images" . "/edit-images") ("import" . "/import") @@ -43,6 +44,4 @@ :site-logo-url "/image/quickhoney/color,000000,33ff00" :login-logo-url "/image/quickhoney/color,000000,33ff00/double,3" :style-sheet-urls '("/static/styles.css") - :javascript-urls '("/static/javascript.js")) - - (hunchentoot:start-server :port port)) + :javascript-urls '("/static/javascript.js")))