installer: Detect mapped installation devices.

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

* gnu/installer/parted.scm (mapped-device?,
mapped-device-parent-partition): New procedures.
(eligible-devices): Detect mapped installation devices using the new
procedures.
This commit is contained in:
Mathieu Othacehe 2022-12-08 13:24:02 +01:00
parent b129026e2e
commit 1ab48edb16
No known key found for this signature in database
GPG key ID: 8354763531769CA6

View file

@ -379,12 +379,44 @@ (define (installer-root-partition-path)
(define %min-device-size (define %min-device-size
(* 2 GIBIBYTE-SIZE)) ;2GiB (* 2 GIBIBYTE-SIZE)) ;2GiB
(define (mapped-device? device)
"Return #true if DEVICE is a mapped device, false otherwise."
(string-prefix? "/dev/dm-" device))
;; TODO: Use DM_TABLE_DEPS ioctl instead of dmsetup.
(define (mapped-device-parent-partition device)
"Return the parent partition path of the mapped DEVICE."
(let* ((command `("dmsetup" "deps" ,device "-o" "devname"))
(parent #f)
(handler
(lambda (input)
;; We are parsing an output that should look like:
;; 1 dependencies : (sda2)
(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) (define (eligible-devices)
"Return all the available devices except the install device and the devices "Return all the available devices except the install device and the devices
which are smaller than %MIN-DEVICE-SIZE." which are smaller than %MIN-DEVICE-SIZE."
(define the-installer-root-partition-path (define the-installer-root-partition-path
(installer-root-partition-path)) (let ((root (installer-root-partition-path)))
(cond
((mapped-device? root)
;; 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 (mapped-device-parent-partition root)))
(installer-log-line "mapped device ~a -> ~a" parent root)
parent))
(else root))))
(define (small-device? device) (define (small-device? device)
(let ((length (device-length device)) (let ((length (device-length device))