1 From 4dfa5465fe813d86a6eb798fbdc549465f812d97 Mon Sep 17 00:00:00 2001
2 From: Christopher Allan Webber <cwebber@dustycloud.org>
3 Date: Wed, 18 Jan 2017 17:27:09 -0600
4 Subject: [PATCH] Revert "Adapt run-server* to change to `accept'."
6 This reverts commit 206dced87f425af7eed628530313067a45bee2c2.
8 module/system/repl/server.scm | 34 +++++++++++++++++++++++++---------
9 1 file changed, 25 insertions(+), 9 deletions(-)
11 diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
12 index f6981edf0..e7241c9ab 100644
13 --- a/module/system/repl/server.scm
14 +++ b/module/system/repl/server.scm
16 (bind sock AF_UNIX path)
19 +;; List of errno values from 'select' or 'accept' that should lead to a
20 +;; retry in 'run-server'.
21 +(define errs-to-retry
23 + (filter-map (lambda (name)
24 + (and=> (module-variable the-root-module name)
26 + '(EINTR EAGAIN EWOULDBLOCK))))
28 (define* (run-server #:optional (server-socket (make-tcp-server-socket)))
29 (run-server* server-socket serve-client))
34 (define (accept-new-client)
35 - (let ((ready-ports (car (select monitored-ports '() '()))))
36 - ;; If we've been asked to shut down, return #f.
37 - (and (not (memq shutdown-read-pipe ready-ports))
38 - ;; If the socket turns out to actually not be ready, this
39 - ;; will return #f. ECONNABORTED etc are still possible of
41 - (or (false-if-exception (accept server-socket)
42 - #:warning "Failed to accept client:")
43 - (accept-new-client)))))
46 + (let ((ready-ports (car (select monitored-ports '() '()))))
47 + ;; If we've been asked to shut down, return #f.
48 + (and (not (memq shutdown-read-pipe ready-ports))
49 + (accept server-socket))))
51 + (let ((err (system-error-errno k-args)))
53 + ((memv err errs-to-retry)
54 + (accept-new-client))
56 + (warn "Error accepting client" k-args)
57 + ;; Retry after a timeout.
59 + (accept-new-client)))))))
61 ;; Put the socket into non-blocking mode.
62 (fcntl server-socket F_SETFL