Re: 01/09: patches: honor NIX_STORE in site.py.

Re: 01/09: patches: honor NIX_STORE in site.py.

[Ludovic Courtès]

Hello reepca,

Since you mentioned on IRC that this commit is a candidate for ‘master’,
I’m replying here.

Perhaps in the future you could email guix-patches@gnu.org for specific
commits like this one, especially when it’s not strictly related to the
daemon?

guix-commits@gnu.org skribis:

> commit c44484dc2008f624788a228925e6cef2bdc6c917
> Author: Caleb Ristvedt <caleb.ristvedt@cune.org>
> Date:   Wed Jan 30 17:00:32 2019 -0600
>
>     patches: honor NIX_STORE in site.py.
>     
>     Previously various python packages would fail to work unless the store they
>     were kept in was /gnu/store. This fixes that.
>     
>     * gnu/packages/patches/python-2.7-site-prefixes.patch: Try NIX_STORE first
>       and only use /gnu/store as a fallback.

[...]

> --- a/configure.ac
> +++ b/configure.ac
> @@ -295,7 +295,8 @@ AC_CONFIG_FILES([Makefile
>                   po/guix/Makefile.in
>                   po/packages/Makefile.in
>                   etc/guix-daemon.cil
> -                 guix/config.scm])
> +                 guix/config.scm
> +		 gnu/packages/patches/python-2.7-site-prefixes.patch])

./configure does not generate any patch files based on patch templates,
and that’s on purpose.  Instead, when we need something like this, we
handle it the way ld-wrapper.in is handled: by doing the substitution
when creating the derivation.

In this case I’d suggest substituting @storedir@ in a post-unpack phase.

Does that make sense?

Also, the summary line of the commit message should be something like:

  gnu: python@2.7: Honor NIX_STORE.

Last, the patch would need to go to ‘core-updates’ because of the number
of rebuilds it entails.

Could you send an updated version of the patch?

Thanks,
Ludo’.

Re: 02/09: guix: store: Make register-items transactional, register drv outputs

[Ludovic Courtès]

Hi reepca,

guix-commits@gnu.org skribis:

> commit 91cbfa8da90d8d1723da753c171a378dae13cb40
> Author: Caleb Ristvedt <caleb.ristvedt@cune.org>
> Date:   Wed Jan 30 17:03:38 2019 -0600
>
>     guix: store: Make register-items transactional, register drv outputs
>     
>     * guix/store/database.scm (SQLITE_BUSY, register-output-sql): new variables
>       (add-references): don't try finalizing after each use, only after all the
>       uses.
>       (call-with-transaction): New procedure.
>       (register-items): Use call-with-transaction to prevent broken intermediate
>       states from being visible. Also if item is a derivation register its
>       outputs (the C++ registering does this).
>       ((guix derivations)): use it for read-derivation-from-file and
>       derivation-path?
>     
>     * .dir-locals.el (call-with-transaction): indent it.

That looks interesting!

That’s really two changes: making a proper transaction, and registering
the outputs.  Could you make it two separate commits?

> +(define SQLITE_BUSY 5)

Please add a comment stating that this is missing in
Guile-SQLite3 0.1.0 (which we should consider fixing.)

> +(define (call-with-transaction db proc)
> +  "Starts a transaction with DB (makes as many attempts as necessary) and runs
> +PROC. If PROC exits abnormally, aborts the transaction, otherwise commits the
> +transaction after it finishes."

Please use imperative tense (“Start”, not “Starts”) and two spaces after
an end-of-sentence period.  I realize I’m nitpicking but I think that
can help make the process smoother as we go.

>  (define* (register-items items
>                           #:key prefix state-directory
>                           (deduplicate? #t)
> @@ -305,6 +336,22 @@ Write a progress report to LOG-PORT."
>      (define real-file-name
>        (string-append store-dir "/" (basename (store-info-item item))))
>  
> +    (define (register-derivation-outputs)
> +      "Register all output paths of REAL-FILE-NAME as being produced by
> +it (note this doesn't mean 'already produced by it', but rather just
> +'associated with it'). This assumes REAL-FILE-NAME is a derivation!"
> +      (let ((drv (read-derivation-from-file real-file-name))
> +            (stmt (sqlite-prepare db register-output-sql #:cache? #t)))
> +        (for-each (match-lambda
> +                    ((outid . ($ <derivation-output> path))
> +                     (sqlite-bind-arguments stmt
> +                                            #:drvpath to-register
> +                                            #:outid outid
> +                                            #:outpath path)
> +                     (sqlite-fold noop #f stmt)))
> +                  (derivation-outputs drv))
> +        (sqlite-finalize stmt)))

I don’t feel comfortable using (guix derivations) here because that’s
supposed to be a higher level of abstraction.  I don’t see any way
around it though.

Could you add a test in tests/store-database.scm for this bit?

> +        (when (derivation-path? real-file-name)
> +          (register-derivation-outputs))

For clarity I’d make it:

  (register-derivation-outputs (read-derivation-from-file real-file-name))

Otherwise LGTM.  I hope we can merge things piecemeal while preserving
existing functionality.

Could you send updated patches?

Thanks,
Ludo’.

Re: 02/09: guix: store: Make register-items transactional, register drv outputs

[Caleb Ristvedt]

[-- Attachment #1: Type: text/plain, Size: 780 bytes --]


Changes made, though I'm not quite sure about this part:

> Could you add a test in tests/store-database.scm for this bit?
>
>> +        (when (derivation-path? real-file-name)
>> +          (register-derivation-outputs))

Should that be a separate test or an extension of "register-path"?
Currently I'm doing the latter. And it looks ugly. The C++ code also
checks the validity of derivation outputs (whether the outputs should
actually have those filenames), which I'd like to eventually add to
register-items, and it would cause an error with the way the test
currently is. But then again, ffffff...fff-fake is probably already not
the right filename to be generated for that file anyway. Should we try
to do things "the proper way" there?

> Could you send updated patches?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-guix-store-Make-register-items-transactional.patch --]
[-- Type: text/x-patch, Size: 4822 bytes --]

From 5ae8c31826f06f4ad0b52a4d7b0cd6c4abc64a20 Mon Sep 17 00:00:00 2001
From: Caleb Ristvedt <caleb.ristvedt@cune.org>
Date: Wed, 30 Jan 2019 17:03:38 -0600
Subject: [PATCH 1/2] guix: store: Make register-items transactional.

* guix/store/database.scm (SQLITE_BUSY, register-output-sql): new variables
  (add-references): don't try finalizing after each use, only after all the
  uses (otherwise a finalized statement would be used if #:cache? was #f).
  (call-with-transaction): New procedure.
  (register-items): Use call-with-transaction to prevent broken intermediate
  states from being visible.

* .dir-locals.el (call-with-transaction): indent it.
---
 .dir-locals.el          |  1 +
 guix/store/database.scm | 50 ++++++++++++++++++++++++++++++++---------
 2 files changed, 40 insertions(+), 11 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index 593c767d2b..550e06ef09 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -79,6 +79,7 @@
    (eval . (put 'with-extensions '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-container 'scheme-indent-function 1))
    (eval . (put 'container-excursion 'scheme-indent-function 1))
diff --git a/guix/store/database.scm b/guix/store/database.scm
index 4791f49865..af7f82b049 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -96,6 +96,31 @@ create it and initialize it as a new database."
                   (lambda ()
                     (sqlite-close db)))))
 
+;; XXX: missing in guile-sqlite3@0.1.0
+(define SQLITE_BUSY 5)
+
+(define (call-with-transaction db proc)
+  "Start a transaction with DB (make as many attempts as necessary) and run
+PROC.  If PROC exits abnormally, abort the transaction, otherwise commit the
+transaction after it finishes."
+  (catch 'sqlite-error
+    (lambda ()
+      ;; We use begin immediate here so that if we need to retry, we
+      ;; figure that out immediately rather than because some SQLITE_BUSY
+      ;; exception gets thrown partway through PROC - in which case the
+      ;; part already executed (which may contain side-effects!) would be
+      ;; executed again for every retry.
+      (sqlite-exec db "begin immediate;")
+      (let ((result (proc)))
+        (sqlite-exec db "commit;")
+        result))
+    (lambda (key who error description)
+      (if (= error SQLITE_BUSY)
+          (call-with-transaction db proc)
+          (begin
+            (sqlite-exec db "rollback;")
+            (throw 'sqlite-error who error description))))))
+
 (define %default-database-file
   ;; Default location of the store database.
   (string-append %store-database-directory "/db.sqlite"))
@@ -172,9 +197,9 @@ ids of items referred to."
                 (sqlite-bind-arguments stmt #:referrer referrer
                                        #:reference reference)
                 (sqlite-fold cons '() stmt)       ;execute it
-                (sqlite-finalize stmt)
                 (last-insert-row-id db))
-              references)))
+              references)
+    (sqlite-finalize stmt)))
 
 (define* (sqlite-register db #:key path (references '())
                           deriver hash nar-size time)
@@ -305,6 +330,7 @@ Write a progress report to LOG-PORT."
     (define real-file-name
       (string-append store-dir "/" (basename (store-info-item item))))
 
+
     ;; When TO-REGISTER is already registered, skip it.  This makes a
     ;; significant differences when 'register-closures' is called
     ;; consecutively for overlapping closures such as 'system' and 'bootcfg'.
@@ -325,12 +351,14 @@ Write a progress report to LOG-PORT."
   (mkdir-p db-dir)
   (parameterize ((sql-schema schema))
     (with-database (string-append db-dir "/db.sqlite") db
-      (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)))))))
+      (call-with-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)))))))))
-- 
2.20.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-guix-store-Register-derivation-outputs.patch --]
[-- Type: text/x-patch, Size: 6761 bytes --]

From adba9061739cd9afff9d404f871f66ce36147dd2 Mon Sep 17 00:00:00 2001
From: Caleb Ristvedt <caleb.ristvedt@cune.org>
Date: Wed, 13 Feb 2019 02:19:42 -0600
Subject: [PATCH 2/2] guix: store: Register derivation outputs.

* guix/store/database.scm (register-output-sql, derivation-outputs-sql): new
  variables.
  (registered-derivation-outputs): new procedure.
  ((guix derivations), (guix store)): used for <derivation> and
  derivation-path?, respectively.
  (register-items): if item is a derivation, also register its outputs.

* tests/store-database.scm (register-path): first register a dummy derivation
  for the test file, and check that its outputs are registered in the
  DerivationOutputs table and are equal to what was specified in the dummy
  derivation.
---
 guix/store/database.scm  | 41 ++++++++++++++++++++++++++++++++++++++++
 tests/store-database.scm | 30 ++++++++++++++++++++++++++++-
 2 files changed, 70 insertions(+), 1 deletion(-)

diff --git a/guix/store/database.scm b/guix/store/database.scm
index af7f82b049..b89d81d770 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -21,6 +21,8 @@
   #:use-module (sqlite3)
   #:use-module (guix config)
   #:use-module (guix serialization)
+  #:use-module (guix derivations)
+  #:use-module (guix store)
   #:use-module (guix store deduplication)
   #:use-module (guix base16)
   #:use-module (guix progress)
@@ -42,6 +44,7 @@
             sqlite-register
             register-path
             register-items
+            registered-derivation-outputs
             %epoch
             reset-timestamps))
 
@@ -282,6 +285,26 @@ be used internally by the daemon's build hook."
   ;; When it all began.
   (make-time time-utc 0 1))
 
+(define derivation-outputs-sql "SELECT id, path FROM DerivationOutputs WHERE
+drv in (SELECT id from ValidPaths where path = :drv)")
+
+(define (registered-derivation-outputs db drv)
+  "Get the list of (id, output-path) pairs registered for DRV."
+  (let ((stmt (sqlite-prepare db derivation-outputs-sql #:cache? #t)))
+    (sqlite-bind-arguments stmt #:drv drv)
+    (let ((result (sqlite-fold (lambda (current prev)
+                                 (match current
+                                   (#(id path)
+                                    (cons (cons id path)
+                                          prev))))
+                               '() stmt)))
+      (sqlite-finalize stmt)
+      result)))
+
+(define register-output-sql
+  "INSERT OR REPLACE INTO DerivationOutputs (drv, id, path) SELECT id, :outid,
+:outpath FROM ValidPaths WHERE path = :drvpath;")
+
 (define* (register-items items
                          #:key prefix state-directory
                          (deduplicate? #t)
@@ -330,6 +353,21 @@ Write a progress report to LOG-PORT."
     (define real-file-name
       (string-append store-dir "/" (basename (store-info-item item))))
 
+    (define (register-derivation-outputs drv)
+      "Register all output paths of DRV as being produced by it (note that
+this doesn't mean 'already produced by it', but rather just 'associated with
+it')."
+      (let ((stmt (sqlite-prepare db register-output-sql #:cache? #t)))
+        (for-each (match-lambda
+                    ((outid . ($ <derivation-output> path))
+                     (sqlite-bind-arguments stmt
+                                            #:drvpath (derivation-file-name
+                                                       drv)
+                                            #:outid outid
+                                            #:outpath path)
+                     (sqlite-fold noop #f stmt)))
+                  (derivation-outputs drv))
+        (sqlite-finalize stmt)))
 
     ;; When TO-REGISTER is already registered, skip it.  This makes a
     ;; significant differences when 'register-closures' is called
@@ -345,6 +383,9 @@ Write a progress report to LOG-PORT."
                                                (bytevector->base16-string hash))
                          #:nar-size nar-size
                          #:time registration-time)
+        (when (derivation-path? real-file-name)
+          (register-derivation-outputs (read-derivation-from-file
+                                        real-file-name)))
         (when deduplicate?
           (deduplicate real-file-name hash #:store store-dir)))))
 
diff --git a/tests/store-database.scm b/tests/store-database.scm
index 4d91884250..d5fb916586 100644
--- a/tests/store-database.scm
+++ b/tests/store-database.scm
@@ -20,6 +20,7 @@
   #:use-module (guix tests)
   #:use-module (guix store)
   #:use-module (guix store database)
+  #:use-module (guix derivations)
   #:use-module ((guix utils) #:select (call-with-temporary-output-file))
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64))
@@ -44,14 +45,41 @@
           (drv (string-append file ".drv")))
       (call-with-output-file file
         (cut display "This is a fake store item.\n" <>))
+      (when (valid-path? %store drv)
+        (delete-paths %store (list drv)))
+      (call-with-output-file drv
+        (lambda (port)
+          ;; XXX: we should really go from derivation to output path as is
+          ;; usual, currently any verification done on this derivation will
+          ;; cause an error.
+          (write-derivation ((@@ (guix derivations) make-derivation)
+                             ;; outputs
+                             (list (cons "out"
+                                         ((@@ (guix derivations)
+                                              make-derivation-output)
+                                          file
+                                          #f
+                                          #f
+                                          #f)))
+                             ;; inputs sources system builder args
+                             '() '() "" "" '()
+                             ;; env-vars filename
+                             '() drv)
+                            port)))
+      (register-path drv)
       (register-path file
                      #:references (list ref)
                      #:deriver drv)
 
       (and (valid-path? %store file)
            (equal? (references %store file) (list ref))
-           (null? (valid-derivers %store file))
+           ;; We expect the derivation outputs to be automatically
+           ;; registered.
+           (not (null? (valid-derivers %store file)))
            (null? (referrers %store file))
+           (equal? (with-database %default-database-file db
+                     (registered-derivation-outputs db drv))
+                   `(("out" . ,file)))
            (list (stat:mtime (lstat file))
                  (stat:mtime (lstat ref)))))))
 
-- 
2.20.0


[-- Attachment #4: Type: text/plain, Size: 11 bytes --]



- reepca

Re: 02/09: guix: store: Make register-items transactional, register drv outputs

[Ludovic Courtès]

Hi reepca!

Caleb Ristvedt <caleb.ristvedt@cune.org> skribis:

> Changes made, though I'm not quite sure about this part:
>
>> Could you add a test in tests/store-database.scm for this bit?
>>
>>> +        (when (derivation-path? real-file-name)
>>> +          (register-derivation-outputs))
>
> Should that be a separate test or an extension of "register-path"?
> Currently I'm doing the latter. And it looks ugly.

It’s part of ‘register-path’, so it’s a test of ‘register-path’, sure.
If you think it’s nicer to test it separately, you can write a separate
test.

>> Could you send updated patches?
>
> From 5ae8c31826f06f4ad0b52a4d7b0cd6c4abc64a20 Mon Sep 17 00:00:00 2001
> From: Caleb Ristvedt <caleb.ristvedt@cune.org>
> Date: Wed, 30 Jan 2019 17:03:38 -0600
> Subject: [PATCH 1/2] guix: store: Make register-items transactional.
>
> * guix/store/database.scm (SQLITE_BUSY, register-output-sql): new variables
>   (add-references): don't try finalizing after each use, only after all the
>   uses (otherwise a finalized statement would be used if #:cache? was #f).
>   (call-with-transaction): New procedure.
>   (register-items): Use call-with-transaction to prevent broken intermediate
>   states from being visible.
>
> * .dir-locals.el (call-with-transaction): indent it.

I applied this one (I updated the copyright year for you and tweaked the
commit log.)

> From adba9061739cd9afff9d404f871f66ce36147dd2 Mon Sep 17 00:00:00 2001
> From: Caleb Ristvedt <caleb.ristvedt@cune.org>
> Date: Wed, 13 Feb 2019 02:19:42 -0600
> Subject: [PATCH 2/2] guix: store: Register derivation outputs.
>
> * guix/store/database.scm (register-output-sql, derivation-outputs-sql): new
>   variables.
>   (registered-derivation-outputs): new procedure.
>   ((guix derivations), (guix store)): used for <derivation> and
>   derivation-path?, respectively.
>   (register-items): if item is a derivation, also register its outputs.
>
> * tests/store-database.scm (register-path): first register a dummy derivation
>   for the test file, and check that its outputs are registered in the
>   DerivationOutputs table and are equal to what was specified in the dummy
>   derivation.
> ---
>  guix/store/database.scm  | 41 ++++++++++++++++++++++++++++++++++++++++
>  tests/store-database.scm | 30 ++++++++++++++++++++++++++++-
>  2 files changed, 70 insertions(+), 1 deletion(-)
>
> diff --git a/guix/store/database.scm b/guix/store/database.scm
> index af7f82b049..b89d81d770 100644
> --- a/guix/store/database.scm
> +++ b/guix/store/database.scm
> @@ -21,6 +21,8 @@
>    #:use-module (sqlite3)
>    #:use-module (guix config)
>    #:use-module (guix serialization)
> +  #:use-module (guix derivations)
> +  #:use-module (guix store)

A problem is that we should not pull in these two modules here, because
they are conceptually at a higher level (they have to do with talking to
a separate daemon process.)

So perhaps a first step would be to re-arrange things, probably along
these lines:

  • Move the .drv parsing code and the <derivation> record type from
    (guix derivations) to, say, (guix store derivations).

  • Re-export all these bindings from (guix derivations).

  • Move ‘store-path?’, ‘derivation-path?’ & co. (everything below line
    1745 in guix/store.scm) to, say, (guix store files).  Re-export
    appropriately so the API remains unchanged.

At this point, (guix store …) modules won’t have to use (guix store) and
(guix derivations) at all.

How does that sound?

Thanks,
Ludo’.

Re: 02/09: guix: store: Make register-items transactional, register drv outputs

[Caleb Ristvedt]

> A problem is that we should not pull in these two modules here, because
> they are conceptually at a higher level (they have to do with talking to
> a separate daemon process.)
>
> So perhaps a first step would be to re-arrange things, probably along
> these lines:
>
>   • Move the .drv parsing code and the <derivation> record type from
>     (guix derivations) to, say, (guix store derivations).
>
>   • Re-export all these bindings from (guix derivations).
>
>   • Move ‘store-path?’, ‘derivation-path?’ & co. (everything below line
>     1745 in guix/store.scm) to, say, (guix store files).  Re-export
>     appropriately so the API remains unchanged.
>
> At this point, (guix store …) modules won’t have to use (guix store) and
> (guix derivations) at all.
>
> How does that sound?

As we found out on IRC yesterday, https://bugs.gnu.org/15602 is causing
this to fail. If I understand correctly, the workaround involves trying
to make sure that modules that use (guix memoization) are compiled
before (guix memoization) is (and it turns out that once that's solved
the same issue occurs with (guix config)). Considering that the
module-import-compiled builders just do a depth-first-search for scheme
source files ordered alphabetically, that's a bit tricky. I ended up
making a dummy module, (gnu build dummy), that does nothing but use
(guix config) and (guix memoization), and the tests now pass.

Does a better workaround exist? Could we pass an ordered list of files
to the builder somehow instead of just a directory? But then again,
changing every module-import-compiled would mean rebuilding the
world. Eh.

Thoughts?

Oh, also, should I just copy all the copyright lines from the old
modules to the new ones?

- reepca

Re: 02/09: guix: store: Make register-items transactional, register drv outputs

[Ludovic Courtès]

Hello,

Caleb Ristvedt <caleb.ristvedt@cune.org> skribis:

>> A problem is that we should not pull in these two modules here, because
>> they are conceptually at a higher level (they have to do with talking to
>> a separate daemon process.)
>>
>> So perhaps a first step would be to re-arrange things, probably along
>> these lines:
>>
>>   • Move the .drv parsing code and the <derivation> record type from
>>     (guix derivations) to, say, (guix store derivations).
>>
>>   • Re-export all these bindings from (guix derivations).
>>
>>   • Move ‘store-path?’, ‘derivation-path?’ & co. (everything below line
>>     1745 in guix/store.scm) to, say, (guix store files).  Re-export
>>     appropriately so the API remains unchanged.
>>
>> At this point, (guix store …) modules won’t have to use (guix store) and
>> (guix derivations) at all.
>>
>> How does that sound?
>
> As we found out on IRC yesterday, https://bugs.gnu.org/15602 is causing
> this to fail. If I understand correctly, the workaround involves trying
> to make sure that modules that use (guix memoization) are compiled
> before (guix memoization) is (and it turns out that once that's solved
> the same issue occurs with (guix config)). Considering that the
> module-import-compiled builders just do a depth-first-search for scheme
> source files ordered alphabetically, that's a bit tricky. I ended up
> making a dummy module, (gnu build dummy), that does nothing but use
> (guix config) and (guix memoization), and the tests now pass.
>
> Does a better workaround exist? Could we pass an ordered list of files
> to the builder somehow instead of just a directory? But then again,
> changing every module-import-compiled would mean rebuilding the
> world. Eh.

We could go with the clunky workaround for now.

Then we should fix ‘compiled-modules’ in a way that does not force a
full rebuild.  That can be done by having a keyword argument to select
between the correct implementation and the buggy one; in (guix
packages), we’d ask for the buggy one so that we don’t trigger a
rebuild.

As for how to fix it, we could use (guix build compile) which already
does the right thing.

> Oh, also, should I just copy all the copyright lines from the old
> modules to the new ones?

Ideally you’d just copy the relevant lines; if it’s too tricky to find
out which lines correspond to what, you could copy them all (I’d argue
it’s not an unreasonable thing to do.)

Thanks!

Ludo’.

Re: 02/09: guix: store: Make register-items transactional, register drv outputs

[Ludovic Courtès]

Caleb Ristvedt <caleb.ristvedt@cune.org> skribis:

> As we found out on IRC yesterday, https://bugs.gnu.org/15602 is causing
> this to fail. If I understand correctly, the workaround involves trying
> to make sure that modules that use (guix memoization) are compiled
> before (guix memoization) is (and it turns out that once that's solved
> the same issue occurs with (guix config)). Considering that the
> module-import-compiled builders just do a depth-first-search for scheme
> source files ordered alphabetically, that's a bit tricky. I ended up
> making a dummy module, (gnu build dummy), that does nothing but use
> (guix config) and (guix memoization), and the tests now pass.

I finally got around to fixing it in
a31174e896047e6a0f42b69db331fdeebb3cc995.

The kludge is no longer needed!

Ludo’.

Re: 02/09: guix: store: Make register-items transactional, register drv outputs

[Caleb Ristvedt]

[-- Attachment #1: Type: text/plain, Size: 154 bytes --]

> I finally got around to fixing it in
> a31174e896047e6a0f42b69db331fdeebb3cc995.
>
> The kludge is no longer needed!

Great. Here are updated patches:


[-- Attachment #2: 0001-guix-split-guix-store-and-guix-derivations.patch --]
[-- Type: text/x-patch, Size: 40246 bytes --]

From 287879a825f41c46cc5091c715467e476d465def Mon Sep 17 00:00:00 2001
From: Caleb Ristvedt <caleb.ristvedt@cune.org>
Date: Mon, 1 Apr 2019 15:04:59 -0500
Subject: [PATCH 1/2] guix: split (guix store) and (guix derivations).

* guix/store.scm (%store-prefix, store-path, output-path, fixed-output-path,
  store-path?, direct-store-path?, derivation-path?, store-path-package-name,
  store-path-hash-part, direct-store-path, derivation-log-file): Moved
  to (guix store files) and re-exported from here.
  ((guix store files)): use it.

* guix/store/files.scm: new module.
  above named variables: added.

* guix/derivations.scm (<derivation>, derivation?, derivation-outputs,
  derivation-inputs, derivation-sources, derivation-system,
  derivation-builder, derivation-builder-arguments,
  derivation-builder-environment-vars, derivation-file-name,
  derivation-output>, derivation-output?, derivation-output-path,
  derivation-output-hash-algo, derivation-output-hash,
  derivation-output-recursive?, derivation-input>, derivation-input?,
  derivation-input-path, derivation-input-sub-derivations, read-derivation,
  read-derivation-from-file, write-derivation): Moved to (guix store
  derivations) and re-exported from here.
  ((guix store derivations)): use it.

* guix/store/derivations.scm: new module.
  above named variables: added.
---
 guix/derivations.scm       | 281 ++++--------------------------------
 guix/store.scm             | 155 ++------------------
 guix/store/derivations.scm | 287 +++++++++++++++++++++++++++++++++++++
 guix/store/files.scm       | 171 ++++++++++++++++++++++
 4 files changed, 502 insertions(+), 392 deletions(-)
 create mode 100644 guix/store/derivations.scm
 create mode 100644 guix/store/files.scm

diff --git a/guix/derivations.scm b/guix/derivations.scm
index fb2fa177be..483b274e53 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -39,31 +39,10 @@
   #:use-module (guix base32)
   #:use-module (guix records)
   #:use-module (guix sets)
-  #:export (<derivation>
-            derivation?
-            derivation-outputs
-            derivation-inputs
-            derivation-sources
-            derivation-system
-            derivation-builder
-            derivation-builder-arguments
-            derivation-builder-environment-vars
-            derivation-file-name
+  #:use-module (guix store derivations)
+  #:export (derivation-input-output-paths
             derivation-prerequisites
             derivation-prerequisites-to-build
-
-            <derivation-output>
-            derivation-output?
-            derivation-output-path
-            derivation-output-hash-algo
-            derivation-output-hash
-            derivation-output-recursive?
-
-            <derivation-input>
-            derivation-input?
-            derivation-input-path
-            derivation-input-sub-derivations
-            derivation-input-output-paths
             valid-derivation-input?
 
             &derivation-error
@@ -82,9 +61,6 @@
             derivation-hash
             derivation-properties
 
-            read-derivation
-            read-derivation-from-file
-            write-derivation
             derivation->output-path
             derivation->output-paths
             derivation-path->output-path
@@ -107,7 +83,33 @@
             build-expression->derivation)
 
   ;; Re-export it from here for backward compatibility.
-  #:re-export (%guile-for-build))
+  #:re-export (%guile-for-build
+               <derivation>
+               derivation?
+               derivation-outputs
+               derivation-inputs
+               derivation-sources
+               derivation-system
+               derivation-builder
+               derivation-builder-arguments
+               derivation-builder-environment-vars
+               derivation-file-name
+
+               <derivation-output>
+               derivation-output?
+               derivation-output-path
+               derivation-output-hash-algo
+               derivation-output-hash
+               derivation-output-recursive?
+
+               <derivation-input>
+               derivation-input?
+               derivation-input-path
+               derivation-input-sub-derivations
+
+               read-derivation
+               read-derivation-from-file
+               write-derivation))
 
 ;;;
 ;;; Error conditions.
@@ -121,48 +123,6 @@
   derivation-missing-output-error?
   (output derivation-missing-output))
 
-;;;
-;;; Nix derivations, as implemented in Nix's `derivations.cc'.
-;;;
-
-(define-immutable-record-type <derivation>
-  (make-derivation outputs inputs sources system builder args env-vars
-                   file-name)
-  derivation?
-  (outputs  derivation-outputs)      ; list of name/<derivation-output> pairs
-  (inputs   derivation-inputs)       ; list of <derivation-input>
-  (sources  derivation-sources)      ; list of store paths
-  (system   derivation-system)       ; string
-  (builder  derivation-builder)      ; store path
-  (args     derivation-builder-arguments)         ; list of strings
-  (env-vars derivation-builder-environment-vars)  ; list of name/value pairs
-  (file-name derivation-file-name))               ; the .drv file name
-
-(define-immutable-record-type <derivation-output>
-  (make-derivation-output path hash-algo hash recursive?)
-  derivation-output?
-  (path       derivation-output-path)             ; store path
-  (hash-algo  derivation-output-hash-algo)        ; symbol | #f
-  (hash       derivation-output-hash)             ; bytevector | #f
-  (recursive? derivation-output-recursive?))      ; Boolean
-
-(define-immutable-record-type <derivation-input>
-  (make-derivation-input path sub-derivations)
-  derivation-input?
-  (path            derivation-input-path)             ; store path
-  (sub-derivations derivation-input-sub-derivations)) ; list of strings
-
-(set-record-type-printer! <derivation>
-                          (lambda (drv port)
-                            (format port "#<derivation ~a => ~a ~a>"
-                                    (derivation-file-name drv)
-                                    (string-join
-                                     (map (match-lambda
-                                           ((_ . output)
-                                            (derivation-output-path output)))
-                                          (derivation-outputs drv)))
-                                    (number->string (object-address drv) 16))))
-
 (define (derivation-name drv)
   "Return the base name of DRV."
   (let ((base (store-path-package-name (derivation-file-name drv))))
@@ -406,189 +366,6 @@ one-argument procedure similar to that returned by 'substitution-oracle'."
                          inputs)
                     (map derivation-input-sub-derivations inputs)))))))
 
-(define (read-derivation drv-port)
-  "Read the derivation from DRV-PORT and return the corresponding <derivation>
-object.  Most of the time you'll want to use 'read-derivation-from-file',
-which caches things as appropriate and is thus more efficient."
-
-  (define comma (string->symbol ","))
-
-  (define (ununquote x)
-    (match x
-      (('unquote x) (ununquote x))
-      ((x ...)      (map ununquote x))
-      (_            x)))
-
-  (define (outputs->alist x)
-    (fold-right (lambda (output result)
-                  (match output
-                    ((name path "" "")
-                     (alist-cons name
-                                 (make-derivation-output path #f #f #f)
-                                 result))
-                    ((name path hash-algo hash)
-                     ;; fixed-output
-                     (let* ((rec? (string-prefix? "r:" hash-algo))
-                            (algo (string->symbol
-                                   (if rec?
-                                       (string-drop hash-algo 2)
-                                       hash-algo)))
-                            (hash (base16-string->bytevector hash)))
-                       (alist-cons name
-                                   (make-derivation-output path algo
-                                                           hash rec?)
-                                   result)))))
-                '()
-                x))
-
-  (define (make-input-drvs x)
-    (fold-right (lambda (input result)
-                  (match input
-                    ((path (sub-drvs ...))
-                     (cons (make-derivation-input path sub-drvs)
-                           result))))
-                '()
-                x))
-
-  ;; The contents of a derivation are typically ASCII, but choosing
-  ;; UTF-8 allows us to take the fast path for Guile's `scm_getc'.
-  (set-port-encoding! drv-port "UTF-8")
-
-  (let loop ((exp    (read drv-port))
-             (result '()))
-    (match exp
-      ((? eof-object?)
-       (let ((result (reverse result)))
-         (match result
-           (('Derive ((outputs ...) (input-drvs ...)
-                      (input-srcs ...)
-                      (? string? system)
-                      (? string? builder)
-                      ((? string? args) ...)
-                      ((var value) ...)))
-            (make-derivation (outputs->alist outputs)
-                             (make-input-drvs input-drvs)
-                             input-srcs
-                             system builder args
-                             (fold-right alist-cons '() var value)
-                             (port-filename drv-port)))
-           (_
-            (error "failed to parse derivation" drv-port result)))))
-      ((? (cut eq? <> comma))
-       (loop (read drv-port) result))
-      (_
-       (loop (read drv-port)
-             (cons (ununquote exp) result))))))
-
-(define %derivation-cache
-  ;; Maps derivation file names to <derivation> objects.
-  ;; XXX: This is redundant with 'atts-cache' in the store.
-  (make-weak-value-hash-table 200))
-
-(define (read-derivation-from-file file)
-  "Read the derivation in FILE, a '.drv' file, and return the corresponding
-<derivation> object."
-  ;; Memoize that operation because 'read-derivation' is quite expensive,
-  ;; and because the same argument is read more than 15 times on average
-  ;; during something like (package-derivation s gdb).
-  (or (and file (hash-ref %derivation-cache file))
-      (let ((drv (call-with-input-file file read-derivation)))
-        (hash-set! %derivation-cache file drv)
-        drv)))
-
-(define-inlinable (write-sequence lst write-item port)
-  ;; Write each element of LST with WRITE-ITEM to PORT, separating them with a
-  ;; comma.
-  (match lst
-    (()
-     #t)
-    ((prefix (... ...) last)
-     (for-each (lambda (item)
-                 (write-item item port)
-                 (display "," port))
-               prefix)
-     (write-item last port))))
-
-(define-inlinable (write-list lst write-item port)
-  ;; Write LST as a derivation list to PORT, using WRITE-ITEM to write each
-  ;; element.
-  (display "[" port)
-  (write-sequence lst write-item port)
-  (display "]" port))
-
-(define-inlinable (write-tuple lst write-item port)
-  ;; Same, but write LST as a tuple.
-  (display "(" port)
-  (write-sequence lst write-item port)
-  (display ")" port))
-
-(define (write-derivation drv port)
-  "Write the ATerm-like serialization of DRV to PORT.  See Section 2.4 of
-Eelco Dolstra's PhD dissertation for an overview of a previous version of
-that form."
-
-  ;; Make sure we're using the faster implementation.
-  (define format simple-format)
-
-  (define (write-string-list lst)
-    (write-list lst write port))
-
-  (define (write-output output port)
-    (match output
-     ((name . ($ <derivation-output> path hash-algo hash recursive?))
-      (write-tuple (list name path
-                         (if hash-algo
-                             (string-append (if recursive? "r:" "")
-                                            (symbol->string hash-algo))
-                             "")
-                         (or (and=> hash bytevector->base16-string)
-                             ""))
-                   write
-                   port))))
-
-  (define (write-input input port)
-    (match input
-      (($ <derivation-input> path sub-drvs)
-       (display "(\"" port)
-       (display path port)
-       (display "\"," port)
-       (write-string-list sub-drvs)
-       (display ")" port))))
-
-  (define (write-env-var env-var port)
-    (match env-var
-      ((name . value)
-       (display "(" port)
-       (write name port)
-       (display "," port)
-       (write value port)
-       (display ")" port))))
-
-  ;; Assume all the lists we are writing are already sorted.
-  (match drv
-    (($ <derivation> outputs inputs sources
-        system builder args env-vars)
-     (display "Derive(" port)
-     (write-list outputs write-output port)
-     (display "," port)
-     (write-list inputs write-input port)
-     (display "," port)
-     (write-string-list sources)
-     (simple-format port ",\"~a\",\"~a\"," system builder)
-     (write-string-list args)
-     (display "," port)
-     (write-list env-vars write-env-var port)
-     (display ")" port))))
-
-(define derivation->bytevector
-  (mlambda (drv)
-    "Return the external representation of DRV as a UTF-8-encoded string."
-    (with-fluids ((%default-port-encoding "UTF-8"))
-      (call-with-values open-bytevector-output-port
-        (lambda (port get-bytevector)
-          (write-derivation drv port)
-          (get-bytevector))))))
-
 (define* (derivation->output-path drv #:optional (output "out"))
   "Return the store path of its output OUTPUT.  Raise a
 '&derivation-missing-output-error' condition if OUTPUT is not an output of
diff --git a/guix/store.scm b/guix/store.scm
index 0a0a7c7c52..d1ccf36f27 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -18,6 +18,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix store)
+  #:use-module (guix store files)
   #:use-module (guix utils)
   #:use-module (guix config)
   #:use-module (guix deprecation)
@@ -163,18 +164,18 @@
             interned-file
             interned-file-tree
 
-            %store-prefix
-            store-path
-            output-path
-            fixed-output-path
-            store-path?
-            direct-store-path?
-            derivation-path?
-            store-path-package-name
-            store-path-hash-part
-            direct-store-path
-            derivation-log-file
-            log-file))
+            log-file)
+  #:re-export (%store-prefix
+               store-path
+               output-path
+               fixed-output-path
+               store-path?
+               direct-store-path?
+               derivation-path?
+               store-path-package-name
+               store-path-hash-part
+               direct-store-path
+               derivation-log-file))
 
 (define %protocol-version #x163)
 
@@ -193,6 +194,7 @@
     ((_ name->int (name id) ...)
      (define-syntax name->int
        (syntax-rules (name ...)
+         ((_) '(name ...))
          ((_ name) id) ...)))))
 
 (define-enumerate-type operation-id
@@ -1740,134 +1742,7 @@ connection, and return the result."
         result))))
 
 \f
-;;;
-;;; Store paths.
-;;;
-
-(define %store-prefix
-  ;; Absolute path to the Nix store.
-  (make-parameter %store-directory))
-
-(define (compressed-hash bv size)                 ; `compressHash'
-  "Given the hash stored in BV, return a compressed version thereof that fits
-in SIZE bytes."
-  (define new (make-bytevector size 0))
-  (define old-size (bytevector-length bv))
-  (let loop ((i 0))
-    (if (= i old-size)
-        new
-        (let* ((j (modulo i size))
-               (o (bytevector-u8-ref new j)))
-          (bytevector-u8-set! new j
-                              (logxor o (bytevector-u8-ref bv i)))
-          (loop (+ 1 i))))))
-
-(define (store-path type hash name)               ; makeStorePath
-  "Return the store path for NAME/HASH/TYPE."
-  (let* ((s (string-append type ":sha256:"
-                           (bytevector->base16-string hash) ":"
-                           (%store-prefix) ":" name))
-         (h (sha256 (string->utf8 s)))
-         (c (compressed-hash h 20)))
-    (string-append (%store-prefix) "/"
-                   (bytevector->nix-base32-string c) "-"
-                   name)))
-
-(define (output-path output hash name)            ; makeOutputPath
-  "Return an output path for OUTPUT (the name of the output as a string) of
-the derivation called NAME with hash HASH."
-  (store-path (string-append "output:" output) hash
-              (if (string=? output "out")
-                  name
-                  (string-append name "-" output))))
-
-(define* (fixed-output-path name hash
-                            #:key
-                            (output "out")
-                            (hash-algo 'sha256)
-                            (recursive? #t))
-  "Return an output path for the fixed output OUTPUT defined by HASH of type
-HASH-ALGO, of the derivation NAME.  RECURSIVE? has the same meaning as for
-'add-to-store'."
-  (if (and recursive? (eq? hash-algo 'sha256))
-      (store-path "source" hash name)
-      (let ((tag (string-append "fixed:" output ":"
-                                (if recursive? "r:" "")
-                                (symbol->string hash-algo) ":"
-                                (bytevector->base16-string hash) ":")))
-        (store-path (string-append "output:" output)
-                    (sha256 (string->utf8 tag))
-                    name))))
-
-(define (store-path? path)
-  "Return #t if PATH is a store path."
-  ;; This is a lightweight check, compared to using a regexp, but this has to
-  ;; be fast as it's called often in `derivation', for instance.
-  ;; `isStorePath' in Nix does something similar.
-  (string-prefix? (%store-prefix) path))
-
-(define (direct-store-path? path)
-  "Return #t if PATH is a store path, and not a sub-directory of a store path.
-This predicate is sometimes needed because files *under* a store path are not
-valid inputs."
-  (and (store-path? path)
-       (not (string=? path (%store-prefix)))
-       (let ((len (+ 1 (string-length (%store-prefix)))))
-         (not (string-index (substring path len) #\/)))))
-
-(define (direct-store-path path)
-  "Return the direct store path part of PATH, stripping components after
-'/gnu/store/xxxx-foo'."
-  (let ((prefix-length (+ (string-length (%store-prefix)) 35)))
-    (if (> (string-length path) prefix-length)
-        (let ((slash (string-index path #\/ prefix-length)))
-          (if slash (string-take path slash) path))
-        path)))
-
-(define (derivation-path? path)
-  "Return #t if PATH is a derivation path."
-  (and (store-path? path) (string-suffix? ".drv" path)))
-
-(define store-regexp*
-  ;; The substituter makes repeated calls to 'store-path-hash-part', hence
-  ;; this optimization.
-  (mlambda (store)
-    "Return a regexp matching a file in STORE."
-    (make-regexp (string-append "^" (regexp-quote store)
-                                "/([0-9a-df-np-sv-z]{32})-([^/]+)$"))))
-
-(define (store-path-package-name path)
-  "Return the package name part of PATH, a file name in the store."
-  (let ((path-rx (store-regexp* (%store-prefix))))
-    (and=> (regexp-exec path-rx path)
-           (cut match:substring <> 2))))
-
-(define (store-path-hash-part path)
-  "Return the hash part of PATH as a base32 string, or #f if PATH is not a
-syntactically valid store path."
-  (and (string-prefix? (%store-prefix) path)
-       (let ((base (string-drop path (+ 1 (string-length (%store-prefix))))))
-         (and (> (string-length base) 33)
-              (let ((hash (string-take base 32)))
-                (and (string-every %nix-base32-charset hash)
-                     hash))))))
-
-(define (derivation-log-file drv)
-  "Return the build log file for DRV, a derivation file name, or #f if it
-could not be found."
-  (let* ((base    (basename drv))
-         (log     (string-append (or (getenv "GUIX_LOG_DIRECTORY")
-                                     (string-append %localstatedir "/log/guix"))
-                                 "/drvs/"
-                                 (string-take base 2) "/"
-                                 (string-drop base 2)))
-         (log.gz  (string-append log ".gz"))
-         (log.bz2 (string-append log ".bz2")))
-    (cond ((file-exists? log.gz) log.gz)
-          ((file-exists? log.bz2) log.bz2)
-          ((file-exists? log) log)
-          (else #f))))
-
+;; Uses VALID-DERIVERS, so can't go in (guix store files)
 (define (log-file store file)
   "Return the build log file for FILE, or #f if none could be found.  FILE
 must be an absolute store file name, or a derivation file name."
diff --git a/guix/store/derivations.scm b/guix/store/derivations.scm
new file mode 100644
index 0000000000..583c7b449a
--- /dev/null
+++ b/guix/store/derivations.scm
@@ -0,0 +1,287 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2019 Caleb Ristvedt <caleb.ristvedt@cune.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (guix store derivations)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-26)
+  #:use-module (guix base16)
+  #:use-module (guix memoization)
+  #:export (<derivation>
+            make-derivation
+            derivation?
+            derivation-outputs
+            derivation-inputs
+            derivation-sources
+            derivation-system
+            derivation-builder
+            derivation-builder-arguments
+            derivation-builder-environment-vars
+            derivation-file-name
+
+            <derivation-output>
+            make-derivation-output
+            derivation-output?
+            derivation-output-path
+            derivation-output-hash-algo
+            derivation-output-hash
+            derivation-output-recursive?
+
+            <derivation-input>
+            make-derivation-input
+            derivation-input?
+            derivation-input-path
+            derivation-input-sub-derivations
+
+            read-derivation
+            read-derivation-from-file
+            derivation->bytevector
+            %derivation-cache
+            write-derivation))
+
+;;;
+;;; Nix derivations, as implemented in Nix's `derivations.cc'.
+;;;
+
+(define-immutable-record-type <derivation>
+  (make-derivation outputs inputs sources system builder args env-vars
+                   file-name)
+  derivation?
+  (outputs  derivation-outputs)      ; list of name/<derivation-output> pairs
+  (inputs   derivation-inputs)       ; list of <derivation-input>
+  (sources  derivation-sources)      ; list of store paths
+  (system   derivation-system)       ; string
+  (builder  derivation-builder)      ; store path
+  (args     derivation-builder-arguments)         ; list of strings
+  (env-vars derivation-builder-environment-vars)  ; list of name/value pairs
+  (file-name derivation-file-name))               ; the .drv file name
+
+(define-immutable-record-type <derivation-output>
+  (make-derivation-output path hash-algo hash recursive?)
+  derivation-output?
+  (path       derivation-output-path)             ; store path
+  (hash-algo  derivation-output-hash-algo)        ; symbol | #f
+  (hash       derivation-output-hash)             ; bytevector | #f
+  (recursive? derivation-output-recursive?))      ; Boolean
+
+(define-immutable-record-type <derivation-input>
+  (make-derivation-input path sub-derivations)
+  derivation-input?
+  (path            derivation-input-path)             ; store path
+  (sub-derivations derivation-input-sub-derivations)) ; list of strings
+
+(set-record-type-printer! <derivation>
+                          (lambda (drv port)
+                            (format port "#<derivation ~a => ~a ~a>"
+                                    (derivation-file-name drv)
+                                    (string-join
+                                     (map (match-lambda
+                                           ((_ . output)
+                                            (derivation-output-path output)))
+                                          (derivation-outputs drv)))
+                                    (number->string (object-address drv) 16))))
+
+(define (read-derivation drv-port)
+  "Read the derivation from DRV-PORT and return the corresponding <derivation>
+object.  Most of the time you'll want to use 'read-derivation-from-file',
+which caches things as appropriate and is thus more efficient."
+
+  (define comma (string->symbol ","))
+
+  (define (ununquote x)
+    (match x
+      (('unquote x) (ununquote x))
+      ((x ...)      (map ununquote x))
+      (_            x)))
+
+  (define (outputs->alist x)
+    (fold-right (lambda (output result)
+                  (match output
+                    ((name path "" "")
+                     (alist-cons name
+                                 (make-derivation-output path #f #f #f)
+                                 result))
+                    ((name path hash-algo hash)
+                     ;; fixed-output
+                     (let* ((rec? (string-prefix? "r:" hash-algo))
+                            (algo (string->symbol
+                                   (if rec?
+                                       (string-drop hash-algo 2)
+                                       hash-algo)))
+                            (hash (base16-string->bytevector hash)))
+                       (alist-cons name
+                                   (make-derivation-output path algo
+                                                           hash rec?)
+                                   result)))))
+                '()
+                x))
+
+  (define (make-input-drvs x)
+    (fold-right (lambda (input result)
+                  (match input
+                    ((path (sub-drvs ...))
+                     (cons (make-derivation-input path sub-drvs)
+                           result))))
+                '()
+                x))
+
+  ;; The contents of a derivation are typically ASCII, but choosing
+  ;; UTF-8 allows us to take the fast path for Guile's `scm_getc'.
+  (set-port-encoding! drv-port "UTF-8")
+
+  (let loop ((exp    (read drv-port))
+             (result '()))
+    (match exp
+      ((? eof-object?)
+       (let ((result (reverse result)))
+         (match result
+           (('Derive ((outputs ...) (input-drvs ...)
+                      (input-srcs ...)
+                      (? string? system)
+                      (? string? builder)
+                      ((? string? args) ...)
+                      ((var value) ...)))
+            (make-derivation (outputs->alist outputs)
+                             (make-input-drvs input-drvs)
+                             input-srcs
+                             system builder args
+                             (fold-right alist-cons '() var value)
+                             (port-filename drv-port)))
+           (_
+            (error "failed to parse derivation" drv-port result)))))
+      ((? (cut eq? <> comma))
+       (loop (read drv-port) result))
+      (_
+       (loop (read drv-port)
+             (cons (ununquote exp) result))))))
+
+(define %derivation-cache
+  ;; Maps derivation file names to <derivation> objects.
+  ;; XXX: This is redundant with 'atts-cache' in the store.
+  (make-weak-value-hash-table 200))
+
+(define (read-derivation-from-file file)
+  "Read the derivation in FILE, a '.drv' file, and return the corresponding
+<derivation> object."
+  ;; Memoize that operation because 'read-derivation' is quite expensive,
+  ;; and because the same argument is read more than 15 times on average
+  ;; during something like (package-derivation s gdb).
+  (or (and file (hash-ref %derivation-cache file))
+      (let ((drv (call-with-input-file file read-derivation)))
+        (hash-set! %derivation-cache file drv)
+        drv)))
+
+(define-inlinable (write-sequence lst write-item port)
+  ;; Write each element of LST with WRITE-ITEM to PORT, separating them with a
+  ;; comma.
+  (match lst
+    (()
+     #t)
+    ((prefix (... ...) last)
+     (for-each (lambda (item)
+                 (write-item item port)
+                 (display "," port))
+               prefix)
+     (write-item last port))))
+
+(define-inlinable (write-list lst write-item port)
+  ;; Write LST as a derivation list to PORT, using WRITE-ITEM to write each
+  ;; element.
+  (display "[" port)
+  (write-sequence lst write-item port)
+  (display "]" port))
+
+(define-inlinable (write-tuple lst write-item port)
+  ;; Same, but write LST as a tuple.
+  (display "(" port)
+  (write-sequence lst write-item port)
+  (display ")" port))
+
+(define (write-derivation drv port)
+  "Write the ATerm-like serialization of DRV to PORT.  See Section 2.4 of
+Eelco Dolstra's PhD dissertation for an overview of a previous version of
+that form."
+
+  ;; Make sure we're using the faster implementation.
+  (define format simple-format)
+
+  (define (write-string-list lst)
+    (write-list lst write port))
+
+  (define (write-output output port)
+    (match output
+     ((name . ($ <derivation-output> path hash-algo hash recursive?))
+      (write-tuple (list name path
+                         (if hash-algo
+                             (string-append (if recursive? "r:" "")
+                                            (symbol->string hash-algo))
+                             "")
+                         (or (and=> hash bytevector->base16-string)
+                             ""))
+                   write
+                   port))))
+
+  (define (write-input input port)
+    (match input
+      (($ <derivation-input> path sub-drvs)
+       (display "(\"" port)
+       (display path port)
+       (display "\"," port)
+       (write-string-list sub-drvs)
+       (display ")" port))))
+
+  (define (write-env-var env-var port)
+    (match env-var
+      ((name . value)
+       (display "(" port)
+       (write name port)
+       (display "," port)
+       (write value port)
+       (display ")" port))))
+
+  ;; Assume all the lists we are writing are already sorted.
+  (match drv
+    (($ <derivation> outputs inputs sources
+        system builder args env-vars)
+     (display "Derive(" port)
+     (write-list outputs write-output port)
+     (display "," port)
+     (write-list inputs write-input port)
+     (display "," port)
+     (write-string-list sources)
+     (simple-format port ",\"~a\",\"~a\"," system builder)
+     (write-string-list args)
+     (display "," port)
+     (write-list env-vars write-env-var port)
+     (display ")" port))))
+
+(define derivation->bytevector
+  (mlambda (drv)
+    "Return the external representation of DRV as a UTF-8-encoded string."
+    (with-fluids ((%default-port-encoding "UTF-8"))
+      (call-with-values open-bytevector-output-port
+        (lambda (port get-bytevector)
+          (write-derivation drv port)
+          (get-bytevector))))))
+
diff --git a/guix/store/files.scm b/guix/store/files.scm
new file mode 100644
index 0000000000..06ed0398ba
--- /dev/null
+++ b/guix/store/files.scm
@@ -0,0 +1,171 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2019 Caleb Ristvedt <caleb.ristvedt@cune.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix store files)
+  #:use-module (ice-9 regex)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-26)
+  #:use-module (gcrypt hash)
+  #:use-module (guix base32)
+  #:use-module (guix base16)
+  #:use-module (guix config)
+  #:use-module (guix memoization)
+  #:export (%store-prefix
+            store-path
+            output-path
+            fixed-output-path
+            store-path?
+            direct-store-path?
+            derivation-path?
+            store-path-package-name
+            store-path-hash-part
+            direct-store-path
+            derivation-log-file
+            log-file))
+
+;;;
+;;; Store paths.
+;;;
+
+(define %store-prefix
+  ;; Absolute path to the Nix store.
+  (make-parameter %store-directory))
+
+(define (compressed-hash bv size)                 ; `compressHash'
+  "Given the hash stored in BV, return a compressed version thereof that fits
+in SIZE bytes."
+  (define new (make-bytevector size 0))
+  (define old-size (bytevector-length bv))
+  (let loop ((i 0))
+    (if (= i old-size)
+        new
+        (let* ((j (modulo i size))
+               (o (bytevector-u8-ref new j)))
+          (bytevector-u8-set! new j
+                              (logxor o (bytevector-u8-ref bv i)))
+          (loop (+ 1 i))))))
+
+(define (store-path type hash name)               ; makeStorePath
+  "Return the store path for NAME/HASH/TYPE."
+  (let* ((s (string-append type ":sha256:"
+                           (bytevector->base16-string hash) ":"
+                           (%store-prefix) ":" name))
+         (h (sha256 (string->utf8 s)))
+         (c (compressed-hash h 20)))
+    (string-append (%store-prefix) "/"
+                   (bytevector->nix-base32-string c) "-"
+                   name)))
+
+(define (output-path output hash name)            ; makeOutputPath
+  "Return an output path for OUTPUT (the name of the output as a string) of
+the derivation called NAME with hash HASH."
+  (store-path (string-append "output:" output) hash
+              (if (string=? output "out")
+                  name
+                  (string-append name "-" output))))
+
+(define* (fixed-output-path name hash
+                            #:key
+                            (output "out")
+                            (hash-algo 'sha256)
+                            (recursive? #t))
+  "Return an output path for the fixed output OUTPUT defined by HASH of type
+HASH-ALGO, of the derivation NAME.  RECURSIVE? has the same meaning as for
+'add-to-store'."
+  (if (and recursive? (eq? hash-algo 'sha256))
+      (store-path "source" hash name)
+      (let ((tag (string-append "fixed:" output ":"
+                                (if recursive? "r:" "")
+                                (symbol->string hash-algo) ":"
+                                (bytevector->base16-string hash) ":")))
+        (store-path (string-append "output:" output)
+                    (sha256 (string->utf8 tag))
+                    name))))
+
+(define (store-path? path)
+  "Return #t if PATH is a store path."
+  ;; This is a lightweight check, compared to using a regexp, but this has to
+  ;; be fast as it's called often in `derivation', for instance.
+  ;; `isStorePath' in Nix does something similar.
+  (string-prefix? (%store-prefix) path))
+
+(define (direct-store-path? path)
+  "Return #t if PATH is a store path, and not a sub-directory of a store path.
+This predicate is sometimes needed because files *under* a store path are not
+valid inputs."
+  (and (store-path? path)
+       (not (string=? path (%store-prefix)))
+       (let ((len (+ 1 (string-length (%store-prefix)))))
+         (not (string-index (substring path len) #\/)))))
+
+(define (direct-store-path path)
+  "Return the direct store path part of PATH, stripping components after
+'/gnu/store/xxxx-foo'."
+  (let ((prefix-length (+ (string-length (%store-prefix)) 35)))
+    (if (> (string-length path) prefix-length)
+        (let ((slash (string-index path #\/ prefix-length)))
+          (if slash (string-take path slash) path))
+        path)))
+
+(define (derivation-path? path)
+  "Return #t if PATH is a derivation path."
+  (and (store-path? path) (string-suffix? ".drv" path)))
+
+(define store-regexp*
+  ;; The substituter makes repeated calls to 'store-path-hash-part', hence
+  ;; this optimization.
+  (mlambda (store)
+    "Return a regexp matching a file in STORE."
+    (make-regexp (string-append "^" (regexp-quote store)
+                                "/([0-9a-df-np-sv-z]{32})-([^/]+)$"))))
+
+(define (store-path-package-name path)
+  "Return the package name part of PATH, a file name in the store."
+  (let ((path-rx (store-regexp* (%store-prefix))))
+    (and=> (regexp-exec path-rx path)
+           (cut match:substring <> 2))))
+
+(define (store-path-hash-part path)
+  "Return the hash part of PATH as a base32 string, or #f if PATH is not a
+syntactically valid store path."
+  (and (string-prefix? (%store-prefix) path)
+       (let ((base (string-drop path (+ 1 (string-length (%store-prefix))))))
+         (and (> (string-length base) 33)
+              (let ((hash (string-take base 32)))
+                (and (string-every %nix-base32-charset hash)
+                     hash))))))
+
+(define (derivation-log-file drv)
+  "Return the build log file for DRV, a derivation file name, or #f if it
+could not be found."
+  (let* ((base    (basename drv))
+         (log     (string-append (or (getenv "GUIX_LOG_DIRECTORY")
+                                     (string-append %localstatedir "/log/guix"))
+                                 "/drvs/"
+                                 (string-take base 2) "/"
+                                 (string-drop base 2)))
+         (log.gz  (string-append log ".gz"))
+         (log.bz2 (string-append log ".bz2")))
+    (cond ((file-exists? log.gz) log.gz)
+          ((file-exists? log.bz2) log.bz2)
+          ((file-exists? log) log)
+          (else #f))))
+
+
-- 
2.21.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-guix-store-Register-derivation-outputs.patch --]
[-- Type: text/x-patch, Size: 6785 bytes --]

From d847f7556790723cd230ef00ff4e106512299f86 Mon Sep 17 00:00:00 2001
From: Caleb Ristvedt <caleb.ristvedt@cune.org>
Date: Wed, 13 Feb 2019 02:19:42 -0600
Subject: [PATCH 2/2] guix: store: Register derivation outputs.

* guix/store/database.scm (register-output-sql, derivation-outputs-sql): new
  variables.
  (registered-derivation-outputs): new procedure.
  ((guix store derivations), (guix store files)): used for <derivation> and
  derivation-path?, respectively.
  (register-items): if item is a derivation, also register its outputs.

* tests/store-database.scm (register-path): first register a dummy derivation
  for the test file, and check that its outputs are registered in the
  DerivationOutputs table and are equal to what was specified in the dummy
  derivation.
---
 guix/store/database.scm  | 41 ++++++++++++++++++++++++++++++++++++++++
 tests/store-database.scm | 30 ++++++++++++++++++++++++++++-
 2 files changed, 70 insertions(+), 1 deletion(-)

diff --git a/guix/store/database.scm b/guix/store/database.scm
index 88d05dc42e..22f411597a 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -21,6 +21,8 @@
   #:use-module (sqlite3)
   #:use-module (guix config)
   #:use-module (guix serialization)
+  #:use-module (guix store derivations)
+  #:use-module (guix store files)
   #:use-module (guix store deduplication)
   #:use-module (guix base16)
   #:use-module (guix progress)
@@ -42,6 +44,7 @@
             sqlite-register
             register-path
             register-items
+            registered-derivation-outputs
             %epoch
             reset-timestamps))
 
@@ -282,6 +285,26 @@ be used internally by the daemon's build hook."
   ;; When it all began.
   (make-time time-utc 0 1))
 
+(define derivation-outputs-sql "SELECT id, path FROM DerivationOutputs WHERE
+drv in (SELECT id from ValidPaths where path = :drv)")
+
+(define (registered-derivation-outputs db drv)
+  "Get the list of (id, output-path) pairs registered for DRV."
+  (let ((stmt (sqlite-prepare db derivation-outputs-sql #:cache? #t)))
+    (sqlite-bind-arguments stmt #:drv drv)
+    (let ((result (sqlite-fold (lambda (current prev)
+                                 (match current
+                                   (#(id path)
+                                    (cons (cons id path)
+                                          prev))))
+                               '() stmt)))
+      (sqlite-finalize stmt)
+      result)))
+
+(define register-output-sql
+  "INSERT OR REPLACE INTO DerivationOutputs (drv, id, path) SELECT id, :outid,
+:outpath FROM ValidPaths WHERE path = :drvpath;")
+
 (define* (register-items items
                          #:key prefix state-directory
                          (deduplicate? #t)
@@ -330,6 +353,21 @@ Write a progress report to LOG-PORT."
     (define real-file-name
       (string-append store-dir "/" (basename (store-info-item item))))
 
+    (define (register-derivation-outputs drv)
+      "Register all output paths of DRV as being produced by it (note that
+this doesn't mean 'already produced by it', but rather just 'associated with
+it')."
+      (let ((stmt (sqlite-prepare db register-output-sql #:cache? #t)))
+        (for-each (match-lambda
+                    ((outid . ($ <derivation-output> path))
+                     (sqlite-bind-arguments stmt
+                                            #:drvpath (derivation-file-name
+                                                       drv)
+                                            #:outid outid
+                                            #:outpath path)
+                     (sqlite-fold noop #f stmt)))
+                  (derivation-outputs drv))
+        (sqlite-finalize stmt)))
 
     ;; When TO-REGISTER is already registered, skip it.  This makes a
     ;; significant differences when 'register-closures' is called
@@ -345,6 +383,9 @@ Write a progress report to LOG-PORT."
                                                (bytevector->base16-string hash))
                          #:nar-size nar-size
                          #:time registration-time)
+        (when (derivation-path? real-file-name)
+          (register-derivation-outputs (read-derivation-from-file
+                                        real-file-name)))
         (when deduplicate?
           (deduplicate real-file-name hash #:store store-dir)))))
 
diff --git a/tests/store-database.scm b/tests/store-database.scm
index 4d91884250..d5fb916586 100644
--- a/tests/store-database.scm
+++ b/tests/store-database.scm
@@ -20,6 +20,7 @@
   #:use-module (guix tests)
   #:use-module (guix store)
   #:use-module (guix store database)
+  #:use-module (guix derivations)
   #:use-module ((guix utils) #:select (call-with-temporary-output-file))
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64))
@@ -44,14 +45,41 @@
           (drv (string-append file ".drv")))
       (call-with-output-file file
         (cut display "This is a fake store item.\n" <>))
+      (when (valid-path? %store drv)
+        (delete-paths %store (list drv)))
+      (call-with-output-file drv
+        (lambda (port)
+          ;; XXX: we should really go from derivation to output path as is
+          ;; usual, currently any verification done on this derivation will
+          ;; cause an error.
+          (write-derivation ((@@ (guix derivations) make-derivation)
+                             ;; outputs
+                             (list (cons "out"
+                                         ((@@ (guix derivations)
+                                              make-derivation-output)
+                                          file
+                                          #f
+                                          #f
+                                          #f)))
+                             ;; inputs sources system builder args
+                             '() '() "" "" '()
+                             ;; env-vars filename
+                             '() drv)
+                            port)))
+      (register-path drv)
       (register-path file
                      #:references (list ref)
                      #:deriver drv)
 
       (and (valid-path? %store file)
            (equal? (references %store file) (list ref))
-           (null? (valid-derivers %store file))
+           ;; We expect the derivation outputs to be automatically
+           ;; registered.
+           (not (null? (valid-derivers %store file)))
            (null? (referrers %store file))
+           (equal? (with-database %default-database-file db
+                     (registered-derivation-outputs db drv))
+                   `(("out" . ,file)))
            (list (stat:mtime (lstat file))
                  (stat:mtime (lstat ref)))))))
 
-- 
2.21.0


[-- Attachment #4: Type: text/plain, Size: 10 bytes --]


- reepca