diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/linux-initrd.scm | 47 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 46 |
2 files changed, 62 insertions, 31 deletions
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 6e04ad150f..8b4ab9c4eb 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -30,11 +30,12 @@ #:use-module (gnu packages guile) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) + #:use-module (gnu system) ; for 'file-system' #:use-module (ice-9 match) #:use-module (ice-9 regex) + #:use-module (srfi srfi-1) #:export (expression->initrd - qemu-initrd - gnu-system-initrd)) + qemu-initrd)) ;;; Commentary: @@ -193,24 +194,29 @@ a list of Guile module names to be embedded in the initrd." (gexp->derivation name builder #:modules '((guix build utils))))) -(define* (qemu-initrd #:key +(define (file-system->spec fs) + "Return a list corresponding to file-system FS that can be passed to the +initrd code." + (match fs + (($ <file-system> device mount-point type flags options) + (list device mount-point type flags options)))) + +(define* (qemu-initrd file-systems + #:key guile-modules-in-chroot? - volatile-root? - (mounts `((cifs "/store" ,(%store-prefix)) - (cifs "/xchg" "/xchg")))) + volatile-root?) "Return a monadic derivation that builds an initrd for use in a QEMU guest -where the store is shared with the host. MOUNTS is a list of file systems to -be mounted atop the root file system, where each item has the form: +where the store is shared with the host. FILE-SYSTEMS is a list of +file-systems to be mounted by the initrd, possibly in addition to the root +file system specified on the kernel command line via '--root'. - (FILE-SYSTEM-TYPE SOURCE TARGET) +When VOLATILE-ROOT? is true, the root file system is writable but any changes +to it are lost. When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in the new root. This is necessary is the file specified as '--load' needs access to these modules (which is the case if it wants to even just print an -exception and backtrace!). - -When VOLATILE-ROOT? is true, the root file system is writable but any changes -to it are lost." +exception and backtrace!)." (define cifs-modules ;; Modules needed to mount CIFS file systems. '("md4.ko" "ecb.ko" "cifs.ko")) @@ -219,14 +225,18 @@ to it are lost." ;; Modules for the 9p paravirtualized file system. '("9pnet.ko" "9p.ko" "9pnet_virtio.ko")) + (define (file-system-type-predicate type) + (lambda (fs) + (string=? (file-system-type fs) type))) + (define linux-modules ;; Modules added to the initrd and loaded from the initrd. `("virtio.ko" "virtio_ring.ko" "virtio_pci.ko" "virtio_balloon.ko" "virtio_blk.ko" "virtio_net.ko" - ,@(if (assoc-ref mounts 'cifs) + ,@(if (find (file-system-type-predicate "cifs") file-systems) cifs-modules '()) - ,@(if (assoc-ref mounts '9p) + ,@(if (find (file-system-type-predicate "9p") file-systems) virtio-9p-modules '()) ,@(if volatile-root? @@ -238,7 +248,7 @@ to it are lost." (use-modules (guix build linux-initrd) (srfi srfi-26)) - (boot-system #:mounts '#$mounts + (boot-system #:mounts '#$(map file-system->spec file-systems) #:linux-modules '#$linux-modules #:qemu-guest-networking? #t #:guile-modules-in-chroot? '#$guile-modules-in-chroot? @@ -254,9 +264,4 @@ to it are lost." #:linux linux-libre #:linux-modules linux-modules)) -(define (gnu-system-initrd) - "Initrd for the GNU system itself, with nothing QEMU-specific." - (qemu-initrd #:guile-modules-in-chroot? #f - #:mounts '())) - ;;; linux-initrd.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index db24c4e761..c080317415 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -82,6 +82,22 @@ input tuple. The output file name is when building for SYSTEM." ((input (and (? string?) (? store-path?) file)) (return `(,input . ,file)))))) +(define %linux-vm-file-systems + ;; File systems mounted for 'derivation-in-linux-vm'. The store and /xchg + ;; directory are shared with the host over 9p. + (list (file-system + (mount-point (%store-prefix)) + (device "store") + (type "9p") + (needed-for-boot? #t) + (options "trans=virtio")) + (file-system + (mount-point "/xchg") + (device "xchg") + (type "9p") + (needed-for-boot? #t) + (options "trans=virtio")))) + (define* (expression->derivation-in-linux-vm name exp #:key (system (%current-system)) @@ -130,9 +146,8 @@ made available under the /xchg CIFS share." (coreutils -> (car (assoc-ref %final-inputs "coreutils"))) (initrd (if initrd ; use the default initrd? (return initrd) - (qemu-initrd #:guile-modules-in-chroot? #t - #:mounts `((9p "store" ,(%store-prefix)) - (9p "xchg" "/xchg")))))) + (qemu-initrd %linux-vm-file-systems + #:guile-modules-in-chroot? #t)))) (define builder ;; Code that launches the VM that evaluates EXP. @@ -292,6 +307,22 @@ system as described by OS." #:initialize-store? #t #:inputs-to-copy `(("system" ,os-drv))))) +(define (virtualized-operating-system os) + "Return an operating system based on OS suitable for use in a virtualized +environment with the store shared with the host." + (operating-system (inherit os) + (initrd (cut qemu-initrd <> #:volatile-root? #t)) + (file-systems (list (file-system + (mount-point "/") + (device "/dev/vda1") + (type "ext3")) + (file-system + (mount-point (%store-prefix)) + (device "store") + (type "9p") + (needed-for-boot? #t) + (options "trans=virtio")))))) + (define* (system-qemu-image/shared-store os #:key (disk-image-size (* 15 (expt 2 20)))) @@ -314,14 +345,9 @@ with the host." (graphic? #t)) "Return a derivation that builds a script to run a virtual machine image of OS that shares its store with the host." - (define initrd - (qemu-initrd #:mounts `((9p "store" ,(%store-prefix))) - #:volatile-root? #t)) - (mlet* %store-monad - ((os -> (operating-system (inherit os) (initrd initrd))) + ((os -> (virtualized-operating-system os)) (os-drv (operating-system-derivation os)) - (initrd initrd) (image (system-qemu-image/shared-store os))) (define builder #~(call-with-output-file #$output @@ -332,7 +358,7 @@ exec " #$qemu "/bin/qemu-system-x86_64 -enable-kvm -no-reboot -net nic,model=vir -virtfs local,path=" #$(%store-prefix) ",security_model=none,mount_tag=store \ -net user \ -kernel " #$(operating-system-kernel os) "/bzImage \ - -initrd " #$initrd "/initrd \ + -initrd " #$os-drv "/initrd \ -append \"" #$(if graphic? "" "console=ttyS0 ") "--load=" #$os-drv "/boot --root=/dev/vda1\" \ -drive file=" #$image |