On Mon, Feb 06, 2017 at 05:32:20PM +0100, Jörg F. Wittenberger wrote:
> Am 05.02.2017 um 21:07 schrieb Peter Bex:
> > The patch looks good to me.  I must say it's not completely clear from
> > the manual what the intended semantics of the nonblocking file-lock
> > procedure are.  I guess if another process has the file locked, we
> > simply error out with "cannot lock file"?
> 
> This was at least the behavior the code did before.
> 
> Actually I'd rather love to see this changed into returning #f instead
> of raising an error.
> 
> Reading the documentation, which is not clear at this point, I did
> actually expect (as in "guess") this to be the case.

I wonder what the other hackers think about this.

Attached is a new version of the original patch that applies cleanly
against the newly reorganised version of the posix module.  It does
_not_ change the semantics at all.

I'd like to keep the behaviour in master exactly the way it is, but
we could decide to change the semantics to have it return #f in
CHICKEN 5, no need for any compatibility hack like you proposed.

Still, applying the patch to master seems like a good idea because
it's a legitimate bug that's being fixed here.

Cheers,
Peter
From 50845c1e6dbc313cc051a81e1108047124780532 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?=
 <joerg.wittenber...@softeyes.net>
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 <pe...@more-magic.net>
---
 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

From 1f212951017d4336ef3976610d5c77f31481ce62 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?=
 <joerg.wittenber...@softeyes.net>
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 <pe...@more-magic.net>

Conflicts:
	NEWS
---
 NEWS          |  8 ++++++++
 posixunix.scm | 26 +++++++++++++++++---------
 2 files changed, 25 insertions(+), 9 deletions(-)

diff --git a/NEWS b/NEWS
index 7cbe20d..46636a9 100644
--- a/NEWS
+++ b/NEWS
@@ -58,6 +58,14 @@
   - Removed support for (define-syntax (foo e r c) ...), which was
     undocumented and not officially supported anyway.
 
+
+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 7e9a21d..1cc6f1e 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1242,16 +1242,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)])
@@ -1263,7 +1269,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

Attachment: signature.asc
Description: Digital signature

_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to