From 96cd163c14e68c66c6a4cf0b18261fc454f8c1ba Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 16 Jul 2024 11:01:57 +0200
Subject: [PATCH] =?UTF-8?q?syscalls:=20Add=20=E2=80=98mode=E2=80=99=20para?=
 =?UTF-8?q?meter=20to=20=E2=80=98lock-file=E2=80=99.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* guix/build/syscalls.scm (lock-file): Add ‘mode’ parameter and honor it.
* tests/syscalls.scm ("lock-file + unlock-file"): New test.

Change-Id: I113fb4a8b35dd8782b9c0991574e39a4b4393333
---
 guix/build/syscalls.scm | 14 +++++++++-----
 tests/syscalls.scm      | 13 +++++++++++++
 2 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 39bcffd516..2c20edf058 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1398,14 +1398,18 @@ exception if it's already taken."
           ;; Presumably we got EAGAIN or so.
           (throw 'flock-error err))))))
 
-(define* (lock-file file #:key (wait? #t))
-  "Wait and acquire an exclusive lock on FILE.  Return an open port."
-  (let ((port (open-file file "w0")))
-    (fcntl-flock port 'write-lock #:wait? wait?)
+(define* (lock-file file #:optional (mode "w0")
+                    #:key (wait? #t))
+  "Wait and acquire an exclusive lock on FILE.  Return an open port according
+to MODE."
+  (let ((port (open-file file mode)))
+    (fcntl-flock port
+                 (if (output-port? port) 'write-lock 'read-lock)
+                 #:wait? wait?)
     port))
 
 (define (unlock-file port)
-  "Unlock PORT, a port returned by 'lock-file'."
+  "Unlock PORT, a port returned by 'lock-file', and close it."
   (fcntl-flock port 'unlock)
   (close-port port)
   #t)
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 7cf67c060d..13f4f11721 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -383,6 +383,19 @@
                (close-port file)
                result)))))))))
 
+(test-equal "lock-file + unlock-file"
+  'hello
+  (call-with-temporary-directory
+   (lambda (directory)
+     (let* ((file (in-vicinity directory "lock"))
+            (out (lock-file file #:wait? #f)))
+       (display "hello" out)
+       (unlock-file out)
+       (let* ((in (lock-file file "r0"))
+              (content (read in)))
+         (unlock-file in)
+         content)))))
+
 (test-equal "set-thread-name"
   "Syscall Test"
   (let ((name (thread-name)))