me/guix
Archived
1
0
Fork 0
Code Activity

image: Add partition file-system options support.

Browse source 
* gnu/image.scm (<partition>)[file-system-options]: New field,
(partition-file-system-options): new exported procedure.
* gnu/system/image.scm (partition->gexp): Adapt accordingly.
* gnu/build/image.scm (sexp->partition): Also adapt accordingly,
(make-ext-image): and pass file-system options to mke2fs.
This commit is contained in:
Mathieu Othacehe 2020-05-26 16:25:25 +02:00
parent 6ac7526e48
commit bd3716f6fe
No known key found for this signature in database
GPG key ID: 8354763531769CA6
3 changed files with 28 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
gnu/build/image.scm
View file

@ -47,9 +47,10 @@
"Take SEXP, a tuple as returned by 'partition->gexp', and turn it into a "Take SEXP, a tuple as returned by 'partition->gexp', and turn it into a
<partition> record." <partition> record."
(match sexp (match sexp
((size file-system label uuid) ((size file-system file-system-options label uuid)
(partition (size size) (partition (size size)
(file-system file-system) (file-system file-system)
(file-system-options file-system-options)
(label label) (label label)
(uuid uuid))))) (uuid uuid)))))
@ -71,19 +72,22 @@ take the partition metadata size into account, take a 25% margin."
'make-partition-image'." 'make-partition-image'."
(let ((size (partition-size partition)) (let ((size (partition-size partition))
(fs (partition-file-system partition)) (fs (partition-file-system partition))
(fs-options (partition-file-system-options partition))
(label (partition-label partition)) (label (partition-label partition))
(uuid (partition-uuid partition)) (uuid (partition-uuid partition))
(options "lazy_itable_init=1,lazy_journal_init=1")) (journal-options "lazy_itable_init=1,lazy_journal_init=1"))
(invoke "mke2fs" "-t" fs "-d" root (apply invoke
"-L" label "-U" (uuid->string uuid) `("mke2fs" "-t" ,fs "-d" ,root
"-E" (format #f "root_owner=~a:~a,~a" "-L" ,label "-U" ,(uuid->string uuid)
owner-uid owner-gid options) "-E" ,(format #f "root_owner=~a:~a,~a"
target owner-uid owner-gid journal-options)
(format #f "~ak" ,@fs-options
(size-in-kib ,target
(if (eq? size 'guess) ,(format #f "~ak"
(estimate-partition-size root) (size-in-kib
size)))))) (if (eq? size 'guess)
(estimate-partition-size root)
size)))))))
(define* (make-vfat-image partition target root) (define* (make-vfat-image partition target root)
"Handle the creation of VFAT partition images. See 'make-partition-image'." "Handle the creation of VFAT partition images. See 'make-partition-image'."

19
gnu/image.scm
View file

@ -24,6 +24,7 @@
partition-size partition-size
partition-offset partition-offset
partition-file-system partition-file-system
partition-file-system-options
partition-label partition-label
partition-uuid partition-uuid
partition-flags partition-flags
@ -46,14 +47,16 @@
(define-record-type* <partition> partition make-partition (define-record-type* <partition> partition make-partition
partition? partition?
(device partition-device (default #f)) (device partition-device (default #f))
(size partition-size) (size partition-size)
(offset partition-offset (default 0)) (offset partition-offset (default 0))
(file-system partition-file-system (default "ext4")) (file-system partition-file-system (default "ext4"))
(label partition-label (default #f)) (file-system-options partition-file-system-options
(uuid partition-uuid (default #f)) (default '()))
(flags partition-flags (default '())) (label partition-label (default #f))
(initializer partition-initializer (default #f))) (uuid partition-uuid (default #f))
(flags partition-flags (default '()))
(initializer partition-initializer (default #f)))
;;; ;;;

1
gnu/system/image.scm
View file

@ -117,6 +117,7 @@
'make-partition-image'." 'make-partition-image'."
#~'(#$@(list (partition-size partition)) #~'(#$@(list (partition-size partition))
#$(partition-file-system partition) #$(partition-file-system partition)
#$(partition-file-system-options partition)
#$(partition-label partition) #$(partition-label partition)
#$(and=> (partition-uuid partition) #$(and=> (partition-uuid partition)
uuid-bytevector))) uuid-bytevector)))