build-aux/patch-guile-fix-live-repl.patch

   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'."
   5
   6 This reverts commit 206dced87f425af7eed628530313067a45bee2c2.
   7 ---
   8  module/system/repl/server.scm | 34 +++++++++++++++++++++++++---------
   9  1 file changed, 25 insertions(+), 9 deletions(-)
  10
  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
  15 @@ -78,6 +78,15 @@
  16      (bind sock AF_UNIX path)
  17      sock))
  18
  19 +;; List of errno values from 'select' or 'accept' that should lead to a
  20 +;; retry in 'run-server'.
  21 +(define errs-to-retry
  22 +  (delete-duplicates
  23 +   (filter-map (lambda (name)
  24 +                 (and=> (module-variable the-root-module name)
  25 +                        variable-ref))
  26 +               '(EINTR EAGAIN EWOULDBLOCK))))
  27 +
  28  (define* (run-server #:optional (server-socket (make-tcp-server-socket)))
  29    (run-server* server-socket serve-client))
  30
  31 @@ -98,15 +107,22 @@
  32            shutdown-read-pipe))
  33
  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
  40 -           ;; course.
  41 -           (or (false-if-exception (accept server-socket)
  42 -                                   #:warning "Failed to accept client:")
  43 -               (accept-new-client)))))
  44 +    (catch #t
  45 +      (lambda ()
  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))))
  50 +      (lambda k-args
  51 +        (let ((err (system-error-errno k-args)))
  52 +          (cond
  53 +           ((memv err errs-to-retry)
  54 +            (accept-new-client))
  55 +           (else
  56 +            (warn "Error accepting client" k-args)
  57 +            ;; Retry after a timeout.
  58 +            (sleep 1)
  59 +            (accept-new-client)))))))
  60
  61    ;; Put the socket into non-blocking mode.
  62    (fcntl server-socket F_SETFL
  63 --
  64 2.11.0
  65