diff options
| author | Ricardo Wurmus <rekado@elephly.net> | 2021-12-05 19:17:41 +0100 |
|---|---|---|
| committer | Ricardo Wurmus <rekado@elephly.net> | 2021-12-05 19:17:41 +0100 |
| commit | 9bc0f45df5d6aed217020b1183dca54989844fb0 (patch) | |
| tree | d927e89949ff7f65b5059bc94273c53fd43d0763 /gnu/installer/parted.scm | |
| parent | 6db3c536e89deb8a204e756f427614925a7d2582 (diff) | |
| parent | 10554e0a57feeea470127a1d0441957d1776b0bd (diff) | |
Merge remote-tracking branch 'origin/master' into core-updates-frozen
Diffstat (limited to 'gnu/installer/parted.scm')
| -rw-r--r-- | gnu/installer/parted.scm | 55 |
1 files changed, 30 insertions, 25 deletions
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index fadac362087..cf121e79a6e 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm | |||
| @@ -26,6 +26,7 @@ | |||
| 26 | #:use-module ((gnu build file-systems) | 26 | #:use-module ((gnu build file-systems) |
| 27 | #:select (canonicalize-device-spec | 27 | #:select (canonicalize-device-spec |
| 28 | find-partition-by-label | 28 | find-partition-by-label |
| 29 | find-partition-by-uuid | ||
| 29 | read-partition-uuid | 30 | read-partition-uuid |
| 30 | read-luks-partition-uuid)) | 31 | read-luks-partition-uuid)) |
| 31 | #:use-module ((gnu build linux-boot) | 32 | #:use-module ((gnu build linux-boot) |
| @@ -345,35 +346,38 @@ fail. See rereadpt function in wipefs.c of util-linux for an explanation." | |||
| 345 | (with-null-output-ports | 346 | (with-null-output-ports |
| 346 | (invoke "dmsetup" "remove_all"))) | 347 | (invoke "dmsetup" "remove_all"))) |
| 347 | 348 | ||
| 348 | (define (installation-device) | 349 | (define (installer-root-partition-path) |
| 349 | "Return the installation device path." | 350 | "Return the root partition path, or #f if it could not be detected." |
| 350 | (let* ((cmdline (linux-command-line)) | 351 | (let* ((cmdline (linux-command-line)) |
| 351 | (root (find-long-option "--root" cmdline))) | 352 | (root (find-long-option "--root" cmdline))) |
| 352 | (and root | 353 | (and root |
| 353 | (canonicalize-device-spec (uuid root))))) | 354 | (or (and (access? root F_OK) root) |
| 355 | (find-partition-by-label root) | ||
| 356 | (and=> (uuid root) | ||
| 357 | find-partition-by-uuid))))) | ||
| 354 | 358 | ||
| 355 | (define (non-install-devices) | 359 | (define (non-install-devices) |
| 356 | "Return all the available devices, except the install device." | 360 | "Return all the available devices, except the install device." |
| 357 | (define (read-only? device) | 361 | |
| 358 | (dynamic-wind | 362 | (define the-installer-root-partition-path |
| 359 | (lambda () | 363 | (installer-root-partition-path)) |
| 360 | (device-open device)) | 364 | |
| 361 | (lambda () | 365 | ;; Read partition table of device and compare each path to the one |
| 362 | (device-read-only? device)) | 366 | ;; we're booting from to determine if it is the installation |
| 363 | (lambda () | 367 | ;; device. |
| 364 | (device-close device)))) | 368 | (define (installation-device? device) |
| 365 | 369 | ;; When using CDROM based installation, the root partition path may be the | |
| 366 | ;; If parted reports that a device is read-only it is probably the | 370 | ;; device path. |
| 367 | ;; installation device. However, as this detection does not always work, | 371 | (or (string=? the-installer-root-partition-path |
| 368 | ;; compare the device path to the installation device path read from the | 372 | (device-path device)) |
| 369 | ;; command line. | 373 | (let ((disk (disk-new device))) |
| 370 | (let ((install-device (installation-device))) | 374 | (and disk |
| 371 | (remove (lambda (device) | 375 | (any (lambda (partition) |
| 372 | (let ((file-name (device-path device))) | 376 | (string=? the-installer-root-partition-path |
| 373 | (or (read-only? device) | 377 | (partition-get-path partition))) |
| 374 | (and install-device | 378 | (disk-partitions disk)))))) |
| 375 | (string=? file-name install-device))))) | 379 | |
| 376 | (devices)))) | 380 | (remove installation-device? (devices))) |
| 377 | 381 | ||
| 378 | 382 | ||
| 379 | ;; | 383 | ;; |
| @@ -1165,8 +1169,9 @@ USER-PARTITION if it is encrypted, or the plain file-name otherwise." | |||
| 1165 | (lambda (key-file) | 1169 | (lambda (key-file) |
| 1166 | (syslog "formatting and opening LUKS entry ~s at ~s~%" | 1170 | (syslog "formatting and opening LUKS entry ~s at ~s~%" |
| 1167 | label file-name) | 1171 | label file-name) |
| 1168 | (system* "cryptsetup" "-q" "luksFormat" file-name key-file) | 1172 | (system* "cryptsetup" "-q" "luksFormat" "--type" "luks2" |
| 1169 | (system* "cryptsetup" "open" "--type" "luks" | 1173 | "--pbkdf" "pbkdf2" file-name key-file) |
| 1174 | (system* "cryptsetup" "open" | ||
| 1170 | "--key-file" key-file file-name label))))) | 1175 | "--key-file" key-file file-name label))))) |
| 1171 | 1176 | ||
| 1172 | (define (luks-close user-partition) | 1177 | (define (luks-close user-partition) |
