From dac8d051628cc62915a535b96227139ff6794727 Mon Sep 17 00:00:00 2001 From: Gerd Flaig Date: Wed, 9 Feb 2011 23:40:31 +0100 Subject: [PATCH] fix ajax update handler, break lines --- web.lisp | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/web.lisp b/web.lisp index c7ead80..127a87e 100644 --- a/web.lisp +++ b/web.lisp @@ -68,10 +68,15 @@ (defun update () "Send stream of updates to client" (with-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*))) + ; kill previous update thread + (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*))) + + ; make current thread the update thread (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. @@ -110,16 +115,21 @@ (with-session (hunchentoot:handle-static-file (concatenate 'string +static-files-root+ +root-page-file+)))) +(defun my-request-p (script-name) + (string-starts-with script-name +web-root+)) + (defun dispatch (request) (let ((script-name (hunchentoot:script-name request))) (cond - ((not (string-starts-with script-name +web-root+)) nil) ; do not handle this request + ((not (my-request-p script-name)) nil) ; do not handle this request ((string= script-name "/eow/update") 'update) ((string= script-name "/eow/login") 'login-action) ((string= script-name "/eow/command") 'command-action) + ; go to the start page ((or (string-equal script-name +web-root-base+) - (string-equal script-name +web-root+)) 'root-page) ; go to the start page - ((string-starts-with script-name +static-web-root+) 'serve-static)))) ; serve static file + (string-equal script-name +web-root+)) 'root-page) + ; serve static file + ((string-starts-with script-name +static-web-root+) 'serve-static)))) (defun start () -- 2.43.0