guix: Add file-locking with no wait.

* guix/build/syscalls.scm (with-file-lock/no-wait): New procedure.
(lock-file): Take a #:wait? key.
This commit is contained in:
Julien Lepiller 2019-11-07 21:50:54 +01:00
parent 970cb5cece
commit f49e913188
No known key found for this signature in database
GPG key ID: 43111F4520086A0C

View file

@ -80,6 +80,7 @@ (define-module (guix build syscalls)
lock-file
unlock-file
with-file-lock
with-file-lock/no-wait
set-thread-name
thread-name
@ -1087,10 +1088,10 @@ (define bv
;; Presumably we got EAGAIN or so.
(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."
(let ((port (open-file file "w0")))
(fcntl-flock port 'write-lock)
(fcntl-flock port 'write-lock #:wait? wait?)
port))
(define (unlock-file port)
@ -1119,10 +1120,40 @@ (define (call-with-file-lock file thunk)
(when 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 ...)
"Wait to acquire a lock on FILE and evaluate EXP in that context."
(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'.