Commit c509baf47f64d5ac1a4a0150232fbddb5be85cb8

Thomas de Grivel 2017-06-27T18:04:05

Restart select on EINTR

diff --git a/cffi-unistd.lisp b/cffi-unistd.lisp
index 03f1226..7f8c644 100644
--- a/cffi-unistd.lisp
+++ b/cffi-unistd.lisp
@@ -211,22 +211,27 @@ or number of bytes written otherwise."
                                    (,fd-set-write '(:struct fd-set))
                                    (,fd-set-except '(:struct fd-set))
                                    (,tv '(:struct timeval)))
-         (list-to-fd-set ,g-readfds ,fd-set-read)
-         (list-to-fd-set ,g-writefds ,fd-set-write)
-         (list-to-fd-set ,g-exceptfds ,fd-set-except)
-         (when ,timeout
-           (seconds-to-timeval ,timeout ,tv))
-         (dolist (fd ,g-readfds)
-           (when (< ,nfds fd) (setq ,nfds fd)))
-         (dolist (fd ,g-writefds)
-           (when (< ,nfds fd) (setq ,nfds fd)))
-         (dolist (fd ,g-exceptfds)
-           (when (< ,nfds fd) (setq ,nfds fd)))
-         (incf ,nfds)
-         (select ,nfds ,fd-set-read ,fd-set-write ,fd-set-except
-                 (if ,timeout ,tv (null-pointer)))
-         (let ((,readfds-var (fd-set-filter ,g-readfds ,fd-set-read))
-               (,writefds-var (fd-set-filter ,g-writefds ,fd-set-write))
-               (,exceptfds-var (fd-set-filter ,g-exceptfds ,fd-set-except)))
-           (declare (ignorable ,readfds-var ,writefds-var ,exceptfds-var))
-           ,@body)))))
+         (loop
+            (list-to-fd-set ,g-readfds ,fd-set-read)
+            (list-to-fd-set ,g-writefds ,fd-set-write)
+            (list-to-fd-set ,g-exceptfds ,fd-set-except)
+            (when ,timeout
+              (seconds-to-timeval ,timeout ,tv))
+            (dolist (fd ,g-readfds)
+              (when (< ,nfds fd) (setq ,nfds fd)))
+            (dolist (fd ,g-writefds)
+              (when (< ,nfds fd) (setq ,nfds fd)))
+            (dolist (fd ,g-exceptfds)
+              (when (< ,nfds fd) (setq ,nfds fd)))
+            (incf ,nfds)
+            (handler-case
+                (select ,nfds ,fd-set-read ,fd-set-write ,fd-set-except
+                        (if ,timeout ,tv (null-pointer)))
+              (errno:errno-error (condition)
+                (when (= errno:+eintr+ (errno:errno-error-errno condition))
+                  (continue))))
+            (let ((,readfds-var (fd-set-filter ,g-readfds ,fd-set-read))
+                  (,writefds-var (fd-set-filter ,g-writefds ,fd-set-write))
+                  (,exceptfds-var (fd-set-filter ,g-exceptfds ,fd-set-except)))
+              (declare (ignorable ,readfds-var ,writefds-var ,exceptfds-var))
+              (return (progn ,@body))))))))