Commit | Line | Data |
---|---|---|
f09d925b LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> | |
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 packages linux-initrd) | |
20 | #:use-module (guix utils) | |
21 | #:use-module (guix licenses) | |
f989fa39 LC |
22 | #:use-module (guix build-system) |
23 | #:use-module ((guix derivations) | |
24 | #:select (imported-modules compiled-modules %guile-for-build)) | |
f09d925b LC |
25 | #:use-module (gnu packages) |
26 | #:use-module (gnu packages cpio) | |
27 | #:use-module (gnu packages compression) | |
28 | #:use-module (gnu packages linux) | |
f989fa39 | 29 | #:use-module (gnu packages guile) |
f09d925b LC |
30 | #:use-module ((gnu packages make-bootstrap) |
31 | #:select (%guile-static-stripped)) | |
32 | #:use-module (guix packages) | |
33 | #:use-module (guix download) | |
34 | #:use-module (guix build-system trivial)) | |
35 | ||
36 | \f | |
37 | ;;; Commentary: | |
38 | ;;; | |
39 | ;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in | |
40 | ;;; particular initrd's that run Guile. | |
41 | ;;; | |
42 | ;;; Code: | |
43 | ||
44 | ||
f989fa39 LC |
45 | (define-syntax-rule (raw-build-system (store system name inputs) body ...) |
46 | "Lift BODY to a package build system." | |
47 | ;; TODO: Generalize. | |
48 | (build-system | |
49 | (name "raw") | |
50 | (description "Raw build system") | |
51 | (build (lambda* (store name source inputs #:key system #:allow-other-keys) | |
52 | (parameterize ((%guile-for-build (package-derivation store | |
53 | guile-2.0))) | |
54 | body ...))))) | |
55 | ||
56 | (define (module-package modules) | |
57 | "Return a package that contains all of MODULES, a list of Guile module | |
58 | names." | |
59 | (package | |
60 | (name "guile-modules") | |
61 | (version "0") | |
62 | (source #f) | |
63 | (build-system (raw-build-system (store system name inputs) | |
64 | (imported-modules store modules | |
65 | #:name name | |
66 | #:system system))) | |
67 | (synopsis "Set of Guile modules") | |
68 | (description synopsis) | |
69 | (license gpl3+) | |
70 | (home-page "http://www.gnu.org/software/guix/"))) | |
71 | ||
72 | (define (compiled-module-package modules) | |
73 | "Return a package that contains the .go files corresponding to MODULES, a | |
74 | list of Guile module names." | |
75 | (package | |
76 | (name "guile-compiled-modules") | |
77 | (version "0") | |
78 | (source #f) | |
79 | (build-system (raw-build-system (store system name inputs) | |
80 | (compiled-modules store modules | |
81 | #:name name | |
82 | #:system system))) | |
83 | (synopsis "Set of compiled Guile modules") | |
84 | (description synopsis) | |
85 | (license gpl3+) | |
86 | (home-page "http://www.gnu.org/software/guix/"))) | |
87 | ||
f09d925b LC |
88 | (define* (expression->initrd exp |
89 | #:key | |
90 | (guile %guile-static-stripped) | |
91 | (cpio cpio) | |
92 | (gzip gzip) | |
93 | (name "guile-initrd") | |
94 | (system (%current-system)) | |
f989fa39 | 95 | (modules '()) |
f09d925b LC |
96 | (linux #f) |
97 | (linux-modules '())) | |
98 | "Return a package that contains a Linux initrd (a gzipped cpio archive) | |
99 | containing GUILE and that evaluates EXP upon booting. LINUX-MODULES is a list | |
f989fa39 LC |
100 | of `.ko' file names to be copied from LINUX into the initrd. MODULES is a |
101 | list of Guile module names to be embedded in the initrd." | |
f09d925b LC |
102 | |
103 | ;; General Linux overview in `Documentation/early-userspace/README' and | |
104 | ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'. | |
105 | ||
106 | (define builder | |
107 | `(begin | |
108 | (use-modules (guix build utils) | |
109 | (ice-9 pretty-print) | |
110 | (ice-9 popen) | |
111 | (ice-9 match) | |
112 | (ice-9 ftw) | |
113 | (srfi srfi-26) | |
114 | (system base compile) | |
115 | (rnrs bytevectors) | |
116 | ((system foreign) #:select (sizeof))) | |
117 | ||
f989fa39 LC |
118 | (let ((guile (assoc-ref %build-inputs "guile")) |
119 | (cpio (string-append (assoc-ref %build-inputs "cpio") | |
120 | "/bin/cpio")) | |
121 | (gzip (string-append (assoc-ref %build-inputs "gzip") | |
122 | "/bin/gzip")) | |
123 | (modules (assoc-ref %build-inputs "modules")) | |
124 | (gos (assoc-ref %build-inputs "modules/compiled")) | |
125 | (scm-dir (string-append "share/guile/" (effective-version))) | |
126 | (go-dir (format #f ".cache/guile/ccache/~a-~a-~a-~a" | |
127 | (effective-version) | |
128 | (if (eq? (native-endianness) (endianness little)) | |
129 | "LE" | |
130 | "BE") | |
131 | (sizeof '*) | |
132 | (effective-version))) | |
133 | (out (assoc-ref %outputs "out"))) | |
f09d925b LC |
134 | (mkdir out) |
135 | (mkdir "contents") | |
136 | (with-directory-excursion "contents" | |
137 | (copy-recursively guile ".") | |
138 | (call-with-output-file "init" | |
139 | (lambda (p) | |
140 | (format p "#!/bin/guile -ds~%!#~%" guile) | |
141 | (pretty-print ',exp p))) | |
142 | (chmod "init" #o555) | |
143 | (chmod "bin/guile" #o555) | |
144 | ||
f989fa39 LC |
145 | ;; Copy Guile modules. |
146 | (chmod scm-dir #o777) | |
147 | (copy-recursively modules scm-dir | |
148 | #:follow-symlinks? #t) | |
149 | (copy-recursively gos (string-append "lib/guile/" | |
150 | (effective-version) "/ccache") | |
151 | #:follow-symlinks? #t) | |
152 | ||
f09d925b | 153 | ;; Compile `init'. |
f989fa39 LC |
154 | (mkdir-p go-dir) |
155 | (set! %load-path (cons modules %load-path)) | |
156 | (set! %load-compiled-path (cons gos %load-compiled-path)) | |
157 | (compile-file "init" | |
158 | #:opts %auto-compilation-options | |
159 | #:output-file (string-append go-dir "/init.go")) | |
f09d925b | 160 | |
f989fa39 | 161 | ;; Copy Linux modules. |
f09d925b LC |
162 | (let* ((linux (assoc-ref %build-inputs "linux")) |
163 | (module-dir (and linux | |
164 | (string-append linux "/lib/modules")))) | |
165 | (mkdir "modules") | |
166 | ,@(map (lambda (module) | |
167 | `(match (find-files module-dir ,module) | |
168 | ((file) | |
169 | (format #t "copying '~a'...~%" file) | |
170 | (copy-file file (string-append "modules/" | |
171 | ,module))) | |
172 | (() | |
173 | (error "module not found" ,module module-dir)) | |
174 | ((_ ...) | |
175 | (error "several modules by that name" | |
176 | ,module module-dir)))) | |
177 | linux-modules)) | |
178 | ||
179 | ;; Reset the timestamps of all the files that will make it in the | |
180 | ;; initrd. | |
181 | (for-each (cut utime <> 0 0 0 0) | |
182 | (find-files "." ".*")) | |
183 | ||
184 | (system* cpio "--version") | |
185 | (let ((pipe (open-pipe* OPEN_WRITE cpio "-o" | |
186 | "-O" (string-append out "/initrd") | |
187 | "-H" "newc" "--null"))) | |
188 | (define print0 | |
189 | (let ((len (string-length "./"))) | |
190 | (lambda (file) | |
191 | (format pipe "~a\0" (string-drop file len))))) | |
192 | ||
193 | ;; Note: as per `ramfs-rootfs-initramfs.txt', always add | |
194 | ;; directory entries before the files that are inside of it: "The | |
195 | ;; Linux kernel cpio extractor won't create files in a directory | |
196 | ;; that doesn't exist, so the directory entries must go before | |
197 | ;; the files that go in those directories." | |
198 | (file-system-fold (const #t) | |
199 | (lambda (file stat result) ; leaf | |
200 | (print0 file)) | |
201 | (lambda (dir stat result) ; down | |
202 | (unless (string=? dir ".") | |
203 | (print0 dir))) | |
204 | (const #f) ; up | |
205 | (const #f) ; skip | |
206 | (const #f) | |
207 | #f | |
208 | ".") | |
209 | ||
210 | (and (zero? (close-pipe pipe)) | |
211 | (with-directory-excursion out | |
212 | (and (zero? (system* gzip "--best" "initrd")) | |
213 | (rename-file "initrd.gz" "initrd"))))))))) | |
214 | ||
215 | (let ((name* name)) | |
216 | (package | |
217 | (name name*) | |
218 | (version "0") | |
219 | (source #f) | |
220 | (build-system trivial-build-system) | |
221 | (arguments `(#:modules ((guix build utils)) | |
222 | #:builder ,builder)) | |
223 | (inputs `(("guile" ,guile) | |
224 | ("cpio" ,cpio) | |
225 | ("gzip" ,gzip) | |
f989fa39 LC |
226 | ("modules" ,(module-package modules)) |
227 | ("modules/compiled" ,(compiled-module-package modules)) | |
f09d925b LC |
228 | ,@(if linux |
229 | `(("linux" ,linux)) | |
230 | '()))) | |
231 | (synopsis "An initial RAM disk (initrd) for the Linux kernel") | |
232 | (description | |
233 | "An initial RAM disk (initrd), really a gzipped cpio archive, for use by | |
234 | the Linux kernel.") | |
235 | (license gpl3+) | |
236 | (home-page "http://www.gnu.org/software/guix/")))) | |
237 | ||
238 | (define-public qemu-initrd | |
239 | (expression->initrd | |
240 | '(begin | |
88840f02 | 241 | (use-modules (srfi srfi-1) |
f09d925b LC |
242 | (srfi srfi-26) |
243 | (ice-9 match) | |
88840f02 | 244 | ((system base compile) #:select (compile-file)) |
89bf140b | 245 | (guix build utils) |
88840f02 | 246 | (guix build linux-initrd)) |
f09d925b | 247 | |
88840f02 | 248 | (display "Welcome, this is GNU's early boot Guile.\n") |
f09d925b LC |
249 | (display "Use '--repl' for an initrd REPL.\n\n") |
250 | ||
88840f02 LC |
251 | (mount-essential-file-systems) |
252 | (let* ((args (linux-command-line)) | |
f09d925b LC |
253 | (option (lambda (opt) |
254 | (let ((opt (string-append opt "="))) | |
255 | (and=> (find (cut string-prefix? opt <>) | |
256 | args) | |
257 | (lambda (arg) | |
258 | (substring arg (+ 1 (string-index arg #\=)))))))) | |
259 | (to-load (option "--load")) | |
260 | (root (option "--root"))) | |
261 | ||
262 | (when (member "--repl" args) | |
263 | ((@ (system repl repl) start-repl))) | |
264 | ||
88840f02 LC |
265 | (display "loading CIFS and companion modules...\n") |
266 | (for-each (compose load-linux-module* | |
267 | (cut string-append "/modules/" <>)) | |
268 | (list "md4.ko" "ecb.ko" "cifs.ko")) | |
f09d925b | 269 | |
88840f02 LC |
270 | (unless (configure-qemu-networking) |
271 | (display "network interface is DOWN\n")) | |
f09d925b | 272 | |
b48d21b2 LC |
273 | ;; Make the device nodes for QEMU's hard disk and partitions. |
274 | (mknod "/dev/vda" 'block-special #o644 (device-number 8 0)) | |
275 | (mknod "/dev/vda1" 'block-special #o644 (device-number 8 1)) | |
276 | (mknod "/dev/vda2" 'block-special #o644 (device-number 8 2)) | |
277 | ||
f09d925b LC |
278 | ;; Prepare the real root file system under /root. |
279 | (unless (file-exists? "/root") | |
280 | (mkdir "/root")) | |
281 | (if root | |
282 | (mount root "/root" "ext3") | |
283 | (mount "none" "/root" "tmpfs")) | |
88840f02 LC |
284 | (mount-essential-file-systems #:root "/root") |
285 | ||
f09d925b | 286 | (mkdir "/root/xchg") |
89bf140b | 287 | (mkdir-p "/root/nix/store") |
f09d925b LC |
288 | |
289 | (mkdir "/root/dev") | |
88840f02 LC |
290 | (mknod "/root/dev/null" 'char-special #o666 (device-number 1 3)) |
291 | (mknod "/root/dev/zero" 'char-special #o666 (device-number 1 5)) | |
f09d925b LC |
292 | |
293 | ;; Mount the host's store and exchange directory. | |
88840f02 LC |
294 | (mount-qemu-smb-share "/store" "/root/nix/store") |
295 | (mount-qemu-smb-share "/xchg" "/root/xchg") | |
f09d925b | 296 | |
89bf140b LC |
297 | ;; Copy the directories that contain .scm and .go files so that the |
298 | ;; child process in the chroot can load modules (we would bind-mount | |
299 | ;; them but for some reason that fails with EINVAL -- XXX). | |
300 | (mkdir "/root/share") | |
301 | (mkdir "/root/lib") | |
302 | (mount "none" "/root/share" "tmpfs") | |
303 | (mount "none" "/root/lib" "tmpfs") | |
304 | (copy-recursively "/share" "/root/share" | |
305 | #:log (%make-void-port "w")) | |
306 | (copy-recursively "/lib" "/root/lib" | |
307 | #:log (%make-void-port "w")) | |
308 | ||
309 | ||
f09d925b LC |
310 | (if to-load |
311 | (begin | |
312 | (format #t "loading boot file '~a'...\n" to-load) | |
313 | (compile-file (string-append "/root/" to-load) | |
314 | #:output-file "/root/loader.go" | |
315 | #:opts %auto-compilation-options) | |
316 | (match (primitive-fork) | |
317 | (0 | |
318 | (chroot "/root") | |
89bf140b LC |
319 | (load-compiled "/loader.go") |
320 | ||
321 | ;; TODO: Remove /lib, /share, and /loader.go. | |
322 | ) | |
f09d925b LC |
323 | (pid |
324 | (format #t "boot file loaded under PID ~a~%" pid) | |
325 | (let ((status (waitpid pid))) | |
326 | (reboot))))) | |
327 | (begin | |
328 | (display "no boot file passed via '--load'\n") | |
329 | (display "entering a warm and cozy REPL\n") | |
330 | ((@ (system repl repl) start-repl)))))) | |
331 | #:name "qemu-initrd" | |
89bf140b LC |
332 | #:modules '((guix build utils) |
333 | (guix build linux-initrd)) | |
f09d925b LC |
334 | #:linux linux-libre |
335 | #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko"))) | |
336 | ||
337 | ;;; linux-initrd.scm ends here |