me
/
guix
Archived
1
0
Fork 0
Code

installer: Improve the installation device detection method. 

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

* gnu/installer/parted.scm (installation-device): New method.
(non-install-devices): Remove devices which are reported as read-only by
parted or which path is identical to the installation device path returned by
the above method.
master
Mathieu Othacehe 2021-06-17 11:00:26 +02:00
parent f1a71be028
commit e12be802e0
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 32 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
gnu/installer/parted.scm
View File

@ -24,9 +24,13 @@
#:use-module (gnu installer newt page) #:use-module (gnu installer newt page)
#:use-module (gnu system uuid) #:use-module (gnu system uuid)
#:use-module ((gnu build file-systems) #:use-module ((gnu build file-systems)
#:select (find-partition-by-label #:select (canonicalize-device-spec
find-partition-by-label
read-partition-uuid read-partition-uuid
read-luks-partition-uuid)) read-luks-partition-uuid))
#:use-module ((gnu build linux-boot)
#:select (linux-command-line
find-long-option))
#:use-module ((gnu build linux-modules) #:use-module ((gnu build linux-modules)
#:select (missing-modules)) #:select (missing-modules))
#:use-module ((gnu system linux-initrd) #:use-module ((gnu system linux-initrd)
@ -338,19 +342,35 @@ fail. See rereadpt function in wipefs.c of util-linux for an explanation."
(with-null-output-ports (with-null-output-ports
(invoke "dmsetup" "remove_all"))) (invoke "dmsetup" "remove_all")))
(define (installation-device)
"Return the installation device path."
(let* ((cmdline (linux-command-line))
(root (find-long-option "--root" cmdline)))
(and root
(canonicalize-device-spec (uuid root)))))
(define (non-install-devices) (define (non-install-devices)
"Return all the available devices, except the install device." "Return all the available devices, except the install device."
;; XXX: The install image uses an overlayfs so detecting the install device (define (read-only? device)
;; is not easy. Assume that a given device is the installation device if it (dynamic-wind
;; is reported as busy by parted or if its label is the ISO9660 image label. (lambda ()
(remove (lambda (device) (device-open device))
(let ((file-name (device-path device)) (lambda ()
(install-file-name (device-read-only? device))
(find-partition-by-label "GUIX_IMAGE"))) (lambda ()
(or (device-is-busy? device) (device-close device))))
(and install-file-name
(string=? file-name install-file-name))))) ;; If parted reports that a device is read-only it is probably the
(devices))) ;; 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))))
;; ;;