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