Commit | Line | Data |
---|---|---|
fbb35558 | 1 | ;;; GNU Guix --- Functional package management for GNU |
2200bb21 | 2 | ;;; Copyright © 2013, 2014, 2015, 2018, 2020 Ludovic Courtès <ludo@gnu.org> |
fbb35558 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 | ||
19 | (define-module (gnu build linux-initrd) | |
e8277f90 | 20 | #:use-module ((guix cpio) #:prefix cpio:) |
1621cf97 LC |
21 | #:use-module (guix build utils) |
22 | #:use-module (guix build store-copy) | |
23 | #:use-module (system base compile) | |
24 | #:use-module (rnrs bytevectors) | |
25 | #:use-module ((system foreign) #:select (sizeof)) | |
fbb35558 | 26 | #:use-module (ice-9 ftw) |
1621cf97 LC |
27 | #:export (write-cpio-archive |
28 | build-initrd)) | |
fbb35558 LC |
29 | |
30 | ;;; Commentary: | |
31 | ;;; | |
32 | ;;; Tools to create Linux initial RAM disks ("initrds"). Initrds are | |
33 | ;;; essentially gzipped cpio archives, with a '/init' executable that the | |
34 | ;;; kernel runs at boot time. | |
35 | ;;; | |
36 | ;;; Code: | |
37 | ||
38 | (define* (write-cpio-archive output directory | |
39 | #:key | |
40 | (compress? #t) | |
e8277f90 | 41 | (gzip "gzip")) |
2200bb21 LC |
42 | "Write a cpio archive containing DIRECTORY to file OUTPUT, with reset |
43 | timestamps in the archive. When COMPRESS? is true, compress it using GZIP. | |
44 | On success, return OUTPUT." | |
84da4ad4 | 45 | |
e8277f90 LC |
46 | ;; Note: as per `ramfs-rootfs-initramfs.txt', always add directory entries |
47 | ;; before the files that are inside of it: "The Linux kernel cpio | |
48 | ;; extractor won't create files in a directory that doesn't exist, so the | |
49 | ;; directory entries must go before the files that go in those | |
50 | ;; directories." | |
fbb35558 | 51 | |
e8277f90 | 52 | (define files |
583323ca LC |
53 | ;; Use 'sort' so that (1) the order of files is deterministic, and (2) |
54 | ;; directories appear before the files they contain. | |
55 | (sort (file-system-fold (const #t) ;enter? | |
56 | (lambda (file stat result) ;leaf | |
57 | (cons file result)) | |
58 | (lambda (dir stat result) ;down | |
59 | (if (string=? dir directory) | |
60 | result | |
61 | (cons dir result))) | |
62 | (lambda (file stat result) | |
63 | result) | |
64 | (const #f) ;skip | |
65 | (const #f) ;error | |
66 | '() | |
67 | directory) | |
68 | string<?)) | |
e8277f90 LC |
69 | |
70 | (call-with-output-file output | |
71 | (lambda (port) | |
eae5b3ff LC |
72 | (cpio:write-cpio-archive files port |
73 | #:file->header cpio:file->cpio-header*))) | |
e8277f90 | 74 | |
91e633f0 | 75 | (if compress? |
d422cbb3 LC |
76 | ;; Gzip insists on adding a '.gz' suffix and does nothing if the input |
77 | ;; file already has that suffix. Shuffle files around to placate it. | |
78 | (let* ((gz-suffix? (string-suffix? ".gz" output)) | |
79 | (sans-gz (if gz-suffix? | |
80 | (string-drop-right output 3) | |
81 | output))) | |
82 | (when gz-suffix? | |
83 | (rename-file output sans-gz)) | |
84 | ;; Use '--no-name' so that gzip records neither a file name nor a time | |
85 | ;; stamp in its output. | |
86 | (and (zero? (system* gzip "--best" "--no-name" sans-gz)) | |
87 | (begin | |
88 | (unless gz-suffix? | |
89 | (rename-file (string-append output ".gz") output)) | |
90 | output))) | |
e8277f90 | 91 | output)) |
fbb35558 | 92 | |
1621cf97 LC |
93 | (define (cache-compiled-file-name file) |
94 | "Return the file name of the in-cache .go file for FILE, relative to the | |
95 | current directory. | |
96 | ||
97 | This is similar to what 'compiled-file-name' in (system base compile) does." | |
98 | (let loop ((file file)) | |
99 | (let ((target (false-if-exception (readlink file)))) | |
100 | (if target | |
101 | (loop target) | |
102 | (format #f ".cache/guile/ccache/~a-~a-~a-~a/~a" | |
103 | (effective-version) | |
104 | (if (eq? (native-endianness) (endianness little)) | |
105 | "LE" | |
106 | "BE") | |
107 | (sizeof '*) | |
108 | (effective-version) | |
109 | file))))) | |
110 | ||
111 | (define (compile-to-cache file) | |
112 | "Compile FILE to the cache." | |
113 | (let ((compiled-file (cache-compiled-file-name file))) | |
114 | (mkdir-p (dirname compiled-file)) | |
115 | (compile-file file | |
116 | #:opts %auto-compilation-options | |
117 | #:output-file compiled-file))) | |
118 | ||
119 | (define* (build-initrd output | |
120 | #:key | |
121 | guile init | |
1621cf97 | 122 | (references-graphs '()) |
1621cf97 LC |
123 | (gzip "gzip")) |
124 | "Write an initial RAM disk (initrd) to OUTPUT. The initrd starts the script | |
125 | at INIT, running GUILE. It contains all the items referred to by | |
42d10464 | 126 | REFERENCES-GRAPHS." |
1621cf97 LC |
127 | (mkdir "contents") |
128 | ||
129 | ;; Copy the closures of all the items referenced in REFERENCES-GRAPHS. | |
6a060ff2 LC |
130 | (populate-store references-graphs "contents" |
131 | #:deduplicate? #f) | |
1621cf97 LC |
132 | |
133 | (with-directory-excursion "contents" | |
1621cf97 LC |
134 | ;; Make '/init'. |
135 | (symlink init "init") | |
136 | ||
137 | ;; Compile it. | |
138 | (compile-to-cache "init") | |
139 | ||
140 | ;; Allow Guile to find out where it is (XXX). See | |
141 | ;; 'guile-relocatable.patch'. | |
142 | (mkdir-p "proc/self") | |
143 | (symlink (string-append guile "/bin/guile") "proc/self/exe") | |
144 | (readlink "proc/self/exe") | |
145 | ||
e8277f90 | 146 | (write-cpio-archive output "." #:gzip gzip)) |
1621cf97 | 147 | |
970c9993 LC |
148 | ;; Make sure directories are writable so we can delete files. |
149 | (for-each make-file-writable | |
150 | (find-files "contents" | |
151 | (lambda (file stat) | |
152 | (eq? 'directory (stat:type stat))) | |
153 | #:directories? #t)) | |
1621cf97 LC |
154 | (delete-file-recursively "contents")) |
155 | ||
fbb35558 | 156 | ;;; linux-initrd.scm ends here |