>From 1d325e122f6adc2d02f170639ada657950c6038c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=B6rg=20F=2E=20Wittenberger?= Date: Wed, 1 Feb 2017 19:46:38 +0100 Subject: [PATCH] Handle possible EINTR in file-lock, file-lock/blocking and file-unlock. --- posixunix.scm | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) 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.6.2