aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi12
-rw-r--r--guix/scripts/gc.scm56
-rw-r--r--tests/guix-gc.sh12
3 files changed, 73 insertions, 7 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 6a9ebab1f6..ec784ce349 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -657,6 +657,18 @@ store---i.e., files and directories no longer reachable from any root.
@item --list-live
Show the list of live store files and directories.
+
+@end table
+
+In addition, the references among existing store files can be queried:
+
+@table @code
+
+@item --references
+@itemx --referrers
+List the references (respectively, the referrers) of store files given
+as arguments.
+
@end table
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index f2d2e17d4b..12d80fd171 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -20,6 +20,7 @@
#:use-module (guix ui)
#:use-module (guix store)
#:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
@@ -48,6 +49,11 @@ Invoke the garbage collector.\n"))
--list-live list live paths"))
(newline)
(display (_ "
+ --references list the references of PATHS"))
+ (display (_ "
+ --referrers list the referrers of PATHS"))
+ (newline)
+ (display (_ "
-h, --help display this help and exit"))
(display (_ "
-V, --version display version information and exit"))
@@ -125,6 +131,14 @@ interpreted."
(option '("list-live") #f #f
(lambda (opt name arg result)
(alist-cons 'action 'list-live
+ (alist-delete 'action result))))
+ (option '("references") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'action 'list-references
+ (alist-delete 'action result))))
+ (option '("referrers") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'action 'list-referrers
(alist-delete 'action result))))))
@@ -142,9 +156,37 @@ interpreted."
(alist-cons 'argument arg result))
%default-options))
+ (define (symlink-target file)
+ (let ((s (false-if-exception (lstat file))))
+ (if (and s (eq? 'symlink (stat:type s)))
+ (symlink-target (readlink file))
+ file)))
+
+ (define (store-directory file)
+ ;; Return the store directory that holds FILE if it's in the store,
+ ;; otherwise return FILE.
+ (or (and=> (string-match (string-append "^" (regexp-quote (%store-prefix))
+ "/([^/]+)")
+ file)
+ (compose (cut string-append (%store-prefix) "/" <>)
+ (cut match:substring <> 1)))
+ file))
+
(with-error-handling
- (let ((opts (parse-options))
- (store (open-connection)))
+ (let* ((opts (parse-options))
+ (store (open-connection))
+ (paths (filter-map (match-lambda
+ (('argument . arg) arg)
+ (_ #f))
+ opts)))
+ (define (list-relatives relatives)
+ (for-each (compose (lambda (path)
+ (for-each (cut simple-format #t "~a~%" <>)
+ (relatives store path)))
+ store-directory
+ symlink-target)
+ paths))
+
(case (assoc-ref opts 'action)
((collect-garbage)
(let ((min-freed (assoc-ref opts 'min-freed)))
@@ -152,11 +194,11 @@ interpreted."
(collect-garbage store min-freed)
(collect-garbage store))))
((delete)
- (let ((paths (filter-map (match-lambda
- (('argument . arg) arg)
- (_ #f))
- opts)))
- (delete-paths store paths)))
+ (delete-paths store paths))
+ ((list-references)
+ (list-relatives references))
+ ((list-referrers)
+ (list-relatives referrers))
((list-dead)
(for-each (cut simple-format #t "~a~%" <>)
(dead-paths store)))
diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh
index a90d085ab2..eac9d82e89 100644
--- a/tests/guix-gc.sh
+++ b/tests/guix-gc.sh
@@ -25,6 +25,18 @@ guix gc --version
trap "rm -f guix-gc-root" EXIT
rm -f guix-gc-root
+# Check the references of a .drv.
+drv="`guix build guile-bootstrap -d`"
+out="`guix build guile-bootstrap`"
+test -f "$drv" && test -d "$out"
+
+guix gc --references "$drv" | grep -e -bash
+guix gc --references "$out"
+guix gc --references "$out/bin/guile"
+
+if guix gc --references /dev/null;
+then false; else true; fi
+
# Add then reclaim a .drv file.
drv="`guix build idutils -d`"
test -f "$drv"