syscalls: Add 'with-file-lock' macro.

* guix/scripts/offload.scm (lock-file, unlock-file, with-file-lock):
Move to...
* guix/build/syscalls.scm: ... here.
This commit is contained in:
Ludovic Courtès 2019-06-03 16:23:01 +02:00
parent c11ac62de9
commit b7178c22bf
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 29 additions and 25 deletions

View File

@ -34,6 +34,8 @@
(eval . (put 'modify-services 'scheme-indent-function 1)) (eval . (put 'modify-services 'scheme-indent-function 1))
(eval . (put 'with-directory-excursion 'scheme-indent-function 1)) (eval . (put 'with-directory-excursion 'scheme-indent-function 1))
(eval . (put 'with-file-lock 'scheme-indent-function 1))
(eval . (put 'package 'scheme-indent-function 0)) (eval . (put 'package 'scheme-indent-function 0))
(eval . (put 'origin 'scheme-indent-function 0)) (eval . (put 'origin 'scheme-indent-function 0))
(eval . (put 'build-system 'scheme-indent-function 0)) (eval . (put 'build-system 'scheme-indent-function 0))

View File

@ -81,7 +81,11 @@
fdatasync fdatasync
pivot-root pivot-root
scandir* scandir*
fcntl-flock fcntl-flock
lock-file
unlock-file
with-file-lock
set-thread-name set-thread-name
thread-name thread-name
@ -1067,6 +1071,29 @@ 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)
"Wait and acquire an exclusive lock on FILE. Return an open port."
(let ((port (open-file file "w0")))
(fcntl-flock port 'write-lock)
port))
(define (unlock-file port)
"Unlock PORT, a port returned by 'lock-file'."
(fcntl-flock port 'unlock)
(close-port port)
#t)
(define-syntax-rule (with-file-lock file exp ...)
"Wait to acquire a lock on FILE and evaluate EXP in that context."
(let ((port (lock-file file)))
(dynamic-wind
(lambda ()
#t)
(lambda ()
exp ...)
(lambda ()
(unlock-file port)))))
;;; ;;;
;;; Miscellaneous, aka. 'prctl'. ;;; Miscellaneous, aka. 'prctl'.

View File

@ -236,30 +236,6 @@ instead of '~a' of type '~a'~%")
;;; Synchronization. ;;; Synchronization.
;;; ;;;
(define (lock-file file)
"Wait and acquire an exclusive lock on FILE. Return an open port."
(mkdir-p (dirname file))
(let ((port (open-file file "w0")))
(fcntl-flock port 'write-lock)
port))
(define (unlock-file lock)
"Unlock LOCK."
(fcntl-flock lock 'unlock)
(close-port lock)
#t)
(define-syntax-rule (with-file-lock file exp ...)
"Wait to acquire a lock on FILE and evaluate EXP in that context."
(let ((port (lock-file file)))
(dynamic-wind
(lambda ()
#t)
(lambda ()
exp ...)
(lambda ()
(unlock-file port)))))
(define (machine-slot-file machine slot) (define (machine-slot-file machine slot)
"Return the file name of MACHINE's file for SLOT." "Return the file name of MACHINE's file for SLOT."
;; For each machine we have a bunch of files representing each build slot. ;; For each machine we have a bunch of files representing each build slot.
@ -829,7 +805,6 @@ This tool is meant to be used internally by 'guix-daemon'.\n"))
(leave (G_ "invalid arguments: ~{~s ~}~%") x)))) (leave (G_ "invalid arguments: ~{~s ~}~%") x))))
;;; Local Variables: ;;; Local Variables:
;;; eval: (put 'with-file-lock 'scheme-indent-function 1)
;;; eval: (put 'with-error-to-port 'scheme-indent-function 1) ;;; eval: (put 'with-error-to-port 'scheme-indent-function 1)
;;; eval: (put 'with-timeout 'scheme-indent-function 2) ;;; eval: (put 'with-timeout 'scheme-indent-function 2)
;;; End: ;;; End: