aboutsummaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-05-03 00:26:07 +0200
committerLudovic Courtès <ludo@gnu.org>2014-05-03 00:46:51 +0200
commit83bcd0b895016c058807e71e102c54d2fab44339 (patch)
tree9e5efaaaf64d39b7ddd7f016019c33134b154f5b /gnu/system
parentf5d5a346dbe74c93642b532a1680c900d24658d8 (diff)
downloadguix-83bcd0b895016c058807e71e102c54d2fab44339.tar
guix-83bcd0b895016c058807e71e102c54d2fab44339.tar.gz
system: Add first-class file system declarations.
* gnu/system.scm (<operating-system>)[initrd]: Default to 'qemu-initrd'. (<file-system>): New record type. (operating-system-root-file-system): New procedure. (operating-system-derivation): Take the device name for GRUB from 'operating-system-root-file-system'. Pass the 'operating-system-initrd' procedure the list of boot file systems. * gnu/system/linux-initrd.scm (file-system->spec): New procedure. (qemu-initrd): Add 'file-systems' parameter, and remove #:mounts parameter. [file-system-type-predicate]: New procedure. [linux-modules]: Use it. Adjust #:mounts argument in 'boot-system' call. (gnu-system-initrd): Remove. * gnu/system/vm.scm (%linux-vm-file-systems): New variable. (expression->derivation-in-linux-vm): Adjust call to 'qemu-initrd'. (virtualized-operating-system): New procedure. (system-qemu-image/shared-store-script)[initrd]: Remove. Use 'virtualized-operating-system'. Get the 'initrd' file from OS-DRV. * guix/build/linux-initrd.scm (mount-qemu-smb-share, mount-qemu-9p): Remove. (MS_RDONLY, MS_BIND): New global variables. (bind-mount): Remove local 'MS_BIND' definition. (mount-root-file-system): New procedure, with code formerly in 'boot-system'. (mount-file-system): New procedure. (boot-system): Add #:root-fs-type parameter. Remove 'MS_RDONLY' local variable. Use 'mount-root-file-system' and 'mount-file-system'. * doc/guix.texi (Using the Configuration System): Add 'file-system' declaration.
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/linux-initrd.scm47
-rw-r--r--gnu/system/vm.scm46
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