X-Git-Url: http://git.pond.sub.org/?p=eow;a=blobdiff_plain;f=web.lisp;h=127a87ecc7bb61716f5e454b96ad946b7efa1bf7;hp=c7ead803bf9f3a808610b80a10d0a286ed2447db;hb=54e14006564ff34c8249b9ddb357201759d77101;hpb=fc5e0903e87b50a4931b66a039f75feb95b78602 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 ()