patch-guile-fix-live-repl.patch 2.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566
  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. This reverts commit 206dced87f425af7eed628530313067a45bee2c2.
  6. ---
  7. module/system/repl/server.scm | 34 +++++++++++++++++++++++++---------
  8. 1 file changed, 25 insertions(+), 9 deletions(-)
  9. diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
  10. index f6981edf0..e7241c9ab 100644
  11. --- a/module/system/repl/server.scm
  12. +++ b/module/system/repl/server.scm
  13. @@ -78,6 +78,15 @@
  14. (bind sock AF_UNIX path)
  15. sock))
  16. +;; List of errno values from 'select' or 'accept' that should lead to a
  17. +;; retry in 'run-server'.
  18. +(define errs-to-retry
  19. + (delete-duplicates
  20. + (filter-map (lambda (name)
  21. + (and=> (module-variable the-root-module name)
  22. + variable-ref))
  23. + '(EINTR EAGAIN EWOULDBLOCK))))
  24. +
  25. (define* (run-server #:optional (server-socket (make-tcp-server-socket)))
  26. (run-server* server-socket serve-client))
  27. @@ -98,15 +107,22 @@
  28. shutdown-read-pipe))
  29. (define (accept-new-client)
  30. - (let ((ready-ports (car (select monitored-ports '() '()))))
  31. - ;; If we've been asked to shut down, return #f.
  32. - (and (not (memq shutdown-read-pipe ready-ports))
  33. - ;; If the socket turns out to actually not be ready, this
  34. - ;; will return #f. ECONNABORTED etc are still possible of
  35. - ;; course.
  36. - (or (false-if-exception (accept server-socket)
  37. - #:warning "Failed to accept client:")
  38. - (accept-new-client)))))
  39. + (catch #t
  40. + (lambda ()
  41. + (let ((ready-ports (car (select monitored-ports '() '()))))
  42. + ;; If we've been asked to shut down, return #f.
  43. + (and (not (memq shutdown-read-pipe ready-ports))
  44. + (accept server-socket))))
  45. + (lambda k-args
  46. + (let ((err (system-error-errno k-args)))
  47. + (cond
  48. + ((memv err errs-to-retry)
  49. + (accept-new-client))
  50. + (else
  51. + (warn "Error accepting client" k-args)
  52. + ;; Retry after a timeout.
  53. + (sleep 1)
  54. + (accept-new-client)))))))
  55. ;; Put the socket into non-blocking mode.
  56. (fcntl server-socket F_SETFL
  57. --
  58. 2.11.0