guix: Add file-locking with no wait.
* guix/build/syscalls.scm (with-file-lock/no-wait): New procedure. (lock-file): Take a #:wait? key.master
parent
970cb5cece
commit
f49e913188
|
@ -80,6 +80,7 @@
|
||||||
lock-file
|
lock-file
|
||||||
unlock-file
|
unlock-file
|
||||||
with-file-lock
|
with-file-lock
|
||||||
|
with-file-lock/no-wait
|
||||||
|
|
||||||
set-thread-name
|
set-thread-name
|
||||||
thread-name
|
thread-name
|
||||||
|
@ -1087,10 +1088,10 @@ exception if it's already taken."
|
||||||
;; Presumably we got EAGAIN or so.
|
;; Presumably we got EAGAIN or so.
|
||||||
(throw 'flock-error err))))))
|
(throw 'flock-error err))))))
|
||||||
|
|
||||||
(define (lock-file file)
|
(define* (lock-file file #:key (wait? #t))
|
||||||
"Wait and acquire an exclusive lock on FILE. Return an open port."
|
"Wait and acquire an exclusive lock on FILE. Return an open port."
|
||||||
(let ((port (open-file file "w0")))
|
(let ((port (open-file file "w0")))
|
||||||
(fcntl-flock port 'write-lock)
|
(fcntl-flock port 'write-lock #:wait? wait?)
|
||||||
port))
|
port))
|
||||||
|
|
||||||
(define (unlock-file port)
|
(define (unlock-file port)
|
||||||
|
@ -1119,10 +1120,40 @@ exception if it's already taken."
|
||||||
(when port
|
(when port
|
||||||
(unlock-file port))))))
|
(unlock-file port))))))
|
||||||
|
|
||||||
|
(define (call-with-file-lock/no-wait file thunk handler)
|
||||||
|
(let ((port (catch #t
|
||||||
|
(lambda ()
|
||||||
|
(lock-file file #:wait? #f))
|
||||||
|
(lambda (key . args)
|
||||||
|
(match key
|
||||||
|
('flock-error
|
||||||
|
(handler args))
|
||||||
|
('system-error
|
||||||
|
;; When using the statically-linked Guile in the initrd,
|
||||||
|
;; 'fcntl-flock' returns ENOSYS unconditionally. Ignore
|
||||||
|
;; that error since we're typically the only process running
|
||||||
|
;; at this point.
|
||||||
|
(if (= ENOSYS (system-error-errno (cons key args)))
|
||||||
|
#f
|
||||||
|
(apply throw args)))
|
||||||
|
(_ (apply throw key args)))))))
|
||||||
|
(dynamic-wind
|
||||||
|
(lambda ()
|
||||||
|
#t)
|
||||||
|
thunk
|
||||||
|
(lambda ()
|
||||||
|
(when port
|
||||||
|
(unlock-file port))))))
|
||||||
|
|
||||||
(define-syntax-rule (with-file-lock file exp ...)
|
(define-syntax-rule (with-file-lock file exp ...)
|
||||||
"Wait to acquire a lock on FILE and evaluate EXP in that context."
|
"Wait to acquire a lock on FILE and evaluate EXP in that context."
|
||||||
(call-with-file-lock file (lambda () exp ...)))
|
(call-with-file-lock file (lambda () exp ...)))
|
||||||
|
|
||||||
|
(define-syntax-rule (with-file-lock/no-wait file handler exp ...)
|
||||||
|
"Try to acquire a lock on FILE and evaluate EXP in that context. Execute
|
||||||
|
handler if the lock is already held by another process."
|
||||||
|
(call-with-file-lock/no-wait file (lambda () exp ...) handler))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Miscellaneous, aka. 'prctl'.
|
;;; Miscellaneous, aka. 'prctl'.
|
||||||
|
|
Reference in New Issue