projects/guix·blob version-0.14.0 · refs

323 lines · 12.7 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <[email protected]>
3;;; Copyright © 2016 Mark H Weaver <[email protected]>
4;;; Copyright © 2016 Jan Nieuwenhuizen <[email protected]>
5;;; Copyright © 2017 Mathieu Othacehe <[email protected]>
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
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
45 raw-initrd
46 file-system-packages
47 base-initrd))
48
49
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)
61 (gzip gzip)
62 (name "guile-initrd")
63 (system (%current-system)))
64 "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
65containing GUILE and that evaluates EXP, a G-expression, upon booting. All
66the derivations referenced by EXP are automatically copied to the initrd."
67
68 ;; General Linux overview in `Documentation/early-userspace/README' and
69 ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
70
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
82 ;; The guile used in the initrd must be present in the store, so
83 ;; that module loading works once the root is switched.
84 ;;
85 ;; To ensure that is the case, add an explicit reference to the
86 ;; guile package used in the initrd to the output.
87 ;;
88 ;; This fixes guix-patches bug #28399, "Fix mysql activation, and
89 ;; add a basic test".
90 (call-with-output-file (string-append #$ output "/references")
91 (lambda (port)
92 (simple-format port "~A\n" #$guile)))
93
94 (build-initrd (string-append #$output "/initrd")
95 #:guile #$guile
96 #:init #$init
97 ;; Copy everything INIT refers to into the initrd.
98 #:references-graphs '("closure")
99 #:gzip (string-append #$gzip "/bin/gzip")))))
100
101 (gexp->derivation name builder
102 #:references-graphs `(("closure" ,init))))
103
104(define (flat-linux-module-directory linux modules)
105 "Return a flat directory containing the Linux kernel modules listed in
106MODULES and taken from LINUX."
107 (define build-exp
108 (with-imported-modules (source-module-closure
109 '((guix build utils)
110 (gnu build linux-modules)))
111 #~(begin
112 (use-modules (ice-9 match) (ice-9 regex)
113 (srfi srfi-1)
114 (guix build utils)
115 (gnu build linux-modules))
116
117 (define (string->regexp str)
118 ;; Return a regexp that matches STR exactly.
119 (string-append "^" (regexp-quote str) "$"))
120
121 (define module-dir
122 (string-append #$linux "/lib/modules"))
123
124 (define (lookup module)
125 (let ((name (ensure-dot-ko module)))
126 (match (find-files module-dir (string->regexp name))
127 ((file)
128 file)
129 (()
130 (error "module not found" name module-dir))
131 ((_ ...)
132 (error "several modules by that name"
133 name module-dir)))))
134
135 (define modules
136 (let ((modules (map lookup '#$modules)))
137 (append modules
138 (recursive-module-dependencies modules
139 #:lookup-module lookup))))
140
141 (mkdir #$output)
142 (for-each (lambda (module)
143 (format #t "copying '~a'...~%" module)
144 (copy-file module
145 (string-append #$output "/"
146 (basename module))))
147 (delete-duplicates modules)))))
148
149 (computed-file "linux-modules" build-exp))
150
151(define* (raw-initrd file-systems
152 #:key
153 (linux linux-libre)
154 (linux-modules '())
155 (mapped-devices '())
156 (helper-packages '())
157 qemu-networking?
158 volatile-root?)
159 "Return a monadic derivation that builds a raw initrd, with kernel
160modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
161mounted by the initrd, possibly in addition to the root file system specified
162on the kernel command line via '--root'. LINUX-MODULES is a list of kernel
163modules to be loaded at boot time. MAPPED-DEVICES is a list of device
164mappings to realize before FILE-SYSTEMS are mounted.
165HELPER-PACKAGES is a list of packages to be copied in the initrd. It may include
166e2fsck/static or other packages needed by the initrd to check root partition.
167
168When QEMU-NETWORKING? is true, set up networking with the standard QEMU
169parameters.
170When VOLATILE-ROOT? is true, the root file system is writable but any changes
171to it are lost."
172 (define device-mapping-commands
173 ;; List of gexps to open the mapped devices.
174 (map (lambda (md)
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)))
180 mapped-devices))
181
182 (define kodir
183 (flat-linux-module-directory linux linux-modules))
184
185 (expression->initrd
186 (with-imported-modules (source-module-closure
187 '((gnu build linux-boot)
188 (guix build utils)
189 (guix build bournish)
190 (gnu system file-systems)
191 (gnu build file-systems)))
192 #~(begin
193 (use-modules (gnu build linux-boot)
194 (gnu system file-systems)
195 (guix build utils)
196 (guix build bournish) ;add the 'bournish' meta-command
197 (srfi srfi-26)
198
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))
204 (rnrs bytevectors))
205
206 (with-output-to-port (%make-void-port "w")
207 (lambda ()
208 (set-path-environment-variable "PATH" '("bin" "sbin")
209 '#$helper-packages)))
210
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 #:qemu-guest-networking? #$qemu-networking?
219 #:volatile-root? '#$volatile-root?)))
220 #:name "raw-initrd"))
221
222(define* (file-system-packages file-systems #:key (volatile-root? #f))
223 "Return the list of statically-linked, stripped packages to check
224FILE-SYSTEMS."
225 `(,@(if (find (lambda (fs)
226 (string-prefix? "ext" (file-system-type fs)))
227 file-systems)
228 (list e2fsck/static)
229 '())
230 ,@(if (find (lambda (fs)
231 (string-suffix? "fat" (file-system-type fs)))
232 file-systems)
233 (list fatfsck/static)
234 '())
235 ,@(if (find (file-system-type-predicate "btrfs") file-systems)
236 (list btrfs-progs/static)
237 '())))
238
239(define* (base-initrd file-systems
240 #:key
241 (linux linux-libre)
242 (mapped-devices '())
243 qemu-networking?
244 volatile-root?
245 (virtio? #t)
246 (extra-modules '()))
247 "Return a monadic derivation that builds a generic initrd, with kernel
248modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
249mounted by the initrd, possibly in addition to the root file system specified
250on the kernel command line via '--root'. MAPPED-DEVICES is a list of device
251mappings to realize before FILE-SYSTEMS are mounted.
252
253QEMU-NETWORKING? and VOLATILE-ROOT? behaves as in raw-initrd.
254
255When VIRTIO? is true, load additional modules so the initrd can
256be used as a QEMU guest with the root file system on a para-virtualized block
257device.
258
259The initrd is automatically populated with all the kernel modules necessary
260for FILE-SYSTEMS and for the given options. However, additional kernel
261modules can be listed in EXTRA-MODULES. They will be added to the initrd, and
262loaded at boot time in the order in which they appear."
263 (define virtio-modules
264 ;; Modules for Linux para-virtualized devices, for use in QEMU guests.
265 '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
266 "virtio_console"))
267
268 (define cifs-modules
269 ;; Modules needed to mount CIFS file systems.
270 '("md4" "ecb" "cifs"))
271
272 (define virtio-9p-modules
273 ;; Modules for the 9p paravirtualized file system.
274 '("9p" "9pnet_virtio"))
275
276 (define (file-system-type-predicate type)
277 (lambda (fs)
278 (string=? (file-system-type fs) type)))
279
280 (define linux-modules
281 ;; Modules added to the initrd and loaded from the initrd.
282 `("ahci" ;for SATA controllers
283 "usb-storage" "uas" ;for the installation image etc.
284 "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot
285 "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
286 "nvme" ;for new SSD NVMe devices
287 "nls_iso8859-1" ;for `mkfs.fat`, et.al
288 ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
289 '("pata_acpi" "pata_atiixp" ;for ATA controllers
290 "isci") ;for SAS controllers like Intel C602
291 '())
292 ,@(if (or virtio? qemu-networking?)
293 virtio-modules
294 '())
295 ,@(if (find (file-system-type-predicate "cifs") file-systems)
296 cifs-modules
297 '())
298 ,@(if (find (file-system-type-predicate "9p") file-systems)
299 virtio-9p-modules
300 '())
301 ,@(if (find (file-system-type-predicate "btrfs") file-systems)
302 '("btrfs")
303 '())
304 ,@(if (find (file-system-type-predicate "iso9660") file-systems)
305 '("isofs")
306 '())
307 ,@(if volatile-root?
308 '("overlay")
309 '())
310 ,@extra-modules))
311
312 (define helper-packages
313 (file-system-packages file-systems #:volatile-root? volatile-root?))
314
315 (raw-initrd file-systems
316 #:linux linux
317 #:linux-modules linux-modules
318 #:mapped-devices mapped-devices
319 #:helper-packages helper-packages
320 #:qemu-networking? qemu-networking?
321 #:volatile-root? volatile-root?))
322
323;;; linux-initrd.scm ends here