From b1393ddfe9b005021ece1e7df6f053861dcddc82 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 12:51:56 +0100 Subject: Loosen the core's dependency on Hunchentoot. --- mulkcms-hunchentoot.lisp | 33 ++++++++++++++++++++++++++++----- 1 file changed, 28 insertions(+), 5 deletions(-) mode change 100755 => 100644 mulkcms-hunchentoot.lisp (limited to 'mulkcms-hunchentoot.lisp') diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp old mode 100755 new mode 100644 index c5fa908..762d181 --- a/mulkcms-hunchentoot.lisp +++ b/mulkcms-hunchentoot.lisp @@ -17,11 +17,34 @@ (defun dispatch-mulkcms-request (request) (let* ((relative-path (subseq (script-name request) 1)) (mulkcms::*use-ssl-p* (equal (header-in* :x-use-ssl) - "true"))) - (mulkcms::find-request-handler relative-path - (append (get-parameters*) - (post-parameters*)) - (header-in* :accept-language)))) + "true")) + (mulkcms::*real-remote-addr* + (hunchentoot:real-remote-addr)) + (mulkcms::*user-agent* + (hunchentoot:user-agent)) + (mulkcms::*request-method* + (hunchentoot:request-method*)) + (mulkcms::*headers* + (hunchentoot::headers-in*))) + (let ((result (mulkcms::find-request-handler relative-path + (append (get-parameters*) + (post-parameters*)) + (header-in* :accept-language)))) + (typecase result + (cons + (when-let (content-type (getf result :content-type)) + (setf (hunchentoot:content-type*) content-type)) + (when-let (headers (getf result :headers)) + (dolist (header headers) + (setf (hunchentoot:header-out (car header)) + (cdr header)))) + (when-let (return-code (getf result :return-code)) + (setf (hunchentoot:return-code*) return-code) + ;;(hunchentoot:abort-request-handler) + ) + (getf result :body)) + (t + result))))) (defun setup-handlers () (setq *dispatch-table* -- cgit v1.2.3 From 7fb228efe3c58932bd465aedb8fa60f131523f87 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 21:25:37 +0100 Subject: Further decouple the core from Hunchentoot. --- mulkcms-hunchentoot.lisp | 48 ++++++++++++++++++++++++++++-------------------- 1 file changed, 28 insertions(+), 20 deletions(-) (limited to 'mulkcms-hunchentoot.lisp') diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp index 762d181..a2e5a15 100644 --- a/mulkcms-hunchentoot.lisp +++ b/mulkcms-hunchentoot.lisp @@ -14,6 +14,9 @@ (not (directory-pathname-p file)) (lambda () (handle-static-file file))))) +(defun handle-authorization-page () + (hunchentoot:require-authorization "MulkCMS")) + (defun dispatch-mulkcms-request (request) (let* ((relative-path (subseq (script-name request) 1)) (mulkcms::*use-ssl-p* (equal (header-in* :x-use-ssl) @@ -25,26 +28,31 @@ (mulkcms::*request-method* (hunchentoot:request-method*)) (mulkcms::*headers* - (hunchentoot::headers-in*))) - (let ((result (mulkcms::find-request-handler relative-path - (append (get-parameters*) - (post-parameters*)) - (header-in* :accept-language)))) - (typecase result - (cons - (when-let (content-type (getf result :content-type)) - (setf (hunchentoot:content-type*) content-type)) - (when-let (headers (getf result :headers)) - (dolist (header headers) - (setf (hunchentoot:header-out (car header)) - (cdr header)))) - (when-let (return-code (getf result :return-code)) - (setf (hunchentoot:return-code*) return-code) - ;;(hunchentoot:abort-request-handler) - ) - (getf result :body)) - (t - result))))) + (hunchentoot::headers-in*)) + (mulkcms::*authorization-page-handler* + #'handle-authorization-page)) + (multiple-value-bind + (mulkcms::*user-name* mulkcms::*password*) + (hunchentoot:authorization) + (let ((result (mulkcms::find-request-handler relative-path + (append (get-parameters*) + (post-parameters*)) + (header-in* :accept-language)))) + (typecase result + (cons + (when-let (content-type (getf result :content-type)) + (setf (hunchentoot:content-type*) content-type)) + (when-let (headers (getf result :headers)) + (dolist (header headers) + (setf (hunchentoot:header-out (car header)) + (cdr header)))) + (when-let (return-code (getf result :return-code)) + (setf (hunchentoot:return-code*) return-code) + ;;(hunchentoot:abort-request-handler) + ) + (getf result :body)) + (t + result)))))) (defun setup-handlers () (setq *dispatch-table* -- cgit v1.2.3 From cc294fe404c750acacca7385cd1d14572eeb6643 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 21:37:21 +0100 Subject: Fix frontend-decoupled authorization. --- mulkcms-hunchentoot.lisp | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'mulkcms-hunchentoot.lisp') diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp index a2e5a15..9f123d0 100644 --- a/mulkcms-hunchentoot.lisp +++ b/mulkcms-hunchentoot.lisp @@ -28,9 +28,7 @@ (mulkcms::*request-method* (hunchentoot:request-method*)) (mulkcms::*headers* - (hunchentoot::headers-in*)) - (mulkcms::*authorization-page-handler* - #'handle-authorization-page)) + (hunchentoot::headers-in*))) (multiple-value-bind (mulkcms::*user-name* mulkcms::*password*) (hunchentoot:authorization) @@ -73,5 +71,6 @@ (setq *acceptor* (make-instance 'hunchentoot:easy-acceptor :port *server-port* :address *server-address*)) + (setq mulkcms::*authorization-page-handler* #'handle-authorization-page) (hunchentoot:start *acceptor*)) -- cgit v1.2.3 From 3b97d53de6b73b41d2153f74aa8c1961a75441ae Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 23:03:05 +0100 Subject: Actually make the decoupled design work. --- mulkcms-hunchentoot.lisp | 40 +++++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 19 deletions(-) (limited to 'mulkcms-hunchentoot.lisp') diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp index 9f123d0..5a134ac 100644 --- a/mulkcms-hunchentoot.lisp +++ b/mulkcms-hunchentoot.lisp @@ -32,25 +32,27 @@ (multiple-value-bind (mulkcms::*user-name* mulkcms::*password*) (hunchentoot:authorization) - (let ((result (mulkcms::find-request-handler relative-path - (append (get-parameters*) - (post-parameters*)) - (header-in* :accept-language)))) - (typecase result - (cons - (when-let (content-type (getf result :content-type)) - (setf (hunchentoot:content-type*) content-type)) - (when-let (headers (getf result :headers)) - (dolist (header headers) - (setf (hunchentoot:header-out (car header)) - (cdr header)))) - (when-let (return-code (getf result :return-code)) - (setf (hunchentoot:return-code*) return-code) - ;;(hunchentoot:abort-request-handler) - ) - (getf result :body)) - (t - result)))))) + (let ((handler (mulkcms::find-request-handler relative-path + (append (get-parameters*) + (post-parameters*)) + (header-in* :accept-language)))) + (lambda () + (let ((result (funcall handler))) + (typecase result + (cons + (when-let (content-type (getf result :content-type)) + (setf (hunchentoot:content-type*) content-type)) + (when-let (headers (getf result :headers)) + (dolist (header headers) + (setf (hunchentoot:header-out (car header)) + (cdr header)))) + (when-let (return-code (getf result :return-code)) + (setf (hunchentoot:return-code*) return-code) + ;;(hunchentoot:abort-request-handler) + ) + (getf result :body)) + (t + result)))))))) (defun setup-handlers () (setq *dispatch-table* -- cgit v1.2.3 From 12cdc3f219e948326fc6b5f428aca02b4b15c655 Mon Sep 17 00:00:00 2001 From: Matthias Andreas Benkard Date: Fri, 23 Dec 2011 23:58:55 +0100 Subject: Fix static file handling. --- mulkcms-hunchentoot.lisp | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) (limited to 'mulkcms-hunchentoot.lisp') diff --git a/mulkcms-hunchentoot.lisp b/mulkcms-hunchentoot.lisp index 5a134ac..4300871 100644 --- a/mulkcms-hunchentoot.lisp +++ b/mulkcms-hunchentoot.lisp @@ -36,23 +36,24 @@ (append (get-parameters*) (post-parameters*)) (header-in* :accept-language)))) - (lambda () - (let ((result (funcall handler))) - (typecase result - (cons - (when-let (content-type (getf result :content-type)) - (setf (hunchentoot:content-type*) content-type)) - (when-let (headers (getf result :headers)) - (dolist (header headers) - (setf (hunchentoot:header-out (car header)) - (cdr header)))) - (when-let (return-code (getf result :return-code)) - (setf (hunchentoot:return-code*) return-code) - ;;(hunchentoot:abort-request-handler) - ) - (getf result :body)) - (t - result)))))))) + (and handler + (lambda () + (let ((result (funcall handler))) + (typecase result + (cons + (when-let (content-type (getf result :content-type)) + (setf (hunchentoot:content-type*) content-type)) + (when-let (headers (getf result :headers)) + (dolist (header headers) + (setf (hunchentoot:header-out (car header)) + (cdr header)))) + (when-let (return-code (getf result :return-code)) + (setf (hunchentoot:return-code*) return-code) + ;;(hunchentoot:abort-request-handler) + ) + (getf result :body)) + (t + result))))))))) (defun setup-handlers () (setq *dispatch-table* -- cgit v1.2.3