01/06: installer: Ignore small devices.

[guix-commits]

mothacehe pushed a commit to branch wip-harden-installer
in repository guix.

commit d597217148e751ff3296888ac8e2f71fd3e8c61c
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Mon Dec 27 19:12:54 2021 +0100

    installer: Ignore small devices.
    
    Filter the devices that are smaller than 2GiB in the device selection list.
    
    * gnu/installer/parted.scm (%min-device-size): New variable.
    (non-install-devices): Rename it ...
    (eligible-devices): ... this way. Filter the install device as well as the
    small devices.
    * gnu/installer/newt/partition.scm (run-partitioning-page): Adapt it.
---
 gnu/installer/newt/partition.scm |  9 ++++----
 gnu/installer/parted.scm         | 47 +++++++++++++++++++++++++++++-----------
 2 files changed, 39 insertions(+), 17 deletions(-)

diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 70c11ed8ad..ccc7686906 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -83,7 +83,8 @@ DEVICES list."
          devices))
 
   (let* ((result (run-listbox-selection-page
-                  #:info-text (G_ "Please select a disk.")
+                  #:info-text (G_ "Please select a \
+disk.  The installation device as well as the small devices are filtered.")
                   #:title (G_ "Disk")
                   #:listbox-items (device-items)
                   #:listbox-item->text cdr
@@ -792,13 +793,13 @@ by pressing the Exit button.~%~%")))
            result-user-partitions)))))
 
   (init-parted)
-  (let* ((non-install-devices (non-install-devices))
-         (user-partitions (run-page non-install-devices))
+  (let* ((eligible-devices (eligible-devices))
+         (user-partitions (run-page eligible-devices))
          (user-partitions-with-pass (prompt-luks-passwords
                                      user-partitions))
          (form (draw-formatting-page user-partitions)))
     ;; Make sure the disks are not in use before proceeding to formatting.
-    (free-parted non-install-devices)
+    (free-parted eligible-devices)
     (format-user-partitions user-partitions-with-pass)
     (syslog "formatted ~a user partitions~%"
             (length user-partitions-with-pass))
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 289cd660fd..66e07574c9 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -81,7 +81,7 @@
 
             with-delay-device-in-use?
             force-device-sync
-            non-install-devices
+            eligible-devices
             partition-user-type
             user-fs-type-name
             partition-filesystem-user-type
@@ -356,28 +356,49 @@ fail. See rereadpt function in wipefs.c of util-linux for 
an explanation."
              (and=> (uuid root)
                     find-partition-by-uuid)))))
 
-(define (non-install-devices)
-  "Return all the available devices, except the install device."
+;; Minimal installation device size.
+(define %min-device-size
+  (* 2 GIBIBYTE-SIZE)) ;2GiB
+
+(define (eligible-devices)
+  "Return all the available devices except the install device and the devices
+which are smaller than %MIN-DEVICE-SIZE."
 
   (define the-installer-root-partition-path
     (installer-root-partition-path))
 
+  (define (small-device? device)
+    (let ((length (device-length device))
+          (sector-size (device-sector-size device)))
+      (and (< (* length sector-size) %min-device-size)
+           (syslog "~a is not eligible because it is smaller than ~a.~%"
+                   (device-path device)
+                   (unit-format-custom-byte device
+                                            %min-device-size
+                                            UNIT-GIGABYTE)))))
+
   ;; Read partition table of device and compare each path to the one
   ;; we're booting from to determine if it is the installation
   ;; device.
   (define (installation-device? device)
     ;; When using CDROM based installation, the root partition path may be the
     ;; device path.
-    (or (string=? the-installer-root-partition-path
-                  (device-path device))
-        (let ((disk (disk-new device)))
-          (and disk
-               (any (lambda (partition)
-                      (string=? the-installer-root-partition-path
-                                (partition-get-path partition)))
-                    (disk-partitions disk))))))
-
-  (remove installation-device? (devices)))
+    (and (or (string=? the-installer-root-partition-path
+                       (device-path device))
+             (let ((disk (disk-new device)))
+               (and disk
+                    (any (lambda (partition)
+                           (string=? the-installer-root-partition-path
+                                     (partition-get-path partition)))
+                         (disk-partitions disk)))))
+         (syslog "~a is not eligible because it is the installation device.~%"
+                 (device-path device))))
+
+  (remove
+   (lambda (device)
+     (or (installation-device? device)
+         (small-device? device)))
+   (devices)))
 
 
 ;;