aboutsummaryrefslogtreecommitdiff
path: root/gnu/installer/parted.scm
diff options
context:
space:
mode:
authorMathieu Othacehe <m.othacehe@gmail.com>2018-12-09 11:09:43 +0900
committerLudovic Courtès <ludo@gnu.org>2019-01-17 14:04:27 +0100
commit44b2d31c2834cae13475a47bbb5a7258358ea03b (patch)
tree88c2b1a688cef39be3e4a98078c4505d684dc405 /gnu/installer/parted.scm
parent5737ba841bd8e21e1cb5dc63e1fc5e09d31482bb (diff)
downloadpatches-44b2d31c2834cae13475a47bbb5a7258358ea03b.tar
patches-44b2d31c2834cae13475a47bbb5a7258358ea03b.tar.gz
installer: Various renamins follow-up.
s/path/file and s/crypt/encrypt. * gnu/installer/newt/partition.scm: Apply renamings. * gnu/installer/parted.scm: Ditto.
Diffstat (limited to 'gnu/installer/parted.scm')
-rw-r--r--gnu/installer/parted.scm119
1 files changed, 60 insertions, 59 deletions
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)))