summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-04-25 22:19:33 +0200
committerLudovic Courtès <ludo@gnu.org>2016-04-25 23:27:09 +0200
commit0054e47036b13d46f0f026bbc04d19770c2ecbad (patch)
treeb76d6e274644cb3209ad4091691fd6e71d20e52d
parenta1f708787d08e567da6118bacc481219884296ca (diff)
guix gc: Add '--free-space'.
* guix/scripts/gc.scm (show-help, %options): Add '--free-space'. (guix-gc)[ensure-free-space]: New procedure. Handle '--free-space'.
-rw-r--r--doc/guix.texi9
-rw-r--r--guix/scripts/gc.scm33
2 files changed, 37 insertions, 5 deletions
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 <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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)