mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 05:48:07 -05:00
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:
parent
b129026e2e
commit
1ab48edb16
1 changed files with 33 additions and 1 deletions
|
@ -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))
|
||||||
|
|
Loading…
Reference in a new issue