summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-04-01 16:08:31 +0200
committerLudovic Courtès <ludo@gnu.org>2013-04-12 21:57:57 +0200
commitafb49942e032000ba03ae879a7a1d29803aac094 (patch)
tree30be807d83b24fa34594881b96ce715ab1707976
parent5477e0342f477bafc0fd23d7ea85288fdd3a0fb7 (diff)
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.
-rw-r--r--guix/store.scm12
-rw-r--r--tests/store.scm12
2 files changed, 23 insertions, 1 deletions
diff --git a/guix/store.scm b/guix/store.scm
index 4d078c5899..3bb2656bb6 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -83,7 +83,8 @@
%store-prefix
store-path?
derivation-path?
- store-path-package-name))
+ store-path-package-name
+ store-path-hash-part))
(define %protocol-version #x10c)
@@ -751,3 +752,12 @@ collected, and the number of bytes freed."
(and=> (regexp-exec store-path-rx path)
(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))))
diff --git a/tests/store.scm b/tests/store.scm
index c2de99e160..d6e1aa54e3 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -48,6 +48,18 @@
(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-assert "dead-paths"