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'.
This commit is contained in:
parent
fae31edcec
commit
ba8b732d20
|
@ -657,6 +657,18 @@ store---i.e., files and directories no longer reachable from any root.
|
||||||
|
|
||||||
@item --list-live
|
@item --list-live
|
||||||
Show the list of live store files and directories.
|
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
|
@end table
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -20,6 +20,7 @@
|
||||||
#:use-module (guix ui)
|
#:use-module (guix ui)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (ice-9 regex)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
|
@ -47,6 +48,11 @@ Invoke the garbage collector.\n"))
|
||||||
(display (_ "
|
(display (_ "
|
||||||
--list-live list live paths"))
|
--list-live list live paths"))
|
||||||
(newline)
|
(newline)
|
||||||
|
(display (_ "
|
||||||
|
--references list the references of PATHS"))
|
||||||
|
(display (_ "
|
||||||
|
--referrers list the referrers of PATHS"))
|
||||||
|
(newline)
|
||||||
(display (_ "
|
(display (_ "
|
||||||
-h, --help display this help and exit"))
|
-h, --help display this help and exit"))
|
||||||
(display (_ "
|
(display (_ "
|
||||||
|
@ -125,6 +131,14 @@ interpreted."
|
||||||
(option '("list-live") #f #f
|
(option '("list-live") #f #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'action 'list-live
|
(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))))))
|
(alist-delete 'action result))))))
|
||||||
|
|
||||||
|
|
||||||
|
@ -142,9 +156,37 @@ interpreted."
|
||||||
(alist-cons 'argument arg result))
|
(alist-cons 'argument arg result))
|
||||||
%default-options))
|
%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
|
(with-error-handling
|
||||||
(let ((opts (parse-options))
|
(let* ((opts (parse-options))
|
||||||
(store (open-connection)))
|
(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)
|
(case (assoc-ref opts 'action)
|
||||||
((collect-garbage)
|
((collect-garbage)
|
||||||
(let ((min-freed (assoc-ref opts 'min-freed)))
|
(let ((min-freed (assoc-ref opts 'min-freed)))
|
||||||
|
@ -152,11 +194,11 @@ interpreted."
|
||||||
(collect-garbage store min-freed)
|
(collect-garbage store min-freed)
|
||||||
(collect-garbage store))))
|
(collect-garbage store))))
|
||||||
((delete)
|
((delete)
|
||||||
(let ((paths (filter-map (match-lambda
|
(delete-paths store paths))
|
||||||
(('argument . arg) arg)
|
((list-references)
|
||||||
(_ #f))
|
(list-relatives references))
|
||||||
opts)))
|
((list-referrers)
|
||||||
(delete-paths store paths)))
|
(list-relatives referrers))
|
||||||
((list-dead)
|
((list-dead)
|
||||||
(for-each (cut simple-format #t "~a~%" <>)
|
(for-each (cut simple-format #t "~a~%" <>)
|
||||||
(dead-paths store)))
|
(dead-paths store)))
|
||||||
|
|
|
@ -25,6 +25,18 @@ guix gc --version
|
||||||
trap "rm -f guix-gc-root" EXIT
|
trap "rm -f guix-gc-root" EXIT
|
||||||
rm -f guix-gc-root
|
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.
|
# Add then reclaim a .drv file.
|
||||||
drv="`guix build idutils -d`"
|
drv="`guix build idutils -d`"
|
||||||
test -f "$drv"
|
test -f "$drv"
|
||||||
|
|
Loading…
Reference in New Issue