ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

image: Support generating GPT images via partition-table-type.

Browse source 
* gnu/image.scm (<image>)[partition-table-type]: New field.
* gnu/system/image.scm: Implement partition-table-type logic for
genimage.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
This commit is contained in:
Ryan Sundberg 2021-11-04 01:35:11 -07:00 committed by Mathieu Othacehe
parent 39754503e8
commit 096a2bf8c5
No known key found for this signature in database
GPG key ID: 8354763531769CA6
2 changed files with 47 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
gnu/image.scm
View file

@ -38,6 +38,7 @@ (define-module (gnu image)
image-platform
image-size
image-operating-system
image-partition-table-type
image-partitions
image-compression?
image-volatile-root?
@ -86,6 +87,8 @@ (define-record-type* <image>
(default 'guess))
(operating-system image-operating-system ;<operating-system>
(default #f))
(partition-table-type image-partition-table-type ; 'mbr or 'gpt
(default 'mbr))
(partitions image-partitions ;list of <partition>
(default '()))
(compression? image-compression? ;boolean

61
gnu/system/image.scm
View file

@ -298,6 +298,14 @@ (define (partition->dos-type partition)
((member 'esp flags) "0xEF")
(else "0x83"))))
(define (partition->gpt-type partition)
;; Return the genimage GPT partition type code corresponding to PARTITION.
;; See https://github.com/pengutronix/genimage/blob/master/README.rst
(let ((flags (partition-flags partition)))
(cond
((member 'esp flags) "U")
(else "L"))))
(define (partition-image partition)
;; Return as a file-like object, an image of the given PARTITION. A
;; directory, filled by calling the PARTITION initializer procedure, is
@ -347,26 +355,44 @@ (define (partition-image partition)
#:local-build? #f
#:options `(#:references-graphs ,inputs))))
(define (partition->config partition)
(define (gpt-image? image)
(eq? 'gpt (image-partition-table-type image)))
(define (partition-type-values image partition)
(if (gpt-image? image)
(values "partition-type-uuid" (partition->gpt-type partition))
(values "partition-type" (partition->dos-type partition))))
(define (partition->config image partition)
;; Return the genimage partition configuration for PARTITION.
(let ((label (partition-label partition))
(dos-type (partition->dos-type partition))
(image (partition-image partition))
(offset (partition-offset partition)))
#~(format #f "~/partition ~a {
~/~/partition-type = ~a
~/~/image = \"~a\"
~/~/offset = \"~a\"
~/}"
#$label
#$dos-type
#$image
#$offset)))
(let-values (((partition-type-attribute partition-type-value)
(partition-type-values image partition)))
(let ((label (partition-label partition))
(image (partition-image partition))
(offset (partition-offset partition)))
#~(format #f "~/partition ~a {
~/~/~a = ~a
~/~/image = \"~a\"
~/~/offset = \"~a\"
~/}"
#$label
#$partition-type-attribute
#$partition-type-value
#$image
#$offset))))
(define (genimage-type-options image-type image)
(cond
((equal? image-type "hdimage")
(format #f "~%~/~/gpt = ~a~%~/"
(if (gpt-image? image) "true" "false")))
(else "")))
(let* ((format (image-format image))
(image-type (format->image-type format))
(image-type-options (genimage-type-options image-type image))
(partitions (image-partitions image))
(partitions-config (map partition->config partitions))
(partitions-config (map (cut partition->config image <>) partitions))
(builder
#~(begin
(let ((format (@ (ice-9 format) format)))
@ -375,9 +401,10 @@ (define (partition->config partition)
(format port
"\
image ~a {
~/~a {}
~/~a {~a}
~{~a~^~%~}
}~%" #$genimage-name #$image-type (list #$@partitions-config))))))))
}~%" #$genimage-name #$image-type #$image-type-options
(list #$@partitions-config))))))))
(computed-file "genimage.cfg" builder)))
(let* ((image-name (image-name image))