ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 22:08:16 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

installer: Use run-command-in-installer in (gnu installer parted).

Browse source 
* gnu/installer/parted.scm (remove-logical-devices,
create-btrfs-file-system, create-ext4-file-system,
create-fat16-file-system, create-fat32-file-system,
create-jfs-file-system, create-ntfs-file-system,
create-xfs-file-system, create-swap-partition, luks-format-and-open,
luks-close): Use run-command-in-installer.
(with-null-output-ports): Remove.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
This commit is contained in:
Josselin Poiret 2022-01-15 14:50:02 +01:00 committed by Mathieu Othacehe
parent 408427a36c
commit af59e53631
No known key found for this signature in database
GPG key ID: 8354763531769CA6
1 changed files with 14 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
gnu/installer/parted.scm
View file

@ -343,8 +343,7 @@ (define* (force-device-sync device)
(define (remove-logical-devices) (define (remove-logical-devices)
"Remove all active logical devices." "Remove all active logical devices."
(with-null-output-ports ((run-command-in-installer) "dmsetup" "remove_all"))
(invoke "dmsetup" "remove_all")))
(define (installer-root-partition-path) (define (installer-root-partition-path)
"Return the root partition path, or #f if it could not be detected." "Return the root partition path, or #f if it could not be detected."
@ -1115,53 +1114,37 @@ (define (set-user-partitions-file-name user-partitions)
(file-name file-name)))) (file-name file-name))))
user-partitions)) user-partitions))
(define-syntax-rule (with-null-output-ports exp ...)
"Evaluate EXP with both the output port and the error port pointing to the
bit bucket."
(with-output-to-port (%make-void-port "w")
(lambda ()
(with-error-to-port (%make-void-port "w")
(lambda () exp ...)))))
(define (create-btrfs-file-system partition) (define (create-btrfs-file-system partition)
"Create a btrfs file-system for PARTITION file-name." "Create a btrfs file-system for PARTITION file-name."
(with-null-output-ports ((run-command-in-installer) "mkfs.btrfs" "-f" partition))
(invoke "mkfs.btrfs" "-f" partition)))
(define (create-ext4-file-system partition) (define (create-ext4-file-system partition)
"Create an ext4 file-system for PARTITION file-name." "Create an ext4 file-system for PARTITION file-name."
(with-null-output-ports ((run-command-in-installer) "mkfs.ext4" "-F" partition))
(invoke "mkfs.ext4" "-F" partition)))
(define (create-fat16-file-system partition) (define (create-fat16-file-system partition)
"Create a fat16 file-system for PARTITION file-name." "Create a fat16 file-system for PARTITION file-name."
(with-null-output-ports ((run-command-in-installer) "mkfs.fat" "-F16" partition))
(invoke "mkfs.fat" "-F16" partition)))
(define (create-fat32-file-system partition) (define (create-fat32-file-system partition)
"Create a fat32 file-system for PARTITION file-name." "Create a fat32 file-system for PARTITION file-name."
(with-null-output-ports ((run-command-in-installer) "mkfs.fat" "-F32" partition))
(invoke "mkfs.fat" "-F32" partition)))
(define (create-jfs-file-system partition) (define (create-jfs-file-system partition)
"Create a JFS file-system for PARTITION file-name." "Create a JFS file-system for PARTITION file-name."
(with-null-output-ports ((run-command-in-installer) "jfs_mkfs" "-f" partition))
(invoke "jfs_mkfs" "-f" partition)))
(define (create-ntfs-file-system partition) (define (create-ntfs-file-system partition)
"Create a JFS file-system for PARTITION file-name." "Create a JFS file-system for PARTITION file-name."
(with-null-output-ports ((run-command-in-installer) "mkfs.ntfs" "-F" "-f" partition))
(invoke "mkfs.ntfs" "-F" "-f" partition)))
(define (create-xfs-file-system partition) (define (create-xfs-file-system partition)
"Create an XFS file-system for PARTITION file-name." "Create an XFS file-system for PARTITION file-name."
(with-null-output-ports ((run-command-in-installer) "mkfs.xfs" "-f" partition))
(invoke "mkfs.xfs" "-f" partition)))
(define (create-swap-partition partition) (define (create-swap-partition partition)
"Set up swap area on PARTITION file-name." "Set up swap area on PARTITION file-name."
(with-null-output-ports ((run-command-in-installer) "mkswap" "-f" partition))
(invoke "mkswap" "-f" partition)))
(define (call-with-luks-key-file password proc) (define (call-with-luks-key-file password proc)
"Write PASSWORD in a temporary file and pass it to PROC as argument." "Write PASSWORD in a temporary file and pass it to PROC as argument."
@ -1190,15 +1173,16 @@ (define (luks-format-and-open user-partition)
(lambda (key-file) (lambda (key-file)
(installer-log-line "formatting and opening LUKS entry ~s at ~s" (installer-log-line "formatting and opening LUKS entry ~s at ~s"
label file-name) label file-name)
(system* "cryptsetup" "-q" "luksFormat" file-name key-file) ((run-command-in-installer) "cryptsetup" "-q" "luksFormat"
(system* "cryptsetup" "open" "--type" "luks" file-name key-file)
"--key-file" key-file file-name label))))) ((run-command-in-installer) "cryptsetup" "open" "--type" "luks"
"--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."
(let ((label (user-partition-crypt-label user-partition))) (let ((label (user-partition-crypt-label user-partition)))
(installer-log-line "closing LUKS entry ~s" label) (installer-log-line "closing LUKS entry ~s" label)
(system* "cryptsetup" "close" label))) ((run-command-in-installer) "cryptsetup" "close" label)))
(define (format-user-partitions user-partitions) (define (format-user-partitions user-partitions)
"Format the <user-partition> records in USER-PARTITIONS list with "Format the <user-partition> records in USER-PARTITIONS list with