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.
			
			
This commit is contained in:
		
							parent
							
								
									ef8c03407d
								
							
						
					
					
						commit
						2c6ab6ccd4
					
				
					 2 changed files with 23 additions and 1 deletions
				
			
		|  | @ -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 a new issue