me
/
guix
Archived
1
0
Fork 0
Code

installer: Rework installation device detection. 

* gnu/installer/parted.scm (installation-device): Remove it.
* gnu/installer/parted.scm (installer-root-partition-path): Add it.
* gnu/installer/parted.scm (non-install-devices): Add installation-device?
predicate.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
master
Josselin Poiret 2021-11-23 22:19:09 +00:00 committed by Mathieu Othacehe
parent 5d93e9e36a
commit b90504cdb5
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 26 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
gnu/installer/parted.scm
View File

@ -26,6 +26,7 @@
#:use-module ((gnu build file-systems)
#:select (canonicalize-device-spec
find-partition-by-label
find-partition-by-uuid
read-partition-uuid
read-luks-partition-uuid))
#:use-module ((gnu build linux-boot)
@ -345,35 +346,38 @@ fail. See rereadpt function in wipefs.c of util-linux for an explanation."
(with-null-output-ports
(invoke "dmsetup" "remove_all")))
(define (installation-device)
"Return the installation device path."
(define (installer-root-partition-path)
"Return the root partition path, or #f if it could not be detected."
(let* ((cmdline (linux-command-line))
(root (find-long-option "--root" cmdline)))
(and root
(canonicalize-device-spec (uuid root)))))
(or (and (access? root F_OK) root)
(find-partition-by-label root)
(and=> (uuid root)
find-partition-by-uuid)))))
(define (non-install-devices)
"Return all the available devices, except the install device."
(define (read-only? device)
(dynamic-wind
(lambda ()
(device-open device))
(lambda ()
(device-read-only? device))
(lambda ()
(device-close device))))
;; If parted reports that a device is read-only it is probably the
;; installation device. However, as this detection does not always work,
;; compare the device path to the installation device path read from the
;; command line.
(let ((install-device (installation-device)))
(remove (lambda (device)
(let ((file-name (device-path device)))
(or (read-only? device)
(and install-device
(string=? file-name install-device)))))
(devices))))
(define the-installer-root-partition-path
(installer-root-partition-path))
;; 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)))
;;