Revision: 3875 Author: ksprotte URL: http://bknr.net/trac/changeset/3875

implemented bos-multi-threaded-server and bos-single-threaded-server (now default) U trunk/projects/bos/web/startup.lisp U trunk/projects/bos/web/webserver.lisp

Modified: trunk/projects/bos/web/startup.lisp =================================================================== --- trunk/projects/bos/web/startup.lisp 2008-09-10 09:27:54 UTC (rev 3874) +++ trunk/projects/bos/web/startup.lisp 2008-09-10 13:12:22 UTC (rev 3875) @@ -8,8 +8,6 @@ :host (pathname-host me) :version nil)))

-(defvar *webserver* nil) - (defvar *port*) (defvar *website-directory*) (defvar *website-url*) @@ -24,7 +22,7 @@ worldpay-test-mode (google-analytics-account "UA-3432041-1") start-frontend - debug) + threaded) (when website-url-given (warn "Specifying :website-url in web.rc is deprecated. Use :host instead.~ ~%Website-url will then be initialized by (format nil "http://~~A%5C" host).")) @@ -39,17 +37,9 @@ (bos.web::publish-website :website-directory *website-directory* :website-url *website-url* :worldpay-test-mode *worldpay-test-mode*) - (format t "~&; Starting hunchentoot~@[ in debug mode~].~%" debug) - (force-output) - (when *webserver* - (hunchentoot:stop-server *webserver*)) - (setf hunchentoot:*hunchentoot-default-external-format* (flex:make-external-format :utf-8 :eol-style :lf) - hunchentoot:*rewrite-for-session-urls* nil - ;; the reason for the following setting is that ptviewer sends - ;; a different User-Agent -- (when requesting PTDefault.html) - hunchentoot:*use-user-agent-for-sessions* nil) - (setq *webserver* (hunchentoot:start-server :port *port* :threaded (not debug) - :persistent-connections-p (not debug))) + (format t "~&; Starting hunchentoot.~%") + (force-output) + (bos-server-restart :port *port* :threaded threaded) (if start-frontend (start-frontend :host host :backend-port port :port frontend-port) (warn "frontend not started - to achieve this specify :start-frontend t"))

Modified: trunk/projects/bos/web/webserver.lisp =================================================================== --- trunk/projects/bos/web/webserver.lisp 2008-09-10 09:27:54 UTC (rev 3874) +++ trunk/projects/bos/web/webserver.lisp 2008-09-10 13:12:22 UTC (rev 3875) @@ -2,6 +2,115 @@

(enable-interpol-syntax)

+;;;; bos-server +(defvar *webserver* nil + "When the bos-server is running this is set to the server +instance.") + +(defclass bos-server () + ()) + +;;; internal protocol +(defgeneric bos-server-start-internal (server)) +(defgeneric bos-server-stop-internal (server)) +(defgeneric bos-server-running-p-internal (server)) + +;;; external protocol +(defun bos-server-start (&key port threaded) + (let ((server-class (if threaded + 'bos-multi-threaded-server + 'bos-single-threaded-server))) + (prog1 + (setq *webserver* (make-instance server-class :port port)) + (bos-server-start-internal *webserver*)))) + +(defun bos-server-stop () + (unless (bos-server-running-p) + (error "BOS server is not running")) + (bos-server-stop-internal *webserver*)) + +(defun bos-server-running-p () + (when *webserver* + (bos-server-running-p-internal *webserver*))) + +(defun bos-server-restart (&key port threaded) + (when (bos-server-running-p) + (bos-server-stop)) + (bos-server-start :port port :threaded threaded)) + +(defgeneric bos-server-port (server)) + +;;; bos-server-hunchentoot-mixin +(defclass bos-server-hunchentoot-mixin () + ()) + +(defmethod bos-server-start-internal :before ((server bos-server-hunchentoot-mixin)) + (declare (ignore server)) + (setf hunchentoot:*hunchentoot-default-external-format* + (flex:make-external-format :utf-8 :eol-style :lf) + hunchentoot:*rewrite-for-session-urls* + nil + ;; the reason for the following setting is that ptviewer sends + ;; a different User-Agent -- (when requesting PTDefault.html) + hunchentoot:*use-user-agent-for-sessions* + nil)) + +;;;; bos-multi-threaded-server +(defclass bos-multi-threaded-server (bos-server bos-server-hunchentoot-mixin) + ((port :reader bos-server-port :initarg :port) + (native-server :accessor bos-server-native-server))) + +(defmethod bos-server-start-internal ((server bos-multi-threaded-server)) + (setf (bos-server-native-server server) + (hunchentoot:start-server :port (bos-server-port server) + :threaded t :persistent-connections-p t))) + +(defmethod bos-server-stop-internal ((server bos-multi-threaded-server)) + (hunchentoot:stop-server (bos-server-native-server server))) + +(defmethod bos-server-running-p-internal ((server bos-multi-threaded-server)) + (not (hunchentoot::server-shutdown-p (bos-server-native-server server)))) + +;;;; bos-single-threaded-server +(defclass bos-single-threaded-server (bos-server bos-server-hunchentoot-mixin) + ((port :reader bos-server-port :initarg :port) + (server-thread :accessor bos-server-thread :initform nil))) + +(defmethod bos-server-start-internal ((server bos-single-threaded-server)) + (setf (bos-server-thread server) + (bt:make-thread (lambda () + (catch 'stop-tag + (hunchentoot:start-server :port (bos-server-port server) + :threaded nil :persistent-connections-p nil))) + :name "bos-single-threaded-server"))) + +(defvar *stop-server-handler-authorized-p* nil) + +(defmacro with-stop-server-handler-autorization (&body body) + `(unwind-protect + (progn + (setq *stop-server-handler-authorized-p* t) + ,@body) + (setq *stop-server-handler-authorized-p* nil))) + +(defclass stop-server-handler (page-handler) + ()) + +(defmethod handle ((handler stop-server-handler)) + (if *stop-server-handler-authorized-p* + (throw 'stop-tag nil) + (error "not found"))) + +(defmethod bos-server-stop-internal ((server bos-single-threaded-server)) + (with-stop-server-handler-autorization + (ignore-errors (drakma:http-request (format nil "http://localhost:~D/stop-server" + (bos-server-port server))))) + nil) + +(defmethod bos-server-running-p-internal ((server bos-single-threaded-server)) + (and (bos-server-thread server) + (bt:thread-alive-p (bos-server-thread server)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

@@ -156,7 +265,8 @@

(make-instance 'bos-website :name "create-rainforest.org CMS" - :handler-definitions `(("/edit-poi-medium" edit-poi-medium-handler) + :handler-definitions `(("/stop-server" stop-server-handler) + ("/edit-poi-medium" edit-poi-medium-handler) ("/edit-poi" edit-poi-handler) ("/edit-sponsor" edit-sponsor-handler) ("/kml-upload" kml-upload-handler)