vm: 'qemu-image' can pass options to the 'mkfs' command.
* gnu/build/vm.scm (<partition>)[file-system-options]: New field. (create-ext-file-system, create-fat-file-system) (format-partition): Add #:options and honor it. (initialize-partition): Pass #:options to 'format-partition'. * gnu/system/vm.scm (qemu-image): Add #:file-system-options and use it for the root partition.
This commit is contained in:
parent
82782d8cec
commit
4d1ff68d73
2 changed files with 19 additions and 10 deletions
|
@ -234,6 +234,8 @@ deduplicates files common to CLOSURE and the rest of PREFIX."
|
||||||
(device partition-device (default #f))
|
(device partition-device (default #f))
|
||||||
(size partition-size)
|
(size partition-size)
|
||||||
(file-system partition-file-system (default "ext4"))
|
(file-system partition-file-system (default "ext4"))
|
||||||
|
(file-system-options partition-file-system-options ;passed to 'mkfs.FS'
|
||||||
|
(default '()))
|
||||||
(label partition-label (default #f))
|
(label partition-label (default #f))
|
||||||
(uuid partition-uuid (default #f))
|
(uuid partition-uuid (default #f))
|
||||||
(flags partition-flags (default '()))
|
(flags partition-flags (default '()))
|
||||||
|
@ -308,7 +310,7 @@ actual /dev name based on DEVICE."
|
||||||
(define MS_BIND 4096) ; <sys/mounts.h> again!
|
(define MS_BIND 4096) ; <sys/mounts.h> again!
|
||||||
|
|
||||||
(define* (create-ext-file-system partition type
|
(define* (create-ext-file-system partition type
|
||||||
#:key label uuid)
|
#:key label uuid (options '()))
|
||||||
"Create an ext-family file system of TYPE on PARTITION. If LABEL is true,
|
"Create an ext-family file system of TYPE on PARTITION. If LABEL is true,
|
||||||
use that as the volume name. If UUID is true, use it as the partition UUID."
|
use that as the volume name. If UUID is true, use it as the partition UUID."
|
||||||
(format #t "creating ~a partition... ~@[label: ~s~] ~@[uuid: ~s~]\n"
|
(format #t "creating ~a partition... ~@[label: ~s~] ~@[uuid: ~s~]\n"
|
||||||
|
@ -320,26 +322,29 @@ use that as the volume name. If UUID is true, use it as the partition UUID."
|
||||||
'())
|
'())
|
||||||
,@(if uuid
|
,@(if uuid
|
||||||
`("-U" ,(uuid->string uuid))
|
`("-U" ,(uuid->string uuid))
|
||||||
'()))))
|
'())
|
||||||
|
,@options)))
|
||||||
|
|
||||||
(define* (create-fat-file-system partition
|
(define* (create-fat-file-system partition
|
||||||
#:key label uuid)
|
#:key label uuid (options '()))
|
||||||
"Create a FAT file system on PARTITION. The number of File Allocation Tables
|
"Create a FAT file system on PARTITION. The number of File Allocation Tables
|
||||||
will be determined based on file system size. If LABEL is true, use that as the
|
will be determined based on file system size. If LABEL is true, use that as the
|
||||||
volume name."
|
volume name."
|
||||||
;; FIXME: UUID is ignored!
|
;; FIXME: UUID is ignored!
|
||||||
(format #t "creating FAT partition...\n")
|
(format #t "creating FAT partition...\n")
|
||||||
(apply invoke "mkfs.fat" partition
|
(apply invoke "mkfs.fat" partition
|
||||||
(if label `("-n" ,label) '())))
|
(append (if label `("-n" ,label) '()) options)))
|
||||||
|
|
||||||
(define* (format-partition partition type
|
(define* (format-partition partition type
|
||||||
#:key label uuid)
|
#:key label uuid (options '()))
|
||||||
"Create a file system TYPE on PARTITION. If LABEL is true, use that as the
|
"Create a file system TYPE on PARTITION. If LABEL is true, use that as the
|
||||||
volume name."
|
volume name. Options is a list of command-line options passed to 'mkfs.FS'."
|
||||||
(cond ((string-prefix? "ext" type)
|
(cond ((string-prefix? "ext" type)
|
||||||
(create-ext-file-system partition type #:label label #:uuid uuid))
|
(create-ext-file-system partition type #:label label #:uuid uuid
|
||||||
|
#:options options))
|
||||||
((or (string-prefix? "fat" type) (string= "vfat" type))
|
((or (string-prefix? "fat" type) (string= "vfat" type))
|
||||||
(create-fat-file-system partition #:label label #:uuid uuid))
|
(create-fat-file-system partition #:label label #:uuid uuid
|
||||||
|
#:options options))
|
||||||
(else (error "Unsupported file system."))))
|
(else (error "Unsupported file system."))))
|
||||||
|
|
||||||
(define (initialize-partition partition)
|
(define (initialize-partition partition)
|
||||||
|
@ -349,7 +354,8 @@ it, run its initializer, and unmount it."
|
||||||
(format-partition (partition-device partition)
|
(format-partition (partition-device partition)
|
||||||
(partition-file-system partition)
|
(partition-file-system partition)
|
||||||
#:label (partition-label partition)
|
#:label (partition-label partition)
|
||||||
#:uuid (partition-uuid partition))
|
#:uuid (partition-uuid partition)
|
||||||
|
#:options (partition-file-system-options partition))
|
||||||
(mkdir-p target)
|
(mkdir-p target)
|
||||||
(mount (partition-device partition) target
|
(mount (partition-device partition) target
|
||||||
(partition-file-system partition))
|
(partition-file-system partition))
|
||||||
|
|
|
@ -368,6 +368,7 @@ INPUTS is a list of inputs (as for packages)."
|
||||||
(disk-image-size 'guess)
|
(disk-image-size 'guess)
|
||||||
(disk-image-format "qcow2")
|
(disk-image-format "qcow2")
|
||||||
(file-system-type "ext4")
|
(file-system-type "ext4")
|
||||||
|
(file-system-options '())
|
||||||
(extra-directives '())
|
(extra-directives '())
|
||||||
file-system-label
|
file-system-label
|
||||||
file-system-uuid
|
file-system-uuid
|
||||||
|
@ -382,7 +383,8 @@ INPUTS is a list of inputs (as for packages)."
|
||||||
'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE.
|
'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE.
|
||||||
Optionally, FILE-SYSTEM-LABEL can be specified as the volume name for the root
|
Optionally, FILE-SYSTEM-LABEL can be specified as the volume name for the root
|
||||||
partition; likewise FILE-SYSTEM-UUID, if true, specifies the UUID of the root
|
partition; likewise FILE-SYSTEM-UUID, if true, specifies the UUID of the root
|
||||||
partition (a UUID object).
|
partition (a UUID object). FILE-SYSTEM-OPTIONS is an optional list of
|
||||||
|
command-line options passed to 'mkfs.ext4' (or similar).
|
||||||
|
|
||||||
The returned image is a full disk image that runs OS-DERIVATION,
|
The returned image is a full disk image that runs OS-DERIVATION,
|
||||||
with a GRUB installation that uses GRUB-CONFIGURATION as its configuration
|
with a GRUB installation that uses GRUB-CONFIGURATION as its configuration
|
||||||
|
@ -472,6 +474,7 @@ system that is passed to 'populate-root-file-system'."
|
||||||
(uuid #$(and=> file-system-uuid
|
(uuid #$(and=> file-system-uuid
|
||||||
uuid-bytevector))
|
uuid-bytevector))
|
||||||
(file-system #$file-system-type)
|
(file-system #$file-system-type)
|
||||||
|
(file-system-options '#$file-system-options)
|
||||||
(flags '(boot))
|
(flags '(boot))
|
||||||
(initializer initialize)))
|
(initializer initialize)))
|
||||||
;; Append a small EFI System Partition for use with UEFI
|
;; Append a small EFI System Partition for use with UEFI
|
||||||
|
|
Reference in a new issue