bknr-cvs September 2008

bknr-cvs@common-lisp.net

1 participants
210 discussions

[bknr-cvs] hans changed trunk/projects/quickhoney/src/tags.lisp
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3884 Author: hans URL: http://bknr.net/trac/changeset/3884 Remove logo here, it is coming from index.xml U trunk/projects/quickhoney/src/tags.lisp Modified: trunk/projects/quickhoney/src/tags.lisp =================================================================== --- trunk/projects/quickhoney/src/tags.lisp 2008-09-10 15:59:45 UTC (rev 3883) +++ trunk/projects/quickhoney/src/tags.lisp 2008-09-10 16:03:09 UTC (rev 3884) @@ -16,9 +16,7 @@ (bknr.images:store-image-name image))) (defun navigation (&key previous up next) - (html ((:div :id "logo") - ((:img :src "/image/quickhoney-black" :alt "" :id "the_logo"))) - ((:div :class "nav") + (html ((:div :class "nav") (when previous (html ((:div :class "previous") ((:a :href previous) "<<"))))

1 0

[bknr-cvs] hans changed trunk/bknr/web/src/web/template-handler.lisp
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3883 Author: hans URL: http://bknr.net/trac/changeset/3883 Implement :catch-all template handler option. If it is set, the default-template is used for all requests that do not match a specific template. It obviously needs to be put at the end of the handler list. U trunk/bknr/web/src/web/template-handler.lisp Modified: trunk/bknr/web/src/web/template-handler.lisp =================================================================== --- trunk/bknr/web/src/web/template-handler.lisp 2008-09-10 15:55:20 UTC (rev 3882) +++ trunk/bknr/web/src/web/template-handler.lisp 2008-09-10 15:59:45 UTC (rev 3883) @@ -43,7 +43,11 @@ :reader template-expander-default-template :documentation "Name of the default template to use when no path -name has been specified."))) +name has been specified.") + (catch-all :initarg :catch-all :initform nil + :reader template-expander-catch-all + :documentation "If non-NIL, direct all requests to the + default template."))) (defmethod find-tag-function ((expander template-expander) name ns) (let ((package-name (cdr (find ns (template-expander-command-packages expander) @@ -226,11 +230,15 @@ (remove "" (split "/" path) :test #'equal)) (defmethod find-template-pathname ((expander template-expander) template-name) - (let ((components (or (split-path template-name) - (and (template-expander-default-template expander) - (split-path (template-expander-default-template expander)))))) + (let* ((default-template-components (and (template-expander-default-template expander) + (split-path (template-expander-default-template expander)))) + (components (or (split-path template-name) default-template-components))) (multiple-value-bind (pathname ret-components) - (find-template (template-expander-destination expander) components) + (find-template (template-expander-destination expander) components) + (when (and (not pathname) + (template-expander-catch-all expander)) + (multiple-value-setq (pathname ret-components) + (find-template (template-expander-destination expander) default-template-components))) (unless pathname (template-not-found template-name)) (values pathname

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/website/static/
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3882 Author: hans URL: http://bknr.net/trac/changeset/3882 Add missing variable declaration for IE. Put logo into the center. U trunk/projects/quickhoney/website/static/index.css U trunk/projects/quickhoney/website/static/javascript.js Modified: trunk/projects/quickhoney/website/static/index.css =================================================================== --- trunk/projects/quickhoney/website/static/index.css 2008-09-10 15:36:40 UTC (rev 3881) +++ trunk/projects/quickhoney/website/static/index.css 2008-09-10 15:55:20 UTC (rev 3882) @@ -635,13 +635,6 @@ padding: 0px 5px 0px 5px; } -#loading #logo { - position: absolute; - right: 10px; - top: 10px; - z-index: 2; -} - #loading .image { position: absolute; z-index: 5; Modified: trunk/projects/quickhoney/website/static/javascript.js =================================================================== --- trunk/projects/quickhoney/website/static/javascript.js 2008-09-10 15:36:40 UTC (rev 3881) +++ trunk/projects/quickhoney/website/static/javascript.js 2008-09-10 15:55:20 UTC (rev 3882) @@ -1143,7 +1143,7 @@ loadJSONDoc("/json-clients").addCallbacks(set_clients, alert); loadJSONDoc('/json-news-archive/quickhoney').addCallbacks(initialize_news_archive, alert); - path = 'home'; + var path = 'home'; if (document.location.pathname != '/') { path = document.location.pathname.substr(1); } else if (document.location.href.match(/#./)) {

1 0

[bknr-cvs] hans changed trunk/projects/quickhoney/
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3881 Author: hans URL: http://bknr.net/trac/changeset/3881 Consolidate all HTML into one template. Remove template names from URL. Improve Javascript-less mode. _U trunk/projects/quickhoney/src/ U trunk/projects/quickhoney/src/config.lisp U trunk/projects/quickhoney/src/init.lisp U trunk/projects/quickhoney/src/tags.lisp U trunk/projects/quickhoney/src/webserver.lisp D trunk/projects/quickhoney/website/static/frontpage.css D trunk/projects/quickhoney/website/static/image-browse.css U trunk/projects/quickhoney/website/static/index.css U trunk/projects/quickhoney/website/static/javascript.js D trunk/projects/quickhoney/website/templates/frontpage.xml D trunk/projects/quickhoney/website/templates/image-browse.xml U trunk/projects/quickhoney/website/templates/index.xml Change set too large, please see URL above

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/test/tsung
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3880 Author: ksprotte URL: http://bknr.net/trac/changeset/3880 small tsung test update U trunk/projects/bos/test/tsung.xml U trunk/projects/bos/test/tsung2.xml Modified: trunk/projects/bos/test/tsung.xml =================================================================== --- trunk/projects/bos/test/tsung.xml 2008-09-10 14:58:16 UTC (rev 3879) +++ trunk/projects/bos/test/tsung.xml 2008-09-10 15:16:21 UTC (rev 3880) @@ -9,7 +9,7 @@  <servers> - <server host="horst.headcraft.de" port="80" type="tcp"></server> + <server host="prod.headcraft.de" port="80" type="tcp"></server> </servers>  <servers> - <server host="horst.headcraft.de" port="80" type="tcp"></server> + <server host="prod.headcraft.de" port="80" type="tcp"></server> </servers> <!-- to start os monitoring (cpu, network, memory). Use an erlang

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3879 Author: ksprotte URL: http://bknr.net/trac/changeset/3879 bos hunchentoot single-threaded startup U trunk/projects/bos/test/web/drakma-requests.lisp U trunk/projects/bos/web/startup.lisp Modified: trunk/projects/bos/test/web/drakma-requests.lisp =================================================================== --- trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 14:06:45 UTC (rev 3878) +++ trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 14:58:16 UTC (rev 3879) @@ -1,24 +1,27 @@ (in-package :bos.test) (in-suite :bos.test.web) -(defmacro with-bos-test-server ((port-var) &body body) - (check-type port-var symbol) - `(with-fixture initial-bos-store () - (let* ((,port-var (+ 70000 (random 5253))) - (server (bos.web::init :port ,port-var - :worldpay-test-mode t))) - (check-type server hunchentoot::server) - (unwind-protect - (progn ,@body) - (hunchentoot:stop-server server))))) +;;; not functional anymore in single-threaded hunchentoot +;;; (server can't be stopped) -(test web-init - (with-bos-test-server (port) - (pass))) +;; (defmacro with-bos-test-server ((port-var) &body body) +;; (check-type port-var symbol) +;; `(with-fixture initial-bos-store () +;; (let* ((,port-var (+ 70000 (random 5253))) +;; (server (bos.web::init :port ,port-var +;; :worldpay-test-mode t))) +;; (check-type server hunchentoot::server) +;; (unwind-protect +;; (progn ,@body) +;; (hunchentoot:stop-server server))))) -(test request-start-page - #+(or ccl openmcl)(skip "known to fail on ccl") - #-(or ccl openmcl) - (with-bos-test-server (port) - (let ((uri (format nil "http://localhost:~D" port))) - (is (= 200 (nth-value 1 (drakma:http-request uri))))))) +;; (test web-init +;; (with-bos-test-server (port) +;; (pass))) + +;; (test request-start-page +;; #+(or ccl openmcl)(skip "known to fail on ccl") +;; #-(or ccl openmcl) +;; (with-bos-test-server (port) +;; (let ((uri (format nil "http://localhost:~D" port))) +;; (is (= 200 (nth-value 1 (drakma:http-request uri))))))) Modified: trunk/projects/bos/web/startup.lisp =================================================================== --- trunk/projects/bos/web/startup.lisp 2008-09-10 14:06:45 UTC (rev 3878) +++ trunk/projects/bos/web/startup.lisp 2008-09-10 14:58:16 UTC (rev 3879) @@ -23,8 +23,7 @@ (website-url (format nil "http://~A" host) website-url-given) worldpay-test-mode (google-analytics-account "UA-3432041-1") - start-frontend - debug) + start-frontend) (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 +38,20 @@ (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) + (format t "~&; Starting hunchentoot.~%") (force-output) (when *webserver* - (hunchentoot:stop-server *webserver*)) + (error "webserver already running")) (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))) + (bt:make-thread (lambda () + (hunchentoot:start-server :port *port* :threaded nil + :persistent-connections-p nil)) + :name "hunchentoot non-threaded wrapper") + (setq *webserver* t) (if start-frontend (start-frontend :host host :backend-port port :port frontend-port) (warn "frontend not started - to achieve this specify :start-frontend t"))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3878 Author: ksprotte URL: http://bknr.net/trac/changeset/3878 rollback of last 3 commits U trunk/projects/bos/test/web/drakma-requests.lisp U trunk/projects/bos/web/startup.lisp U trunk/projects/bos/web/webserver.lisp Modified: trunk/projects/bos/test/web/drakma-requests.lisp =================================================================== --- trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 13:45:42 UTC (rev 3877) +++ trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 14:06:45 UTC (rev 3878) @@ -7,10 +7,10 @@ (let* ((,port-var (+ 70000 (random 5253))) (server (bos.web::init :port ,port-var :worldpay-test-mode t))) - (check-type server bos.web::bos-server) + (check-type server hunchentoot::server) (unwind-protect (progn ,@body) - (bos.web::bos-server-stop))))) + (hunchentoot:stop-server server))))) (test web-init (with-bos-test-server (port) Modified: trunk/projects/bos/web/startup.lisp =================================================================== --- trunk/projects/bos/web/startup.lisp 2008-09-10 13:45:42 UTC (rev 3877) +++ trunk/projects/bos/web/startup.lisp 2008-09-10 14:06:45 UTC (rev 3878) @@ -8,6 +8,8 @@ :host (pathname-host me) :version nil))) +(defvar *webserver* nil) + (defvar *port*) (defvar *website-directory*) (defvar *website-url*) @@ -22,7 +24,7 @@ worldpay-test-mode (google-analytics-account "UA-3432041-1") start-frontend - threaded) + debug) (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).")) @@ -37,9 +39,17 @@ (bos.web::publish-website :website-directory *website-directory* :website-url *website-url* :worldpay-test-mode *worldpay-test-mode*) - (format t "~&; Starting hunchentoot.~%") - (force-output) - (bos-server-restart :port *port* :threaded threaded) + (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))) (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 13:45:42 UTC (rev 3877) +++ trunk/projects/bos/web/webserver.lisp 2008-09-10 14:06:45 UTC (rev 3878) @@ -2,115 +2,6 @@ (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)))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -265,8 +156,7 @@ (make-instance 'bos-website :name "create-rainforest.org CMS" - :handler-definitions `(("/stop-server" stop-server-handler) - ("/edit-poi-medium" edit-poi-medium-handler) + :handler-definitions `(("/edit-poi-medium" edit-poi-medium-handler) ("/edit-poi" edit-poi-handler) ("/edit-sponsor" edit-sponsor-handler) ("/kml-upload" kml-upload-handler)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/test/web/drakma-requests.lisp
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3877 Author: ksprotte URL: http://bknr.net/trac/changeset/3877 NOW fixed bos tests for prev commit U trunk/projects/bos/test/web/drakma-requests.lisp Modified: trunk/projects/bos/test/web/drakma-requests.lisp =================================================================== --- trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 13:33:04 UTC (rev 3876) +++ trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 13:45:42 UTC (rev 3877) @@ -10,7 +10,7 @@ (check-type server bos.web::bos-server) (unwind-protect (progn ,@body) - (hunchentoot:stop-server server))))) + (bos.web::bos-server-stop))))) (test web-init (with-bos-test-server (port)

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/test/web/drakma-requests.lisp
by BKNR Commits 10 Sep '08

10 Sep '08

Revision: 3876 Author: ksprotte URL: http://bknr.net/trac/changeset/3876 fixed bos tests for prev commit U trunk/projects/bos/test/web/drakma-requests.lisp Modified: trunk/projects/bos/test/web/drakma-requests.lisp =================================================================== --- trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 13:12:22 UTC (rev 3875) +++ trunk/projects/bos/test/web/drakma-requests.lisp 2008-09-10 13:33:04 UTC (rev 3876) @@ -7,7 +7,7 @@ (let* ((,port-var (+ 70000 (random 5253))) (server (bos.web::init :port ,port-var :worldpay-test-mode t))) - (check-type server hunchentoot::server) + (check-type server bos.web::bos-server) (unwind-protect (progn ,@body) (hunchentoot:stop-server server)))))

1 0

[bknr-cvs] ksprotte changed trunk/projects/bos/web/
by BKNR Commits 10 Sep '08

10 Sep '08

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) + ,@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)

1 0

← Newer
1
...
6
7
8
9
10
11
12
...
21
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

bknr-cvs September 2008