TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

installer: Various renamins follow-up.

Browse source 
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 @@ (define (prompt-luks-passwords user-partitions)
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 @@ (define (button-action)
(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 @@ (define (button-action)
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 @@ (define (button-action)
#: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 @@ (define (hotkey-action key listbox-item)
(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 @@ (define (run-partioning-page)
(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 @@ (define (run-page devices)
(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 @@ (define-module (gnu installer parted)
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 @@ (define-module (gnu installer parted)
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 @@ (define-record-type* <user-partition>
(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 @@ (define (partition->user-partition partition)
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 @@ (define (find-user-partition-by-parted-object user-partitions
;; 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 @@ (define (non-install-devices)
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 @@ (define (non-install-devices)
(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 @@ (define* (device-description device #:optional disk)
`(,@(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 @@ (define* (create-adjacent-partitions disk partitions
(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 @@ (define* (auto-partition disk
`(,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 @@ (define (check-user-partitions user-partitions)
(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 @@ (define-syntax-rule (with-null-output-ports exp ...)
(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 @@ (define (call-with-luks-key-file password proc)
(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 @@ (define (format-user-partitions user-partitions)
(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 @@ (define (format-user-partitions user-partitions)
((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 @@ (define (mount-user-partitions user-partitions)
(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 @@ (define (find-swap-user-partitions user-partitions)
"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 @@ (define (user-partition->file-system user-partition)
(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 @@ (define (user-partition->mapped-device user-partition)
"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 @@ (define (bootloader-configuration user-partitions)
(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 @@ (define (bootloader-configuration user-partitions)
(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 @@ (define (free-parted devices)
;; 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)))