guix gc: Add '--list-roots'.

* guix/scripts/gc.scm (show-help, %options): Add '--list-roots'.
(guix-gc)[list-roots]: New procedure.
Handle '--list-roots'.
* tests/guix-gc.sh: Test it.
* doc/guix.texi (Invoking guix gc): Document it.
This commit is contained in:
Ludovic Courtès 2019-04-06 22:29:18 +02:00
parent 72eda0624b
commit bacf980c76
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 29 additions and 4 deletions

View file

@ -3385,7 +3385,7 @@ deleted. The set of garbage collector roots (``GC roots'' for short)
includes default user profiles; by default, the symlinks under includes default user profiles; by default, the symlinks under
@file{/var/guix/gcroots} represent these GC roots. New GC roots can be @file{/var/guix/gcroots} represent these GC roots. New GC roots can be
added with @command{guix build --root}, for example (@pxref{Invoking added with @command{guix build --root}, for example (@pxref{Invoking
guix build}). guix build}). The @command{guix gc --list-roots} command lists them.
Prior to running @code{guix gc --collect-garbage} to make space, it is Prior to running @code{guix gc --collect-garbage} to make space, it is
often useful to remove old generations from user profiles; that way, old often useful to remove old generations from user profiles; that way, old
@ -3451,6 +3451,10 @@ This prints nothing unless the daemon was started with
@option{--cache-failures} (@pxref{Invoking guix-daemon, @option{--cache-failures} (@pxref{Invoking guix-daemon,
@option{--cache-failures}}). @option{--cache-failures}}).
@item --list-roots
List the GC roots owned by the user; when run as root, list @emph{all} the GC
roots.
@item --clear-failures @item --clear-failures
Remove the specified store items from the failed-build cache. Remove the specified store items from the failed-build cache.

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -20,6 +20,7 @@ (define-module (guix scripts gc)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix store roots)
#:autoload (guix build syscalls) (free-disk-space) #:autoload (guix build syscalls) (free-disk-space)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
@ -48,6 +49,8 @@ (define (show-help)
-F, --free-space=FREE attempt to reach FREE available space in the store")) -F, --free-space=FREE attempt to reach FREE available space in the store"))
(display (G_ " (display (G_ "
-d, --delete attempt to delete PATHS")) -d, --delete attempt to delete PATHS"))
(display (G_ "
--list-roots list the user's garbage collector roots"))
(display (G_ " (display (G_ "
--optimize optimize the store by deduplicating identical files")) --optimize optimize the store by deduplicating identical files"))
(display (G_ " (display (G_ "
@ -135,6 +138,10 @@ (define %options
(alist-cons 'verify-options options (alist-cons 'verify-options options
(alist-delete 'action (alist-delete 'action
result)))))) result))))))
(option '("list-roots") #f #f
(lambda (opt name arg result)
(alist-cons 'action 'list-roots
(alist-delete 'action result))))
(option '("list-dead") #f #f (option '("list-dead") #f #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'action 'list-dead (alist-cons 'action 'list-dead
@ -205,6 +212,15 @@ (define (ensure-free-space store space)
(info (G_ "freeing ~h MiBs~%") (/ to-free 1024. 1024.)) (info (G_ "freeing ~h MiBs~%") (/ to-free 1024. 1024.))
(collect-garbage store to-free))))) (collect-garbage store to-free)))))
(define (list-roots)
;; List all the user-owned GC roots.
(let ((roots (filter (if (zero? (getuid)) (const #t) user-owned?)
(gc-roots))))
(for-each (lambda (root)
(display root)
(newline))
roots)))
(with-error-handling (with-error-handling
(let* ((opts (parse-options)) (let* ((opts (parse-options))
(store (open-connection)) (store (open-connection))
@ -238,6 +254,9 @@ (define (list-relatives relatives)
(else (else
(let-values (((paths freed) (collect-garbage store))) (let-values (((paths freed) (collect-garbage store)))
(info (G_ "freed ~h MiBs~%") (/ freed 1024. 1024.))))))) (info (G_ "freed ~h MiBs~%") (/ freed 1024. 1024.)))))))
((list-roots)
(assert-no-extra-arguments)
(list-roots))
((delete) ((delete)
(delete-paths store (map direct-store-path paths))) (delete-paths store (map direct-store-path paths)))
((list-references) ((list-references)

View file

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU # GNU Guix --- Functional package management for GNU
# Copyright © 2013, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org> # Copyright © 2013, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
# #
# This file is part of GNU Guix. # This file is part of GNU Guix.
# #
@ -34,7 +34,7 @@ unset drv
unset out unset out
# For some operations, passing extra arguments is an error. # For some operations, passing extra arguments is an error.
for option in "" "-C 500M" "--verify" "--optimize" for option in "" "-C 500M" "--verify" "--optimize" "--list-roots"
do do
if guix gc $option whatever; then false; else true; fi if guix gc $option whatever; then false; else true; fi
done done
@ -69,6 +69,8 @@ guix gc --delete "$drv"
drv="`guix build --root=guix-gc-root lsh -d`" drv="`guix build --root=guix-gc-root lsh -d`"
test -f "$drv" && test -L guix-gc-root test -f "$drv" && test -L guix-gc-root
guix gc --list-roots | grep "$PWD/guix-gc-root"
guix gc --list-live | grep "$drv" guix gc --list-live | grep "$drv"
if guix gc --delete "$drv"; if guix gc --delete "$drv";
then false; else true; fi then false; else true; fi