[bug#74837,v2,1/2] gnu: services: Add resize-fs-service.

Message ID 472c97dc7cb15bc73e93576868d4da8517d2ddb5.1734038130.git.richard@freakingpenguin.com
State New
Headers
Series [bug#74837,v2,1/2] gnu: services: Add resize-fs-service. |

Commit Message

Richard Sent Dec. 12, 2024, 9:15 p.m. UTC
  * gnu/services/admin.scm (resize-fs-configuration): New configuration
type.
(resize-fs-shepherd-service): New procedure.
(resize-fs-service-type): New variable.
* doc/guix.texi (Miscallaneous Services): Document it.

Change-Id: Icae2fefc9a8d936d4c3add47520258b341f689a4
---
Fixing up the export list.

 doc/guix.texi          |  50 ++++++++++++++++
 gnu/services/admin.scm | 133 ++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 182 insertions(+), 1 deletion(-)


base-commit: a9003b8e6b40b59c9545ae87bb441d3549630db7
  

Comments

Ludovic Courtès Dec. 14, 2024, 3:23 p.m. UTC | #1
Hello,

Richard Sent <richard@freakingpenguin.com> skribis:

> * gnu/services/admin.scm (resize-fs-configuration): New configuration
> type.
> (resize-fs-shepherd-service): New procedure.
> (resize-fs-service-type): New variable.
> * doc/guix.texi (Miscallaneous Services): Document it.
>
> Change-Id: Icae2fefc9a8d936d4c3add47520258b341f689a4

Nice!  Overall LGTM.  Minor comments below.

> +@subsubheading Resize File System service
> +
> +This service type lets you resize a live file system during boot, which
> +can be convenient if a Guix image is flashed on an SD Card (e.g. for an
> +embedded device) or uploaded to a VPS.  In both cases the medium the
> +image will reside upon may be larger than the image you want to produce.
> +
> +For an embedded device booting from an SD card you may use something like:
> +@lisp
> +(service resize-fs-service-type
> +  (resize-fs-configuration
> +    (file-system
> +     (device (file-system-label "root"))
> +     (type "ext4"))))
> +@end lisp

I would avoid abbreviations as usual and go for
‘file-system-resizing-service-type’.  WDYT?

> +Be extra cautious to use the correct device and type.  The service has
> +little error handling of its own and relies on the underlying tools.
> +Wrong use could end in loss of data or the corruption of the operating
> +system.

Maybe wrap this paragraph in “@quotation Warning”.

> +@item @code{file-system} (default: @code{#f}) (type: file-system)
> +The file-system object to resize.  This object must have the device and
                                   ^
Maybe add “(@pxref{File Systems})”.

> +type fields set.  The others are ignored.

“the @code{device} and @code{type} fields set.  Other fields are
ignored.”

> +@item @code{cloud-utils} (default: @code{cloud-utils}) (type: file-like)
> +The cloud-utils package to use.

Maybe add a sentence explaining that ‘cloud-utils’ is used for its
‘growpart’ command.

I wonder if Guile-Parted could be used instead of ‘growpart’ (shouldn’t
be a blocker though).

> +                    (let/ec return
> +                      (guard (c ((and (invoke-error? c)
> +                                      ;; growpart NOCHANGE exits with 1. It is
> +                                      ;; unlikely the partition was resized
> +                                      ;; while the file system was not. Just
> +                                      ;; exit.
> +                                      (equal? (invoke-error-exit-status c) 1))
> +                                 (format (current-error-port)
> +                                         "The device ~a is already resized.~%" device)
> +                                 ;; Must return something or Shepherd considers
> +                                 ;; the service perpetually starting.
> +                                 (return 0)))
> +                        (apply invoke grow-partition-command))
> +                      (apply invoke grow-filesystem-command)))))))))

No need for ‘let/ec’ here, you can just return from the ‘guard’ handler.

The second patch LGTM, though perhaps it should come before this patch
since it fixes something that the resize service needs.

Could you send updated patches?

Thanks!

Ludo’.
  

Patch

diff --git a/doc/guix.texi b/doc/guix.texi
index a2915de954..5636eb23fb 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41891,6 +41891,56 @@  Miscellaneous Services
 
 @c End of auto-generated fail2ban documentation.
 
+@cindex resize-fs
+@subsubheading Resize File System service
+
+This service type lets you resize a live file system during boot, which
+can be convenient if a Guix image is flashed on an SD Card (e.g. for an
+embedded device) or uploaded to a VPS.  In both cases the medium the
+image will reside upon may be larger than the image you want to produce.
+
+For an embedded device booting from an SD card you may use something like:
+@lisp
+(service resize-fs-service-type
+  (resize-fs-configuration
+    (file-system
+     (device (file-system-label "root"))
+     (type "ext4"))))
+@end lisp
+
+Be extra cautious to use the correct device and type.  The service has
+little error handling of its own and relies on the underlying tools.
+Wrong use could end in loss of data or the corruption of the operating
+system.
+
+Partitions and file systems are grown to the maximum size available.
+File systems can only grow when they are on the last partition on a
+device and have empty space available.
+
+This service supports the ext2, ext3, ext4, btrfs, and bcachefs file
+systems.
+
+@table @asis
+
+@item @code{file-system} (default: @code{#f}) (type: file-system)
+The file-system object to resize.  This object must have the device and
+type fields set.  The others are ignored.
+
+@item @code{cloud-utils} (default: @code{cloud-utils}) (type: file-like)
+The cloud-utils package to use.
+
+@item @code{e2fsprogs} (default: @code{e2fsprogs}) (type: file-like)
+The e2fsprogs package to use, used for resizing ext2, ext3, and ext4
+file systems.
+
+@item @code{btrfs-progs} (default: @code{btrfs-progs}) (type: file-like)
+The btrfs-progs package to use, used for resizing the btrfs file system.
+
+@item @code{bcachefs-tools} (default: @code{bcachefs-tools}) (type: file-like)
+The bcachefs-tools package to use, used for resizing the bcachefs file system.
+
+@end table
+
 @cindex Backup
 @subsubheading Backup Services
 
diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm
index 24ff659a01..a92b3b0ecc 100644
--- a/gnu/services/admin.scm
+++ b/gnu/services/admin.scm
@@ -3,6 +3,8 @@ 
 ;;; Copyright © 2016-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
+;;; Copyright © 2024 Gabriel Wicki <gabriel@erlikon.ch>
+;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,11 +22,15 @@ 
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu services admin)
+  #:use-module (gnu system file-systems)
   #:use-module (gnu packages admin)
   #:use-module ((gnu packages base)
                 #:select (canonical-package findutils coreutils sed))
+  #:use-module (gnu packages file-systems)
   #:use-module (gnu packages certs)
+  #:use-module (gnu packages disk)
   #:use-module (gnu packages package-management)
+  #:use-module (gnu packages linux)
   #:use-module (gnu services)
   #:use-module (gnu services configuration)
   #:use-module (gnu services mcron)
@@ -93,7 +99,16 @@  (define-module (gnu services admin)
             unattended-upgrade-configuration-services-to-restart
             unattended-upgrade-configuration-system-expiration
             unattended-upgrade-configuration-maximum-duration
-            unattended-upgrade-configuration-log-file))
+            unattended-upgrade-configuration-log-file
+
+            resize-fs-service-type
+            resize-fs-configuration
+            resize-fs-configuration?
+            resize-fs-configuration-file-system
+            resize-fs-configuration-cloud-utils
+            resize-fs-configuration-e2fsprogs
+            resize-fs-configuration-btrfs-progs
+            resize-fs-configuration-bcachefs-tools))
 
 ;;; Commentary:
 ;;;
@@ -550,4 +565,120 @@  (define unattended-upgrade-service-type
     "Periodically upgrade the system from the current configuration.")
    (default-value (unattended-upgrade-configuration))))
 
+;;;
+;;; Resize file system.
+;;;
+
+(define-record-type* <resize-fs-configuration>
+  resize-fs-configuration make-resize-fs-configuration
+  resize-fs-configuration?
+  (file-system    resize-fs-file-system
+                  (default #f))
+  (cloud-utils    resize-fs-cloud-utils
+                  (default cloud-utils))
+  (e2fsprogs      resize-fs-e2fsprogs
+                  (default e2fsprogs))
+  (btrfs-progs    resize-fs-btrfs-progs
+                  (default btrfs-progs))
+  (bcachefs-tools resize-fs-bcachefs-tools
+                  (default bcachefs-tools)))
+
+(define (resize-fs-shepherd-service config)
+  "Returns a <shepherd-service> for resize-fs-service for CONFIG."
+  (match-record config <resize-fs-configuration>
+                (file-system cloud-utils e2fsprogs btrfs-progs
+                             bcachefs-tools)
+    (let ((fs-spec (file-system->spec file-system)))
+      (shepherd-service
+       (documentation "Resize a file system. Intended for Guix Systems that
+are booted from a system image flashed onto a larger medium.")
+       ;; XXX: This could be extended with file-system info.
+       (provision '(resize-fs))
+       (requirement '(user-processes))
+       (one-shot? #t)
+       (respawn? #f)
+       (modules '((guix build utils)
+                  (gnu build file-systems)
+                  (gnu system file-systems)
+                  (ice-9 control)
+                  (ice-9 match)
+                  (ice-9 ftw)
+                  (ice-9 rdelim)
+                  (srfi srfi-34)))
+       (start (with-imported-modules (source-module-closure
+                                      '((guix build utils)
+                                        (gnu build file-systems)
+                                        (gnu system file-systems)))
+                #~(lambda _
+                    (use-modules (guix build utils)
+                                 (gnu build file-systems)
+                                 (gnu system file-systems)
+                                 (ice-9 control)
+                                 (ice-9 match)
+                                 (ice-9 ftw)
+                                 (ice-9 rdelim)
+                                 (srfi srfi-34))
+
+                    (define file-system
+                      (spec->file-system '#$fs-spec))
+
+                    ;; Shepherd recommends the start constructor takes <1
+                    ;; minute, canonicalize-device-spec will hang for up to
+                    ;; max-trials seconds (20 seconds) if an invalid device is
+                    ;; connected. Revisit this if max-trials increases.
+                    (define device (canonicalize-device-spec
+                                    (file-system-device file-system)))
+
+                    (define grow-partition-command
+                      (let* ((sysfs-device
+                              (string-append "/sys/class/block/"
+                                             (basename device)))
+                             (partition-number
+                              (with-input-from-file
+                                  (string-append sysfs-device
+                                                 "/partition")
+                                read-line))
+                             (parent (string-append
+                                      "/dev/"
+                                      (basename (dirname (readlink sysfs-device))))))
+                        (list #$(file-append cloud-utils "/bin/growpart")
+                              parent partition-number)))
+
+                    (define grow-filesystem-command
+                      (match (file-system-type file-system)
+                        ((or "ext2" "ext3" "ext4")
+                         (list #$(file-append e2fsprogs "/sbin/resize2fs") device))
+                        ("btrfs"
+                         (list #$(file-append btrfs-progs "/bin/btrfs")
+                               "filesystem" "resize" device))
+                        ("bcachefs"
+                         (list #$(file-append bcachefs-tools "/sbin/bcachefs")
+                               "device" "resize" device))
+                        (e (error "Unsupported filesystem type" e))))
+
+                    (let/ec return
+                      (guard (c ((and (invoke-error? c)
+                                      ;; growpart NOCHANGE exits with 1. It is
+                                      ;; unlikely the partition was resized
+                                      ;; while the file system was not. Just
+                                      ;; exit.
+                                      (equal? (invoke-error-exit-status c) 1))
+                                 (format (current-error-port)
+                                         "The device ~a is already resized.~%" device)
+                                 ;; Must return something or Shepherd considers
+                                 ;; the service perpetually starting.
+                                 (return 0)))
+                        (apply invoke grow-partition-command))
+                      (apply invoke grow-filesystem-command)))))))))
+
+(define resize-fs-service-type
+  (service-type
+   (name 'resize-fs)
+   (description "Resize a partition during boot.")
+   (extensions
+    (list
+     (service-extension shepherd-root-service-type
+                        (compose list resize-fs-shepherd-service))))
+   (default-value (resize-fs-configuration))))
+
 ;;; admin.scm ends here