store: Add `store-path-hash-part'.
* guix/store.scm (store-path-hash-part): New procedure. * tests/store.scm ("store-path-hash-part", "store-path-hash-part #f"): New tests.master
parent
ef8c03407d
commit
2c6ab6ccd4
|
@ -83,7 +83,8 @@
|
||||||
%store-prefix
|
%store-prefix
|
||||||
store-path?
|
store-path?
|
||||||
derivation-path?
|
derivation-path?
|
||||||
store-path-package-name))
|
store-path-package-name
|
||||||
|
store-path-hash-part))
|
||||||
|
|
||||||
(define %protocol-version #x10c)
|
(define %protocol-version #x10c)
|
||||||
|
|
||||||
|
@ -751,3 +752,12 @@ collected, and the number of bytes freed."
|
||||||
|
|
||||||
(and=> (regexp-exec store-path-rx path)
|
(and=> (regexp-exec store-path-rx path)
|
||||||
(cut match:substring <> 1)))
|
(cut match:substring <> 1)))
|
||||||
|
|
||||||
|
(define (store-path-hash-part path)
|
||||||
|
"Return the hash part of PATH as a base32 string, or #f if PATH is not a
|
||||||
|
syntactically valid store path."
|
||||||
|
(let ((path-rx (make-regexp
|
||||||
|
(string-append"^" (regexp-quote (%store-prefix))
|
||||||
|
"/([0-9a-df-np-sv-z]{32})-[^/]+$"))))
|
||||||
|
(and=> (regexp-exec path-rx path)
|
||||||
|
(cut match:substring <> 1))))
|
||||||
|
|
|
@ -48,6 +48,18 @@
|
||||||
|
|
||||||
(test-begin "store")
|
(test-begin "store")
|
||||||
|
|
||||||
|
(test-equal "store-path-hash-part"
|
||||||
|
"283gqy39v3g9dxjy26rynl0zls82fmcg"
|
||||||
|
(store-path-hash-part
|
||||||
|
(string-append (%store-prefix)
|
||||||
|
"/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
|
||||||
|
|
||||||
|
(test-equal "store-path-hash-part #f"
|
||||||
|
#f
|
||||||
|
(store-path-hash-part
|
||||||
|
(string-append (%store-prefix)
|
||||||
|
"/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")))
|
||||||
|
|
||||||
(test-skip (if %store 0 10))
|
(test-skip (if %store 0 10))
|
||||||
|
|
||||||
(test-assert "dead-paths"
|
(test-assert "dead-paths"
|
||||||
|
|
Reference in New Issue