On Wed, Feb 01, 2017 at 07:50:30PM +0100, Jörg F. Wittenberger wrote: > Hi all, > > I just found a couple of procedures in the posix unit, which did not > handle EINTR well.
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"? If that behavious is inteneded, please apply the signed-off version attached. Cheers, Peter
From 8ff43e0653045f24757b7dee93bdc8fb0060ff0b 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 5099942..1ef9c21 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 4964f89..7c5a948 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1248,16 +1248,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)])
@@ -1269,7 +1275,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 7178bf64bde976442af08ab4c935dc66827041a1 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
signature.asc
Description: Digital signature
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers
