me
/
guix
Archived
1
0
Fork 0

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
Ludovic Courtès 2013-04-01 16:08:31 +02:00
parent 5477e0342f
commit afb49942e0
2 changed files with 23 additions and 1 deletions

View File

@ -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))))

View File

@ -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"