nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

installer: Various renamins follow-up. 

s/path/file and s/crypt/encrypt.

* gnu/installer/newt/partition.scm: Apply renamings.
* gnu/installer/parted.scm: Ditto.
This commit is contained in:
Mathieu Othacehe 2018-12-09 11:09:43 +09:00 committed by Ludovic Courtès
parent 5737ba841b
commit 44b2d31c28
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 70 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gnu/installer/newt/partition.scm
View File

@ -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." USER-PARTITIONS list. Return this list with password fields filled-in."
(map (lambda (user-part) (map (lambda (user-part)
(let* ((crypt-label (user-partition-crypt-label 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 (password-page
(lambda () (lambda ()
(run-input-page (run-input-page
(format #f (G_ "Please enter the password for the \ (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"))))) (G_ "Password required")))))
(if crypt-label (if crypt-label
(user-partition (user-partition
@ -378,8 +378,8 @@ partition. Leave this field empty if you don't want to set a mounting point.")
(user-partition (user-partition
(inherit new-user-partition) (inherit new-user-partition)
(need-formating? #t) (need-formating? #t)
(path (partition-get-path new-partition)) (file-name (partition-get-path new-partition))
(disk-path (device-path device)) (disk-file-name (device-path device))
(parted-object new-partition)))) (parted-object new-partition))))
(and (apply-user-partition-changes new-user-partition) (and (apply-user-partition-changes new-user-partition)
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)) target-user-partition))
(disk (partition-disk partition)) (disk (partition-disk partition))
(device (disk-device disk)) (device (disk-device disk))
(path (device-path device)) (file-name (device-path device))
(number-str (partition-print-number partition)) (number-str (partition-print-number partition))
(type (user-partition-type target-user-partition)) (type (user-partition-type target-user-partition))
(type-str (symbol->string type)) (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 #:info-text
(if creation? (if creation?
(G_ (format #f "Creating ~a partition starting at ~a of ~a." (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." (G_ (format #f "You are currently editing partition ~a."
number-str))) number-str)))
#:title (if creation? #:title (if creation?
@ -589,10 +589,10 @@ edit it."
(cond (cond
((disk? item) ((disk? item)
(let* ((device (disk-device item)) (let* ((device (disk-device item))
(path (device-path device)) (file-name (device-path device))
(info-text (info-text
(format #f (G_ "Are you sure you want to delete everything on disk ~a?") (format #f (G_ "Are you sure you want to delete everything on disk ~a?")
path)) file-name))
(result (choice-window (G_ "Delete disk") (result (choice-window (G_ "Delete disk")
(G_ "Ok") (G_ "Ok")
(G_ "Exit") (G_ "Exit")
@ -699,7 +699,7 @@ by pressing the Exit button.~%~%")))
(define (run-page devices) (define (run-page devices)
(let* ((items (let* ((items
'((entire . "Guided - using the entire disk") '((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"))) (manual . "Manual")))
(result (run-listbox-selection-page (result (run-listbox-selection-page
#:info-text (G_ "Please select a partitioning method.") #:info-text (G_ "Please select a partitioning method.")
@ -711,7 +711,7 @@ by pressing the Exit button.~%~%")))
(method (car result))) (method (car result)))
(cond (cond
((or (eq? method 'entire) ((or (eq? method 'entire)
(eq? method 'entire-crypted)) (eq? method 'entire-encrypted))
(let* ((device (run-device-page devices)) (let* ((device (run-device-page devices))
(disk-type (disk-probe device)) (disk-type (disk-probe device))
(disk (if disk-type (disk (if disk-type

119
gnu/installer/parted.scm
View File

@ -42,8 +42,8 @@
user-partition? user-partition?
user-partition-name user-partition-name
user-partition-type user-partition-type
user-partition-path user-partition-file-name
user-partition-disk-path user-partition-disk-file-name
user-partition-crypt-label user-partition-crypt-label
user-partition-crypt-password user-partition-crypt-password
user-partition-fs-type user-partition-fs-type
@ -106,7 +106,7 @@
no-root-mount-point? no-root-mount-point?
check-user-partitions check-user-partitions
set-user-partitions-path set-user-partitions-file-name
format-user-partitions format-user-partitions
mount-user-partitions mount-user-partitions
umount-user-partitions umount-user-partitions
@ -129,9 +129,9 @@
(default #f)) (default #f))
(type user-partition-type (type user-partition-type
(default 'normal)) ; 'normal | 'logical | 'extended (default 'normal)) ; 'normal | 'logical | 'extended
(path user-partition-path (file-name user-partition-file-name
(default #f)) (default #f))
(disk-path user-partition-disk-path (disk-file-name user-partition-disk-file-name
(default #f)) (default #f))
(crypt-label user-partition-crypt-label (crypt-label user-partition-crypt-label
(default #f)) (default #f))
@ -304,8 +304,8 @@ of <user-partition> record."
name)) name))
(type (or (partition-user-type partition) (type (or (partition-user-type partition)
'normal)) 'normal))
(path (partition-get-path partition)) (file-name (partition-get-path partition))
(disk-path (device-path device)) (disk-file-name (device-path device))
(fs-type (or (partition-filesystem-user-type partition) (fs-type (or (partition-filesystem-user-type partition)
'ext4)) 'ext4))
(mount-point (and (esp-partition? partition) (mount-point (and (esp-partition? partition)
@ -336,12 +336,12 @@ PARTED-OBJECT field equals PARTITION, return #f if not found."
;; Devices ;; 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 "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." fail. See rereadpt function in wipefs.c of util-linux for an explanation."
(let loop ((try 4)) (let loop ((try 4))
(usleep 250000) (usleep 250000)
(let ((in-use? (device-in-use? path))) (let ((in-use? (device-in-use? file-name)))
(if (and in-use? (> try 0)) (if (and in-use? (> try 0))
(loop (- try 1)) (loop (- try 1))
in-use?)))) 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 partition table to determine whether or not it is already used (like sfdisk
from util-linux)." from util-linux)."
(remove (lambda (device) (remove (lambda (device)
(let ((path (device-path device))) (let ((file-name (device-path device)))
(or (device-is-busy? device) (or (device-is-busy? device)
(with-delay-device-in-use? path)))) (with-delay-device-in-use? file-name))))
(devices))) (devices)))
@ -374,7 +374,7 @@ from util-linux)."
(define* (device-description device #:optional disk) (define* (device-description device #:optional disk)
"Return a string describing the given DEVICE." "Return a string describing the given DEVICE."
(let* ((type (device-type device)) (let* ((type (device-type device))
(path (device-path device)) (file-name (device-path device))
(model (device-model device)) (model (device-model device))
(type-str (device-type->string type)) (type-str (device-type->string type))
(disk-type (if disk (disk-type (if disk
@ -389,7 +389,7 @@ from util-linux)."
`(,@(if (string=? model "") `(,@(if (string=? model "")
`(,type-str) `(,type-str)
`(,model ,(string-append "(" type-str ")"))) `(,model ,(string-append "(" type-str ")")))
,path ,file-name
,end ,end
,@(if disk-type ,@(if disk-type
`(,(disk-type-name disk-type)) `(,(disk-type-name disk-type))
@ -854,8 +854,8 @@ partition."
(if new-partition (if new-partition
(cons (user-partition (cons (user-partition
(inherit new-user-partition) (inherit new-user-partition)
(path (partition-get-path new-partition)) (file-name (partition-get-path new-partition))
(disk-path (device-path device)) (disk-file-name (device-path device))
(parted-object new-partition)) (parted-object new-partition))
(loop rest (loop rest
(if (eq? type 'extended) (if (eq? type 'extended)
@ -946,10 +946,10 @@ swap partition, a root partition and a home partition."
`(,start-partition) `(,start-partition)
'()) '())
,@(if encrypted? ,@(if encrypted?
'() '()
`(,(user-partition `(,(user-partition
(fs-type 'swap) (fs-type 'swap)
(size swap-size)))) (size swap-size))))
,(user-partition ,(user-partition
(fs-type 'ext4) (fs-type 'ext4)
(bootable? has-extended?) (bootable? has-extended?)
@ -1015,15 +1015,15 @@ otherwise."
(raise (raise
(condition (&no-root-mount-point)))))) (condition (&no-root-mount-point))))))
(define (set-user-partitions-path user-partitions) (define (set-user-partitions-file-name user-partitions)
"Set the partition path of <user-partition> records in USER-PARTITIONS list "Set the partition file-name of <user-partition> records in USER-PARTITIONS
and return the updated list." list and return the updated list."
(map (lambda (p) (map (lambda (p)
(let* ((partition (user-partition-parted-object p)) (let* ((partition (user-partition-parted-object p))
(path (partition-get-path partition))) (file-name (partition-get-path partition)))
(user-partition (user-partition
(inherit p) (inherit p)
(path path)))) (file-name file-name))))
user-partitions)) user-partitions))
(define-syntax-rule (with-null-output-ports exp ...) (define-syntax-rule (with-null-output-ports exp ...)
@ -1035,17 +1035,17 @@ bit bucket."
(lambda () exp ...))))) (lambda () exp ...)))))
(define (create-ext4-file-system partition) (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 (with-null-output-ports
(invoke "mkfs.ext4" "-F" partition))) (invoke "mkfs.ext4" "-F" partition)))
(define (create-fat32-file-system 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 (with-null-output-ports
(invoke "mkfs.fat" "-F32" partition))) (invoke "mkfs.fat" "-F32" partition)))
(define (create-swap-partition 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 (with-null-output-ports
(invoke "mkswap" "-f" partition))) (invoke "mkswap" "-f" partition)))
@ -1057,26 +1057,26 @@ bit bucket."
(close port) (close port)
(proc file)))) (proc file))))
(define (user-partition-upper-path user-partition) (define (user-partition-upper-file-name user-partition)
"Return the path of the virtual block device corresponding to USER-PARTITION "Return the file-name of the virtual block device corresponding to
if it is encrypted, or the plain path otherwise." USER-PARTITION if it is encrypted, or the plain file-name otherwise."
(let ((crypt-label (user-partition-crypt-label user-partition)) (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 (if crypt-label
(string-append "/dev/mapper/" crypt-label) (string-append "/dev/mapper/" crypt-label)
path))) file-name)))
(define (luks-format-and-open user-partition) (define (luks-format-and-open user-partition)
"Format and open the encrypted partition pointed by 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)) (label (user-partition-crypt-label user-partition))
(password (user-partition-crypt-password user-partition))) (password (user-partition-crypt-password user-partition)))
(call-with-luks-key-file (call-with-luks-key-file
password password
(lambda (key-file) (lambda (key-file)
(system* "cryptsetup" "-q" "luksFormat" path key-file) (system* "cryptsetup" "-q" "luksFormat" file-name key-file)
(system* "cryptsetup" "open" "--type" "luks" (system* "cryptsetup" "open" "--type" "luks"
"--key-file" key-file path label))))) "--key-file" key-file file-name label)))))
(define (luks-close user-partition) (define (luks-close user-partition)
"Close the encrypted partition pointed by 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)) (user-partition-need-formating? user-partition))
(type (user-partition-type user-partition)) (type (user-partition-type user-partition))
(crypt-label (user-partition-crypt-label 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))) (fs-type (user-partition-fs-type user-partition)))
(when crypt-label (when crypt-label
(luks-format-and-open user-partition)) (luks-format-and-open user-partition))
@ -1101,13 +1101,13 @@ NEED-FORMATING? field set to #t."
((ext4) ((ext4)
(and need-formating? (and need-formating?
(not (eq? type 'extended)) (not (eq? type 'extended))
(create-ext4-file-system path))) (create-ext4-file-system file-name)))
((fat32) ((fat32)
(and need-formating? (and need-formating?
(not (eq? type 'extended)) (not (eq? type 'extended))
(create-fat32-file-system path))) (create-fat32-file-system file-name)))
((swap) ((swap)
(create-swap-partition path)) (create-swap-partition file-name))
(else (else
;; TODO: Add support for other file-system types. ;; TODO: Add support for other file-system types.
#t)))) #t))))
@ -1139,9 +1139,10 @@ respective mount-points."
(user-partition-crypt-label user-partition)) (user-partition-crypt-label user-partition))
(mount-type (mount-type
(user-fs-type->mount-type fs-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) (mkdir-p target)
(mount path target mount-type))) (mount file-name target mount-type)))
sorted-partitions))) sorted-partitions)))
(define (umount-user-partitions user-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 "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." the FS-TYPE field set to 'swap, return the empty list if none found."
(filter (lambda (user-partition) (filter (lambda (user-partition)
(let ((fs-type (user-partition-fs-type user-partition))) (let ((fs-type (user-partition-fs-type user-partition)))
(eq? fs-type 'swap))) (eq? fs-type 'swap)))
user-partitions)) user-partitions))
(define (start-swapping user-partitions) (define (start-swapping user-partitions)
"Start swaping on <user-partition> records with FS-TYPE equal to 'swap." "Start swaping on <user-partition> records with FS-TYPE equal to 'swap."
(let* ((swap-user-partitions (find-swap-user-partitions 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)))
(for-each swapon swap-devices))) (for-each swapon swap-devices)))
(define (stop-swapping user-partitions) (define (stop-swapping user-partitions)
"Stop swaping on <user-partition> records with FS-TYPE equal to 'swap." "Stop swaping on <user-partition> records with FS-TYPE equal to 'swap."
(let* ((swap-user-partitions (find-swap-user-partitions 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)))
(for-each swapoff swap-devices))) (for-each swapoff swap-devices)))
(define-syntax-rule (with-mounted-partitions user-partitions exp ...) (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)) (fs-type (user-partition-fs-type user-partition))
(crypt-label (user-partition-crypt-label user-partition)) (crypt-label (user-partition-crypt-label user-partition))
(mount-type (user-fs-type->mount-type fs-type)) (mount-type (user-fs-type->mount-type fs-type))
(path (user-partition-path user-partition)) (file-name (user-partition-file-name user-partition))
(upper-path (user-partition-upper-path user-partition)) (upper-file-name (user-partition-upper-file-name user-partition))
;; Only compute uuid if partition is not encrypted. ;; Only compute uuid if partition is not encrypted.
(uuid (or crypt-label (uuid (or crypt-label
(uuid->string (read-partition-uuid path) fs-type)))) (uuid->string (read-partition-uuid file-name) fs-type))))
`(file-system `(file-system
(mount-point ,mount-point) (mount-point ,mount-point)
(device ,@(if crypt-label (device ,@(if crypt-label
`(,upper-path) `(,upper-file-name)
`((uuid ,uuid (quote ,fs-type))))) `((uuid ,uuid (quote ,fs-type)))))
(type ,mount-type) (type ,mount-type)
,@(if crypt-label ,@(if crypt-label
@ -1231,10 +1232,10 @@ list of <file-system> records."
"Convert the given USER-PARTITION record into a MAPPED-DEVICE record "Convert the given USER-PARTITION record into a MAPPED-DEVICE record
from (gnu system mapped-devices) and return it." from (gnu system mapped-devices) and return it."
(let ((label (user-partition-crypt-label user-partition)) (let ((label (user-partition-crypt-label user-partition))
(path (user-partition-path user-partition))) (file-name (user-partition-file-name user-partition)))
`(mapped-device `(mapped-device
(source (uuid ,(uuid->string (source (uuid ,(uuid->string
(read-luks-partition-uuid path) (read-luks-partition-uuid file-name)
'luks))) 'luks)))
(target ,label) (target ,label)
(type luks-device-mapping)))) (type luks-device-mapping))))
@ -1248,7 +1249,7 @@ from (gnu system mapped-devices) and return it."
(and mount-point (and mount-point
(string=? mount-point "/")))) (string=? mount-point "/"))))
user-partitions)) user-partitions))
(root-partition-disk (user-partition-disk-path root-partition))) (root-partition-disk (user-partition-disk-file-name root-partition)))
`((bootloader-configuration `((bootloader-configuration
,@(if (efi-installation?) ,@(if (efi-installation?)
`((bootloader grub-efi-bootloader) `((bootloader grub-efi-bootloader)
@ -1259,7 +1260,7 @@ from (gnu system mapped-devices) and return it."
(define (user-partitions->configuration user-partitions) (define (user-partitions->configuration user-partitions)
"Return the configuration field for USER-PARTITIONS." "Return the configuration field for USER-PARTITIONS."
(let* ((swap-user-partitions (find-swap-user-partitions 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 (encrypted-partitions
(filter user-partition-crypt-label user-partitions))) (filter user-partition-crypt-label user-partitions)))
`(,@(if (null? swap-devices) `(,@(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 ;; them to stop returning EBUSY to BLKRRPART ioctl seems to be enough. The
;; same kind of issue is described here: ;; same kind of issue is described here:
;; https://mail.gnome.org/archives/commits-list/2013-March/msg18423.html. ;; 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) (for-each force-device-sync devices)
(free-all-devices) (free-all-devices)
(for-each (lambda (path) (for-each (lambda (file-name)
(let ((in-use? (with-delay-device-in-use? path))) (let ((in-use? (with-delay-device-in-use? file-name)))
(and in-use? (and in-use?
(error (error
(format #f (G_ "Device ~a is still in use.") (format #f (G_ "Device ~a is still in use.")
path))))) file-name)))))
device-paths))) device-file-names)))