aboutsummaryrefslogtreecommitdiff
path: root/gnu/system/vm.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system/vm.scm')
-rw-r--r--gnu/system/vm.scm94
1 files changed, 80 insertions, 14 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 7ac8696158..66a2448ceb 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,52 @@ made available under the /xchg CIFS share."
#:guile-for-build guile-for-build
#:references-graphs references-graphs)))
+(define* (iso9660-image #:key
+ (name "iso9660-image")
+ file-system-label
+ file-system-uuid
+ (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"
+ #:volume-id #$file-system-label
+ #:volume-uuid #$file-system-uuid)
+ (reboot))))
+ #:system system
+ #:make-disk-image? #f
+ #:references-graphs inputs))
+
(define* (qemu-image #:key
(name "qemu-image")
(system (%current-system))
@@ -288,11 +335,17 @@ the image."
system described by OS. Said image can be copied on a USB stick as is. When
VOLATILE? is true, the root file system is made volatile; this is useful
to USB sticks meant to be read-only."
+ (define normalize-label
+ ;; ISO labels are all-caps (case-insensitive), but since
+ ;; 'find-partition-by-label' is case-sensitive, make it all-caps here.
+ (if (string=? "iso9660" file-system-type)
+ string-upcase
+ identity))
(define root-label
;; Volume name of the root file system. Since we don't know which device
;; will hold it, we use the volume name to find it (using the UUID would
;; be even better, but somewhat less convenient.)
- "gnu-disk-image")
+ (normalize-label "GuixSD"))
(define file-systems-to-keep
(remove (lambda (fs)
@@ -318,19 +371,32 @@ 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
+ #:file-system-label root-label
+ #:file-system-uuid #f
+ #: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