1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017 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 monads)
24 #:use-module (guix store)
25 #:use-module (guix gexp)
26 #:use-module (guix utils)
27 #:use-module ((guix store)
28 #:select (%store-prefix))
29 #:use-module ((guix derivations)
30 #:select (derivation->output-path))
31 #:use-module (guix modules)
32 #:use-module (gnu packages compression)
33 #:use-module (gnu packages disk)
34 #:use-module (gnu packages linux)
35 #:use-module (gnu packages guile)
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 (ice-9 match)
41 #:use-module (ice-9 regex)
42 #:use-module (srfi srfi-1)
43 #:use-module (srfi srfi-26)
44 #:export (expression->initrd
52 ;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in
53 ;;; particular initrd's that run Guile.
58 (define* (expression->initrd exp
60 (guile %guile-static-stripped)
63 (system (%current-system)))
64 "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
65 containing GUILE and that evaluates EXP, a G-expression, upon booting. All
66 the derivations referenced by EXP are automatically copied to the initrd."
68 ;; General Linux overview in `Documentation/early-userspace/README' and
69 ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
71 (mlet %store-monad ((init (gexp->script "init" exp
74 (with-imported-modules (source-module-closure
75 '((gnu build linux-initrd)))
77 (use-modules (gnu build linux-initrd))
80 (build-initrd (string-append #$output "/initrd")
83 ;; Copy everything INIT refers to into the initrd.
84 #:references-graphs '("closure")
85 #:gzip (string-append #$gzip "/bin/gzip")))))
87 (gexp->derivation name builder
88 #:references-graphs `(("closure" ,init)))))
90 (define (flat-linux-module-directory linux modules)
91 "Return a flat directory containing the Linux kernel modules listed in
92 MODULES and taken from LINUX."
94 (with-imported-modules (source-module-closure
96 (gnu build linux-modules)))
98 (use-modules (ice-9 match) (ice-9 regex)
101 (gnu build linux-modules))
103 (define (string->regexp str)
104 ;; Return a regexp that matches STR exactly.
105 (string-append "^" (regexp-quote str) "$"))
108 (string-append #$linux "/lib/modules"))
110 (define (lookup module)
111 (let ((name (ensure-dot-ko module)))
112 (match (find-files module-dir (string->regexp name))
116 (error "module not found" name module-dir))
118 (error "several modules by that name"
122 (let ((modules (map lookup '#$modules)))
124 (recursive-module-dependencies modules
125 #:lookup-module lookup))))
128 (for-each (lambda (module)
129 (format #t "copying '~a'...~%" module)
131 (string-append #$output "/"
133 (delete-duplicates modules)))))
135 (gexp->derivation "linux-modules" build-exp))
137 (define* (raw-initrd file-systems
142 (helper-packages '())
145 "Return a monadic derivation that builds a raw initrd, with kernel
146 modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
147 mounted by the initrd, possibly in addition to the root file system specified
148 on the kernel command line via '--root'. LINUX-MODULES is a list of kernel
149 modules to be loaded at boot time. MAPPED-DEVICES is a list of device
150 mappings to realize before FILE-SYSTEMS are mounted.
151 HELPER-PACKAGES is a list of packages to be copied in the initrd. It may include
152 e2fsck/static or other packages needed by the initrd to check root partition.
154 When QEMU-NETWORKING? is true, set up networking with the standard QEMU
156 When VOLATILE-ROOT? is true, the root file system is writable but any changes
158 (define device-mapping-commands
159 ;; List of gexps to open the mapped devices.
161 (let* ((source (mapped-device-source md))
162 (target (mapped-device-target md))
163 (type (mapped-device-type md))
164 (open (mapped-device-kind-open type)))
165 (open source target)))
168 (mlet %store-monad ((kodir (flat-linux-module-directory linux
171 (with-imported-modules (source-module-closure
172 '((gnu build linux-boot)
174 (guix build bournish)
175 (gnu build file-systems)))
177 (use-modules (gnu build linux-boot)
179 (guix build bournish) ;add the 'bournish' meta-command
182 ;; FIXME: The following modules are for
183 ;; LUKS-DEVICE-MAPPING. We should instead propagate
184 ;; this info via gexps.
185 ((gnu build file-systems)
186 #:select (find-partition-by-luks-uuid))
189 (with-output-to-port (%make-void-port "w")
191 (set-path-environment-variable "PATH" '("bin" "sbin")
192 '#$helper-packages)))
194 (boot-system #:mounts '#$(map file-system->spec file-systems)
195 #:pre-mount (lambda ()
196 (and #$@device-mapping-commands))
197 #:linux-modules '#$linux-modules
198 #:linux-module-directory '#$kodir
199 #:qemu-guest-networking? #$qemu-networking?
200 #:volatile-root? '#$volatile-root?)))
201 #:name "raw-initrd")))
203 (define* (file-system-packages file-systems #:key (volatile-root? #f))
204 "Return the list of statically-linked, stripped packages to check
206 `(,@(if (find (lambda (fs)
207 (string-prefix? "ext" (file-system-type fs)))
211 ,@(if (find (lambda (fs)
212 (string-suffix? "fat" (file-system-type fs)))
214 (list fatfsck/static)
216 ,@(if (find (file-system-type-predicate "btrfs") file-systems)
217 (list btrfs-progs/static)
220 (list unionfs-fuse/static)
223 (define* (base-initrd file-systems
231 "Return a monadic derivation that builds a generic initrd, with kernel
232 modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
233 mounted by the initrd, possibly in addition to the root file system specified
234 on the kernel command line via '--root'. MAPPED-DEVICES is a list of device
235 mappings to realize before FILE-SYSTEMS are mounted.
237 QEMU-NETWORKING? and VOLATILE-ROOT? behaves as in raw-initrd.
239 When VIRTIO? is true, load additional modules so the initrd can
240 be used as a QEMU guest with the root file system on a para-virtualized block
243 The initrd is automatically populated with all the kernel modules necessary
244 for FILE-SYSTEMS and for the given options. However, additional kernel
245 modules can be listed in EXTRA-MODULES. They will be added to the initrd, and
246 loaded at boot time in the order in which they appear."
247 (define virtio-modules
248 ;; Modules for Linux para-virtualized devices, for use in QEMU guests.
249 '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
253 ;; Modules needed to mount CIFS file systems.
254 '("md4" "ecb" "cifs"))
256 (define virtio-9p-modules
257 ;; Modules for the 9p paravirtualized file system.
258 '("9p" "9pnet_virtio"))
260 (define (file-system-type-predicate type)
262 (string=? (file-system-type fs) type)))
264 (define linux-modules
265 ;; Modules added to the initrd and loaded from the initrd.
266 `("ahci" ;for SATA controllers
267 "usb-storage" "uas" ;for the installation image etc.
268 "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot
269 "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
270 "nvme" ;for new SSD NVMe devices
271 "nls_iso8859-1" ;for `mkfs.fat`, et.al
272 ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
273 '("pata_acpi" "pata_atiixp" ;for ATA controllers
274 "isci") ;for SAS controllers like Intel C602
276 ,@(if (or virtio? qemu-networking?)
279 ,@(if (find (file-system-type-predicate "cifs") file-systems)
282 ,@(if (find (file-system-type-predicate "9p") file-systems)
285 ,@(if (find (file-system-type-predicate "btrfs") file-systems)
293 (define helper-packages
294 (file-system-packages file-systems #:volatile-root? volatile-root?))
296 (raw-initrd file-systems
298 #:linux-modules linux-modules
299 #:mapped-devices mapped-devices
300 #:helper-packages helper-packages
301 #:qemu-networking? qemu-networking?
302 #:volatile-root? volatile-root?))
304 ;;; linux-initrd.scm ends here