Commit f2c281a49acf6166aad77f270ec1c8bd9cf2aaff
2019-01-16T17:29:53
fix select
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
diff --git a/thot-select.lisp b/thot-select.lisp
index 9060327..e92756e 100644
--- a/thot-select.lisp
+++ b/thot-select.lisp
@@ -5,24 +5,27 @@
(in-package :thot)
-(defun request-loop-simple (request-stream reply-stream)
- (loop
- (when *stop*
- (return))
- (handler-case
- (let* ((req (make-instance 'request :stream request-stream))
+(defun request-loop-simple (request-stream reply-stream addr)
+ (with-simple-restart (abort "Abort request loop")
+ (loop
+ (when *stop*
+ (return))
+ (handler-bind
+ ((warning (lambda (w)
+ (msg warn w)
+ (continue)))
+ (error (lambda (e)
+ (msg error e)
+ (unless (debug-p :conditions)
+ (return)))))
+ (let* ((req (make-instance 'request :stream request-stream
+ :remote-addr addr))
(reply (make-instance 'reply :stream reply-stream))
(reader (request-reader req reply))
(result (funcall (the function reader))))
(stream-flush reply-stream)
(unless (eq :keep-alive result)
- (return)))
- (warning (w)
- (msg warn w)
- (continue))
- (error (e)
- (msg error e)
- (return)))))
+ (return)))))))
(defun fd= (a b)
(= (the unistd:file-descriptor a) (the unistd:file-descriptor b)))
@@ -42,7 +45,7 @@
(find pipe readable :test #'fd=))
(return))
(when (find fd readable :test #'fd=)
- (socket:with-accept (clientfd) fd
+ (socket:with-accept (clientfd addr) fd
(let ((request-stream
(babel-input-stream
(unistd-input-stream clientfd)))
@@ -51,7 +54,9 @@
(multi-buffered-output-stream
(unistd-output-stream clientfd)))))
(request-loop-simple request-stream
- reply-stream))))))))
+ reply-stream
+ (socket:sockaddr-to-string
+ addr)))))))))
(defun configure-select ()
(setf *acceptor-loop* #'acceptor-loop-select))