projects/guix·blob version-0.8.3 · refs

248 lines · 9.5 KiB

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