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

From 4dfa5465fe813d86a6eb798fbdc549465f812d97 Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Wed, 18 Jan 2017 17:27:09 -0600
Subject: [PATCH] Revert "Adapt run-server* to change to `accept'."

This reverts commit 206dced87f425af7eed628530313067a45bee2c2.
---
 module/system/repl/server.scm | 34 +++++++++++++++++++++++++---------
 1 file changed, 25 insertions(+), 9 deletions(-)

diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
index f6981edf0..e7241c9ab 100644
--- a/module/system/repl/server.scm
+++ b/module/system/repl/server.scm
@@ -78,6 +78,15 @@
     (bind sock AF_UNIX path)
     sock))
 
+;; List of errno values from 'select' or 'accept' that should lead to a
+;; retry in 'run-server'.
+(define errs-to-retry
+  (delete-duplicates
+   (filter-map (lambda (name)
+                 (and=> (module-variable the-root-module name)
+                        variable-ref))
+               '(EINTR EAGAIN EWOULDBLOCK))))
+
 (define* (run-server #:optional (server-socket (make-tcp-server-socket)))
   (run-server* server-socket serve-client))
 
@@ -98,15 +107,22 @@
           shutdown-read-pipe))
 
   (define (accept-new-client)
-    (let ((ready-ports (car (select monitored-ports '() '()))))
-      ;; If we've been asked to shut down, return #f.
-      (and (not (memq shutdown-read-pipe ready-ports))
-           ;; If the socket turns out to actually not be ready, this
-           ;; will return #f.  ECONNABORTED etc are still possible of
-           ;; course.
-           (or (false-if-exception (accept server-socket)
-                                   #:warning "Failed to accept client:")
-               (accept-new-client)))))
+    (catch #t
+      (lambda ()
+        (let ((ready-ports (car (select monitored-ports '() '()))))
+          ;; If we've been asked to shut down, return #f.
+          (and (not (memq shutdown-read-pipe ready-ports))
+               (accept server-socket))))
+      (lambda k-args
+        (let ((err (system-error-errno k-args)))
+          (cond
+           ((memv err errs-to-retry)
+            (accept-new-client))
+           (else
+            (warn "Error accepting client" k-args)
+            ;; Retry after a timeout.
+            (sleep 1)
+            (accept-new-client)))))))
 
   ;; Put the socket into non-blocking mode.
   (fcntl server-socket F_SETFL
-- 
2.11.0