From 499b166d1ce3ead61afb985053012ceb451f3beb Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 13 Feb 2019 15:27:36 +0100
Subject: 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 2ae4f53245..6980672094 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.
 
+@item delete-generations
+@cindex deleting system generations
+@cindex 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:
+
+@example
+guix system delete-generations
+@end 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:
+
+@example
+guix system delete-generations 2m
+@end 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 1695250c79..0e70315708 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -55,6 +55,7 @@ (define-module (guix scripts package)
   #: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 4c8d8acc8f..c0301eac2b 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -36,6 +36,8 @@ (define-module (guix scripts system)
   #: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)
@@ -962,10 +964,12 @@ (define (show-help)
    reconfigure      switch to a new operating system configuration\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 @@ (define (process-command command args opts)
      (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 @@ (define (parse-sub-command arg result)
         (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))))))
-- 
cgit v1.2.3