[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#27521] [PATCH v4] build: Add iso9660 system image generator.
|
From: |
Danny Milosavljevic |
|
Subject: |
[bug#27521] [PATCH v4] build: Add iso9660 system image generator. |
|
Date: |
Thu, 29 Jun 2017 04:09:54 +0200 |
* build-aux/hydra/gnu-system.scm (qemu-jobs): Add 'iso9660-image .
* guix/script/system.scm: Add "iso9660-disk-image" action.
* 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.
---
build-aux/hydra/gnu-system.scm | 7 ++++
gnu/build/vm.scm | 13 ++++++-
gnu/system/vm.scm | 83 +++++++++++++++++++++++++++++++++++-------
guix/scripts/system.scm | 20 ++++++----
4 files changed, 102 insertions(+), 21 deletions(-)
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index eeb7183a4..0b49ce971 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -162,6 +162,13 @@ system.")
(set-guile-for-build (default-guile))
(system-disk-image installation-os
#:disk-image-size
+ (* 1024 MiB)))))
+ (->job 'iso9660-image
+ (run-with-store store
+ (mbegin %store-monad
+ (set-guile-for-build (default-guile))
+ (system-disk-image installation-os
+ #:disk-image-size
(* 1024 MiB))))))
'()))
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 57619764c..f2ef923b8 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -48,7 +48,8 @@
root-partition-initializer
initialize-partition-table
- initialize-hard-disk))
+ initialize-hard-disk
+ make-iso9660-image))
;;; Commentary:
;;;
@@ -344,6 +345,16 @@ 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)
+ "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")))
+ (unless (zero? (system* grub-mkrescue "-o" target
+ (string-append "boot/grub/grub.cfg=" config-file)
+ (string-append "gnu/store=" os-drv "/..")
+ "--" "-volid" "GUIXSD"))
+ (error "failed to create ISO image"))))
+
(define* (initialize-hard-disk device
#:key
bootloader-package
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 392737d07..5a865d24b 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -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)
@@ -170,6 +171,51 @@ 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)
+ (mkdir-p "/tmp")
+ ;(mount "none" "/tmp" "tmpfs")
+ ;(mkdir-p "/tmp/extra")
+ (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))
@@ -308,19 +354,30 @@ to USB sticks meant to be read-only."
(mlet* %store-monad ((os-drv (operating-system-derivation os))
(bootcfg (operating-system-bootcfg os)))
- (qemu-image #:name name
- #:os-drv os-drv
- #:bootcfg-drv bootcfg
- #:bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os))
- #:disk-image-size disk-image-size
- #:disk-image-format "raw"
- #:file-system-type file-system-type
- #:file-system-label root-label
- #:copy-inputs? #t
- #:register-closures? #t
- #:inputs `(("system" ,os-drv)
- ("bootcfg" ,bootcfg))))))
+ (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
+ #:bootloader (bootloader-configuration-bootloader
+ (operating-system-bootloader os))
+ #:disk-image-size disk-image-size
+ #:disk-image-format "raw"
+ #: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)))))))
(define* (system-qemu-image os
#:key
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 35675cc01..da0f5b04b 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -578,7 +578,9 @@ PATTERN, a string. When PATTERN is #f, display all the
system generations."
(* 70 (expt 2 20)))
#:mappings mappings))
((disk-image)
- (system-disk-image os #:disk-image-size image-size))))
+ (system-disk-image os #:disk-image-size image-size))
+ ((iso9660-disk-image)
+ (system-disk-image os #:file-system-type "iso9660"))))
(define (maybe-suggest-running-guix-pull)
"Suggest running 'guix pull' if this has never been done before."
@@ -616,7 +618,8 @@ and TARGET arguments."
"Perform ACTION for OS. INSTALL-BOOTLOADER? specifies whether to install
bootloader; DEVICE is the target devices for bootloader; TARGET is the target
root directory; IMAGE-SIZE is the size of the image to be built, for the
-'vm-image' and 'disk-image' actions. FULL-BOOT? is used for the 'vm' action;
+'vm-image', 'iso9660-disk-image' and 'disk-image' actions.
+FULL-BOOT? is used for the 'vm' action;
it determines whether to boot directly to the kernel or to the bootloader.
When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
@@ -764,6 +767,8 @@ Some ACTIONS support additional ARGS.\n"))
(display (G_ "\
init initialize a root file system to run GNU\n"))
(display (G_ "\
+ iso9660-disk-image build a disk image, suitable for a CD or DVD\n"))
+ (display (G_ "\
extension-graph emit the service extension graph in Dot format\n"))
(display (G_ "\
shepherd-graph emit the graph of shepherd services in Dot format\n"))
@@ -781,9 +786,9 @@ Some ACTIONS support additional ARGS.\n"))
(display (G_ "
--share=SPEC for 'vm', share host file system according to SPEC"))
(display (G_ "
- -r, --root=FILE for 'vm', 'vm-image', 'disk-image', 'container',
- and 'build', make FILE a symlink to the result, and
- register it as a garbage collector root"))
+ -r, --root=FILE for 'vm', 'vm-image', 'disk-image',
'iso9660-disk-image',
+ 'container', and 'build', make FILE a symlink to the
+ result, and register it as a garbage collector root"))
(display (G_ "
--expose=SPEC for 'vm', expose host file system according to SPEC"))
(display (G_ "
@@ -957,7 +962,8 @@ argument list and OPTS is the option alist."
(alist-cons 'argument arg result)
(let ((action (string->symbol arg)))
(case action
- ((build container vm vm-image disk-image reconfigure init
+ ((build container vm vm-image disk-image iso9660-disk-image
+ reconfigure init
extension-graph shepherd-graph list-generations roll-back
switch-generation)
(alist-cons 'action action result))
@@ -987,7 +993,7 @@ argument list and OPTS is the option alist."
(exit 1))
(case action
- ((build container vm vm-image disk-image reconfigure)
+ ((build container vm vm-image disk-image iso9660-disk-image
reconfigure)
(unless (= count 1)
(fail)))
((init)