commit 77acdcacca6c97a50c773467d73863a07f2b330c parent d1e151d8bb404261061312f50ee991c827902a83 Author: Tomas Hlavaty <tom@logand.com> Date: Sun, 6 Dec 2015 09:21:20 +0100 better accept-loop Diffstat:
| M | http.lisp | | | 20 | ++++++++++++-------- |
1 file changed, 12 insertions(+), 8 deletions(-)
diff --git a/http.lisp b/http.lisp @@ -340,15 +340,16 @@ (function (funcall body stream)))))))))) #-clisp -(defun server-loop (socket quit handler host port) +(defun accept-loop (socket quit handler host port) (do ((q (or quit (rw:reader '(nil t))))) ((funcall q)) (let ((c (rw.socket:accept socket))) (rw.concurrency:make-thread (format nil "RW.HTTP:SERVER-HANDLER ~s ~s" host port) (lambda () - (with-open-stream (c c) - (server-handler c handler))))))) + (ignore-errors + (with-open-stream (c c) + (server-handler c handler)))))))) ;; TODO also without threads ;; TODO also thread limit @@ -356,11 +357,14 @@ #-clisp (defun server (host port handler &key quit) (let ((s (rw.socket:make-tcp-server-socket host port))) - (rw.concurrency:make-thread - (format nil "RW.HTTP:SERVER-LOOP ~s ~s" host port) - (lambda () - (with-open-stream (s s) - (server-loop s quit handler host port)))))) + (flet ((accept () + (with-open-stream (s s) + (accept-loop s quit handler host port)))) + (if (rw.concurrency:threads-supported-p) + (rw.concurrency:make-thread + (format nil "RW.HTTP:ACCEPT-LOOP ~s ~s" host port) + #'accept) + (accept))))) (defun my-handler (msg stream method query protocol headers &optional body) (ecase msg