[bug#72137] [PATCH 1/2] syscalls: Add ‘mode’ parameter to ‘lock-file’.

["Ludovic Courtès" <ludo@gnu.org>]

* 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 @@ (define fcntl-flock
           ;; 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 @@ (define perform-container-tests?
                (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)))
-- 
2.45.2