summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-06-03 16:23:01 +0200
committerLudovic Courtès <ludo@gnu.org>2019-06-05 23:10:36 +0200
commitb7178c22bf642919345095aff9e34e02c00d5762 (patch)
tree3ae97ad3afecd9499104b1ed0b36e3a8b00a6b91
parentc11ac62de92c54d1422b4de6d2b50c3b2c1bbc87 (diff)
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.el2
-rw-r--r--guix/build/syscalls.scm27
-rw-r--r--guix/scripts/offload.scm25
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: