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.
This commit is contained in:
Mathieu Othacehe 2020-09-29 11:37:19 +02:00
parent c4d3eb569c
commit f441e3e8b5
No known key found for this signature in database
GPG key ID: 8354763531769CA6
2 changed files with 29 additions and 17 deletions

View file

@ -37,6 +37,7 @@ (define-module (gnu build image)
#: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 @@ (define* (make-partition-image partition-sexp target root)
(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

View file

@ -47,11 +47,13 @@ (define-module (gnu system image)
#: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 @@ (define (image->genimage-cfg 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 @@ (define (partition->config partition)
(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 @@ (define target (image-target image))
(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