[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
17/19: guix: store: Make register-items transactional, register drv outp
From: |
guix-commits |
Subject: |
17/19: guix: store: Make register-items transactional, register drv outputs |
Date: |
Tue, 29 Jan 2019 14:19:52 -0500 (EST) |
reepca pushed a commit to branch guile-daemon
in repository guix.
commit 2946700984f584e7b62a8d346f8ec84dba68d7ef
Author: Caleb Ristvedt <address@hidden>
Date: Tue Jan 29 12:46:02 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?
* guix/derivations.scm (derivation-path?): re-export so that (guix store
database) can use it without causing a cycle between it and (guix store).
* .dir-locals.el (call-with-transaction): indent it.
---
.dir-locals.el | 7 +----
guix/derivations.scm | 3 ++-
guix/store/database.scm | 72 +++++++++++++++++++++++++++++++++++++++++--------
3 files changed, 64 insertions(+), 18 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index 87bc13c..550e06e 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -79,12 +79,7 @@
(eval . (put 'with-extensions 'scheme-indent-function 1))
(eval . (put 'with-database 'scheme-indent-function 2))
-
- (eval . (put 'with-sql-statement 'scheme-indent-function 1))
- (eval . (put 'with-sql-statements 'scheme-indent-function 1))
- (eval . (put 'with-sql-database 'scheme-indent-function 1))
- (eval . (put 'run-sql 'scheme-indent-function 1))
- (eval . (put 'run-statement 'scheme-indent-function 1))
+ (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/derivations.scm b/guix/derivations.scm
index fb2fa17..31b1364 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -107,7 +107,8 @@
build-expression->derivation)
;; Re-export it from here for backward compatibility.
- #:re-export (%guile-for-build))
+ #:re-export (%guile-for-build
+ derivation-path?))
;;;
;;; Error conditions.
diff --git a/guix/store/database.scm b/guix/store/database.scm
index 6490b52..20615eb 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -23,6 +23,7 @@
#:use-module (guix config)
#:use-module (guix serialization)
#:use-module (guix store deduplication)
+ #:use-module (guix derivations)
#:use-module (guix base16)
#:use-module (guix progress)
#:use-module (guix build syscalls)
@@ -101,6 +102,30 @@ create it and initialize it as a new database."
(lambda ()
(sqlite-close db)))))
+(define SQLITE_BUSY 5)
+
+(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."
+ (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"))
@@ -177,9 +202,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)
@@ -262,6 +287,11 @@ be used internally by the daemon's build hook."
;; When it all began.
(make-time time-utc 0 1))
+(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)
@@ -310,6 +340,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)))
+
;; 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'.
@@ -324,21 +370,25 @@ 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))
(when deduplicate?
(deduplicate real-file-name hash #:store store-dir)))))
(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)))))))))
(define get-outputs-sql
"SELECT path FROM DerivationOutputs WHERE $drvpath IN (SELECT path FROM
- 08/19: guix: register-path: do deduplication., (continued)
- 08/19: guix: register-path: do deduplication., guix-commits, 2019/01/29
- 12/19: linux-container: new use-output argument., guix-commits, 2019/01/29
- 02/19: guix: register-path: Implement prototype in scheme., guix-commits, 2019/01/29
- 05/19: guix: sql.scm: split into generic and store-specific parts., guix-commits, 2019/01/29
- 09/19: guix: register-path: return #t on success., guix-commits, 2019/01/29
- 03/19: guix: register-path: Honor environment variables., guix-commits, 2019/01/29
- 06/19: guix: register-path: use new %store-database-directory, guix-commits, 2019/01/29
- 10/19: guix: register-path: use new %store-database-directory, guix-commits, 2019/01/29
- 16/19: build-derivations: Leaked environment variables more robust., guix-commits, 2019/01/29
- 19/19: gnu: linux-container: Make it more suitable for derivation-building., guix-commits, 2019/01/29
- 17/19: guix: store: Make register-items transactional, register drv outputs,
guix-commits <=
- 14/19: build-derivations: initial build-group support, guix-commits, 2019/01/29
- 15/19: linux-container: don't include /dev/ptmx or /dev/pts from host., guix-commits, 2019/01/29
- 13/19: build-derivations: use call-with-container, guix-commits, 2019/01/29
- 18/19: guix: store: Adapt to using register-items instead of register-path., guix-commits, 2019/01/29
- 11/19: guix/store/build-derivations.scm: new module., guix-commits, 2019/01/29