From 0afda5b3ed32e73bece9db96ab970d83f9f2e74b Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Thu, 8 Dec 2022 13:24:02 +0100
Subject: [PATCH 1/1] installer: Detect mapped installation devices.

Fixes: <https://issues.guix.gnu.org/59823>

* gnu/installer/parted.scm (mapped-device?,
mapped-device->parent-partition-path): New procedures.
(eligible-devices): Detect mapped installation devices using the new
procedures.
---
 gnu/installer/parted.scm | 35 ++++++++++++++++++++++++++++++++++-
 1 file changed, 34 insertions(+), 1 deletion(-)

diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 82375d29e3..058f2a8dab 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -379,12 +379,45 @@ (define (installer-root-partition-path)
 (define %min-device-size
   (* 2 GIBIBYTE-SIZE)) ;2GiB
 
+(define (mapped-device? device)
+  "Return #true if DEVICE is a mapped device, false otherwise."
+  (string-prefix? "/dev/dm-" device))
+
+(define (mapped-device->parent-partition-path device)
+  "Return the parent partition path of the mapped DEVICE."
+  (let* ((command `("dmsetup" "deps" ,device "-o" "devname"))
+         (parent #f)
+         (handler
+          (lambda (input)
+            (let ((result
+                   (string-match "\\(([^\\)]+)\\)"
+                                 (get-string-all input))))
+              (and result
+                   (set! parent
+                         (format #f "/dev/~a"
+                                 (match:substring result 1))))))))
+    (run-external-command-with-handler handler command)
+    parent))
+
 (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))
+    (let ((root-path
+           (installer-root-partition-path)))
+      (cond
+       ((mapped-device? root-path)
+        ;; If the partition is a mapped device (/dev/dm-X), locate the parent
+        ;; partition.  It is the case when Ventoy is used to host the
+        ;; installation image.
+        (let ((parent-path
+               (mapped-device->parent-partition-path root-path)))
+          (installer-log-line "mapped device ~a -> ~a"
+                              parent-path root-path)
+          parent-path))
+       (else
+        root-path))))
 
   (define (small-device? device)
     (let ((length (device-length device))
-- 
2.38.1