[bknr-cvs] ksprotte changed trunk/projects/bos/web/
BKNR Commits
bknr at bknr.net
Wed Sep 10 13:12:22 UTC 2008
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\" 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)
+ , at 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)
More information about the Bknr-cvs
mailing list