aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/installer/newt/partition.scm20
-rw-r--r--gnu/installer/parted.scm119
2 files changed, 70 insertions, 69 deletions
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 0bd84be8d9..56e9dafd49 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -143,12 +143,12 @@ an inform the user with an appropriate error-page and return #f."
USER-PARTITIONS list. Return this list with password fields filled-in."
(map (lambda (user-part)
(let* ((crypt-label (user-partition-crypt-label user-part))
- (path (user-partition-path user-part))
+ (file-name (user-partition-file-name user-part))
(password-page
(lambda ()
(run-input-page
(format #f (G_ "Please enter the password for the \
-encryption of partition ~a (label: ~a).") path crypt-label)
+encryption of partition ~a (label: ~a).") file-name crypt-label)
(G_ "Password required")))))
(if crypt-label
(user-partition
@@ -378,8 +378,8 @@ partition. Leave this field empty if you don't want to set a mounting point.")
(user-partition
(inherit new-user-partition)
(need-formating? #t)
- (path (partition-get-path new-partition))
- (disk-path (device-path device))
+ (file-name (partition-get-path new-partition))
+ (disk-file-name (device-path device))
(parted-object new-partition))))
(and (apply-user-partition-changes new-user-partition)
new-user-partition))))
@@ -389,7 +389,7 @@ partition. Leave this field empty if you don't want to set a mounting point.")
target-user-partition))
(disk (partition-disk partition))
(device (disk-device disk))
- (path (device-path device))
+ (file-name (device-path device))
(number-str (partition-print-number partition))
(type (user-partition-type target-user-partition))
(type-str (symbol->string type))
@@ -404,7 +404,7 @@ partition. Leave this field empty if you don't want to set a mounting point.")
#:info-text
(if creation?
(G_ (format #f "Creating ~a partition starting at ~a of ~a."
- type-str start path))
+ type-str start file-name))
(G_ (format #f "You are currently editing partition ~a."
number-str)))
#:title (if creation?
@@ -589,10 +589,10 @@ edit it."
(cond
((disk? item)
(let* ((device (disk-device item))
- (path (device-path device))
+ (file-name (device-path device))
(info-text
(format #f (G_ "Are you sure you want to delete everything on disk ~a?")
- path))
+ file-name))
(result (choice-window (G_ "Delete disk")
(G_ "Ok")
(G_ "Exit")
@@ -699,7 +699,7 @@ by pressing the Exit button.~%~%")))
(define (run-page devices)
(let* ((items
'((entire . "Guided - using the entire disk")
- (entire-crypted . "Guided - using the entire disk with encryption")
+ (entire-encrypted . "Guided - using the entire disk with encryption")
(manual . "Manual")))
(result (run-listbox-selection-page
#:info-text (G_ "Please select a partitioning method.")
@@ -711,7 +711,7 @@ by pressing the Exit button.~%~%")))
(method (car result)))
(cond
((or (eq? method 'entire)
- (eq? method 'entire-crypted))
+ (eq? method 'entire-encrypted))
(let* ((device (run-device-page devices))
(disk-type (disk-probe device))
(disk (if disk-type
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 1ff17d39d6..ea62d6ad77 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -42,8 +42,8 @@
user-partition?
user-partition-name
user-partition-type
- user-partition-path
- user-partition-disk-path
+ user-partition-file-name
+ user-partition-disk-file-name
user-partition-crypt-label
user-partition-crypt-password
user-partition-fs-type
@@ -106,7 +106,7 @@
no-root-mount-point?
check-user-partitions
- set-user-partitions-path
+ set-user-partitions-file-name
format-user-partitions
mount-user-partitions
umount-user-partitions
@@ -129,9 +129,9 @@
(default #f))
(type user-partition-type
(default 'normal)) ; 'normal | 'logical | 'extended
- (path user-partition-path
+ (file-name user-partition-file-name
(default #f))
- (disk-path user-partition-disk-path
+ (disk-file-name user-partition-disk-file-name
(default #f))
(crypt-label user-partition-crypt-label
(default #f))
@@ -304,8 +304,8 @@ of <user-partition> record."
name))
(type (or (partition-user-type partition)
'normal))
- (path (partition-get-path partition))
- (disk-path (device-path device))
+ (file-name (partition-get-path partition))
+ (disk-file-name (device-path device))
(fs-type (or (partition-filesystem-user-type partition)
'ext4))
(mount-point (and (esp-partition? partition)
@@ -336,12 +336,12 @@ PARTED-OBJECT field equals PARTITION, return #f if not found."
;; Devices
;;
-(define (with-delay-device-in-use? path)
+(define (with-delay-device-in-use? file-name)
"Call DEVICE-IN-USE? with a few retries, as the first re-read will often
fail. See rereadpt function in wipefs.c of util-linux for an explanation."
(let loop ((try 4))
(usleep 250000)
- (let ((in-use? (device-in-use? path)))
+ (let ((in-use? (device-in-use? file-name)))
(if (and in-use? (> try 0))
(loop (- try 1))
in-use?))))
@@ -361,9 +361,9 @@ from (guix build syscalls) module, who will try to re-read the device's
partition table to determine whether or not it is already used (like sfdisk
from util-linux)."
(remove (lambda (device)
- (let ((path (device-path device)))
+ (let ((file-name (device-path device)))
(or (device-is-busy? device)
- (with-delay-device-in-use? path))))
+ (with-delay-device-in-use? file-name))))
(devices)))
@@ -374,7 +374,7 @@ from util-linux)."
(define* (device-description device #:optional disk)
"Return a string describing the given DEVICE."
(let* ((type (device-type device))
- (path (device-path device))
+ (file-name (device-path device))
(model (device-model device))
(type-str (device-type->string type))
(disk-type (if disk
@@ -389,7 +389,7 @@ from util-linux)."
`(,@(if (string=? model "")
`(,type-str)
`(,model ,(string-append "(" type-str ")")))
- ,path
+ ,file-name
,end
,@(if disk-type
`(,(disk-type-name disk-type))
@@ -854,8 +854,8 @@ partition."
(if new-partition
(cons (user-partition
(inherit new-user-partition)
- (path (partition-get-path new-partition))
- (disk-path (device-path device))
+ (file-name (partition-get-path new-partition))
+ (disk-file-name (device-path device))
(parted-object new-partition))
(loop rest
(if (eq? type 'extended)
@@ -946,10 +946,10 @@ swap partition, a root partition and a home partition."
`(,start-partition)
'())
,@(if encrypted?
- '()
- `(,(user-partition
- (fs-type 'swap)
- (size swap-size))))
+ '()
+ `(,(user-partition
+ (fs-type 'swap)
+ (size swap-size))))
,(user-partition
(fs-type 'ext4)
(bootable? has-extended?)
@@ -1015,15 +1015,15 @@ otherwise."
(raise
(condition (&no-root-mount-point))))))
-(define (set-user-partitions-path user-partitions)
- "Set the partition path of <user-partition> records in USER-PARTITIONS list
-and return the updated list."
+(define (set-user-partitions-file-name user-partitions)
+ "Set the partition file-name of <user-partition> records in USER-PARTITIONS
+list and return the updated list."
(map (lambda (p)
(let* ((partition (user-partition-parted-object p))
- (path (partition-get-path partition)))
+ (file-name (partition-get-path partition)))
(user-partition
(inherit p)
- (path path))))
+ (file-name file-name))))
user-partitions))
(define-syntax-rule (with-null-output-ports exp ...)
@@ -1035,17 +1035,17 @@ bit bucket."
(lambda () exp ...)))))
(define (create-ext4-file-system partition)
- "Create an ext4 file-system for PARTITION path."
+ "Create an ext4 file-system for PARTITION file-name."
(with-null-output-ports
(invoke "mkfs.ext4" "-F" partition)))
(define (create-fat32-file-system partition)
- "Create an ext4 file-system for PARTITION path."
+ "Create an ext4 file-system for PARTITION file-name."
(with-null-output-ports
(invoke "mkfs.fat" "-F32" partition)))
(define (create-swap-partition partition)
- "Set up swap area on PARTITION path."
+ "Set up swap area on PARTITION file-name."
(with-null-output-ports
(invoke "mkswap" "-f" partition)))
@@ -1057,26 +1057,26 @@ bit bucket."
(close port)
(proc file))))
-(define (user-partition-upper-path user-partition)
- "Return the path of the virtual block device corresponding to USER-PARTITION
-if it is encrypted, or the plain path otherwise."
+(define (user-partition-upper-file-name user-partition)
+ "Return the file-name of the virtual block device corresponding to
+USER-PARTITION if it is encrypted, or the plain file-name otherwise."
(let ((crypt-label (user-partition-crypt-label user-partition))
- (path (user-partition-path user-partition)))
+ (file-name (user-partition-file-name user-partition)))
(if crypt-label
(string-append "/dev/mapper/" crypt-label)
- path)))
+ file-name)))
(define (luks-format-and-open user-partition)
"Format and open the encrypted partition pointed by USER-PARTITION."
- (let* ((path (user-partition-path user-partition))
+ (let* ((file-name (user-partition-file-name user-partition))
(label (user-partition-crypt-label user-partition))
(password (user-partition-crypt-password user-partition)))
(call-with-luks-key-file
password
(lambda (key-file)
- (system* "cryptsetup" "-q" "luksFormat" path key-file)
+ (system* "cryptsetup" "-q" "luksFormat" file-name key-file)
(system* "cryptsetup" "open" "--type" "luks"
- "--key-file" key-file path label)))))
+ "--key-file" key-file file-name label)))))
(define (luks-close user-partition)
"Close the encrypted partition pointed by USER-PARTITION."
@@ -1092,7 +1092,7 @@ NEED-FORMATING? field set to #t."
(user-partition-need-formating? user-partition))
(type (user-partition-type user-partition))
(crypt-label (user-partition-crypt-label user-partition))
- (path (user-partition-upper-path user-partition))
+ (file-name (user-partition-upper-file-name user-partition))
(fs-type (user-partition-fs-type user-partition)))
(when crypt-label
(luks-format-and-open user-partition))
@@ -1101,13 +1101,13 @@ NEED-FORMATING? field set to #t."
((ext4)
(and need-formating?
(not (eq? type 'extended))
- (create-ext4-file-system path)))
+ (create-ext4-file-system file-name)))
((fat32)
(and need-formating?
(not (eq? type 'extended))
- (create-fat32-file-system path)))
+ (create-fat32-file-system file-name)))
((swap)
- (create-swap-partition path))
+ (create-swap-partition file-name))
(else
;; TODO: Add support for other file-system types.
#t))))
@@ -1139,9 +1139,10 @@ respective mount-points."
(user-partition-crypt-label user-partition))
(mount-type
(user-fs-type->mount-type fs-type))
- (path (user-partition-upper-path user-partition)))
+ (file-name
+ (user-partition-upper-file-name user-partition)))
(mkdir-p target)
- (mount path target mount-type)))
+ (mount file-name target mount-type)))
sorted-partitions)))
(define (umount-user-partitions user-partitions)
@@ -1165,20 +1166,20 @@ respective mount-points."
"Return the subset of <user-partition> records in USER-PARTITIONS list with
the FS-TYPE field set to 'swap, return the empty list if none found."
(filter (lambda (user-partition)
- (let ((fs-type (user-partition-fs-type user-partition)))
- (eq? fs-type 'swap)))
- user-partitions))
+ (let ((fs-type (user-partition-fs-type user-partition)))
+ (eq? fs-type 'swap)))
+ user-partitions))
(define (start-swapping user-partitions)
"Start swaping on <user-partition> records with FS-TYPE equal to 'swap."
(let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
- (swap-devices (map user-partition-path swap-user-partitions)))
+ (swap-devices (map user-partition-file-name swap-user-partitions)))
(for-each swapon swap-devices)))
(define (stop-swapping user-partitions)
"Stop swaping on <user-partition> records with FS-TYPE equal to 'swap."
(let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
- (swap-devices (map user-partition-path swap-user-partitions)))
+ (swap-devices (map user-partition-file-name swap-user-partitions)))
(for-each swapoff swap-devices)))
(define-syntax-rule (with-mounted-partitions user-partitions exp ...)
@@ -1201,15 +1202,15 @@ the FS-TYPE field set to 'swap, return the empty list if none found."
(fs-type (user-partition-fs-type user-partition))
(crypt-label (user-partition-crypt-label user-partition))
(mount-type (user-fs-type->mount-type fs-type))
- (path (user-partition-path user-partition))
- (upper-path (user-partition-upper-path user-partition))
+ (file-name (user-partition-file-name user-partition))
+ (upper-file-name (user-partition-upper-file-name user-partition))
;; Only compute uuid if partition is not encrypted.
(uuid (or crypt-label
- (uuid->string (read-partition-uuid path) fs-type))))
+ (uuid->string (read-partition-uuid file-name) fs-type))))
`(file-system
(mount-point ,mount-point)
(device ,@(if crypt-label
- `(,upper-path)
+ `(,upper-file-name)
`((uuid ,uuid (quote ,fs-type)))))
(type ,mount-type)
,@(if crypt-label
@@ -1231,10 +1232,10 @@ list of <file-system> records."
"Convert the given USER-PARTITION record into a MAPPED-DEVICE record
from (gnu system mapped-devices) and return it."
(let ((label (user-partition-crypt-label user-partition))
- (path (user-partition-path user-partition)))
+ (file-name (user-partition-file-name user-partition)))
`(mapped-device
(source (uuid ,(uuid->string
- (read-luks-partition-uuid path)
+ (read-luks-partition-uuid file-name)
'luks)))
(target ,label)
(type luks-device-mapping))))
@@ -1248,7 +1249,7 @@ from (gnu system mapped-devices) and return it."
(and mount-point
(string=? mount-point "/"))))
user-partitions))
- (root-partition-disk (user-partition-disk-path root-partition)))
+ (root-partition-disk (user-partition-disk-file-name root-partition)))
`((bootloader-configuration
,@(if (efi-installation?)
`((bootloader grub-efi-bootloader)
@@ -1259,7 +1260,7 @@ from (gnu system mapped-devices) and return it."
(define (user-partitions->configuration user-partitions)
"Return the configuration field for USER-PARTITIONS."
(let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
- (swap-devices (map user-partition-path swap-user-partitions))
+ (swap-devices (map user-partition-file-name swap-user-partitions))
(encrypted-partitions
(filter user-partition-crypt-label user-partitions)))
`(,@(if (null? swap-devices)
@@ -1296,13 +1297,13 @@ the devices not to be used before returning."
;; them to stop returning EBUSY to BLKRRPART ioctl seems to be enough. The
;; same kind of issue is described here:
;; https://mail.gnome.org/archives/commits-list/2013-March/msg18423.html.
- (let ((device-paths (map device-path devices)))
+ (let ((device-file-names (map device-path devices)))
(for-each force-device-sync devices)
(free-all-devices)
- (for-each (lambda (path)
- (let ((in-use? (with-delay-device-in-use? path)))
+ (for-each (lambda (file-name)
+ (let ((in-use? (with-delay-device-in-use? file-name)))
(and in-use?
(error
(format #f (G_ "Device ~a is still in use.")
- path)))))
- device-paths)))
+ file-name)))))
+ device-file-names)))
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-02 10:35:43 +0000