Browse Source

guix gc: Add `--references' and `--referrers'.

* guix/scripts/gc.scm (show-help): Update.
  (%options): Add `--references' and `--referrers'.
  (guix-gc)[symlink-target, store-directory]: New procedures.
  Handle the `list-references' and `list-referrers' actions.
* tests/guix-gc.sh: Add tests for `--references'.
* doc/guix.texi (Invoking guix gc): Document `--references' and
  `--referrers'.
gn-latest-20200428
Ludovic Courtès 9 years ago
parent
commit
ba8b732d20
3 changed files with 73 additions and 7 deletions
  1. +12
    -0
      doc/guix.texi
  2. +49
    -7
      guix/scripts/gc.scm
  3. +12
    -0
      tests/guix-gc.sh

+ 12
- 0
doc/guix.texi View File

@ -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


+ 49
- 7
guix/scripts/gc.scm View File

@ -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)
@ -47,6 +48,11 @@ Invoke the garbage collector.\n"))
(display (_ "
--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 (_ "
@ -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)))


+ 12
- 0
tests/guix-gc.sh View File

@ -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"


Loading…
Cancel
Save