diff options
| -rw-r--r-- | build-aux/hydra/gnu-system.scm | 9 | ||||
| -rw-r--r-- | gnu/build/vm.scm | 18 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 80 |
3 files changed, 92 insertions, 15 deletions
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index eeb7183a4f..73bd566f7c 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -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) diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm index 8f7fc3c9c4..860c98346d 100644 --- a/gnu/build/vm.scm +++ b/gnu/build/vm.scm @@ -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 diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 7ac8696158..f1c650c97b 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) @@ -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,19 +361,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 |