mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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:
parent
c4d3eb569c
commit
f441e3e8b5
2 changed files with 29 additions and 17 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue