;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (gnu system linux-initrd) #:use-module (guix monads) #:use-module (guix store) #:use-module (guix gexp) #:use-module (guix utils) #:use-module ((guix store) #:select (%store-prefix)) #:use-module ((guix derivations) #:select (derivation->output-path)) #:use-module (gnu packages cpio) #:use-module (gnu packages compression) #:use-module (gnu packages linux) #:use-module (gnu packages guile) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) #:use-module (gnu system file-systems) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (expression->initrd base-initrd)) ;;; Commentary: ;;; ;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in ;;; particular initrd's that run Guile. ;;; ;;; Code: (define* (expression->initrd exp #:key (guile %guile-static-stripped) (cpio cpio) (gzip gzip) (name "guile-initrd") (system (%current-system)) (modules '())) "Return a derivation that builds a Linux initrd (a gzipped cpio archive) containing GUILE and that evaluates EXP, a G-expression, upon booting. All the derivations referenced by EXP are automatically copied to the initrd. MODULES is a list of Guile module names to be embedded in the initrd." ;; General Linux overview in `Documentation/early-userspace/README' and ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'. (mlet %store-monad ((init (gexp->script "init" exp #:modules modules #:guile guile))) (define builder #~(begin (use-modules (gnu build linux-initrd)) (mkdir #$output) (build-initrd (string-append #$output "/initrd") #:guile #$guile #:init #$init ;; Copy everything INIT refers to into the initrd. #:references-graphs '("closure") #:cpio (string-append #$cpio "/bin/cpio") #:gzip (string-append #$gzip "/bin/gzip")))) (gexp->derivation name builder #:modules '((guix build utils) (guix build store-copy) (gnu build linux-initrd)) #:references-graphs `(("closure" ,init))))) (define (flat-linux-module-directory linux modules) "Return a flat directory containing the Linux kernel modules listed in MODULES and taken from LINUX." (define build-exp #~(begin (use-modules (ice-9 match) (ice-9 regex) (srfi srfi-1) (guix build utils) (gnu build linux-modules)) (define (string->regexp str) ;; Return a regexp that matches STR exactly. (string-append "^" (regexp-quote str) "$")) (define module-dir (string-append #$linux "/lib/modules")) (define (lookup module) (let ((name (ensure-dot-ko module))) (match (find-files module-dir (string->regexp name)) ((file) file) (() (error "module not found" name module-dir)) ((_ ...) (error "several modules by that name" name module-dir))))) (define modules (let ((modules (map lookup '#$modules))) (append modules (recursive-module-dependencies modules #:lookup-module lookup)))) (mkdir #$output) (for-each (lambda (module) (format #t "copying '~a'...~%" module) (copy-file module (string-append #$output "/" (basename module)))) (delete-duplicates modules)))) (gexp->derivation "linux-modules" build-exp #:modules '((guix build utils) (guix elf) (gnu build linux-modules)))) (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 title mount-point type flags options _ check?) (list device title mount-point type flags options check?)))) (define* (base-initrd file-systems #:key (linux linux-libre) (mapped-devices '()) qemu-networking? (virtio? #t) volatile-root? (extra-modules '())) "Return a monadic derivation that builds a generic initrd, with kernel modules taken from LINUX. 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 be used as a QEMU guest with the root file system on a para-virtualized block device. When VOLATILE-ROOT? is true, the root file system is writable but any changes 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." (define virtio-modules ;; Modules for Linux para-virtualized devices, for use in QEMU guests. '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net" "virtio_console")) (define cifs-modules ;; Modules needed to mount CIFS file systems. '("md4" "ecb" "cifs")) (define virtio-9p-modules ;; Modules for the 9p paravirtualized file system. '("9p" "9pnet_virtio")) (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. `("ahci" ;for SATA controllers "pata_acpi" "pata_atiixp" ;for ATA controllers "isci" ;for SAS controllers like Intel C602 "usb-storage" "uas" ;for the installation image etc. "usbkbd" "usbhid" ;USB keyboards, for debugging ,@(if (or virtio? qemu-networking?) virtio-modules '()) ,@(if (find (file-system-type-predicate "cifs") file-systems) cifs-modules '()) ,@(if (find (file-system-type-predicate "9p") file-systems) virtio-9p-modules '()) ,@(if volatile-root? '("fuse") '()) ,@extra-modules)) (define helper-packages ;; Packages to be copied on the initrd. `(,@(if (find (lambda (fs) (string-prefix? "ext" (file-system-type fs))) file-systems) (list e2fsck/static) '()) ,@(if volatile-root? (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 linux-modules))) (expression->initrd #~(begin (use-modules (gnu build linux-boot) (guix build utils) (srfi srfi-26)) (with-output-to-port (%make-void-port "w") (lambda () (set-path-environment-variable "PATH" '("bin" "sbin") '#$helper-packages))) (boot-system #:mounts '#$(map file-system->spec file-systems) #:pre-mount (lambda () (and #$@device-mapping-commands)) #:linux-modules '#$linux-modules #:linux-module-directory '#$kodir #:qemu-guest-networking? #$qemu-networking? #:volatile-root? '#$volatile-root?)) #:name "base-initrd" #:modules '((guix build utils) (gnu build linux-boot) (gnu build linux-modules) (gnu build file-systems) (guix elf))))) ;;; linux-initrd.scm ends here