summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2020-09-29 11:37:19 +0200
committerMathieu Othacehe <othacehe@gnu.org>2020-09-29 11:42:52 +0200
commitf441e3e8b5fbc2406fa924d3761774bbd50cc683 (patch)
tree83442b571f049d2142f006b893ac2949c34c9c1f /gnu
parentc4d3eb569ca08776895c15d3bd38a34c8c37a68a (diff)
image: Add support for compressed-qcow2 format.
* gnu/build/image.scm (convert-disk-image): New procedure. (genimage): Remove target argument. * gnu/system/image.scm (system-disk-image): Add support for 'compressed-qcow2 image format. Call "convert-disk-image" to apply image conversions on the final image. Add "qemu-minimal" to the build inputs. (system-image): Also add support for 'compressed-qcow2.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/build/image.scm16
-rw-r--r--gnu/system/image.scm30
2 files changed, 29 insertions, 17 deletions
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index d8efa73f16..8a2d0eb5fd 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -37,6 +37,7 @@
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (make-partition-image
+ convert-disk-image
genimage
initialize-efi-partition
initialize-root-partition
@@ -120,13 +121,22 @@ ROOT directory to populate the image."
(format (current-error-port)
"Unsupported partition type~%.")))))
-(define* (genimage config target)
+(define (convert-disk-image image format output)
+ "Convert IMAGE to OUTPUT according to the given FORMAT."
+ (case format
+ ((compressed-qcow2)
+ (begin
+ (invoke "qemu-img" "convert" "-c" "-f" "raw"
+ "-O" "qcow2" image output)))
+ (else
+ (copy-file image output))))
+
+(define* (genimage config)
"Use genimage to generate in TARGET directory, the image described in the
given CONFIG file."
;; genimage needs a 'root' directory.
(mkdir "root")
- (invoke "genimage" "--config" config
- "--outputpath" target))
+ (invoke "genimage" "--config" config))
(define* (register-closure prefix closure
#:key
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 49cdd9e7de..0f2fb62a6b 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -47,11 +47,13 @@
#:use-module (gnu packages hurd)
#:use-module (gnu packages linux)
#:use-module (gnu packages mtools)
+ #:use-module (gnu packages virtualization)
#:use-module ((srfi srfi-1) #:prefix srfi-1:)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-35)
#:use-module (rnrs bytevectors)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (root-offset
root-label
@@ -207,8 +209,8 @@ used in the image."
(define (format->image-type format)
;; Return the genimage format corresponding to FORMAT. For now, only
;; the hdimage format (raw disk-image) is supported.
- (case format
- ((disk-image) "hdimage")
+ (cond
+ ((memq format '(disk-image compressed-qcow2)) "hdimage")
(else
(raise (condition
(&message
@@ -306,25 +308,24 @@ image ~a {
(name (if image-name
(symbol->string image-name)
name))
+ (format (image-format image))
(substitutable? (image-substitutable? image))
(builder
(with-imported-modules*
- (let ((inputs '#+(list genimage coreutils findutils))
+ (let ((inputs '#+(list genimage coreutils findutils qemu-minimal))
(bootloader-installer
- #+(bootloader-disk-image-installer bootloader)))
+ #+(bootloader-disk-image-installer bootloader))
+ (out-image (string-append "images/" #$genimage-name)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
- (genimage #$(image->genimage-cfg image) #$output)
+ (genimage #$(image->genimage-cfg image))
;; Install the bootloader directly on the disk-image.
(when bootloader-installer
(bootloader-installer
#+(bootloader-package bootloader)
#$(root-partition-index image)
- (string-append #$output "/" #$genimage-name))))))
- (image-dir (computed-file "image-dir" builder)))
- (computed-file name
- #~(symlink
- (string-append #$image-dir "/" #$genimage-name)
- #$output)
+ out-image))
+ (convert-disk-image out-image '#$format #$output)))))
+ (computed-file name builder
#:options `(#:substitutable? ,substitutable?))))
@@ -523,19 +524,20 @@ image, depending on IMAGE format."
(with-parameters ((%current-target-system target))
(let* ((os (operating-system-for-image image))
(image* (image-with-os image os))
+ (image-format (image-format image))
(register-closures? (has-guix-service-type? os))
(bootcfg (operating-system-bootcfg os))
(bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os))))
- (case (image-format image)
- ((disk-image)
+ (cond
+ ((memq image-format '(disk-image compressed-qcow2))
(system-disk-image image*
#:bootcfg bootcfg
#:bootloader bootloader
#:register-closures? register-closures?
#:inputs `(("system" ,os)
("bootcfg" ,bootcfg))))
- ((iso9660)
+ ((memq image-format '(iso9660))
(system-iso9660-image
image*
#:bootcfg bootcfg