unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Mathieu Othacehe <othacehe@gnu.org>
To: 57643@debbugs.gnu.org
Cc: Mathieu Othacehe <othacehe@gnu.org>
Subject: [bug#57643] [PATCH 1/3] image: Make the operating-system field mandatory.
Date: Wed,  7 Sep 2022 14:46:31 +0200	[thread overview]
Message-ID: <20220907124633.17013-1-othacehe@gnu.org> (raw)
In-Reply-To: <20220907124449.16904-1-othacehe@gnu.org>

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.
---
 gnu/image.scm              |  3 +--
 gnu/system/image.scm       | 41 +++++++++++++++++++++++++++++++++-----
 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 @@ (define-record-type* <image>
   (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 @@ (define-module (gnu system image)
   #:use-module (ice-9 match)
   #:export (root-offset
             root-label
+            image-without-os
 
             esp-partition
             esp32-partition
@@ -102,6 +103,36 @@ (define root-offset (* 512 2048))
 ;; 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 @@ (define root-partition
    (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 @@ (define iso9660-image
            (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 @@ (define hurd-initialize-root-partition
                            #:wal-mode? #f)))))
 
 (define hurd-disk-image
-  (image
+  (image-without-os
    (format 'disk-image)
    (platform hurd)
    (partitions
-- 
2.37.2





  reply	other threads:[~2022-09-07 12:48 UTC|newest]

Thread overview: 22+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-09-07 12:44 [bug#57643] [PATCH 0/3] Document the image API Mathieu Othacehe
2022-09-07 12:46 ` Mathieu Othacehe [this message]
2022-09-07 12:46   ` [bug#57643] [PATCH 2/3] doc: Add a "Platforms" chapter Mathieu Othacehe
2022-09-07 15:37     ` zimoun
2022-09-24  9:55       ` [bug#57643] [PATCH 0/3] Document the image API Ludovic Courtès
2022-09-24 10:10     ` Ludovic Courtès
2022-09-24 10:49       ` Maxime Devos
2022-09-24 13:01         ` Mathieu Othacehe
2022-09-24 16:33         ` Ludovic Courtès
2022-09-24 16:58           ` Maxime Devos
2022-09-25 20:15             ` Ludovic Courtès
2022-09-24 12:50       ` Mathieu Othacehe
2022-09-07 12:46   ` [bug#57643] [PATCH 3/3] doc: Add a "System Images" chapter Mathieu Othacehe
2022-09-07 15:47     ` zimoun
2022-09-24 10:15     ` [bug#57643] [PATCH 0/3] Document the image API Ludovic Courtès
2022-09-07 18:34   ` [bug#57643] [PATCH 1/3] image: Make the operating-system field mandatory Liliana Marie Prikler
2022-09-24 10:16     ` [bug#57643] [PATCH 0/3] Document the image API Ludovic Courtès
2022-09-24 10:55   ` [bug#57643] [PATCH 1/3] image: Make the operating-system field mandatory Maxime Devos
2022-09-24 13:02     ` Mathieu Othacehe
2022-09-24 10:18 ` [bug#57643] [PATCH 0/3] Document the image API Ludovic Courtès
2022-09-24 12:59   ` Mathieu Othacehe
2022-09-25 11:53   ` bug#57643: " Mathieu Othacehe

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20220907124633.17013-1-othacehe@gnu.org \
    --to=othacehe@gnu.org \
    --cc=57643@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).