X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=build-aux%2Fpatch-guile-fix-live-repl.patch;fp=build-aux%2Fpatch-guile-fix-live-repl.patch;h=fbfa130cd221df982991835c69a5a23ea5c37a41;hp=0000000000000000000000000000000000000000;hb=2cb0d7e771236309dcab8c5a4fe04b46f2929223;hpb=76ece1325111d6736003c3a3c7b6383f07478d3e

diff --git a/build-aux/patch-guile-fix-live-repl.patch b/build-aux/patch-guile-fix-live-repl.patch
new file mode 100644
index 0000000..fbfa130
--- /dev/null
+++ b/build-aux/patch-guile-fix-live-repl.patch
@@ -0,0 +1,65 @@
+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
+