From b7178c22bf642919345095aff9e34e02c00d5762 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 3 Jun 2019 16:23:01 +0200
Subject: syscalls: Add 'with-file-lock' macro.

* guix/scripts/offload.scm (lock-file, unlock-file, with-file-lock):
Move to...
* guix/build/syscalls.scm: ... here.
---
 guix/build/syscalls.scm | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

(limited to 'guix/build')

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'.
-- 
cgit v1.2.3