From mboxrd@z Thu Jan 1 00:00:00 1970 From: Caleb Ristvedt Subject: Re: 02/09: guix: store: Make register-items transactional, register drv outputs Date: Wed, 13 Feb 2019 02:43:31 -0600 Message-ID: <87o97gcc3w.fsf@cune.org> References: <20190204192241.15758.66035@vcs0.savannah.gnu.org> <20190204192243.D1BD820B84@vcs0.savannah.gnu.org> <87wom8pqbi.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([209.51.188.92]:51939) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gtqFm-00025D-DF for guix-devel@gnu.org; Wed, 13 Feb 2019 03:50:51 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gtq8p-0001Yx-Jq for guix-devel@gnu.org; Wed, 13 Feb 2019 03:43:44 -0500 Received: from mail-yw1-xc2d.google.com ([2607:f8b0:4864:20::c2d]:45025) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1gtq8o-0001Up-Pl for guix-devel@gnu.org; Wed, 13 Feb 2019 03:43:39 -0500 Received: by mail-yw1-xc2d.google.com with SMTP id x21so581197ywx.11 for ; Wed, 13 Feb 2019 00:43:38 -0800 (PST) In-Reply-To: <87wom8pqbi.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Sat, 09 Feb 2019 23:09:05 +0100") List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: ludo@gnu.org, guix-devel@gnu.org --=-=-= Content-Type: text/plain 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? --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-guix-store-Make-register-items-transactional.patch >From 5ae8c31826f06f4ad0b52a4d7b0cd6c4abc64a20 Mon Sep 17 00:00:00 2001 From: Caleb Ristvedt 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-guix-store-Register-derivation-outputs.patch >From adba9061739cd9afff9d404f871f66ce36147dd2 Mon Sep 17 00:00:00 2001 From: Caleb Ristvedt 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 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 . ($ 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 --=-=-= Content-Type: text/plain - reepca --=-=-=--