futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
* guix/nar.scm (finalize-store-file): check for deletion token when acquiring
  lock, write deletion token and delete lock file before releasing lock.
This commit is contained in:
Caleb Ristvedt 2020-05-06 11:48:21 -05:00
parent 5aa4d2dcf2
commit 37edbc91e3
No known key found for this signature in database
GPG Key ID: C166AA495F7F189C
1 changed files with 25 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
guix/nar.scm
View File

@ -82,10 +82,28 @@
REFERENCES and DERIVER. When LOCK? is true, acquire exclusive locks on TARGET REFERENCES and DERIVER. When LOCK? is true, acquire exclusive locks on TARGET
before attempting to register it; otherwise, assume TARGET's locks are already before attempting to register it; otherwise, assume TARGET's locks are already
held." 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 (with-database %default-database-file db
(unless (path-id db target) (unless (path-id db target)
(let ((lock (and lock? (let ((lock (and lock?
(lock-file (string-append target ".lock"))))) (acquire-lock (string-append target ".lock")))))
(unless (path-id db target) (unless (path-id db target)
;; If FILE already exists, delete it (it's invalid anyway.) ;; If FILE already exists, delete it (it's invalid anyway.)
@ -102,6 +120,12 @@ held."
#:deriver deriver)) #:deriver deriver))
(when lock? (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)))))) (unlock-file lock))))))
(define (temporary-store-file) (define (temporary-store-file)