* Re: 01/09: patches: honor NIX_STORE in site.py. [not found] ` <20190204192243.A58BA20B45@vcs0.savannah.gnu.org> @ 2019-02-04 23:14 ` Ludovic Courtès 2019-02-07 0:07 ` [bug#34358] [PATCH] gnu: python@2.7: Honor NIX_STORE Caleb Ristvedt 0 siblings, 1 reply; 11+ messages in thread From: Ludovic Courtès @ 2019-02-04 23:14 UTC (permalink / raw) To: guix-devel, Caleb Ristvedt 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’. ^ permalink raw reply [flat|nested] 11+ messages in thread
* [bug#34358] [PATCH] gnu: python@2.7: Honor NIX_STORE. 2019-02-04 23:14 ` 01/09: patches: honor NIX_STORE in site.py Ludovic Courtès @ 2019-02-07 0:07 ` Caleb Ristvedt 2021-09-26 2:31 ` Sarah Morgensen 0 siblings, 1 reply; 11+ messages in thread From: Caleb Ristvedt @ 2019-02-07 0:07 UTC (permalink / raw) To: 34358, ludo [-- Attachment #1: Type: text/plain, Size: 1279 bytes --] Ludovic Courtès <ludo@gnu.org> writes: > 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? ... > Could you send an updated version of the patch? Here it is! > ./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. "When creating the derivation" sounds like it's when the package is lowered to a derivation, but from what I can see of ld-wrapper in (gnu packages base) the actual substitution is done when the derivation is built. I am curious how one would go about doing the substitution when the package is lowered to a derivation, though. Anyway, for now I'm doing the substitution at derivation-build-time. > Last, the patch would need to go to ‘core-updates’ because of the number > of rebuilds it entails. Should I mention this somewhere? Also, I should add that "guix lint" and indent-code.el both want changes to gnu/packages/python.scm, but not due to changes I made. Should a separate patch address those? - reepca [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: gnu: python@2.7: Honor NIX_STORE. --] [-- Type: text/x-patch, Size: 7008 bytes --] From 62e9e9a336ab5608405df8114f78c3cbb9dc3a39 Mon Sep 17 00:00:00 2001 From: Caleb Ristvedt <caleb.ristvedt@cune.org> Date: Wed, 30 Jan 2019 17:00:32 -0600 Subject: [PATCH] gnu: python@2.7: Honor NIX_STORE. 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.in: New file that causes python@2.7 to honor NIX_STORE at runtime or, if it isn't set, to use the NIX_STORE available when it was built. * gnu/packages/patches/python-2.7-site-prefixes.patch: Removed. * gnu/packages/python.scm (python-2.7): generates a patch from python-2.7-site-prefixes.patch.in at build-time and applies it. (python-3.7): don't apply that patch. (python2-minimal): inputs still need to include the patch utility and the patch. * gnu/local.mk: adjust patch name since it's been suffixed with ".in". --- gnu/local.mk | 2 +- ...atch => python-2.7-site-prefixes.patch.in} | 9 ++++-- gnu/packages/python.scm | 29 ++++++++++++++++--- 3 files changed, 32 insertions(+), 8 deletions(-) rename gnu/packages/patches/{python-2.7-site-prefixes.patch => python-2.7-site-prefixes.patch.in} (81%) diff --git a/gnu/local.mk b/gnu/local.mk index 57595721cd..af18741a55 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -1164,7 +1164,7 @@ dist_patch_DATA = \ %D%/packages/patches/python-2-deterministic-build-info.patch \ %D%/packages/patches/python-2.7-adjust-tests.patch \ %D%/packages/patches/python-2.7-search-paths.patch \ - %D%/packages/patches/python-2.7-site-prefixes.patch \ + %D%/packages/patches/python-2.7-site-prefixes.patch.in \ %D%/packages/patches/python-2.7-source-date-epoch.patch \ %D%/packages/patches/python-3-deterministic-build-info.patch \ %D%/packages/patches/python-3-search-paths.patch \ diff --git a/gnu/packages/patches/python-2.7-site-prefixes.patch b/gnu/packages/patches/python-2.7-site-prefixes.patch.in similarity index 81% rename from gnu/packages/patches/python-2.7-site-prefixes.patch rename to gnu/packages/patches/python-2.7-site-prefixes.patch.in index 9e3066508f..0ac0da46ce 100644 --- a/gnu/packages/patches/python-2.7-site-prefixes.patch +++ b/gnu/packages/patches/python-2.7-site-prefixes.patch.in @@ -5,7 +5,7 @@ site-packages (and .pth files) are searched. --- Python-2.7.11/Lib/site.py 2016-10-17 23:44:51.930871644 +0200 *************** *** 65,70 **** ---- 65,82 ---- +--- 65,85 ---- # Prefixes for site-packages; add additional prefixes like /usr/local here PREFIXES = [sys.prefix, sys.exec_prefix] @@ -16,9 +16,12 @@ site-packages (and .pth files) are searched. + # This is necessary if the packages are not merged into a single + # `site-packages` directory (like when using `guix environment`) but + # listed in PYTHONPATH (like when running `guix build`). ++ guix_store = os.getenv("NIX_STORE") ++ if not guix_store: ++ guix_store = '@storedir@' + for p in sys.path: -+ if p.startswith('/gnu/store/'): -+ PREFIXES.append(p[:p.find('/', 44)]) # find first pathsep after hash ++ if p.startswith(guix_store): ++ PREFIXES.append(p[:p.find('/', 34 + len(guix_store))]) # find first pathsep after hash + del p + # Enable per user site-packages directory diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 1c4ea720f1..7c53e6a4ef 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -76,6 +76,7 @@ (define-module (gnu packages python) #:use-module ((guix licenses) #:prefix license:) #:use-module (gnu packages) + #:use-module (gnu packages base) #:use-module (gnu packages bash) #:use-module (gnu packages compression) #:use-module (gnu packages dbm) @@ -106,7 +107,6 @@ "0x2mvz9dp11wj7p5ccvmk9s0hzjk2fa1m462p395l4r6bfnb3n92")) (patches (search-patches "python-2.7-search-paths.patch" "python-2-deterministic-build-info.patch" - "python-2.7-site-prefixes.patch" "python-2.7-source-date-epoch.patch" "python-2.7-adjust-tests.patch")) (modules '((guix build utils))) @@ -138,7 +138,10 @@ (assoc-ref %outputs "out") "/lib")) #:modules ((ice-9 ftw) (ice-9 match) - (guix build utils) (guix build gnu-build-system)) + (guix build utils) (guix build gnu-build-system) + (guix config)) + #:imported-modules ,(cons '(guix config) + %gnu-build-system-modules) #:phases (modify-phases %standard-phases (add-before @@ -188,6 +191,19 @@ (utime file circa-1980 circa-1980) #t)) #t))) + (add-after 'unpack 'apply-templated-patch + (lambda* (#:key inputs #:allow-other-keys) + (let ((patch-template (assoc-ref inputs "site-patch")) + (patch "python-2.7-site-prefixes.patch")) + ;; generate actual patch + (copy-file patch-template patch) + (substitute* patch + (("@storedir@") + %store-directory)) + ;; apply it (taken from (guix packages)) + (invoke (string-append (assoc-ref inputs "patch") "/bin/patch") + "--force" "--no-backup-if-mismatch" + "-p1" "--input" patch)))) (add-after 'install 'remove-tests ;; Remove 25 MiB of unneeded unit tests. Keep test_support.* ;; because these files are used by some libraries out there. @@ -244,7 +260,9 @@ ("readline" ,readline) ("zlib" ,zlib) ("tcl" ,tcl) - ("tk" ,tk))) ; for tkinter + ("tk" ,tk) ; for tkinter + ("site-patch" ,(search-patch "python-2.7-site-prefixes.patch.in")) + ("patch" ,patch))) (native-inputs `(("pkg-config" ,pkg-config))) (native-search-paths @@ -320,6 +338,7 @@ data types.") (substitute-keyword-arguments (package-arguments python-2) ((#:phases phases) `(modify-phases ,phases + (delete 'apply-templated-patch) ;; Unset SOURCE_DATE_EPOCH while running the test-suite and set it ;; again afterwards. See <https://bugs.python.org/issue34022>. (add-before 'check 'unset-SOURCE_DATE_EPOCH @@ -384,7 +403,9 @@ data types.") ;; is invoked upon 'make install'. 'pip' also expects 'ctypes' and thus ;; libffi. (inputs `(("libffi" ,libffi) - ("zlib" ,zlib))))) + ("zlib" ,zlib) + ("site-patch" ,(search-patch "python-2.7-site-prefixes.patch.in")) + ("patch" ,patch))))) (define-public python-minimal (package/inherit python -- 2.20.0 ^ permalink raw reply related [flat|nested] 11+ messages in thread
* [bug#34358] [PATCH] gnu: python@2.7: Honor NIX_STORE. 2019-02-07 0:07 ` [bug#34358] [PATCH] gnu: python@2.7: Honor NIX_STORE Caleb Ristvedt @ 2021-09-26 2:31 ` Sarah Morgensen 2021-09-27 16:25 ` bug#34358: " Ludovic Courtès 0 siblings, 1 reply; 11+ messages in thread From: Sarah Morgensen @ 2021-09-26 2:31 UTC (permalink / raw) To: Caleb Ristvedt; +Cc: ludo, 34358 Hello, Caleb Ristvedt <caleb.ristvedt@cune.org> writes: > Ludovic Courtès <ludo@gnu.org> writes: > >> 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? > > ... > >> Could you send an updated version of the patch? > > Here it is! > >> ./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. > > "When creating the derivation" sounds like it's when the package is lowered > to a derivation, but from what I can see of ld-wrapper in (gnu packages > base) the actual substitution is done when the derivation is built. I > am curious how one would go about doing the substitution when the > package is lowered to a derivation, though. Anyway, for now I'm doing > the substitution at derivation-build-time. > >> Last, the patch would need to go to ‘core-updates’ because of the number >> of rebuilds it entails. > > Should I mention this somewhere? > > Also, I should add that "guix lint" and indent-code.el both want changes > to gnu/packages/python.scm, but not due to changes I made. Should a > separate patch address those? > > - reepca > >From 62e9e9a336ab5608405df8114f78c3cbb9dc3a39 Mon Sep 17 00:00:00 2001 >From: Caleb Ristvedt <caleb.ristvedt@cune.org> >Date: Wed, 30 Jan 2019 17:00:32 -0600 >Subject: [PATCH] gnu: python@2.7: Honor NIX_STORE. > >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.in: New file that causes > python@2.7 to honor NIX_STORE at runtime or, if it isn't set, to use the > NIX_STORE available when it was built. > >* gnu/packages/patches/python-2.7-site-prefixes.patch: Removed. > >* gnu/packages/python.scm (python-2.7): generates a patch from > python-2.7-site-prefixes.patch.in at build-time and applies it. > (python-3.7): don't apply that patch. > (python2-minimal): inputs still need to include the patch utility and the > patch. > >* gnu/local.mk: adjust patch name since it's been suffixed with ".in". Given that Python 2.7 is now EOL and Python 3 doesn't seem to use this NIX_STORE patch in the first place, is this patch still relevant? -- Sarah ^ permalink raw reply [flat|nested] 11+ messages in thread
* bug#34358: [PATCH] gnu: python@2.7: Honor NIX_STORE. 2021-09-26 2:31 ` Sarah Morgensen @ 2021-09-27 16:25 ` Ludovic Courtès 0 siblings, 0 replies; 11+ messages in thread From: Ludovic Courtès @ 2021-09-27 16:25 UTC (permalink / raw) To: Sarah Morgensen; +Cc: Caleb Ristvedt, 34358-done Hi Sarah, Sarah Morgensen <iskarian@mgsn.dev> skribis: >>From 62e9e9a336ab5608405df8114f78c3cbb9dc3a39 Mon Sep 17 00:00:00 2001 >>From: Caleb Ristvedt <caleb.ristvedt@cune.org> >>Date: Wed, 30 Jan 2019 17:00:32 -0600 >>Subject: [PATCH] gnu: python@2.7: Honor NIX_STORE. >> >>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.in: New file that causes >> python@2.7 to honor NIX_STORE at runtime or, if it isn't set, to use the >> NIX_STORE available when it was built. >> >>* gnu/packages/patches/python-2.7-site-prefixes.patch: Removed. >> >>* gnu/packages/python.scm (python-2.7): generates a patch from >> python-2.7-site-prefixes.patch.in at build-time and applies it. >> (python-3.7): don't apply that patch. >> (python2-minimal): inputs still need to include the patch utility and the >> patch. >> >>* gnu/local.mk: adjust patch name since it's been suffixed with ".in". > > Given that Python 2.7 is now EOL and Python 3 doesn't seem to use this > NIX_STORE patch in the first place, is this patch still relevant? Let’s close it and Caleb or anyone is welcome to reopen it if there’s interest. Thanks, Ludo’. ^ permalink raw reply [flat|nested] 11+ messages in thread
[parent not found: <20190204192243.D1BD820B84@vcs0.savannah.gnu.org>]
* Re: 02/09: guix: store: Make register-items transactional, register drv outputs [not found] ` <20190204192243.D1BD820B84@vcs0.savannah.gnu.org> @ 2019-02-09 22:09 ` Ludovic Courtès 2019-02-13 8:43 ` Caleb Ristvedt 0 siblings, 1 reply; 11+ messages in thread From: Ludovic Courtès @ 2019-02-09 22:09 UTC (permalink / raw) To: guix-devel, Caleb Ristvedt 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’. ^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: 02/09: guix: store: Make register-items transactional, register drv outputs 2019-02-09 22:09 ` 02/09: guix: store: Make register-items transactional, register drv outputs Ludovic Courtès @ 2019-02-13 8:43 ` Caleb Ristvedt 2019-03-06 13:14 ` Ludovic Courtès 0 siblings, 1 reply; 11+ messages in thread From: Caleb Ristvedt @ 2019-02-13 8:43 UTC (permalink / raw) To: ludo, guix-devel [-- 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 ^ permalink raw reply related [flat|nested] 11+ messages in thread
* Re: 02/09: guix: store: Make register-items transactional, register drv outputs 2019-02-13 8:43 ` Caleb Ristvedt @ 2019-03-06 13:14 ` Ludovic Courtès 2019-04-01 17:53 ` Caleb Ristvedt 0 siblings, 1 reply; 11+ messages in thread From: Ludovic Courtès @ 2019-03-06 13:14 UTC (permalink / raw) To: Caleb Ristvedt; +Cc: guix-devel 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’. ^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: 02/09: guix: store: Make register-items transactional, register drv outputs 2019-03-06 13:14 ` Ludovic Courtès @ 2019-04-01 17:53 ` Caleb Ristvedt 2019-04-01 19:43 ` Ludovic Courtès 2019-04-04 16:20 ` Ludovic Courtès 0 siblings, 2 replies; 11+ messages in thread From: Caleb Ristvedt @ 2019-04-01 17:53 UTC (permalink / raw) To: ludo; +Cc: guix-devel > 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 ^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: 02/09: guix: store: Make register-items transactional, register drv outputs 2019-04-01 17:53 ` Caleb Ristvedt @ 2019-04-01 19:43 ` Ludovic Courtès 2019-04-04 16:20 ` Ludovic Courtès 1 sibling, 0 replies; 11+ messages in thread From: Ludovic Courtès @ 2019-04-01 19:43 UTC (permalink / raw) To: Caleb Ristvedt; +Cc: guix-devel 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’. ^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: 02/09: guix: store: Make register-items transactional, register drv outputs 2019-04-01 17:53 ` Caleb Ristvedt 2019-04-01 19:43 ` Ludovic Courtès @ 2019-04-04 16:20 ` Ludovic Courtès 2019-04-06 23:57 ` Caleb Ristvedt 1 sibling, 1 reply; 11+ messages in thread From: Ludovic Courtès @ 2019-04-04 16:20 UTC (permalink / raw) To: Caleb Ristvedt; +Cc: guix-devel 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’. ^ permalink raw reply [flat|nested] 11+ messages in thread
* Re: 02/09: guix: store: Make register-items transactional, register drv outputs 2019-04-04 16:20 ` Ludovic Courtès @ 2019-04-06 23:57 ` Caleb Ristvedt 0 siblings, 0 replies; 11+ messages in thread From: Caleb Ristvedt @ 2019-04-06 23:57 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel [-- 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 ^ permalink raw reply related [flat|nested] 11+ messages in thread
end of thread, other threads:[~2021-09-27 16:27 UTC | newest]
Thread overview: 11+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
[not found] <20190204192241.15758.66035@vcs0.savannah.gnu.org>
[not found] ` <20190204192243.A58BA20B45@vcs0.savannah.gnu.org>
2019-02-04 23:14 ` 01/09: patches: honor NIX_STORE in site.py Ludovic Courtès
2019-02-07 0:07 ` [bug#34358] [PATCH] gnu: python@2.7: Honor NIX_STORE Caleb Ristvedt
2021-09-26 2:31 ` Sarah Morgensen
2021-09-27 16:25 ` bug#34358: " Ludovic Courtès
[not found] ` <20190204192243.D1BD820B84@vcs0.savannah.gnu.org>
2019-02-09 22:09 ` 02/09: guix: store: Make register-items transactional, register drv outputs Ludovic Courtès
2019-02-13 8:43 ` Caleb Ristvedt
2019-03-06 13:14 ` Ludovic Courtès
2019-04-01 17:53 ` Caleb Ristvedt
2019-04-01 19:43 ` Ludovic Courtès
2019-04-04 16:20 ` Ludovic Courtès
2019-04-06 23:57 ` Caleb Ristvedt
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/guix.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.