image: Add bootable flag support.

* gnu/build/image.scm (sexp->partition): Add flags support.
* gnu/system/image.scm (partition->gexp): Ditto.
(system-disk-image): Set the genimage bootable flag if it is part of the
partition flags.

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
This commit is contained in:
Pavel Shlyak 2022-05-22 16:53:49 +03:00 committed by Mathieu Othacehe
parent 6e99c020b8
commit bb662d71e6
No known key found for this signature in database
GPG key ID: 8354763531769CA6
2 changed files with 13 additions and 5 deletions

View file

@ -5,6 +5,7 @@
;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com> ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;; Copyright © 2020, 2022 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2020, 2022 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2022 Pavel Shlyak <p.shlyak@pantherx.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -48,12 +49,13 @@ (define (sexp->partition sexp)
"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 file-system-options label uuid) ((size file-system file-system-options label uuid flags)
(partition (size size) (partition (size size)
(file-system file-system) (file-system file-system)
(file-system-options file-system-options) (file-system-options file-system-options)
(label label) (label label)
(uuid uuid))))) (uuid uuid)
(flags flags)))))
(define (size-in-kib size) (define (size-in-kib size)
"Convert SIZE expressed in bytes, to kilobytes and return it as a string." "Convert SIZE expressed in bytes, to kilobytes and return it as a string."
@ -78,6 +80,7 @@ (define* (make-ext-image partition target root
(fs-options (partition-file-system-options partition)) (fs-options (partition-file-system-options partition))
(label (partition-label partition)) (label (partition-label partition))
(uuid (partition-uuid partition)) (uuid (partition-uuid partition))
(flags (partition-flags partition))
(journal-options "lazy_itable_init=1,lazy_journal_init=1")) (journal-options "lazy_itable_init=1,lazy_journal_init=1"))
(apply invoke (apply invoke
`("fakeroot" "mke2fs" "-t" ,fs "-d" ,root `("fakeroot" "mke2fs" "-t" ,fs "-d" ,root

View file

@ -219,7 +219,8 @@ (define (partition->gexp partition)
#$(partition-file-system-options partition) #$(partition-file-system-options partition)
#$(partition-label partition) #$(partition-label partition)
#$(and=> (partition-uuid partition) #$(and=> (partition-uuid partition)
uuid-bytevector))) uuid-bytevector)
#$(partition-flags partition)))
(define gcrypt-sqlite3&co (define gcrypt-sqlite3&co
;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs. ;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs.
@ -401,17 +402,21 @@ (define (partition->config image partition)
(partition-type-values image partition))) (partition-type-values image partition)))
(let ((label (partition-label partition)) (let ((label (partition-label partition))
(image (partition-image partition)) (image (partition-image partition))
(offset (partition-offset partition))) (offset (partition-offset partition))
(bootable (if (memq 'boot (partition-flags partition))
"true" "false" )))
#~(format #f "~/partition ~a { #~(format #f "~/partition ~a {
~/~/~a = ~a ~/~/~a = ~a
~/~/image = \"~a\" ~/~/image = \"~a\"
~/~/offset = \"~a\" ~/~/offset = \"~a\"
~/~/bootable = \"~a\"
~/}" ~/}"
#$label #$label
#$partition-type-attribute #$partition-type-attribute
#$partition-type-value #$partition-type-value
#$image #$image
#$offset)))) #$offset
#$bootable))))
(define (genimage-type-options image-type image) (define (genimage-type-options image-type image)
(cond (cond