build: Add iso9660 system image generator.

* build-aux/hydra/gnu-system.scm (qemu-jobs): Add 'iso9660-image .
* gnu/build/vm.scm (make-iso9660-image): New variable.  Export it.
* gnu/system/vm.scm (iso9660-image): New variable.  Use make-iso9660-image.
(system-disk-image): Use iso9660-image.
This commit is contained in:
Danny Milosavljevic 2017-07-03 10:05:03 +02:00
parent 1b0f266e40
commit be1033a334
No known key found for this signature in database
GPG Key ID: E71A35542C30BAA5
3 changed files with 92 additions and 15 deletions

View File

@ -162,7 +162,14 @@ system.")
(set-guile-for-build (default-guile))
(system-disk-image installation-os
#:disk-image-size
(* 1024 MiB))))))
(* 1024 MiB)))))
(->job 'iso9660-image
(run-with-store store
(mbegin %store-monad
(set-guile-for-build (default-guile))
(system-disk-image installation-os
#:file-system-type
"iso9660")))))
'()))
(define (system-test-jobs store system)

View File

@ -50,7 +50,8 @@
estimated-partition-size
root-partition-initializer
initialize-partition-table
initialize-hard-disk))
initialize-hard-disk
make-iso9660-image))
;;; Commentary:
;;;
@ -351,6 +352,21 @@ SYSTEM-DIRECTORY is the name of the directory of the 'system' derivation."
(string-append "boot/grub/grub.cfg=" config-file)))
(error "failed to create GRUB EFI image"))))
(define* (make-iso9660-image grub config-file os-drv target
#:key (volume-id "GuixSD"))
"Given a GRUB package, creates an iso image as TARGET, using CONFIG-FILE as
Grub configuration and OS-DRV as the stuff in it."
(let ((grub-mkrescue (string-append grub "/bin/grub-mkrescue")))
(mkdir-p "/tmp/root/var/run")
(mkdir-p "/tmp/root/run")
(unless (zero? (system* grub-mkrescue "-o" target
(string-append "boot/grub/grub.cfg=" config-file)
(string-append "gnu/store=" os-drv "/..")
"var=/tmp/root/var"
"run=/tmp/root/run"
"--" "-volid" (string-upcase volume-id)))
(error "failed to create ISO image"))))
(define* (initialize-hard-disk device
#:key
bootloader-package

View File

@ -34,6 +34,7 @@
#:select (qemu-command))
#:use-module (gnu packages base)
#:use-module (gnu packages bootloaders)
#:use-module (gnu packages cdrom)
#:use-module (gnu packages guile)
#:use-module (gnu packages gawk)
#:use-module (gnu packages bash)
@ -174,6 +175,48 @@ made available under the /xchg CIFS share."
#:guile-for-build guile-for-build
#:references-graphs references-graphs)))
(define* (iso9660-image #:key
(name "iso9660-image")
(system (%current-system))
(qemu qemu-minimal)
os-drv
bootcfg-drv
bootloader
(inputs '()))
"Return a bootable, stand-alone iso9660 image.
INPUTS is a list of inputs (as for packages)."
(expression->derivation-in-linux-vm
name
(with-imported-modules (source-module-closure '((gnu build vm)
(guix build utils)))
#~(begin
(use-modules (gnu build vm)
(guix build utils))
(let ((inputs
'#$(append (list qemu parted e2fsprogs dosfstools xorriso)
(map canonical-package
(list sed grep coreutils findutils gawk))))
;; This variable is unused but allows us to add INPUTS-TO-COPY
;; as inputs.
(to-register
'#$(map (match-lambda
((name thing) thing)
((name thing output) `(,thing ,output)))
inputs)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(make-iso9660-image #$(bootloader-package bootloader)
#$bootcfg-drv
#$os-drv
"/xchg/guixsd.iso")
(reboot))))
#:system system
#:make-disk-image? #f
#:references-graphs inputs))
(define* (qemu-image #:key
(name "qemu-image")
(system (%current-system))
@ -318,6 +361,14 @@ to USB sticks meant to be read-only."
(mlet* %store-monad ((os-drv (operating-system-derivation os))
(bootcfg (operating-system-bootcfg os)))
(if (string=? "iso9660" file-system-type)
(iso9660-image #:name name
#:os-drv os-drv
#:bootcfg-drv bootcfg
#:bootloader (bootloader-configuration-bootloader
(operating-system-bootloader os))
#:inputs `(("system" ,os-drv)
("bootcfg" ,bootcfg)))
(qemu-image #:name name
#:os-drv os-drv
#:bootcfg-drv bootcfg
@ -325,12 +376,15 @@ to USB sticks meant to be read-only."
(operating-system-bootloader os))
#:disk-image-size disk-image-size
#:disk-image-format "raw"
#:file-system-type file-system-type
#:file-system-type (if (string=? "iso9660"
file-system-type)
"ext4"
file-system-type)
#:file-system-label root-label
#:copy-inputs? #t
#:register-closures? #t
#:inputs `(("system" ,os-drv)
("bootcfg" ,bootcfg))))))
("bootcfg" ,bootcfg)))))))
(define* (system-qemu-image os
#:key