mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 22:08:16 -05:00
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.
This commit is contained in:
parent
4cd27cd60a
commit
533d1768f4
2 changed files with 43 additions and 1 deletions
|
@ -60,6 +60,7 @@ (define-module (guix store)
|
||||||
valid-path?
|
valid-path?
|
||||||
query-path-hash
|
query-path-hash
|
||||||
hash-part->path
|
hash-part->path
|
||||||
|
query-path-info
|
||||||
add-text-to-store
|
add-text-to-store
|
||||||
add-to-store
|
add-to-store
|
||||||
build-things
|
build-things
|
||||||
|
@ -79,6 +80,13 @@ (define-module (guix store)
|
||||||
substitutable-paths
|
substitutable-paths
|
||||||
substitutable-path-info
|
substitutable-path-info
|
||||||
|
|
||||||
|
path-info?
|
||||||
|
path-info-deriver
|
||||||
|
path-info-hash
|
||||||
|
path-info-references
|
||||||
|
path-info-registration-time
|
||||||
|
path-info-nar-size
|
||||||
|
|
||||||
references
|
references
|
||||||
requisites
|
requisites
|
||||||
referrers
|
referrers
|
||||||
|
@ -212,6 +220,24 @@ (define (read-substitutable-path-list p)
|
||||||
(cons (substitutable path deriver refs dl-size nar-size)
|
(cons (substitutable path deriver refs dl-size nar-size)
|
||||||
result))))))
|
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
|
(define-syntax write-arg
|
||||||
(syntax-rules (integer boolean file string string-list string-pairs
|
(syntax-rules (integer boolean file string string-list string-pairs
|
||||||
store-path store-path-list base16)
|
store-path store-path-list base16)
|
||||||
|
@ -236,7 +262,7 @@ (define-syntax write-arg
|
||||||
|
|
||||||
(define-syntax read-arg
|
(define-syntax read-arg
|
||||||
(syntax-rules (integer boolean string store-path store-path-list
|
(syntax-rules (integer boolean string store-path store-path-list
|
||||||
substitutable-path-list base16)
|
substitutable-path-list path-info base16)
|
||||||
((_ integer p)
|
((_ integer p)
|
||||||
(read-int p))
|
(read-int p))
|
||||||
((_ boolean p)
|
((_ boolean p)
|
||||||
|
@ -249,6 +275,8 @@ (define-syntax read-arg
|
||||||
(read-store-path-list p))
|
(read-store-path-list p))
|
||||||
((_ substitutable-path-list p)
|
((_ substitutable-path-list p)
|
||||||
(read-substitutable-path-list p))
|
(read-substitutable-path-list p))
|
||||||
|
((_ path-info p)
|
||||||
|
(read-path-info p))
|
||||||
((_ base16 p)
|
((_ base16 p)
|
||||||
(base16-string->bytevector (read-string p)))))
|
(base16-string->bytevector (read-string p)))))
|
||||||
|
|
||||||
|
@ -541,6 +569,10 @@ (define hash-part->path
|
||||||
;; /HASH.narinfo.
|
;; /HASH.narinfo.
|
||||||
(query-path-from-hash-part server hash-part))))
|
(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
|
(define add-text-to-store
|
||||||
;; A memoizing version of `add-to-store', to avoid repeated RPCs with
|
;; A memoizing version of `add-to-store', to avoid repeated RPCs with
|
||||||
;; the very same arguments during a given session.
|
;; the very same arguments during a given session.
|
||||||
|
|
|
@ -606,6 +606,16 @@ (define (same? x y)
|
||||||
(file (add %store "foo" "Lowered.")))
|
(file (add %store "foo" "Lowered.")))
|
||||||
(call-with-input-file file get-string-all)))
|
(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")
|
(test-end "store")
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue