From 5395ae49a635a9e3ce9b57c06ebd1281c4413cce Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 27 Mar 2016 16:10:13 +0200
Subject: [PATCH 1/2] Automatically retry file-close on _eintr.

Before, it would just raise an exception, causing lost file descriptors.
Thanks to Joerg Wittenberger.
---
 NEWS          | 2 ++
 posixunix.scm | 8 ++++++--
 posixwin.scm  | 9 ++++++---
 3 files changed, 14 insertions(+), 5 deletions(-)

diff --git a/NEWS b/NEWS
index 390155f..544536d 100644
--- a/NEWS
+++ b/NEWS
@@ -43,6 +43,8 @@
     file-type and all procedures using file-type. These are:
     regular-file?, symbolic-link?, block-device?, character-device?
     fifo? and socket?.
+  - Unit "posix": When "file-close" is interrupted it will retry,
+    to avoid leaking descriptors (thanks to Joerg Wittenberger).
   - Unit "data-structures": alist-{update[!],ref} were made consistent
     with srfi-1 in the argument order of comparison procedures.
   - Unit "lolevel": locative-ref has been fixed for locatives of u32
diff --git a/posixunix.scm b/posixunix.scm
index f56960d..7ff42ce 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -514,8 +514,12 @@ EOF
 (define file-close
   (lambda (fd)
     (##sys#check-exact fd 'file-close)
-    (when (fx< (##core#inline "C_close" fd) 0)
-      (posix-error #:file-error 'file-close "cannot close file" fd) ) ) )
+    (let loop ()
+      (when (fx< (##core#inline "C_close" fd) 0)
+	(select _errno
+	  ((_eintr) (##sys#dispatch-interrupt loop))
+	  (else
+	   (posix-error #:file-error 'file-close "cannot close file" fd))) ) ) ) )
 
 (define file-read
   (lambda (fd size . buffer)
diff --git a/posixwin.scm b/posixwin.scm
index 81d2af2..983e601 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -743,9 +743,12 @@ EOF
 (define file-close
   (lambda (fd)
     (##sys#check-exact fd 'file-close)
-    (when (fx< (##core#inline "C_close" fd) 0)
-      (##sys#update-errno)
-      (##sys#signal-hook #:file-error 'file-close "cannot close file" fd) ) ) )
+    (let loop ()
+      (when (fx< (##core#inline "C_close" fd) 0)
+	(select _errno
+	  ((_eintr) (##sys#dispatch-interrupt loop))
+	  (else
+	   (posix-error #:file-error 'file-close "cannot close file" fd))) ) ) ) )
 
 (define file-read
   (lambda (fd size . buffer)
-- 
2.1.4