ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 22:08:16 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix gc: Add '--free-space'.

Browse source 
* guix/scripts/gc.scm (show-help, %options): Add '--free-space'.
(guix-gc)[ensure-free-space]: New procedure.
Handle '--free-space'.
This commit is contained in:
Ludovic Courtès 2016-04-25 22:19:33 +02:00
parent a1f708787d
commit 0054e47036
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 37 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
doc/guix.texi
View file

@ -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

33
guix/scripts/gc.scm
View file

@ -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 @@ (define-module (guix scripts gc)
#: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 @@ (define (show-help)
-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 @@ (define %options
(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 @@ (define (store-directory file)
(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 @@ (define (list-relatives relatives)
(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)