GNU bug report logs -
#70494
[PATCH 00/23] Groundwork for the Guile guix-daemon
Previous Next
Full log
View this message in rfc822 format
* guix/store/database.scm (valid-path, all-valid-paths,
valid-path-from-hash-part, valid-path-references): New procedures.
Change-Id: Ib08837ee20f5a5a24a8089e611b5d67b003b62cc
---
guix/store/database.scm | 88 ++++++++++++++++++++++++++++++++++++++++-
1 file changed, 87 insertions(+), 1 deletion(-)
diff --git a/guix/store/database.scm b/guix/store/database.scm
index 07bd501644..8a3436368e 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -55,9 +55,13 @@ (define-module (guix store database)
%epoch
reset-timestamps
vacuum-database
+ valid-path
+ all-valid-paths
+ valid-path-from-hash-part
outputs-exist?
file-closure
- all-transitive-inputs))
+ all-transitive-inputs
+ valid-path-references))
;;; Code for working with the store database directly.
@@ -447,6 +451,63 @@ (define (vacuum-database)
(sqlite-exec db "VACUUM;")
(sqlite-close db)))
+(define (valid-path db store-filename)
+ (let ((statement
+ (sqlite-prepare
+ db
+ "
+SELECT id, hash, registrationTime, deriver, narSize
+FROM ValidPaths
+WHERE path = :path"
+ #:cache? #t)))
+
+ (sqlite-bind-arguments
+ statement
+ #:path store-filename)
+
+ (let ((result (sqlite-step statement)))
+ (sqlite-reset statement)
+
+ result)))
+
+(define (all-valid-paths db)
+ (let ((statement
+ (sqlite-prepare
+ db
+ "
+SELECT path FROM ValidPaths"
+ #:cache? #t)))
+
+ (let ((result
+ (sqlite-map
+ (match-lambda
+ (#(path) path))
+ statement)))
+ (sqlite-reset statement)
+
+ result)))
+
+(define (valid-path-from-hash-part db hash)
+ (let ((statement
+ (sqlite-prepare
+ db
+ "
+SELECT path FROM ValidPaths WHERE path >= :path LIMIT 1"
+ #:cache? #t))
+ (path-prefix
+ (string-append (%store-prefix) "/" hash)))
+
+ (sqlite-bind-arguments
+ statement
+ #:path path-prefix)
+
+ (let ((result
+ (sqlite-step statement)))
+
+ (if (and result (string-prefix? path-prefix result))
+ result
+ #f))))
+
(define (outputs-exist? db drv-path outputs)
"Determine whether all output labels in OUTPUTS exist as built outputs of
DRV-PATH."
@@ -527,3 +588,28 @@ (define (all-transitive-inputs db drv)
vlist-null
`(,@(derivation-sources drv)
,@input-paths)))))
+
+(define (valid-path-references db valid-path-id)
+ (let ((statement
+ (sqlite-prepare
+ db
+ "
+SELECT ValidPaths.path
+FROM Refs
+INNER JOIN ValidPaths ON Refs.reference = ValidPaths.id
+WHERE referrer = :id"
+ #:cache? #t)))
+
+ (sqlite-bind-arguments
+ statement
+ #:id valid-path-id)
+
+ (let ((result (sqlite-fold
+ (lambda (row result)
+ (cons (vector-ref row 0)
+ result))
+ '()
+ statement)))
+ (sqlite-reset statement)
+
+ result)))
--
2.41.0
This bug report was last modified 1 year and 28 days ago.
Previous Next
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.