syscalls: Add ‘mode’ parameter to ‘lock-file’.

* 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

@@ -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)

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)))