03/09: syscalls: Add 'with-file-lock' macro.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit b7178c22bf642919345095aff9e34e02c00d5762
Author: Ludovic Courtès <address@hidden>
Date:   Mon Jun 3 16:23:01 2019 +0200

    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 f1196fd..228685a 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 3abe65b..04fbebb 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 eb02672..0c0dd9d 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: