diff options
author | Mathieu Othacehe <othacehe@gnu.org> | 2022-09-05 18:12:22 +0200 |
---|---|---|
committer | Mathieu Othacehe <othacehe@gnu.org> | 2022-09-11 13:57:21 +0200 |
commit | 6c79ca53d64df90ab17bd700aac89c3f8dff4a15 (patch) | |
tree | 5e29073a66f972738fe34b5fb5fdaa5057a70962 | |
parent | f760e628fb923a4e968bae6d38be870d6a4b668e (diff) | |
download | guix-6c79ca53d64df90ab17bd700aac89c3f8dff4a15.tar.gz |
image: Make the operating-system field mandatory.
Make the operating-system field mandatory as creating an image without it makes no sense. Introduce a new macro, image-without-os for the specific cases where the image is only created to be inherited from afterwards. * gnu/image.scm (<image>)[operating-system]: Make it mandatory. * gnu/system/image.scm (image-without-os): New macro. (efi-disk-image, efi32-disk-image, iso9660-image, docker-image, raw-with-offset-disk-image): Use it. * gnu/system/images/hurd.scm (hurd-disk-image): Ditto.
-rw-r--r-- | gnu/image.scm | 3 | ||||
-rw-r--r-- | gnu/system/image.scm | 41 | ||||
-rw-r--r-- | gnu/system/images/hurd.scm | 2 |
3 files changed, 38 insertions, 8 deletions
diff --git a/gnu/image.scm b/gnu/image.scm index 4a0068934e..68784deb12 100644 --- a/gnu/image.scm +++ b/gnu/image.scm @@ -170,8 +170,7 @@ that is not in SET, mentioning FIELD in the error message." (size image-size ;size in bytes as integer (default 'guess) (sanitize validate-size)) - (operating-system image-operating-system ;<operating-system> - (default #f)) + (operating-system image-operating-system) ;<operating-system> (partition-table-type image-partition-table-type ; 'mbr or 'gpt (default 'mbr) (sanitize validate-partition-table-type)) diff --git a/gnu/system/image.scm b/gnu/system/image.scm index a04363a130..709c3ab6ff 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -65,6 +65,7 @@ #:use-module (ice-9 match) #:export (root-offset root-label + image-without-os esp-partition esp32-partition @@ -102,6 +103,36 @@ ;; Generic root partition label. (define root-label "Guix_image") +(define-syntax image-without-os + (lambda (x) + "Return an image record with the mandatory operating-system field set to +#false. This is useful when creating an image record that will serve as a +parent image record." + + (define (maybe-cons field acc) + ;; Return the given ACC list if FIELD is 'operating-system or the + ;; concatenation of FIELD to ACC otherwise. + (syntax-case field () + ((f v) + (if (eq? (syntax->datum #'f) 'operating-system) + acc + (cons field acc))))) + + (syntax-case x (image) + ;; Remove the operating-system field from the defined fields and then + ;; force it to #false. + ((_ fields ...) + (let loop ((fields #'(fields ...)) + (acc '())) + (syntax-case fields () + ((last) + #`(image + ;; Force it to #false. + (operating-system #false) + #,@(maybe-cons #'last acc))) + ((field rest ...) + (loop #'(rest ...) (maybe-cons #'field acc))))))))) + (define esp-partition (partition (size (* 40 (expt 2 20))) @@ -127,17 +158,17 @@ (initializer (gexp initialize-root-partition)))) (define efi-disk-image - (image + (image-without-os (format 'disk-image) (partitions (list esp-partition root-partition)))) (define efi32-disk-image - (image + (image-without-os (format 'disk-image) (partitions (list esp32-partition root-partition)))) (define iso9660-image - (image + (image-without-os (format 'iso9660) (partitions (list (partition @@ -146,11 +177,11 @@ (flags '(boot))))))) (define docker-image - (image + (image-without-os (format 'docker))) (define* (raw-with-offset-disk-image #:optional (offset root-offset)) - (image + (image-without-os (format 'disk-image) (partitions (list (partition diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm index 6da09b855a..2c64117c08 100644 --- a/gnu/system/images/hurd.scm +++ b/gnu/system/images/hurd.scm @@ -74,7 +74,7 @@ #:wal-mode? #f))))) (define hurd-disk-image - (image + (image-without-os (format 'disk-image) (platform hurd) (partitions |