Add `guix-gc'.

* guix-gc.in, tests/guix-gc.sh: New files.
* configure.ac: Output `guix-gc', and make it executable.
* Makefile.am (bin_SCRIPTS): Add `guix-gc'.
  (TESTS): Add `tests/guix-gc.sh'.
* doc/guix.texi (Features): Add xref to "Invoking guix-gc".
  (Invoking guix-gc): New node.
* po/POTFILES.in: Add `guix-gc.in'.
This commit is contained in:
Ludovic Courtès 2013-01-06 00:28:06 +01:00
parent 2646c55b03
commit fe8ff02827
7 changed files with 299 additions and 7 deletions

1
.gitignore vendored
View file

@ -64,3 +64,4 @@ stamp-h[0-9]
/nix/scripts/list-runtime-roots
/test-env
/nix/nix-setuid-helper/nix-setuid-helper.cc
/guix-gc

View file

@ -1,5 +1,5 @@
# Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
# Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org>
# Copyright (C) 2012, 2013 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of Guix.
#
@ -20,7 +20,8 @@ bin_SCRIPTS = \
guix-build \
guix-download \
guix-import \
guix-package
guix-package \
guix-gc
MODULES = \
guix/base32.scm \
@ -189,6 +190,7 @@ TESTS = \
tests/union.scm \
tests/guix-build.sh \
tests/guix-download.sh \
tests/guix-gc.sh \
tests/guix-package.sh
TEST_EXTENSIONS = .scm .sh

View file

@ -114,10 +114,12 @@ AC_CONFIG_FILES([Makefile
guix-download
guix-import
guix-package
guix-gc
pre-inst-env
test-env])
AC_CONFIG_COMMANDS([commands-exec],
[chmod +x guix-build guix-download guix-import guix-package pre-inst-env test-env])
[chmod +x guix-build guix-download guix-import guix-package guix-gc \
pre-inst-env test-env])
AC_OUTPUT

View file

@ -43,7 +43,7 @@ Documentation License''.
@copying
This manual documents GNU Guix version @value{VERSION}.
Copyright (C) 2012 Ludovic Courtès
Copyright (C) 2012, 2013 Ludovic Courtès
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -133,6 +133,7 @@ management tools it provides.
@menu
* Features:: How Guix will make your life brighter.
* Invoking guix-package:: Package installation, removal, etc.
* Invoking guix-gc:: Running the garbage collector.
@end menu
@node Features
@ -172,9 +173,10 @@ of their profile, which was known to work well.
All those packages in the package store may be @emph{garbage-collected}.
Guix can determine which packages are still referenced by the user
profiles, and remove those that are provably no longer referenced.
Users may also explicitly remove old generations of their profile so
that the packages they refer to can be collected.
profiles, and remove those that are provably no longer referenced
(@pxref{Invoking guix-gc}). Users may also explicitly remove old
generations of their profile so that the packages they refer to can be
collected.
Finally, Guix takes a @dfn{purely functional} approach to package
management, as described in the introduction (@pxref{Introduction}).
@ -275,6 +277,53 @@ its version string, and the source location of its definition.
@end table
@node Invoking guix-gc
@section Invoking @command{guix-gc}
@cindex garbage collector
Packages that are installed but not used may be @dfn{garbage-collected}.
The @command{guix-gc} command allows users to explicitly run the garbage
collector to reclaim space from the @file{/nix/store} directory.
The garbage collector has a set of known @dfn{roots}: any file under
@file{/nix/store} reachable from a root is considered @dfn{live} and
cannot be deleted; any other file is considered @dfn{dead} and may be
deleted. The set of garbage collector roots includes default user
profiles, and may be augmented with @command{guix-build --root}, for
example (@pxref{Invoking guix-build}).
The @command{guix-gc} command has three mode of operations: it can be
used to garbage-collect any dead files (the default), to delete specific
files (the @code{--delete} option), or to print garbage-collector
information. The available options are listed below:
@table @code
@item --collect-garbage[=@var{min}]
@itemx -C [@var{min}]
Collect garbage---i.e., unreachable @file{/nix/store} files and
sub-directories. This is the default operation when no option is
specified.
When @var{min} is given, stop once @var{min} bytes have been collected.
@var{min} may be a number of bytes, or it may include a unit as a
suffix, such as @code{MiB} for mebibytes and @code{GB} for gigabytes.
When @var{min} is omitted, collect all the garbage.
@item --delete
@itemx -d
Attempt to delete all the store files and directories specified as
arguments. This fails if some of the files are not in the store, or if
they are still live.
@item --list-dead
Show the list of dead files and directories still present in the
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
@c *********************************************************************
@node Programming Interface

183
guix-gc.in Normal file
View file

@ -0,0 +1,183 @@
#!/bin/sh
# aside from this initial boilerplate, this is actually -*- scheme -*- code
prefix="@prefix@"
datarootdir="@datarootdir@"
GUILE_LOAD_COMPILED_PATH="@guilemoduledir@:$GUILE_LOAD_COMPILED_PATH"
export GUILE_LOAD_COMPILED_PATH
main='(module-ref (resolve-interface '\''(guix-gc)) '\'guix-gc')'
exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \
-c "(apply $main (cdr (command-line)))" "$@"
!#
;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
;;; Copyright (C) 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of Guix.
;;;
;;; Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix-gc)
#:use-module (guix ui)
#:use-module (guix store)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:export (guix-gc))
;;;
;;; Command-line options.
;;;
(define %default-options
;; Alist of default option values.
`((action . collect-garbage)))
(define (show-help)
(display (_ "Usage: guix-gc [OPTION]... PATHS...
Invoke the garbage collector.\n"))
(display (_ "
-C, --collect-garbage[=MIN]
collect at least MIN bytes of garbage"))
(display (_ "
-d, --delete attempt to delete PATHS"))
(display (_ "
--list-dead list dead paths"))
(display (_ "
--list-live list live paths"))
(newline)
(display (_ "
-h, --help display this help and exit"))
(display (_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(define (size->number str)
"Convert STR, a storage measurement representation such as \"1024\" or
\"1MiB\", to a number of bytes. Raise an error if STR could not be
interpreted."
(define unit-pos
(string-rindex str char-set:digit))
(define unit
(and unit-pos (substring str (+ 1 unit-pos))))
(let* ((numstr (if unit-pos
(substring str 0 (+ 1 unit-pos))
str))
(num (string->number numstr)))
(if num
(* num
(match unit
("KiB" (expt 2 10))
("MiB" (expt 2 20))
("GiB" (expt 2 30))
("TiB" (expt 2 40))
("KB" (expt 10 3))
("MB" (expt 10 6))
("GB" (expt 10 9))
("TB" (expt 10 12))
("" 1)
(_
(format (current-error-port) (_ "error: unknown unit: ~a~%")
unit)
(exit 1))))
(begin
(format (current-error-port)
(_ "error: invalid number: ~a") numstr)
(exit 1)))))
(define %options
;; Specification of the command-line options.
(list (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix-gc")))
(option '(#\C "collect-garbage") #f #t
(lambda (opt name arg result)
(let ((result (alist-cons 'action 'collect-garbage
(alist-delete 'action result))))
(match arg
((? string?)
(let ((amount (size->number arg)))
(if arg
(alist-cons 'min-freed amount result)
(begin
(format (current-error-port)
(_ "error: invalid amount of storage: ~a~%")
arg)
(exit 1)))))
(#f result)))))
(option '(#\d "delete") #f #f
(lambda (opt name arg result)
(alist-cons 'action 'delete
(alist-delete 'action result))))
(option '("list-dead") #f #f
(lambda (opt name arg result)
(alist-cons 'action 'list-dead
(alist-delete 'action result))))
(option '("list-live") #f #f
(lambda (opt name arg result)
(alist-cons 'action 'list-live
(alist-delete 'action result))))))
;;;
;;; Entry point.
;;;
(define (guix-gc . args)
(define (parse-options)
;; Return the alist of option values.
(args-fold args %options
(lambda (opt name arg result)
(leave (_ "~A: unrecognized option~%") name))
(lambda (arg result)
(alist-cons 'argument arg result))
%default-options))
(setlocale LC_ALL "")
(textdomain "guix")
(setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF)
(with-error-handling
(let ((opts (parse-options))
(store (open-connection)))
(case (assoc-ref opts 'action)
((collect-garbage)
(let ((min-freed (assoc-ref opts 'min-freed)))
(if min-freed
(collect-garbage store min-freed)
(collect-garbage store))))
((delete)
(let ((paths (filter-map (match-lambda
(('argument . arg) arg)
(_ #f))
opts)))
(delete-paths store paths)))
((list-dead)
(for-each (cut simple-format #t "~a~%" <>)
(dead-paths store)))
((list-live)
(for-each (cut simple-format #t "~a~%" <>)
(live-paths store)))))))

View file

@ -8,3 +8,4 @@ guix/ui.scm
guix-build.in
guix-download.in
guix-package.in
guix-gc.in

54
tests/guix-gc.sh Normal file
View file

@ -0,0 +1,54 @@
# Guix --- Nix package management from Guile. -*- coding: utf-8 -*-
# Copyright (C) 2013 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of Guix.
#
# Guix is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or (at
# your option) any later version.
#
# Guix is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Guix. If not, see <http://www.gnu.org/licenses/>.
#
# Test the `guix-gc' command-line utility.
#
guix-gc --version
trap "rm -f guix-gc-root" EXIT
rm -f guix-gc-root
# Add then reclaim a .drv file.
drv="`guix-build idutils -d`"
test -f "$drv"
guix-gc --list-dead | grep "$drv"
guix-gc --delete "$drv"
! test -f "$drv"
# Add a .drv, register it as a root.
drv="`guix-build --root=guix-gc-root lsh -d`"
test -f "$drv" && test -L guix-gc-root
guix-gc --list-live | grep "$drv"
if guix-gc --delete "$drv";
then false; else true; fi
rm guix-gc-root
guix-gc --list-dead | grep "$drv"
guix-gc --delete "$drv"
! test -f "$drv"
# Try a random collection.
guix-gc -C 1KiB
# Check trivial error cases.
if guix-gc --delete /dev/null;
then false; else true; fi