[bug#42023] [PATCH] database: register-items: reduce transaction scope.

[Caleb Ristvedt <caleb.ristvedt@cune.org>]

[-- Attachment #1.1: Type: text/plain, Size: 7373 bytes --]

Ludovic Courtès <ludo@gnu.org> writes:

> Hi reepca,
>
> Did you have time to look into this (see below)?  I still see a lot of
> contention on /var/guix/db/db.sqlite-shm on berlin and I feel like these
> changes would be welcome.  :-)

Apologies for the long delay, I think I'm caught up on this issue
now. Patch series detailed below.

>
> Thanks,
> Ludo’.

>>> So general "fiddling" can't happen, but GC can. The responsibility for
>>> both locking and registering as temporary roots falls on the caller,
>>> currently, as I believe it should. We may want to document this
>>> responsibility in the docstring for register-items, though.
>>
>> Yes, it would be good to add a sentence to document it.

Patch attached.

>>
>>> So currently finalize-store-file is safe from clobbering by another
>>> process attempting to finalize to the same path, but not safe from
>>> garbage collection between when the temporary store file is renamed and
>>> when it is registered. It needs an add-temp-root prior to renaming.
>>
>> Ah, so we’d need to do that before applying the patch that reduces the
>> scope of the transaction, right?

AFAIK the only code path that actually uses finalize-store-file
currently is from the build hook / offload thingy, and it turns out that
the outputs of derivations should already be registered as temp roots by
the daemon process that launched the offload process (specifically
registered in haveDerivation() in nix/libstore/build.cc). So this is
technically not currently necessary before or after the scope-reducing
patch. But it makes sense to guarantee that the register-items
invocation will only happen on items that are protected from garbage
collection, so I've put a patch, right before the documenting of that
requirement, that modifies finalize-store-file to always add the file
being finalized as a temp root for the extent of the register-items
invocation.

>>> Also, replace-with-link doesn't check whether the "containing directory"
>>> is the store like optimisePath_() does, so in theory if another process
>>> tried to make a permanent change to the store's permissions it could be
>>> clobbered when replace-with-link restores the permissions. I don't know
>>> of any instance where this could happen currently, but it's something to
>>> keep in mind.
>>
>> I guess we should also avoid changing permissions on /gnu/store, it
>> would be wiser.

While rebasing my changes I noticed that the current implementation of
this uses (%store-directory) from (guix build utils), which may not
correspond to the #:store keyword argument of 'deduplicate'. So I added
a patch that propagates the store through to replace-with-link and from
there to with-writable-file.

>>> diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
>>> index 6784ee0b92..b6d94e49c2 100644
>>> --- a/guix/store/deduplication.scm
>>> +++ b/guix/store/deduplication.scm
>>> @@ -161,26 +161,44 @@ under STORE."
>>>                    (scandir* path))
>>>          (let ((link-file (string-append links-directory "/"
>>>                                          (bytevector->nix-base32-string hash))))
>>> -          (if (file-exists? link-file)
>>> -              (replace-with-link link-file path
>>> -                                 #:swap-directory links-directory)
>>> -              (catch 'system-error
>>> -                (lambda ()
>>> -                  (link path link-file))
>>> -                (lambda args
>>> -                  (let ((errno (system-error-errno args)))
>>> -                    (cond ((= errno EEXIST)
>>> -                           ;; Someone else put an entry for PATH in
>>> -                           ;; LINKS-DIRECTORY before we could.  Let's use it.
>>> -                           (replace-with-link path link-file
>>> -                                              #:swap-directory links-directory))
>>> -                          ((= errno ENOSPC)
>>> -                           ;; There's not enough room in the directory index for
>>> -                           ;; more entries in .links, but that's fine: we can
>>> -                           ;; just stop.
>>> -                           #f)
>>> -                          ((= errno EMLINK)
>>> -                           ;; PATH has reached the maximum number of links, but
>>> -                           ;; that's OK: we just can't deduplicate it more.
>>> -                           #f)
>>> -                          (else (apply throw args)))))))))))
>>> +          (let retry ()
>>> +            (if (file-exists? link-file)
>>> +                (catch 'system-error
>>> +                  (lambda ()
>>> +                    (replace-with-link link-file path
>>> +                                       #:swap-directory links-directory))
>>> +                  (lambda args
>>> +                    (if (and (= (system-error-errno args) ENOENT)
>>> +                             ;; ENOENT can be produced because:
>>> +                             ;; - LINK-FILE has missing directory components
>>> +                             ;; - LINKS-DIRECTORY has missing directory
>>> +                             ;;   components
>>> +                             ;; - PATH has missing directory components
>>> +                             ;;
>>> +                             ;; the last two are errors, the first just
>>> +                             ;; requires a retry.
>>> +                             (file-exists? (dirname path))
>>> +                             (file-exists? links-directory))
>>> +                        (retry)
>>> +                        (apply throw args))))
>>
>> I feel like there are TOCTTOU issues here and redundant ‘stat’ calls,
>> plus the risk of catching a ‘system-error’ coming from “somewhere else.”
>>
>> What about baking this logic directly in ‘replace-with-link’, and
>> replacing ‘file-exists?’ calls by 'system-error handling?

Patch attached. I've renamed replace-with-link to canonicalize-with-link
since it may now have to create the target link. Unfortunately there are
places where 'file-exists?' error handling is necessary, simply because
of ambiguity in errnos. For example, link(oldpath, newpath) can return
ENOENT, but there's no way of knowing from that alone whether this is
because oldpath has missing directories or newpath has missing
directories or the directory components of oldpath are all present but
the file itself is missing (the case we need to be able to recognize and
retry in case of).

Also, I tried removing the first check for whether the canonical link
exists in favor of error handling like you suggested, but this actually
messes up the hard-coded number of link-invocations expected in
tests/store-deduplication.scm - it expects a single link invocation when
the canonical link already exists, but the error-handling approach uses
two - one to discover it exists, and another to create the temporary
link. I didn't know how to reconcile the testing strategy with this
behavior, so I kept the behavior of first using a 'file-exists?' call to
test for the existence of the canonical link.

All tests pass except for tests/packages.scm, which failed even without
the patches.

- reepca


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-.dir-locals.el-fix-call-with-retrying-transaction-in.patch --]
[-- Type: text/x-patch, Size: 1247 bytes --]

From 4c8f0cc50e2a1a33d9ce2f8e58cc426872676a7f Mon Sep 17 00:00:00 2001
From: Caleb Ristvedt <caleb.ristvedt@cune.org>
Date: Wed, 24 Jun 2020 01:00:40 -0500
Subject: [PATCH 1/6] .dir-locals.el: fix call-with-{retrying-}transaction
 indenting.

* .dir-locals.el (call-with-transaction, call-with-retrying-transaction):
  change scheme-indent-function property from 2 to 1.
---
 .dir-locals.el | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index 155255a770..d3ec2dd00d 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -89,9 +89,9 @@
    (eval . (put 'let-system 'scheme-indent-function 1))
 
    (eval . (put 'with-database 'scheme-indent-function 2))
-   (eval . (put 'call-with-transaction 'scheme-indent-function 2))
+   (eval . (put 'call-with-transaction 'scheme-indent-function 1))
    (eval . (put 'with-statement 'scheme-indent-function 3))
-   (eval . (put 'call-with-retrying-transaction 'scheme-indent-function 2))
+   (eval . (put 'call-with-retrying-transaction 'scheme-indent-function 1))
    (eval . (put 'call-with-savepoint 'scheme-indent-function 1))
    (eval . (put 'call-with-retrying-savepoint 'scheme-indent-function 1))
 
-- 
2.28.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.3: 0002-deduplication-pass-store-directory-to-replace-with-l.patch --]
[-- Type: text/x-patch, Size: 8620 bytes --]

From 9717568f922e0921e5fdc320cbe6689768d29a29 Mon Sep 17 00:00:00 2001
From: Caleb Ristvedt <caleb.ristvedt@cune.org>
Date: Sat, 8 Aug 2020 10:05:22 -0500
Subject: [PATCH 2/6] deduplication: pass store directory to replace-with-link.

This causes with-writable-file to take into consideration the actual store
being used, as passed to 'deduplicate', rather than
whatever (%store-directory) may return.

* guix/store/deduplication.scm (replace-with-link): new keyword argument
  'store'.  Pass to with-writable-file.
  (with-writable-file, call-with-writable-file): new store argument.
  (deduplicate): pass store to replace-with-link.
---
 .dir-locals.el               |   2 +-
 guix/store/deduplication.scm | 102 ++++++++++++++++++-----------------
 2 files changed, 54 insertions(+), 50 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index d3ec2dd00d..419911972d 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -37,7 +37,7 @@
    (eval . (put 'with-file-lock 'scheme-indent-function 1))
    (eval . (put 'with-file-lock/no-wait 'scheme-indent-function 1))
    (eval . (put 'with-profile-lock 'scheme-indent-function 1))
-   (eval . (put 'with-writable-file 'scheme-indent-function 1))
+   (eval . (put 'with-writable-file 'scheme-indent-function 2))
 
    (eval . (put 'package 'scheme-indent-function 0))
    (eval . (put 'origin 'scheme-indent-function 0))
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index df959bdd06..0655ceb890 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -94,8 +94,8 @@ LINK-PREFIX."
             (try (tempname-in link-prefix))
             (apply throw args))))))
 
-(define (call-with-writable-file file thunk)
-  (if (string=? file (%store-directory))
+(define (call-with-writable-file file store thunk)
+  (if (string=? file store)
       (thunk)                       ;don't meddle with the store's permissions
       (let ((stat (lstat file)))
         (dynamic-wind
@@ -106,17 +106,18 @@ LINK-PREFIX."
             (set-file-time file stat)
             (chmod file (stat:mode stat)))))))
 
-(define-syntax-rule (with-writable-file file exp ...)
+(define-syntax-rule (with-writable-file file store exp ...)
   "Make FILE writable for the dynamic extent of EXP..., except if FILE is the
 store."
-  (call-with-writable-file file (lambda () exp ...)))
+  (call-with-writable-file file store (lambda () exp ...)))
 
 ;; There are 3 main kinds of errors we can get from hardlinking: "Too many
 ;; things link to this" (EMLINK), "this link already exists" (EEXIST), and
 ;; "can't fit more stuff in this directory" (ENOSPC).
 
 (define* (replace-with-link target to-replace
-                            #:key (swap-directory (dirname target)))
+                            #:key (swap-directory (dirname target))
+                            (store (%store-directory)))
   "Atomically replace the file TO-REPLACE with a link to TARGET.  Use
 SWAP-DIRECTORY as the directory to store temporary hard links.  Upon ENOSPC
 and EMLINK, TO-REPLACE is left unchanged.
@@ -137,7 +138,7 @@ Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on the same file system."
   ;; If we couldn't create TEMP-LINK, that's OK: just don't do the
   ;; replacement, which means TO-REPLACE won't be deduplicated.
   (when temp-link
-    (with-writable-file (dirname to-replace)
+    (with-writable-file (dirname to-replace) store
       (catch 'system-error
         (lambda ()
           (rename-file temp-link to-replace))
@@ -154,46 +155,49 @@ under STORE."
   (define links-directory
     (string-append store "/.links"))
 
-  (mkdir-p links-directory)
-  (let loop ((path path)
-             (type (stat:type (lstat path)))
-             (hash hash))
-    (if (eq? 'directory type)
-        ;; Can't hardlink directories, so hardlink their atoms.
-        (for-each (match-lambda
-                    ((file . properties)
-                     (unless (member file '("." ".."))
-                       (let* ((file (string-append path "/" file))
-                              (type (match (assoc-ref properties 'type)
-                                      ((or 'unknown #f)
-                                       (stat:type (lstat file)))
-                                      (type type))))
-                         (loop file type
-                               (and (not (eq? 'directory type))
-                                    (nar-sha256 file)))))))
-                  (scandir* path))
-        (let ((link-file (string-append links-directory "/"
-                                        (bytevector->nix-base32-string hash))))
-          (if (file-exists? link-file)
-              (replace-with-link link-file path
-                                 #:swap-directory links-directory)
-              (catch 'system-error
-                (lambda ()
-                  (link path link-file))
-                (lambda args
-                  (let ((errno (system-error-errno args)))
-                    (cond ((= errno EEXIST)
-                           ;; Someone else put an entry for PATH in
-                           ;; LINKS-DIRECTORY before we could.  Let's use it.
-                           (replace-with-link path link-file
-                                              #:swap-directory links-directory))
-                          ((= errno ENOSPC)
-                           ;; There's not enough room in the directory index for
-                           ;; more entries in .links, but that's fine: we can
-                           ;; just stop.
-                           #f)
-                          ((= errno EMLINK)
-                           ;; PATH has reached the maximum number of links, but
-                           ;; that's OK: we just can't deduplicate it more.
-                           #f)
-                          (else (apply throw args)))))))))))
+    (mkdir-p links-directory)
+    (let loop ((path path)
+               (type (stat:type (lstat path)))
+               (hash hash))
+      (if (eq? 'directory type)
+          ;; Can't hardlink directories, so hardlink their atoms.
+          (for-each (match-lambda
+                      ((file . properties)
+                       (unless (member file '("." ".."))
+                         (let* ((file (string-append path "/" file))
+                                (type (match (assoc-ref properties 'type)
+                                        ((or 'unknown #f)
+                                         (stat:type (lstat file)))
+                                        (type type))))
+                           (loop file type
+                                 (and (not (eq? 'directory type))
+                                      (nar-sha256 file)))))))
+                    (scandir* path))
+          (let ((link-file (string-append links-directory "/"
+                                          (bytevector->nix-base32-string hash))))
+            (if (file-exists? link-file)
+                (replace-with-link link-file path
+                                   #:swap-directory links-directory
+                                   #:store store)
+                (catch 'system-error
+                  (lambda ()
+                    (link path link-file))
+                  (lambda args
+                    (let ((errno (system-error-errno args)))
+                      (cond ((= errno EEXIST)
+                             ;; Someone else put an entry for PATH in
+                             ;; LINKS-DIRECTORY before we could.  Let's use it.
+                             (replace-with-link path link-file
+                                                #:swap-directory
+                                                links-directory
+                                                #:store store))
+                            ((= errno ENOSPC)
+                             ;; There's not enough room in the directory index for
+                             ;; more entries in .links, but that's fine: we can
+                             ;; just stop.
+                             #f)
+                            ((= errno EMLINK)
+                             ;; PATH has reached the maximum number of links, but
+                             ;; that's OK: we just can't deduplicate it more.
+                             #f)
+                            (else (apply throw args)))))))))))
-- 
2.28.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.4: 0003-deduplication-retry-on-ENOENT.patch --]
[-- Type: text/x-patch, Size: 7355 bytes --]

From b992a3aaac7e3b30222e0bf1df09093f18e25e6a Mon Sep 17 00:00:00 2001
From: Caleb Ristvedt <caleb.ristvedt@cune.org>
Date: Sat, 8 Aug 2020 11:25:57 -0500
Subject: [PATCH 3/6] deduplication: retry on ENOENT.

It's possible for the garbage collector to remove the "canonical" link after
it's been detected as existing by 'deduplicate'.  This would cause an ENOENT
error when replace-with-link attempts to create the temporary link.  This
changes it so that it will properly handle that by retrying.

* guix/store/deduplication.scm (replace-with-link): renamed to
  canonicalize-with-link, now also handles the case where the target link
  doesn't exist yet, and retries on ENOENT.
  (deduplicate): modified to use canonicalize-with-link.
---
 guix/store/deduplication.scm | 103 ++++++++++++++++++-----------------
 1 file changed, 53 insertions(+), 50 deletions(-)

diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index 0655ceb890..035a4218fb 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -115,9 +115,9 @@ store."
 ;; things link to this" (EMLINK), "this link already exists" (EEXIST), and
 ;; "can't fit more stuff in this directory" (ENOSPC).
 
-(define* (replace-with-link target to-replace
-                            #:key (swap-directory (dirname target))
-                            (store (%store-directory)))
+(define* (canonicalize-with-link target to-replace
+                                 #:key (swap-directory (dirname target))
+                                 (store (%store-directory)))
   "Atomically replace the file TO-REPLACE with a link to TARGET.  Use
 SWAP-DIRECTORY as the directory to store temporary hard links.  Upon ENOSPC
 and EMLINK, TO-REPLACE is left unchanged.
@@ -126,7 +126,32 @@ Note: TARGET, TO-REPLACE, and SWAP-DIRECTORY must be on the same file system."
   (define temp-link
     (catch 'system-error
       (lambda ()
-        (get-temp-link target swap-directory))
+        (let retry ()
+          (if (file-exists? target)
+              (catch 'system-error
+                (lambda ()
+                  (get-temp-link target swap-directory))
+                (lambda args
+                  (let ((errno (system-error-errno args)))
+                    (if (= errno ENOENT)
+                        ;; either SWAP-DIRECTORY has missing directory
+                        ;; components or TARGET was deleted - this is a
+                        ;; fundamental ambiguity to the errno produced by
+                        ;; link()
+                        (if (file-exists? swap-directory)
+                            ;; we must assume link failed because target doesn't
+                            ;; exist, so create it.
+                            (retry)
+                            (apply throw args))
+                        (apply throw args)))))
+              (catch 'system-error
+                (lambda ()
+                  (link to-replace target)
+                  #f)
+                (lambda args
+                  (if (= (system-error-errno args) EEXIST)
+                      (retry)
+                      (apply throw args)))))))
       (lambda args
         ;; We get ENOSPC when we can't fit an additional entry in
         ;; SWAP-DIRECTORY.  If it's EMLINK, then TARGET has reached its
@@ -155,49 +180,27 @@ under STORE."
   (define links-directory
     (string-append store "/.links"))
 
-    (mkdir-p links-directory)
-    (let loop ((path path)
-               (type (stat:type (lstat path)))
-               (hash hash))
-      (if (eq? 'directory type)
-          ;; Can't hardlink directories, so hardlink their atoms.
-          (for-each (match-lambda
-                      ((file . properties)
-                       (unless (member file '("." ".."))
-                         (let* ((file (string-append path "/" file))
-                                (type (match (assoc-ref properties 'type)
-                                        ((or 'unknown #f)
-                                         (stat:type (lstat file)))
-                                        (type type))))
-                           (loop file type
-                                 (and (not (eq? 'directory type))
-                                      (nar-sha256 file)))))))
-                    (scandir* path))
-          (let ((link-file (string-append links-directory "/"
-                                          (bytevector->nix-base32-string hash))))
-            (if (file-exists? link-file)
-                (replace-with-link link-file path
-                                   #:swap-directory links-directory
-                                   #:store store)
-                (catch 'system-error
-                  (lambda ()
-                    (link path link-file))
-                  (lambda args
-                    (let ((errno (system-error-errno args)))
-                      (cond ((= errno EEXIST)
-                             ;; Someone else put an entry for PATH in
-                             ;; LINKS-DIRECTORY before we could.  Let's use it.
-                             (replace-with-link path link-file
-                                                #:swap-directory
-                                                links-directory
-                                                #:store store))
-                            ((= errno ENOSPC)
-                             ;; There's not enough room in the directory index for
-                             ;; more entries in .links, but that's fine: we can
-                             ;; just stop.
-                             #f)
-                            ((= errno EMLINK)
-                             ;; PATH has reached the maximum number of links, but
-                             ;; that's OK: we just can't deduplicate it more.
-                             #f)
-                            (else (apply throw args)))))))))))
+  (mkdir-p links-directory)
+  (let loop ((path path)
+             (type (stat:type (lstat path)))
+             (hash hash))
+    (if (eq? 'directory type)
+        ;; Can't hardlink directories, so hardlink their atoms.
+        (for-each (match-lambda
+                    ((file . properties)
+                     (unless (member file '("." ".."))
+                       (let* ((file (string-append path "/" file))
+                              (type (match (assoc-ref properties 'type)
+                                      ((or 'unknown #f)
+                                       (stat:type (lstat file)))
+                                      (type type))))
+                         (loop file type
+                               (and (not (eq? 'directory type))
+                                    (nar-sha256 file)))))))
+                  (scandir* path))
+        (let ((link-file (string-append links-directory "/"
+                                        (bytevector->nix-base32-string
+                                         hash))))
+          (canonicalize-with-link link-file path
+                                  #:swap-directory links-directory
+                                  #:store store)))))
-- 
2.28.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.5: 0004-nar-ensure-finalization-target-is-a-temp-root-during.patch --]
[-- Type: text/x-patch, Size: 2583 bytes --]

From 6b7d011680c77642f24396be0eb0015c20413d1a Mon Sep 17 00:00:00 2001
From: Caleb Ristvedt <caleb.ristvedt@cune.org>
Date: Sat, 8 Aug 2020 08:31:38 -0500
Subject: [PATCH 4/6] nar: ensure finalization target is a temp root during
 registration.

Note that this is currently unnecessary, as finalize-store-file is only used
from the offload hook, and the daemon process that spawned the offload hook
will have already registered the derivation outputs as temp roots prior to
attempting to offload (see haveDerivation() in nix/libstore/build.cc).  But
it's necessary to ensure that the register-items invocation works properly
when finalize-store-file is used in other contexts.

* guix/nar.scm (finalize-store-file): make target a temp root during extent of
  register-items invocation.
---
 guix/nar.scm | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

diff --git a/guix/nar.scm b/guix/nar.scm
index a2aacf585c..ffb487e185 100644
--- a/guix/nar.scm
+++ b/guix/nar.scm
@@ -111,13 +111,24 @@ held."
           (when (file-exists? target)
             (delete-file-recursively target))
 
-          ;; Install the new TARGET.
-          (rename-file source target)
+          ;; Register TARGET as a temp root.  Note that this may not always be
+          ;; necessary, but adding a temp root multiple times doesn't change
+          ;; anything (except taking a little more space in the temproots
+          ;; file).  Note that currently this will only ensure that TARGET
+          ;; doesn't get deleted between now and when registration finishes;
+          ;; it may well be deleted by the time this procedure returns.
 
-          ;; Register TARGET.  As a side effect, it resets the timestamps of all
-          ;; its files, recursively, and runs a deduplication pass.
-          (register-items db
-                          (list (store-info target deriver references))))
+          ;; TODO: don't use an RPC for this, add it to *this process's* temp
+          ;; roots file.
+          (with-store store
+            (add-temp-root store target)
+            ;; Install the new TARGET.
+            (rename-file source target)
+
+            ;; Register TARGET.  As a side effect, it resets the timestamps of
+            ;; all its files, recursively, and runs a deduplication pass.
+            (register-items db
+                            (list (store-info target deriver references)))))
 
         (when lock?
           (delete-file (string-append target ".lock"))
-- 
2.28.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.6: 0005-database-document-extra-registration-requirements.patch --]
[-- Type: text/x-patch, Size: 1956 bytes --]

From 55dd48e88d641bbc17b4d9484d6ee84acfb29766 Mon Sep 17 00:00:00 2001
From: Caleb Ristvedt <caleb.ristvedt@cune.org>
Date: Wed, 8 Jul 2020 11:33:23 -0500
Subject: [PATCH 5/6] database: document extra registration requirements.

It's necessary that store items be locked and protected from garbage
collection while they are being registered.  This documents that.

* guix/store/database.scm (register-path, register-items): document GC
  protection and locking requirements.
---
 guix/store/database.scm | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/guix/store/database.scm b/guix/store/database.scm
index 50b66ce282..e39a1603af 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -397,7 +397,10 @@ absolute file name to the state directory of the store being initialized.
 Return #t on success.
 
 Use with care as it directly modifies the store!  This is primarily meant to
-be used internally by the daemon's build hook."
+be used internally by the daemon's build hook.
+
+PATH must be protected from GC and locked during execution of this, typically
+by adding it as a temp-root."
   (define db-file
     (store-database-file #:prefix prefix
                          #:state-directory state-directory))
@@ -423,7 +426,9 @@ be used internally by the daemon's build hook."
   "Register all of ITEMS, a list of <store-info> records as returned by
 'read-reference-graph', in DB.  ITEMS must be in topological order (with
 leaves first.)  REGISTRATION-TIME must be the registration time to be recorded
-in the database; #f means \"now\".  Write a progress report to LOG-PORT."
+in the database; #f means \"now\".  Write a progress report to LOG-PORT.  All
+of ITEMS must be protected from GC and locked during execution of this,
+typically by adding them as temp-roots."
   (define store-dir
     (if prefix
         (string-append prefix %storedir)
-- 
2.28.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.7: 0006-database-register-items-reduce-transaction-scope.patch --]
[-- Type: text/x-patch, Size: 4054 bytes --]

From 30afb453ce4eb161bb87645a0e6314e6af82a61f Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 23 Jun 2020 17:36:49 +0100
Subject: [PATCH 6/6] database: register-items: reduce transaction scope.

It was made transactional in a4678c6ba18d8dbd79d931f80426eebf61be7ebe, with
the reasoning to prevent broken intermediate states from being visible. I
think this means something like an entry being in ValidPaths, but the Refs not
being inserted.

Using a transaction for this makes sense, but I think using one single
transaction for the whole register-items call is unnecessary to avoid broken
states from being visible, and could block other writes to the store database
while register-items is running. Because the deduplication and resetting
timestamps happens within the transaction as well, even though these things
don't involve the database, writes to the database will still be blocked while
this is happening.

To reduce the potential for register-items to block other writers to the
database for extended periods, this commit moves the transaction to just wrap
the call to sqlite-register. This is the one place where writes occur, so that
should prevent the broken intermediate states issue above. The one difference
this will make is some of the registered items will be visible to other
connections while others may be still being added. I think this is OK, as it's
equivalent to just registering different items.

* guix/store/database.scm (register-items): Reduce transaction scope.
---
 guix/store/database.scm | 37 +++++++++++++++++++------------------
 1 file changed, 19 insertions(+), 18 deletions(-)

diff --git a/guix/store/database.scm b/guix/store/database.scm
index e39a1603af..2ea63b17aa 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -457,24 +457,25 @@ typically by adding them as temp-roots."
       (when reset-timestamps?
         (reset-timestamps real-file-name))
       (let-values (((hash nar-size) (nar-sha256 real-file-name)))
-        (sqlite-register db #:path to-register
-                         #:references (store-info-references item)
-                         #:deriver (store-info-deriver item)
-                         #:hash (string-append "sha256:"
-                                               (bytevector->base16-string hash))
-                         #:nar-size nar-size
-                         #:time registration-time)
+        (call-with-retrying-transaction db
+          (lambda ()
+            (sqlite-register db #:path to-register
+                             #:references (store-info-references item)
+                             #:deriver (store-info-deriver item)
+                             #:hash (string-append
+                                     "sha256:"
+                                     (bytevector->base16-string hash))
+                             #:nar-size nar-size
+                             #:time registration-time)))
         (when deduplicate?
           (deduplicate real-file-name hash #:store store-dir)))))
 
-  (call-with-retrying-transaction db
-      (lambda ()
-        (let* ((prefix   (format #f "registering ~a items" (length items)))
-               (progress (progress-reporter/bar (length items)
-                                                prefix log-port)))
-          (call-with-progress-reporter progress
-            (lambda (report)
-              (for-each (lambda (item)
-                          (register db item)
-                          (report))
-                        items)))))))
+  (let* ((prefix   (format #f "registering ~a items" (length items)))
+         (progress (progress-reporter/bar (length items)
+                                          prefix log-port)))
+    (call-with-progress-reporter progress
+      (lambda (report)
+        (for-each (lambda (item)
+                    (register db item)
+                    (report))
+                  items)))))
-- 
2.28.0


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]