Commit | Line | Data |
---|---|---|
f09d925b | 1 | ;;; GNU Guix --- Functional package management for GNU |
b0dd47a8 | 2 | ;;; Copyright © 2013, 2014 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) | |
0c21d92b | 21 | #:use-module (guix gexp) |
f09d925b | 22 | #:use-module (guix utils) |
d4254711 LC |
23 | #:use-module ((guix store) |
24 | #:select (%store-prefix)) | |
1c96c1bb LC |
25 | #:use-module ((guix derivations) |
26 | #:select (derivation->output-path)) | |
f09d925b LC |
27 | #:use-module (gnu packages cpio) |
28 | #:use-module (gnu packages compression) | |
29 | #:use-module (gnu packages linux) | |
f989fa39 | 30 | #:use-module (gnu packages guile) |
f09d925b LC |
31 | #:use-module ((gnu packages make-bootstrap) |
32 | #:select (%guile-static-stripped)) | |
c5df1839 | 33 | #:use-module (gnu system file-systems) |
1c96c1bb | 34 | #:use-module (ice-9 match) |
217b862f | 35 | #:use-module (ice-9 regex) |
83bcd0b8 | 36 | #:use-module (srfi srfi-1) |
735c6dd7 | 37 | #:export (expression->initrd |
060238ae | 38 | base-initrd)) |
f09d925b LC |
39 | |
40 | \f | |
41 | ;;; Commentary: | |
42 | ;;; | |
43 | ;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in | |
44 | ;;; particular initrd's that run Guile. | |
45 | ;;; | |
46 | ;;; Code: | |
47 | ||
48 | ||
49 | (define* (expression->initrd exp | |
50 | #:key | |
51 | (guile %guile-static-stripped) | |
52 | (cpio cpio) | |
53 | (gzip gzip) | |
54 | (name "guile-initrd") | |
55 | (system (%current-system)) | |
f989fa39 | 56 | (modules '()) |
0c21d92b | 57 | (to-copy '()) |
f09d925b LC |
58 | (linux #f) |
59 | (linux-modules '())) | |
fd1b1fa2 LC |
60 | "Return a derivation that builds a Linux initrd (a gzipped cpio archive) |
61 | containing GUILE and that evaluates EXP, a G-expression, upon booting. | |
62 | ||
63 | LINUX-MODULES is a list of '.ko' file names to be copied from LINUX into the | |
64 | initrd. TO-COPY is a list of additional derivations or packages to copy to | |
65 | the initrd. MODULES is a list of Guile module names to be embedded in the | |
66 | initrd." | |
f09d925b LC |
67 | |
68 | ;; General Linux overview in `Documentation/early-userspace/README' and | |
69 | ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'. | |
70 | ||
217b862f LC |
71 | (define (string->regexp str) |
72 | ;; Return a regexp that matches STR exactly. | |
73 | (string-append "^" (regexp-quote str) "$")) | |
74 | ||
0c21d92b LC |
75 | (mlet* %store-monad ((source (imported-modules modules)) |
76 | (compiled (compiled-modules modules))) | |
77 | (define builder | |
548f7a8f | 78 | ;; TODO: Move most of this code to (gnu build linux-initrd). |
0c21d92b LC |
79 | #~(begin |
80 | (use-modules (guix build utils) | |
81 | (ice-9 pretty-print) | |
82 | (ice-9 popen) | |
83 | (ice-9 match) | |
84 | (ice-9 ftw) | |
85 | (srfi srfi-26) | |
86 | (system base compile) | |
87 | (rnrs bytevectors) | |
88 | ((system foreign) #:select (sizeof))) | |
1c96c1bb | 89 | |
0c21d92b LC |
90 | (let ((cpio (string-append #$cpio "/bin/cpio")) |
91 | (gzip (string-append #$gzip "/bin/gzip")) | |
92 | (modules #$source) | |
93 | (gos #$compiled) | |
94 | (scm-dir (string-append "share/guile/" (effective-version))) | |
95 | (go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a" | |
96 | (effective-version) | |
97 | (if (eq? (native-endianness) (endianness little)) | |
98 | "LE" | |
99 | "BE") | |
100 | (sizeof '*) | |
101 | (effective-version)))) | |
102 | (mkdir #$output) | |
103 | (mkdir "contents") | |
104 | (with-directory-excursion "contents" | |
105 | (copy-recursively #$guile ".") | |
106 | (call-with-output-file "init" | |
107 | (lambda (p) | |
108 | (format p "#!/bin/guile -ds~%!#~%" #$guile) | |
109 | (pretty-print '#$exp p))) | |
110 | (chmod "init" #o555) | |
111 | (chmod "bin/guile" #o555) | |
f09d925b | 112 | |
0c21d92b LC |
113 | ;; Copy Guile modules. |
114 | (chmod scm-dir #o777) | |
115 | (copy-recursively modules scm-dir | |
116 | #:follow-symlinks? #t) | |
117 | (copy-recursively gos (string-append "lib/guile/" | |
118 | (effective-version) "/ccache") | |
119 | #:follow-symlinks? #t) | |
f09d925b | 120 | |
0c21d92b LC |
121 | ;; Compile `init'. |
122 | (mkdir-p go-dir) | |
123 | (set! %load-path (cons modules %load-path)) | |
124 | (set! %load-compiled-path (cons gos %load-compiled-path)) | |
125 | (compile-file "init" | |
126 | #:opts %auto-compilation-options | |
127 | #:output-file (string-append go-dir "/init.go")) | |
f989fa39 | 128 | |
0c21d92b LC |
129 | ;; Copy Linux modules. |
130 | (let* ((linux #$linux) | |
131 | (module-dir (and linux | |
132 | (string-append linux "/lib/modules")))) | |
133 | (mkdir "modules") | |
134 | #$@(map (lambda (module) | |
135 | #~(match (find-files module-dir | |
136 | #$(string->regexp module)) | |
137 | ((file) | |
138 | (format #t "copying '~a'...~%" file) | |
139 | (copy-file file (string-append "modules/" | |
140 | #$module))) | |
141 | (() | |
142 | (error "module not found" #$module module-dir)) | |
143 | ((_ ...) | |
144 | (error "several modules by that name" | |
145 | #$module module-dir)))) | |
146 | linux-modules)) | |
f09d925b | 147 | |
0c21d92b LC |
148 | (let ((store #$(string-append "." (%store-prefix))) |
149 | (to-copy '#$to-copy)) | |
150 | (unless (null? to-copy) | |
151 | (mkdir-p store)) | |
152 | ;; XXX: Should we do export-references-graph? | |
153 | (for-each (lambda (input) | |
154 | (let ((target | |
155 | (string-append store "/" | |
156 | (basename input)))) | |
157 | (copy-recursively input target))) | |
158 | to-copy)) | |
f09d925b | 159 | |
0c21d92b LC |
160 | ;; Reset the timestamps of all the files that will make it in the |
161 | ;; initrd. | |
162 | (for-each (cut utime <> 0 0 0 0) | |
163 | (find-files "." ".*")) | |
1c96c1bb | 164 | |
0c21d92b LC |
165 | (system* cpio "--version") |
166 | (let ((pipe (open-pipe* OPEN_WRITE cpio "-o" | |
167 | "-O" (string-append #$output "/initrd") | |
168 | "-H" "newc" "--null"))) | |
169 | (define print0 | |
170 | (let ((len (string-length "./"))) | |
171 | (lambda (file) | |
172 | (format pipe "~a\0" (string-drop file len))))) | |
f09d925b | 173 | |
0c21d92b LC |
174 | ;; Note: as per `ramfs-rootfs-initramfs.txt', always add |
175 | ;; directory entries before the files that are inside of it: "The | |
176 | ;; Linux kernel cpio extractor won't create files in a directory | |
177 | ;; that doesn't exist, so the directory entries must go before | |
178 | ;; the files that go in those directories." | |
179 | (file-system-fold (const #t) | |
180 | (lambda (file stat result) ; leaf | |
181 | (print0 file)) | |
182 | (lambda (dir stat result) ; down | |
183 | (unless (string=? dir ".") | |
184 | (print0 dir))) | |
185 | (const #f) ; up | |
186 | (const #f) ; skip | |
187 | (const #f) | |
188 | #f | |
189 | ".") | |
f09d925b | 190 | |
0c21d92b LC |
191 | (and (zero? (close-pipe pipe)) |
192 | (with-directory-excursion #$output | |
193 | (and (zero? (system* gzip "--best" "initrd")) | |
194 | (rename-file "initrd.gz" "initrd"))))))))) | |
f09d925b | 195 | |
0c21d92b LC |
196 | (gexp->derivation name builder |
197 | #:modules '((guix build utils))))) | |
735c6dd7 | 198 | |
83bcd0b8 LC |
199 | (define (file-system->spec fs) |
200 | "Return a list corresponding to file-system FS that can be passed to the | |
201 | initrd code." | |
202 | (match fs | |
d4c87617 LC |
203 | (($ <file-system> device title mount-point type flags options _ check?) |
204 | (list device title mount-point type flags options check?)))) | |
83bcd0b8 | 205 | |
060238ae | 206 | (define* (base-initrd file-systems |
83bcd0b8 | 207 | #:key |
4fc96187 | 208 | qemu-networking? |
24e0160a LC |
209 | virtio? |
210 | volatile-root? | |
fa16f845 | 211 | (extra-modules '()) |
24e0160a | 212 | guile-modules-in-chroot?) |
060238ae LC |
213 | "Return a monadic derivation that builds a generic initrd. FILE-SYSTEMS is |
214 | a list of file-systems to be mounted by the initrd, possibly in addition to | |
215 | the root file system specified on the kernel command line via '--root'. | |
f09d925b | 216 | |
112440a7 | 217 | When QEMU-NETWORKING? is true, set up networking with the standard QEMU |
24e0160a LC |
218 | parameters. When VIRTIO? is true, load additional modules so the initrd can |
219 | be used as a QEMU guest with para-virtualized I/O drivers. | |
112440a7 | 220 | |
83bcd0b8 LC |
221 | When VOLATILE-ROOT? is true, the root file system is writable but any changes |
222 | to it are lost. | |
b48d21b2 | 223 | |
fa16f845 LC |
224 | The initrd is automatically populated with all the kernel modules necessary |
225 | for FILE-SYSTEMS and for the given options. However, additional kernel | |
226 | modules can be listed in EXTRA-MODULES. They will be added to the initrd, and | |
227 | loaded at boot time in the order in which they appear. | |
228 | ||
d4254711 LC |
229 | When GUILE-MODULES-IN-CHROOT? is true, make core Guile modules available in |
230 | the new root. This is necessary is the file specified as '--load' needs | |
231 | access to these modules (which is the case if it wants to even just print an | |
83bcd0b8 | 232 | exception and backtrace!)." |
24e0160a LC |
233 | (define virtio-modules |
234 | ;; Modules for Linux para-virtualized devices, for use in QEMU guests. | |
235 | '("virtio.ko" "virtio_ring.ko" "virtio_pci.ko" | |
236 | "virtio_balloon.ko" "virtio_blk.ko" "virtio_net.ko")) | |
237 | ||
d4254711 LC |
238 | (define cifs-modules |
239 | ;; Modules needed to mount CIFS file systems. | |
240 | '("md4.ko" "ecb.ko" "cifs.ko")) | |
88840f02 | 241 | |
4919d684 LC |
242 | (define virtio-9p-modules |
243 | ;; Modules for the 9p paravirtualized file system. | |
6f22f3c9 | 244 | '("fscache.ko" "9pnet.ko" "9p.ko" "9pnet_virtio.ko")) |
4919d684 | 245 | |
83bcd0b8 LC |
246 | (define (file-system-type-predicate type) |
247 | (lambda (fs) | |
248 | (string=? (file-system-type fs) type))) | |
249 | ||
d4254711 LC |
250 | (define linux-modules |
251 | ;; Modules added to the initrd and loaded from the initrd. | |
c299dffc DT |
252 | `("libahci.ko" "ahci.ko" ; modules for SATA controllers |
253 | ,@(if (or virtio? qemu-networking?) | |
24e0160a LC |
254 | virtio-modules |
255 | '()) | |
83bcd0b8 | 256 | ,@(if (find (file-system-type-predicate "cifs") file-systems) |
4919d684 LC |
257 | cifs-modules |
258 | '()) | |
83bcd0b8 | 259 | ,@(if (find (file-system-type-predicate "9p") file-systems) |
4919d684 | 260 | virtio-9p-modules |
1c96c1bb LC |
261 | '()) |
262 | ,@(if volatile-root? | |
263 | '("fuse.ko") | |
fa16f845 LC |
264 | '()) |
265 | ,@extra-modules)) | |
f09d925b | 266 | |
3c05b4bc LC |
267 | (define helper-packages |
268 | ;; Packages to be copied on the initrd. | |
269 | `(,@(if (find (lambda (fs) | |
270 | (string-prefix? "ext" (file-system-type fs))) | |
271 | file-systems) | |
272 | (list e2fsck/static) | |
273 | '()) | |
274 | ,@(if volatile-root? | |
275 | (list unionfs-fuse/static) | |
276 | '()))) | |
277 | ||
0c21d92b LC |
278 | (expression->initrd |
279 | #~(begin | |
548f7a8f | 280 | (use-modules (gnu build linux-initrd) |
3c05b4bc | 281 | (guix build utils) |
0c21d92b | 282 | (srfi srfi-26)) |
1c96c1bb | 283 | |
3c05b4bc LC |
284 | (with-output-to-port (%make-void-port "w") |
285 | (lambda () | |
286 | (set-path-environment-variable "PATH" '("bin" "sbin") | |
287 | '#$helper-packages))) | |
288 | ||
83bcd0b8 | 289 | (boot-system #:mounts '#$(map file-system->spec file-systems) |
0c21d92b | 290 | #:linux-modules '#$linux-modules |
112440a7 | 291 | #:qemu-guest-networking? #$qemu-networking? |
0c21d92b | 292 | #:guile-modules-in-chroot? '#$guile-modules-in-chroot? |
0c21d92b | 293 | #:volatile-root? '#$volatile-root?)) |
060238ae | 294 | #:name "base-initrd" |
0c21d92b | 295 | #:modules '((guix build utils) |
548f7a8f | 296 | (gnu build linux-initrd)) |
3c05b4bc | 297 | #:to-copy helper-packages |
0c21d92b LC |
298 | #:linux linux-libre |
299 | #:linux-modules linux-modules)) | |
f09d925b LC |
300 | |
301 | ;;; linux-initrd.scm ends here |