02/02: image: Add compression, volatile-root? and substitutable? options.

[guix-commits]

mothacehe pushed a commit to branch wip-disk-image
in repository guix.

commit ec6c1d14b95e6cd9bc8f85efb2e29d0c0341d1dd
Author: Mathieu Othacehe <address@hidden>
AuthorDate: Mon Apr 27 13:51:57 2020 +0200

    image: Add compression, volatile-root? and substitutable? options.
---
 gnu/image.scm        | 13 +++++++++++--
 gnu/system/image.scm |  7 +++++--
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/gnu/image.scm b/gnu/image.scm
index fdada40..e250741 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -34,7 +34,10 @@
             image-format
             image-size
             image-operating-system
-            image-partitions))
+            image-partitions
+            image-compression?
+            image-volatile-root?
+            image-substitutable?))
 
 
 ;;;
@@ -65,4 +68,10 @@
   (operating-system   image-operating-system  ;<operating-system>
                       (default #f))
   (partitions         image-partitions ;list of <partition>
-                      (default '())))
+                      (default '()))
+  (compression?       image-compression? ;boolean
+                      (default #t))
+  (volatile-root?     image-volatile-root? ;boolean
+                      (default #t))
+  (substitutable?     image-substitutable? ;boolean
+                      (default #t)))
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 9c4209d..2978e77 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -288,6 +288,7 @@ image ~a {
 
   (let* ((os (image-operating-system image))
          (bootloader (bootloader-package bootloader))
+         (compression? (image-compression? image))
          (schema (local-file (search-path %load-path
                                           "guix/store/schema.sql")))
          (graph (match inputs
@@ -323,7 +324,7 @@ image ~a {
                                  #$output
                                  #:references-graphs '#$graph
                                  #:register-closures? #$register-closures?
-                                 #:compression? #f
+                                 #:compression? #$compression?
                                  #:volume-id #$root-label
                                  #:volume-uuid #$root-uuid)))))
     (gexp->derivation name builder
@@ -379,12 +380,14 @@ image ~a {
              (string=? (file-system-mount-point fs) "/"))
            (operating-system-file-systems image-os)))
          (root-file-system-type (image->root-file-system image))
+         (substitutable? (image-substitutable? image))
+         (volatile-root? (image-volatile-root? image))
          (os (operating-system
                (inherit image-os)
                (initrd (lambda (file-systems . rest)
                          (apply (operating-system-initrd image-os)
                                 file-systems
-                                #:volatile-root? #t
+                                #:volatile-root? volatile-root?
                                 rest)))
                (bootloader (if (eq? format 'iso9660)
                                (bootloader-configuration