;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;; (guix store) since this is "daemon-side" code.
#:use-module (guix store)
#:use-module (guix store database)
+ #:use-module ((guix build store-copy) #:select (store-info))
- #:use-module (guix ui) ; for '_'
+ #:use-module (guix i18n)
#:use-module (gcrypt hash)
#:use-module (guix pki)
#:use-module (gcrypt pk-crypto)
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.)
;; Register TARGET. As a side effect, it resets the timestamps of all
;; its files, recursively, and runs a deduplication pass.
- (register-path target
- #:references references
- #:deriver deriver))
+ (register-items db
+ (list (store-info target deriver references))))
(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)
(define-syntax-rule (with-temporary-store-file name body ...)
"Evaluate BODY with NAME bound to the file name of a temporary store item
protected from GC."
- (let loop ((name (temporary-store-file)))
- (with-store store
+ (with-store store
+ (let loop ((name (temporary-store-file)))
;; Add NAME to the current process' roots. (Opening this connection to
;; the daemon allows us to reuse its code that deals with the
;; per-process roots file.)
(define* (restore-one-item port
#:key acl (verify-signature? #t) (lock? #t)
(log-port (current-error-port)))
- "Restore one store item from PORT; return its file name on success."
+ "Restore one store item of a nar bundle read from PORT; return its file name
+on success."
(define (assert-valid-signature signature hash file)
;; Bail out if SIGNATURE, which must be a string as produced by
(define* (restore-file-set port
#:key (verify-signature? #t) (lock? #t)
(log-port (current-error-port)))
- "Restore the file set read from PORT to the store. The format of the data
-on PORT must be as created by 'export-paths'---i.e., a series of Nar-formatted
-archives with interspersed meta-data joining them together, possibly with a
-digital signature at the end. Log progress to LOG-PORT. Return the list of
-files restored.
+ "Restore the file set (\"nar bundle\") read from PORT to the store. The
+format of the data on PORT must be as created by 'export-paths'---i.e., a
+series of Nar-formatted archives with interspersed meta-data joining them
+together, possibly with a digital signature at the end. Log progress to
+LOG-PORT. Return the list of files restored.
When LOCK? is #f, assume locks for the files to be restored are already held.
This is the case when the daemon calls a build hook.
HCoop / jackhill / guix / guix.git / blobdiff