From fe8ff0282779b57a27139ced6ac7b7bcc5658252 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 6 Jan 2013 00:28:06 +0100 Subject: [PATCH] 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'. --- .gitignore | 1 + Makefile.am | 6 +- configure.ac | 4 +- doc/guix.texi | 57 +++++++++++++-- guix-gc.in | 183 +++++++++++++++++++++++++++++++++++++++++++++++ po/POTFILES.in | 1 + tests/guix-gc.sh | 54 ++++++++++++++ 7 files changed, 299 insertions(+), 7 deletions(-) create mode 100644 guix-gc.in create mode 100644 tests/guix-gc.sh diff --git a/.gitignore b/.gitignore index b6786d212b..0b21a03ece 100644 --- a/.gitignore +++ b/.gitignore @@ -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 diff --git a/Makefile.am b/Makefile.am index 805ce446bd..7ad34f1787 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,5 +1,5 @@ # Guix --- Nix package management from Guile. -*- coding: utf-8 -*- -# Copyright (C) 2012 Ludovic Courtès +# Copyright (C) 2012, 2013 Ludovic Courtès # # 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 diff --git a/configure.ac b/configure.ac index bebb9885c4..0c3a9e5f6f 100644 --- a/configure.ac +++ b/configure.ac @@ -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 diff --git a/doc/guix.texi b/doc/guix.texi index 21f6d87b3a..2ca1496bac 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -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 diff --git a/guix-gc.in b/guix-gc.in new file mode 100644 index 0000000000..4e2da697f0 --- /dev/null +++ b/guix-gc.in @@ -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 +;;; +;;; 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 . + +(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))))))) diff --git a/po/POTFILES.in b/po/POTFILES.in index fbcd957a16..2ca98ed1b5 100644 --- a/po/POTFILES.in +++ b/po/POTFILES.in @@ -8,3 +8,4 @@ guix/ui.scm guix-build.in guix-download.in guix-package.in +guix-gc.in diff --git a/tests/guix-gc.sh b/tests/guix-gc.sh new file mode 100644 index 0000000000..a216e6941c --- /dev/null +++ b/tests/guix-gc.sh @@ -0,0 +1,54 @@ +# Guix --- Nix package management from Guile. -*- coding: utf-8 -*- +# Copyright (C) 2013 Ludovic Courtès +# +# 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 . + +# +# 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