system: Add 'grep --color' alias in '.bash_profile' skeleton.
[jackhill/guix/guix.git] / gnu / system / linux-initrd.scm
CommitLineData
f09d925b 1;;; GNU Guix --- Functional package management for GNU
278d486b 2;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
cc023e32 3;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
ad857912 4;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
47bdc5a1 5;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
f09d925b
LC
6;;;
7;;; This file is part of GNU Guix.
8;;;
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.
13;;;
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.
18;;;
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/>.
21
735c6dd7
LC
22(define-module (gnu system linux-initrd)
23 #:use-module (guix monads)
e87f0591 24 #:use-module (guix store)
0c21d92b 25 #:use-module (guix gexp)
f09d925b 26 #:use-module (guix utils)
d4254711
LC
27 #:use-module ((guix store)
28 #:select (%store-prefix))
1c96c1bb
LC
29 #:use-module ((guix derivations)
30 #:select (derivation->output-path))
239c6e27 31 #:use-module (guix modules)
f09d925b 32 #:use-module (gnu packages compression)
866872aa 33 #:use-module (gnu packages disk)
f09d925b 34 #:use-module (gnu packages linux)
f989fa39 35 #:use-module (gnu packages guile)
f09d925b
LC
36 #:use-module ((gnu packages make-bootstrap)
37 #:select (%guile-static-stripped))
c5df1839 38 #:use-module (gnu system file-systems)
060d62a7 39 #:use-module (gnu system mapped-devices)
1c96c1bb 40 #:use-module (ice-9 match)
217b862f 41 #:use-module (ice-9 regex)
83bcd0b8 42 #:use-module (srfi srfi-1)
42d10464 43 #:use-module (srfi srfi-26)
735c6dd7 44 #:export (expression->initrd
47bdc5a1 45 raw-initrd
278d486b 46 file-system-packages
060238ae 47 base-initrd))
f09d925b
LC
48
49\f
50;;; Commentary:
51;;;
52;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in
53;;; particular initrd's that run Guile.
54;;;
55;;; Code:
56
57
58(define* (expression->initrd exp
59 #:key
60 (guile %guile-static-stripped)
f09d925b
LC
61 (gzip gzip)
62 (name "guile-initrd")
4ee96a79 63 (system (%current-system)))
fd1b1fa2 64 "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
df650fa8 65containing GUILE and that evaluates EXP, a G-expression, upon booting. All
4ee96a79 66the derivations referenced by EXP are automatically copied to the initrd."
f09d925b
LC
67
68 ;; General Linux overview in `Documentation/early-userspace/README' and
69 ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
70
6d9a8590
LC
71 (define init
72 (program-file "init" exp #:guile guile))
73
74 (define builder
75 (with-imported-modules (source-module-closure
76 '((gnu build linux-initrd)))
77 #~(begin
78 (use-modules (gnu build linux-initrd))
79
80 (mkdir #$output)
81 (build-initrd (string-append #$output "/initrd")
82 #:guile #$guile
83 #:init #$init
84 ;; Copy everything INIT refers to into the initrd.
85 #:references-graphs '("closure")
86 #:gzip (string-append #$gzip "/bin/gzip")))))
87
88 (gexp->derivation name builder
89 #:references-graphs `(("closure" ,init))))
735c6dd7 90
b21a1c5a
LC
91(define (flat-linux-module-directory linux modules)
92 "Return a flat directory containing the Linux kernel modules listed in
93MODULES and taken from LINUX."
94 (define build-exp
239c6e27
LC
95 (with-imported-modules (source-module-closure
96 '((guix build utils)
97 (gnu build linux-modules)))
4ee96a79
LC
98 #~(begin
99 (use-modules (ice-9 match) (ice-9 regex)
100 (srfi srfi-1)
101 (guix build utils)
102 (gnu build linux-modules))
b21a1c5a 103
4ee96a79
LC
104 (define (string->regexp str)
105 ;; Return a regexp that matches STR exactly.
106 (string-append "^" (regexp-quote str) "$"))
b21a1c5a 107
4ee96a79
LC
108 (define module-dir
109 (string-append #$linux "/lib/modules"))
b21a1c5a 110
4ee96a79
LC
111 (define (lookup module)
112 (let ((name (ensure-dot-ko module)))
113 (match (find-files module-dir (string->regexp name))
114 ((file)
115 file)
116 (()
117 (error "module not found" name module-dir))
118 ((_ ...)
119 (error "several modules by that name"
120 name module-dir)))))
600c285b 121
4ee96a79
LC
122 (define modules
123 (let ((modules (map lookup '#$modules)))
124 (append modules
125 (recursive-module-dependencies modules
126 #:lookup-module lookup))))
600c285b 127
4ee96a79
LC
128 (mkdir #$output)
129 (for-each (lambda (module)
130 (format #t "copying '~a'...~%" module)
131 (copy-file module
132 (string-append #$output "/"
133 (basename module))))
134 (delete-duplicates modules)))))
b21a1c5a 135
6d9a8590 136 (computed-file "linux-modules" build-exp))
b21a1c5a 137
47bdc5a1
MO
138(define* (raw-initrd file-systems
139 #:key
140 (linux linux-libre)
141 (linux-modules '())
142 (mapped-devices '())
143 (helper-packages '())
144 qemu-networking?
145 volatile-root?)
146 "Return a monadic derivation that builds a raw initrd, with kernel
147modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
148mounted by the initrd, possibly in addition to the root file system specified
149on the kernel command line via '--root'. LINUX-MODULES is a list of kernel
150modules to be loaded at boot time. MAPPED-DEVICES is a list of device
151mappings to realize before FILE-SYSTEMS are mounted.
152HELPER-PACKAGES is a list of packages to be copied in the initrd. It may include
153e2fsck/static or other packages needed by the initrd to check root partition.
154
155When QEMU-NETWORKING? is true, set up networking with the standard QEMU
156parameters.
157When VOLATILE-ROOT? is true, the root file system is writable but any changes
158to it are lost."
159 (define device-mapping-commands
160 ;; List of gexps to open the mapped devices.
161 (map (lambda (md)
162 (let* ((source (mapped-device-source md))
163 (target (mapped-device-target md))
164 (type (mapped-device-type md))
165 (open (mapped-device-kind-open type)))
166 (open source target)))
167 mapped-devices))
168
6d9a8590
LC
169 (define kodir
170 (flat-linux-module-directory linux linux-modules))
171
172 (expression->initrd
173 (with-imported-modules (source-module-closure
174 '((gnu build linux-boot)
175 (guix build utils)
176 (guix build bournish)
177 (gnu build file-systems)))
178 #~(begin
179 (use-modules (gnu build linux-boot)
180 (guix build utils)
181 (guix build bournish) ;add the 'bournish' meta-command
182 (srfi srfi-26)
183
184 ;; FIXME: The following modules are for
185 ;; LUKS-DEVICE-MAPPING. We should instead propagate
186 ;; this info via gexps.
187 ((gnu build file-systems)
188 #:select (find-partition-by-luks-uuid))
189 (rnrs bytevectors))
190
191 (with-output-to-port (%make-void-port "w")
192 (lambda ()
193 (set-path-environment-variable "PATH" '("bin" "sbin")
194 '#$helper-packages)))
195
196 (boot-system #:mounts '#$(map file-system->spec file-systems)
197 #:pre-mount (lambda ()
198 (and #$@device-mapping-commands))
199 #:linux-modules '#$linux-modules
200 #:linux-module-directory '#$kodir
201 #:qemu-guest-networking? #$qemu-networking?
202 #:volatile-root? '#$volatile-root?)))
203 #:name "raw-initrd"))
47bdc5a1 204
278d486b
LC
205(define* (file-system-packages file-systems #:key (volatile-root? #f))
206 "Return the list of statically-linked, stripped packages to check
207FILE-SYSTEMS."
208 `(,@(if (find (lambda (fs)
209 (string-prefix? "ext" (file-system-type fs)))
210 file-systems)
211 (list e2fsck/static)
212 '())
213 ,@(if (find (lambda (fs)
214 (string-suffix? "fat" (file-system-type fs)))
215 file-systems)
216 (list fatfsck/static)
217 '())
218 ,@(if (find (file-system-type-predicate "btrfs") file-systems)
219 (list btrfs-progs/static)
220 '())
221 ,@(if volatile-root?
222 (list unionfs-fuse/static)
223 '())))
224
060238ae 225(define* (base-initrd file-systems
83bcd0b8 226 #:key
0d275f4a 227 (linux linux-libre)
de1c158f 228 (mapped-devices '())
4fc96187 229 qemu-networking?
24e0160a 230 volatile-root?
47bdc5a1 231 (virtio? #t)
6c1df081 232 (extra-modules '()))
0d275f4a
AW
233 "Return a monadic derivation that builds a generic initrd, with kernel
234modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
235mounted by the initrd, possibly in addition to the root file system specified
236on the kernel command line via '--root'. MAPPED-DEVICES is a list of device
237mappings to realize before FILE-SYSTEMS are mounted.
f09d925b 238
47bdc5a1
MO
239QEMU-NETWORKING? and VOLATILE-ROOT? behaves as in raw-initrd.
240
241When VIRTIO? is true, load additional modules so the initrd can
e26d5076
LC
242be used as a QEMU guest with the root file system on a para-virtualized block
243device.
112440a7 244
fa16f845
LC
245The initrd is automatically populated with all the kernel modules necessary
246for FILE-SYSTEMS and for the given options. However, additional kernel
247modules can be listed in EXTRA-MODULES. They will be added to the initrd, and
6c1df081 248loaded at boot time in the order in which they appear."
24e0160a
LC
249 (define virtio-modules
250 ;; Modules for Linux para-virtualized devices, for use in QEMU guests.
a182e94e
LC
251 '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
252 "virtio_console"))
24e0160a 253
d4254711
LC
254 (define cifs-modules
255 ;; Modules needed to mount CIFS file systems.
08b1990a 256 '("md4" "ecb" "cifs"))
88840f02 257
4919d684
LC
258 (define virtio-9p-modules
259 ;; Modules for the 9p paravirtualized file system.
08b1990a 260 '("9p" "9pnet_virtio"))
4919d684 261
83bcd0b8
LC
262 (define (file-system-type-predicate type)
263 (lambda (fs)
264 (string=? (file-system-type fs) type)))
265
d4254711
LC
266 (define linux-modules
267 ;; Modules added to the initrd and loaded from the initrd.
493c245b 268 `("ahci" ;for SATA controllers
493c245b 269 "usb-storage" "uas" ;for the installation image etc.
cc023e32 270 "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot
dfb9001a 271 "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
ad857912 272 "nvme" ;for new SSD NVMe devices
4d415f0c 273 "nls_iso8859-1" ;for `mkfs.fat`, et.al
9f4a2496
MW
274 ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
275 '("pata_acpi" "pata_atiixp" ;for ATA controllers
276 "isci") ;for SAS controllers like Intel C602
277 '())
c299dffc 278 ,@(if (or virtio? qemu-networking?)
24e0160a
LC
279 virtio-modules
280 '())
83bcd0b8 281 ,@(if (find (file-system-type-predicate "cifs") file-systems)
4919d684
LC
282 cifs-modules
283 '())
83bcd0b8 284 ,@(if (find (file-system-type-predicate "9p") file-systems)
4919d684 285 virtio-9p-modules
1c96c1bb 286 '())
b1a505ba
DC
287 ,@(if (find (file-system-type-predicate "btrfs") file-systems)
288 '("btrfs")
289 '())
ed3485fa
DM
290 ,@(if (find (file-system-type-predicate "iso9660") file-systems)
291 '("isofs")
292 '())
1c96c1bb 293 ,@(if volatile-root?
08b1990a 294 '("fuse")
fa16f845
LC
295 '())
296 ,@extra-modules))
f09d925b 297
3c05b4bc 298 (define helper-packages
72089954 299 (file-system-packages file-systems #:volatile-root? volatile-root?))
3c05b4bc 300
47bdc5a1
MO
301 (raw-initrd file-systems
302 #:linux linux
303 #:linux-modules linux-modules
304 #:mapped-devices mapped-devices
305 #:helper-packages helper-packages
306 #:qemu-networking? qemu-networking?
307 #:volatile-root? volatile-root?))
f09d925b
LC
308
309;;; linux-initrd.scm ends here