diff options
| -rw-r--r-- | guix/store.scm | 12 | ||||
| -rw-r--r-- | tests/store.scm | 12 |
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" |