diff options
author | Marius Bakke <marius@gnu.org> | 2021-06-19 17:38:47 +0200 |
---|---|---|
committer | Marius Bakke <marius@gnu.org> | 2021-06-19 17:38:47 +0200 |
commit | 6f9a80b331ae41d142a49fbeb94b90ee587b6155 (patch) | |
tree | 2da042a6ccf5368c73d6e3d54c2ee02a62d284e4 /gnu/installer | |
parent | 6500c9a5b364616e38a7e03aa4516fc2d7cee876 (diff) | |
parent | dece03e2b98fc1c2428c2448ce5792f813eb79bf (diff) | |
download | guix-patches-6f9a80b331ae41d142a49fbeb94b90ee587b6155.tar guix-patches-6f9a80b331ae41d142a49fbeb94b90ee587b6155.tar.gz |
Merge branch 'master' into core-updates
Note: this merge actually changes the 'curl' and 'python-attrs' derivations,
as part of solving caf4a7a2770ef4d05a6e18f40d602e51da749ddc and
12964df69a99de6190422c752fef65ef813f3b6b respectively.
4604d43c0e (gnu: gnutls@3.6.16: Fix cross-compilation.) was ignored because it
cannot currently be tested.
Conflicts:
gnu/local.mk
gnu/packages/aidc.scm
gnu/packages/boost.scm
gnu/packages/curl.scm
gnu/packages/nettle.scm
gnu/packages/networking.scm
gnu/packages/python-xyz.scm
gnu/packages/tls.scm
Diffstat (limited to 'gnu/installer')
-rw-r--r-- | gnu/installer/newt/partition.scm | 8 | ||||
-rw-r--r-- | gnu/installer/parted.scm | 98 |
2 files changed, 87 insertions, 19 deletions
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index 2bb9b16945..1c0444b67f 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm @@ -709,6 +709,13 @@ by pressing the Exit button.~%~%"))) (run-error-page (G_ "No root mount point found.") (G_ "Missing mount point")) + #f) + ((cannot-read-uuid? c) + (run-error-page + (format #f (G_ "Cannot read the ~a partition UUID.\ + You may need to format it.") + (cannot-read-uuid-partition c)) + (G_ "Wrong partition format")) #f)) (check-user-partitions user-partitions)))) (if user-partitions-ok? @@ -789,6 +796,7 @@ by pressing the Exit button.~%~%"))) (format-user-partitions user-partitions-with-pass) (syslog "formatted ~a user partitions~%" (length user-partitions-with-pass)) + (syslog "user-partitions: ~a~%" user-partitions) (destroy-form-and-pop form) user-partitions)) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index 6d6e500d71..1f9cec1d11 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -24,8 +24,13 @@ #:use-module (gnu installer newt page) #:use-module (gnu system uuid) #:use-module ((gnu build file-systems) - #:select (read-partition-uuid + #:select (canonicalize-device-spec + find-partition-by-label + read-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) #:select (missing-modules)) #:use-module ((gnu system linux-initrd) @@ -107,6 +112,9 @@ &no-root-mount-point no-root-mount-point? + &cannot-read-uuid + cannot-read-uuid? + cannot-read-uuid-partition check-user-partitions set-user-partitions-file-name @@ -230,7 +238,7 @@ inferior to MAX-SIZE, #f otherwise." (case fs-type ((ext4) "ext4") ((btrfs) "btrfs") - ((fat16) "fat") + ((fat16) "vfat") ((fat32) "vfat") ((jfs) "jfs") ((ntfs) "ntfs"))) @@ -334,16 +342,35 @@ 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." + (let* ((cmdline (linux-command-line)) + (root (find-long-option "--root" cmdline))) + (and root + (canonicalize-device-spec (uuid root))))) + (define (non-install-devices) - "Return all the available devices, except the busy one, allegedly the -install device. DEVICE-IS-BUSY? is a parted call, checking if the device is -mounted." - ;; FIXME: The install image uses an overlayfs so the install device does not - ;; appear as mounted and won't be considered as busy. - (remove (lambda (device) - (let ((file-name (device-path device))) - (device-is-busy? device))) - (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)))) ;; @@ -1006,15 +1033,48 @@ exists." (define-condition-type &no-root-mount-point &condition no-root-mount-point?) +;; Cannot not read the partition UUID. +(define-condition-type &cannot-read-uuid &condition + cannot-read-uuid? + (partition cannot-read-uuid-partition)) + (define (check-user-partitions user-partitions) - "Return #t if the USER-PARTITIONS lists contains one <user-partition> record -with a mount-point set to '/', raise &no-root-mount-point condition -otherwise." - (let ((mount-points - (map user-partition-mount-point user-partitions))) - (or (member "/" mount-points) - (raise - (condition (&no-root-mount-point)))))) + "Check the following statements: + +The USER-PARTITIONS list contains one <user-partition> record with a +mount-point set to '/'. Raise &no-root-mount-point condition otherwise. + +All the USER-PARTITIONS with a mount point and that will not be formatted have +a valid UUID. Raise a &cannot-read-uuid condition specifying the faulty +partition otherwise. + +Return #t if all the statements are valid." + (define (check-root) + (let ((mount-points + (map user-partition-mount-point user-partitions))) + (or (member "/" mount-points) + (raise + (condition (&no-root-mount-point)))))) + + (define (check-uuid) + (let ((mount-partitions + (filter user-partition-mount-point user-partitions))) + (every + (lambda (user-partition) + (let ((file-name (user-partition-file-name user-partition)) + (need-formatting? + (user-partition-need-formatting? user-partition))) + (or need-formatting? + (read-partition-uuid file-name) + (raise + (condition + (&cannot-read-uuid + (partition file-name))))))) + mount-partitions))) + + (and (check-root) + (check-uuid) + #t)) (define (set-user-partitions-file-name user-partitions) "Set the partition file-name of <user-partition> records in USER-PARTITIONS |