diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-06-03 16:23:01 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-06-05 23:10:36 +0200 |
commit | b7178c22bf642919345095aff9e34e02c00d5762 (patch) | |
tree | 3ae97ad3afecd9499104b1ed0b36e3a8b00a6b91 | |
parent | c11ac62de92c54d1422b4de6d2b50c3b2c1bbc87 (diff) | |
download | guix-b7178c22bf642919345095aff9e34e02c00d5762.tar guix-b7178c22bf642919345095aff9e34e02c00d5762.tar.gz |
syscalls: Add 'with-file-lock' macro.
* guix/scripts/offload.scm (lock-file, unlock-file, with-file-lock):
Move to...
* guix/build/syscalls.scm: ... here.
-rw-r--r-- | .dir-locals.el | 2 | ||||
-rw-r--r-- | guix/build/syscalls.scm | 27 | ||||
-rw-r--r-- | guix/scripts/offload.scm | 25 |
3 files changed, 29 insertions, 25 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index f1196fd781..228685a69f 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -34,6 +34,8 @@ (eval . (put 'modify-services '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 'origin 'scheme-indent-function 0)) (eval . (put 'build-system 'scheme-indent-function 0)) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 3abe65bc4f..04fbebb8a2 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -81,7 +81,11 @@ fdatasync pivot-root scandir* + fcntl-flock + lock-file + unlock-file + with-file-lock set-thread-name thread-name @@ -1067,6 +1071,29 @@ exception if it's already taken." ;; Presumably we got EAGAIN or so. (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'. diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index eb02672dbf..0c0dd9d516 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -236,30 +236,6 @@ instead of '~a' of type '~a'~%") ;;; 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) "Return the file name of MACHINE's file for 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)))) ;;; Local Variables: -;;; eval: (put 'with-file-lock 'scheme-indent-function 1) ;;; eval: (put 'with-error-to-port 'scheme-indent-function 1) ;;; eval: (put 'with-timeout 'scheme-indent-function 2) ;;; End: |