diff --git a/doc/guix.texi b/doc/guix.texi index ab07d1066e..6d64772262 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1974,6 +1974,15 @@ suffix, such as @code{MiB} for mebibytes and @code{GB} for gigabytes When @var{min} is omitted, collect all the garbage. +@item --free-space=@var{free} +@itemx -F @var{free} +Collect garbage until @var{free} space is available under +@file{/gnu/store}, if possible; @var{free} denotes storage space, such +as @code{500MiB}, as described above. + +When @var{free} or more is already available in @file{/gnu/store}, do +nothing and exit immediately. + @item --delete @itemx -d Attempt to delete all the store files and directories specified as diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index fe1bb93f7f..4ec9ff9dca 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2015 Ludovic Courtès +;;; Copyright © 2012, 2013, 2015, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +20,7 @@ #:use-module (guix ui) #:use-module (guix scripts) #:use-module (guix store) + #:autoload (guix build syscalls) (statfs) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) @@ -43,6 +44,8 @@ Invoke the garbage collector.\n")) -C, --collect-garbage[=MIN] collect at least MIN bytes of garbage")) (display (_ " + -F, --free-space=FREE attempt to reach FREE available space in the store")) + (display (_ " -d, --delete attempt to delete PATHS")) (display (_ " --optimize optimize the store by deduplicating identical files")) @@ -96,6 +99,9 @@ Invoke the garbage collector.\n")) (leave (_ "invalid amount of storage: ~a~%") arg)))) (#f result))))) + (option '(#\F "free-space") #t #f + (lambda (opt name arg result) + (alist-cons 'free-space (size->number arg) result))) (option '(#\d "delete") #f #f (lambda (opt name arg result) (alist-cons 'action 'delete @@ -175,6 +181,18 @@ Invoke the garbage collector.\n")) (cut match:substring <> 1))) file)) + (define (ensure-free-space store space) + ;; Attempt to have at least SPACE bytes available in STORE. + (let* ((fs (statfs (%store-prefix))) + (free (* (file-system-block-size fs) + (file-system-blocks-available fs)))) + (if (> free space) + (info (_ "already ~h bytes available on ~a, nothing to do~%") + free (%store-prefix)) + (let ((to-free (- space free))) + (info (_ "freeing ~h bytes~%") to-free) + (collect-garbage store to-free))))) + (with-error-handling (let* ((opts (parse-options)) (store (open-connection)) @@ -197,10 +215,15 @@ Invoke the garbage collector.\n")) (case (assoc-ref opts 'action) ((collect-garbage) (assert-no-extra-arguments) - (let ((min-freed (assoc-ref opts 'min-freed))) - (if min-freed - (collect-garbage store min-freed) - (collect-garbage store)))) + (let ((min-freed (assoc-ref opts 'min-freed)) + (free-space (assoc-ref opts 'free-space))) + (cond + (free-space + (ensure-free-space store free-space)) + (min-freed + (collect-garbage store min-freed)) + (else + (collect-garbage store))))) ((delete) (delete-paths store (map direct-store-path paths))) ((list-references)