From 50845c1e6dbc313cc051a81e1108047124780532 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?=
 <address@hidden>
Date: Wed, 1 Feb 2017 19:46:38 +0100
Subject: [PATCH] Handle possible EINTR in file-lock, file-lock/blocking and
 file-unlock.

Signed-off-by: Peter Bex <address@hidden>
---
 NEWS          |  7 +++++++
 posixunix.scm | 26 +++++++++++++++++---------
 2 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/NEWS b/NEWS
index 20e157a..32f5186 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,10 @@
+4.12.1
+
+- Core Libraries
+  - Unit "posix": If file-lock, file-lock/blocking or file-unlock are
+    interrupted by a signal, we now retry (thanks to Joerg Wittenberger).
+
+
 4.12.0
 
 - Security fixes
diff --git a/posixunix.scm b/posixunix.scm
index df9a89b..1e24910 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1335,16 +1335,22 @@ EOF
     (posix-error #:file-error loc msg (##sys#slot lock 1) (##sys#slot lock 2) (##sys#slot lock 3)) )
   (set! file-lock
     (lambda (port . args)
-      (let ([lock (setup port args 'file-lock)])
-        (if (fx< (##core#inline "C_flock_lock" port) 0)
-            (err "cannot lock file" lock 'file-lock)
-            lock) ) ) )
+      (let loop ()
+	(let ((lock (setup port args 'file-lock)))
+	  (if (fx< (##core#inline "C_flock_lock" port) 0)
+	      (select _errno
+		((_eintr) (##sys#dispatch-interrupt loop))
+		(else (err "cannot lock file" lock 'file-lock)))
+	      lock) )) ) )
   (set! file-lock/blocking
     (lambda (port . args)
-      (let ([lock (setup port args 'file-lock/blocking)])
-        (if (fx< (##core#inline "C_flock_lockw" port) 0)
-            (err "cannot lock file" lock 'file-lock/blocking)
-            lock) ) ) )
+      (let loop ()
+	(let ((lock (setup port args 'file-lock/blocking)))
+	  (if (fx< (##core#inline "C_flock_lockw" port) 0)
+	      (select _errno
+		((_eintr) (##sys#dispatch-interrupt loop))
+		(else (err "cannot lock file" lock 'file-lock/blocking)))
+	      lock) )) ) )
   (set! file-test-lock
     (lambda (port . args)
       (let ([lock (setup port args 'file-test-lock)])
@@ -1356,7 +1362,9 @@ EOF
     (##sys#check-structure lock 'lock 'file-unlock)
     (##core#inline "C_flock_setup" _f_unlck (##sys#slot lock 2) (##sys#slot lock 3))
     (when (fx< (##core#inline "C_flock_lock" (##sys#slot lock 1)) 0)
-      (posix-error #:file-error 'file-unlock "cannot unlock file" lock) ) ) )
+      (select _errno
+	((_eintr) (##sys#dispatch-interrupt (lambda () (file-unlock lock))))
+	(else (posix-error #:file-error 'file-unlock "cannot unlock file" lock)))) ) )
 
 
 ;;; FIFOs:
-- 
2.1.4