1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
4 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
5 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
7 ;;; This file is part of GNU Guix.
9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
10 ;;; under the terms of the GNU General Public License as published by
11 ;;; the Free Software Foundation; either version 3 of the License, or (at
12 ;;; your option) any later version.
14 ;;; GNU Guix is distributed in the hope that it will be useful, but
15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;;; GNU General Public License for more details.
19 ;;; You should have received a copy of the GNU General Public License
20 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
22 (define-module (gnu system linux-initrd)
23 #:use-module (guix gexp)
24 #:use-module (guix utils)
25 #:use-module ((guix store)
26 #:select (%store-prefix))
27 #:use-module ((guix derivations)
28 #:select (derivation->output-path))
29 #:use-module (guix modules)
30 #:use-module (gnu packages compression)
31 #:use-module (gnu packages disk)
32 #:use-module (gnu packages linux)
33 #:use-module (gnu packages guile)
34 #:use-module ((gnu packages xorg)
35 #:select (console-setup xkeyboard-config))
36 #:use-module ((gnu packages make-bootstrap)
37 #:select (%guile-static-stripped))
38 #:use-module (gnu system file-systems)
39 #:use-module (gnu system mapped-devices)
40 #:use-module (gnu system keyboard)
41 #:use-module (ice-9 match)
42 #:use-module (ice-9 regex)
43 #:use-module (ice-9 vlist)
44 #:use-module (srfi srfi-1)
45 #:use-module (srfi srfi-26)
46 #:export (expression->initrd
55 ;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in
56 ;;; particular initrd's that run Guile.
61 (define* (expression->initrd exp
63 (guile %guile-static-stripped)
66 (system (%current-system)))
67 "Return as a file-like object a Linux initrd (a gzipped cpio archive)
68 containing GUILE and that evaluates EXP, a G-expression, upon booting. All
69 the derivations referenced by EXP are automatically copied to the initrd."
71 ;; General Linux overview in `Documentation/early-userspace/README' and
72 ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
75 (program-file "init" exp #:guile guile))
78 (with-imported-modules (source-module-closure
79 '((gnu build linux-initrd)))
81 (use-modules (gnu build linux-initrd))
85 ;; The guile used in the initrd must be present in the store, so
86 ;; that module loading works once the root is switched.
88 ;; To ensure that is the case, add an explicit reference to the
89 ;; guile package used in the initrd to the output.
91 ;; This fixes guix-patches bug #28399, "Fix mysql activation, and
93 (call-with-output-file (string-append #$ output "/references")
95 (simple-format port "~A\n" #$guile)))
97 (build-initrd (string-append #$output "/initrd.cpio.gz")
100 ;; Copy everything INIT refers to into the initrd.
101 #:references-graphs '("closure")
102 #:gzip (string-append #$gzip "/bin/gzip")))))
104 (file-append (computed-file name builder
106 `(#:references-graphs (("closure" ,init))))
109 (define (flat-linux-module-directory linux modules)
110 "Return a flat directory containing the Linux kernel modules listed in
111 MODULES and taken from LINUX."
113 (with-imported-modules (source-module-closure
114 '((gnu build linux-modules)))
116 (use-modules (gnu build linux-modules)
121 (string-append #$linux "/lib/modules"))
124 (let* ((lookup (cut find-module-file module-dir <>))
125 (modules (map lookup '#$modules)))
127 (recursive-module-dependencies modules
128 #:lookup-module lookup))))
131 (for-each (lambda (module)
132 (format #t "copying '~a'...~%" module)
134 (string-append #$output "/"
136 (delete-duplicates modules)))))
138 (computed-file "linux-modules" build-exp))
140 (define* (raw-initrd file-systems
146 (helper-packages '())
150 "Return as a file-like object a raw initrd, with kernel
151 modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
152 mounted by the initrd, possibly in addition to the root file system specified
153 on the kernel command line via '--root'. LINUX-MODULES is a list of kernel
154 modules to be loaded at boot time. MAPPED-DEVICES is a list of device
155 mappings to realize before FILE-SYSTEMS are mounted.
156 HELPER-PACKAGES is a list of packages to be copied in the initrd. It may include
157 e2fsck/static or other packages needed by the initrd to check root partition.
159 When true, KEYBOARD-LAYOUT is a <keyboard-layout> record denoting the desired
160 console keyboard layout. This is done before MAPPED-DEVICES are set up and
161 before FILE-SYSTEMS are mounted such that, should the user need to enter a
162 passphrase or use the REPL, this happens using the intended keyboard layout.
164 When QEMU-NETWORKING? is true, set up networking with the standard QEMU
167 When VOLATILE-ROOT? is true, the root file system is writable but any changes
170 ON-ERROR is passed to 'call-with-error-handling'; it determines what happens
172 (define device-mapping-commands
173 ;; List of gexps to open the mapped devices.
175 (let* ((source (mapped-device-source md))
176 (target (mapped-device-target md))
177 (type (mapped-device-type md))
178 (open (mapped-device-kind-open type)))
179 (open source target)))
183 (flat-linux-module-directory linux linux-modules))
186 (with-imported-modules (source-module-closure
187 '((gnu build linux-boot)
189 (guix build bournish)
190 (gnu system file-systems)
191 (gnu build file-systems)))
193 (use-modules (gnu build linux-boot)
194 (gnu system file-systems)
196 (guix build bournish) ;add the 'bournish' meta-command
199 ;; FIXME: The following modules are for
200 ;; LUKS-DEVICE-MAPPING. We should instead propagate
201 ;; this info via gexps.
202 ((gnu build file-systems)
203 #:select (find-partition-by-luks-uuid))
206 (with-output-to-port (%make-void-port "w")
208 (set-path-environment-variable "PATH" '("bin" "sbin")
209 '#$helper-packages)))
211 (boot-system #:mounts
212 (map spec->file-system
213 '#$(map file-system->spec file-systems))
214 #:pre-mount (lambda ()
215 (and #$@device-mapping-commands))
216 #:linux-modules '#$linux-modules
217 #:linux-module-directory '#$kodir
218 #:keymap-file #+(and=> keyboard-layout
219 keyboard-layout->console-keymap)
220 #:qemu-guest-networking? #$qemu-networking?
221 #:volatile-root? '#$volatile-root?
222 #:on-error '#$on-error)))
223 #:name "raw-initrd"))
225 (define* (file-system-packages file-systems #:key (volatile-root? #f))
226 "Return the list of statically-linked, stripped packages to check
228 `(,@(if (find (lambda (fs)
229 (string-prefix? "ext" (file-system-type fs)))
233 ,@(if (find (lambda (fs)
234 (string-suffix? "fat" (file-system-type fs)))
236 (list fatfsck/static)
238 ,@(if (find (file-system-type-predicate "btrfs") file-systems)
239 (list btrfs-progs/static)
242 (define-syntax vhash ;TODO: factorize
244 "Build a vhash with the given key/value mappings."
247 ((_ (key others ... => value) rest ...)
248 (vhash-cons key value
249 (vhash (others ... => value) rest ...)))
250 ((_ (=> value) rest ...)
253 (define-syntax lookup-procedure
255 "Return a procedure that lookups keys in the given dictionary."
256 ((_ mapping ... (else default))
257 (let ((table (vhash mapping ...)))
259 (match (vhash-assoc key table)
261 ((key . value) value)))))))
263 (define file-system-type-modules
264 ;; Given a file system type, return the list of modules it needs.
265 (lookup-procedure ("cifs" => '("md4" "ecb" "cifs"))
266 ("9p" => '("9p" "9pnet_virtio"))
267 ("btrfs" => '("btrfs"))
268 ("iso9660" => '("isofs"))
271 (define (file-system-modules file-systems)
272 "Return the list of Linux modules needed to mount FILE-SYSTEMS."
273 (append-map (compose file-system-type-modules file-system-type)
276 (define* (default-initrd-modules #:optional (system (%current-system)))
277 "Return the list of modules included in the initrd by default."
278 (define virtio-modules
279 ;; Modules for Linux para-virtualized devices, for use in QEMU guests.
280 '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
281 "virtio_console" "virtio-rng"))
283 `("ahci" ;for SATA controllers
284 "usb-storage" "uas" ;for the installation image etc.
285 "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot
286 "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
287 "nls_iso8859-1" ;for `mkfs.fat`, et.al
288 ,@(if (string-match "^(x86_64|i[3-6]86)-" system)
289 '("pata_acpi" "pata_atiixp" ;for ATA controllers
290 "isci") ;for SAS controllers like Intel C602
295 (define-syntax %base-initrd-modules
296 ;; This more closely matches our naming convention.
297 (identifier-syntax (default-initrd-modules)))
299 (define* (base-initrd file-systems
307 (extra-modules '()) ;deprecated
309 "Return as a file-like object a generic initrd, with kernel
310 modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
311 mounted by the initrd, possibly in addition to the root file system specified
312 on the kernel command line via '--root'. MAPPED-DEVICES is a list of device
313 mappings to realize before FILE-SYSTEMS are mounted.
315 When true, KEYBOARD-LAYOUT is a <keyboard-layout> record denoting the desired
316 console keyboard layout. This is done before MAPPED-DEVICES are set up and
317 before FILE-SYSTEMS are mounted such that, should the user need to enter a
318 passphrase or use the REPL, this happens using the intended keyboard layout.
320 QEMU-NETWORKING? and VOLATILE-ROOT? behaves as in raw-initrd.
322 The initrd is automatically populated with all the kernel modules necessary
323 for FILE-SYSTEMS and for the given options. Additional kernel
324 modules can be listed in LINUX-MODULES. They will be added to the initrd, and
325 loaded at boot time in the order in which they appear."
326 (define linux-modules*
327 ;; Modules added to the initrd and loaded from the initrd.
329 ,@(file-system-modules file-systems)
335 (define helper-packages
336 (append (file-system-packages file-systems
337 #:volatile-root? volatile-root?)
339 (list loadkeys-static)
342 (raw-initrd file-systems
344 #:linux-modules linux-modules*
345 #:mapped-devices mapped-devices
346 #:helper-packages helper-packages
347 #:keyboard-layout keyboard-layout
348 #:qemu-networking? qemu-networking?
349 #:volatile-root? volatile-root?
350 #:on-error on-error))
352 ;;; linux-initrd.scm ends here