diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/file-systems.scm | 17 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 27 | ||||
| -rw-r--r-- | gnu/system/shadow.scm | 4 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 29 |
4 files changed, 52 insertions, 25 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 90e2b0c796..ed9d70587f 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu system file-systems) + #:use-module (guix gexp) #:use-module (guix records) #:export (<file-system> file-system @@ -43,7 +44,12 @@ mapped-device? mapped-device-source mapped-device-target - mapped-device-command)) + mapped-device-type + + mapped-device-kind + mapped-device-kind? + mapped-device-kind-open + mapped-device-kind-close)) ;;; Commentary: ;;; @@ -145,6 +151,13 @@ mapped-device? (source mapped-device-source) ;string (target mapped-device-target) ;string - (command mapped-device-command)) ;source target -> gexp + (type mapped-device-type)) ;<mapped-device-kind> + +(define-record-type* <mapped-device-type> mapped-device-kind + make-mapped-device-kind + mapped-device-kind? + (open mapped-device-kind-open) ;source target -> gexp + (close mapped-device-kind-close ;source target -> gexp + (default (const #~(const #f))))) ;;; file-systems.scm ends here diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 93f751b757..d1b1216f9d 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -126,15 +126,16 @@ initrd code." (define* (base-initrd file-systems #:key + (mapped-devices '()) qemu-networking? virtio? volatile-root? - (extra-modules '()) - guile-modules-in-chroot?) - ;; TODO: Support boot-time device mappings. + (extra-modules '())) "Return a monadic derivation that builds a generic initrd. 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'. +MAPPED-DEVICES is a list of device mappings to realize before FILE-SYSTEMS are +mounted. When QEMU-NETWORKING? is true, set up networking with the standard QEMU parameters. When VIRTIO? is true, load additional modules so the initrd can @@ -146,12 +147,7 @@ to it are lost. The initrd is automatically populated with all the kernel modules necessary for FILE-SYSTEMS and for the given options. However, additional kernel modules can be listed in EXTRA-MODULES. They will be added to the initrd, and -loaded at boot time in the order in which they appear. - -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!)." +loaded at boot time in the order in which they appear." (define virtio-modules ;; Modules for Linux para-virtualized devices, for use in QEMU guests. '("virtio.ko" "virtio_ring.ko" "virtio_pci.ko" @@ -197,6 +193,16 @@ exception and backtrace!)." (list unionfs-fuse/static) '()))) + (define device-mapping-commands + ;; List of gexps to open the mapped devices. + (map (lambda (md) + (let* ((source (mapped-device-source md)) + (target (mapped-device-target md)) + (type (mapped-device-type md)) + (open (mapped-device-kind-open type))) + (open source target))) + mapped-devices)) + (mlet %store-monad ((kodir (flat-linux-module-directory linux-libre linux-modules))) (expression->initrd @@ -211,11 +217,12 @@ exception and backtrace!)." '#$helper-packages))) (boot-system #:mounts '#$(map file-system->spec file-systems) + #:pre-mount (lambda () + (and #$@device-mapping-commands)) #:linux-modules (map (lambda (file) (string-append #$kodir "/" file)) '#$linux-modules) #:qemu-guest-networking? #$qemu-networking? - #:guile-modules-in-chroot? '#$guile-modules-in-chroot? #:volatile-root? '#$volatile-root?)) #:name "base-initrd" #:modules '((guix build utils) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 5d638398d1..6970021e1f 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -95,6 +95,7 @@ (system-group (name "tty") (id %tty-gid)) (system-group (name "dialout")) (system-group (name "kmem")) + (system-group (name "input")) ; input devices, from udev (system-group (name "video")) (system-group (name "audio")) (system-group (name "netdev")) ; used in avahi-dbus.conf @@ -102,7 +103,8 @@ (system-group (name "disk")) (system-group (name "floppy")) (system-group (name "cdrom")) - (system-group (name "tape"))))) + (system-group (name "tape")) + (system-group (name "kvm"))))) ; for /dev/kvm (define (default-skeletons) "Return the default skeleton files for /etc/skel. These files are copied by diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 4ee8dc5cf2..799ab51d41 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -159,8 +159,7 @@ made available under the /xchg CIFS share." (return initrd) (base-initrd %linux-vm-file-systems #:virtio? #t - #:qemu-networking? #t - #:guile-modules-in-chroot? #t)))) + #:qemu-networking? #t)))) (define builder ;; Code that launches the VM that evaluates EXP. @@ -290,9 +289,11 @@ to USB sticks meant to be read-only." ;; Since this is meant to be used on real hardware, don't ;; install QEMU networking or anything like that, but make sure ;; USB mass storage devices are available. - (initrd (cut base-initrd <> - #:volatile-root? #t - #:extra-modules '("usb-storage.ko"))) + (initrd (lambda (file-systems . rest) + (apply base-initrd file-systems + #:volatile-root? #t + #:extra-modules '("usb-storage.ko") + rest))) ;; Force our own root file system. (file-systems (cons (file-system @@ -334,9 +335,11 @@ of the GNU system as described by OS." (let ((os (operating-system (inherit os) ;; Use an initrd with the whole QEMU shebang. - (initrd (cut base-initrd <> - #:virtio? #t - #:qemu-networking? #t)) + (initrd (lambda (file-systems . rest) + (apply base-initrd file-systems + #:virtio? #t + #:qemu-networking? #t + rest))) ;; Force our own root file system. (file-systems (cons (file-system @@ -359,10 +362,12 @@ of the GNU system as described by 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 base-initrd <> - #:volatile-root? #t - #:virtio? #t - #:qemu-networking? #t)) + (initrd (lambda (file-systems . rest) + (apply base-initrd file-systems + #:volatile-root? #t + #:virtio? #t + #:qemu-networking? #t + rest))) (file-systems (cons* (file-system (mount-point "/") (device "/dev/vda1") |