From cdb5b075d545dd4e0b2a03bdc62fa0d1f6e00fc3 Mon Sep 17 00:00:00 2001 From: Cyrill Schenkel Date: Sun, 24 May 2015 14:04:15 +0200 Subject: gc: ignore trailing slash or subdirectories for `guix gc -d' MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . * guix/scripts/gc.scm (guix-gc): Convert paths to direct store paths. * guix/store.scm (direct-store-path): Get rid of subdirectories in store path. * tests/guix-gc.sh: New tests. Co-authored-by: Ludovic Courtès --- guix/store.scm | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'guix/store.scm') diff --git a/guix/store.scm b/guix/store.scm index fc2f8d92ca..8905a5a558 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -121,6 +121,7 @@ derivation-path? store-path-package-name store-path-hash-part + direct-store-path log-file)) (define %protocol-version #x10c) @@ -1012,6 +1013,15 @@ valid inputs." (let ((len (+ 1 (string-length (%store-prefix))))) (not (string-index (substring path len) #\/))))) +(define (direct-store-path path) + "Return the direct store path part of PATH, stripping components after +'/gnu/store/xxxx-foo'." + (let ((prefix-length (+ (string-length (%store-prefix)) 35))) + (if (> (string-length path) prefix-length) + (let ((slash (string-index path #\/ prefix-length))) + (if slash (string-take path slash) path)) + path))) + (define (derivation-path? path) "Return #t if PATH is a derivation path." (and (store-path? path) (string-suffix? ".drv" path))) -- cgit v1.2.3