summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2015-03-17 10:19:36 -0400
committerDavid Thompson <dthompson2@worcester.edu>2015-04-04 13:50:52 -0400
commit533d1768f47520ac7010adc550b0dd9783ebb011 (patch)
tree6b329f3d97c95f75bb5d9e00f485f0ba5cc4ae4c
parent4cd27cd60ab2e8246fff1372a469f2a0d6b41bb2 (diff)
downloadpatches-533d1768f47520ac7010adc550b0dd9783ebb011.tar
patches-533d1768f47520ac7010adc550b0dd9783ebb011.tar.gz
store: Add query-path-info operation.
* guix/store.scm (<path-info>): New record type. (read-path-info): New procedure. (read-arg): Add 'path-info' syntax. (query-path-info): New variable. * tests/store.scm ("query-path-info"): New test.
-rw-r--r--guix/store.scm34
-rw-r--r--tests/store.scm10
2 files changed, 43 insertions, 1 deletions
diff --git a/guix/store.scm b/guix/store.scm
index 3d6b06989c..10b9062db2 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -60,6 +60,7 @@
valid-path?
query-path-hash
hash-part->path
+ query-path-info
add-text-to-store
add-to-store
build-things
@@ -79,6 +80,13 @@
substitutable-paths
substitutable-path-info
+ path-info?
+ path-info-deriver
+ path-info-hash
+ path-info-references
+ path-info-registration-time
+ path-info-nar-size
+
references
requisites
referrers
@@ -212,6 +220,24 @@
(cons (substitutable path deriver refs dl-size nar-size)
result))))))
+;; Information about a store path.
+(define-record-type <path-info>
+ (path-info deriver hash references registration-time nar-size)
+ path-info?
+ (deriver path-info-deriver)
+ (hash path-info-hash)
+ (references path-info-references)
+ (registration-time path-info-registration-time)
+ (nar-size path-info-nar-size))
+
+(define (read-path-info p)
+ (let ((deriver (read-store-path p))
+ (hash (base16-string->bytevector (read-string p)))
+ (refs (read-store-path-list p))
+ (registration-time (read-int p))
+ (nar-size (read-long-long p)))
+ (path-info deriver hash refs registration-time nar-size)))
+
(define-syntax write-arg
(syntax-rules (integer boolean file string string-list string-pairs
store-path store-path-list base16)
@@ -236,7 +262,7 @@
(define-syntax read-arg
(syntax-rules (integer boolean string store-path store-path-list
- substitutable-path-list base16)
+ substitutable-path-list path-info base16)
((_ integer p)
(read-int p))
((_ boolean p)
@@ -249,6 +275,8 @@
(read-store-path-list p))
((_ substitutable-path-list p)
(read-substitutable-path-list p))
+ ((_ path-info p)
+ (read-path-info p))
((_ base16 p)
(base16-string->bytevector (read-string p)))))
@@ -541,6 +569,10 @@ string). Raise an error if no such path exists."
;; /HASH.narinfo.
(query-path-from-hash-part server hash-part))))
+(define-operation (query-path-info (store-path path))
+ "Return the info (hash, references, etc.) for PATH."
+ path-info)
+
(define add-text-to-store
;; A memoizing version of `add-to-store', to avoid repeated RPCs with
;; the very same arguments during a given session.
diff --git a/tests/store.scm b/tests/store.scm
index f778c2086d..eeceed45c1 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -606,6 +606,16 @@
(file (add %store "foo" "Lowered.")))
(call-with-input-file file get-string-all)))
+(test-assert "query-path-info"
+ (let* ((ref (add-text-to-store %store "ref" "foo"))
+ (item (add-text-to-store %store "item" "bar" (list ref)))
+ (info (query-path-info %store item)))
+ (and (equal? (path-info-references info) (list ref))
+ (equal? (path-info-hash info)
+ (sha256
+ (string->utf8
+ (call-with-output-string (cut write-file item <>))))))))
+
(test-end "store")