01/03: guix system: Add 'delete-generations'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 499b166d1ce3ead61afb985053012ceb451f3beb
Author: Ludovic Courtès <address@hidden>
Date:   Wed Feb 13 15:27:36 2019 +0100

    guix system: Add 'delete-generations'.
    
    * guix/scripts/package.scm (delete-matching-generations): Export.
    * guix/scripts/system.scm (show-help): Add 'delete-generations'.
    (process-command): Honor it.
    (guix-system): Support it.
    * doc/guix.texi (Invoking guix system): Document it.
---
 doc/guix.texi            | 26 ++++++++++++++++++++++++++
 guix/scripts/package.scm |  1 +
 guix/scripts/system.scm  | 17 +++++++++++++++--
 3 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 2ae4f53..6980672 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -23038,6 +23038,32 @@ Currently, as with @command{switch-generation}, you 
must reboot after
 running this action to actually start using the preceding system
 generation.
 
address@hidden delete-generations
address@hidden deleting system generations
address@hidden saving space
+Delete system generations, making them candidates for garbage collection
+(@pxref{Invoking guix gc}, for information on how to run the ``garbage
+collector'').
+
+This works in the same way as @command{guix package --delete-generations}
+(@pxref{Invoking guix package, @code{--delete-generations}}).  With no
+arguments, all system generations but the current one are deleted:
+
address@hidden
+guix system delete-generations
address@hidden example
+
+You can also select the generations you want to delete.  The example below
+deletes all the system generations that are more than two month old:
+
address@hidden
+guix system delete-generations 2m
address@hidden example
+
+Running this command automatically reinstalls the bootloader with an updated
+list of menu entries---e.g., the ``old generations'' sub-menu in GRUB no
+longer lists the generations that have been deleted.
+
 @item build
 Build the derivation of the operating system, which includes all the
 configuration files and programs needed to boot and run the system.
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1695250..0e70315 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -55,6 +55,7 @@
   #:autoload   (gnu packages bootstrap) (%bootstrap-guile)
   #:export (build-and-use-profile
             delete-generations
+            delete-matching-generations
             display-search-paths
             guix-package))
 
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 4c8d8ac..c0301ea 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -36,6 +36,8 @@
   #:use-module (guix profiles)
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
+  #:autoload   (guix scripts package) (delete-generations
+                                       delete-matching-generations)
   #:use-module (guix graph)
   #:use-module (guix scripts graph)
   #:use-module (guix build utils)
@@ -963,9 +965,11 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "\
    roll-back        switch to the previous operating system configuration\n"))
   (display (G_ "\
+   list-generations list the system generations\n"))
+  (display (G_ "\
    switch-generation switch to an existing operating system configuration\n"))
   (display (G_ "\
-   list-generations list the system generations\n"))
+   delete-generations delete old system generations\n"))
   (display (G_ "\
    build            build the operating system without installing anything\n"))
   (display (G_ "\
@@ -1202,6 +1206,14 @@ argument list and OPTS is the option alist."
      (apply (resolve-subcommand "search") args))
     ;; The following commands need to use the store, but they do not need an
     ;; operating system configuration file.
+    ((delete-generations)
+     (let ((pattern (match args
+                      (() "")
+                      ((pattern) pattern)
+                      (x (leave (G_ "wrong number of arguments~%"))))))
+       (with-store store
+         (delete-matching-generations store %system-profile pattern)
+         (reinstall-bootloader store (generation-number %system-profile)))))
     ((switch-generation)
      (let ((pattern (match args
                       ((pattern) pattern)
@@ -1228,7 +1240,8 @@ argument list and OPTS is the option alist."
         (let ((action (string->symbol arg)))
           (case action
             ((build container vm vm-image disk-image reconfigure init
-              extension-graph shepherd-graph list-generations roll-back
+              extension-graph shepherd-graph
+              list-generations delete-generations roll-back
               switch-generation search docker-image)
              (alist-cons 'action action result))
             (else (leave (G_ "~a: unknown action~%") action))))))