@@ -22,6 +22,9 @@
(define-module (guix store database)
#:use-module (sqlite3)
#:use-module (guix config)
+ #:use-module (guix serialization)
+ #:use-module (guix store)
+ #:use-module (guix derivations)
#:use-module (guix store deduplication)
#:use-module (guix base16)
#:use-module (guix progress)
@@ -44,7 +47,9 @@ (define-module (guix store database)
valid-path-id
register-valid-path
+ register-derivation-outputs
register-items
+ registered-derivation-outputs
%epoch
reset-timestamps
vacuum-database))
@@ -206,6 +211,26 @@ (define-inlinable (assert-integer proc in-range? key number)
"Integer ~A out of range: ~S" (list key number)
(list number))))
+(define (register-derivation-outputs db 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
+ "
+INSERT OR REPLACE INTO DerivationOutputs (drv, id, path)
+SELECT id, :outid, :outpath FROM ValidPaths WHERE path = :drvpath;"
+ #:cache? #t)))
+ (for-each (match-lambda
+ ((outid . ($ <derivation-output> path))
+ (sqlite-bind-arguments stmt
+ #:drvpath (derivation-file-name
+ drv)
+ #:outid outid
+ #:outpath path)
+ (sqlite-step-and-reset stmt)))
+ (derivation-outputs drv))))
+
(define (add-references db referrer references)
"REFERRER is the id of the referring store item, REFERENCES is a list
ids of items referred to."
@@ -284,6 +309,11 @@ (define* (register-valid-path db #:key path (references '())
(sqlite-step-and-reset stmt)
(last-insert-row-id db)))))
+ (when (derivation-path? path)
+ (register-derivation-outputs db
+ (read-derivation-from-file
+ path)))
+
;; Call 'path-id' on each of REFERENCES. This ensures we get a
;; "non-NULL constraint" failure if one of REFERENCES is unregistered.
(add-references db id
@@ -331,6 +361,25 @@ (define %epoch
;; When it all began.
(make-time time-utc 0 1))
+(define (registered-derivation-outputs db drv)
+ "Get the list of (id, output-path) pairs registered for DRV."
+ (let ((stmt (sqlite-prepare
+ db
+ "
+SELECT id, path
+FROM DerivationOutputs
+WHERE drv in (SELECT id from ValidPaths where path = :drv)"
+ #: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-reset stmt)
+ result)))
+
(define* (register-items db items
#:key prefix
(registration-time (timestamp))
From: Caleb Ristvedt <caleb.ristvedt@cune.org> * guix/store/database.scm (register-derivation-outputs, registered-derivation-outputs): New procedures (register-valid-path): Call register-derivation-outputs for derivations. Co-authored-by: Christopher Baines <mail@cbaines.net> Change-Id: Id958709f36f24ee1c9c375807e8146a9d1cc4259 --- guix/store/database.scm | 49 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 49 insertions(+) base-commit: 92af4ea17f70207fbbf2513f677f3171d4eafd41