From b7178c22bf642919345095aff9e34e02c00d5762 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 3 Jun 2019 16:23:01 +0200
Subject: [PATCH] syscalls: Add 'with-file-lock' macro.
* guix/scripts/offload.scm (lock-file, unlock-file, with-file-lock):
Move to...
* guix/build/syscalls.scm: ... here.
---
.dir-locals.el | 2 ++
guix/build/syscalls.scm | 27 +++++++++++++++++++++++++++
guix/scripts/offload.scm | 25 -------------------------
3 files changed, 29 insertions(+), 25 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index f1196fd7813..228685a69f2 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 3abe65bc4f1..04fbebb8a2f 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -81,7 +81,11 @@ (define-module (guix build syscalls)
fdatasync
pivot-root
scandir*
+
fcntl-flock
+ lock-file
+ unlock-file
+ with-file-lock
set-thread-name
thread-name
@@ -1067,6 +1071,29 @@ (define bv
;; 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 eb02672dbfc..0c0dd9d5169 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -236,30 +236,6 @@ (define (open-ssh-session machine)
;;; 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 @@ (define not-coma
(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:
--
GitLab