X-Git-Url: http://git.pond.sub.org/?p=eow;a=blobdiff_plain;f=web.lisp;h=c7ead803bf9f3a808610b80a10d0a286ed2447db;hp=06f483b8a323637c385deb7e24584a3871eca4d4;hb=29826a10a86f840b6c9feb248142debc67cc7df8;hpb=fc636ef0b61e6018deba9e31e2f9ab3efc381a1e diff --git a/web.lisp b/web.lisp index 06f483b..c7ead80 100644 --- a/web.lisp +++ b/web.lisp @@ -27,16 +27,20 @@ (defun serve-static () "Handle a request for a file under static/ directory" - (let* ((script-name (script-name)) + (let* ((script-name (hunchentoot:script-name hunchentoot:*request*)) (fname (subseq script-name (length +static-web-root+))) (fullname (concatenate 'string +static-files-root+ fname))) - (handle-static-file fullname))) + (hunchentoot:handle-static-file fullname))) (defclass session () ((update-queue :accessor update-queue :initform (locked-queue:create) :documentation "Updates to be sent to the browser") + (update-thread + :accessor update-thread + :initform nil + :documentation "COMET thread waiting for updates of non-NIL") (connection :accessor connection :documentation "Connection to the empire game server"))) @@ -56,15 +60,24 @@ (defvar *empire-session*) (defmacro with-session (&body body) - `(let ((*empire-session* (session-value 'session))) + `(let ((*empire-session* (hunchentoot:session-value 'session))) (if *empire-session* (progn ,@body) - (redirect +login-page+)))) + (hunchentoot:redirect +login-page+)))) (defun update () "Send stream of updates to client" (with-session - (locked-queue:dequeue (update-queue *empire-session*)))) + (when (update-thread *empire-session*) + (empire-log:info "~a: Killing update thread ~a." *empire-session* (update-thread *empire-session*)) + (sb-thread:terminate-thread (update-thread *empire-session*))) + (setf (update-thread *empire-session*) sb-thread:*current-thread*) + (let ((next-updates (locked-queue:dequeue-all (update-queue *empire-session*)))) + ; There's a race here. The next update thread might kill this one before + ; sending the reply. + (setf (update-thread *empire-session*) nil) + (nconc next-updates (list (parenscript:ps* '(next)))) + (apply #'concatenate 'string next-updates)))) (defmethod send ((s session) string) "Push a javascript update fragment to the client." @@ -79,25 +92,26 @@ ;; destination of login-form (defun login-action () (handler-case - (let* ((user (post-parameter "username")) - (pass (post-parameter "password")) + (let* ((user (hunchentoot:post-parameter "username")) + (pass (hunchentoot:post-parameter "password")) (session (make-session user pass))) - (setf (session-value 'session) session) + (setf (hunchentoot:session-value 'session) session) (empire-log:info "~a: User ~a logging in." session user) - (redirect +root-url+)) + (hunchentoot:redirect +root-url+)) (usocket:connection-refused-error (e) (format nil "Connection error: ~a~%" e)))) (defun command-action () (with-session - (empire:command (connection *empire-session*) (get-parameter "q")))) + (empire:command (connection *empire-session*) (hunchentoot:get-parameter "q")) + "ok")) (defun root-page () (with-session - (handle-static-file (concatenate 'string +static-files-root+ +root-page-file+)))) + (hunchentoot:handle-static-file (concatenate 'string +static-files-root+ +root-page-file+)))) (defun dispatch (request) - (let ((script-name (script-name request))) + (let ((script-name (hunchentoot:script-name request))) (cond ((not (string-starts-with script-name +web-root+)) nil) ; do not handle this request ((string= script-name "/eow/update") 'update) @@ -110,5 +124,4 @@ (defun start () (empire-log:info "Startup") - (pushnew 'dispatch *dispatch-table* :test #'eq)) - + (pushnew 'dispatch hunchentoot:*dispatch-table* :test #'eq))