projects/guix·blob version-0.10.0 · refs

254 lines · 9.8 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <[email protected]>
3;;; Copyright © 2016 Mark H Weaver <[email protected]>
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20(define-module (gnu system linux-initrd)
21 #:use-module (guix monads)
22 #:use-module (guix store)
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 (gnu packages compression)
30 #:use-module (gnu packages linux)
31 #:use-module (gnu packages guile)
32 #:use-module ((gnu packages make-bootstrap)
33 #:select (%guile-static-stripped))
34 #:use-module (gnu system file-systems)
35 #:use-module (ice-9 match)
36 #:use-module (ice-9 regex)
37 #:use-module (srfi srfi-1)
38 #:use-module (srfi srfi-26)
39 #:export (expression->initrd
40 base-initrd))
41
42
43;;; Commentary:
44;;;
45;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in
46;;; particular initrd's that run Guile.
47;;;
48;;; Code:
49
50
51(define* (expression->initrd exp
52 #:key
53 (guile %guile-static-stripped)
54 (gzip gzip)
55 (name "guile-initrd")
56 (system (%current-system))
57 (modules '()))
58 "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
59containing GUILE and that evaluates EXP, a G-expression, upon booting. All
60the derivations referenced by EXP are automatically copied to the initrd.
61
62MODULES is a list of Guile module names to be embedded in the initrd."
63
64 ;; General Linux overview in `Documentation/early-userspace/README' and
65 ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
66
67 (mlet %store-monad ((init (gexp->script "init" exp
68 #:modules modules
69 #:guile guile)))
70 (define builder
71 #~(begin
72 (use-modules (gnu build linux-initrd))
73
74 (mkdir #$output)
75 (build-initrd (string-append #$output "/initrd")
76 #:guile #$guile
77 #:init #$init
78 ;; Copy everything INIT refers to into the initrd.
79 #:references-graphs '("closure")
80 #:gzip (string-append #$gzip "/bin/gzip"))))
81
82 (gexp->derivation name builder
83 #:modules '((guix cpio)
84 (guix build utils)
85 (guix build store-copy)
86 (gnu build linux-initrd))
87 #:references-graphs `(("closure" ,init)))))
88
89(define (flat-linux-module-directory linux modules)
90 "Return a flat directory containing the Linux kernel modules listed in
91MODULES and taken from LINUX."
92 (define build-exp
93 #~(begin
94 (use-modules (ice-9 match) (ice-9 regex)
95 (srfi srfi-1)
96 (guix build utils)
97 (gnu build linux-modules))
98
99 (define (string->regexp str)
100 ;; Return a regexp that matches STR exactly.
101 (string-append "^" (regexp-quote str) "$"))
102
103 (define module-dir
104 (string-append #$linux "/lib/modules"))
105
106 (define (lookup module)
107 (let ((name (ensure-dot-ko module)))
108 (match (find-files module-dir (string->regexp name))
109 ((file)
110 file)
111 (()
112 (error "module not found" name module-dir))
113 ((_ ...)
114 (error "several modules by that name"
115 name module-dir)))))
116
117 (define modules
118 (let ((modules (map lookup '#$modules)))
119 (append modules
120 (recursive-module-dependencies modules
121 #:lookup-module lookup))))
122
123 (mkdir #$output)
124 (for-each (lambda (module)
125 (format #t "copying '~a'...~%" module)
126 (copy-file module
127 (string-append #$output "/"
128 (basename module))))
129 (delete-duplicates modules))))
130
131 (gexp->derivation "linux-modules" build-exp
132 #:modules '((guix build utils)
133 (guix elf)
134 (gnu build linux-modules))))
135
136(define* (base-initrd file-systems
137 #:key
138 (linux linux-libre)
139 (mapped-devices '())
140 qemu-networking?
141 (virtio? #t)
142 volatile-root?
143 (extra-modules '()))
144 "Return a monadic derivation that builds a generic initrd, with kernel
145modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
146mounted by the initrd, possibly in addition to the root file system specified
147on the kernel command line via '--root'. MAPPED-DEVICES is a list of device
148mappings to realize before FILE-SYSTEMS are mounted.
149
150When QEMU-NETWORKING? is true, set up networking with the standard QEMU
151parameters. When VIRTIO? is true, load additional modules so the initrd can
152be used as a QEMU guest with the root file system on a para-virtualized block
153device.
154
155When VOLATILE-ROOT? is true, the root file system is writable but any changes
156to it are lost.
157
158The initrd is automatically populated with all the kernel modules necessary
159for FILE-SYSTEMS and for the given options. However, additional kernel
160modules can be listed in EXTRA-MODULES. They will be added to the initrd, and
161loaded at boot time in the order in which they appear."
162 (define virtio-modules
163 ;; Modules for Linux para-virtualized devices, for use in QEMU guests.
164 '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
165 "virtio_console"))
166
167 (define cifs-modules
168 ;; Modules needed to mount CIFS file systems.
169 '("md4" "ecb" "cifs"))
170
171 (define virtio-9p-modules
172 ;; Modules for the 9p paravirtualized file system.
173 '("9p" "9pnet_virtio"))
174
175 (define (file-system-type-predicate type)
176 (lambda (fs)
177 (string=? (file-system-type fs) type)))
178
179 (define linux-modules
180 ;; Modules added to the initrd and loaded from the initrd.
181 `("ahci" ;for SATA controllers
182 "usb-storage" "uas" ;for the installation image etc.
183 "usbhid" "hid-generic" "hid-apple" ;keyboards during early boot
184 "dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
185 ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
186 '("pata_acpi" "pata_atiixp" ;for ATA controllers
187 "isci") ;for SAS controllers like Intel C602
188 '())
189 ,@(if (or virtio? qemu-networking?)
190 virtio-modules
191 '())
192 ,@(if (find (file-system-type-predicate "cifs") file-systems)
193 cifs-modules
194 '())
195 ,@(if (find (file-system-type-predicate "9p") file-systems)
196 virtio-9p-modules
197 '())
198 ,@(if volatile-root?
199 '("fuse")
200 '())
201 ,@extra-modules))
202
203 (define helper-packages
204 ;; Packages to be copied on the initrd.
205 `(,@(if (find (lambda (fs)
206 (string-prefix? "ext" (file-system-type fs)))
207 file-systems)
208 (list e2fsck/static)
209 '())
210 ,@(if volatile-root?
211 (list unionfs-fuse/static)
212 '())))
213
214 (define device-mapping-commands
215 ;; List of gexps to open the mapped devices.
216 (map (lambda (md)
217 (let* ((source (mapped-device-source md))
218 (target (mapped-device-target md))
219 (type (mapped-device-type md))
220 (open (mapped-device-kind-open type)))
221 (open source target)))
222 mapped-devices))
223
224 (mlet %store-monad ((kodir (flat-linux-module-directory linux
225 linux-modules)))
226 (expression->initrd
227 #~(begin
228 (use-modules (gnu build linux-boot)
229 (guix build utils)
230 (guix build bournish) ;add the 'bournish' meta-command
231 (srfi srfi-26))
232
233 (with-output-to-port (%make-void-port "w")
234 (lambda ()
235 (set-path-environment-variable "PATH" '("bin" "sbin")
236 '#$helper-packages)))
237
238 (boot-system #:mounts '#$(map file-system->spec file-systems)
239 #:pre-mount (lambda ()
240 (and #$@device-mapping-commands))
241 #:linux-modules '#$linux-modules
242 #:linux-module-directory '#$kodir
243 #:qemu-guest-networking? #$qemu-networking?
244 #:volatile-root? '#$volatile-root?))
245 #:name "base-initrd"
246 #:modules '((guix build bournish)
247 (guix build utils)
248 (guix build syscalls)
249 (gnu build linux-boot)
250 (gnu build linux-modules)
251 (gnu build file-systems)
252 (guix elf)))))
253
254;;; linux-initrd.scm ends here