Package: guix-patches;
Reported by: Mathieu Othacehe <othacehe <at> gnu.org>
Date: Thu, 21 Jan 2021 11:39:02 UTC
Severity: normal
Tags: patch
Done: Mathieu Othacehe <mathieu <at> cervin.i-did-not-set--mail-host-address--so-tickle-me>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 46017 in the body.
You can then email your comments to 46017 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#46017; Package guix-patches.
(Thu, 21 Jan 2021 11:39:02 GMT) Full text and rfc822 format available.Mathieu Othacehe <othacehe <at> gnu.org>:guix-patches <at> gnu.org.
(Thu, 21 Jan 2021 11:39:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <othacehe <at> gnu.org> To: guix-patches <at> gnu.org Cc: Mathieu Othacehe <othacehe <at> gnu.org> Subject: [PATCH 0/2] scripts: system: Accept <image> records as input. Date: Thu, 21 Jan 2021 12:37:51 +0100
Hello, Here is a patch adding support for <image> records as input of "guix system image" command. This has been discussed here: https://issues.guix.gnu.org/45933. It would be nice to also provide some documentation about that feature. I have delayed it because I felt the API was not stable enough. Maybe now is the time. Joshua is proposing a Cookbook patch that could be a first step. Then, I'll try to provide a proper description of the <image> record and the associated commands in the documentation. Thanks, Mathieu Mathieu Othacehe (2): image: Export image? procedure. scripts: system: Accept <image> records as input. gnu/image.scm | 1 + gnu/system/images/hurd.scm | 3 + gnu/system/images/novena.scm | 3 + gnu/system/images/pine64.scm | 3 + gnu/system/images/pinebook-pro.scm | 3 + guix/scripts/system.scm | 128 ++++++++++++++--------------- tests/guix-system.sh | 7 +- 7 files changed, 80 insertions(+), 68 deletions(-) -- 2.29.2
guix-patches <at> gnu.org:bug#46017; Package guix-patches.
(Thu, 21 Jan 2021 11:44:01 GMT) Full text and rfc822 format available.Message #8 received at 46017 <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <othacehe <at> gnu.org> To: 46017 <at> debbugs.gnu.org Cc: Mathieu Othacehe <othacehe <at> gnu.org> Subject: [PATCH 1/2] image: Export image? procedure. Date: Thu, 21 Jan 2021 12:42:59 +0100
* gnu/image.scm (image?): Export it.
---
gnu/image.scm | 1 +
1 file changed, 1 insertion(+)
diff --git a/gnu/image.scm b/gnu/image.scm
index a60d83b175..75d489490d 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -31,6 +31,7 @@
partition-initializer
image
+ image?
image-name
image-format
image-target
--
2.29.2
guix-patches <at> gnu.org:bug#46017; Package guix-patches.
(Thu, 21 Jan 2021 11:44:02 GMT) Full text and rfc822 format available.Message #11 received at 46017 <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <othacehe <at> gnu.org> To: 46017 <at> debbugs.gnu.org Cc: Mathieu Othacehe <othacehe <at> gnu.org> Subject: [PATCH 2/2] scripts: system: Accept <image> records as input. Date: Thu, 21 Jan 2021 12:43:00 +0100
* guix/scripts/system.scm (system-derivation-for-action): Replace "os"
argument by "image". Remove "image-type", "label" and "volatile-root?"
arguments.
(perform-action): Ditto.
(process-action): Construct the <image> record and pass it to "perform-action"
procedure.
* tests/guix-system.sh: Adapt accordingly.
* gnu/system/images/hurd.scm: Return the default image.
* gnu/system/images/novena.scm: Ditto.
* gnu/system/images/pine64.scm: Ditto.
* gnu/system/images/pinebook-pro.scm Ditto.
---
gnu/system/images/hurd.scm | 3 +
gnu/system/images/novena.scm | 3 +
gnu/system/images/pine64.scm | 3 +
gnu/system/images/pinebook-pro.scm | 3 +
guix/scripts/system.scm | 128 ++++++++++++++---------------
tests/guix-system.sh | 7 +-
6 files changed, 79 insertions(+), 68 deletions(-)
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 4417952c5d..eac5b7f7e6 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -111,3 +111,6 @@
(inherit
(os->image hurd-barebones-os #:type hurd-qcow2-image-type))
(name 'hurd-barebones.qcow2)))
+
+;; Return the default image.
+hurd-barebones-qcow2-image
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index dfaf2c60ee..1cd724ff88 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -59,3 +59,6 @@
(inherit
(os->image novena-barebones-os #:type novena-image-type))
(name 'novena-barebones-raw-image)))
+
+;; Return the default image.
+novena-barebones-raw-image
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index 63b31399a5..613acd5cfd 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -64,3 +64,6 @@
(inherit
(os->image pine64-barebones-os #:type pine64-image-type))
(name 'pine64-barebones-raw-image)))
+
+;; Return the default image.
+pine64-barebones-raw-image
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index 22997fd742..b56a7ea409 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -66,3 +66,6 @@
(inherit
(os->image pinebook-pro-barebones-os #:type pinebook-pro-image-type))
(name 'pinebook-pro-barebones-raw-image)))
+
+;; Return the default image.
+pinebook-pro-barebones-raw-image
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 9b75ac2fd0..ae904b3fd6 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -680,13 +680,14 @@ checking this by themselves in their 'check' procedure."
;;; Action.
;;;
-(define* (system-derivation-for-action os action
- #:key image-size image-type
- full-boot? container-shared-network?
- mappings label
- volatile-root?)
- "Return as a monadic value the derivation for OS according to ACTION."
- (mlet %store-monad ((target (current-target-system)))
+(define* (system-derivation-for-action image action
+ #:key
+ image-size full-boot?
+ container-shared-network?
+ mappings)
+ "Return as a monadic value the derivation for IMAGE according to ACTION."
+ (mlet %store-monad ((target (current-target-system))
+ (os -> (image-operating-system image)))
(case action
((build init reconfigure)
(operating-system-derivation os))
@@ -704,25 +705,11 @@ checking this by themselves in their 'check' procedure."
(* 70 (expt 2 20)))
#:mappings mappings))
((image disk-image vm-image)
- (let* ((image-type (if (eq? action 'vm-image)
- qcow2-image-type
- image-type))
- (base-image (os->image os #:type image-type))
- (base-target (image-target base-image)))
- (when (eq? action 'disk-image)
- (warning (G_ "'disk-image' is deprecated: use 'image' instead~%")))
- (when (eq? action 'vm-image)
- (warning (G_ "'vm-image' is deprecated: use 'image' instead~%")))
- (lower-object
- (system-image
- (image
- (inherit (if label
- (image-with-label base-image label)
- base-image))
- (target (or base-target target))
- (size image-size)
- (operating-system os)
- (volatile-root? volatile-root?))))))
+ (when (eq? action 'disk-image)
+ (warning (G_ "'disk-image' is deprecated: use 'image' instead~%")))
+ (when (eq? action 'vm-image)
+ (warning (G_ "'vm-image' is deprecated: use 'image' instead~%")))
+ (lower-object (system-image image)))
((docker-image)
(system-docker-image os
#:shared-network? container-shared-network?)))))
@@ -768,7 +755,7 @@ and TARGET arguments."
(set! %load-compiled-path (lowered-gexp-load-compiled-path lowered))
(return (primitive-eval (lowered-gexp-sexp lowered))))))
-(define* (perform-action action os
+(define* (perform-action action image
#:key
(validate-reconfigure ensure-forward-reconfigure)
save-provenance?
@@ -776,16 +763,14 @@ and TARGET arguments."
install-bootloader?
dry-run? derivations-only?
use-substitutes? bootloader-target target
- image-size image-type
- volatile-root?
- full-boot? label container-shared-network?
+ image-size full-boot?
+ container-shared-network?
(mappings '())
(gc-root #f))
- "Perform ACTION for OS. INSTALL-BOOTLOADER? specifies whether to install
+ "Perform ACTION for IMAGE. INSTALL-BOOTLOADER? specifies whether to install
bootloader; BOOTLOADER-TAGET is the target for the bootloader; TARGET is the
target root directory; IMAGE-SIZE is the size of the image to be built, for
-the 'image' action. IMAGE-TYPE is the type of image to be built. When
-VOLATILE-ROOT? is #t, the root file system is mounted volatile.
+the 'image' action.
FULL-BOOT? is used for the 'vm' action; it determines whether to
boot directly to the kernel or to the bootloader. CONTAINER-SHARED-NETWORK?
@@ -807,6 +792,9 @@ static checks."
'()
(map boot-parameters->menu-entry (profile-boot-parameters))))
+ (define os
+ (image-operating-system image))
+
(define bootloader
(operating-system-bootloader os))
@@ -829,11 +817,8 @@ static checks."
(check-initrd-modules os)))
(mlet* %store-monad
- ((sys (system-derivation-for-action os action
- #:label label
- #:image-type image-type
+ ((sys (system-derivation-for-action image action
#:image-size image-size
- #:volatile-root? volatile-root?
#:full-boot? full-boot?
#:container-shared-network? container-shared-network?
#:mappings mappings))
@@ -1168,9 +1153,9 @@ Some ACTIONS support additional ARGS.\n"))
ACTION must be one of the sub-commands that takes an operating system
declaration as an argument (a file name.) OPTS is the raw alist of options
resulting from command-line parsing."
- (define (ensure-operating-system file-or-exp obj)
- (unless (operating-system? obj)
- (leave (G_ "'~a' does not return an operating system~%")
+ (define (ensure-operating-system-or-image file-or-exp obj)
+ (unless (or (operating-system? obj) (image? obj))
+ (leave (G_ "'~a' does not return an operating system or an image~%")
file-or-exp))
obj)
@@ -1184,27 +1169,47 @@ resulting from command-line parsing."
(expr (assoc-ref opts 'expression))
(system (assoc-ref opts 'system))
(target (assoc-ref opts 'target))
- (transform (if save-provenance?
- (cut operating-system-with-provenance <> file)
- identity))
- (os (transform
- (ensure-operating-system
- (or file expr)
- (cond
- ((and expr file)
- (leave
- (G_ "both file and expression cannot be specified~%")))
- (expr
- (read/eval expr))
- (file
- (load* file %user-module
- #:on-error (assoc-ref opts 'on-error)))
- (else
- (leave (G_ "no configuration specified~%")))))))
-
+ (transform (lambda (obj)
+ (if (and save-provenance? (operating-system? obj))
+ (operating-system-with-provenance obj file)
+ obj)))
+ (obj (transform
+ (ensure-operating-system-or-image
+ (or file expr)
+ (cond
+ ((and expr file)
+ (leave
+ (G_ "both file and expression cannot be specified~%")))
+ (expr
+ (read/eval expr))
+ (file
+ (load* file %user-module
+ #:on-error (assoc-ref opts 'on-error)))
+ (else
+ (leave (G_ "no configuration specified~%")))))))
(dry? (assoc-ref opts 'dry-run?))
(bootloader? (assoc-ref opts 'install-bootloader?))
(label (assoc-ref opts 'label))
+ (image-type (lookup-image-type-by-name
+ (assoc-ref opts 'image-type)))
+ (image (let* ((image-type (if (eq? action 'vm-image)
+ qcow2-image-type
+ image-type))
+ (image-size (assoc-ref opts 'image-size))
+ (volatile? (assoc-ref opts 'volatile-root?))
+ (base-image (if (operating-system? obj)
+ (os->image obj
+ #:type image-type)
+ obj))
+ (base-target (image-target base-image)))
+ (image
+ (inherit (if label
+ (image-with-label base-image label)
+ base-image))
+ (target (or base-target target))
+ (size image-size)
+ (volatile-root? volatile?))))
+ (os (image-operating-system image))
(target-file (match args
((first second) second)
(_ #f)))
@@ -1240,7 +1245,7 @@ resulting from command-line parsing."
(warn-about-old-distro #:suggested-command
"guix system reconfigure"))
- (perform-action action os
+ (perform-action action image
#:dry-run? dry?
#:derivations-only? (assoc-ref opts
'derivations-only?)
@@ -1249,11 +1254,7 @@ resulting from command-line parsing."
(assoc-ref opts 'skip-safety-checks?)
#:validate-reconfigure
(assoc-ref opts 'validate-reconfigure)
- #:image-type (lookup-image-type-by-name
- (assoc-ref opts 'image-type))
#:image-size (assoc-ref opts 'image-size)
- #:volatile-root?
- (assoc-ref opts 'volatile-root?)
#:full-boot? (assoc-ref opts 'full-boot?)
#:container-shared-network?
(assoc-ref opts 'container-shared-network?)
@@ -1263,7 +1264,6 @@ resulting from command-line parsing."
(_ #f))
opts)
#:install-bootloader? bootloader?
- #:label label
#:target target-file
#:bootloader-target bootloader-target
#:gc-root (assoc-ref opts 'gc-root)))))
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index ddbdd0edcd..ce4030bc59 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -333,12 +333,11 @@ for example in gnu/system/examples/*.tmpl; do
guix system -n disk-image $target "$example"
done
-# Verify that the disk image types can be built.
+# Verify that the images can be built.
guix system -n vm gnu/system/examples/vm-image.tmpl
+guix system -n image gnu/system/images/pinebook-pro.scm
guix system -n image -t qcow2 gnu/system/examples/vm-image.tmpl
-# This invocation was taken care of in the loop above:
-# guix system -n disk-image gnu/system/examples/bare-bones.tmpl
-guix system -n disk-image -t iso9660 gnu/system/examples/bare-bones.tmpl
+guix system -n image -t iso9660 gnu/system/examples/bare-bones.tmpl
guix system -n docker-image gnu/system/examples/docker-image.tmpl
# Verify that at least the raw image type is available.
--
2.29.2
guix-patches <at> gnu.org:bug#46017; Package guix-patches.
(Thu, 21 Jan 2021 11:53:01 GMT) Full text and rfc822 format available.Message #14 received at 46017 <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <othacehe <at> gnu.org> To: 46017 <at> debbugs.gnu.org Cc: Mathieu Othacehe <othacehe <at> gnu.org> Subject: [PATCH v2] scripts: system: Accept <image> records as input. Date: Thu, 21 Jan 2021 12:52:24 +0100
* guix/scripts/system.scm (system-derivation-for-action): Replace "os"
argument by "image". Remove "image-size", "image-type", "label" and
"volatile-root?" arguments.
(perform-action): Ditto.
(process-action): Construct the <image> record and pass it to "perform-action"
procedure.
* tests/guix-system.sh: Adapt accordingly.
* gnu/system/images/hurd.scm: Return the default image.
* gnu/system/images/novena.scm: Ditto.
* gnu/system/images/pine64.scm: Ditto.
* gnu/system/images/pinebook-pro.scm Ditto.
---
Hello,
Here's a v2 that's also removing the "image-size" argument.
Thanks,
Mathieu
gnu/system/images/hurd.scm | 3 +
gnu/system/images/novena.scm | 3 +
gnu/system/images/pine64.scm | 3 +
gnu/system/images/pinebook-pro.scm | 3 +
guix/scripts/system.scm | 132 ++++++++++++++---------------
tests/guix-system.sh | 7 +-
6 files changed, 80 insertions(+), 71 deletions(-)
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 4417952c5d..eac5b7f7e6 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -111,3 +111,6 @@
(inherit
(os->image hurd-barebones-os #:type hurd-qcow2-image-type))
(name 'hurd-barebones.qcow2)))
+
+;; Return the default image.
+hurd-barebones-qcow2-image
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index dfaf2c60ee..1cd724ff88 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -59,3 +59,6 @@
(inherit
(os->image novena-barebones-os #:type novena-image-type))
(name 'novena-barebones-raw-image)))
+
+;; Return the default image.
+novena-barebones-raw-image
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index 63b31399a5..613acd5cfd 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -64,3 +64,6 @@
(inherit
(os->image pine64-barebones-os #:type pine64-image-type))
(name 'pine64-barebones-raw-image)))
+
+;; Return the default image.
+pine64-barebones-raw-image
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index 22997fd742..b56a7ea409 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -66,3 +66,6 @@
(inherit
(os->image pinebook-pro-barebones-os #:type pinebook-pro-image-type))
(name 'pinebook-pro-barebones-raw-image)))
+
+;; Return the default image.
+pinebook-pro-barebones-raw-image
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 9b75ac2fd0..f4743c64ea 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -680,13 +680,15 @@ checking this by themselves in their 'check' procedure."
;;; Action.
;;;
-(define* (system-derivation-for-action os action
- #:key image-size image-type
- full-boot? container-shared-network?
- mappings label
- volatile-root?)
- "Return as a monadic value the derivation for OS according to ACTION."
- (mlet %store-monad ((target (current-target-system)))
+(define* (system-derivation-for-action image action
+ #:key
+ full-boot?
+ container-shared-network?
+ mappings)
+ "Return as a monadic value the derivation for IMAGE according to ACTION."
+ (mlet %store-monad ((target (current-target-system))
+ (os -> (image-operating-system image))
+ (image-size -> (image-size image)))
(case action
((build init reconfigure)
(operating-system-derivation os))
@@ -704,25 +706,11 @@ checking this by themselves in their 'check' procedure."
(* 70 (expt 2 20)))
#:mappings mappings))
((image disk-image vm-image)
- (let* ((image-type (if (eq? action 'vm-image)
- qcow2-image-type
- image-type))
- (base-image (os->image os #:type image-type))
- (base-target (image-target base-image)))
- (when (eq? action 'disk-image)
- (warning (G_ "'disk-image' is deprecated: use 'image' instead~%")))
- (when (eq? action 'vm-image)
- (warning (G_ "'vm-image' is deprecated: use 'image' instead~%")))
- (lower-object
- (system-image
- (image
- (inherit (if label
- (image-with-label base-image label)
- base-image))
- (target (or base-target target))
- (size image-size)
- (operating-system os)
- (volatile-root? volatile-root?))))))
+ (when (eq? action 'disk-image)
+ (warning (G_ "'disk-image' is deprecated: use 'image' instead~%")))
+ (when (eq? action 'vm-image)
+ (warning (G_ "'vm-image' is deprecated: use 'image' instead~%")))
+ (lower-object (system-image image)))
((docker-image)
(system-docker-image os
#:shared-network? container-shared-network?)))))
@@ -768,7 +756,7 @@ and TARGET arguments."
(set! %load-compiled-path (lowered-gexp-load-compiled-path lowered))
(return (primitive-eval (lowered-gexp-sexp lowered))))))
-(define* (perform-action action os
+(define* (perform-action action image
#:key
(validate-reconfigure ensure-forward-reconfigure)
save-provenance?
@@ -776,16 +764,13 @@ and TARGET arguments."
install-bootloader?
dry-run? derivations-only?
use-substitutes? bootloader-target target
- image-size image-type
- volatile-root?
- full-boot? label container-shared-network?
+ full-boot?
+ container-shared-network?
(mappings '())
(gc-root #f))
- "Perform ACTION for OS. INSTALL-BOOTLOADER? specifies whether to install
+ "Perform ACTION for IMAGE. INSTALL-BOOTLOADER? specifies whether to install
bootloader; BOOTLOADER-TAGET is the target for the bootloader; TARGET is the
-target root directory; IMAGE-SIZE is the size of the image to be built, for
-the 'image' action. IMAGE-TYPE is the type of image to be built. When
-VOLATILE-ROOT? is #t, the root file system is mounted volatile.
+target root directory.
FULL-BOOT? is used for the 'vm' action; it determines whether to
boot directly to the kernel or to the bootloader. CONTAINER-SHARED-NETWORK?
@@ -807,6 +792,9 @@ static checks."
'()
(map boot-parameters->menu-entry (profile-boot-parameters))))
+ (define os
+ (image-operating-system image))
+
(define bootloader
(operating-system-bootloader os))
@@ -829,11 +817,7 @@ static checks."
(check-initrd-modules os)))
(mlet* %store-monad
- ((sys (system-derivation-for-action os action
- #:label label
- #:image-type image-type
- #:image-size image-size
- #:volatile-root? volatile-root?
+ ((sys (system-derivation-for-action image action
#:full-boot? full-boot?
#:container-shared-network? container-shared-network?
#:mappings mappings))
@@ -1168,9 +1152,9 @@ Some ACTIONS support additional ARGS.\n"))
ACTION must be one of the sub-commands that takes an operating system
declaration as an argument (a file name.) OPTS is the raw alist of options
resulting from command-line parsing."
- (define (ensure-operating-system file-or-exp obj)
- (unless (operating-system? obj)
- (leave (G_ "'~a' does not return an operating system~%")
+ (define (ensure-operating-system-or-image file-or-exp obj)
+ (unless (or (operating-system? obj) (image? obj))
+ (leave (G_ "'~a' does not return an operating system or an image~%")
file-or-exp))
obj)
@@ -1184,27 +1168,47 @@ resulting from command-line parsing."
(expr (assoc-ref opts 'expression))
(system (assoc-ref opts 'system))
(target (assoc-ref opts 'target))
- (transform (if save-provenance?
- (cut operating-system-with-provenance <> file)
- identity))
- (os (transform
- (ensure-operating-system
- (or file expr)
- (cond
- ((and expr file)
- (leave
- (G_ "both file and expression cannot be specified~%")))
- (expr
- (read/eval expr))
- (file
- (load* file %user-module
- #:on-error (assoc-ref opts 'on-error)))
- (else
- (leave (G_ "no configuration specified~%")))))))
-
+ (transform (lambda (obj)
+ (if (and save-provenance? (operating-system? obj))
+ (operating-system-with-provenance obj file)
+ obj)))
+ (obj (transform
+ (ensure-operating-system-or-image
+ (or file expr)
+ (cond
+ ((and expr file)
+ (leave
+ (G_ "both file and expression cannot be specified~%")))
+ (expr
+ (read/eval expr))
+ (file
+ (load* file %user-module
+ #:on-error (assoc-ref opts 'on-error)))
+ (else
+ (leave (G_ "no configuration specified~%")))))))
(dry? (assoc-ref opts 'dry-run?))
(bootloader? (assoc-ref opts 'install-bootloader?))
(label (assoc-ref opts 'label))
+ (image-type (lookup-image-type-by-name
+ (assoc-ref opts 'image-type)))
+ (image (let* ((image-type (if (eq? action 'vm-image)
+ qcow2-image-type
+ image-type))
+ (image-size (assoc-ref opts 'image-size))
+ (volatile? (assoc-ref opts 'volatile-root?))
+ (base-image (if (operating-system? obj)
+ (os->image obj
+ #:type image-type)
+ obj))
+ (base-target (image-target base-image)))
+ (image
+ (inherit (if label
+ (image-with-label base-image label)
+ base-image))
+ (target (or base-target target))
+ (size image-size)
+ (volatile-root? volatile?))))
+ (os (image-operating-system image))
(target-file (match args
((first second) second)
(_ #f)))
@@ -1240,7 +1244,7 @@ resulting from command-line parsing."
(warn-about-old-distro #:suggested-command
"guix system reconfigure"))
- (perform-action action os
+ (perform-action action image
#:dry-run? dry?
#:derivations-only? (assoc-ref opts
'derivations-only?)
@@ -1249,11 +1253,6 @@ resulting from command-line parsing."
(assoc-ref opts 'skip-safety-checks?)
#:validate-reconfigure
(assoc-ref opts 'validate-reconfigure)
- #:image-type (lookup-image-type-by-name
- (assoc-ref opts 'image-type))
- #:image-size (assoc-ref opts 'image-size)
- #:volatile-root?
- (assoc-ref opts 'volatile-root?)
#:full-boot? (assoc-ref opts 'full-boot?)
#:container-shared-network?
(assoc-ref opts 'container-shared-network?)
@@ -1263,7 +1262,6 @@ resulting from command-line parsing."
(_ #f))
opts)
#:install-bootloader? bootloader?
- #:label label
#:target target-file
#:bootloader-target bootloader-target
#:gc-root (assoc-ref opts 'gc-root)))))
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index ddbdd0edcd..ce4030bc59 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -333,12 +333,11 @@ for example in gnu/system/examples/*.tmpl; do
guix system -n disk-image $target "$example"
done
-# Verify that the disk image types can be built.
+# Verify that the images can be built.
guix system -n vm gnu/system/examples/vm-image.tmpl
+guix system -n image gnu/system/images/pinebook-pro.scm
guix system -n image -t qcow2 gnu/system/examples/vm-image.tmpl
-# This invocation was taken care of in the loop above:
-# guix system -n disk-image gnu/system/examples/bare-bones.tmpl
-guix system -n disk-image -t iso9660 gnu/system/examples/bare-bones.tmpl
+guix system -n image -t iso9660 gnu/system/examples/bare-bones.tmpl
guix system -n docker-image gnu/system/examples/docker-image.tmpl
# Verify that at least the raw image type is available.
--
2.29.2
Mathieu Othacehe <mathieu <at> cervin.i-did-not-set--mail-host-address--so-tickle-me>
to control <at> debbugs.gnu.org.
(Wed, 17 Feb 2021 09:59:01 GMT) Full text and rfc822 format available.Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Wed, 17 Mar 2021 11:24:04 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.