01/02: nar: 'finalize-store-file' follows proper store lock protocol.

[guix-commits]

reepca pushed a commit to branch master
in repository guix.

commit 37edbc91e34fb5658261e637e6ffccdb381e5271
Author: Caleb Ristvedt <address@hidden>
AuthorDate: Wed May 6 11:48:21 2020 -0500

    nar: 'finalize-store-file' follows proper store lock protocol.
    
    * guix/nar.scm (finalize-store-file): check for deletion token when 
acquiring
      lock, write deletion token and delete lock file before releasing lock.
---
 guix/nar.scm | 26 +++++++++++++++++++++++++-
 1 file changed, 25 insertions(+), 1 deletion(-)

diff --git a/guix/nar.scm b/guix/nar.scm
index 29636aa..0a6f59b 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -82,10 +82,28 @@
 REFERENCES and DERIVER.  When LOCK? is true, acquire exclusive locks on TARGET
 before attempting to register it; otherwise, assume TARGET's locks are already
 held."
+  ;; TODO: make this reusable
+  (define (acquire-lock file)
+    (let ((port (lock-file file)))
+      ;; There is an inherent race condition between opening the lock file and
+      ;; attempting to acquire the lock on it, and because we like deleting
+      ;; these lock files when we release them, only the first successful
+      ;; acquisition on a given lock file matters.  To make it easier to tell
+      ;; when an acquisition is and isn't the first, the first to acquire it
+      ;; writes a deletion token (arbitrary character) prior to releasing the
+      ;; lock.
+      (if (zero? (stat:size (stat port)))
+          port
+          ;; if FILE is non-empty, that's because it contains the deletion
+          ;; token, so we aren't the first to acquire it.  So try again!
+          (begin
+            (close port)
+            (acquire-lock file)))))
+
   (with-database %default-database-file db
     (unless (path-id db target)
       (let ((lock (and lock?
-                       (lock-file (string-append target ".lock")))))
+                       (acquire-lock (string-append target ".lock")))))
 
         (unless (path-id db target)
           ;; If FILE already exists, delete it (it's invalid anyway.)
@@ -102,6 +120,12 @@ held."
                          #:deriver deriver))
 
         (when lock?
+          (delete-file (string-append target ".lock"))
+          ;; Write the deletion token to inform anyone who acquires the lock
+          ;; on this particular file next that they aren't the first to
+          ;; acquire it, so they should retry.
+          (display "d" lock)
+          (force-output lock)
           (unlock-file lock))))))
 
 (define (temporary-store-file)